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)
>
next prev parent 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).