1 ;;; 8sync --- Asynchronous programming for Guile
2 ;;; Copyright © 2016, 2017 Christopher Allan Webber <cwebber@dustycloud.org>
4 ;;; This file is part of 8sync.
6 ;;; 8sync is free software: you can redistribute it and/or modify it
7 ;;; under the terms of the GNU Lesser General Public License as
8 ;;; published by the Free Software Foundation, either version 3 of the
9 ;;; License, or (at your option) any later version.
11 ;;; 8sync is distributed in the hope that it will be useful,
12 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;;; GNU Lesser General Public License for more details.
16 ;;; You should have received a copy of the GNU Lesser General Public
17 ;;; License along with 8sync. If not, see <http://www.gnu.org/licenses/>.
19 ;;; =====================================================================
20 ;;; Robot Scanner test demo (from XUDD, originally).
22 ;;; Here's the premise. There's a warehouse full of droids, some
23 ;;; infected, and some not. The SecurityRobot is being sent in to clean
24 ;;; up the mess. It's capable of sending a message that infected droids
25 ;;; are susceptible to responding in a predictable way. Once it has
26 ;;; identified that a droid is infected, it shoots it full of holes till
27 ;;; the droid is terminated. The SecurityRobot goes from room to room
28 ;;; till things are cleared out.
30 ;;; Overseeing the operation is the "overseer". The security robot keeps
31 ;;; the overseer up to date on its progress as it goes. (For this demo,
32 ;;; the overseer is also responsible for initializing the world and
33 ;;; reporting info back to the user.)
34 ;;; =====================================================================
36 (use-modules (8sync actors)
41 (set! *random-state* (random-state-from-platform))
43 (define room-structure
44 ;; A list of (clean-droids infected-droids)
51 (define-actor <overseer> (<actor>)
53 (lambda (actor message)
54 ;; Porting mostly straight up from super-imperative XUDD code.
55 (define previous-room #f)
56 (define first-room #f)
61 ((clean-droids infected-droids)
63 (define room (create-actor* <warehouse-room> "room"))
64 (define* (init-droid #:key infected)
65 (define droid (create-actor* <droid> "droid"
68 (<-wait droid 'register-with-room))
71 ;; Couldn't this just be folded into the warehouse room init?
72 ;; I guess it stress tests more the message sending process
74 (<- previous-room 'set-next-room
76 (<- room 'set-previous-room
79 ;; Set up clean droids in the room
82 (init-droid #:infected #f))
85 ;; Set up infected droids in the room
88 (init-droid #:infected #t))
91 (set! previous-room room)
93 (set! first-room room))))
98 (create-actor <security-robot>)))
99 (<- security-robot 'begin-mission
100 #:starting-room first-room
101 #:overseer (actor-id actor)))))
104 (lambda* (actor message #:key text)
108 (lambda* (actor message)
109 (signal-condition! (.done? actor)))))
110 (done? #:init-keyword #:done?
114 ;;; A room full of robots.
115 (define-class <warehouse-room> (<actor>)
116 (droids #:init-value '())
117 (next-room #:init-value #f)
118 (previous-room #:init-value #f)
121 #:allocation #:each-subclass
125 (lambda* (actor message #:key id)
126 "Set the room following this"
127 (slot-set! actor 'next-room id)))
130 (lambda* (actor message #:key id)
131 "Set the room previous to this"
132 (slot-set! actor 'previous-room id)))
135 (lambda (actor message)
136 "Return a reference to the link following this"
137 (slot-ref actor 'next-room)))
140 (lambda (actor message)
141 "Return a reference to the link preceding this"
142 (slot-ref actor 'previous-room)))
145 (lambda (actor message)
146 "Return a list of all the droid ids we know of in this room"
147 (slot-ref actor 'droids)))
150 (lambda* (actor message #:key droid-id)
151 "Register a droid as being in this room"
152 (slot-set! actor 'droids
154 (slot-ref actor 'droids))))))))
157 ;;; A droid that may or may not be infected!
158 ;;; What will happen? Stay tuned!
159 (define-class <droid> (<actor>)
160 (infected #:init-keyword #:infected)
161 (room #:init-keyword #:room)
165 #:allocation #:each-subclass
169 (lambda (actor message)
170 "Register ourselves as being in a room"
171 (let ((room-id (slot-ref actor 'room)))
172 (<-wait room-id 'register-droid
173 #:droid-id (actor-id actor))
174 (format #t "Droid ~a registered with room ~a\n"
175 (actor-id-actor actor)
176 (address-actor-id room-id)))))
179 (lambda (actor message)
180 "Leak whether or not we're infected to a security droid"
181 (slot-ref actor 'infected)))
184 (lambda (actor message)
185 "Get shot by bullets"
186 (let* ((damage (random 60))
187 (new-hp (- (slot-ref actor 'hp) damage))
188 (alive (> new-hp 0)))
189 ;; Set our health to the new value
190 (slot-set! actor 'hp new-hp)
192 (format #t "~a: *Kaboom!*\n" (actor-id-actor actor))
193 (self-destruct actor))
194 (values #:hp-left new-hp
195 #:damage-taken damage
199 (define* (droid-status-format droid-id alive damage-taken hp-left)
201 (format #f "Droid ~a shot; taken ~a damage. Still alive... ~a hp left."
202 (address-actor-id droid-id)
203 damage-taken hp-left)
204 (format #f "Droid ~a shot; taken ~a damage. Terminated."
205 (address-actor-id droid-id)
209 ;;; Security robot... designed to seek out and destroy infected droids.
210 (define-actor <security-robot> (<actor>)
211 ((begin-mission security-robot-begin-mission)))
213 (define* (security-robot-begin-mission actor message
214 #:key starting-room overseer)
215 ;; used to track the current room / if any rooms are remaining
216 (define room starting-room)
218 ;; Walk through all rooms, clearing out infected droids
219 ;; Continue this whil there's still another room to investigate.
222 (<- overseer 'transmission
223 #:text (format #f "Entering room ~a..."
224 (address-actor-id room)))
226 ;; Find all droids in this room and exterminate the infected ones.
227 (let ((droid-ids (<-wait room 'list-droids)))
231 ;; Looks like it's infected
232 ((<-wait droid-id 'infection-expose)
233 ;; Inform that it's infected
234 (<- overseer 'transmission
235 #:text (format #f "~a found to be infected... taking out"
236 (address-actor-id droid-id)))
238 ;; Keep firing till it's dead.
239 (let ((still-alive #t))
242 (lambda () (<-wait droid-id 'get-shot))
243 (lambda* (#:key hp-left damage-taken alive)
244 (<- overseer 'transmission
245 #:text (droid-status-format droid-id alive damage-taken hp-left))
246 (set! still-alive alive))))))
248 ;; Not infected... inform and go to the next one
250 (<- overseer 'transmission
252 (format #f "~a is clean... moving on."
253 (address-actor-id droid-id))))))
256 ;; Switch to next room, if there is one.
257 (set! room (<-wait room 'get-next-room)))
259 ;; Good job everyone! Shut down the operation.
260 (<-wait overseer 'transmission
261 #:text "Mission accomplished.")
262 (<- overseer 'done!))
264 (define (main . args)
267 (define done? (make-condition))
268 (define overseer (create-actor <overseer> #:done? done?))
269 (<- overseer 'init-world)