X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=demos%2Factors%2Fbotherbotherbother.scm;h=2e72b2d21034ac5ad7eb41c35485b27f47ad319a;hp=db3c9d810748e022643c7fa7989d03d2b784bcbe;hb=dc2155083a90de90e24f5341b837d4d96ce2898c;hpb=9414dea358e9067f1d333650df1a228dcc4bf378 diff --git a/demos/actors/botherbotherbother.scm b/demos/actors/botherbotherbother.scm index db3c9d8..2e72b2d 100755 --- a/demos/actors/botherbotherbother.scm +++ b/demos/actors/botherbotherbother.scm @@ -23,7 +23,7 @@ ;; Puppet show simulator. (use-modules (8sync agenda) - (8sync systems actors) + (8sync actors) (oop goops) (ice-9 hash-table) (ice-9 format)) @@ -50,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) @@ -90,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)) @@ -105,10 +101,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) @@ -133,4 +129,4 @@ #:target professor)) students)) - (ez-run-hive hive start-bothering-tasks)) + (run-hive hive start-bothering-tasks))