[racket] Custom GUI container

Hi all,

I needed a GUI container that allows the contained components to choose
where they are placed in the container.  i.e. A container that doesn't try
to stretch and re-'place' its containees, instead letting the containees
figure out where they want to be.

I was surprised that this particular container/containee use-case wasn't
readily available in Racket (since it is 'the' fundamental layout
elsewhere), so I implemented a version and post it here in case it is
useful to others. (If I'm going about it wrong, then please do let me know.)

Cheers,

Kieron.

p.s. I notice the canvas border is actually painted only on the top and
left (see capture-self-placeable). Should the border also be painted on the
bottom and right?

****

#lang racket/gui

; Specify in an interface the methods that a containee needs to make it
self-placeable.
(define self-placeable-containee<%>
  (interface ()
    get-preferred-x get-preferred-y get-preferred-x-y
    set-preferred-x set-preferred-y set-preferred-x-y))

; Define in a mixin the default implementations for a self-placeable
containee.
(define (self-placeable-containee%% %)
  (class* % (self-placeable-containee<%>)
    (super-new)

    (define preferred-x 0)
    (define preferred-y 0)

    (define/public (get-preferred-x)
      preferred-x)
    (define/public (get-preferred-y)
      preferred-y)
    (define/public (get-preferred-x-y)
      (values preferred-x preferred-y))

    (define/public (set-preferred-x x)
      (set! preferred-x x))
    (define/public (set-preferred-y y)
      (set! preferred-y y))
    (define/public (set-preferred-x-y x y)
      (set! preferred-x x)
      (set! preferred-y y))
    ))

; Define a custom container panel that can place the self-placeable
containees.
(define placer-panel%
  (class panel%
    (inherit get-children min-width min-height)

    (super-new)

    ; container-size is called with each child's dimensions and
strechability,
    ; and returns the container's required minimum dimensions.
    ; In this case, the containee size's are ignored,
    ; and the container's (previously set) minimum width and height are
returned.
    [define/override (container-size containee-sizes)
;      (printf "container-size:~a\n" containee-sizes)
      (values (min-width) (min-height))]

    ; place-children is called with each child's dimensions and
strechability,
    ; and returns each child's location and dimensions.
    ; In this case, each containee is simply asked where it wants to be
(previously set).
    ; No adustments are made to a containee's size so as to use any empty
space in the container.
    ; i.e. A containee's strechability is ignored, and each containee
remains the (previously set) minimum width and height.
    [define/override (place-children containee-sizes container-width
container-height)
;      (printf "place-children:~a\n" containee-sizes)
      (map (lambda (containee-size containee)
             (let*-values ([(min-width min-height h-stretch? v-stretch?)
                            (apply values containee-size)]
                           [(x y)
                            (send containee get-preferred-x-y)]
                           )
               (list x y min-width min-height)))
           containee-sizes
           (get-children))]
    ))

(define self-placeable-canvas%
  (class (self-placeable-containee%% canvas%)
    (inherit set-preferred-x-y)
    (init x y)
    (super-new)
    (set-preferred-x-y x y)
    ))

(define frame-1 (new frame%
                     [label "Self Placeable Containees"]
                     [x 30]
                     [y 30]
                     [min-width 800]
                     [min-height 600]))

(define panel-1 (new placer-panel%
                     [parent frame-1]
                     ))

(define canvas-1 (new self-placeable-canvas%
                      [parent panel-1]
                      [style (list 'border)]
                      [x 25]
                      [y 25]
                      [min-width 500]
                      [min-height 75]))

(define canvas-2 (new self-placeable-canvas%
                      [parent panel-1]
                      [style (list 'border)]
                      [x 275]
                      [y 275]
                      [min-width 100]
                      [min-height 100]))

(define canvas-3 (new self-placeable-canvas%
                      [parent panel-1]
                      [style (list 'border)]
                      [x 600]
                      [y 125]
                      [min-width 100]
                      [min-height 400]))

(send frame-1 show #t)
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20120225/c872adaf/attachment-0001.html>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: Capture-self-placeable.PNG
Type: image/png
Size: 67008 bytes
Desc: not available
URL: <http://lists.racket-lang.org/users/archive/attachments/20120225/c872adaf/attachment-0001.png>