2013-10-28 10:18:09 +00:00
|
|
|
#lang racket/base
|
|
|
|
|
|
|
|
(require racket/match)
|
|
|
|
(require (only-in racket/port read-line-evt))
|
2013-10-28 10:55:46 +00:00
|
|
|
(require "../main.rkt")
|
2014-05-14 04:09:36 +00:00
|
|
|
(require "../drivers/timer.rkt")
|
2013-10-28 10:18:09 +00:00
|
|
|
|
2014-05-21 01:50:19 +00:00
|
|
|
(define (quasi-spy e s)
|
|
|
|
(printf "----------------------------------------\n")
|
|
|
|
(printf "QUASI-SPY:\n")
|
|
|
|
(match e
|
|
|
|
[(routing-update g) (pretty-print-gestalt g)]
|
|
|
|
[other
|
|
|
|
(write other)
|
|
|
|
(newline)])
|
|
|
|
(printf "========================================\n")
|
|
|
|
#f)
|
|
|
|
|
2013-10-28 10:18:09 +00:00
|
|
|
(define (r e s)
|
|
|
|
(match e
|
2014-05-28 19:24:26 +00:00
|
|
|
[(message body _ _) (transition s (send `(print (got ,body)) #:meta-level 1))]
|
2013-10-28 10:18:09 +00:00
|
|
|
[_ #f]))
|
|
|
|
|
|
|
|
(define (b e n)
|
|
|
|
(match e
|
|
|
|
[#f (if (< n 10)
|
|
|
|
(transition (+ n 1) (send `(hello ,n)))
|
|
|
|
#f)]
|
|
|
|
[_ #f]))
|
|
|
|
|
|
|
|
(define (echoer e s)
|
|
|
|
(match e
|
|
|
|
[(message (event _ (list (? eof-object?))) _ _) (transition s (quit))]
|
2014-05-28 19:24:26 +00:00
|
|
|
[(message (event _ (list line)) _ _) (transition s (send `(print (got-line ,line))))]
|
2014-05-14 04:09:36 +00:00
|
|
|
[_ #f]))
|
|
|
|
|
|
|
|
(define (ticker e s)
|
|
|
|
(match e
|
|
|
|
[(routing-update g)
|
|
|
|
(printf "EMPTY? ~v\n" (gestalt-empty? g))
|
|
|
|
(printf "INTERSECTED:\n")
|
2014-05-20 00:15:05 +00:00
|
|
|
(pretty-print-gestalt (gestalt-filter g (pub (set-timer ? ? ?) #:level 1)))
|
2014-05-14 04:09:36 +00:00
|
|
|
#f]
|
|
|
|
[(message (timer-expired 'tick now) _ _)
|
|
|
|
(printf "TICK ~v\n" now)
|
|
|
|
(transition (+ s 1) (if (< s 3)
|
|
|
|
(send (set-timer 'tick 1000 'relative))
|
|
|
|
(quit)))]
|
|
|
|
[_ #f]))
|
|
|
|
|
|
|
|
(define (printer e s)
|
|
|
|
(match e
|
2014-05-28 19:24:26 +00:00
|
|
|
[(message (list 'print v) _ _)
|
2014-05-14 04:09:36 +00:00
|
|
|
(log-info "PRINTER: ~a" v)
|
|
|
|
#f]
|
2013-10-28 10:18:09 +00:00
|
|
|
[_ #f]))
|
|
|
|
|
2014-06-23 11:27:53 +00:00
|
|
|
(run-ground (spawn quasi-spy (void) (gestalt-union (sub ? #:level 10)
|
2014-05-21 01:50:19 +00:00
|
|
|
(pub ? #:level 10)))
|
|
|
|
(spawn-timer-driver)
|
2014-05-14 04:09:36 +00:00
|
|
|
(send (set-timer 'tick 1000 'relative))
|
|
|
|
(spawn ticker 1 (gestalt-union (pub (set-timer ? ? ?) #:level 1)
|
|
|
|
(sub (timer-expired 'tick ?))))
|
|
|
|
(spawn-world (spawn r (void) (sub ?))
|
2013-10-28 10:18:09 +00:00
|
|
|
(spawn b 0))
|
2014-05-10 23:26:03 +00:00
|
|
|
(spawn echoer (void) (sub (event (read-line-evt (current-input-port) 'any) ?)
|
|
|
|
#:meta-level 1))
|
2014-05-28 19:24:26 +00:00
|
|
|
(spawn printer (void) (sub `(print ,?))))
|