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

Update big-bang.rkt to the new Syndicate/Racket HLL.

This commit is contained in:
Tony Garnock-Jones 2016-07-09 16:35:29 -04:00
parent 8ca2b1ac0c
commit 3bc95aeaeb
2 changed files with 24 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
racket/syndicate/actor.rkt
View File

@ -23,6 +23,7 @@
asserted asserted
retracted retracted
rising-edge rising-edge
(rename-out [core:message message])
suspend-script suspend-script
@ -34,6 +35,8 @@
syndicate-effects-available? syndicate-effects-available?
suspend-script* suspend-script*
? ;; from pattern.rkt
;; ;;
schedule-action! schedule-action!

39
racket/syndicate/examples/actor/big-bang.rkt
View File

@ -23,24 +23,27 @@
(define (draggable-shape name orig-x orig-y image) (define (draggable-shape name orig-x orig-y image)
(define (window-at x y) (window name x y 10 (seal image))) (define (window-at x y) (window name x y 10 (seal image)))
(define (mouse-left-event-type? t) (member t '("leave" "button-up"))) (define (mouse-left-event-type? t) (member t '("leave" "button-up")))
(define (idle ticks x y) ;;
;; TODO: Once "tail-calls" between `state`s are fixed, remove the ;; N.B. Currently (9 July 2016), fields are not properly
;; ugly returning-of-an-immediately-called-thunk-from-the- ;; garbage-collected on tail-calls between states, as you pick up
;; termination-handlers here and in `dragging`. ;; and put down shapes, you'll see their field-tables grow.
((state [#:collect [(ticks ticks) (x x) (y y)] ;;
(assert (window-at x y) #:meta-level 1) (define (idle ticks0 x0 y0)
(on (message (tick-event) #:meta-level 1) (react (field [ticks ticks0] [x x0] [y y0])
(define new-ticks (+ ticks 1)) (assert (window-at (x) (y)) #:meta-level 1)
(define displacement (* (cos (* new-ticks 10 1/180 pi)) 4)) (on (message (tick-event) #:meta-level 1)
(values new-ticks x (+ y displacement)))] (ticks (+ (ticks) 1))
[(message (mouse-event $mx $my name "button-down") #:meta-level 1) (y (+ (y) (* (cos (* (ticks) 10 1/180 pi)) 4))))
(lambda () (dragging mx my (- mx x) (- my y)))]))) (stop-when (message (mouse-event $mx $my name "button-down") #:meta-level 1)
(define (dragging mx my dx dy) (dragging mx my (- mx (x)) (- my (y))))))
((state [#:collect [(mx mx) (my my)] (define (dragging mx0 my0 dx dy)
(assert (window-at (- mx dx) (- my dy)) #:meta-level 1) (react (field [mx mx0] [my my0])
(on (message (mouse-event $mx $my _ "drag") #:meta-level 1) (values mx my))] (assert (window-at (- (mx) dx) (- (my) dy)) #:meta-level 1)
[(message (mouse-event $mx $my _ (? mouse-left-event-type? $t)) #:meta-level 1) (on (message (mouse-event $nmx $nmy _ "drag") #:meta-level 1)
(lambda () (idle 0 (- mx dx) (- my dy)))]))) (mx nmx)
(my nmy))
(stop-when (message (mouse-event $mx $my _ (? mouse-left-event-type? $t)) #:meta-level 1)
(idle 0 (- mx dx) (- my dy)))))
(actor (idle 0 orig-x orig-y))) (actor (idle 0 orig-x orig-y)))
(big-bang-dataspace #:width 640 (big-bang-dataspace #:width 640