X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=demos%2Factors%2Fbotherbotherbother.scm;fp=demos%2Factors%2Fbotherbotherbother.scm;h=48270f27702b7cb3bf30c08c2e336f7dc9f54e0b;hp=8daed935e358e0167e3d3954032701a0f86845ed;hb=509e4af613c8a67d58f1cb2d2409c4db88f77fd2;hpb=47dbaac681252f3d71e78a712cab0c829b913a63 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)