;;; reporting info back to the user.)
;;; =====================================================================
-(use-modules (8sync systems actors)
+(use-modules (8sync actors)
(oop goops)
(ice-9 match))
(define droid (create-actor* actor <droid> "droid"
#:infected infected
#:room room))
- (send-message-wait actor droid
- 'register-with-room))
+ (<-wait actor droid 'register-with-room))
;; Link rooms.
;; Couldn't this just be folded into the warehouse room init?
;; I guess it stress tests more the message sending process
(when previous-room
- (send-message actor previous-room
- 'set-next-room
- #:id room)
- (send-message actor room
- 'set-previous-room
- #:id previous-room))
+ (<- actor previous-room 'set-next-room
+ #:id room)
+ (<- actor room 'set-previous-room
+ #:id previous-room))
;; Set up clean droids in the room
(for-each
;; Add security robot
(let ((security-robot
(create-actor actor <security-robot>)))
- (send-message actor security-robot
- 'begin-mission
- #:starting-room first-room
- #:overseer (actor-id actor)))))
+ (<- actor security-robot 'begin-mission
+ #:starting-room first-room
+ #:overseer (actor-id actor)))))
(transmission
- (lambda (actor message)
- (display (message-ref message 'message))
+ (lambda* (actor message #:key text)
+ (display text)
(newline))))
(next-room #:init-value #f)
(previous-room #:init-value #f)
- (message-handler
+ (actions
+ #:allocation #:each-subclass
#:init-value
- (make-action-dispatch
- ((set-next-room actor message)
- "Set the room following this"
- (slot-set! actor 'next-room
- (message-ref message 'id)))
-
- ((set-previous-room actor message)
- "Set the room previous to this"
- (slot-set! actor 'previous-room
- (message-ref message 'id)))
-
- ((get-next-room actor message)
- "Return a reference to the link following this"
- (reply-message actor message
- #:id (slot-ref actor 'next-room)))
-
- ((get-previous-room actor message)
- "Return a reference to the link preceding this"
- (reply-message actor message
- #:id (slot-ref actor 'previous-room)))
-
- ((list-droids actor message)
- "Return a list of all the droid ids we know of in this room"
- (reply-message actor message
- #:droid-ids (slot-ref actor 'droids)))
-
- ((register-droid actor message)
- "Register a droid as being in this room"
- (slot-set! actor 'droids
- (cons (message-ref message 'droid-id)
- (slot-ref actor 'droids)))))))
+ (build-actions
+ (set-next-room
+ (lambda* (actor message #:key id)
+ "Set the room following this"
+ (slot-set! actor 'next-room id)))
+
+ (set-previous-room
+ (lambda* (actor message #:key id)
+ "Set the room previous to this"
+ (slot-set! actor 'previous-room id)))
+
+ (get-next-room
+ (lambda (actor message)
+ "Return a reference to the link following this"
+ (<-reply actor message (slot-ref actor 'next-room))))
+
+ (get-previous-room
+ (lambda (actor message)
+ "Return a reference to the link preceding this"
+ (<-reply actor message (slot-ref actor 'previous-room))))
+
+ (list-droids
+ (lambda (actor message)
+ "Return a list of all the droid ids we know of in this room"
+ (<-reply actor message
+ #:droid-ids (slot-ref actor 'droids))))
+
+ (register-droid
+ (lambda* (actor message #:key droid-id)
+ "Register a droid as being in this room"
+ (slot-set! actor 'droids
+ (cons droid-id
+ (slot-ref actor 'droids))))))))
;;; A droid that may or may not be infected!
(room #:init-keyword #:room)
(hp #:init-value 50)
- (message-handler
+ (actions
+ #:allocation #:each-subclass
#:init-value
- (make-action-dispatch
- ((register-with-room actor message)
- "Register ourselves as being in a room"
- (let ((room-id (slot-ref actor 'room)))
- (send-message-wait actor room-id
- 'register-droid
- #:droid-id (actor-id actor))
- (format #t "Droid ~a registered with room ~a\n"
- (actor-id-actor actor)
- (address-actor-id room-id))))
-
- ((infection-expose actor message)
- "Leak whether or not we're infected to a security droid"
- (reply-message actor message
- #:is-infected #t))
-
- ((get-shot actor message)
- "Get shot by bullets"
- (let* ((damage (random 60))
- (new-hp (- (slot-ref actor 'hp) damage))
- (alive (> new-hp 0)))
- ;; Set our health to the new value
- (slot-set! actor 'hp new-hp)
- (reply-message actor message
- #:hp-left new-hp
- #:damage-taken damage
- #:alive alive)
- (when (not alive)
- (format #t "~a: *Kaboom!*\n" (actor-id-actor actor))
- (self-destruct actor)))))))
+ (build-actions
+ (register-with-room
+ (lambda (actor message)
+ "Register ourselves as being in a room"
+ (let ((room-id (slot-ref actor 'room)))
+ (<-wait actor room-id
+ 'register-droid
+ #:droid-id (actor-id actor))
+ (format #t "Droid ~a registered with room ~a\n"
+ (actor-id-actor actor)
+ (address-actor-id room-id)))))
+
+ (infection-expose
+ (lambda (actor message)
+ "Leak whether or not we're infected to a security droid"
+ (<-reply actor message (slot-ref actor 'infected))))
+
+ (get-shot
+ (lambda (actor message)
+ "Get shot by bullets"
+ (let* ((damage (random 60))
+ (new-hp (- (slot-ref actor 'hp) damage))
+ (alive (> new-hp 0)))
+ ;; Set our health to the new value
+ (slot-set! actor 'hp new-hp)
+ (<-reply actor message
+ #:hp-left new-hp
+ #:damage-taken damage
+ #:alive alive)
+ (when (not alive)
+ (format #t "~a: *Kaboom!*\n" (actor-id-actor actor))
+ (self-destruct actor))))))))
(define (droid-status-format shot-response)
- (if (message-ref shot-response 'alive)
- (format #f "Droid ~a shot; taken ~a damage. Still alive... ~a hp left."
- (address-actor-id (message-from shot-response))
- (message-ref shot-response 'damage-taken)
- (message-ref shot-response 'hp-left))
- (format #f "Droid ~a shot; taken ~a damage. Terminated."
- (address-actor-id (message-from shot-response))
- (message-ref shot-response 'damage-taken))))
+ (call-with-message
+ shot-response
+ (lambda* (_ #:key alive damage-taken hp-left)
+ (if alive
+ (format #f "Droid ~a shot; taken ~a damage. Still alive... ~a hp left."
+ (address-actor-id (message-from shot-response))
+ damage-taken hp-left)
+ (format #f "Droid ~a shot; taken ~a damage. Terminated."
+ (address-actor-id (message-from shot-response))
+ damage-taken)))))
;;; Security robot... designed to seek out and destroy infected droids.
(define-simple-actor <security-robot>
- ((begin-mission actor message)
- ;; used to track the current room / if any rooms are remaining
- (define room (message-ref message 'starting-room))
- (define overseer (message-ref message 'overseer))
-
- ;; Walk through all rooms, clearing out infected droids
- ;; Continue this whil there's still another room to investigate.
- (define response)
- (while room
- (send-message actor overseer
- 'transmission
- #:message (format #f "Entering room ~a..."
- (address-actor-id room)))
-
- ;; Find all droids in this room and exterminate the infected ones.
- (set! response (send-message-wait actor room 'list-droids))
- (for-each
- (lambda (droid-id)
- (cond
- ;; Looks like it's infected
- ((message-ref
- (send-message-wait actor droid-id
- 'infection-expose)
- 'is-infected)
- ;; Inform that it's infected
- (send-message actor overseer
- 'transmission
- #:message
- (format #f "~a found to be infected... taking out"
- (address-actor-id droid-id)))
-
- ;; Keep firing till it's dead.
- (let ((still-alive #t))
- (while still-alive
- (let ((response
- (send-message-wait actor droid-id 'get-shot)))
- (send-message actor overseer 'transmission
- #:message (droid-status-format response))
- (set! still-alive (message-ref response 'alive))))))
-
- ;; Not infected... inform and go to the next one
- (else
- (send-message actor overseer 'transmission
- #:message
- (format #f "~a is clean... moving on."
- (address-actor-id droid-id))))))
- (message-ref response 'droid-ids))
-
- ;; Switch to next room, if there is one.
- (set! room (message-ref
- (send-message-wait actor room 'get-next-room)
- 'id)))
-
- ;; Good job everyone! Shut down the operation.
- (send-message actor overseer 'transmission
- #:message "Mission accomplished.")))
+ (begin-mission security-robot-begin-mission))
+
+(define* (security-robot-begin-mission actor message
+ #:key starting-room overseer)
+ ;; used to track the current room / if any rooms are remaining
+ (define room starting-room)
+
+ ;; Walk through all rooms, clearing out infected droids
+ ;; Continue this whil there's still another room to investigate.
+ (define response)
+ (while room
+ (<- actor overseer 'transmission
+ #:text (format #f "Entering room ~a..."
+ (address-actor-id room)))
+
+ ;; Find all droids in this room and exterminate the infected ones.
+ (msg-receive (_ #:key list-droids droid-ids #:allow-other-keys)
+ (<-wait actor room 'list-droids)
+ (for-each
+ (lambda (droid-id)
+ (cond
+ ;; Looks like it's infected
+ ((msg-val (<-wait actor droid-id 'infection-expose))
+ ;; Inform that it's infected
+ (<- actor overseer 'transmission
+ #:text (format #f "~a found to be infected... taking out"
+ (address-actor-id droid-id)))
+
+ ;; Keep firing till it's dead.
+ (let ((still-alive #t))
+ (while still-alive
+ (msg-receive (response #:key alive #:allow-other-keys)
+ (<-wait actor droid-id 'get-shot)
+ (<- actor overseer 'transmission
+ #:text (droid-status-format response))
+ (set! still-alive alive)))))
+
+ ;; Not infected... inform and go to the next one
+ (else
+ (<- actor overseer 'transmission
+ #:text
+ (format #f "~a is clean... moving on."
+ (address-actor-id droid-id))))))
+ droid-ids))
+
+ ;; Switch to next room, if there is one.
+ (set! room (msg-val (<-wait actor room 'get-next-room))))
+
+ ;; Good job everyone! Shut down the operation.
+ (<- actor overseer 'transmission
+ #:text "Mission accomplished."))
(define (main . args)
(define hive (make-hive))
projects / 8sync.git / blobdiff