From 3edd18424216252d807db3516be5a70e62810af4 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Sat, 30 Jul 2016 14:22:14 -0400 Subject: [PATCH] Update syndicate-gl for split mux and relay. --- racket/syndicate-gl/2d.rkt | 41 ++++++++++++----------- racket/syndicate-gl/examples/basic.rkt | 45 ++++++++++++-------------- 2 files changed, 44 insertions(+), 42 deletions(-) diff --git a/racket/syndicate-gl/2d.rkt b/racket/syndicate-gl/2d.rkt index be064d8..3126173 100644 --- a/racket/syndicate-gl/2d.rkt +++ b/racket/syndicate-gl/2d.rkt @@ -64,8 +64,8 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (update-scene prelude postlude #:meta-level [meta-level 1]) - (patch-seq (retract (scene ? ?) #:meta-level meta-level) - (assert (scene (seal prelude) (seal postlude)) #:meta-level meta-level))) + (patch-seq (retract (outbound* meta-level (scene ? ?))) + (assert (outbound* meta-level (scene (seal prelude) (seal postlude)))))) (define (make-sprite z instructions) (sprite z (seal instructions))) @@ -76,8 +76,8 @@ (texture ,i)))) (define (update-sprites #:meta-level [meta-level 1] . ss) - (patch-seq* (cons (retract (sprite ? ?) #:meta-level meta-level) - (map (lambda (s) (assert s #:meta-level meta-level)) ss)))) + (patch-seq* (cons (retract (outbound* meta-level (sprite ? ?))) + (map (lambda (s) (assert (outbound* meta-level s))) ss)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -85,11 +85,11 @@ (define (spawn-keyboard-integrator #:meta-level [meta-level 1]) (spawn (lambda (e s) (match e - [(message (at-meta (key-event code press? _))) + [(message (inbound* meta-level (key-event code press? _))) (transition (void) ((if press? assert retract) (key-pressed code)))] [#f #f])) (void) - (sub (key-event ? ? ?) #:meta-level meta-level))) + (sub (inbound* meta-level (key-event ? ? ?))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -243,7 +243,8 @@ (define postlude empty-instructions) (define fullscreen? #f) - (define dataspace (make-dataspace boot-actions)) + (define-values (proc pending-transition) + (spawn->process+transition (spawn-dataspace boot-actions))) (define event-queue (make-queue)) (define target-frame-rate 60) @@ -266,19 +267,23 @@ (enqueue! event-queue e)) (define (deliver-event e) - (clean-transition (dataspace-handle-event e dataspace))) + (clean-transition ((process-behavior proc) e (process-state proc)))) (define (quiesce!) - (let loop ((txn #f) (need-poll? #t)) - (match txn - [#f ;; inert - (if (queue-empty? event-queue) - (when need-poll? (loop (deliver-event #f) #f)) - (loop (deliver-event (dequeue! event-queue)) #t))] - [(transition new-dataspace actions) - (set! dataspace new-dataspace) - (for-each process-action! actions) - (loop #f #t)]))) + (define txn pending-transition) + (set! pending-transition #f) + (process-transition txn #t)) + + (define (process-transition txn need-poll?) + (match txn + [#f ;; inert + (if (queue-empty? event-queue) + (when need-poll? (process-transition (deliver-event #f) #f)) + (process-transition (deliver-event (dequeue! event-queue)) #t))] + [(transition new-state actions) + (set! proc (update-process-state proc new-state)) + (for-each process-action! actions) + (process-transition #f #t)])) (define (process-action! a) (match a diff --git a/racket/syndicate-gl/examples/basic.rkt b/racket/syndicate-gl/examples/basic.rkt index e5b6e3e..8bca6bd 100644 --- a/racket/syndicate-gl/examples/basic.rkt +++ b/racket/syndicate-gl/examples/basic.rkt @@ -7,18 +7,18 @@ (define (spawn-background) (actor (react - (during (window $width $height) #:meta-level 1 - (assert (scene (seal `((push-matrix (scale ,width ,(* height 2)) - (translate 0 -0.25) - (texture - ,(overlay/xy (rectangle 1 1 "solid" "white") - 0 0 - (rectangle 1 2 "solid" "black")))) - ;; (rotate -30) - ;; (scale 5 5) - )) - (seal `())) - #:meta-level 1))))) + (during (inbound (window $width $height)) + (assert (outbound + (scene (seal `((push-matrix (scale ,width ,(* height 2)) + (translate 0 -0.25) + (texture + ,(overlay/xy (rectangle 1 1 "solid" "white") + 0 0 + (rectangle 1 2 "solid" "black")))) + ;; (rotate -30) + ;; (scale 5 5) + )) + (seal `())))))))) (define (spawn-player-avatar) (local-require 2htdp/planetcute) @@ -26,15 +26,14 @@ (actor (react (field [x 100] [y 100]) - (assert (simple-sprite -0.5 (x) (y) (image-width CC) (image-height CC) CC) - #:meta-level 1) + (assert (outbound (simple-sprite -0.5 (x) (y) (image-width CC) (image-height CC) CC))) (field [keys-down (set)]) (on (asserted (key-pressed $k)) (keys-down (set-add (keys-down) k))) (on (retracted (key-pressed $k)) (keys-down (set-remove (keys-down) k))) (define (key->delta k distance) (if (set-member? (keys-down) k) distance 0)) - (on (message (frame-event _ _ $elapsed-ms _) #:meta-level 1) + (on (message (inbound (frame-event _ _ $elapsed-ms _))) (define-values (old-x old-y) (values (x) (y))) (define distance (* 0.360 elapsed-ms)) (define nx (+ old-x (key->delta 'right distance) (key->delta 'left (- distance)))) @@ -45,9 +44,9 @@ (define (spawn-frame-counter) (actor (react (field [i empty-image]) - (assert (simple-sprite -10 300 10 (image-width (i)) (image-height (i)) (i)) - #:meta-level 1) - (on (message (frame-event $counter $sim-time-ms _ _) #:meta-level 1) + (assert (outbound + (simple-sprite -10 300 10 (image-width (i)) (image-height (i)) (i)))) + (on (message (inbound (frame-event $counter $sim-time-ms _ _))) (when (> sim-time-ms 0) (define fps (/ counter (/ sim-time-ms 1000.0))) (i (text (format "~a fps" fps) 22 "black"))))))) @@ -56,11 +55,9 @@ (spawn-background) ;; (spawn-frame-counter) (spawn-player-avatar) -(actor (react (assert (simple-sprite 0 50 50 50 50 (circle 50 "solid" "orange")) - #:meta-level 1) - (assert (simple-sprite -1 60 60 50 50 (circle 50 "solid" "green")) - #:meta-level 1))) -(actor (until (message (key-event #\q #t _) #:meta-level 1)) - (assert! 'stop #:meta-level 1)) +(actor (react (assert (outbound (simple-sprite 0 50 50 50 50 (circle 50 "solid" "orange")))) + (assert (outbound (simple-sprite -1 60 60 50 50 (circle 50 "solid" "green")))))) +(actor (until (message (inbound (key-event #\q #t _)))) + (assert! (outbound 'stop))) (module+ main (current-ground-dataspace (2d-dataspace)))