Initial

info.rkt

@@ -0,0 +1,22 @@
+#lang info
+
+(define pkg-authors '(hnmdijkema))
+(define version "0.1")
+(define license 'Apache-2.0)
+(define collection "columns-pane")
+(define pkg-desc "A pane that arranges it's children widgets in columns")
+
+(define scribblings
+  '(
+    ("scribblings/columns-pane.scrbl" () (library) "columns-pane%")
+    )
+  )
+
+(define deps
+  '("racket/gui"))
+
+(define build-deps
+  '("racket-doc"
+    "rackunit-lib"
+    "scribble-lib"))
+

main.rkt

@@ -0,0 +1,112 @@
+#lang racket
+
+(require racket/gui)
+
+(provide columns-pane%)
+
+(define columns-pane%
+  (class vertical-pane%
+    (super-new)
+
+    ;; Internal data
+    (define hpanes #f)
+    (define creating-row #f)
+    (define current-col 0)
+    (define current-row 0)
+
+    (define/private (mk-hpane*)
+      (set! creating-row #t)
+      (let ((new-pane (new horizontal-pane% [parent this]
+                           [spacing spacing] [horiz-margin horiz-margin] [vert-margin (round (/ spacing 2))]
+                           [stretchable-height #f])))
+        (set! creating-row #f)
+        new-pane)
+      )
+    
+    (define/private (get-row* i)
+      (when (eq? hpanes #f)
+        (set! hpanes (make-vector (+ i 1) #f)))
+      (when (>= i (vector-length hpanes))
+        (let ((v hpanes))
+          (set! hpanes (make-vector (+ i 1) #f))
+          (vector-copy! hpanes 0 v)))
+      (let ((p (vector-ref hpanes i)))
+        (when (eq? p #f)
+          (set! p (mk-hpane*))
+          (vector-set! hpanes i p))
+        p))
+
+    (define/private (child* c r)
+      (let* ((hpane (vector-ref hpanes r))
+             (children (send hpane get-children))
+             (child (if (>= c (length children)) #f (list-ref children c)))
+             )
+        child))
+    
+    (define/private (max-width* c r w)
+      (if (< r (vector-length hpanes))
+          (let* ((child (child* c r))
+                 (child-width (if (eq? child #f) 0 (send child get-width))))
+            (max-width* c (+ r 1) (if (> child-width w) child-width w)))
+          w))
+
+    (define/private (set-min-width* c r w)
+      (when (< r (vector-length hpanes))
+        (let ((child (child* c r)))
+          (when (not (eq? child #f))
+            (send child min-width w))
+          (set-min-width* c (+ r 1) w))))
+    
+    (define/private (arrange-col* c)
+      (let ((w (max-width* c 0 -1)))
+        (set-min-width* c 0 w)))
+        
+    (define/private (arrange*)
+      (letrec ((cols (length (send (vector-ref hpanes 0) get-children)))
+               (f (lambda (c)
+                    (when (< c cols)
+                      (arrange-col* c)
+                      (f (+ c 1)))))
+               )
+        (f 0)))
+
+    ;; Fields that can be given
+    (init-field [vert-margin 5] [horiz-margin 5] [spacing 5] [columns 1])
+
+    ;; Public methods
+    (define/override (after-new-child child)
+      (super after-new-child child)
+      (when (eq? creating-row #f)
+        (let ((hpane (get-row* current-row)))
+          (send child reparent hpane)
+          (set! current-col (+ current-col 1))
+          (when (>= current-col columns)
+            (set! current-row (+ current-row 1))
+          (set! current-col 0))
+          )))
+
+    (define/override (place-children info width height)
+      (let ((r (super place-children info width height)))
+        (arrange*)
+        r
+        ))
+    
+    ))
+
+
+;;; GUI Testing
+
+;(define win (new frame% [label "Hi there!"]))
+;(define grid-group (new group-box-panel% [label "My group"] [parent win] [horiz-margin 10] [vert-margin 10]))
+
+;(define g (new columns-pane% [parent grid-group] [columns 3]))
+
+;(define btn1 (new button% [parent g] [label "Button 1"]))
+;(define g1 (new gauge%  [parent g] [stretchable-width #t] [label "gauge 1"] [range 100]))
+;(define lbl1 (new message% [parent g] [label "This is lbl 1"]))
+
+;(define btn2 (new button% [parent g] [label "Btn 2"]))
+;(define lbl2 (new message% [parent g] [label "This is lbl 2"]))
+
+;(send win show #t)
+

scribblings/columns-pane.scrbl

@@ -0,0 +1,64 @@
+#lang scribble/manual
+
+@(require
+   scribble/example
+   (for-label racket/base
+              racket/string
+              racket/file))
+
+(define myeval
+   (make-base-eval '(require columns-pane)))
+
+@title[#:tag "columns pane"]{Arrange widgets in columns and make them of equal width per column}
+
+@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
+
+@defmodule[columns-pane]{This module provides a new class @racket[columns-pane%] that can be used to arrange widgets in a table like fashon, making all widgets in a column of the same width}
+
+@defclass/title[columns-pane% vertical-pane% ()]{
+
+A columns pane arranges its subwindows in columns. The number of columns must be given in advance and initializes to 1. 
+
+@defconstructor[([parent (or/c (is-a?/c frame%) (is-a?/c dialog%) 
+                               (is-a?/c panel%) (is-a?/c pane%))]
+                 [columns 1]
+                 [vert-margin spacing-integer? 0]
+                 [horiz-margin spacing-integer? 0]
+                 [border spacing-integer? 0]
+                 [spacing spacing-integer? 0]
+                 [alignment (list/c (or/c 'left 'center 'right)
+                                    (or/c 'top 'center 'bottom))
+                            '(left center)]
+                 [min-width (or/c dimension-integer? #f) #f]
+                 [min-height (or/c dimension-integer? #f) #f]
+                 [stretchable-width any/c #t]
+                 [stretchable-height any/c #t])]{
+
+}}
+
+
+@#reader scribble/comment-reader 
+[racketblock
+   (require racket/gui)
+   (require columns-pane)
+
+   (define win (new frame% [label "A new frame"]))
+   (define grid-group (new group-box-panel%
+                           [label "A new group"] [parent win] [horiz-margin 10] [vert-margin 10]))
+
+   ;; Adding the columns pane with 3 columns
+   (define g (new columns-pane% [parent grid-group] [columns 3]))
+
+   (define btn1 (new button% [parent g] [label "Button 1"]))
+   (define g1 (new gauge%  [parent g] [stretchable-width #t] [label "gauge 1"] [range 100]))
+   (define lbl1 (new message% [parent g] [label "This is lbl 1"]))
+
+   (define btn2 (new button% [parent g] [label "Btn 2"]))
+   (define lbl2 (new message% [parent g] [label "This is lbl 2"]))
+
+   ;; Now, when the window is shown, the columns pane will arrange it's children
+   ;; to have the same width in each column. 
+   (send win show #t)
+]
+
+