demos/actors/robotscanner.scm

   1 ;;; 8sync --- Asynchronous programming for Guile
   2 ;;; Copyright (C) 2016 Christopher Allan Webber <cwebber@dustycloud.org>
   3 ;;;
   4 ;;; This file is part of 8sync.
   5 ;;;
   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.
  10 ;;;
  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.
  15 ;;;
  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/>.
  18
  19 ;;; =====================================================================
  20 ;;; Robot Scanner test demo (from XUDD, originally).
  21 ;;;
  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.
  29 ;;;
  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 ;;; =====================================================================
  35
  36 (use-modules (8sync systems actors)
  37              (oop goops)
  38              (ice-9 match))
  39
  40 (set! *random-state* (random-state-from-platform))
  41
  42 (define room-structure
  43   ;; A list of (clean-droids infected-droids)
  44   '((3 1)
  45     (0 2)
  46     (8 5)
  47     (5 0)
  48     (2 1)))
  49
  50 (define-simple-actor <overseer>
  51   (init-world
  52    (lambda (actor message)
  53      ;; Porting mostly straight up from super-imperative XUDD code.
  54      (define previous-room #f)
  55      (define first-room #f)
  56
  57      ;; Set up all rooms
  58      (for-each
  59       (match-lambda
  60         ((clean-droids infected-droids)
  61          ;; Create this room
  62          (define room (create-actor* actor <warehouse-room> "room"))
  63          (define* (init-droid #:key infected)
  64            (define droid (create-actor* actor <droid> "droid"
  65                                         #:infected infected
  66                                         #:room room))
  67            (send-message-wait actor droid
  68                               'register-with-room))
  69
  70          ;; Link rooms.
  71          ;; Couldn't this just be folded into the warehouse room init?
  72          ;; I guess it stress tests more the message sending process
  73          (when previous-room
  74            (send-message actor previous-room
  75                          'set-next-room
  76                          #:id room)
  77            (send-message actor room
  78                          'set-previous-room
  79                          #:id previous-room))
  80
  81          ;; Set up clean droids in the room
  82          (for-each
  83           (lambda _
  84             (init-droid #:infected #f))
  85           (iota clean-droids))
  86
  87          ;; Set up infected droids in the room
  88          (for-each
  89           (lambda _
  90             (init-droid #:infected #t))
  91           (iota clean-droids))
  92
  93          (set! previous-room room)
  94          (if (not first-room)
  95              (set! first-room room))))
  96       room-structure)
  97
  98      ;; Add security robot
  99      (let ((security-robot
 100             (create-actor actor <security-robot>)))
 101        (send-message actor security-robot
 102                      'begin-mission
 103                      #:starting-room first-room
 104                      #:overseer (actor-id actor)))))
 105
 106   (transmission
 107    (lambda (actor message)
 108      (display (message-ref message 'message))
 109      (newline))))
 110
 111
 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)
 117
 118   (message-handler
 119    #:init-value
 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)))
 125
 126     ((set-previous-room actor message)
 127      "Set the room previous to this"
 128      (slot-set! actor 'previous-room
 129                 (message-ref message 'id)))
 130
 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)))
 135
 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)))
 140
 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)))
 145
 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)))))))
 151
 152
 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)
 158   (hp #:init-value 50)
 159
 160   (message-handler
 161    #:init-value
 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
 167                           'register-droid
 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))))
 172
 173     ((infection-expose actor message)
 174      "Leak whether or not we're infected to a security droid"
 175      (reply-message actor message
 176                     #:is-infected #t))
 177
 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
 186                       #:hp-left new-hp
 187                       #:damage-taken damage
 188                       #:alive alive)
 189        (when (not alive)
 190          (format #t "~a: *Kaboom!*\n" (actor-id-actor actor))
 191          (self-destruct actor)))))))
 192
 193
 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))))
 203
 204
 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))
 211
 212    ;; Walk through all rooms, clearing out infected droids
 213    ;; Continue this whil there's still another room to investigate.
 214    (define response)
 215    (while room
 216      (send-message actor overseer
 217                    'transmission
 218                    #:message (format #f "Entering room ~a..."
 219                                      (address-actor-id room)))
 220
 221      ;; Find all droids in this room and exterminate the infected ones.
 222      (set! response (send-message-wait actor room 'list-droids))
 223      (for-each
 224       (lambda (droid-id)
 225         (cond
 226          ;; Looks like it's infected
 227          ((message-ref
 228            (send-message-wait actor droid-id
 229                               'infection-expose)
 230            'is-infected)
 231           ;; Inform that it's infected
 232           (send-message actor overseer
 233                         'transmission
 234                         #:message
 235                         (format #f "~a found to be infected... taking out"
 236                                 (address-actor-id droid-id)))
 237
 238           ;; Keep firing till it's dead.
 239           (let ((still-alive #t))
 240             (while still-alive
 241               (let ((response
 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))))))
 246
 247          ;; Not infected... inform and go to the next one
 248          (else
 249           (send-message actor overseer 'transmission
 250                         #:message
 251                         (format #f "~a is clean... moving on."
 252                                 (address-actor-id droid-id))))))
 253       (message-ref response 'droid-ids))
 254
 255      ;; Switch to next room, if there is one.
 256      (set! room (message-ref
 257                  (send-message-wait actor room 'get-next-room)
 258                  'id)))
 259
 260    ;; Good job everyone!  Shut down the operation.
 261    (send-message actor overseer 'transmission
 262                  #:message "Mission accomplished.")))
 263
 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))