1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
|
;;; Sly
;;; Copyright © 2016 David Thompson <davet@gnu.org>
;;;
;;; Sly 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.
;;;
;;; Sly 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/>.
;;; Commentary:
;;
;; Purely functional game object scripting.
;;
;; Inspired by https://github.com/brandonbloom/bulletcombinators/
;;
;;; Code:
(define-module (sly actor)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
#:export (make-actor
actor?
actor-ref
actor-action
update-actor
actor-filter-update
call-with-actor
apply-effects
action-lift
action-effect-lift
idle
both
then
forever
repeat
wait
ifa
whena
sequence
together))
;;;
;;; Actors
;;;
(define-record-type <actor>
(make-actor object action)
actor?
(object actor-ref)
(action actor-action))
(define (update-actor world effects actor)
"Apply the action for ACTOR with the given WORLD, the game world
object, and EFFECTS, the effects list."
(match actor
(($ <actor> _ #f)
(values effects actor))
(($ <actor> object action)
(let-values (((new-action new-effects new-object)
(action world effects object)))
(values new-effects (make-actor new-object new-action))))))
(define (actor-filter-update predicate world actors)
"Update each actor in the list ACTORS with respect to WORLD and
return a new list of actors whose objects satisfy PREDICATE."
(let loop ((actors actors)
(effects '())
(results '()))
(match actors
(() (values (reverse effects)
(reverse results)))
((actor . rest)
(let-values (((effects actor) (update-actor world effects actor)))
(if (predicate (actor-ref actor))
(loop rest effects (cons actor results))
(loop rest effects results)))))))
(define (call-with-actor actor proc)
"Apply PROC with the object stored in ACTOR and return a new actor
containing the value returned from PROC."
(let ((new (proc (actor-ref actor))))
(make-actor new (actor-action actor))))
(define (apply-effects effects world)
"Apply each effect procedure in EFFECTS using WORLD as an initial
value. Each successive effect is applied with the world returned by
the previous effect."
(fold (lambda (effect world) (effect world))
world
effects))
;;;
;;; Actions
;;;
(define (action-lift proc)
"Create an action constructor from PROC, a procedure of any number
of arguments whose first argument is the game object being
transformed."
(lambda args
(lambda (world effects object)
(values #f
effects
(apply proc object args)))))
(define (action-effect-lift proc)
"Create an action constructor from PROC, a procedure of any number
of arguments, whose first two arguments are the world being
transformed and the game object being acted upon. The actions
returned from this new procedure specify that PROC should be performed
as an effect on the world, and do not change the actor itself."
(lambda args
(lambda (world effects object)
(values #f
(list (lambda (world) (apply proc world object args)))
object))))
(define (idle world effects object)
"Do nothing. Do not change OBJECT nor add anything to EFFECTS."
(values #f effects object))
(define (both a b)
"Peform action A immediately followed by action B. When the action
is run, the remainder of both A and B are returned as the next action
to perform."
(lambda (world effects object)
(let-values (((next new-effects new-object)
(a world effects object)))
(if next
(let-values (((next* new-effects* new-object*)
(b world new-effects new-object)))
(values (if next* (both next next*) next)
new-effects*
new-object*))
(b world new-effects new-object)))))
(define (then a b)
"Perform action A followed by action B. Unlike 'both', action B is
not performed immediately after A finishes, but rather requires
another tick."
(lambda (world effects object)
(let-values (((next new-effects new-object)
(a world effects object)))
(values (if next (then next b) b)
new-effects
new-object))))
(define (forever action)
"Perform ACTION in an infinite loop."
(define (forever world effects object)
(let-values (((next new-effects new-object)
(action world effects object)))
(values (if next (then next forever) forever) ; memoize?
new-effects
new-object)))
forever)
(define (repeat times action)
"Perform ACTION TIMES times in a row."
(cond ((zero? times) idle)
((= times 1) action)
(else (then action (repeat (1- times) action)))))
(define (wait duration)
"Do nothing DURATION times."
(repeat duration idle))
(define (ifa predicate consequent alternate)
"Create an action that performs CONSEQUENT if PREDICATE is
satisfied, or ALTERNATE otherwise. PREDICATE is a procedure that
accepts a single argument: The game object stored within the actor
that is performing the action."
(lambda (world effects object)
(let ((action (if (predicate object) consequent alternate)))
(action world effects object))))
(define (whena predicate consequent)
"Create an action that performs CONSEQUENT when PREDICATE is
satisfied, otherwise nothing is done."
(ifa predicate consequent idle))
(define (unlessa predicate alternate)
"Create an action that performs ALTERNATE unless PREDICATE is
satisfied, otherwise nothing is done."
(ifa predicate idle alternate))
(define (sequence . actions)
"Create an action that sequentially performs each action in
ACTIONS."
(let loop ((actions actions))
(match actions
(() idle)
((action) action)
((action . rest)
(then action (loop rest))))))
(define (together . actions)
"Create an action that concurrently performs each action in
ACTIONS."
(let loop ((actions actions))
(match actions
(() idle)
((action) action)
((action . rest)
(both action (loop rest))))))
|
