;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Invisible Vector Library
;;; simple FlexBox-based layouting engine
;;;
;;; coded by Ketmar // Invisible Vector <ketmar@ketmar.no-ip.org>
;;; Understanding is not required. Only obedience.
;;;
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, version 3 of the License ONLY.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; this engine can layout any box set (if it is valid)
;;;
;;; the idea of the flexbox layout is very simple:
;;; the size of a box is equal to the size of its parent multiplied by the
;;; value of the its `flex` property, and divided by the sum of all the
;;; `flex` properties of all boxes included in its parent.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(begin-module 'flexlay)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; this interface is enough to implement most of the common widget properties.
;;
;; cross axis alignment is always "expand", so, for example, to implement other
;; cross axis alignment types, you can align box content using the final size
;; (the whole box).
;;
;; to implement margins, perform the necessary calculations, and add margins
;; to the result of `<min|max|pref>-size-*:`. or simply insert empty boxes
;; with the fixed size between other boxes.
;;
;; note that the layouter may ask the box to shrink itself using `set-size-*:`
;; with the size smaller than the current one. do not reject this, use minimum
;; size callback to limit the size instead.
;;
;; there is no need to pass direction to `flex:`, because flex layouting is
;; done only on the "main" direction (i.e. the direction of the parent box).
;;
;; WARNING! returned values of any properties should not change while the
;;          layouting is in progress! the only exceptions are "size",
;;          "final size" and "final position" -- they should return what was
;;          previously set with the corresponding setter.
;;
;; `new-box()` returns box object. returned object should be called with keyword method.
;; all setter methods should return the box object they were called on (i.e. `self`)
;; methods:
;;    box?: (self) return #t for boxes
;;    self: (self) return this box object
;;    parent-box: (self) return parent box or #nil
;;    %parent-box-set!: (self box) -- WARNING! this setter for internal use only! but it should be implemented.
;;    direction: (self) return direction index (HORIZ or VERT)
;;    horiz?: (self) return bool
;;    vert?: (self) return bool
;;    flex: (self) return flex property (>= 0, `0` means "no flex"
;;    min-width: (self) minimum width (>= 0)
;;    min-height: (self) minimum height (>= 0)
;;    max-width: (self) maximum width (>= 0)
;;    max-height: (self) maximum height (>= 0)
;;    pref-width: (self) initial width
;;    pref-height: (self) initial height
;;    inset-<left|right|top|bottom>: (self) internal padding
;;    widget-padding: (self) padding *between* widgets in the main direction
;;    ignore?: (self) bool -- if set, this box is ignored by the layouter
;;    collapsed?: (self) bool -- see below (EXPERIMENTAL, not properly tested!)
;;    user-data (self): arbitrary user data; the layouter never touches this
;;    next-sibling: (self) -- get next sibling or #nil
;;    prev-sibling: (self) -- get next sibling or #nil
;;    first-sibling: (self) -- get first sibling
;;    last-sibling: (self) -- get last sibling
;;    first-child: (self) -- get first child
;;    last-child: (self) -- get last child
;;    append-child: (self cbox) -- return self
;;    remove-child: (self cbox) -- return self
;;    append-child-before: (self cbox cbox-before) -- return self; if `cbox-before` is null, prepend
;;    direction-set!: (self value) -- HORIZ or VERT, return self
;;    as-horiz!: (self) -- return self
;;    as-vert!: (self) -- return self
;;    flex-set!: (self value) -- #f or >= 0, return self
;;    min-width-set!: (self value) -- #f or >= 0, not sanitized (#f means "zero"), return self
;;    min-height-set!: (self value) -- #f or >= 0, not sanitized (#f means "zero"), return self
;;    max-width-set!: (self value) -- #f or >= 0, not sanitized (#f means "unlimited"), return self
;;    max-height-set!: (self value) -- #f or >= 0, not sanitized (#f means "unlimited"), return self
;;    pref-width-set!: (self value) -- >= 0, not clamped to the min/max, return self
;;    pref-height-set!: (self value) -- >= 0, not clamped to the min/max, return self
;;    ignore-set!: (self value) -- set "ignore this box" flag, return self
;;    collapsed-set!: (self value) -- set "collapsed" flag, return self
;;    user-data-set!: (self value) -- set user data, return self
;;  the following methods are used by the layouter to keep internal state,
;;  or to set the final one. note that the layouter may call `final-position-set!:`
;;  several times, but it will never call `final-position:`. i.e. the layouter
;;  never reads any position properties, only sets them.
;;    lay-width: (self) -- this is used by the layouter
;;    lay-height: (self) -- this is used by the layouter
;;    final-width: (self) -- final size, set by the layouter
;;    final-height: (self) -- final size, set by the layouter
;;    final-x: (self) -- final position, set by the layouter
;;    final-y: (self) -- final position, set by the layouter
;;    lay-width-set!: (self value) -- this is used by the layouter, return self
;;    lay-height-set!: (self value) -- this is used by the layouter, return self
;;    final-width-set!: (self value) -- final size, set by the layouter, return self
;;    final-height-set!: (self value) -- final size, set by the layouter, return self
;;    final-x-set!: (self value) -- final position, set by the layouter, return self
;;    final-y-set!: (self value) -- final position, set by the layouter, return self
;;  the following method is used in layout parser. it is called with the property name,
;;  and property value. there should be only one value, but it could be of any type.
;;  property name is guaranteed to be a symbol, if called from the parser.
;;  the layouter knows some standard properties, but the handler is called first, so you
;;  can override standard property handling.
;;  return #f if the property is unknown.
;;    handle-property: (self name value)
;;
;; *** EXPERIMENTAL! ***
;; "collapsed" property:
;;   is this box works like "visibility:collapse"?
;;   such box will be used to calculate maximum size for cross axis,
;;   but it will be ignored for positioning.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module-export '(
  new-box
  layout
  parse-layout
  ;;
  for-each-box
  select-one-box
  find-box-by-id
  ;; directions
  HORIZ
  VERT
))

