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

mouse leave/enter behavior was wrong; failure of SPC?

Browse Source 
svn: r17925
This commit is contained in:
Matthias Felleisen 2010-02-01 16:05:37 +00:00
parent 6f4c164793
commit 9664c79320
2 changed files with 46 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -181,7 +181,7 @@
(when live
(cond
[(and (<= 0 x width) (<= 0 y height)) (pmouse x y me)]
[(memq me '(leave enter)) (pmouse x y me)]
[(member me '("leave" "enter")) (pmouse x y me)]
[else (void)]))))
(parent frame)
(editor visible)

45
collects/2htdp/tests/mouse-evt.ss Normal file
View File

@ -0,0 +1,45 @@
#lang scheme
(require 2htdp/universe)
(require htdp/image)
(require test-engine/scheme-tests)
(define-struct posn (x y) #:transparent)
(define world1 (make-posn 50 50))
(define world-in (make-posn 100 100))
(define world-out (make-posn 250 250))
(define mt (empty-scene 500 500))
(define sq (rectangle 10 10 'solid 'black))
(define (draw a-world)
(cond
[(equal? a-world world1)
(place-image (text "move mouse in to canvas" 11 'red) 10 10
(place-image sq (posn-x a-world) (posn-y a-world) mt))]
[(equal? a-world world-in)
(place-image (text "move mouse out of canvas" 11 'red) 10 10
(place-image sq (posn-x a-world) (posn-y a-world) mt))]
[else
(place-image sq (posn-x a-world) (posn-y a-world) mt)]))
(check-expect (mouse-handler 'w 100 100 "leave") (make-posn 250 250))
(define (mouse-handler w x y me)
(cond
[(string=? "button-down" me) w]
[(string=? "button-up" me) w]
[(string=? "drag" me) w]
[(string=? "move" me) w]
[(string=? "enter" me) world-in]
[(string=? "leave" me) world-out]))
(define (out? w) (equal? world-out w))
(define (main w)
(big-bang world1 (on-draw draw) (stop-when out?) (on-mouse mouse-handler)))
(test)
(main 0)