2016-04-01 23:53:46 +00:00
|
|
|
#lang syndicate-monolithic
|
2016-04-07 07:42:54 +00:00
|
|
|
;; Demonstrates quit-dataspace.
|
2016-01-23 23:24:07 +00:00
|
|
|
|
|
|
|
(require (only-in racket/port read-bytes-line-evt))
|
|
|
|
|
|
|
|
(define (spawn-command-listener)
|
|
|
|
(spawn (lambda (e s)
|
|
|
|
(match e
|
|
|
|
[(message (at-meta (at-meta (external-event _ (list #"quit")))))
|
|
|
|
(printf "Quitting just the leaf actor.\n")
|
|
|
|
(quit)]
|
2016-04-07 07:42:54 +00:00
|
|
|
[(message (at-meta (at-meta (external-event _ (list #"quit-dataspace")))))
|
|
|
|
(printf "Terminating the whole dataspace.\n")
|
|
|
|
(transition s (quit-dataspace))]
|
2016-01-23 23:24:07 +00:00
|
|
|
[_ #f]))
|
|
|
|
(void)
|
|
|
|
(scn (subscription (external-event (read-bytes-line-evt (current-input-port) 'any) ?)
|
|
|
|
#:meta-level 2))))
|
|
|
|
|
|
|
|
(define (spawn-ticker)
|
|
|
|
(define (sub-to-alarm)
|
|
|
|
(scn (subscription (external-event (alarm-evt (+ (current-inexact-milliseconds) 1000)) ?)
|
|
|
|
#:meta-level 2)))
|
|
|
|
(spawn (lambda (e s)
|
|
|
|
(match e
|
|
|
|
[(message (at-meta (at-meta (external-event _ _))))
|
|
|
|
(printf "Tick!\n")
|
|
|
|
(transition s (sub-to-alarm))]
|
|
|
|
[_ #f]))
|
|
|
|
(void)
|
|
|
|
(sub-to-alarm)))
|
|
|
|
|
2016-04-07 07:42:54 +00:00
|
|
|
(printf "Type 'quit' or 'quit-dataspace'.\n")
|
|
|
|
(spawn-dataspace (spawn-command-listener)
|
|
|
|
(spawn-ticker))
|