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: Re: wayland client in Guile without libwayland-client Date: Fri, 18 Nov 2022 09:03:47 -0800 Message-ID: <433b7d4d-ad20-1f85-4a20-e5ffa26f5e88@gmail.com> References: Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8; format=flowed Content-Transfer-Encoding: 8bit Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="13430"; 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@gnu.org Original-X-From: guile-user-bounces+guile-user=m.gmane-mx.org@gnu.org Fri Nov 18 18:04:48 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 1ow4nI-0003Dc-1n for guile-user@m.gmane-mx.org; Fri, 18 Nov 2022 18:04:48 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ow4mf-0002BG-8F; Fri, 18 Nov 2022 12:04:09 -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 1ow4mU-00028o-59 for guile-user@gnu.org; Fri, 18 Nov 2022 12:04:00 -0500 Original-Received: from mail-pg1-x534.google.com ([2607:f8b0:4864:20::534]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1ow4mO-00056o-BB for guile-user@gnu.org; Fri, 18 Nov 2022 12:03:54 -0500 Original-Received: by mail-pg1-x534.google.com with SMTP id r18so5468081pgr.12 for ; Fri, 18 Nov 2022 09:03:50 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=content-transfer-encoding:in-reply-to:from:references:to :content-language:subject:user-agent:mime-version:date:message-id :from:to:cc:subject:date:message-id:reply-to; bh=gpfR2Fa9s+CiX2Dl5snpRpnjROE9E2+RoYpT+E6ikIk=; b=C3wwVrojK5ARsdFJK9pf7h+rfbxuH2G/utcParf+CwympmtBxzw69l39YnQCJOWILu LCaEBDdH+sl8FtdrlmoTA8GHQRzahfcOlDtS7q/UDDlk+ZwFk1z858UF3OvNfnTFy4RF HmLlcI6//HmE8n9OvgqdmbanGro/4HU/SghJe/gC0v/axmQ7Wz1Pr35GORODzcxjsrcQ sDsbFD7kVGZzURWOyeMJED7U6sLAaP3DBL85sJEW3VNUbMRFW8fQHOSfQxo6eGvCWWsP pwB/G0XiLv7EKRjvVptdEXalFfhpQOEBT+Jy1d5m8N7RSiHoOxX1h0wCOta1+pWJadyD FIng== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=content-transfer-encoding:in-reply-to:from:references:to :content-language:subject:user-agent:mime-version:date:message-id :x-gm-message-state:from:to:cc:subject:date:message-id:reply-to; bh=gpfR2Fa9s+CiX2Dl5snpRpnjROE9E2+RoYpT+E6ikIk=; b=c6dpJUo0bvvMCTqPKshZ2SBxK7SVm5FHBplFWO0V6NrW1W/zFxZI2enMbarMaq3wpU eHbv/3qRv17LfxwnsQmztjxl8NiObTqI1tc9xO/o0MrUMqq4kD0KVIGoa9cSc5NOxw8n /63yG5G7+TAnQW0KmInTHrwXKzoC3swaGiYVd9x7TB6Rz4YN4ab11ybCkG7ujJfC8vd3 wQZmc1t6gRq4Z1aZsvxaUYdSVRJ9/WENVVfLaYL+1QU5lSZByNh41SL3zCeemueVkQx0 vXCCHBMDh3vbzoWNFPIQDYYFEG+ZUvQ5WtdOWBJ3WJ5q6N0PXnmHzOLjCR8pkQjocZeO UEew== X-Gm-Message-State: ANoB5pnYKYKER6XGeEsNxhxQq4PAdmEaN1voDQFdw0zJJhtbnkZHDPRm 8uWoRS0esjKchP2dcrjNJ+4gG0gtxuY= X-Google-Smtp-Source: AA0mqf6gTZBb1PfJk1or+B0hz01AQQipRz+GiW+ASNAdYxhl9NgW8jOB7T6hbBNrB8xxU8bdzz4Dsw== X-Received: by 2002:a63:f455:0:b0:461:4e55:eab with SMTP id p21-20020a63f455000000b004614e550eabmr7340428pgk.174.1668791028942; Fri, 18 Nov 2022 09:03: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 x15-20020a63fe4f000000b00434272fe870sm3022419pgj.88.2022.11.18.09.03.48 for (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Fri, 18 Nov 2022 09:03:48 -0800 (PST) Content-Language: en-US In-Reply-To: Received-SPF: pass client-ip=2607:f8b0:4864:20::534; envelope-from=matt.wette@gmail.com; helo=mail-pg1-x534.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, NICE_REPLY_A=-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-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:18738 Archived-At: Oops: Please substitute "object code" with "opcode". On 11/18/22 8:54 AM, Matt Wette wrote: > 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) >