1 ;;; 8sync --- Asynchronous programming for Guile
2 ;;; Copyright (C) 2016 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 systems actors)
40 (set! *random-state* (random-state-from-platform))
42 (define room-structure
43 ;; A list of (clean-droids infected-droids)
50 (define-simple-actor <overseer>
52 (lambda (actor message)
53 ;; Porting mostly straight up from super-imperative XUDD code.
54 (define previous-room #f)
55 (define first-room #f)
60 ((clean-droids infected-droids)
62 (define room (create-actor* actor <warehouse-room> "room"))
63 (define* (init-droid #:key infected)
64 (define droid (create-actor* actor <droid> "droid"
67 (send-message-wait actor droid
71 ;; Couldn't this just be folded into the warehouse room init?
72 ;; I guess it stress tests more the message sending process
74 (send-message actor previous-room
77 (send-message actor room
81 ;; Set up clean droids in the room
84 (init-droid #:infected #f))
87 ;; Set up infected droids in the room
90 (init-droid #:infected #t))
93 (set! previous-room room)
95 (set! first-room room))))
100 (create-actor actor <security-robot>)))
101 (send-message actor security-robot
103 #:starting-room first-room
104 #:overseer (actor-id actor)))))
107 (lambda (actor message)
108 (display (message-ref message 'message))
112 ;;; A room full of robots.
113 (define-class <warehouse-room> (<actor>)
114 (droids #:init-value '())
115 (next-room #:init-value #f)
116 (previous-room #:init-value #f)
120 (make-action-dispatch
121 ((set-next-room actor message)
122 "Set the room following this"
123 (slot-set! actor 'next-room
124 (message-ref message 'id)))
126 ((set-previous-room actor message)
127 "Set the room previous to this"
128 (slot-set! actor 'previous-room
129 (message-ref message 'id)))
131 ((get-next-room actor message)
132 "Return a reference to the link following this"
133 (reply-message actor message
134 #:id (slot-ref actor 'next-room)))
136 ((get-previous-room actor message)
137 "Return a reference to the link preceding this"
138 (reply-message actor message
139 #:id (slot-ref actor 'previous-room)))
141 ((list-droids actor message)
142 "Return a list of all the droid ids we know of in this room"
143 (reply-message actor message
144 #:droid-ids (slot-ref actor 'droids)))
146 ((register-droid actor message)
147 "Register a droid as being in this room"
148 (slot-set! actor 'droids
149 (cons (message-ref message 'droid-id)
150 (slot-ref actor 'droids)))))))
153 ;;; A droid that may or may not be infected!
154 ;;; What will happen? Stay tuned!
155 (define-class <droid> (<actor>)
156 (infected #:init-keyword #:infected)
157 (room #:init-keyword #:room)
162 (make-action-dispatch
163 ((register-with-room actor message)
164 "Register ourselves as being in a room"
165 (let ((room-id (slot-ref actor 'room)))
166 (send-message-wait actor room-id
168 #:droid-id (actor-id actor))
169 (format #t "Droid ~a registered with room ~a\n"
170 (actor-id-actor actor)
171 (address-actor-id room-id))))
173 ((infection-expose actor message)
174 "Leak whether or not we're infected to a security droid"
175 (reply-message actor message
178 ((get-shot actor message)
179 "Get shot by bullets"
180 (let* ((damage (random 60))
181 (new-hp (- (slot-ref actor 'hp) damage))
182 (alive (> new-hp 0)))
183 ;; Set our health to the new value
184 (slot-set! actor 'hp new-hp)
185 (reply-message actor message
187 #:damage-taken damage
190 (format #t "~a: *Kaboom!*\n" (actor-id-actor actor))
191 (self-destruct actor)))))))
194 (define (droid-status-format shot-response)
195 (if (message-ref shot-response 'alive)
196 (format #f "Droid ~a shot; taken ~a damage. Still alive... ~a hp left."
197 (address-actor-id (message-from shot-response))
198 (message-ref shot-response 'damage-taken)
199 (message-ref shot-response 'hp-left))
200 (format #f "Droid ~a shot; taken ~a damage. Terminated."
201 (address-actor-id (message-from shot-response))
202 (message-ref shot-response 'damage-taken))))
205 ;;; Security robot... designed to seek out and destroy infected droids.
206 (define-simple-actor <security-robot>
207 ((begin-mission actor message)
208 ;; used to track the current room / if any rooms are remaining
209 (define room (message-ref message 'starting-room))
210 (define overseer (message-ref message 'overseer))
212 ;; Walk through all rooms, clearing out infected droids
213 ;; Continue this whil there's still another room to investigate.
216 (send-message actor overseer
218 #:message (format #f "Entering room ~a..."
219 (address-actor-id room)))
221 ;; Find all droids in this room and exterminate the infected ones.
222 (set! response (send-message-wait actor room 'list-droids))
226 ;; Looks like it's infected
228 (send-message-wait actor droid-id
231 ;; Inform that it's infected
232 (send-message actor overseer
235 (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 (send-message-wait actor droid-id 'get-shot)))
243 (send-message actor overseer 'transmission
244 #:message (droid-status-format response))
245 (set! still-alive (message-ref response 'alive))))))
247 ;; Not infected... inform and go to the next one
249 (send-message actor overseer 'transmission
251 (format #f "~a is clean... moving on."
252 (address-actor-id droid-id))))))
253 (message-ref response 'droid-ids))
255 ;; Switch to next room, if there is one.
256 (set! room (message-ref
257 (send-message-wait actor room 'get-next-room)
260 ;; Good job everyone! Shut down the operation.
261 (send-message actor overseer 'transmission
262 #:message "Mission accomplished.")))
264 (define (main . args)
265 (define hive (make-hive))
266 (define overseer (hive-create-actor hive <overseer>))
267 (define initial-messages
268 (list (hive-bootstrap-message hive overseer 'init-world)))
269 (ez-run-hive hive initial-messages))