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

world with mouse events

Browse Source 
svn: r2517
This commit is contained in:
Matthias Felleisen 2006-03-27 15:31:07 +00:00
parent 634eb6f00d
commit c3803982eb
1 changed files with 85 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
collects/htdp/world.ss
View File

@ -1,3 +1,4 @@
;; Mon Mar 27 10:29:28 EST 2006: integrated Felix's mouse events
;; Wed Jan 25 13:38:42 EST 2006: on-redraw: proc is now called on installation
;; Tue Jan 3 11:17:50 EST 2006: changed add-line behavior in world.ss
;; Sat Dec 10 19:39:03 EST 2005: fixed name, changed interface to on-key-event
@ -41,7 +42,20 @@
(provide-higher-order-primitive ;; (World KeyEvent -> World) -> true
on-key-event
(tock)
(draw)
)
;; A MouseEventType is one of:
;; - 'button-down
;; - 'button-up
;; - 'drag
;; - 'move
;; - 'enter
;; - 'leave
(provide-higher-order-primitive ;; (World Number Number MouseEvent -> World) -> true
on-mouse-event
(clack)
)
;; ---------------------------------------------------------------------------
@ -173,7 +187,9 @@
(let ([c (new (class editor-canvas%
(super-new)
(define/override (on-char e)
(on-char-proc (send e get-key-code))))
(on-char-proc (send e get-key-code)))
(define/override (on-event e)
(on-mouse-proc e)))
(parent the-frame)
(editor txt)
(style '(no-hscroll no-vscroll))
@ -209,7 +225,7 @@
(if (exact? w) w (inexact->exact w))))
#t]
;; --- key events
;; --- key and mouse events
;; KeyEvent -> Void
[define on-char-proc void]
@ -238,6 +254,56 @@
(stop-it)
the-world]
;; MouseEvent -> Void
[define on-mouse-proc void]
[define (on-mouse-event f)
(check-proc 'on-mouse-event f 4 "on-mouse-event" "four arguments")
(check-world 'on-mouse-event)
(let ([esp (current-eventspace)])
(if (eq? on-mouse-proc void)
(begin
(set! on-mouse-proc
(lambda (e)
(parameterize ([current-eventspace esp])
(queue-callback
(lambda ()
(with-handlers ([exn:break? break-handler]
[exn? exn-handler])
(set! the-world (f the-world
(send e get-x)
(send e get-y)
(cond [(send e button-down?) 'button-down]
[(send e button-up?) 'button-up]
[(send e dragging?) 'drag]
[(send e moving?) 'move]
[(send e entering?) 'enter]
[(send e leaving?) 'leave]
[else ; (send e get-event-type)
(error 'on-mouse-event
(format
"Unknown event type: ~a"
(send e get-event-type)))]
)))
(on-redraw-proc))))
#t)))
#t)
(error 'on-mouse-event "the mouse event action has been set already")))]
#|
Note an alternative to the above cond is to just
send get-event-type, which produces one of the following:
? 'enter -- mouse pointer entered the window
? 'leave -- mouse pointer left the window
? 'left-down -- left mouse button pressed
? 'left-up -- left mouse button released
? 'middle-down -- middle mouse button pressed
? 'middle-up -- middle mouse button released
? 'right-down -- right mouse button pressed (Mac OS: click with control key pressed)
? 'right-up -- right mouse button released (Mac OS: release with control key pressed)
? 'motion -- mouse moved, with or without button(s) pressed
|#
;; --- library
[define (exn-handler e)
(send the-time stop)