(define-module (catbird mode)
  #:use-module (catbird config)
  #:use-module (catbird input-map)
  #:use-module (catbird mixins)
  #:use-module (ice-9 match)
  #:use-module (oop goops)
  #:use-module (srfi srfi-1)
  #:export (<major-mode>
            <minor-mode>
            bind-input
            unbind-input
            name-mode
            clear-inputs
            input-map
            on-key-press
            on-key-release
            on-text-input
            on-mouse-press
            on-mouse-release
            on-mouse-move
            on-mouse-wheel
            on-controller-press
            on-controller-release
            on-controller-move
            <nothing-mode>)
  #:re-export (controller-move
               controller-press
               controller-release
               key-press
               key-release
               text-input
               mouse-move
               mouse-press
               mouse-release
               mouse-wheel
               name
               on-enter
               on-exit
               on-pause
               on-resume
               update))

(define-root-class <mode> (<scriptable> <containable> <nameable>)
  (input-map #:accessor input-map #:allocation #:each-subclass
             #:init-thunk make-input-map))

(define-method (input-map (mode-class <class>))
  (class-slot-ref mode-class 'input-map))

(define-method (bind-input mode-class spec handler)
  (class-slot-set! mode-class 'input-map
                   (add-input (input-map mode-class) spec handler)))

(define-method (unbind-input mode-class spec)
  (class-slot-set! mode-class 'input-map
                   (remove-input (input-map mode-class) spec)))

(define (clear-inputs mode-class)
  (class-slot-set! mode-class 'input-map '()))

(define-method (on-key-press (mode <mode>) key modifiers)
  (let ((handler (key-press-handler (input-map mode) key modifiers)))
    (and handler (handler mode))))

(define-method (on-key-release (mode <mode>) key modifiers)
  (let ((handler (key-release-handler (input-map mode) key modifiers)))
    (and handler (handler mode))))

(define-method (on-text-input (mode <mode>) text)
  (let ((handler (text-input-handler (input-map mode))))
    (and handler (handler mode text))))

(define-method (on-mouse-press (mode <mode>) button x y)
  (let ((handler (mouse-press-handler (input-map mode) button)))
    (and handler (handler mode x y))))

(define-method (on-mouse-release (mode <mode>) button x y)
  (let ((handler (mouse-release-handler (input-map mode) button)))
    (and handler (handler mode x y))))

(define-method (on-mouse-move (mode <mode>) x y x-rel y-rel buttons)
  (let ((handler (mouse-move-handler (input-map mode) buttons)))
    (and handler (handler mode x y x-rel y-rel))))

(define-method (on-mouse-wheel (mode <mode>) x y)
  (let ((handler (mouse-wheel-handler (input-map mode))))
    (and handler (handler mode x y))))

(define-method (on-controller-press (mode <mode>) controller-id button)
  (let ((handler (controller-press-handler (input-map mode) controller-id button)))
    (and handler (handler mode))))

(define-method (on-controller-release (mode <mode>) controller-id button)
  (let ((handler (controller-release-handler (input-map mode) controller-id button)))
    (and handler (handler mode))))

(define-method (on-controller-move (mode <mode>) controller-id axis value)
  (let ((handler (controller-move-handler (input-map mode) controller-id axis)))
    (and handler (handler mode value))))

(define-class <major-mode> (<mode>))

(define-class <minor-mode> (<mode>))

(define-class <nothing-mode> (<major-mode>))