summaryrefslogtreecommitdiff
path: root/starling/transition.scm
blob: e3681763a103cac7063336d3b79879d21bc719bc (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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
;;; 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) #:select (make-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
            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))))