2021-05-27 09:28:10 +00:00
|
|
|
#lang racket/base
|
|
|
|
|
2021-05-28 07:57:11 +00:00
|
|
|
(require racket/match)
|
|
|
|
|
2021-06-02 13:00:25 +00:00
|
|
|
(require "main.rkt")
|
|
|
|
(require "dataspace.rkt")
|
|
|
|
|
2021-05-28 07:57:11 +00:00
|
|
|
(require "schemas/gen/box-protocol.rkt")
|
|
|
|
|
2021-06-02 11:41:30 +00:00
|
|
|
(require (only-in "pattern.rkt" :pattern))
|
2021-05-28 07:57:11 +00:00
|
|
|
|
2021-06-01 08:04:10 +00:00
|
|
|
(define box
|
|
|
|
(action (ds LIMIT REPORT_EVERY)
|
|
|
|
(spawn (define root-facet this-facet)
|
|
|
|
(define-field value 0)
|
|
|
|
(define start-time (current-inexact-milliseconds))
|
|
|
|
(define prev-value 0)
|
|
|
|
(at ds
|
2021-06-02 11:11:26 +00:00
|
|
|
(assert (BoxState (value)))
|
|
|
|
(when (message (SetBox $new-value))
|
2021-06-01 08:04:10 +00:00
|
|
|
(when (zero? (remainder new-value REPORT_EVERY))
|
|
|
|
(define end-time (current-inexact-milliseconds))
|
|
|
|
(define delta (/ (- end-time start-time) 1000.0))
|
|
|
|
(define count (- new-value prev-value))
|
|
|
|
(set! prev-value new-value)
|
|
|
|
(set! start-time end-time)
|
|
|
|
(log-info "Box got ~a (~a Hz)" new-value (/ count delta)))
|
|
|
|
(when (= new-value LIMIT)
|
|
|
|
(stop-facet root-facet))
|
|
|
|
(value new-value))))))
|
|
|
|
|
|
|
|
(define client
|
|
|
|
(action (ds)
|
|
|
|
(spawn (define root-facet this-facet)
|
|
|
|
(define count 0)
|
|
|
|
(at ds
|
2021-06-02 11:11:26 +00:00
|
|
|
(when (asserted (BoxState $value))
|
2021-06-01 08:04:10 +00:00
|
|
|
(send! ds (SetBox->preserves (SetBox (+ value 1)))))
|
|
|
|
;; (during (BoxState _)
|
|
|
|
;; (on-start (set! count (+ count 1)))
|
|
|
|
;; (on-stop (set! count (- count 1))
|
|
|
|
;; (when (zero? count)
|
|
|
|
;; (log-info "Client detected box termination")
|
|
|
|
;; (stop-facet root-facet))))
|
2021-06-02 11:41:30 +00:00
|
|
|
(assert (Observe (:pattern (BoxState _))
|
2021-06-02 11:11:26 +00:00
|
|
|
(ref (entity #:assert
|
|
|
|
(action (_v _h)
|
|
|
|
(set! count (+ count 1)))
|
|
|
|
#:retract
|
|
|
|
(action (_h)
|
|
|
|
(set! count (- count 1))
|
|
|
|
(when (zero? count)
|
|
|
|
(log-info "Client detected box termination")
|
|
|
|
(stop-facet root-facet)))))))
|
2021-06-01 08:04:10 +00:00
|
|
|
;; (during (BoxState _)
|
|
|
|
;; (on-stop (log-info "Client detected box termination")
|
|
|
|
;; (stop-facet root-facet)))
|
|
|
|
))))
|
2021-05-28 07:57:11 +00:00
|
|
|
|
2021-05-31 11:07:37 +00:00
|
|
|
(module+ main
|
|
|
|
(time
|
|
|
|
(actor-system
|
2021-06-01 08:04:10 +00:00
|
|
|
(define disarm (facet-prevent-inert-check! this-facet))
|
|
|
|
(define ds (ref (dataspace)))
|
|
|
|
(box this-turn ds 500000 100000)
|
|
|
|
(client this-turn ds))))
|