;;;OLD!
;; (inherited self kw: ...) => (invoke(self super:) kw: self ...)
;define-macro inherited(nspace env _ obj mth ... rest)
;  define gs gensym()
;  `(let ((,gs ,obj))
;    ((invoke ,gs super:) ,mth ,gs ,@rest))

;;;OLD!
;; (inherited self kw: ...) => (invoke(@self super:) kw: self ...)
;define-macro inherited(nspace env _ obj mth ... rest)
;  `((invoke @self super:) ,mth ,obj ,@rest)

;;; compiler does this for us
;; (inherited kw: ...) => (invoke(@self super:) kw: self ...)
;define-macro inherited(nspace env _ mth ... rest)
;  `((,invoke @self super:) ,mth self ,@rest)
;
;; (call kw: ...) => (invoke self kw: ...)
;define-macro call(nspace env _ mth ... rest)
;  `(,invoke self ,mth ,@rest)


;; direction codes
(constant HORIZ 0)
(constant VERT 1)
;; used in setters to indicate both directions
;(constant BOTH #t)

;; return box object.
;; default box is of zero size, the maximum size is not limited,
;; the orientation is horizontal.
define new-box()
  define id #void         ;; arbitrary box id, used by user code
  ;;
  define next #nil        ;; next sibling or #nil
  define prev #nil        ;; prev sibling or #nil
  define child-head #nil  ;; first children or #nil
  define child-tail #nil  ;; last children or #nil
  define parent #nil      ;; not used by the layouter, but nice to have here
  ;;
  define dir HORIZ        ;; container type (for boxes with children): 0:horiz, 1:vert
  define flex 0           ;; flex value; <=0 means "not flexible"
  ;; minimum, maximum and preferred sizes
  ;; initial setup will normalise the sizes (min<=pref<=max)
  ;; use `(fixnum-max)` as "unlimited" for max size
  define min-size make-vector(2 0)
  define max-size make-vector(2 (fixnum-max))
  ;; this is the initial size
  define pref-size make-vector(2 0)
  ;; calculated size (not expanded); respects min/max
  define lay-size make-vector(2 0)
  ;; calculated size (expanded); doesn't respect min/max
  define final-size make-vector(2 0)
  ;; calculated final position inside the parent (for expanded size)
  define final-pos make-vector(2 0)
  define inset-left 0
  define inset-right 0
  define inset-top 0
  define inset-bottom 0
  ;; flags
  define ignore #f    ;; ignore this box
  ;; *** EXPERIMENTAL! ***
  ;; is this box works like "visibility:collapse"?
  ;; such box will be used to calculate maximum size for cross axis,
  ;; but it will be ignored for positioning.
  define collapsed #f
  ;; arbitrary user data, not used by the layouter
  define user-data #nil
  ;;
  define good-box?(box)
    {{procedure? box} and box[box?:]}
  ;;
  define good-box-or-null?(box)
    {{null? box} or {{procedure? box} and box[box?:]}}
  ;;
  define ?box-not-adopted(box)
    assert {null? box[parent-box:]} "child box already adopted"
  ;;
  define ?box-not-chained(box)
    assert {null? box[prev-sibling:]} "box already chained"
    assert {null? box[next-sibling:]} "box already chained"
  ;;
  method-lambda box-dispatcher
    ;; getters
    box?: (self) #t
    ;self: (self) box-dispatcher
    super: (self) #nil
    id: (self) id
    parent-box: (self) parent
    direction: (self) dir
    horiz?: (self) {dir = HORIZ}
    vert?: (self) {dir = VERT}
    flex: (self) flex
    min-width: (self) min-size[HORIZ]
    min-height: (self) min-size[VERT]
    max-width: (self) max-size[HORIZ]
    max-height: (self) max-size[VERT]
    ;; initial size
    pref-width: (self) pref-size[HORIZ]
    pref-height: (self) pref-size[VERT]
    ignore?: (self) ignore
    collapsed?: (self) collapsed
    user-data: (self) user-data
    ;; calculated properties
    lay-width: (self) lay-size[HORIZ]
    lay-height: (self) lay-size[VERT]
    final-width: (self) final-size[HORIZ]
    final-height: (self) final-size[VERT]
    final-x: (self) final-pos[HORIZ]
    final-y: (self) final-pos[VERT]
    ;; WARNING! this setter for internal use only!
    %parent-box-set!: (self box)
      assert good-box-or-null?(box) "invalid parent box"
      assert {not {box eq? self}} "the box cannot adopt itself"
      {parent := box}
      self
    %prev-set!: (self box)
      assert good-box-or-null?(box) "invalid previous box"
      assert {not {box eq? self}} "the box cannot link to itself"
      {prev := box}
      self
    %next-set!: (self box)
      assert good-box-or-null?(box) "invalid next box"
      assert {not {box eq? self}} "the box cannot link to itself"
      {next := box}
      self
    ;; get various things
    prev-sibling: (self)
      prev
    next-sibling: (self)
      next
    first-sibling: (self)
      if {null? parent}
        self
        parent[first-child:]
    last-sibling: (self)
      if {null? next}
        self
        next[last-child:]
    first-child: (self)
      child-head
    last-child: (self)
      child-tail
    ;; anyone
    my-child?: (self cbox)
      if {cbox eq? self}
        {cbox := #nil}
      while {{not-null? cbox} and {not {cbox[parent-box:] eq? self}}}
        {cbox := cbox[parent-box:]}
      {not-null? cbox}
    ;; return cbox
    append-child: (self cbox)
      if {not-null? cbox}
        then
          assert good-box?(cbox) "invalid child box"
          ?box-not-adopted(cbox)
          ?box-not-chained(cbox)
          {cbox[%parent-box:] := self}
          {cbox[%prev:] := child-tail}
          if {null? child-head}
            {child-head := cbox}
          if {not-null? child-tail}
            then
              assert {null? child-tail[next-sibling:]}
              {child-tail[%next:] := cbox}
          {child-tail := cbox}
      self
    remove-child: (self cbox)
      if {not-null? cbox}
        then
          assert {not {cbox eq? self}} "wtf: remove self from children?"
          assert good-box?(cbox) "invalid child box"
          assert {cbox[parent-box:] eq? self} "cannot remove non-child"
          define cprev cbox[prev-sibling:]
          define cnext cbox[next-sibling:]
          if {null? cprev}
            then
              assert {cbox eq? child-head} "broken children chain"
              {child-head := cnext}
            else
              {cprev[%next:] := cnext}
          if {null? cnext}
            then
              assert {cbox eq? child-tail} "broken children chain"
              {child-tail := cprev}
            else
              {cnext[%prev:] := cprev}
          {cbox[%prev:] := #nil}
          {cbox[%next:] := #nil}
          {cbox[%parent-box:] := #nil}
      self
    append-child-before: (self cbox cbox-before)
      if {not-null? cbox}
        then
          assert good-box?(cbox) "invalid child box"
          ?box-not-adopted(cbox)
          ?box-not-chained(cbox)
          cond
            {{null? cbox-before} or {cbox-before eq? child-head}}
              ;; prepend
              {cbox[%parent-box:] := self}
              {cbox[%next:] := child-head}
              if {null? child-tail}
                {child-tail := cbox}
              if {not-null? child-head}
                then
                  assert {null? child-head[prev-sibling:]}
                  {child-head[%prev:] := cbox}
              {child-head := cbox}
            else
              ;; insert
              assert {cbox-before[parent-box:] eq? self} "invalid cbox-before"
              define cprev cbox-before[prev-sibling:]
              assert {not-null? cprev} "broken children chain"
              assert {cprev[next-sibling:] eq? cbox-before} "broken children chain"
              {cbox[%parent-box:] := self}
              {cbox[%prev:] := cprev}
              {cbox[%next:] := cbox-before}
              {cprev[%next:] := cbox}
              {cbox-before[%prev:] := cbox}
      self
    ;; setters
    id-set!: (self value)
      {id := value}
    ;; TODO: add better type checks!
    direction-set!: (self value)
      assert {{fixnum? value} and between?(value 0 1)} "invalid direction"
      {dir := value}
      self
    as-horiz!: (self)
      {dir := HORIZ}
      self
    as-vert!: (self)
      {dir := VERT}
      self
    flex-set!: (self value)
      assert {{false? value} or {fixnum? value}} "invalid flex value"
      {flex := (if (false? value) 0 max(0 value))}
      self
    min-width-set!: (self value)
      assert {{false? value} or {{fixnum? value} and {value >= 0}}} "invalid min width value"
      {min-size[HORIZ] := (if {false? value} 0 value)}
    min-height-set!: (self value)
      assert {{false? value} or {{fixnum? value} and {value >= 0}}} "invalid min height value"
      {min-size[VERT] := (if {false? value} 0 value)}
      self
    max-width-set!: (self value)
      assert {{false? value} or {{fixnum? value} and {value >= 0}}} "invalid max width value"
      {max-size[HORIZ] := (if {false? value} (fixnum-max) value)}
      self
    max-height-set!: (self value)
      assert {{false? value} or {{fixnum? value} and {value >= 0}}} "invalid max height value"
      {max-size[VERT] := (if {false? value} (fixnum-max) value)}
      self
    pref-width-set!: (self value)
      assert {{fixnum? value} and {value >= 0}} "invalid pref width value"
      {pref-size[HORIZ] := value}
      self
    pref-height-set!: (self value)
      assert {{fixnum? value} and {value >= 0}} "invalid pref width value"
      {pref-size[VERT] := value}
      self
    ignore-set!: (self value)
      assert {boolean? value} "invalid ignore value"
      {ignore := value}
      self
    collapsed-set!: (self value)
      assert {boolean? value} "invalid collapsed value"
      {collapsed := value}
      self
    user-data-set!: (self value)
      {user-data := value}
      self
    ;; DO NOT USE! this is only for the layouter!
    lay-width-set!: (self value)
      assert {fixnum? value} "invalid lay width value"
      {lay-size[HORIZ] := value}
      self
    lay-height-set!: (self value)
      assert {fixnum? value} "invalid lay height value"
      {lay-size[VERT] := value}
      self
    final-width-set!: (self value)
      assert {fixnum? value} "invalid final width value"
      {final-size[HORIZ] := value}
      self
    final-height-set!: (self value)
      assert {fixnum? value} "invalid final height value"
      {final-size[VERT] := value}
      self
    final-x-set!: (self value)
      assert {fixnum? value} "invalid final x value"
      {final-pos[HORIZ] := value}
      self
    final-y-set!: (self value)
      assert {fixnum? value} "invalid final y value"
      {final-pos[VERT] := value}
      self
    final-shift!: (self dx dy)
      {self[final-x:] := {dx + self[final-x:]}}
      {self[final-y:] := {dy + self[final-y:]}}
    ;;
    inset-left: (self) inset-left
    inset-right: (self) inset-right
    inset-top: (self) inset-top
    inset-bottom: (self) inset-bottom
    inset-left-set!: (self value) {inset-left := max(0 value)}
    inset-right-set!: (self value) {inset-right := max(0 value)}
    inset-top-set!: (self value) {inset-top := max(0 value)}
    inset-bottom-set!: (self value) {inset-bottom := max(0 value)}
    ;;
    handle-property: (self name value)
      ;printf "basic-prop: %o is %o\n" name value
      case name
        (direction:)
          case value
            (horiz:) {self[direction:] := HORIZ}
            (vert:) {self[direction:] := VERT}
            else
              assert {{fixnum? value} and between?(value 0 1)} "invalid \"direction:\" property value"
              {self[direction:] := value}
          #t
        (flex:)
          {self[flex:] := value}
          #t
        (ignore:)
          {self[ignore:] := value}
          #t
        (collapsed:)
          {self[collapsed:] := value}
          #t
        (user-data:)
          {self[user-data:] := value}
          #t
        (id:)
          {self[id:] := value}
          #t
        (pref-width:)
          {self[pref-width:] := value}
          #t
        (pref-height:)
          {self[pref-height:] := value}
          #t
        (min-width:)
          {self[min-width:] := value}
          #t
        (min-height:)
          {self[min-height:] := value}
          #t
        (max-width:)
          {self[max-width:] := value}
          #t
        (max-height:)
          {self[max-height:] := value}
          #t
        (call-lambda:)
          value(self)
          #t
        (inset-left:)
          {self[inset-left:] := value}
          #t
        (inset-right:)
          {self[inset-right:] := value}
          #t
        (inset-top:)
          {self[inset-top:] := value}
          #t
        (inset-bottom:)
          {self[inset-bottom:] := value}
          #t
        (h-inset:)
          {self[inset-left:] := value}
          {self[inset-right:] := value}
          #t
        (v-inset:)
          {self[inset-top:] := value}
          {self[inset-bottom:] := value}
          #t
        (inset:)
          {self[inset-left:] := value}
          {self[inset-right:] := value}
          {self[inset-top:] := value}
          {self[inset-bottom:] := value}
          #t
        (fixed-width:)
          {self[min-width:] := value}
          {self[max-width:] := value}
          {self[pref-width:] := value}
          #t
        (fixed-height:)
          {self[min-height:] := value}
          {self[max-height:] := value}
          {self[pref-height:] := value}
          #t
        (no-expand:)
          case value
            (x:)
              {self[max-width:] := self[pref-width:]}
            (y:)
              {self[max-height:] := self[pref-height:]}
            (both:)
              {self[max-width:] := self[pref-width:]}
              {self[max-height:] := self[pref-height:]}
            else
              error "invalid \"no-expand:\" property value"
          #t
        else
          #f


#|
the algorithm is multipass, and it also does separate layouting for
horizontal and vertical containers.

each box has the following basic properties:
  min-size
  max-size
  pref-size (preferred, initial size)
also, there are runtime properties:
  lay-size (current/real box size) -- on exit, this is unexpanded box size
  final-size (expanded box size; see below)
  final-position

let's see how the horizontal container is layouted.

first pass: set initial sizes.
recursively call `set-init-sizes()` for all children.
each child sets its initial size to `pref-size`, and calls
`set-init-sizes()` for all its children.

second pass: calculate bounding size.
recursively call `fit-to-size()` for all children.
on this pass, we simply sum sizes of all children, and check if
they fit in our max-size. if they aren't, calculate the extra,
and try to shrink each children equally (respecting their min-sizes).
loop over all children until either there is no more extra, or
all children refused to shrink. if we have some extra space left,
add it to our size (because this is everything we can do here).
again, respect max-size of the container here.

third pass: set real sizes.
recursively call `calc-final-size()` for all children.
on this pass, we have correct sizes set, so we simply process
flexbox expanding.
the size of a box is equal to the size of its parent multiplied by
the value of the its `flex` property, and divided by the sum of all
the `flex` properties of all boxes included in its parent.

the last box will be expanded to take the remaining container size
(respecting box max-size).

the same thing is done for vertical containers.

to calculate the size of the root, do not enforce its max-size.
the layouter will use pref-sizes of all children, and properly set
the size of the root.
|#


;; all access to box properties should be done with the following wrappers.
;; this makes code modification easier in case of API changes.
define valid?(box)
  assert {{null? box} or box[box?:]}
  cond
    {null? box}   #f
    box[ignore?:] #f
    else          #t

define foreach-child(box proc)
  {box := (if valid?(box) box[first-child:] #nil)}
  while {not-null? box}
    if {not box[ignore?:]}
      proc box
    {box := box[next-sibling:]}

(define (main-dir? box dir) {{zero? box[direction:]} eq? {zero? dir}})
(define (collapsed? box) box[collapsed?:])
(define (child-uncollapsed? box cbox dir) {not {main-dir?(box dir) and collapsed?(cbox)}})

define vh-method
  case-lambda
    (box dir h-kw v-kw)
      cond
        {dir = HORIZ} invoke(box h-kw)
        {dir = VERT}  invoke(box v-kw)
        else error("bad dir")
    (box dir h-kw v-kw value)
      cond
        {dir = HORIZ} invoke(box h-kw value)
        {dir = VERT}  invoke(box v-kw value)
        else error("bad dir")

(define (min-size box dir) vh-method(box dir min-width: min-height:))
(define (min-size! box dir value) vh-method(box dir min-width-set!: min-height-set!: value))
(define (max-size box dir) vh-method(box dir max-width: max-height:))
(define (max-size! box dir value) vh-method(box dir max-width-set!: max-height-set!: value))
(define (pref-size box dir) vh-method(box dir pref-width: pref-height:))
(define (size box dir) vh-method(box dir lay-width: lay-height:))
(define (size! box dir value) vh-method(box dir lay-width-set!: lay-height-set!: value))
(define (final-size box dir) vh-method(box dir final-width: final-height:))
(define (final-size! box dir value) vh-method(box dir final-width-set!: final-height-set!: value))
(define (final-pos! box dir value) vh-method(box dir final-x-set!: final-y-set!: value))
(define (get-flex box) box[flex:])
(define (inset-left box) box[inset-left:])
(define (inset-right box) box[inset-right:])
(define (inset-top box) box[inset-top:])
(define (inset-bottom box) box[inset-bottom:])

;; calculate children size
define calc-children-size(box laydir)
  define res
  cond
    main-dir?(box laydir)
      {res := 0}
      foreach-child box
        lambda (cbox)
          inc! res size(cbox laydir)
    else
      {res := (fixnum-min)}
      foreach-child box
        lambda (cbox)
          {res := max(res size(cbox laydir))}
  cond
    {laydir eq? HORIZ}
      inc! res {inset-left(box) + inset-right(box)}
    else
      inc! res {inset-top(box) + inset-bottom(box)}
  res

define set-init-sizes(box)
  define set-size(box dir)
    max-size! box dir max(0 max-size(box dir))
    min-size! box dir clamp(min-size(box dir) 0 max-size(box dir))
    size! box dir clamp(pref-size(box dir) min-size(box dir) max-size(box dir))
  ;;
  set-size box HORIZ
  set-size box VERT
  foreach-child box set-init-sizes


;; main layouter entry point
define layout(root)
  ;; calculate and return new "extra"
  ;; check if something was shrinked by comparing the original value
  ;; with the returned one.
  define fit-shrink(box extra laydir good-box? calc-delta)
    foreach-child box
      lambda (cbox)
        if {{positive? extra} and child-uncollapsed?(box cbox laydir)}
          then
            define oldbsz size(cbox laydir)
            if {oldbsz > min-size(cbox laydir)}
              then
                define delta min(extra max(1 calc-delta(cbox))
                                 {oldbsz - min-size(cbox laydir)})
                assert {positive? delta}
                fit-to-size cbox laydir {oldbsz - delta}
                if {size(cbox laydir) < oldbsz}
                  dec! extra {oldbsz - size(cbox laydir)}
    max(0 extra)
  ;;
  define shrink-loop(box laydir maxsz)
    define csz
    define prev-extra
    define new-extra
    define nonflextotal
    define flextotal
    define was-shrink #t
    while was-shrink
      {was-shrink := #f}
      ; check if our size fits in max
      if {{csz := calc-children-size(box laydir)} > maxsz}
        then
          ; can't fit, need to shrink children
          ; count flex and non-flex amount by which we can shrink
          {nonflextotal := 0}
          {flextotal := 0}
          foreach-child box
            lambda (cbox)
              if {child-uncollapsed?(box cbox laydir) and
                  {size(cbox laydir) > min-size(cbox laydir)}}
                if {positive? get-flex(cbox)}
                  inc! flextotal get-flex(cbox)
                  inc! nonflextotal size(cbox laydir)
          ; how much we need to subtract?
          {prev-extra := {csz - maxsz}}
          ; if we have flex children, try to shrink them first
          if {positive? flextotal}
            then
              {new-extra := fit-shrink(box prev-extra laydir
                     (lambda (box) {positive? get-flex(box)})
                     (lambda (box) {{prev-extra * flextotal} div get-flex(box)}))}
              if {was-shrink := {prev-extra <> new-extra}}
                {prev-extra := new-extra}
          ; now try non-flex children
          ; shrink proportinally to child box sizes
          if {positive? nonflextotal}
            then
              {new-extra := fit-shrink(box prev-extra laydir
                     (lambda (box) {get-flex(box) <= 0})
                     (lambda (box) {{prev-extra * size(box laydir)} div nonflextotal}))}
              if {prev-extra <> new-extra}
                {was-shrink := #t}
  ;;
  ;; fit into the given size.
  ;; recursively calls `fit-to-size()` for all children.
  ;; on this pass, we simply sum sizes of all children, and check if
  ;; they fit in our maxsize. if they aren't, calculate the extra,
  ;; shrink each children, and re-fit their contents.
  ;; loop over all children until either there is no more extra, or
  ;; all children refuse to shrink. if we have some extra left,
  ;; add it to our size (because this is everything we can do now).
  ;; this also expands box size to accomodate all children.
  define fit-to-size(box laydir maxszOrig)
    define maxsz max(0 clamp(maxszOrig min-size(box laydir) max-size(box laydir)))
    if {positive? maxsz}
      then
        define ccount 0 ; number of visible children
        ; recursively call `fit-to-size()` for all children
        foreach-child box
          lambda (cbox)
            fit-to-size cbox laydir maxsz
            inc! ccount
        cond
          {zero? ccount}
            ; shrink this box
            size! box laydir max(min(size(box laydir) maxsz) min-size(box laydir))
          else
            shrink-loop box laydir maxsz
            ; expand this box (up to max size) to fit all children
            size! box laydir
              min(max(size(box laydir) min(maxsz calc-children-size(box laydir)))
                  max-size(box laydir))
  ;;
  define wipe-final-size(box laydir)
    size! box laydir min-size(box laydir)
    final-pos! box laydir 0
    final-size! box laydir min-size(box laydir)
    foreach-child box (lambda (cbox) (wipe-final-size cbox laydir))
  ;;
  ;; return calculated flextotal
  define calc-flex-total(box laydir)
    define flextotal 0
    foreach-child box
      lambda (cbox)
        define flex get-flex(cbox)
        if {{positive? flex} and main-dir?(box laydir) and {not collapsed?(cbox)}}
          inc! flextotal flex
        ; also, set initial final size
        final-size! cbox laydir size(cbox laydir)
    flextotal
  ;;
  define redistribute-flex(box laydir flextotal)
    if {positive? flextotal}
      then
        ; grow flexboxes
        assert main-dir?(box laydir)
        define totalsz
        define csz calc-children-size(box laydir)
        define left {size(box laydir) - csz}
        define wasChange #t
        while {{positive? left} and wasChange}
          {wasChange := #f}
          {totalsz := left}
          foreach-child box
            lambda (cbox)
              define flex get-flex(cbox)
              if {{positive? left} and {positive? flex} and
                  child-uncollapsed?(box cbox laydir)}
                then
                  define maxsz max-size(cbox laydir)
                  define finsz final-size(cbox laydir)
                  if {finsz < maxsz}
                    then
                      define addsp min(left max(1 {{totalsz * flex} div flextotal})
                                       {maxsz - finsz})
                      final-size! cbox laydir {finsz + addsp}
                      dec! left addsp
                      {wasChange := #t}
  ;;
  define setup-coords(box laydir)
    define inset 0
    define fsz final-size(box laydir)
    cond
      {laydir eq? HORIZ}
        {inset := inset-left(box)}
        dec! fsz {inset + inset-right(box)}
      else
        {inset := inset-top(box)}
        dec! fsz {inset + inset-bottom(box)}
    {fsz := max(0 fsz)}
    define coord 0
    define last #nil ; save last child, we may need it later
    foreach-child box
      lambda (cbox)
        final-size! cbox laydir min(final-size(cbox laydir) max-size(cbox laydir))
        if child-uncollapsed?(box cbox laydir)
          then
            {last := cbox}
            final-pos! cbox laydir {coord + inset}
            if main-dir?(box laydir)
              inc! coord final-size(cbox laydir)
              else
                define bsz size(cbox laydir)
                define msz max-size(cbox laydir)
                ; expand each box on cross axis (respecting max size)
                if {{bsz < fsz} and {bsz < msz}}
                  final-size! cbox laydir min(fsz msz)
    ; expand the last box
    if {{not-null? last} and {coord < fsz} and main-dir?(box laydir)}
      then
        {coord := {fsz - coord}}
        assert {positive? coord}
        final-size! last laydir min({final-size(last laydir) + coord} max-size(last laydir))
  ;;
  define calc-final-size(box laydir)
    ; degenerate case?
    if {size(box laydir) <= 0}
      wipe-final-size box laydir
      else
        ; expand all flexboxes
        ; the size of a box is equal to the size of its parent multiplied by the
        ; value of the its `flex` property, and divided by the sum of all the
        ; `flex` properties of all boxes included in its parent.
        ; actually, calculate the remaining free space, and distribute it.
        redistribute-flex box laydir calc-flex-total(box laydir)
        setup-coords box laydir
        ; now do the same for all visible children.
        ; this is done as the last step, because children have their sizes set now.
        ; we will temporarily set box size property to calculated size, so
        ; the box will correctly redistribute everything.
        foreach-child box
          lambda (cbox)
            if {not collapsed?(cbox)}
              then
                ;;HACK!
                define osz size(cbox laydir)
                size! cbox laydir final-size(cbox laydir)
                calc-final-size cbox laydir
                size! cbox laydir osz
  ;;
  ;; main
  if valid?(root)
    then
      ; phase 0
      set-init-sizes root
      ; phase 1
      fit-to-size root HORIZ max-size(root HORIZ)
      fit-to-size root VERT max-size(root VERT)
      ; phase 2
      final-pos! root HORIZ 0
      final-pos! root VERT 0
      final-size! root HORIZ size(root HORIZ)
      final-size! root VERT size(root VERT)
      calc-final-size root HORIZ
      calc-final-size root VERT


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; parse layout from list of lists ;-)
;; WARNING! this doesn't use layouter abstraction API!
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; create-box(parent type)
;; parent can be #nil
;; return box or #nil on invalid type
define parse-layout(create-box lay-list)
  define try-new-box-kw(parent type)
    if {keyword? type}
      create-box parent type
      #nil
  ;;
  define parse-box-property(box name value)
    assert {keyword? name} "malformed box property list"
    ;printf "*** name=%o; id=%o\n" name invoke(box debug-id:)
    if {{pair? value} and {car(value) eq? procedure:}}
      {value := cadr(value)(box)}
    if {not {true? box[handle-property: name value]}}
      error(string-append("unknown box property: \"" symbol->string(name) "\""))
  ;;
  define parse-box-def(box prop-list)
    define name
    define value
    while {pair? prop-list}
      {name := car(prop-list)}
      {prop-list := cdr(prop-list)}
      cond
        {pair? name} ;; contents, or property pair
          {value := try-new-box-kw(box car(name))}
          cond
            {null? value}
              parse-box-def(box name)
            {lax-cadr(name) eq? default:}
              #void
            else
              parse-box-def(value cdr(name))
        {keyword? name}
          {value := try-new-box-kw(box name)}
          cond
            {null? value}
              assert {pair? prop-list}
                string-append("missing value for box property: \"" symbol->string(name) "\"")
              {value := car(prop-list)}
              {prop-list := cdr(prop-list)}
              parse-box-property box name value
            {lax-caar(name) eq? default:}
              #void
            else
              parse-box-def(value prop-list)
              {prop-list := #nil}
        {symbol? name}
          error string-append("bad box property name: \"" symbol->string(name) "\"")
        else
          error "malformed box property list"
  ;;
  assert {pair? lay-list} "empty layout list"
  define box try-new-box-kw(#nil car(lay-list))
  assert {not-null? box} "layout list should start with the box element"
  parse-box-def box cdr(lay-list)
  box


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; box selection
;; WARNING! this doesn't use layouter abstraction API!
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define wild-match(pat str)
  define ch
  define savedp -1
  define saveds -1
  define sidx 0
  define pidx 0
  define res #nil
  ;;
  define backtrack()
    if {negative? savedp}
      {res := #f} ;; no saved "*"
      else
        ;; backtrack
        {sidx := inc!(saveds)}
        {pidx := savedp}
  ;;
  define peek-pidx-char()
    if {pidx >= string-length(pat)}
      -1
      pat[pidx]
  ;;
  define get-pidx-char()
    if {pidx >= string-length(pat)}
      -1
      pat[{inc!(pidx) - 1}]
  ;;
  define range?(ch)
    define ch1
    define ch2
    define xres #nil
    define pch get-pidx-char()
    ;;
    define parse-range-cont(ch1)
      {pch := get-pidx-char()}
      cond
        {pch = -1}
          ch1
        {pch <> #\-}
          ch1
        {peek-pidx-char() = 93}
          ch1
        else
          define res get-pidx-char()
          {pch := get-pidx-char()}
          res
    ;;
    define inv {pch = 94}
    if inv
      {pch := get-pidx-char()}
    ;; first char is special
    ;printf "000: ch=%c; pch=%c\n" ch pch
    if {{pch = 93} or {pch = #\-}}
      then
        {xres := {ch = pch}}
        {pch := get-pidx-char()}
    ;printf "001:  ch=%c; pch=%c; xres=%o\n" ch pch xres
    while {{pch <> -1} and {pch <> 93}}
      {ch1 := pch}
      {ch2 := parse-range-cont(ch1)}
      ;printf "002:   ch1=%c; ch2=%c; ch=%c; pch=%c; xres=%o\n" ch1 ch2 ch pch xres
      if {null? xres}
        {xres := between?(ch ch1 ch2)}
    ;printf "004:    pch=%c; xres=%o\n" pch xres
    if {null? xres}
      {xres := #f}
    if inv
      {not xres}
      xres
  ;;
  ;printf "000: pat=%o; str=%o\n" pat str
  while {{null? res} and {sidx < string-length(str)}}
    ;printf "001: pat=%o; str=%o; sidx=%o; pidx=%o\n" pat str sidx pidx
    {ch := get-pidx-char()}
    ;printf "002: pat=%o; str=%o; sidx=%o; pidx=%o; ch=%c\n" pat str sidx pidx ch
    cond
      {ch = #\*}
        if {pidx >= string-length(pat)}
          {res := #t} ;; ends with "*"
          else
            {saveds := sidx}
            {savedp := pidx}
      {ch = 91} ; range
        if range?(str[sidx])
          inc! sidx
          if {null? res}
            backtrack()
      {{ch <> #\?} and {ch <> str[sidx]}}
        backtrack()
      else
        inc! sidx
  ;printf "100: pat=%o; str=%o; res=%o; sidx=%o; pidx=%o\n" pat str res sidx pidx
  if {not-null? res}
    res
    else
      ;; skip final "*", if there are any
      while {{pidx < string-length(pat)} and {pat[pidx] = #\*}}
        inc! pidx
      {pidx >= string-length(pat)}


;; proc(box): return #t to stop
define for-each-box(root path proc)
  define path-vec make-vector()
  ;;
  define parse-path(path)
    cond
      {empty-string? path}
        #void
      {path[0] = #\/}
        parse-path substring(path 1)
      {{string-length(path) = 2} and {path[0] = #\*} and {path[1] = #\*}}
        vector-push! path-vec "**"
      {{string-length(path) > 2} and {path[0] = #\*} and {path[1] = #\*}}
        assert {path[2] = #\/} "invalid path"
        vector-push! path-vec "**"
        parse-path substring(path 3)
      else
        define idx 1
        while {{idx <> string-length(path)} and {path[idx] <> #\/}}
          inc! idx
        vector-push! path-vec substring(path 0 idx)
        parse-path substring(path idx)
  ;;
  define get-box-id(box)
    define id box[id:]
    cond
      {string? id} id
      {number? id} number->string(id)
      {symbol? id} symbol->string(id)
      else #nil
  ;;
  define check-path(box)
    define match(box path-idx)
      cond
        {null? box}
          #f
        {negative? path-idx}
          #t
        {path-vec[path-idx] = "**"}
          if match(box {path-idx - 1})
            #t
            match box[parent-box:] path-idx
        {null? get-box-id(box)}
          #f
        wild-match(path-vec[path-idx] get-box-id(box))
          ;printf "wild-hit! id=%d; part(%d)=%o\n" invoke(box id:) path-idx path-vec[path-idx]
          if {zero? path-idx}
            #t
            match box[parent-box:] {path-idx - 1}
        else
          ;printf "match: id=%d; part(%d)=%o\n" invoke(box id:) path-idx path-vec[path-idx]
          #f
    ;;
    cond
      {{path-vec[{vector-length(path-vec) - 1}] <> "**"} and
       {not-null? box[first-child:]}}
        ;printf "skipped! %d\n" invoke(box id:)
        #f
      else
        match box {vector-length(path-vec) - 1}
  ;;
  define do-box(box)
    define res #nil
    while {{null? res} and {not-null? box}}
      cond
        {check-path(box) and {true? proc(box)}}
          {res := #t}
        do-box(box[first-child:])
          {res := #t}
        else
          {box := box[next-sibling:]}
    {true? res}
  ;;
  assert {not {empty-string? path}} "invalid path"
  parse-path(path)
  assert {positive? vector-length(path-vec)} "invalid path"
  define cmp-res do-box(root)
  vector-resize! path-vec 0 ;; help GC a little
  cmp-res


;; fox or #nil
define select-one-box(root path)
  define res #nil
  for-each-box root path
    lambda (box)
      if {null? res}
        then
          {res := box}
          #t
        else
          #f
  res


;; box or #nil
define find-box-by-id
  case-lambda
    (root id)
      find-box-by-id root id eqv?
    (root id cmp-proc)
      cond
        {null? root}
          #nil
        {root[id:] cmp-proc id}
          root
        ;find-box-by-id(invoke(root first-child:) id cmp-proc) not-null? =>
        ;  identity
        ;; no need to use predicate, as "=> understands "#nil" and "#f" as false value
        find-box-by-id(root[first-child:] id cmp-proc) =>
          identity
        else
          find-box-by-id root[next-sibling:] id cmp-proc


(end-module 'flexlay)
