1 files changed, 53 insertions, 0 deletions
diff --git a/chickadee/scripting.scm b/chickadee/scripting.scm
new file mode 100644
index 0000000..7a661bb
--- /dev/null
+++ b/chickadee/scripting.scm
@@ -0,0 +1,53 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2017 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee 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.
+;;;
+;;; Chickadee 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 (chickadee scripting)
+  #:use-module (chickadee scripting agenda)
+  #:use-module (chickadee scripting channel)
+  #:use-module (chickadee scripting coroutine)
+  #:export (forever
+            wait
+            tween))
+
+;; Export public bindings from other modules.
+(eval-when (eval load compile)
+  (begin
+    (define %public-modules
+      '(agenda channel coroutine))
+    (for-each (let ((i (module-public-interface (current-module))))
+                (lambda (m)
+                  (module-use! i (resolve-interface
+                                  `(chickadee scripting ,m)))))
+              %public-modules)))
+
+(define-syntax-rule (forever body ...)
+  "Evaluate BODY in an endless loop."
+  (while #t body ...))
+
+(define (wait duration)
+  "Wait DURATION before resuming the current coroutine."
+  (yield (lambda (cont) (schedule-after duration cont))))
+
+(define (tween duration start end ease proc)
+  (let loop ((t 0))
+    (if (= t duration)
+        (proc end)
+        (let ((alpha (/ t duration)))
+          (proc (+ (* start (- 1 alpha))
+                   (* end alpha)))
+          (wait 1)
+          (loop (1+ t))))))