1  (use-modules
  2   (wlroots types keyboard)
  3   (wayland server protocol wayland)
  4   (wayland server display)
  5   (wayland server listener)
  6   (wayland signal)
  7   (xkbcommon xkbcommon)
  8   (util572 color)
  9   (oop goops)
 10   (wlroots))
 11  
 12  ;;; this a simple example, pass ESC exit, other key will toggle background
 13  ;;; color.
 14  
 15  (define w-display (wl-display-create))
 16  (define w-backend (wlr-backend-autocreate w-display))
 17  (define w-renderer (wlr-renderer-autocreate w-backend))
 18  (define w-allocator (wlr-allocator-autocreate w-backend w-renderer))
 19  (define w-seat (wlr-seat-create w-display "seat0"))
 20  
 21  (define black? (make-parameter #t))
 22  
 23  (define output-frame-listener
 24    (make-wl-listener
 25     (lambda (listener output)
 26       (wlr-output-attach-render output #f)
 27       (call-with-renderer
 28        w-renderer (.width output) (.height output)
 29        (lambda (renderer . _)
 30          (wlr-renderer-clear
 31           renderer (make-rgba-color (if (black?) "#0000" "#ffff")))))
 32       (wlr-output-commit output))))
 33  
 34  (define w-backend-new-output-listener
 35    (make-wl-listener
 36     (lambda (listener output)
 37       (display "I get new output!\n")
 38       (wlr-output-init-render
 39        output w-allocator w-renderer)
 40       (wl-signal-add (get-event-signal output 'frame) output-frame-listener)
 41       (wlr-output-commit output))))
 42  
 43  (define (add-seat-capabilitie seat o)
 44    (wlr-seat-set-capabilities seat
 45                               (logior (.capabilities seat)
 46                                       (bs:enum->integer
 47                                        %wl-seat-capability-enum o))))
 48  
 49  
 50  
 51  (define (create-keyboard device)
 52    (display "new keyboard create!\n")
 53    (let* ((wl-kb (wlr-keyboard-from-input-device device))
 54           (context (xkb-context-new XKB_CONTEXT_NO_FLAGS))
 55           (keymap (xkb-keymap-new
 56                    context
 57                    #:flags XKB_KEYMAP_COMPILE_NO_FLAGS)))
 58      (wlr-keyboard-set-keymap wl-kb keymap)
 59      (wlr-keyboard-set-repeat-info wl-kb 10 600)
 60      (wl-signal-add (get-event-signal wl-kb 'modifiers)
 61                     (make-wl-listener
 62                      (lambda (listener data)
 63                        (let* ((wlr-keyboard (wrap-wlr-keyboard data))
 64                               (modifiers(.modifiers wlr-keyboard)))
 65                          (wlr-seat-set-keyboard
 66                           w-seat wl-kb)
 67                          (wlr-seat-keyboard-notify-modifiers
 68                           w-seat modifiers)
 69                          (pk 'new-modifiers modifiers)))))
 70      (wl-signal-add (get-event-signal wl-kb 'key)
 71                     (make-wl-listener
 72                      (lambda (listener data)
 73                        (let* ((event (wrap-wlr-keyboard-key-event data)))
 74                          (if (= (.keycode event) 1)
 75                              (wl-display-terminate w-display)
 76                              (begin (wlr-seat-set-keyboard w-seat wl-kb)
 77                                     (wlr-seat-keyboard-notify-key
 78                                      w-seat
 79                                      (.time-msec event)
 80                                      (.keycode event)
 81                                      (if (eq? (.state event)
 82                                               WL_KEYBOARD_KEY_STATE_PRESSED)
 83                                          1 0))
 84                                     (when (eq? (.state event)
 85                                                WL_KEYBOARD_KEY_STATE_PRESSED)
 86                                       (black? (not (black?))))
 87                                     (pk 'new-key (.keycode event))))))))))
 88  
 89  (define w-backend-new-input-listener
 90    (make-wl-listener
 91     (lambda (listener device)
 92       (display "I get new input device!\n")
 93       (case (.type device)
 94         ((WLR_INPUT_DEVICE_KEYBOARD)
 95          (create-keyboard device)
 96          (add-seat-capabilitie
 97           w-seat
 98           WL_SEAT_CAPABILITY_KEYBOARD))))))
 99  
100  (wlr-renderer-init-wl-display w-renderer w-display)
101  
102  (wl-signal-add (get-event-signal w-backend 'new-output)
103                 w-backend-new-output-listener)
104  
105  (wl-signal-add (get-event-signal w-backend 'new-input)
106                 w-backend-new-input-listener)
107  
108  (wlr-backend-start w-backend)
109  
110  (setenv "WAYLAND_DISPLAY" (wl-display-add-socket-auto w-display))
111  
112  (wl-display-run w-display)
113  
114  (wl-display-destroy-clients w-display)
115  (wl-display-destroy w-display)