unofficial mirror of guile-user@gnu.org 
 help / color / mirror / Atom feed
From: Matt Wette <matt.wette@gmail.com>
To: guile-user@gnu.org
Subject: Re: wayland client in Guile without libwayland-client
Date: Fri, 18 Nov 2022 09:03:47 -0800	[thread overview]
Message-ID: <433b7d4d-ad20-1f85-4a20-e5ffa26f5e88@gmail.com> (raw)
In-Reply-To: <aa8a8abe-182d-f5c7-5d1d-0a33fb05c2eb@gmail.com>

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)
>




  reply	other threads:[~2022-11-18 17:03 UTC|newest]

Thread overview: 6+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-11-18 16:54 wayland client in Guile without libwayland-client Matt Wette
2022-11-18 17:03 ` Matt Wette [this message]
2022-11-18 22:34 ` Maxime Devos
2022-11-18 22:58   ` Matt Wette
2022-11-19  4:26 ` Damien Mattei
2022-11-19 14:50   ` Matt Wette

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/guile/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=433b7d4d-ad20-1f85-4a20-e5ffa26f5e88@gmail.com \
    --to=matt.wette@gmail.com \
    --cc=guile-user@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).