[racket] Custom GUI container

Neat!

That would make a great planet package,

Vincent


At Sat, 25 Feb 2012 11:40:32 -0700,
Kieron Hardy wrote:
> 
> 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)