suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fixed mouse event bug

Browse Source 
svn: r13756
This commit is contained in:
Matthias Felleisen 2009-02-21 00:14:17 +00:00
parent 7663087254
commit 33df6b2bfa
2 changed files with 6 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/2htdp/private/check-aux.ss
View File

@ -59,7 +59,7 @@
(define (mouse-event->parts e) (define (mouse-event->parts e)
(define x (- (send e get-x) INSET)) (define x (- (send e get-x) INSET))
(define y (- (send e get-y) INSET)) (define y (- (send e get-y) INSET))
(list x y (cond [(send e button-down?) 'button-down] (values x y (cond [(send e button-down?) 'button-down]
[(send e button-up?) 'button-up] [(send e button-up?) 'button-up]
[(send e dragging?) 'drag] [(send e dragging?) 'drag]
[(send e moving?) 'move] [(send e moving?) 'move]

8
collects/2htdp/private/world.ss
View File

@ -180,10 +180,12 @@
(when live (pkey (send e get-key-code)))) (when live (pkey (send e get-key-code))))
;; deal with mouse events if live and within range ;; deal with mouse events if live and within range
(define/override (on-event e) (define/override (on-event e)
(define l (mouse-event->parts e)) (define-values (x y me) (mouse-event->parts e))
(when live (when live
(when (and (<= 0 (first l) width) (<= 0 (second l) height)) (cond
(pmouse . l))))) [(and (<= 0 x width) (<= 0 y height)) (pmouse x y me)]
[(memq me '(leave enter)) (pmouse x y me)]
[else (void)]))))
(parent frame) (parent frame)
(editor visible) (editor visible)
(style '(no-hscroll no-vscroll)) (style '(no-hscroll no-vscroll))