(define-module (wm)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-9)
  #:use-module (system foreign)
  #:export (wm-init
            make-config
            wm-reconfigure
            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-focused-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/parse-color
  (schewm-func uint32 "parse_color" (list '*)))

(define (parse-color s)
  (c/parse-color (string->pointer s)))

(define c/wm-reconfigure
  (schewm-func void
               "wm_reconfigure"
               (list uint16
                     uint16
                     uint16
                     int16
                     int16
                     uint16
                     uint16
                     uint32
                     uint32
                     uint32
                     uint32
                     uint32)))

(define (wm-reconfigure config)
  (c/wm-reconfigure (config-inner-border-width config)
                    (config-outer-border-width config)
                    (config-magnet-border-width config)
                    (config-offset-x config)
                    (config-offset-y config)
                    (config-offset-width config)
                    (config-offset-height config)
                    (parse-color (config-focused-color config))
                    (parse-color (config-unfocused-color config))
                    (parse-color (config-unkillable-color config))
                    (parse-color (config-empty-color config))
                    (parse-color (config-outer-color config))))

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

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

(define wm-focus-close
  (schewm-func void "wm_focus_close" '()))

(define wm-pack-left
 (schewm-func void "wm_pack_left" '()))

(define wm-pack-right
 (schewm-func void "wm_pack_right" '()))

(define wm-pack-top
 (schewm-func void "wm_pack_top" '()))

(define wm-pack-bottom
 (schewm-func void "wm_pack_bottom" '()))

(define wm-toggle-maximize
 (schewm-func void "wm_toggle_maximize" '()))

(define wm-toggle-half-left
 (schewm-func void "wm_toggle_half_left" '()))

(define wm-toggle-half-right
 (schewm-func void "wm_toggle_half_right" '()))

(define wm-toggle-half-top
 (schewm-func void "wm_toggle_half_top" '()))

(define wm-toggle-half-bottom
 (schewm-func void "wm_toggle_half_bottom" '()))

(define wm-toggle-top-left
 (schewm-func void "wm_toggle_top_left" '()))

(define wm-toggle-top-right
 (schewm-func void "wm_toggle_top_right" '()))

(define wm-toggle-bottom-left
 (schewm-func void "wm_toggle_bottom_left" '()))

(define wm-toggle-bottom-right
 (schewm-func void "wm_toggle_bottom_right" '()))

(define wm-set-workspace
  (schewm-func void
               "wm_set_workspace"
               (list uint32)))

(define wm-set-focused-client-workspace
  (schewm-func void
               "wm_set_focused_client_workspace"
               (list uint32)))

(define wm-client-monitor-prev
  (schewm-func void "wm_client_monitor_prev" '()))

(define wm-client-monitor-next
  (schewm-func void "wm_client_monitor_next" '()))


(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 c/wm-grab-key-with-mod
  (schewm-func void "wm_grab_key_with_mod"
               (list uint32 '*)))

(define (wm-grab-key-with-mod key proc)
  (c/wm-grab-key-with-mod key (procedure->pointer void proc '())))

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

(define (wm-grab-key-with-mod-shift key proc)
  (c/wm-grab-key-with-mod-shift key (procedure->pointer void proc '())))

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

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

(define (wm-set-key-press-handler! handler)
  ;; Event handler args are:
  ;; - mod (`ev.state' clean from noise, uint16)
  ;; - keysym (`ev.detail' converted to keysym, uint32)
  (c/wm-set-key-press-handler
   (procedure->pointer void
                       handler
                       (list uint16 uint32))))