summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile.am4
-rw-r--r--chickadee/scripting.scm53
-rw-r--r--chickadee/scripting/agenda.scm100
-rw-r--r--chickadee/scripting/channel.scm74
-rw-r--r--chickadee/scripting/coroutine.scm88
-rw-r--r--doc/api.texi252
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