[plt-scheme] Grid control...

Rian Douglas writes:
 > I've checked the mail archive and from time time to someone has asked
 > after a grid control.  I'm wondering if any work has been done towards
 > this

I hacked this up a while ago; it seems to work but it's probably a bit 
simple-minded:

(module grid-panel mzscheme
  (require (lib "class.ss"))
  (require (lib "mred.ss" "mred"))
  (provide grid-panel%)

  (define grid-panel%
    (class panel%
      (init-field columns rows)
      (define/public (get-columns) columns)
      (define/public (get-rows) rows)

      (define/public (set-columns new-cols)
	(set! columns new-cols)
	(send this container-flow-modified))
      (define/public (set-rows new-rows)
	(set! rows new-rows)
	(send this container-flow-modified))

      (define/override (container-size size-specs)
	(if (null? size-specs)
	    (values 0 0)
	    (let-values (((width height)
			  (send this get-size))
			 ((client-width client-height)
			  (send this get-client-size)))
	      (let ((border-width (- width client-width))
		    (border-height (- height client-height))
		    (column-width (apply max (map car size-specs)))
		    (row-height (apply max (map cadr size-specs))))
		(values (+ (* column-width columns) border-width)
			(+ (* row-height rows) border-height))))))

      (define/override (place-children size-specs width height)
	(let ((column-width (quotient width columns))
	      (row-height (quotient height rows)))
	  (define (make-info size-spec i)
	    (let ((row (quotient i columns))
		  (col (remainder i columns)))
	      (apply (lambda (min-width min-height
			      stretchable-width stretchable-height)
		       (list (* col column-width) (* row row-height)
			     (if stretchable-width column-width min-width)
			     (if stretchable-height row-height min-height)))
		     size-spec)))
	  (do ((size-specs size-specs (cdr size-specs))
	       (i 0 (+ i 1))
	       (info '() (cons (make-info (car size-specs) i) info)))
	      ((null? size-specs) (reverse info)))))

      (super-instantiate ())
      ))
)

I'd appreciate seeing any improvements you make.

--dougo at ccs.neu.edu