;;; Starling Game Engine
;;; Copyright © 2018 David Thompson <davet@gnu.org>
;;;
;;; This program 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.
;;;
;;; This program 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 Starling.  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 (starling scene)
  #:use-module (chickadee)
  #:use-module (chickadee audio)
  #:use-module (ice-9 match)
  #:use-module (oop goops)
  #:use-module (starling 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-thunk make-source)
  (background-music #:accessor background-music #:init-form #f
                    #:init-keyword #:music #:asset? #t #:watch? #t)
  (background-music-volume #:accessor background-music-volume #:init-form 1.0
                           #:init-keyword #:music-volume #:watch? #t)
  (background-music-loop? #:accessor background-music-loop? #:init-form #t
                          #:init-keyword #:music-loop? #:watch? #t))

(define-method (refresh-background-music (scene <scene>))
  (let ((source (background-music-source scene)))
    (set-source-volume! source (background-music-volume scene))
    (set-source-loop! source (background-music-loop? scene))
    (when (audio? (background-music scene))
      (set-source-audio! source (background-music scene))
      (if (active? scene)
          (source-play source)
          (source-stop source)))))

(define-method (on-change (scene <scene>) slot-name old new)
  (case slot-name
    ((background-music background-music-volume background-music-loop?)
     (refresh-background-music scene))
    (else
     (next-method))))

(define-method (on-enter (scene <scene>))
  (refresh-background-music 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 modifiers repeat?)
  #t)

(define-method (on-key-release (scene <scene>) key 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-detach (mux <scene-mux>) (scene <scene>))
  (when (eq? scene (current-scene mux))
    (error "current scene improperly detached.  use push/pop/replace-scene instead.")))

(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 modifiers repeat?)
  (on-key-press (current-scene mux) key modifiers repeat?))

(define-method (on-key-release (mux <scene-mux>) key modifiers)
  (on-key-release (current-scene mux) key 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))