X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=demos%2Factors%2Fbotherbotherbother.scm;h=2e72b2d21034ac5ad7eb41c35485b27f47ad319a;hp=3a2747ab9914a5f93d44bf0eff135cd34f450ec4;hb=dc2155083a90de90e24f5341b837d4d96ce2898c;hpb=3c40164d37f2a11e9439261625c9dd4385a27350

diff --git a/demos/actors/botherbotherbother.scm b/demos/actors/botherbotherbother.scm
old mode 100644
new mode 100755
index 3a2747a..2e72b2d
--- a/demos/actors/botherbotherbother.scm
+++ b/demos/actors/botherbotherbother.scm
@@ -1,3 +1,7 @@
+#!/usr/bin/guile \
+-e main -s
+!#
+
 ;;; 8sync --- Asynchronous programming for Guile
 ;;; Copyright (C) 2016 Christopher Allan Webber <cwebber@dustycloud.org>
 ;;;
@@ -19,7 +23,7 @@
 ;; Puppet show simulator.
 
 (use-modules (8sync agenda)
-             (8sync systems actors)
+             (8sync actors)
              (oop goops)
              (ice-9 hash-table)
              (ice-9 format))
@@ -46,37 +50,35 @@
   (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))
+                 (<- 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!
   (display (string-append (random-choice complaints)))
+  (newline)
 
   ;; More than one student is bothering us, lose our temper
   (if (> (hash-count (const #t) whos-bothering)
@@ -86,9 +88,7 @@
                 (actor-id actor))
         (hash-for-each
          (lambda (student _)
-           (send-message
-            actor student
-            'be-lambda-consvardraed)
+           (<- student 'be-lambda-consvardraed)
            ;; Remove student from bothering list
            (hash-remove! whos-bothering student))
          whos-bothering))
@@ -101,31 +101,32 @@
   ;; 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)
 
-(define (main)
+(define (main . args)
   (define agenda (make-agenda))
   (define hive (make-hive))
-  (define professor (hive-create-actor hive <professor>))
+  (define professor (hive-create-actor* hive <professor> "prof"))
   (define namegen (student-name-generator))
   (define students
     (map
      (lambda _
-       (hive-create-actor* hive <student>
-                           (#:name (namegen))))
+       (let ((name (namegen)))
+         (hive-create-actor* hive <student> name
+                             #:name name)))
      (iota num-students)))
 
   ;; Bootstrap each student into bothering-professor mode.
   (define start-bothering-tasks
     (map
      (lambda (student)
-       (hive-bootstrap-message hive student 'bother-professor
+       (bootstrap-message hive student 'bother-professor
                                #:target professor))
      students))
 
-  (ez-run-hive hive start-bothering-tasks))
+  (run-hive hive start-bothering-tasks))