`#: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

View File

@ -11,6 +11,8 @@
(except-out (struct-out sprite) sprite)
(rename-out [sprite <sprite>] [make-sprite sprite])
(struct-out request-gc)
in-unit-circle?
in-unit-square?
simple-sprite
update-scene
update-sprites
@ -86,15 +88,20 @@
(define (make-sprite z 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)
(and (<= 0 x 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)
(scale ,w ,h)
,@(if touchable-id
`((touchable ,touchable-id ,in-unit-square?))
`((touchable ,touchable-id ,touchable-predicate))
`())
(texture ,i))))

View File

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