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

`#:touchable-predicate`

This commit is contained in:
Tony Garnock-Jones 2016-09-02 10:08:02 +01:00
parent a6f002c27d
commit e50ab77b53
2 changed files with 11 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -11,6 +11,8 @@
(except-out (struct-out sprite) sprite) (except-out (struct-out sprite) sprite)
(rename-out [sprite <sprite>] [make-sprite sprite]) (rename-out [sprite <sprite>] [make-sprite sprite])
(struct-out request-gc) (struct-out request-gc)
in-unit-circle?
in-unit-square?
simple-sprite simple-sprite
update-scene update-scene
update-sprites update-sprites
@ -86,15 +88,20 @@
(define (make-sprite z instructions) (define (make-sprite z instructions)
(sprite z (seal instructions))) (sprite z (seal instructions)))
(define (in-unit-circle? x y)
(<= (+ (sqr (- x 0.5)) (sqr (- y 0.5))) (sqr 0.5)))
(define (in-unit-square? x y) (define (in-unit-square? x y)
(and (<= 0 x 1) (and (<= 0 x 1)
(<= 0 y 1))) (<= 0 y 1)))
(define (simple-sprite z x y w h i #:touchable-id [touchable-id #f]) (define (simple-sprite z x y w h i
#:touchable-id [touchable-id #f]
#:touchable-predicate [touchable-predicate in-unit-square?])
(make-sprite z `((translate ,x ,y) (make-sprite z `((translate ,x ,y)
(scale ,w ,h) (scale ,w ,h)
,@(if touchable-id ,@(if touchable-id
`((touchable ,touchable-id ,in-unit-square?)) `((touchable ,touchable-id ,touchable-predicate))
`()) `())
(texture ,i)))) (texture ,i))))

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

@ -59,11 +59,13 @@
(actor (define/query-value touching-orange? #f (inbound (touching 'orange _ _ _)) #t) (actor (define/query-value touching-orange? #f (inbound (touching 'orange _ _ _)) #t)
(assert (outbound (simple-sprite #:touchable-id 'orange (assert (outbound (simple-sprite #:touchable-id 'orange
#:touchable-predicate in-unit-circle?
0 50 50 50 50 (circle 50 "solid" 0 50 50 50 50 (circle 50 "solid"
(if (touching-orange?) (if (touching-orange?)
"red" "red"
"orange"))))) "orange")))))
(assert (outbound (simple-sprite #:touchable-id 'green (assert (outbound (simple-sprite #:touchable-id 'green
#:touchable-predicate in-unit-circle?
-1 60 60 50 50 (circle 50 "solid" "green"))))) -1 60 60 50 50 (circle 50 "solid" "green")))))
(actor* (until (message (inbound (key-event #\q #t _)))) (actor* (until (message (inbound (key-event #\q #t _))))
(assert! (outbound 'stop))) (assert! (outbound 'stop)))