(define-module (wm)
  #:use-module (srfi srfi-9)
  #:use-module (system foreign)
  #:export (wm-init
            make-config
            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-focus-close
            wm-pack-left
            wm-pack-right
            wm-pack-top
            wm-pack-bottom
            wm-toggle-maximize
            wm-toggle-half-left
            wm-toggle-half-right
            wm-toggle-half-top
            wm-toggle-half-bottom
            wm-toggle-top-left
            wm-toggle-top-right
            wm-toggle-bottom-left
            wm-toggle-bottom-right
            wm-set-workspace
            wm-set-client-workspace
            wm-client-monitor-prev
            wm-client-monitor-next
            wm-run
            wm-quit))

;; Configuration record
(define-record-type <wm-config>
  (make-config
   inner-border-width
   outer-border-width
   magnet-border-width
   offset-x
   offset-y
   offset-width
   offset-height
   focused-color
   unfocused-color
   unkillable-color
   empty-color
   outer-color)
  wm-config?
  (inner-border-width   config-inner-border-width  set-config-inner-border-width!)
  (outer-border-width   config-outer-border-width  set-config-outer-border-width!)
  (magnet-border-width  config-magnet-border-width set-config-magnet-border-width!)
  (offset-x             config-offset-x            set-config-offset-x!)
  (offset-y             config-offset-y            set-config-offset-y!)
  (offset-width         config-offset-width        set-config-offset-width!)
  (offset-height        config-offset-height       set-config-offset-height!)
  (focused-color    config-focused-color    set-config-focused-color!)
  (unfocused-color  config-unfocused-color  set-config-unfocused-color!)
  (unkillable-color config-unkillable-color set-config-unkillable-color)
  (empty-color      config-empty-color      set-config-empty-color)
  (outer-color      config-outer-color      set-config-outer-color))

;; Misc. utility functions
(define (uint8-as-bool i)
  (not (eq? 0 i)))

;; Link to schewm shared lib
(define libschewm (dynamic-link "libschewm"))

;; Helper to easily define calls into schewm C code
(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/keysym-from-str
  (schewm-func uint32
               "keysym_from_str"
               (list '*)))

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

(define (make-key key)
  (list #f (string->key key)))

(define (make-shift-key key)
  (list #t (string->key 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))))

;; XXX: Dummy
(define (wm-focus-close) '())
(define (wm-pack-left) '())
(define (wm-pack-right) '())
(define (wm-pack-top) '())
(define (wm-pack-bottom) '())
(define (wm-toggle-maximize) '())
(define (wm-toggle-half-left) '())
(define (wm-toggle-half-right) '())
(define (wm-toggle-half-top) '())
(define (wm-toggle-half-bottom) '())
(define (wm-toggle-top-left) '())
(define (wm-toggle-top-right) '())
(define (wm-toggle-bottom-left) '())
(define (wm-toggle-bottom-right) '())
(define (wm-set-workspace) '())
(define (wm-set-client-workspace) '())
(define (wm-client-monitor-prev) '())
(define (wm-client-monitor-next) '())