demos/actors/robotscanner.scm

   1 ;;; 8sync --- Asynchronous programming for Guile
   2 ;;; Copyright © 2016, 2017 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 actors)
  37              (oop goops)
  38              (ice-9 match)
  39              (fibers conditions))
  40
  41 (set! *random-state* (random-state-from-platform))
  42
  43 (define room-structure
  44   ;; A list of (clean-droids infected-droids)
  45   '((3 1)
  46     (0 2)
  47     (8 5)
  48     (5 0)
  49     (2 1)))
  50
  51 (define-actor <overseer> (<actor>)
  52   ((init-world
  53     (lambda (actor message)
  54       ;; Porting mostly straight up from super-imperative XUDD code.
  55       (define previous-room #f)
  56       (define first-room #f)
  57
  58       ;; Set up all rooms
  59       (for-each
  60        (match-lambda
  61          ((clean-droids infected-droids)
  62           ;; Create this room
  63           (define room (create-actor* actor <warehouse-room> "room"))
  64           (define* (init-droid #:key infected)
  65             (define droid (create-actor* actor <droid> "droid"
  66                                          #:infected infected
  67                                          #:room room))
  68             (<-wait droid '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             (<- previous-room 'set-next-room
  75                 #:id room)
  76             (<- room 'set-previous-room
  77                 #:id previous-room))
  78
  79           ;; Set up clean droids in the room
  80           (for-each
  81            (lambda _
  82              (init-droid #:infected #f))
  83            (iota clean-droids))
  84
  85           ;; Set up infected droids in the room
  86           (for-each
  87            (lambda _
  88              (init-droid #:infected #t))
  89            (iota clean-droids))
  90
  91           (set! previous-room room)
  92           (if (not first-room)
  93               (set! first-room room))))
  94        room-structure)
  95
  96       ;; Add security robot
  97       (let ((security-robot
  98              (create-actor actor <security-robot>)))
  99         (<- security-robot 'begin-mission
 100             #:starting-room first-room
 101             #:overseer (actor-id actor)))))
 102
 103    (transmission
 104     (lambda* (actor message #:key text)
 105       (display text)
 106       (newline)))
 107    (done!
 108     (lambda* (actor message)
 109       (signal-condition! (.done? actor)))))
 110   (done? #:init-keyword #:done?
 111          #:accessor .done?))
 112
 113
 114 ;;; A room full of robots.
 115 (define-class <warehouse-room> (<actor>)
 116   (droids #:init-value '())
 117   (next-room #:init-value #f)
 118   (previous-room #:init-value #f)
 119
 120   (actions
 121    #:allocation #:each-subclass
 122    #:init-thunk
 123    (build-actions
 124     (set-next-room
 125      (lambda* (actor message #:key id)
 126        "Set the room following this"
 127        (slot-set! actor 'next-room id)))
 128
 129     (set-previous-room
 130      (lambda* (actor message #:key id)
 131        "Set the room previous to this"
 132        (slot-set! actor 'previous-room id)))
 133
 134     (get-next-room
 135      (lambda (actor message)
 136        "Return a reference to the link following this"
 137        (slot-ref actor 'next-room)))
 138
 139     (get-previous-room
 140      (lambda (actor message)
 141        "Return a reference to the link preceding this"
 142        (slot-ref actor 'previous-room)))
 143
 144     (list-droids
 145      (lambda (actor message)
 146        "Return a list of all the droid ids we know of in this room"
 147        (slot-ref actor 'droids)))
 148
 149     (register-droid
 150      (lambda* (actor message #:key droid-id)
 151        "Register a droid as being in this room"
 152        (slot-set! actor 'droids
 153                   (cons droid-id
 154                         (slot-ref actor 'droids))))))))
 155
 156
 157 ;;; A droid that may or may not be infected!
 158 ;;; What will happen?  Stay tuned!
 159 (define-class <droid> (<actor>)
 160   (infected #:init-keyword #:infected)
 161   (room #:init-keyword #:room)
 162   (hp #:init-value 50)
 163
 164   (actions
 165    #:allocation #:each-subclass
 166    #:init-thunk
 167    (build-actions
 168     (register-with-room
 169      (lambda (actor message)
 170        "Register ourselves as being in a room"
 171        (let ((room-id (slot-ref actor 'room)))
 172          (<-wait room-id 'register-droid
 173                  #:droid-id (actor-id actor))
 174          (format #t "Droid ~a registered with room ~a\n"
 175                  (actor-id-actor actor)
 176                  (address-actor-id room-id)))))
 177
 178     (infection-expose
 179      (lambda (actor message)
 180        "Leak whether or not we're infected to a security droid"
 181        (slot-ref actor 'infected)))
 182
 183     (get-shot
 184      (lambda (actor message)
 185        "Get shot by bullets"
 186        (let* ((damage (random 60))
 187               (new-hp (- (slot-ref actor 'hp) damage))
 188               (alive (> new-hp 0)))
 189          ;; Set our health to the new value
 190          (slot-set! actor 'hp new-hp)
 191          (when (not alive)
 192            (format #t "~a: *Kaboom!*\n" (actor-id-actor actor))
 193            (self-destruct actor))
 194          (values #:hp-left new-hp
 195                  #:damage-taken damage
 196                  #:alive alive)))))))
 197
 198
 199 (define* (droid-status-format droid-id alive damage-taken hp-left)
 200   (if alive
 201       (format #f "Droid ~a shot; taken ~a damage. Still alive... ~a hp left."
 202               (address-actor-id droid-id)
 203               damage-taken hp-left)
 204       (format #f "Droid ~a shot; taken ~a damage. Terminated."
 205               (address-actor-id droid-id)
 206               damage-taken)))
 207
 208
 209 ;;; Security robot... designed to seek out and destroy infected droids.
 210 (define-actor <security-robot> (<actor>)
 211   ((begin-mission security-robot-begin-mission)))
 212
 213 (define* (security-robot-begin-mission actor message
 214                                        #:key starting-room overseer)
 215   ;; used to track the current room / if any rooms are remaining
 216   (define room starting-room)
 217
 218   ;; Walk through all rooms, clearing out infected droids
 219   ;; Continue this whil there's still another room to investigate.
 220   (define response)
 221   (while room
 222     (<- overseer 'transmission
 223         #:text (format #f "Entering room ~a..."
 224                        (address-actor-id room)))
 225
 226     ;; Find all droids in this room and exterminate the infected ones.
 227     (let ((droid-ids (<-wait room 'list-droids)))
 228       (for-each
 229        (lambda (droid-id)
 230          (cond
 231           ;; Looks like it's infected
 232           ((<-wait droid-id 'infection-expose)
 233            ;; Inform that it's infected
 234            (<- overseer 'transmission
 235                #:text (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                (call-with-values
 242                    (lambda () (<-wait droid-id 'get-shot))
 243                  (lambda* (#:key hp-left damage-taken alive)
 244                    (<- overseer 'transmission
 245                        #:text (droid-status-format droid-id alive damage-taken hp-left))
 246                    (set! still-alive alive))))))
 247
 248           ;; Not infected... inform and go to the next one
 249           (else
 250            (<- overseer 'transmission
 251                #:text
 252                (format #f "~a is clean... moving on."
 253                        (address-actor-id droid-id))))))
 254        droid-ids))
 255
 256     ;; Switch to next room, if there is one.
 257     (set! room (<-wait room 'get-next-room)))
 258
 259   ;; Good job everyone!  Shut down the operation.
 260   (<-wait overseer 'transmission
 261           #:text "Mission accomplished.")
 262   (<- overseer 'done!))
 263
 264 (define (main . args)
 265   (run-hive
 266    (lambda (hive)
 267      (define done? (make-condition))
 268      (define overseer (bootstrap-actor hive <overseer>
 269                                        #:done? done?))
 270      (<- overseer 'init-world)
 271      (wait done?))))