syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Update syndicate-gl for split mux and relay.

This commit is contained in:
Tony Garnock-Jones 2016-07-30 14:22:14 -04:00
parent c7dae47210
commit 3edd184242
2 changed files with 44 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
racket/syndicate-gl/2d.rkt
View File

@ -64,8 +64,8 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (update-scene prelude postlude #:meta-level [meta-level 1]) (define (update-scene prelude postlude #:meta-level [meta-level 1])
(patch-seq (retract (scene ? ?) #:meta-level meta-level) (patch-seq (retract (outbound* meta-level (scene ? ?)))
(assert (scene (seal prelude) (seal postlude)) #:meta-level meta-level))) (assert (outbound* meta-level (scene (seal prelude) (seal postlude))))))
(define (make-sprite z instructions) (define (make-sprite z instructions)
(sprite z (seal instructions))) (sprite z (seal instructions)))
@ -76,8 +76,8 @@
(texture ,i)))) (texture ,i))))
(define (update-sprites #:meta-level [meta-level 1] . ss) (define (update-sprites #:meta-level [meta-level 1] . ss)
(patch-seq* (cons (retract (sprite ? ?) #:meta-level meta-level) (patch-seq* (cons (retract (outbound* meta-level (sprite ? ?)))
(map (lambda (s) (assert s #:meta-level meta-level)) ss)))) (map (lambda (s) (assert (outbound* meta-level s))) ss))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -85,11 +85,11 @@
(define (spawn-keyboard-integrator #:meta-level [meta-level 1]) (define (spawn-keyboard-integrator #:meta-level [meta-level 1])
(spawn (lambda (e s) (spawn (lambda (e s)
(match e (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)))] (transition (void) ((if press? assert retract) (key-pressed code)))]
[#f #f])) [#f #f]))
(void) (void)
(sub (key-event ? ? ?) #:meta-level meta-level))) (sub (inbound* meta-level (key-event ? ? ?)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -243,7 +243,8 @@
(define postlude empty-instructions) (define postlude empty-instructions)
(define fullscreen? #f) (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 event-queue (make-queue))
(define target-frame-rate 60) (define target-frame-rate 60)
@ -266,19 +267,23 @@
(enqueue! event-queue e)) (enqueue! event-queue e))
(define (deliver-event e) (define (deliver-event e)
(clean-transition (dataspace-handle-event e dataspace))) (clean-transition ((process-behavior proc) e (process-state proc))))
(define (quiesce!) (define (quiesce!)
(let loop ((txn #f) (need-poll? #t)) (define txn pending-transition)
(match txn (set! pending-transition #f)
[#f ;; inert (process-transition txn #t))
(if (queue-empty? event-queue)
(when need-poll? (loop (deliver-event #f) #f)) (define (process-transition txn need-poll?)
(loop (deliver-event (dequeue! event-queue)) #t))] (match txn
[(transition new-dataspace actions) [#f ;; inert
(set! dataspace new-dataspace) (if (queue-empty? event-queue)
(for-each process-action! actions) (when need-poll? (process-transition (deliver-event #f) #f))
(loop #f #t)]))) (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) (define (process-action! a)
(match a (match a

45
racket/syndicate-gl/examples/basic.rkt
View File

@ -7,18 +7,18 @@
(define (spawn-background) (define (spawn-background)
(actor (actor
(react (react
(during (window $width $height) #:meta-level 1 (during (inbound (window $width $height))
(assert (scene (seal `((push-matrix (scale ,width ,(* height 2)) (assert (outbound
(translate 0 -0.25) (scene (seal `((push-matrix (scale ,width ,(* height 2))
(texture (translate 0 -0.25)
,(overlay/xy (rectangle 1 1 "solid" "white") (texture
0 0 ,(overlay/xy (rectangle 1 1 "solid" "white")
(rectangle 1 2 "solid" "black")))) 0 0
;; (rotate -30) (rectangle 1 2 "solid" "black"))))
;; (scale 5 5) ;; (rotate -30)
)) ;; (scale 5 5)
(seal `())) ))
#:meta-level 1))))) (seal `()))))))))
(define (spawn-player-avatar) (define (spawn-player-avatar)
(local-require 2htdp/planetcute) (local-require 2htdp/planetcute)
@ -26,15 +26,14 @@
(actor (react (actor (react
(field [x 100] [y 100]) (field [x 100] [y 100])
(assert (simple-sprite -0.5 (x) (y) (image-width CC) (image-height CC) CC) (assert (outbound (simple-sprite -0.5 (x) (y) (image-width CC) (image-height CC) CC)))
#:meta-level 1)
(field [keys-down (set)]) (field [keys-down (set)])
(on (asserted (key-pressed $k)) (keys-down (set-add (keys-down) k))) (on (asserted (key-pressed $k)) (keys-down (set-add (keys-down) k)))
(on (retracted (key-pressed $k)) (keys-down (set-remove (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)) (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-values (old-x old-y) (values (x) (y)))
(define distance (* 0.360 elapsed-ms)) (define distance (* 0.360 elapsed-ms))
(define nx (+ old-x (key->delta 'right distance) (key->delta 'left (- distance)))) (define nx (+ old-x (key->delta 'right distance) (key->delta 'left (- distance))))
@ -45,9 +44,9 @@
(define (spawn-frame-counter) (define (spawn-frame-counter)
(actor (react (field [i empty-image]) (actor (react (field [i empty-image])
(assert (simple-sprite -10 300 10 (image-width (i)) (image-height (i)) (i)) (assert (outbound
#:meta-level 1) (simple-sprite -10 300 10 (image-width (i)) (image-height (i)) (i))))
(on (message (frame-event $counter $sim-time-ms _ _) #:meta-level 1) (on (message (inbound (frame-event $counter $sim-time-ms _ _)))
(when (> sim-time-ms 0) (when (> sim-time-ms 0)
(define fps (/ counter (/ sim-time-ms 1000.0))) (define fps (/ counter (/ sim-time-ms 1000.0)))
(i (text (format "~a fps" fps) 22 "black"))))))) (i (text (format "~a fps" fps) 22 "black")))))))
@ -56,11 +55,9 @@
(spawn-background) (spawn-background)
;; (spawn-frame-counter) ;; (spawn-frame-counter)
(spawn-player-avatar) (spawn-player-avatar)
(actor (react (assert (simple-sprite 0 50 50 50 50 (circle 50 "solid" "orange")) (actor (react (assert (outbound (simple-sprite 0 50 50 50 50 (circle 50 "solid" "orange"))))
#:meta-level 1) (assert (outbound (simple-sprite -1 60 60 50 50 (circle 50 "solid" "green"))))))
(assert (simple-sprite -1 60 60 50 50 (circle 50 "solid" "green")) (actor (until (message (inbound (key-event #\q #t _))))
#:meta-level 1))) (assert! (outbound 'stop)))
(actor (until (message (key-event #\q #t _) #:meta-level 1))
(assert! 'stop #:meta-level 1))
(module+ main (current-ground-dataspace (2d-dataspace))) (module+ main (current-ground-dataspace (2d-dataspace)))