Separate out narration
This commit is contained in:
parent
84298d5571
commit
22b4f965b9
|
@ -21,58 +21,63 @@
|
||||||
(define elf-self (gensym 'elf))
|
(define elf-self (gensym 'elf))
|
||||||
(spawn* #:name elf-self
|
(spawn* #:name elf-self
|
||||||
(let work-industriously ()
|
(let work-industriously ()
|
||||||
(printf "~a working.\n" elf-self)
|
|
||||||
(sleep (/ (random 1000) 1000.0))
|
(sleep (/ (random 1000) 1000.0))
|
||||||
(printf "~a has a problem!\n" elf-self)
|
|
||||||
(react (assert (elf-has-a-problem elf-self))
|
(react (assert (elf-has-a-problem elf-self))
|
||||||
(stop-when (asserted (problem-resolved elf-self))
|
(stop-when (asserted (problem-resolved elf-self))
|
||||||
(printf "~a's problem is resolved.\n" elf-self)
|
|
||||||
(work-industriously))))))
|
(work-industriously))))))
|
||||||
|
|
||||||
(define (reindeer)
|
(define (reindeer)
|
||||||
(define reindeer-self (gensym 'reindeer))
|
(define reindeer-self (gensym 'reindeer))
|
||||||
(spawn* #:name reindeer-self
|
(spawn* #:name reindeer-self
|
||||||
(let holiday ()
|
(let holiday ()
|
||||||
(printf "~a is on holiday.\n" reindeer-self)
|
|
||||||
(sleep (/ (random 9000) 1000.0))
|
(sleep (/ (random 9000) 1000.0))
|
||||||
(printf "~a has returned from holiday and is ready to deliver toys!\n" reindeer-self)
|
|
||||||
(react (assert (reindeer-has-returned reindeer-self))
|
(react (assert (reindeer-has-returned reindeer-self))
|
||||||
(stop-when (asserted (deliver-toys))
|
(stop-when (asserted (deliver-toys))
|
||||||
(printf "~a delivers toys with the other reindeer.\n" reindeer-self)
|
(react (stop-when (retracted (deliver-toys))
|
||||||
(react
|
(holiday))))))))
|
||||||
(stop-when (retracted (deliver-toys))
|
|
||||||
(printf "~a has been dismissed by Santa.\n" reindeer-self)
|
|
||||||
(holiday))))))))
|
|
||||||
|
|
||||||
(spawn* #:name 'santa
|
(spawn* #:name 'santa
|
||||||
(define (wait-for-work)
|
(define (wait-for-work)
|
||||||
(react
|
(react (define/query-set stuck-elves (elf-has-a-problem $id) id)
|
||||||
(on-start (printf "Santa is waiting for something to do.\n"))
|
(define/query-set returned-reindeer (reindeer-has-returned $id) id)
|
||||||
(define/query-set stuck-elves (elf-has-a-problem $id) id)
|
(stop-when-true (= (set-count (returned-reindeer)) N-REINDEER)
|
||||||
(define/query-set returned-reindeer (reindeer-has-returned $id) id)
|
(harness-reindeer))
|
||||||
(stop-when-true (= (set-count (returned-reindeer)) N-REINDEER)
|
(stop-when-true (>= (set-count (stuck-elves)) ELF-GROUP-SIZE)
|
||||||
(harness-reindeer))
|
(talk-to-elves (take (set->list (stuck-elves)) ELF-GROUP-SIZE)))))
|
||||||
(stop-when-true (>= (set-count (stuck-elves)) ELF-GROUP-SIZE)
|
|
||||||
(talk-to-elves (take (set->list (stuck-elves)) ELF-GROUP-SIZE)))))
|
|
||||||
|
|
||||||
(define (harness-reindeer)
|
(define (harness-reindeer)
|
||||||
(react
|
(react (assert (deliver-toys))
|
||||||
(on-start (printf "Santa does the delivery run!\n"))
|
(stop-when (retracted (reindeer-has-returned _))
|
||||||
(assert (deliver-toys))
|
(wait-for-work))))
|
||||||
(stop-when (retracted (reindeer-has-returned _))
|
|
||||||
(wait-for-work))))
|
|
||||||
|
|
||||||
(define (talk-to-elves elves)
|
(define (talk-to-elves elves)
|
||||||
(match elves
|
(match elves
|
||||||
['() (wait-for-work)]
|
['() (wait-for-work)]
|
||||||
[(cons elf remainder)
|
[(cons elf remainder)
|
||||||
(react
|
(react (assert (problem-resolved elf))
|
||||||
(on-start (printf "Santa resolves the problem of ~a.\n" elf))
|
(stop-when (retracted (elf-has-a-problem elf))
|
||||||
(assert (problem-resolved elf))
|
(talk-to-elves remainder)))]))
|
||||||
(stop-when (retracted (elf-has-a-problem elf))
|
|
||||||
(talk-to-elves remainder)))]))
|
|
||||||
|
|
||||||
(wait-for-work))
|
(wait-for-work))
|
||||||
|
|
||||||
(for [(i N-ELVES)] (elf))
|
(for [(i N-ELVES)] (elf))
|
||||||
(for [(i N-REINDEER)] (reindeer))
|
(for [(i N-REINDEER)] (reindeer))
|
||||||
|
|
||||||
|
(spawn #:name 'narrator
|
||||||
|
(during (elf-has-a-problem $id)
|
||||||
|
(on-start (printf "~a has a problem!\n" id))
|
||||||
|
(on-stop (printf "~a's problem is resolved. ~a returns to work.\n" id id)))
|
||||||
|
|
||||||
|
(on (asserted (reindeer-has-returned $id))
|
||||||
|
(printf "~a has returned from holiday and is ready to deliver toys!\n" id))
|
||||||
|
|
||||||
|
(on (retracted (reindeer-has-returned $id))
|
||||||
|
(printf "~a delivers toys with the other reindeer.\n" id)
|
||||||
|
(react (stop-when (retracted (deliver-toys))
|
||||||
|
(printf "~a has been dismissed by Santa, and goes back on holiday.\n" id))))
|
||||||
|
|
||||||
|
(on (asserted (deliver-toys))
|
||||||
|
(printf "Santa does the delivery run!\n"))
|
||||||
|
|
||||||
|
(on (asserted (problem-resolved $id))
|
||||||
|
(printf "Santa resolves the problem of ~a.\n" id)))
|
||||||
|
|
Loading…
Reference in New Issue