From 64319d0c2d3809d35ab6017456e095b6bdabfd08 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Tue, 26 Apr 2016 13:24:12 -0500 Subject: [PATCH] demos: actors: Adding new robotscanner demo. * 8sync/actors/robotscanner.scm: New file. --- demos/actors/robotscanner.scm | 252 ++++++++++++++++++++++++++++++++++ 1 file changed, 252 insertions(+) create mode 100644 demos/actors/robotscanner.scm diff --git a/demos/actors/robotscanner.scm b/demos/actors/robotscanner.scm new file mode 100644 index 0000000..361324b --- /dev/null +++ b/demos/actors/robotscanner.scm @@ -0,0 +1,252 @@ +;;; 8sync --- Asynchronous programming for Guile +;;; Copyright (C) 2016 Christopher Allan Webber +;;; +;;; This file is part of 8sync. +;;; +;;; 8sync is free software: you can redistribute it and/or modify it +;;; under the terms of the GNU Lesser General Public License as +;;; published by the Free Software Foundation, either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; 8sync 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 Lesser General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with 8sync. If not, see . + +(use-modules (8sync systems actors) + (oop goops) + (ice-9 match)) + +(set! *random-state* (random-state-from-platform)) + +(define room-structure + ;; A list of (clean-droids infected-droids) + '((3 1) + (0 2) + (8 5) + (5 0) + (2 1))) + +(define-simple-actor + (init-world + (lambda (actor message) + ;; Porting mostly straight up from super-imperative XUDD code. + (define previous-room #f) + (define first-room #f) + + ;; Set up all rooms + (for-each + (match-lambda + ((clean-droids infected-droids) + ;; Create this room + (define room (create-actor* actor "room")) + (define* (init-droid #:key infected) + (define droid (create-actor* actor "droid" + #:infected infected + #:room room)) + (send-message-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)) + + ;; Set up clean droids in the room + (for-each + (lambda _ + (init-droid #:infected #f)) + (iota clean-droids)) + + ;; Set up infected droids in the room + (for-each + (lambda _ + (init-droid #:infected #t)) + (iota clean-droids)) + + (set! previous-room room) + (if (not first-room) + (set! first-room room)))) + room-structure) + + ;; Add security robot + (let ((security-robot + (create-actor actor ))) + (send-message actor security-robot + 'begin-mission + #:starting-room first-room + #:overseer (actor-id actor))))) + + (transmission + (lambda (actor message) + (display (message-ref message 'message)) + (newline)))) + + +;;; A room full of robots. +(define-class () + (droids #:init-value '()) + (next-room #:init-value #f) + (previous-room #:init-value #f) + + (message-handler + #: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))))))) + + +;;; A droid that may or may not be infected! +;;; What will happen? Stay tuned! +(define-class () + (infected #:init-keyword #:infected) + (room #:init-keyword #:room) + (hp #:init-value 50) + + (message-handler + #: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))))))) + + +(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)))) + + +;;; Security robot... designed to seek out and destroy infected droids. +(define-simple-actor + ((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."))) + +(define (main) + (define hive (make-hive)) + (define overseer (hive-create-actor hive )) + (define initial-messages + (list (hive-bootstrap-message hive overseer 'init-world))) + (ez-run-hive hive initial-messages)) -- 2.31.1