hans/columns-pane
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial

Browse Source
This commit is contained in:
Hans Dijkema
2025-08-06 09:37:29 +02:00
parent 5261847187
commit f43df41218
3 changed files with 198 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
info.rkt Normal file
View File

@@ -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"))

112
main.rkt Normal file
View File

@@ -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)

64
scribblings/columns-pane.scrbl Normal file
View File

@@ -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)
]