;;; Chickadee Game Toolkit
;;; Copyright © 2017 David Thompson <davet@gnu.org>
;;;
;;; Chickadee is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published
;;; by the Free Software Foundation, either version 3 of the License,
;;; or (at your option) any later version.
;;;
;;; Chickadee is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see
;;; <http://www.gnu.org/licenses/>.

(define-module (chickadee buffer)
  #:use-module (chickadee)
  #:use-module (chickadee scripting)
  #:use-module (oop goops)
  #:export (<buffer>
            started?
            start
            stop
            pause
            resume
            update
            before-draw
            draw
            after-draw
            abort
            key-press
            key-release
            text-input
            mouse-press
            mouse-move
            controller-add
            controller-remove
            controller-press
            controller-release
            controller-move
            current-buffer
            push-buffer!
            pop-buffer!
            replace-buffer!
            use-buffers!))

(define-class <buffer> ()
  (started? #:init-value #f #:accessor buffer-started?)
  (agenda #:init-thunk make-agenda #:getter buffer-agenda))

(define-method (start (buffer <buffer>))
  #t)

(define-method (stop (buffer <buffer>))
  #t)

(define-method (pause (buffer <buffer>))
  #t)

(define-method (resume (buffer <buffer>))
  #t)

(define-method (update (buffer <buffer>) dt)
  #t)

(define-method (abort (buffer <buffer>))
  (abort-game))

(define-method (before-draw (buffer <buffer>))
  #t)

(define-method (draw (buffer <buffer>) alpha)
  #t)

(define-method (after-draw (buffer <buffer>))
  #t)

(define-method (key-press (buffer <buffer>) key scancode modifiers repeat?)
  #t)

(define-method (key-release (buffer <buffer>) key scancode modifiers)
  #t)

(define-method (text-input (buffer <buffer>) text)
  #t)

(define-method (mouse-press (buffer <buffer>) button clicks x y)
  #t)

(define-method (mouse-release (buffer <buffer>) button x y)
  #t)

(define-method (mouse-move (buffer <buffer>) x y x-rel y-rel buttons)
  #t)

(define-method (controller-add (buffer <buffer>) controller)
  #t)

(define-method (controller-remove (buffer <buffer>) controller)
  #t)

(define-method (controller-press (buffer <buffer>) controller button)
  #t)

(define-method (controller-release (buffer <buffer>) controller button)
  #t)

(define-method (controller-move (buffer <buffer>) controller axis value)
  #t)


;;;
;;; Buffer management
;;;

(define *buffers* '())

(define (current-buffer)
  "Return the current buffer."
  (and (not (null? *buffers*))
       (car *buffers*)))

(define-syntax-rule (with-buffer buffer body ...)
  (with-agenda (buffer-agenda buffer)
    body ...))

(define-syntax-rule (with-current-buffer name body ...)
  (let ((name (current-buffer)))
    (with-buffer name
      body ...)))

(define* (switch-buffers old new #:optional replace?)
  (when (is-a? old <buffer>)
    (with-buffer old
      (if replace?
          (stop old)
          (pause old))))
  (with-buffer new
    (if (buffer-started? new)
        (resume new)
        (begin
          (start new)
          (set! (buffer-started? new) #t)))))

(define (push-buffer! buffer)
  "Pause the current buffer and switch to BUFFER."
  (let ((old (current-buffer)))
    (set! *buffers* (cons buffer *buffers*))
    (switch-buffers old buffer)))

(define (pop-buffer!)
  "Stop the current buffer and switch back to the previously active
buffer, or terminate the game loop if the buffer stack is empty."
  (let ((old (current-buffer)))
    (set! *buffers* (cdr *buffers*))
    (if (null? *buffers*)
        (begin
          (stop old)
          (abort-game))
        (switch-buffers old (current-buffer) #t))))

(define (replace-buffer! buffer)
  "Stop the current buffer and switch to BUFFER."
  (let ((old (current-buffer)))
    (set! *buffers* (cons buffer (cdr *buffers*)))
    (switch-buffers old buffer #t)))

(define (use-buffers! initial-buffer)
  "Install buffers into the game engine and set the current buffer to
INITIAL-BUFFER."
  (add-hook! load-hook
             (lambda ()
               (push-buffer! initial-buffer)))
  (add-hook! update-hook
             (lambda (dt)
               (with-current-buffer buffer
                 (update-agenda 1)
                 (update buffer dt))))
  (add-hook! before-draw-hook
             (lambda ()
               (with-current-buffer buffer
                 (before-draw buffer))))
  (add-hook! after-draw-hook
             (lambda ()
               (with-current-buffer buffer
                 (after-draw buffer))))
  (add-hook! draw-hook
             (lambda (alpha)
               (with-current-buffer buffer
                 (draw buffer alpha))))
  (add-hook! quit-hook
             (lambda ()
               (with-current-buffer buffer
                 (abort buffer))))
  (add-hook! key-press-hook
             (lambda (key scancode modifiers repeat?)
               (with-current-buffer buffer
                 (key-press buffer key scancode modifiers repeat?))))
  (add-hook! key-release-hook
             (lambda (key scancode modifiers)
               (with-current-buffer buffer
                 (key-release buffer key scancode modifiers))))
  (add-hook! text-input-hook
             (lambda (text)
               (with-current-buffer buffer
                 (text-input buffer text))))
  (add-hook! mouse-press-hook
             (lambda (button clicks x y)
               (with-current-buffer buffer
                 (mouse-press buffer button clicks x y))))
  (add-hook! mouse-release-hook
             (lambda (button x y)
               (with-current-buffer buffer
                 (mouse-release buffer button x y))))
  (add-hook! mouse-move-hook
             (lambda (x y x-rel y-rel buttons)
               (with-current-buffer buffer
                 (mouse-move buffer x y x-rel y-rel buttons))))
  (add-hook! controller-add-hook
             (lambda (controller)
               (with-current-buffer buffer
                 (controller-add buffer controller))))
  (add-hook! controller-remove-hook
             (lambda (controller)
               (with-current-buffer buffer
                 (controller-remove buffer controller))))
  (add-hook! controller-press-hook
             (lambda (controller button)
               (with-current-buffer buffer
                 (controller-press buffer controller button))))
  (add-hook! controller-release-hook
             (lambda (controller button)
               (with-current-buffer buffer
                 (controller-release buffer controller button))))
  (add-hook! controller-move-hook
             (lambda (controller axis value)
               (with-current-buffer buffer
                 (controller-move buffer controller axis value)))))