summaryrefslogtreecommitdiff
path: root/starling/transition.scm
blob: f673d9cd4274799be2e4ec11a692881ef37d8f41 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
;;; 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:
;;
;; Scene transitions.
;;
;;; Code:

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

            <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))

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


;;;
;;; Transitions
;;;

(define-class <transition> (<scene>)
  (scene-from #:getter scene-from #:init-keyword #:from)
  (scene-to #:getter scene-to #:init-keyword #:to)
  (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))))