X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=demos%2Factors%2Fbotherbotherbother.scm;h=356a6a9451410eda4709cc8e78ba5d46a3211f59;hb=165231476f466b4dbeca51c981cf0dfa2963ff16;hp=5f294fd8d46097c2c3d41bda4a943ef068cc60af;hpb=5985528115e276d273a6a4bb1df57c93cab61f84;p=8sync.git diff --git a/demos/actors/botherbotherbother.scm b/demos/actors/botherbotherbother.scm index 5f294fd..356a6a9 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,36 @@ (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! (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 +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)) @@ -105,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) @@ -129,7 +127,7 @@ (define start-bothering-tasks (map (lambda (student) - (hive-bootstrap-message hive student 'bother-professor + (bootstrap-message hive student 'bother-professor #:target professor)) students))