;;; Lisparuga
;;; Copyright © 2020 David Thompson <dthompson2@worcester.edu>
;;;
;;; Lisparuga 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.
;;;
;;; Lisparuga 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 Lisparuga.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Scenes are the main state machine abstraction.  A scene represents
;; a distinct portion of a game: main menu, overworld map, inventory
;; screen, etc.  The kernel tracks the currently active scene.
;;
;;; Code:

(define-module (lisparuga scene)
  #:use-module (chickadee)
  #:use-module (chickadee audio)
  #:use-module (ice-9 match)
  #:use-module (oop goops)
  #:use-module (lisparuga node)
  #:export (<scene>
            background-music
            background-music-volume
            background-music-loop?
            on-quit
            on-key-press
            on-key-release
            on-text-input
            on-mouse-press
            on-mouse-release
            on-mouse-move
            on-controller-add
            on-controller-remove
            on-controller-press
            on-controller-release
            on-controller-move

            <scene-mux>
            current-scene
            previous-scene
            push-scene
            replace-scene
            pop-scene
            on-scenes-empty))

(define-class <scene> (<node>)
  (background-music-source #:getter background-music-source
                           #:init-form (make-source #:loop? #t))
  (background-music #:accessor background-music #:init-form #f
                    #:init-keyword #:music)
  (background-music-volume #:accessor background-music-volume #:init-form 1.0
                           #:init-keyword #:music-volume)
  (background-music-loop? #:accessor background-music-loop? #:init-form #t
                          #:init-keyword #:music-loop?))

(define-method (on-enter (scene <scene>))
  (when (audio? (background-music scene))
    (set-source-volume! (background-music-source scene)
                        (background-music-volume scene))
    (set-source-audio! (background-music-source scene)
                       (background-music scene))
    (source-play (background-music-source scene))))

(define-method (on-exit (scene <scene>))
  (source-stop (background-music-source scene)))

;; Input event handler methods
(define-method (on-quit (scene <scene>))
  (abort-game))

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

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

(define-method (on-text-input (scene <scene>) text)
  #t)

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

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

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

(define-method (on-controller-add (scene <scene>) controller)
  #t)

(define-method (on-controller-remove (scene <scene>) controller)
  #t)

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

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

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


;;;
;;; Scene Multiplexer
;;;

(define-class <scene-mux> (<node>)
  (scenes #:accessor scenes #:init-form '()))

(define-method (current-scene (mux <scene-mux>))
  (match (scenes mux)
    ((s . _) s)
    (() #f)))

(define-method (previous-scene (mux <scene-mux>))
  (match (scenes mux)
    ((_ s . _) s)
    (_ #f)))

(define-method (push-scene (mux <scene-mux>) (scene <scene>))
  (let ((old (current-scene mux)))
    (set! (scenes mux) (cons scene (scenes mux)))
    (when old (detach old))
    (attach-to mux scene)))

(define-method (replace-scene (mux <scene-mux>) (scene <scene>))
  (match (scenes mux)
    ((old . rest)
     (set! (scenes mux) (cons scene rest))
     (detach old)
     (attach-to mux scene))
    (()
     (error "no scene to replace!" mux))))

(define-method (pop-scene (mux <scene-mux>))
  (match (scenes mux)
    ((old)
     (set! (scenes mux) '())
     (detach old)
     (on-scenes-empty mux))
    ((and (old new . _)
          (_ . rest))
     (set! (scenes mux) rest)
     (detach old)
     (attach-to mux new))
    (()
     (error "no scene to pop!" mux))))

(define-method (on-scenes-empty (mux <scene-mux>))
  #t)

(define-method (on-quit (mux <scene-mux>))
  (on-quit (current-scene mux)))

(define-method (on-key-press (mux <scene-mux>) key scancode modifiers repeat?)
  (on-key-press (current-scene mux) key scancode modifiers repeat?))

(define-method (on-key-release (mux <scene-mux>) key scancode modifiers)
  (on-key-release (current-scene mux) key scancode modifiers))

(define-method (on-text-input (mux <scene-mux>) text)
  (on-text-input (current-scene mux) text))

(define-method (on-mouse-press (mux <scene-mux>) button clicks x y)
  (on-mouse-press (current-scene mux) button clicks x y))

(define-method (on-mouse-release (mux <scene-mux>) button x y)
  (on-mouse-release (current-scene mux) button x y))

(define-method (on-mouse-move (mux <scene-mux>) x y x-rel y-rel buttons)
  (on-mouse-move (current-scene mux) x y x-rel y-rel buttons))

(define-method (on-controller-add (mux <scene-mux>) controller)
  (on-controller-add (current-scene mux) controller))

(define-method (on-controller-remove (mux <scene-mux>) controller)
  (on-controller-remove (current-scene mux) controller))

(define-method (on-controller-press (mux <scene-mux>) controller button)
  (on-controller-press (current-scene mux) controller button))

(define-method (on-controller-release (mux <scene-mux>) controller button)
  (on-controller-release (current-scene mux) controller button))

(define-method (on-controller-move (mux <scene-mux>) controller axis value)
  (on-controller-move (current-scene mux) controller axis value))