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 (use-modules (8sync systems actors)
23 (set! *random-state* (random-state-from-platform))
25 (define room-structure
26 ;; A list of (clean-droids infected-droids)
33 (define-simple-actor <overseer>
35 (lambda (actor message)
36 ;; Porting mostly straight up from super-imperative XUDD code.
37 (define previous-room #f)
38 (define first-room #f)
43 ((clean-droids infected-droids)
45 (define room (create-actor* actor <warehouse-room> "room"))
46 (define* (init-droid #:key infected)
47 (define droid (create-actor* actor <droid> "droid"
50 (send-message-wait actor droid
54 ;; Couldn't this just be folded into the warehouse room init?
55 ;; I guess it stress tests more the message sending process
57 (send-message actor previous-room
60 (send-message actor room
64 ;; Set up clean droids in the room
67 (init-droid #:infected #f))
70 ;; Set up infected droids in the room
73 (init-droid #:infected #t))
76 (set! previous-room room)
78 (set! first-room room))))
83 (create-actor actor <security-robot>)))
84 (send-message actor security-robot
86 #:starting-room first-room
87 #:overseer (actor-id actor)))))
90 (lambda (actor message)
91 (display (message-ref message 'message))
95 ;;; A room full of robots.
96 (define-class <warehouse-room> (<actor>)
97 (droids #:init-value '())
98 (next-room #:init-value #f)
99 (previous-room #:init-value #f)
103 (make-action-dispatch
104 ((set-next-room actor message)
105 "Set the room following this"
106 (slot-set! actor 'next-room
107 (message-ref message 'id)))
109 ((set-previous-room actor message)
110 "Set the room previous to this"
111 (slot-set! actor 'previous-room
112 (message-ref message 'id)))
114 ((get-next-room actor message)
115 "Return a reference to the link following this"
116 (reply-message actor message
117 #:id (slot-ref actor 'next-room)))
119 ((get-previous-room actor message)
120 "Return a reference to the link preceding this"
121 (reply-message actor message
122 #:id (slot-ref actor 'previous-room)))
124 ((list-droids actor message)
125 "Return a list of all the droid ids we know of in this room"
126 (reply-message actor message
127 #:droid-ids (slot-ref actor 'droids)))
129 ((register-droid actor message)
130 "Register a droid as being in this room"
131 (slot-set! actor 'droids
132 (cons (message-ref message 'droid-id)
133 (slot-ref actor 'droids)))))))
136 ;;; A droid that may or may not be infected!
137 ;;; What will happen? Stay tuned!
138 (define-class <droid> (<actor>)
139 (infected #:init-keyword #:infected)
140 (room #:init-keyword #:room)
145 (make-action-dispatch
146 ((register-with-room actor message)
147 "Register ourselves as being in a room"
148 (let ((room-id (slot-ref actor 'room)))
149 (send-message-wait actor room-id
151 #:droid-id (actor-id actor))
152 (format #t "Droid ~a registered with room ~a\n"
153 (actor-id-actor actor)
154 (address-actor-id room-id))))
156 ((infection-expose actor message)
157 "Leak whether or not we're infected to a security droid"
158 (reply-message actor message
161 ((get-shot actor message)
162 "Get shot by bullets"
163 (let* ((damage (random 60))
164 (new-hp (- (slot-ref actor 'hp) damage))
165 (alive (> new-hp 0)))
166 ;; Set our health to the new value
167 (slot-set! actor 'hp new-hp)
168 (reply-message actor message
170 #:damage-taken damage
173 (format #t "~a: *Kaboom!*\n" (actor-id-actor actor))
174 (self-destruct actor)))))))
177 (define (droid-status-format shot-response)
178 (if (message-ref shot-response 'alive)
179 (format #f "Droid ~a shot; taken ~a damage. Still alive... ~a hp left."
180 (address-actor-id (message-from shot-response))
181 (message-ref shot-response 'damage-taken)
182 (message-ref shot-response 'hp-left))
183 (format #f "Droid ~a shot; taken ~a damage. Terminated."
184 (address-actor-id (message-from shot-response))
185 (message-ref shot-response 'damage-taken))))
188 ;;; Security robot... designed to seek out and destroy infected droids.
189 (define-simple-actor <security-robot>
190 ((begin-mission actor message)
191 ;; used to track the current room / if any rooms are remaining
192 (define room (message-ref message 'starting-room))
193 (define overseer (message-ref message 'overseer))
195 ;; Walk through all rooms, clearing out infected droids
196 ;; Continue this whil there's still another room to investigate.
199 (send-message actor overseer
201 #:message (format #f "Entering room ~a..."
202 (address-actor-id room)))
204 ;; Find all droids in this room and exterminate the infected ones.
205 (set! response (send-message-wait actor room 'list-droids))
209 ;; Looks like it's infected
211 (send-message-wait actor droid-id
214 ;; Inform that it's infected
215 (send-message actor overseer
218 (format #f "~a found to be infected... taking out"
219 (address-actor-id droid-id)))
221 ;; Keep firing till it's dead.
222 (let ((still-alive #t))
225 (send-message-wait actor droid-id 'get-shot)))
226 (send-message actor overseer 'transmission
227 #:message (droid-status-format response))
228 (set! still-alive (message-ref response 'alive))))))
230 ;; Not infected... inform and go to the next one
232 (send-message actor overseer 'transmission
234 (format #f "~a is clean... moving on."
235 (address-actor-id droid-id))))))
236 (message-ref response 'droid-ids))
238 ;; Switch to next room, if there is one.
239 (set! room (message-ref
240 (send-message-wait actor room 'get-next-room)
243 ;; Good job everyone! Shut down the operation.
244 (send-message actor overseer 'transmission
245 #:message "Mission accomplished.")))
248 (define hive (make-hive))
249 (define overseer (hive-create-actor hive <overseer>))
250 (define initial-messages
251 (list (hive-bootstrap-message hive overseer 'init-world)))
252 (ez-run-hive hive initial-messages))