From 6a182194d6bf70dac37e18d4c63c56314018147c Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sat, 1 Apr 2017 12:02:17 -0400 Subject: 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. --- Makefile.am | 4 + chickadee/scripting.scm | 53 ++++++++ chickadee/scripting/agenda.scm | 100 +++++++++++++++ chickadee/scripting/channel.scm | 74 +++++++++++ chickadee/scripting/coroutine.scm | 88 +++++++++++++ doc/api.texi | 252 ++++++++++++++++++++++++++++++++++++++ 6 files changed, 571 insertions(+) create mode 100644 chickadee/scripting.scm create mode 100644 chickadee/scripting/agenda.scm create mode 100644 chickadee/scripting/channel.scm create mode 100644 chickadee/scripting/coroutine.scm 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 +;;; +;;; 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 +;;; . + +(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 +;;; +;;; 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 +;;; . + +(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 + (%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 +;;; +;;; 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 +;;; . + +(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 + (%make-channel get-queue put-queue) + channel? + (get-queue channel-get-queue) + (put-queue channel-put-queue)) + +(define (display-channel channel port) + (display "" port)) + +(set-record-type-printer! 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 +;;; +;;; 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 +;;; . + +(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 + (make-coroutine status) + coroutine? + (status coroutine-status set-coroutine-status!)) + +(define (display-coroutine co port) + (format port "" (coroutine-status co))) + +(set-record-type-printer! 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 -- cgit v1.2.3