(define-module (wm)
  #:use-module (system foreign)
  #:export (wm-init
            make-key
            make-shift-key
            wm-grab-keys
            wm-grab-key-with-mod
            wm-grab-key-with-mod-shift
            wm-set-key-press-handler!
            wm-focus-prev
            wm-focus-next
            wm-run
            wm-quit))

(define libschewm (dynamic-link "libschewm"))

(define (uint8-as-bool i)
  (not (eq? 0 i)))

(define (schewm-func return-type name args)
  (pointer->procedure
   return-type
   (dynamic-func name libschewm)
   args))

(define c/wm-init
  (schewm-func uint8 "wm_init" '()))

(define (wm-init)
  (uint8-as-bool (c/wm-init)))

(define wm-quit
  (schewm-func void "wm_quit" '()))

(define wm-run
  (schewm-func void "wm_run" '()))

(define c/key-from-str
  (schewm-func uint32
               "keysym_from_str"
               (list '*)))

(define (key-from-str s)
  (c/key-from-str (string->pointer s)))

(define (make-key key)
  (list #f (key-from-str key)))

(define (make-shift-key key)
  (list #t (key-from-str key)))

(define wm-grab-key-with-mod
  (schewm-func void "wm_grab_key_with_mod"
               (list uint32)))

(define wm-grab-key-with-mod-shift
  (schewm-func void "wm_grab_key_with_mod_shift"
               (list uint32)))

(define (wm-grab-keys keybindings)
  (unless (null? keybindings)
    (let* ((keybinding (car keybindings))
           (chord (car keybinding))
           (func (cdr keybinding))
           (with-shift (car chord))
           (key (car (cdr chord))))
      (if with-shift
          (wm-grab-key-with-mod-shift key)
          (wm-grab-key-with-mod key))
      (wm-grab-keys (cdr keybindings)))))

(define wm-focus-prev
  (schewm-func void "wm_focus_prev" '()))

(define wm-focus-next
  (schewm-func void "wm_focus_next" '()))

(define c/wm-set-key-press-handler
  (schewm-func void
               "wm_set_key_press_handler"
               (list '*)))

(define (wm-set-key-press-handler! handler)
  ;; mod (state, uint16)
  ;; keysym (detail, uint8)
  (c/wm-set-key-press-handler
   (procedure->pointer void
                       handler
                       (list uint16 uint8))))