[plt-scheme] A Square Canvas

I can't quite figure out what sizes you want (is something backwards
somewhere in the below, by chance?) but maybe you're looking for the
min-width and min-height methods of the canvas? If you set those and
then make the canvas not stretchable, it will be exactly that size.

Robby

On Sun, Jul 13, 2008 at 5:48 AM, Jens Axel Soegaard
<jensaxel at soegaard.net> wrote:
> Hi All,
>
> I'd like to create a square canvas - as big as possible.
>
> The normal geometry management makes it easy to make an
> rectangular canvas that uses as much space as possible.
>
> At first I thought I could get the retangular size and then
> shrink the canvas to use the minimum of the horizontal
> and vertival sizes - but canvases have no resize method.
>
> Is using a non-stretchable canvas my best option? Or is
> there a trick I have overlooked?
>
> A simplified version of my layout is found below.
>
> /Jens Axel
>
>
>
> #lang scheme/gui
>
> (require framework)
>
> (define-values (full-screen-width full-screen-height) (get-display-size #t))
> (define-values (canvas-width canvas-height) (values 0 0))
>
> (let* ([frame (new frame%
> [label "Exercises"]
> [width full-screen-width] [height full-screen-height]
> [style '(no-resize-border no-caption hide-menu-bar no-system-menu)])]
> [header-panel (new vertical-panel%
> [parent frame] [alignment '(center center)] [stretchable-height #f])]
> [header-msg (new message% [parent header-panel] [label "Problem Name"])]
> ; exercise + instructions
> [main-panel (new horizontal-panel% [parent frame] [vert-margin 20]
> [horiz-margin 20])]
> [left (new vertical-panel%
> [parent main-panel] [vert-margin 20] [horiz-margin 20]
> [min-width (- (* 2 (quotient full-screen-width 3)) 100)])]
> [right (new vertical-panel%
> [parent main-panel] [min-width (quotient full-screen-width 3)]
> [alignment '(center center)])]
> [statement (new message%
> [parent left] [label "A problem statement"] [vert-margin 10])]
> [instructions (new editor-canvas%
> [parent right] [editor (new text%)] [style '(auto-vscroll no-hscroll)])]
> ; status message
> [status-panel (new horizontal-panel% [parent frame] [stretchable-height
> #f])]
> [status-msg (new message% [parent status-panel] [label "Status goes here"])]
> [quit-button (new button% [parent right] [label "Quit"]
> [callback (λ (but ev) (send frame show #f))])])
> (define exercise-canvas%
> (class canvas%
> (define/public (get-canvas-size)
> (set!-values (canvas-width canvas-height) (send this get-size)))
> (define/override (on-event e)
> (send this get-canvas-size))
> (define (on-size e) (send this get-screen-size))
> (define (on-move e) (send this get-screen-size))
> (super-new)))
> (letrec ([canvas (new exercise-canvas%
> [parent left] [style '(border)]
> [stretchable-width #t] [stretchable-height #t]
> [paint-callback (λ (b dc) '...)])])
> ; move frame to top-left of screen
> (let-values ([(dx dy) (send frame client->screen 0 0)])
> (send frame move 0 (- dy)))
> (send frame show #t)
> (send (send instructions get-editor) insert "Solve the problem at the
> left.")))
>
> _________________________________________________
>  For list-related administrative tasks:
>  http://list.cs.brown.edu/mailman/listinfo/plt-scheme
>
>