;;; 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:
;;
;; Scene transitions.
;;
;;; Code:

(define-module (lisparuga transition)
  #:use-module (chickadee math rect)
  #:use-module ((chickadee render color) #:select (make-color))
  #:use-module (chickadee scripting)
  #:use-module (ice-9 match)
  #:use-module (oop goops)
  #:use-module (lisparuga kernel)
  #:use-module (lisparuga node)
  #:use-module (lisparuga node-2d)
  #:use-module (lisparuga scene)
  #:export (<sequence-scene>
            scenes
            last-scene
            transition

            <transition>
            scene-from
            scene-to
            duration

            <fade-transition>))


;;;
;;; Sequence
;;;

;; Not a transition like all the others, but still a form of
;; transitioning scenes.

(define-class <sequence-scene> (<scene>)
  (scenes #:accessor scenes #:init-keyword #:scenes)
  (last-scene #:accessor last-scene #:init-form #f)
  (transition #:accessor transition #:init-keyword #:transition
              #:init-form default-sequence-transition))

(define (default-sequence-transition from to)
  ;; Return the 'to' scene as-is, which means there is no transition
  ;; at all.
  to)

(define-method (on-enter (sequence <sequence-scene>))
  (define (next-scene-transition scene)
    (let ((last (last-scene sequence)))
      (if last
          ((transition sequence) last scene)
          scene)))
  (match (scenes sequence)
    ((scene)
     ;; If we've reached the last scene, we're done!
     (replace-scene (next-scene-transition scene)))
    ((scene . rest)
     (let ((next-scene (next-scene-transition scene)))
       (set! (scenes sequence) rest)
       (set! (last-scene sequence) scene)
       (push-scene next-scene)))))


;;;
;;; Transitions
;;;

(define-class <transition> (<scene>)
  (scene-from #:getter scene-from #:init-keyword #:from
              #:init-thunk current-scene)
  (scene-to #:getter scene-to #:init-keyword #:to
            #:init-thunk previous-scene)
  (duration #:getter duration #:init-keyword #:duration))

(define-generic do-transition)

(define-method (on-boot (transition <transition>))
  (attach-to transition (make <canvas> #:name 'canvas)))

(define-method (on-enter (transition <transition>))
  (script
   (attach-to (& transition canvas)
              (scene-from transition)
              (scene-to transition))
   (do-transition transition)
   (detach (scene-from transition))
   (detach (scene-to transition))
   (replace-scene (scene-to transition))))

(define-class <fade-transition> (<transition>))

(define-method (on-boot (fade <fade-transition>))
  (next-method)
  (attach-to (& fade canvas)
             (make <filled-rect>
               #:name 'rect
               #:region (make-rect 0.0 0.0 640.0 480.0)
               #:rank 9999)))

(define-method (do-transition (fade <fade-transition>))
  (let ((half-duration (inexact->exact (round (/ (duration fade) 2))))
        (rect (& fade canvas rect)))
    (define (set-alpha! alpha)
      (set! (color rect) (make-color 0 0 0 alpha)))
    (hide (scene-to fade))
    (show (scene-from fade))
    (tween half-duration 0.0 1.0 set-alpha!)
    (hide (scene-from fade))
    (show (scene-to fade))
    (tween half-duration 1.0 0.0 set-alpha!)
    (show (scene-from fade))))