From 33df6b2bfa456d9f07db77f257fecdfb7a8ad0da Mon Sep 17 00:00:00 2001 From: Matthias Felleisen Date: Sat, 21 Feb 2009 00:14:17 +0000 Subject: [PATCH] fixed mouse event bug svn: r13756 --- collects/2htdp/private/check-aux.ss | 2 +- collects/2htdp/private/world.ss | 8 +++++--- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/collects/2htdp/private/check-aux.ss b/collects/2htdp/private/check-aux.ss index b0a404c4d7..ff81e7b968 100644 --- a/collects/2htdp/private/check-aux.ss +++ b/collects/2htdp/private/check-aux.ss @@ -59,7 +59,7 @@ (define (mouse-event->parts e) (define x (- (send e get-x) 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 dragging?) 'drag] [(send e moving?) 'move] diff --git a/collects/2htdp/private/world.ss b/collects/2htdp/private/world.ss index 6daa9e326f..4e29a5882d 100644 --- a/collects/2htdp/private/world.ss +++ b/collects/2htdp/private/world.ss @@ -180,10 +180,12 @@ (when live (pkey (send e get-key-code)))) ;; deal with mouse events if live and within range (define/override (on-event e) - (define l (mouse-event->parts e)) + (define-values (x y me) (mouse-event->parts e)) (when live - (when (and (<= 0 (first l) width) (<= 0 (second l) height)) - (pmouse . l))))) + (cond + [(and (<= 0 x width) (<= 0 y height)) (pmouse x y me)] + [(memq me '(leave enter)) (pmouse x y me)] + [else (void)])))) (parent frame) (editor visible) (style '(no-hscroll no-vscroll))