From 2c5b19226815a406c60cc1a49c59864922364c55 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@vistahigherlearning.com>
Date: Fri, 10 Apr 2020 08:55:50 -0400
Subject: Add project skeleton and import engine code.

---
 lisparuga/transition.scm | 128 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 128 insertions(+)
 create mode 100644 lisparuga/transition.scm

(limited to 'lisparuga/transition.scm')

diff --git a/lisparuga/transition.scm b/lisparuga/transition.scm
new file mode 100644
index 0000000..9129372
--- /dev/null
+++ b/lisparuga/transition.scm
@@ -0,0 +1,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))))
-- 
cgit v1.2.3