X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=demos%2Factors%2Fbotherbotherbother.scm;h=2e72b2d21034ac5ad7eb41c35485b27f47ad319a;hp=8daed935e358e0167e3d3954032701a0f86845ed;hb=dc2155083a90de90e24f5341b837d4d96ce2898c;hpb=63aac37eb1ba788176c1452c50a6eb5a7ce3cd77 diff --git a/demos/actors/botherbotherbother.scm b/demos/actors/botherbotherbother.scm index 8daed93..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,33 +50,30 @@ (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! @@ -91,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)) @@ -106,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) @@ -134,4 +129,4 @@ #:target professor)) students)) - (ez-run-hive hive start-bothering-tasks)) + (run-hive hive start-bothering-tasks))