I've been on the lookout for the best way to style MrEd components. One suggestion that was made was to mix and match the drawing API (really, a canvas% object) with the other widgets (like buttons and panels). Today, I gave this a shot, and the result is a canvas-panel% - panel% that you can draw on the background of.
Specifically, I used it to draw a colored border around a collection of components.
While the solution isn't perfect - it did demonstrate to me that between the power of the canvas% objects, and the relative ease of creating custom containers. I think this approach may really come in handy for customizing apps.
Before I share the code, I should put in an especially strong disclaimer. This is my first container component, so I have no idea if this is the recommended approach for solving this problem. Or even if this is correct. Or even if this will cause some horrible resource leak that will ruin my application and your day. Use at your own risk.
There, with that out of the way, here's the code:
;;
;; A panel that can hold children, but is also a canvas.
;;
(module canvas-panel mzscheme
(require (lib "mred.ss" "mred")
(lib "class.ss")
"../../lib/list.ss")
(provide canvas-panel%)
(define canvas-panel%
(class panel%
(inherit get-width get-height get-size)
(init-field parent (paint-callback (lambda (canvas dc) (void))) (panel-padding '(2 2 2 2)))
(super-new (parent parent))
;; Layout our our children. We'll be stacking them
;; one on top of another, inside the panel.
;;
;; Note: the first child in our list is always
;; the canvas object which serves as the background.
(define/override (place-children info width height)
(let* ((left-margin (fourth panel-padding))
(current-y (first panel-padding))
(canvas-info (first info))
(children-info (rest info)))
(cons
(list 0 0 width height)
(map (lambda (min-width min-height horiz-stretch? vert-stretch?)
; x, y, w, h
(let ((v (list left-margin
current-y
(if horiz-stretch?
(- width (* 2 (second panel-padding))
min-width)
min-height)))
(set! current-y (+ current-y min-height))
v))
(map first children-info)
(map second children-info)
(map third children-info)
(map fourth children-info)))))
;; The size of this container. Which is:
;; width: our largest child + the padding use on this panel
;; height: our children's heights added up + the padding
(define/override (container-size info)
(let ((children-info (rest info)))
(values (+ (second panel-padding)
(fourth panel-padding)
(fold max 0 (map first children-info)))
(+ (first panel-padding)
(third panel-padding)
(fold + 0 (map second children-info))))))
;; Define our canvas that people can draw on,
;; Notice that the parent is this. That's key.
;; When asked to layout our children, the first child.
(define canvas (new canvas%
(parent this)
(paint-callback paint-callback)))
(define/public (get-canvas)
canvas)
)))
To define a new panel% you need to implement two functions: container-size and place-children.
It took me some time to wrap my head around how these methods work. What struck me as odd is that the list of children are passed into these functions. In other words, my component doesn't need to keep track of its list of children. Instead, it just needs to say, given a particular set of children, how to position them and how big the container is.
Once I really processed this - it hit me that this whole layout thing isn't so bad. I just needed to do some simple arithmetic on the information passed into these functions, to implement the exact layout I needed. This let me focus just on the calculation aspect of laying the children out, and not the actual management of the children themselves. Turns out, it's a nice approach.
The other set of dots I connected is how I could get the canvas% object to be laid out under the other components. To make it work, I set the canvas%'s parent as myself. The result: it would be added to my list of children I'd be responsible for laying out, and I'd be given control over it. Not only that, but I'd know it was first in the list (because I added it first) and could do something intelligent with this fact. If you look at the code above, you'll see that when I'm calculating my size or positioning my components, I'm treating the first child specially.
Again, once I put the pieces together, I realized that the component itself wouldn't be hard to write at all.
And here's an example of using the component:
(require "canvas-panel.ss"
(lib "mred.ss" "mred")
(lib "class.ss"))
(define f (new frame% (label "CanvasPanelTest") (width 400) (height 400)))
(define c (new canvas-panel%
(parent f)
(stretchable-height #f)
(panel-padding '(10 10 10 10))
(paint-callback (lambda (canvas dc)
(let ((w (send canvas get-width))
(h (send canvas get-height)))
(send dc set-pen (instantiate pen% ("Black" 1 'transparent)))
(send dc set-brush (instantiate brush% ("Blue" 'solid)))
(send dc draw-rectangle 0 0 w h)
(send dc set-pen (instantiate pen% ("Green" 10 'solid)))
(send dc draw-line 0 0 w 0)
(send dc draw-line 0 h w h))))))
(new text-field% (parent c) (label "Name: "))
(new text-field% (parent c) (label "Rank: "))
(new text-field% (parent c) (label "Serial #: "))
(new button% (parent c) (label "Submit"))
(send f show #t)
