From 313b20c51185618e7e2a6a5ae105fe2f04612b92 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Tue, 28 Aug 2018 09:06:27 -0400
Subject: Add scene transitions.

---
 Makefile.am             |  3 +-
 starling/transition.scm | 80 +++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 82 insertions(+), 1 deletion(-)
 create mode 100644 starling/transition.scm

diff --git a/Makefile.am b/Makefile.am
index b755a59..25798e0 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -44,7 +44,8 @@ SOURCES = 					\
   starling/scene.scm				\
   starling/repl.scm				\
   starling/kernel.scm				\
-  starling/node-2d.scm
+  starling/node-2d.scm				\
+  starling/transition.scm
 
 EXTRA_DIST += 					\
   COPYING
diff --git a/starling/transition.scm b/starling/transition.scm
new file mode 100644
index 0000000..0d70e2f
--- /dev/null
+++ b/starling/transition.scm
@@ -0,0 +1,80 @@
+;;; 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 (oop goops)
+  #:use-module (starling kernel)
+  #:use-module (starling node)
+  #:use-module (starling node-2d)
+  #:use-module (starling scene)
+  #:export (<transition>
+            scene-from
+            scene-to
+            duration
+
+            <fade-transition>))
+
+(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))))
-- 
cgit v1.2.3