46 lines
1.2 KiB
Racket
46 lines
1.2 KiB
Racket
#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)
|