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

Simplify `touching` notifications

This commit is contained in:
Tony Garnock-Jones 2016-09-02 11:11:56 +01:00
parent 386df02fd0
commit bd40ca3c62
2 changed files with 5 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -62,7 +62,7 @@
(struct mouse-state (x y left-down? middle-down? right-down?) #:transparent)
;; Assertion. Indicates that the mouse is touching a particular touchable.
(struct touching (id user-x user-y state) #:transparent)
(struct touching (id) #:transparent)
;; Shared state maintained by program. Prelude and postlude are to be
;; sealed instruction lists. It is an error to have more than exactly
@ -308,7 +308,7 @@
(define user-point (untransform-point xform (make-rectangular x y)))
(define ux (real-part user-point))
(define uy (imag-part user-point))
(and (contains? ux uy) (touching id ux uy state))))
(and (contains? ux uy) (touching id))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

@ -36,7 +36,7 @@
(define (draggable-shape name orig-x orig-y z plain-image hover-image)
(actor (field [x orig-x] [y orig-y])
(define/query-value touching? #f (inbound (touching name _ _ _)) #t)
(define/query-value touching? #f (inbound (touching name)) #t)
(assert (outbound (simple-sprite #:touchable-id name
#:touchable-predicate in-unit-circle?
z (x) (y) 50 50
@ -58,7 +58,7 @@
(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))
(define/query-value touching? #f (inbound (touching 'player _ _ _)) #t)
(define/query-value touching? #f (inbound (touching 'player)) #t)
(on-start (draggable-mixin touching? x y))
(on (message (inbound (frame-event _ _ $elapsed-ms _)))
@ -97,7 +97,7 @@
(actor* (until (message (inbound (key-event #\q #t _))))
(assert! (outbound 'stop)))
(actor (during (inbound (touching $id _ _ _))
(actor (during (inbound (touching $id))
(on-start (log-info "Touching ~v" id))
(on-stop (log-info "No longer touching ~v" id))))