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 (use-modules (8sync systems actors)
  20              (oop goops)
  21              (ice-9 match))
  22
  23 (set! *random-state* (random-state-from-platform))
  24
  25 (define room-structure
  26   ;; A list of (clean-droids infected-droids)
  27   '((3 1)
  28     (0 2)
  29     (8 5)
  30     (5 0)
  31     (2 1)))
  32
  33 (define-simple-actor <overseer>
  34   (init-world
  35    (lambda (actor message)
  36      ;; Porting mostly straight up from super-imperative XUDD code.
  37      (define previous-room #f)
  38      (define first-room #f)
  39
  40      ;; Set up all rooms
  41      (for-each
  42       (match-lambda
  43         ((clean-droids infected-droids)
  44          ;; Create this room
  45          (define room (create-actor* actor <warehouse-room> "room"))
  46          (define* (init-droid #:key infected)
  47            (define droid (create-actor* actor <droid> "droid"
  48                                         #:infected infected
  49                                         #:room room))
  50            (send-message-wait actor droid
  51                               'register-with-room))
  52
  53          ;; Link rooms.
  54          ;; Couldn't this just be folded into the warehouse room init?
  55          ;; I guess it stress tests more the message sending process
  56          (when previous-room
  57            (send-message actor previous-room
  58                          'set-next-room
  59                          #:id room)
  60            (send-message actor room
  61                          'set-previous-room
  62                          #:id previous-room))
  63
  64          ;; Set up clean droids in the room
  65          (for-each
  66           (lambda _
  67             (init-droid #:infected #f))
  68           (iota clean-droids))
  69
  70          ;; Set up infected droids in the room
  71          (for-each
  72           (lambda _
  73             (init-droid #:infected #t))
  74           (iota clean-droids))
  75
  76          (set! previous-room room)
  77          (if (not first-room)
  78              (set! first-room room))))
  79       room-structure)
  80
  81      ;; Add security robot
  82      (let ((security-robot
  83             (create-actor actor <security-robot>)))
  84        (send-message actor security-robot
  85                      'begin-mission
  86                      #:starting-room first-room
  87                      #:overseer (actor-id actor)))))
  88
  89   (transmission
  90    (lambda (actor message)
  91      (display (message-ref message 'message))
  92      (newline))))
  93
  94
  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)
 100
 101   (message-handler
 102    #:init-value
 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)))
 108
 109     ((set-previous-room actor message)
 110      "Set the room previous to this"
 111      (slot-set! actor 'previous-room
 112                 (message-ref message 'id)))
 113
 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)))
 118
 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)))
 123
 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)))
 128
 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)))))))
 134
 135
 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)
 141   (hp #:init-value 50)
 142
 143   (message-handler
 144    #:init-value
 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
 150                           'register-droid
 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))))
 155
 156     ((infection-expose actor message)
 157      "Leak whether or not we're infected to a security droid"
 158      (reply-message actor message
 159                     #:is-infected #t))
 160
 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
 169                       #:hp-left new-hp
 170                       #:damage-taken damage
 171                       #:alive alive)
 172        (when (not alive)
 173          (format #t "~a: *Kaboom!*\n" (actor-id-actor actor))
 174          (self-destruct actor)))))))
 175
 176
 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))))
 186
 187
 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))
 194
 195    ;; Walk through all rooms, clearing out infected droids
 196    ;; Continue this whil there's still another room to investigate.
 197    (define response)
 198    (while room
 199      (send-message actor overseer
 200                    'transmission
 201                    #:message (format #f "Entering room ~a..."
 202                                      (address-actor-id room)))
 203
 204      ;; Find all droids in this room and exterminate the infected ones.
 205      (set! response (send-message-wait actor room 'list-droids))
 206      (for-each
 207       (lambda (droid-id)
 208         (cond
 209          ;; Looks like it's infected
 210          ((message-ref
 211            (send-message-wait actor droid-id
 212                               'infection-expose)
 213            'is-infected)
 214           ;; Inform that it's infected
 215           (send-message actor overseer
 216                         'transmission
 217                         #:message
 218                         (format #f "~a found to be infected... taking out"
 219                                 (address-actor-id droid-id)))
 220
 221           ;; Keep firing till it's dead.
 222           (let ((still-alive #t))
 223             (while still-alive
 224               (let ((response
 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))))))
 229
 230          ;; Not infected... inform and go to the next one
 231          (else
 232           (send-message actor overseer 'transmission
 233                         #:message
 234                         (format #f "~a is clean... moving on."
 235                                 (address-actor-id droid-id))))))
 236       (message-ref response 'droid-ids))
 237
 238      ;; Switch to next room, if there is one.
 239      (set! room (message-ref
 240                  (send-message-wait actor room 'get-next-room)
 241                  'id)))
 242
 243    ;; Good job everyone!  Shut down the operation.
 244    (send-message actor overseer 'transmission
 245                  #:message "Mission accomplished.")))
 246
 247 (define (main)
 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))