#lang scheme/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%))