From: Christopher Allan Webber <cwebber@dustycloud.org>
Date: Sat, 17 Dec 2016 03:47:51 +0000 (-0600)
Subject: demos: Update demos to new conventions.
X-Git-Tag: v0.3.0~4
X-Git-Url: https://jxself.org/git/?p=8sync.git;a=commitdiff_plain;h=509e4af613c8a67d58f1cb2d2409c4db88f77fd2

demos: Update demos to new conventions.

* demos/actors/botherbotherbother.scm:
* demos/actors/robotscanner.scm:
* demos/actors/simplest-possible.scm: Update demos to use new
  conventions around actions slot, lack of message-ref, etc.
---

diff --git a/demos/actors/botherbotherbother.scm b/demos/actors/botherbotherbother.scm
index 8daed93..48270f2 100755
--- a/demos/actors/botherbotherbother.scm
+++ b/demos/actors/botherbotherbother.scm
@@ -50,33 +50,31 @@
   (name #:init-keyword #:name)
   (dead #:init-value #f
         #:accessor student-dead)
-  (message-handler
-   #:init-value
-   (make-action-dispatch
-    (bother-professor
-     (lambda (actor message)
-       "Go bother a professor"
-       (while (not (student-dead actor))
-         (format #t "~a: Bother bother bother!\n"
-                 (actor-id-actor actor))
-         (send-message
-          actor (message-ref message 'target)
-          'be-bothered
-          #:noise "Bother bother bother!\n"))))
-
-    (be-lambda-consvardraed
-     (lambda (actor message)
-       "This kills the student."
-       (format #t "~a says: AAAAAAAHHHH!!! I'm dead!\n"
-               (actor-id-actor actor))
-       (set! (student-dead actor) #t))))))
+  (actions #:allocation #:each-subclass
+           #:init-value
+           (build-actions
+            (bother-professor
+             (lambda* (actor message #:key target)
+               "Go bother a professor"
+               (while (not (student-dead actor))
+                 (format #t "~a: Bother bother bother!\n"
+                         (actor-id-actor actor))
+                 (<- actor target
+                     'be-bothered
+                     #:noise "Bother bother bother!\n"))))
+
+            (be-lambda-consvardraed
+             (lambda (actor message)
+               "This kills the student."
+               (format #t "~a says: AAAAAAAHHHH!!! I'm dead!\n"
+                       (actor-id-actor actor))
+               (set! (student-dead actor) #t))))))
 
 (define complaints
   '("Hey!" "Stop that!" "Oof!"))
 
-(define (professor-be-bothered actor message)
+(define (professor-be-bothered actor message . rest)
   (define whos-bothering (professor-bothered-by actor))
-
   (hash-set! whos-bothering (message-from message) #t)
 
   ;; Oof!  Those kids!
@@ -91,9 +89,8 @@
                 (actor-id actor))
         (hash-for-each
          (lambda (student _)
-           (send-message
-            actor student
-            'be-lambda-consvardraed)
+           (<- actor student
+               'be-lambda-consvardraed)
            ;; Remove student from bothering list
            (hash-remove! whos-bothering student))
          whos-bothering))
@@ -106,10 +103,10 @@
   ;; We'll use a hash table as a fake set.
   (bothered-by #:init-thunk make-hash-table
                #:getter professor-bothered-by)
-  (message-handler
-   #:init-value
-   (make-action-dispatch
-    (be-bothered professor-be-bothered))))
+  (actions #:allocation #:each-subclass
+           #:init-value
+           (build-actions
+            (be-bothered professor-be-bothered))))
 
 (define num-students 10)
 
diff --git a/demos/actors/robotscanner.scm b/demos/actors/robotscanner.scm
index 7093a04..9ab5765 100644
--- a/demos/actors/robotscanner.scm
+++ b/demos/actors/robotscanner.scm
@@ -100,8 +100,8 @@
            #:overseer (actor-id actor)))))
 
   (transmission
-   (lambda (actor message)
-     (display (message-ref message 'message))
+   (lambda* (actor message #:key text)
+     (display text)
      (newline))))
 
 
@@ -111,37 +111,42 @@
   (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 id)
-     "Set the room following this"
-     (slot-set! actor 'next-room id))
-
-    ((set-previous-room actor message id)
-     "Set the room previous to this"
-     (slot-set! actor 'previous-room id))
-
-    ((get-next-room actor message)
-     "Return a reference to the link following this"
-     (<-reply actor message
-              #:id (slot-ref actor 'next-room)))
-
-    ((get-previous-room actor message)
-     "Return a reference to the link preceding this"
-     (<-reply 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 actor message
-                    #:droid-ids (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 actor message droid-id)
-     "Register a droid as being in this room"
-     (slot-set! actor 'droids
-                (cons droid-id
-                      (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!
@@ -151,108 +156,109 @@
   (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)))
-       (<-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 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 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 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
-         #:message (format #f "Entering room ~a..."
-                           (address-actor-id room)))
-
-     ;; Find all droids in this room and exterminate the infected ones.
-     (set! response (<-wait actor room 'list-droids))
-     (for-each
-      (lambda (droid-id)
-        (cond
-         ;; Looks like it's infected
-         ((message-ref
-           (<-wait actor droid-id
-                              'infection-expose)
-           'is-infected)
-          ;; Inform that it's infected
-          (<- 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
-                     (<-wait actor droid-id 'get-shot)))
-                (<- 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
-          (<- 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
-                 (<-wait actor room 'get-next-room)
-                 'id)))
-
-   ;; Good job everyone!  Shut down the operation.
-   (<- 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))
diff --git a/demos/actors/simplest-possible.scm b/demos/actors/simplest-possible.scm
index 9b563c0..8496b92 100644
--- a/demos/actors/simplest-possible.scm
+++ b/demos/actors/simplest-possible.scm
@@ -21,11 +21,9 @@
 
 (define-simple-actor <emo>
   (greet-proog
-   (lambda (actor message)
+   (lambda (actor message target)
      (display "emo> What's next, Proog?\n")
-     (send-message
-      actor (message-ref message 'target)
-      'greet-emo))))
+     (<- actor target 'greet-emo))))
 
 (define-simple-actor <proog>
   (greet-emo
@@ -38,4 +36,4 @@
 (define (main . args)
   (ez-run-hive hive
                (list (bootstrap-message hive our-emo 'greet-proog
-                                        #:target our-proog))))
+                                        our-proog))))