93 lines
2.5 KiB
Racket
93 lines
2.5 KiB
Racket
#lang racket/gui
|
|
|
|
(provide
|
|
locked-text-field-mixin
|
|
locked-text-field%
|
|
locked-combo-field%
|
|
union-container-mixin
|
|
union-pane%
|
|
union-panel%)
|
|
|
|
;; ======================================================================
|
|
;;
|
|
;; LOCKED TEXT FIELD CLASS / MIXIN
|
|
;;
|
|
;; ======================================================================
|
|
|
|
(define locked-text-field-mixin
|
|
(mixin [(class->interface text-field%)] []
|
|
|
|
(inherit get-editor)
|
|
|
|
(define/override (set-value str)
|
|
(send (get-editor) lock #f)
|
|
(super set-value str)
|
|
(send (get-editor) lock #t))
|
|
|
|
(super-new)
|
|
|
|
(init [undo-history 0])
|
|
|
|
(send (get-editor) lock #t)
|
|
(send (get-editor) set-max-undo-history undo-history)))
|
|
|
|
(define locked-text-field%
|
|
(locked-text-field-mixin text-field%))
|
|
|
|
(define locked-combo-field%
|
|
(locked-text-field-mixin combo-field%))
|
|
|
|
|
|
;; ======================================================================
|
|
;;
|
|
;; UNION PANEL CLASS / MIXIN
|
|
;;
|
|
;; ======================================================================
|
|
|
|
(define union-container-mixin
|
|
(mixin [area-container<%>] []
|
|
|
|
(super-new)
|
|
|
|
(inherit get-children get-alignment)
|
|
|
|
(define/public (choose child)
|
|
(for ([child* (get-children)])
|
|
(send child* show (eq? child* child))))
|
|
|
|
(define/override (container-size info)
|
|
(match info
|
|
[(list (list w h _ _) ...)
|
|
(values (apply max 0 w)
|
|
(apply max 0 h))]))
|
|
|
|
(define/override (place-children info w0 h0)
|
|
(let*-values ([(ha va) (get-alignment)]
|
|
[(hp) (horiz->place ha)]
|
|
[(vp) (vert->place va)])
|
|
(map (lambda (child) (place-child hp vp w0 h0 child)) info)))
|
|
|
|
(define/private (place-child hp vp w0 h0 child)
|
|
(match child
|
|
[(list cw ch sw sh)
|
|
(let*-values ([(x w) (place-dim hp w0 cw sw)]
|
|
[(y h) (place-dim vp h0 ch sh)])
|
|
(list x y w h))]))
|
|
|
|
(define/private (place-dim p maximum minimum stretch?)
|
|
(match (list p stretch?)
|
|
[(list _ #t) (values 0 maximum)]
|
|
[(list 'min #f) (values 0 minimum)]
|
|
[(list 'mid #f) (values (floor (/ (- maximum minimum) 2)) minimum)]
|
|
[(list 'max #f) (values (- maximum minimum) minimum)]))
|
|
|
|
(define/private horiz->place
|
|
(match-lambda ['left 'min] ['center 'mid] ['right 'max]))
|
|
|
|
(define/private vert->place
|
|
(match-lambda ['top 'min] ['center 'mid] ['bottom 'max]))))
|
|
|
|
(define union-pane% (union-container-mixin pane%))
|
|
(define union-panel% (union-container-mixin panel%))
|
|
|