From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Matt Wette Newsgroups: gmane.lisp.guile.user Subject: wayland client in Guile without libwayland-client Date: Fri, 18 Nov 2022 08:54:46 -0800 Message-ID: Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8; format=flowed Content-Transfer-Encoding: 7bit Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="6562"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:102.0) Gecko/20100101 Thunderbird/102.4.2 To: Guile User Original-X-From: guile-user-bounces+guile-user=m.gmane-mx.org@gnu.org Fri Nov 18 17:55:47 2022 Return-path: Envelope-to: guile-user@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1ow4eX-0001SH-Mo for guile-user@m.gmane-mx.org; Fri, 18 Nov 2022 17:55:45 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ow4di-0007EH-MG; Fri, 18 Nov 2022 11:54:54 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ow4dh-0007E1-CE for guile-user@gnu.org; Fri, 18 Nov 2022 11:54:53 -0500 Original-Received: from mail-pf1-x429.google.com ([2607:f8b0:4864:20::429]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1ow4de-0003Zp-Pw for guile-user@gnu.org; Fri, 18 Nov 2022 11:54:53 -0500 Original-Received: by mail-pf1-x429.google.com with SMTP id b185so5397692pfb.9 for ; Fri, 18 Nov 2022 08:54:50 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=subject:from:to:content-language:user-agent:mime-version:date :message-id:from:to:cc:subject:date:message-id:reply-to; bh=IGwhJzO4GhZ+N/tmgX8345rOCW2PDegErZQxyg6g5Es=; b=DmHevSyYuAqTN1/8f+yWJ51w7XQWXCSKLbvP4kKOwi9LYLL/QNBSqlNihS+QPlWiBJ Np/5tgFmaQalJcUFwWm/3k28ZlmASNs16QJ6pvrhBVW2Ijq6dEADhyNI+VR/Ht9hfSQO WSfZVB/SlJZLSrlF6zM83ChjtO4zvpT+fzlhQWURyjGyzU5QljQyodOIzXTbpNUHo4Bw DAZUQQym7wJ1IphDLOFIhg4SjTISL+yWg4ufuu8GUeyDWaGxx48mkKF65E8MssSs5hoo bLLObuPBFyEumRlx0TDOcz19dCN+Smx7IO5y/GLP+rnrsgoQ875cxL7OTWU92f/LnLgB g5Kw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=subject:from:to:content-language:user-agent:mime-version:date :message-id:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=IGwhJzO4GhZ+N/tmgX8345rOCW2PDegErZQxyg6g5Es=; b=xbDOWvSgYoY4GRh2q+TW+XWQtygctb5xizLper2CjZKiLTH7UtPZ0ixro9ld9icT9G yKsbLnJ9ASVG4ZL497UBiBUsWLCDiwH72ROCmSDKlwN+v3AyrqQFrvxkjG/fF5U5iOVD AlHX8Gn32WsJ5G73OykB5j4p5aTmDwNrmeEP6lCGUMvX2+1O1jSvPrC5Ve+gmIaXvC1J OXaoNCYQ6CmWApkzQHp5TCO9LpIAbbvB5H1UyITignY1Ae+GjzGZ9LPqlt+EoMUxlJcV a2Moa4DSkncSS2wio4CA1nU//QeWL9JLk5KheDZShMgIkA+qFz1pcAgYXzQf6r6/rA/a aVlQ== X-Gm-Message-State: ANoB5pn66wWTOifh2hOw9TNI/XhsH/unLvjDqzsEAOl206r27Hr1V00w 1UJhXXjSlO5neDDZdSPsD1gFFMcs+tw= X-Google-Smtp-Source: AA0mqf6CDks25dNIBqddb01XRL6aiNoRbNSB+OlGaQFP4L33p0OnfZTQ4BOj5gYuXSFOaXxOiJNcjw== X-Received: by 2002:a63:4755:0:b0:477:1bf6:8b1c with SMTP id w21-20020a634755000000b004771bf68b1cmr4910529pgk.25.1668790488172; Fri, 18 Nov 2022 08:54:48 -0800 (PST) Original-Received: from [192.168.2.158] (64-52-138-37.championbroadband.com. [64.52.138.37]) by smtp.gmail.com with ESMTPSA id z11-20020a170903018b00b0018685aaf41dsm4008664plg.18.2022.11.18.08.54.47 for (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Fri, 18 Nov 2022 08:54:47 -0800 (PST) Content-Language: en-US Received-SPF: pass client-ip=2607:f8b0:4864:20::429; envelope-from=matt.wette@gmail.com; helo=mail-pf1-x429.google.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, HTML_MESSAGE=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-Content-Filtered-By: Mailman/MimeDel 2.1.29 X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: General Guile related discussions List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-user-bounces+guile-user=m.gmane-mx.org@gnu.org Original-Sender: guile-user-bounces+guile-user=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.lisp.guile.user:18737 Archived-At: Hi All, Just for fun, I'm working on an "all" Guile client-side program to use with Wayland. I'm just getting started, but I thought you all might be interested to see what I'm doing. Wayland is the apparent replacement for X11. My reading is that it provides a client software tighter intergration with the GPUs. In Wayland the display is managed by the "compositor". Applications communicate with the compositor via UNIX domain sockets. Messages have an eight byte header that provides object id, object code and message size. An object id is mapped to an interface, and the object code is mapped to an interface method. The interfaces and their methods are specified in the protocol file "wayland.xml". ref:https://wayland-book.com ref:https://github.com/wayland-project/wayland/blob/main/protocol/wayland.xml The above implies that one could write a client application for Wayland in Guile using a socket interface and procedures generated from wayland.xml. I have started working on just that. One issue is that clients operate on buffers and surfaces directly. To negotiate buffer sharing, file descriptors are transferred over the socket connection. This means we need sendmsg() and recvmsg() in Guile. I have coded prototypes for those. In addition, I have generated an auto-coder to translate wayland.xml to Guile Scheme. Socket extension procedures are: (sendmsg sock iobuf ix length cm-buf flags) => n-sent (recvmsg! sock iobuf ix cmsg-list flags) => (n-sent cm-buf) cm-buf is a bytevector of control messages (`man cmsg`). To deal with control messages I have generated these procedures: (cmsg-list->bytevector cmsg-list) => bytevector (bytevector->cmsg-list bytevector) => cmsg-list Here is an example of auto-coded request (client->server), from wayland.xml to Guile Scheme: (define-public encode-wl_display:get_registry (lambda (obj-id bv ix registry) (define (encode-body) (bytevector-u32-native-set! bv (+ ix 8) registry) (values (+ ix 12) #f)) (call-with-values encode-body (lambda (msg-size control) (bytevector-u32-native-set! bv ix obj-id) (bytevector-u16-native-set! bv (+ ix 6) msg-size) (bytevector-u16-native-set! bv (+ ix 4) 1) (values msg-size control))))) Here is an example of an auto-coded event decoder: (lambda (obj-id bv ix cm) "event decoder for global" (let*-values (((name ix) (dec-u32 bv ix)) ((interface ix) (dec-string bv ix)) ((version ix) (dec-u32 bv ix))) (values obj-id name interface version))) With the event decoder and user-supplied handler I have this dispatch: (define (dispatch obj-id opcode bv ix cm) (let* ((decoder (vector-ref (vector-ref object-decoders-vec obj-id) opcode)) (handler (vector-ref (vector-ref object-handlers-vec obj-id) opcode))) (call-with-values (lambda () (decoder obj-id bv ix cm)) handler))) The code below sets up the interface with the compositor and obtains the list of global objects and prints them. The output is as follows: global: 1 wl_compositor global: 2 wl_drm global: 3 wl_shm global: 4 wl_output global: 5 zxdg_output_manager_v1 global: 6 wl_data_device_manager global: 7 zwp_primary_selection_device_manager_v1 global: 8 gtk_primary_selection_device_manager global: 9 wl_subcompositor global: 10 xdg_wm_base global: 11 zxdg_shell_v6 global: 12 gtk_shell1 global: 13 wp_viewporter global: 14 zwp_pointer_gestures_v1 global: 15 zwp_tablet_manager_v2 global: 16 wl_seat global: 17 zwp_relative_pointer_manager_v1 global: 18 zwp_pointer_constraints_v1 global: 19 zxdg_exporter_v1 global: 20 zxdg_importer_v1 global: 21 zwp_linux_dmabuf_v1 global: 22 zwp_keyboard_shortcuts_inhibit_manager_v1 global: 23 zwp_text_input_manager_v3 global: 24 wp_presentation global: 25 xdg_activation_v1 CODE: ;; per-interface vectors of handlers by opcode (define wl-handler-vec-vec (make-wl-handler-vec-vec)) ;; number of objects (define user-obj-count (make-parameter 0)) (define (incr-obj-count) (user-obj-count (1+ (user-obj-count)))) ;; vector of object-id => ref into wl-handler-vec (handler by opcode) (define object-decoders-vec (make-vector 1000)) ;; vector of object-id => ref into wl-handler-vec (handler by opcode) (define object-handlers-vec (make-vector 1000)) ;; vector of objec-id => user-defined value (define object-value-vec (make-vector 1000)) ;; set-event-handler 'wl_displaly 'get_registry proc => prev-proc (define (set-event-handler interface event proc) (let* ((if-indx (assq-ref wayland-index-dict interface)) (opcode (assq-ref (vector-ref wayland-opcode-dict-vec if-indx) event)) (if-handlers (vector-ref wl-handler-vec-vec if-indx)) (evt-handler (vector-ref if-handlers opcode))) (vector-set! if-handlers opcode proc) evt-handler)) (define (dispatch obj-id opcode bv ix cm) (let* ((decoder (vector-ref (vector-ref object-decoders-vec obj-id) opcode)) (handler (vector-ref (vector-ref object-handlers-vec obj-id) opcode))) (call-with-values (lambda () (decoder obj-id bv ix cm)) handler))) (define null-id 0) (define display-id 1) (define registry-id 2) ;; wl_display:error (define (handle-error obj-id code message) (sf "error: ~S\n" message)) ;; wl_display:delete_id (define (handle-delete_id obj-id id) (sf "delete-id: ~S\n" id)) (define (handle-global obj-id name interface version) (sf "global: ~A\t~A\n" name interface) #f) (define (setup) (set-event-handler 'wl_display 'error handle-error) (set-event-handler 'wl_display 'delete_id handle-delete_id) (set-event-handler 'wl_registry 'global handle-global) ;; display (set! display-id 1) (let* ((ob-indx display-id) (if-indx (assq-ref wayland-index-dict 'wl_display)) (if-decoders (vector-ref wl-decoder-vec-vec if-indx)) (if-handlers (vector-ref wl-handler-vec-vec if-indx))) (vector-set! object-decoders-vec ob-indx if-decoders) (vector-set! object-handlers-vec ob-indx if-handlers)) ;; registry object (set! registry-id 2) (let* ((ob-indx registry-id) (if-indx (assq-ref wayland-index-dict 'wl_registry)) (if-decoders (vector-ref wl-decoder-vec-vec if-indx)) (if-handlers (vector-ref wl-handler-vec-vec if-indx))) (vector-set! object-decoders-vec ob-indx if-decoders) (vector-set! object-handlers-vec ob-indx if-handlers)) (user-obj-count 3)) (define socket-path (let ((dir (getenv "XDG_RUNTIME_DIR")) (dpy (getenv "WAYLAND_DISPLAY"))) (and dir dpy (string-append dir "/" dpy)))) (define wl-display-id 1) (define wl-registry-id 2) (define (main) (let* ((path socket-path) (style (logior SOCK_STREAM SOCK_CLOEXEC)) (sock (socket PF_UNIX SOCK_STREAM 0)) (conn (connect sock AF_UNIX path)) (iobuf (make-bytevector 72))) (setvbuf sock 'none) (setup) ;; request: wl_display:get_registry 2 (call-with-values (lambda () (encode-wl_display:get_registry 1 iobuf 0 2)) (lambda (ln ctl) (sendmsg sock iobuf 0 ln ctl))) (let loop ((n-have 0) (object-id #f) (msg-size 8) (opcode #f) (control #f)) (usleep 20000) (cond ((< n-have msg-size) (let* ((res (recvmsg! sock iobuf n-have)) (n-have (+ n-have (vector-ref res 0))) (control (or control (vector-ref res 1)))) (loop n-have object-id msg-size opcode control))) ((not object-id) (let* ((object-id (bytevector-u32-native-ref iobuf 0)) (word1 (bytevector-u32-native-ref iobuf 4)) (msg-size (bytevector-u16-native-ref iobuf msg-size-offset)) (opcode (bytevector-u16-native-ref iobuf opcode-offset))) (loop n-have object-id msg-size opcode control))) (else (dispatch object-id opcode iobuf 8 control) (if (> n-have msg-size) (bytevector-copy! iobuf msg-size iobuf 0 (- n-have msg-size))) (loop (- n-have msg-size) #f 8 opcode control)))) 0)) (main)