Bogdanp / racket-gui-easy

Declarative GUIs in Racket.
https://docs.racket-lang.org/gui-easy/index.html
134 stars 18 forks source link

Render popup-menus relative to a child widget? #28

Closed benknoble closed 1 year ago

benknoble commented 1 year ago

The render-popup-menu function takes x-y coordinates and renders a popup-menu (pum) relative to the root widget of a renderer.

Canvases are windows and can react to mouse events, so I can use a mixin with, say, pict-canvas to make right-clicks shows a popup-window if I have a renderer. The mouse-event's x-y coordinates are relative to the canvas (!).

I get a renderer only by calling render on the full tree of views, so its root widget is from the (window …) view.

This combines to result in the x-y coordinates being relative to the wrong part of the GUI, so the pum is in the wrong place.

Possible solutions I've come up with:

  1. Hack around it, duplicate some things from render-pum via reflection (https://github.com/benknoble/frosthaven-manager/commit/53c567cb360ec43f84302df9c50fde5ee9a24216)
  2. Translate the canvas x-y coordinates with respect to (renderer-root …). This would probably be much nicer, but I can't figure out how to do it.
  3. Manually compute approximate coordinates based on expected layout. This doesn't sit well with me, especially since I expect to re-use some views in very different compositions or layouts.

Have you run into this in the past? How did you solve it?

benknoble commented 1 year ago

Update: roughly, the following approach works:

(define (clicker-mixin …)
  (mixin (canvas<%>) ()
    (super-new)
    (define/override (on-event e)
      (case (send e get-event-type)
        [(left-down) (…)]
        [(right-down)
         (define pum (popup-menu …))
         (apply
           render-popup-menu
           (current-renderer)
           pum
           (let* ([child-x (send e get-x)]
                  [child-y (send e get-y)]
                  [top (renderer-root (current-renderer))])
             (let loop ([x child-x]
                        [y child-y]
                        [container (send this get-parent)])
               (if (eq? container top)
                 (list x y)
                 (loop (+ x (send container get-x))
                       (+ y (send container get-y))
                       (send container get-parent))))))]))))