blob: 9129372a8955e5454be872484ab8f16b197316c6 (
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
|
;;; 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))))
|
