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])
(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

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

@ -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)))