[plt-scheme] Re: on-event on snips seems a little weird

On Thu, Jun 19, 2008 at 1:55 AM, Danny Yoo <dyoo at cs.wpi.edu> wrote:
> I'm trying to get a snip to do something when I hover my mouse over
> it; I suspect I need to have the snip somehow have keyboard focus.  Is
> there a way to get a snip to get events even if it doesn't have
> keyboard focus?


Ah, ok.  I see how syncheck is doing it now.  Ok, that works well
enough.  I end up firing off the events manually from the enclosing
editor, so that I get to control when the snip gets the event,
regardless of focus.


Here's my example, just in case it comes in handy to others.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#lang scheme/gui


;; event-in-snip? mouse-event snip -> void
;; Returns true if the mouse event is hovering over the snip.
;; If the snip isn't attached to an admin, or isn't visible, returns #f.
(define (event-hovering-over-snip? an-event a-snip)
  (cond
    [(and (send a-snip get-admin)
          (send (send a-snip get-admin) get-dc))
     (let ([dc (send (send a-snip get-admin) get-dc)]
           [editor (send (send a-snip get-admin) get-editor)])
       (let-values ([(x-box y-box) (values (box 0) (box 0))]
                    [(w-box h-box) (values (box 0) (box 0))])
         (send editor get-snip-location a-snip x-box y-box)
         (send a-snip get-extent dc
               (unbox x-box) (unbox y-box) w-box h-box #f #f #f #f)

         (and (<= (unbox x-box) (send an-event get-x)
                  (+ (unbox x-box) (unbox w-box)))
              (<= (unbox y-box) (send an-event get-y)
                  (+ (unbox y-box) (unbox h-box))))))]
    [else
     #f]))


;; event-editor-mixin: editor<%> -> editor<%>
;; Adds an interface for doing event listening to an editor.
(define (event-editor-mixin super%)
  (class super%
    (define listeners (make-weak-hasheq))

    (define/public (add-event-listener a-listener)
      (hash-set! listeners a-listener #t))

    (define/override (on-event event)
      (for ([listener (in-hash-keys listeners)])
        (with-handlers ([exn:fail? (lambda (exn) (void))])
          (listener event)))
      (super on-event event))

    (super-new)))


;; exercising code, not really a test case.
(define (test)
  (define my-editor-snip%
    (class editor-snip%
      (define over? #f)

      (define/public (handle-event an-event)
        (cond [(and (not over?) (event-hovering-over-snip? an-event this))
               (printf "over~n")
               (set! over? #t)]
              [(and over? (not (event-hovering-over-snip? an-event this)))
               (printf "not over~n")
               (set! over? #f)]))

      (super-new)))

  (define f (new frame% [label ""]))
  (define e (new (event-editor-mixin text%)))
  (define c (new editor-canvas% [parent f] [editor e]))

  (define snip (make-object my-editor-snip%))
  (send e add-event-listener
        (lambda (evt)
          (send snip handle-event evt)))

  (send (send snip get-editor)
        insert "hi")

  (send e insert snip)

  (send f show #t))