1 files changed, 60 insertions, 0 deletions
diff --git a/apple-town-fair/common.scm b/apple-town-fair/common.scm
new file mode 100644
index 0000000..5fe5bb3
--- /dev/null
+++ b/apple-town-fair/common.scm
@@ -0,0 +1,60 @@
+;;; Copyright © 2022 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 this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+(define-module (apple-town-fair common)
+  #:use-module (apple-town-fair config)
+  #:use-module (chickadee)
+  #:use-module (chickadee graphics color)
+  #:use-module (chickadee graphics path)
+  #:use-module (chickadee math vector)
+  #:use-module (chickadee scripting)
+  #:use-module (oop goops)
+  #:use-module (catbird scene)
+  #:use-module (catbird node)
+  #:use-module (catbird node-2d)
+  #:export (steps
+            full-screen-rectangle
+            fade-in
+            fade-out))
+
+(define (steps n)
+  (* n (current-timestep)))
+
+(define (full-screen-rectangle color)
+  (with-style ((fill-color color))
+    (fill
+     (rectangle (vec2 0.0 0.0) %game-width %game-height))))
+
+(define (black-alpha alpha)
+  (make-color 0.0 0.0 0.0 alpha))
+
+(define (fade scene start-alpha end-alpha duration)
+  (let ((bg (make <canvas>
+              #:rank 999
+              #:painter (full-screen-rectangle
+                         (black-alpha start-alpha)))))
+    (attach-to scene bg)
+    (tween duration start-alpha end-alpha
+           (lambda (a)
+             (set! (painter bg)
+                   (full-screen-rectangle
+                    (black-alpha a)))))
+    (detach bg)))
+
+(define-method (fade-in (scene <scene>) duration)
+  (fade scene 1.0 0.0 duration))
+
+(define-method (fade-out (scene <scene>) duration)
+  (fade scene 0.0 1.0 duration))