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) (struct mouse-state (x y left-down? middle-down? right-down?) #:transparent)
;; Assertion. Indicates that the mouse is touching a particular touchable. ;; 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 ;; Shared state maintained by program. Prelude and postlude are to be
;; sealed instruction lists. It is an error to have more than exactly ;; 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 user-point (untransform-point xform (make-rectangular x y)))
(define ux (real-part user-point)) (define ux (real-part user-point))
(define uy (imag-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) (define (draggable-shape name orig-x orig-y z plain-image hover-image)
(actor (field [x orig-x] [y orig-y]) (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 (assert (outbound (simple-sprite #:touchable-id name
#:touchable-predicate in-unit-circle? #:touchable-predicate in-unit-circle?
z (x) (y) 50 50 z (x) (y) 50 50
@ -58,7 +58,7 @@
(on (retracted (key-pressed $k)) (keys-down (set-remove (keys-down) k))) (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 (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-start (draggable-mixin touching? x y))
(on (message (inbound (frame-event _ _ $elapsed-ms _))) (on (message (inbound (frame-event _ _ $elapsed-ms _)))
@ -97,7 +97,7 @@
(actor* (until (message (inbound (key-event #\q #t _)))) (actor* (until (message (inbound (key-event #\q #t _))))
(assert! (outbound 'stop))) (assert! (outbound 'stop)))
(actor (during (inbound (touching $id _ _ _)) (actor (during (inbound (touching $id))
(on-start (log-info "Touching ~v" id)) (on-start (log-info "Touching ~v" id))
(on-stop (log-info "No longer touching ~v" id)))) (on-stop (log-info "No longer touching ~v" id))))