`#:touchable-predicate`
This commit is contained in:
parent
a6f002c27d
commit
e50ab77b53
|
@ -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))))
|
||||
|
||||
|
|
|
@ -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)))
|
||||
|
|
Loading…
Reference in New Issue