Add simple scripting system.

* chickadee/scripting.scm: New file.
* chickadee/scripting/agenda.scm: New file.
* chickadee/scripting/coroutine.scm: New file.
* Makefile.am (SOURCES): Add them.

6 files changed, 571 insertions, 0 deletions

diff --git a/Makefile.am b/Makefile.am
index 6b52cb7..82c6f83 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -65,6 +65,10 @@ SOURCES = 					\
   chickadee/render/font.scm			\
   chickadee/render.scm				\
   chickadee/window.scm				\
+  chickadee/scripting/agenda.scm		\
+  chickadee/scripting/coroutine.scm		\
+  chickadee/scripting/channel.scm		\
+  chickadee/scripting.scm			\
   chickadee.scm
 
 EXTRA_DIST += 					\
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))))))
diff --git a/chickadee/scripting/agenda.scm b/chickadee/scripting/agenda.scm
new file mode 100644
index 0000000..c815afa
--- /dev/null
+++ b/chickadee/scripting/agenda.scm
@@ -0,0 +1,100 @@
+;;; 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 agenda)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-9)
+  #:use-module (chickadee heap)
+  #:export (make-agenda
+            agenda?
+            current-agenda
+            with-agenda
+            agenda-time
+            update-agenda
+            clear-agenda
+            schedule-at
+            schedule-after
+            at
+            after))
+
+(define-record-type <agenda>
+  (%make-agenda time queue)
+  agenda?
+  (time %agenda-time set-agenda-time!)
+  (queue agenda-queue))
+
+(define (task< a b)
+  (< (car a) (car b)))
+
+(define (make-agenda)
+  "Return a new task scheduler."
+  (%make-agenda 0 (make-heap task<)))
+
+(define (schedule agenda time thunk)
+  (when (<= time (%agenda-time agenda))
+    (error "cannot schedule in the past" time))
+  (heap-insert! (agenda-queue agenda) (cons time thunk)))
+
+(define (%agenda-clear! agenda)
+  (heap-clear! (agenda-queue agenda))
+  (set-agenda-time! agenda 0)
+  *unspecified*)
+
+(define (%update-agenda agenda dt)
+  (let ((queue (agenda-queue agenda))
+        (time (+ (%agenda-time agenda) dt)))
+    (set-agenda-time! agenda time)
+    (let loop ()
+      (when (not (heap-empty? queue))
+        (match (heap-min queue)
+          ((task-time . thunk)
+           (when (<= task-time time)
+             (heap-remove! queue)
+             (thunk)
+             (loop))))))))
+
+(define current-agenda (make-parameter (make-agenda)))
+
+(define-syntax-rule (with-agenda agenda body ...)
+  (parameterize ((current-agenda agenda))
+    body ...))
+
+(define (agenda-time)
+  "Return the current agenda time."
+  (%agenda-time (current-agenda)))
+
+(define (clear-agenda)
+  "Remove all scheduled tasks from the current agenda."
+  (%agenda-clear! (current-agenda)))
+
+(define (update-agenda dt)
+  "Advance the current agenda by DT."
+  (%update-agenda (current-agenda) dt))
+
+(define (schedule-at time thunk)
+  "Schedule THUNK to be run at TIME."
+  (schedule (current-agenda) time thunk))
+
+(define (schedule-after delay thunk)
+  "Schedule THUNK to be run after DELAY."
+  (schedule (current-agenda) (+ (agenda-time) delay) thunk))
+
+(define-syntax-rule (at time body ...)
+  (schedule-at time (lambda () body ...)))
+
+(define-syntax-rule (after delay body ...)
+  (schedule-after delay (lambda () body ...)))
diff --git a/chickadee/scripting/channel.scm b/chickadee/scripting/channel.scm
new file mode 100644
index 0000000..0c78ffa
--- /dev/null
+++ b/chickadee/scripting/channel.scm
@@ -0,0 +1,74 @@
+;;; 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 channel)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (srfi srfi-11)
+  #:use-module (chickadee queue)
+  #:use-module (chickadee scripting coroutine)
+  #:export (make-channel
+            channel?
+            channel-get
+            channel-put))
+
+;; A very simplified notion of channels compared to guile-fibers.  In
+;; our case, everything is cooperative and on the same thread, so we
+;; have less to worry about.
+(define-record-type <channel>
+  (%make-channel get-queue put-queue)
+  channel?
+  (get-queue channel-get-queue)
+  (put-queue channel-put-queue))
+
+(define (display-channel channel port)
+  (display "<channel>" port))
+
+(set-record-type-printer! <channel> display-channel)
+
+(define (make-channel)
+  "Return a new channel."
+  (%make-channel (make-queue) (make-queue)))
+
+(define (maybe-deliver channel)
+  (let ((getq (channel-get-queue channel))
+        (putq (channel-put-queue channel)))
+    (if (and (not (queue-empty? getq))
+             (not (queue-empty? putq)))
+        (match (dequeue! putq)
+          ((data . put-cont)
+           (let ((get-cont (dequeue! getq)))
+             (get-cont data)
+             (put-cont)))))))
+
+(define (channel-get channel)
+  "Retrieve a value from CHANNEL.  The current coroutine suspends
+until a value is available."
+  (yield
+   (lambda (cont)
+     (enqueue! (channel-get-queue channel) cont)
+     (maybe-deliver channel))))
+
+(define (channel-put channel data)
+  "Send DATA to CHANNEL.  The current coroutine suspends until another
+coroutine is available to retrieve the value."
+  (yield
+   (lambda (cont)
+     (enqueue! (channel-put-queue channel) (cons data cont))
+     (maybe-deliver channel))))
diff --git a/chickadee/scripting/coroutine.scm b/chickadee/scripting/coroutine.scm
new file mode 100644
index 0000000..38f0da0
--- /dev/null
+++ b/chickadee/scripting/coroutine.scm
@@ -0,0 +1,88 @@
+;;; 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 coroutine)
+  #:use-module (ice-9 format)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:export (coroutine?
+            coroutine-cancelled?
+            coroutine-running?
+            coroutine-complete?
+            spawn-coroutine
+            coroutine
+            cancel-coroutine
+            yield)
+  #:replace (yield))
+
+(define-record-type <coroutine>
+  (make-coroutine status)
+  coroutine?
+  (status coroutine-status set-coroutine-status!))
+
+(define (display-coroutine co port)
+  (format port "<coroutine status: ~a>" (coroutine-status co)))
+
+(set-record-type-printer! <coroutine> display-coroutine)
+
+(define (coroutine-cancelled? co)
+  "Return #t if CO has been cancelled."
+  (eq? 'cancelled (coroutine-status co)))
+
+(define (coroutine-running? co)
+  "Return #t if CO has not yet terminated or been cancelled."
+  (eq? 'cancelled (coroutine-status co)))
+
+(define (coroutine-complete? co)
+  "Return #t if CO has terminated."
+  (eq? 'cancelled (coroutine-status co)))
+
+(define (cancel-coroutine co)
+  "Prevent further execution of CO."
+  (set-coroutine-status! co 'cancelled)
+  *unspecified*)
+
+(define coroutine-prompt (make-prompt-tag 'coroutine))
+
+(define (spawn-coroutine thunk)
+  "Apply THUNK as a coroutine."
+  (let ((co (make-coroutine 'running)))
+    (define (handler cont callback . args)
+      (define (resume . args)
+        ;; Call continuation that resumes the procedure, unless, of
+        ;; course, the coroutine has been cancelled in the meantime.
+        (unless (coroutine-cancelled? co)
+          (call-with-prompt coroutine-prompt
+            (lambda () (apply cont args))
+            handler)))
+      (when (procedure? callback)
+        (apply callback resume args)))
+    (define (task)
+      (thunk)
+      (set-coroutine-status! co 'complete))
+    ;; Start the coroutine.
+    (call-with-prompt coroutine-prompt task handler)
+    co))
+
+(define-syntax-rule (coroutine body ...)
+  "Evaluate BODY in a coroutine."
+  (spawn-coroutine (lambda () body ...)))
+
+(define (yield handler)
+  "Suspend the current coroutine and pass its continuation to the
+procedure HANDLER."
+  (abort-to-prompt coroutine-prompt handler))
diff --git a/doc/api.texi b/doc/api.texi
index 74ccfff..9c568d5 100644
--- a/doc/api.texi
+++ b/doc/api.texi
@@ -4,6 +4,7 @@
 * Math::                        Linear algebra and more.
 * Graphics::                    Eye candy.
 * Audio::                       Sound effects and music.
+* Scripting::                   Bringing the game world to life.
 @end menu
 
 @node Kernel
@@ -832,3 +833,254 @@ Return @code{#t} if music is currently playing.
 @deffn {Scheme Procedure} music-paused?
 Return @code{#t} if music is currently paused.
 @end deffn
+
+@node Scripting
+@section Scripting
+
+Game logic is a web of asynchronous events that are carefully
+coordinated to bring the game world to life.  In order to make an
+enemy follow and attack the player, or move an NPC back and forth in
+front of the item shop, or do both at the same time, a scripting
+system is a necessity.  Chickadee comes with an asynchronous
+programming system in the @code{(chickadee scripting)} module.
+Lightweight, cooperative threads known as ``coroutines'' allow the
+programmer to write asynchronous code as if it were synchronous, and
+allow many such ``threads'' to run concurrently.
+
+But before we dig deeper into coroutines, let's discuss the simple act
+of scheduling tasks.
+
+@menu
+* Agendas::                     Scheduling tasks.
+* Coroutines::                  Cooperative multitasking.
+* Channels::                    Publish data to listeners.
+@end menu
+
+@node Agendas
+@subsection Agendas
+
+To schedule a task to be performed later, an ``agenda'' is used.
+There is a default, global agenda that is ready to be used, or
+additional agendas may be created for different purposes.  The
+following example prints the text ``hello'' when the agenda has
+advanced to time unit 10.
+
+@example
+(at 10 (display "hello\n"))
+@end example
+
+Most of the time it is more convenient to schedule tasks relative to
+the current time.  This is where @code{after} comes in handy:
+
+@example
+(after 10 (display "hello\n"))
+@end example
+
+Time units in the agenda are in no way connected to real time.  It's
+up to the programmer to decide what agenda time means.  A simple and
+effective approach is to map each call of the update hook
+(@pxref{Kernel}) to 1 unit of agenda time, like so:
+
+@example
+(add-hook! update-hook (lambda (dt) (update-agenda 1)))
+@end example
+
+It is important to call @code{update-agenda} periodically, otherwise
+no tasks will ever be run!
+
+In addition to using the global agenda, it is useful to have multiple
+agendas for different purposes.  For example, the game world can use a
+different agenda than the user interface, so that pausing the game is
+a simple matter of not updating the world's agenda while continuing to
+update the user interface's agenda.  The current agenda is dynamically
+scoped and can be changed using the @code{with-agenda} special form:
+
+@example
+(define game-world-agenda (make-agenda))
+
+(with-agenda game-world-agenda
+  (at 60 (spawn-goblin))
+  (at 120 (spawn-goblin))
+  (at 240 (spawn-goblin-king)))
+@end example
+
+@deffn {Scheme Procedure} make-agenda
+Return a new task scheduler.
+@end deffn
+
+@deffn {Scheme Procedure} agenda? @var{obj}
+Return @code{#t} if @var{obj} is an agenda.
+@end deffn
+
+@deffn {Scheme Procedure} current-agenda
+@deffnx {Scheme Procedure} current-agenda @var{agenda}
+When called with no arguments, return the current agenda.  When called
+with one argument, set the current agenda to @var{agenda}.
+@end deffn
+
+@deffn {Scheme Syntax} with-agenda @var{agenda} @var{body} @dots{}
+Evaluate @var{body} with the current agenda set to @var{agenda}.
+@end deffn
+
+@deffn {Scheme Procedure} agenda-time
+Return the current agenda time.
+@end deffn
+
+@deffn {Scheme Procedure} update-agenda @var{dt}
+Advance the current agenda by @var{dt}.
+@end deffn
+
+@deffn {Scheme Procedure} schedule-at @var{time} @var{thunk}
+Schedule @var{thunk}, a procedure of zero arguments, to be run at
+@var{time}.
+@end deffn
+
+@deffn {Scheme Procedure} schedule-after @var{delay} @var{thunk}
+Schedule @var{thunk}, a procedure of zero arguments, to be run after
+@var{delay}.
+@end deffn
+
+@deffn {Scheme Syntax} at @var{time} @var{body} @dots{}
+Schedule @var{body} to be evaluated at @var{time}.
+@end deffn
+
+@deffn {Scheme Syntax} after @var{delay} @var{body} @dots{}
+Schedule @var{body} to be evaluated after @var{delay}.
+@end deffn
+
+@node Coroutines
+@subsection Coroutines
+
+Now that we can schedule tasks, let's take things to the next level.
+It sure would be great if we could make procedures that described a
+series of actions that happened over time, especially if we could do
+so without contorting our code into a nest of callback procedures.
+This is where coroutines come in.  With coroutines we can write code
+in a linear way, in a manner that appears to be synchronous, but with
+the ability to suspend periodically in order to let other coroutines
+have a turn and prevent blocking the game loop.  Building on top of
+the scheduling that agendas provide, here is a coroutine that models a
+child trying to get their mother's attention:
+
+@example
+(coroutine
+  (while #t
+    (display "mom!")
+    (newline)
+    (wait 60))) ; where 60 = 1 second of real time
+@end example
+
+This code runs in an endless loop, but the @code{wait} procedure
+suspends the coroutine and schedules it to be run later by the agenda.
+So, after each iteration of the loop, control is returned back to the
+game loop and the program is not stuck spinning in a loop that will
+never exit.  Pretty neat, eh?
+
+Coroutines can suspend to any capable handler, not just the agenda.
+The @code{yield} procedure will suspend the current coroutine and pass
+its ``continuation'' to a handler procedure.  This handler procedure
+could do anything.  Perhaps the handler stashes the continuation
+somewhere where it will be resumed when the user presses a specific
+key on the keyboard, or maybe it will be resumed when the player picks
+up an item off of the dungeon floor; the sky is the limit.
+
+Sometimes it is necessary to abruptly terminate a coroutine after it
+has been started.  For example, when an enemy is defeated their AI
+routine needs to be shut down.  When a coroutine is spawned, a handle
+to that coroutine is returned that can be used to cancel it when
+desired.
+
+@example
+(define co (coroutine (while #t (display "hey\n") (wait 60))))
+;; sometime later
+(cancel-coroutine co)
+@end example
+
+@deffn {Scheme Procedure} spawn-coroutine @var{thunk}
+Apply @var{thunk} as a coroutine and return a handle to it.
+@end deffn
+
+@deffn {Scheme Syntax} coroutine @var{body} @dots{}
+Evaluate @var{body} as a coroutine and return a handle to it.
+@end deffn
+
+@deffn {Scheme Procedure} coroutine? @var{obj}
+Return @code{#t} if @var{obj} is a coroutine handle.
+@end deffn
+
+@deffn {Scheme Procedure} coroutine-cancelled? @var{obj}
+Return @code{#t} if @var{obj} has been cancelled.
+@end deffn
+
+@deffn {Scheme Procedure} coroutine-running? @var{obj}
+Return @code{#t} if @var{obj} has not yet terminated or been
+cancelled.
+@end deffn
+
+@deffn {Scheme Procedure} coroutine-complete? @var{obj}
+Return @code{#t} if @var{obj} has terminated.
+@end deffn
+
+@deffn {Scheme Procedure} cancel-coroutine @var{co}
+Prevent further execution of the coroutine @var{co}.
+@end deffn
+
+@deffn {Scheme Procedure} yield @var{handler}
+Suspend the current coroutine and pass its continuation to the
+procedure @var{handler}.
+@end deffn
+
+@deffn {Scheme Procedure} wait @var{duration}
+Wait @var{duration} before resuming the current coroutine.
+@end deffn
+
+@deffn {Scheme Procedure} channel-get @var{channel}
+Wait for a message from @var{channel}.
+@end deffn
+
+@deffn {Scheme Syntax} forever @var{body} @dots{}
+Evaluate @var{body} in an endless loop.
+@end deffn
+
+@node Channels
+@subsection Channels
+
+Channels are a tool for communicating amongst different coroutines.
+One coroutine can write a value to the channel and another can read
+from it.  Reading or writing to a channel suspends that coroutine
+until there is someone on the other end of the line to complete the
+transaction.
+
+Here's a simplistic example:
+
+@example
+(define c (make-channel))
+
+(coroutine
+ (forever
+  (let ((item (channel-get c)))
+    (pk 'got item))))
+
+(coroutine
+ (channel-put c 'sword)
+ (channel-put c 'shield)
+ (channel-put c 'potion))
+@end example
+
+@deffn {Scheme Procedure} make-channel
+Return a new channel
+@end deffn
+
+@deffn {Scheme Procedure} channel? @var{obj}
+Return @code{#t} if @var{obj} is a channel.
+@end deffn
+
+@deffn {Scheme Procedure} channel-get @var{channel}
+Retrieve a value from @var{channel}.  The current coroutine suspends
+until a value is available.
+@end deffn
+
+@deffn {Scheme Procedure} channel-put @var{channel} @var{data}
+Send @var{data} to @var{channel}.  The current coroutine suspends
+until another coroutine is available to retrieve the value.
+@end deffn