Holmes UI: non-working draft of FlexBox layouter

diff --git a/src/game/Doom2DF.dpr b/src/game/Doom2DF.dpr
index 7daaaea83727b95ee5252ab62194eaee6e8ce732..e81b4ae970bdaa871bed0e864ebf94105417be26 100644 (file)
--- a/src/game/Doom2DF.dpr
+++ b/src/game/Doom2DF.dpr
@@ -114,7 +114,8 @@ uses
   sdlcarcass in '../gx/sdlcarcass.pas',
   glgfx in '../gx/glgfx.pas',
   gh_ui_common in '../gx/gh_ui_common.pas',
-  gh_ui in '../gx/gh_ui.pas';
+  gh_ui in '../gx/gh_ui.pas',
+  gh_flexlay in '../gx/gh_flexlay.pas';
 
 {$IFDEF WINDOWS}
   {$R *.res}

diff --git a/src/gx/gh_flexlay.pas b/src/gx/gh_flexlay.pas
new file mode 100644 (file)
index 0000000..cc01bb6
--- /dev/null
+++ b/src/gx/gh_flexlay.pas
@@ -0,0 +1,844 @@
+{$INCLUDE ../shared/a_modes.inc}
+unit gh_flexlay;
+
+(*
+first pass:
+  set all 'temp-flex' flags for controls to 'flex'
+  reset all 'laywrap' flags for controls
+  build group arrays; for each group: find max size for group, adjust 'wantsize' controls to group max size
+  call 'calc max size' for top-level control
+  flags set:
+    'firsttime'
+
+second pass:
+  calcluate desired sizes (process flexes) using 'wantsize', set 'desiredsize' and 'desiredpos'
+    if control has children, call 'second pass' recursively with this control as parent
+  flags set:
+    'group-element-changed', if any group element size was changed
+    'wrapping-changed', if not 'firsttime', and wrapping was changed (i.e. first pass will not set the flag)
+
+third pass:
+  if 'group-element-changed':
+    for each group: adjust controls to max desired size (wantsize), set 'temp-flex' flags to 0 for 'em, set 'second-again' flag
+  for other controls: if 'desiredsize' > 'maxsize', set 'wantsize' to 'maxsize', set 'temp-flex' flag to 0, set 'second-again' flag
+  if 'second-again' or 'wrapping-changed':
+    reset 'second-again'
+    reset 'wrapping-changed'
+    reset 'firsttime'
+    goto second pass
+
+fourth pass:
+  set 'actualsize' and 'actualpos' to 'desiredsize' and 'desiredpos'
+  return
+
+calc max size:
+  set 'wantsize' to max(size, maxsize, 0)
+  if 'size' is negative:
+    set 'temp-flex' flag to 0
+  if has children:
+    call 'calc max size' for each child
+    set 'desiredmax' to 'wantsize'
+    do lines, don't distribute space (i.e. calc only wrapping),
+      for each complete line, set 'desiredmax' to max(desiredmax, linesize)
+    if 'maxsize' >= 0:
+      set 'desiredmax' to min(desiredmax, maxsize)
+    set 'wantsize' to 'desiredmax'
+  return
+
+
+wrapping lines:
+  try to stuff controls in line until line width is less or equal to maxsize
+  distribute flex for filled line
+  continue until we still has something to stuff
+
+
+for wrapping:
+  we'll hold 'laywrap' flag for each control; it will be set if this control
+  starts a new line (even if this is the first control in line, as it is obviously
+  starts a new line)
+
+  on redoing second pass, if 'laywrap' flag changed, set 'wrapping-changed' flag
+*)
+
+
+(*
+ControlT:
+  function getDefSize (): TLaySize; // default size; <0: use max size
+  function getMaxSize (): TLaySize; // max size; <0: set to some huge value
+  function getFlex (): Integer; // <=0: not flexible
+  function isHorizBox (): Boolean; // horizontal layout for children?
+  function canWrap (): Boolean; // for horizontal boxes: can wrap children? for child: `false` means 'nonbreakable at *next* ctl'
+  function isLineStart (): Boolean; // `true` if this ctl should start a new line; ignored for vertical boxes
+  function getAlign (): Integer; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
+  function getExpand (): Boolean; // expanding in non-main direction: `true` will ignore align and eat all available space
+  procedure setActualSizePos (constref apos: TLayPos; constref asize: TLaySize);
+  function getHGroup (): AnsiString; // empty: not grouped
+  function getVGroup (): AnsiString; // empty: not grouped
+  function nextSibling (): ControlT;
+  function firstChild (): ControlT;
+*)
+
+interface
+
+uses
+  gh_ui_common;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+type
+  generic TFlexLayouterBase<ControlT> = class
+  public
+    type CtlT = ControlT;
+
+  private
+    type LayControlIdx = Integer;
+
+  private
+    // flags
+    const
+      FlagHorizBox = LongWord(1) shl 0; // horizontal layout for children
+      FlagLineStart = LongWord(1) shl 1;
+      FlagLineCanWrap = LongWord(1) shl 2;
+      // internal
+      FlagLineDidWrap = LongWord(1) shl 3; // will be set when line was wrapped
+      FlagInGroup = LongWord(1) shl 4; // set if this control is a member of any group
+      FlagExpand = LongWord(1) shl 5;
+      FlagLineFirst = LongWord(1) shl 6;
+
+  private
+    type
+      PLayControl = ^TLayControl;
+      TLayControl = record
+      public
+        myidx: LayControlIdx;
+        tempFlex: Integer;
+        flags: LongWord; // see below
+        aligndir: Integer;
+        wantsize, desiredsize, maxsize: TLaySize;
+        desiredpos: TLayPos;
+        ctl: ControlT;
+        parent: LayControlIdx; // = -1;
+        firstChild: LayControlIdx; // = -1;
+        nextSibling: LayControlIdx; // = -1;
+
+      private
+        function getDidWrap (): Boolean; inline;
+        procedure setDidWrap (v: Boolean); inline;
+
+      public
+        procedure initialize (); inline;
+
+        function horizBox (): Boolean; inline;
+        function lineStart (): Boolean; inline;
+        function canWrap (): Boolean; inline;
+        function inGroup (): Boolean; inline;
+        function expand (): Boolean; inline;
+        function firstInLine (): Boolean; inline;
+
+      public
+        property didWrap: Boolean read getDidWrap write setDidWrap;
+      end;
+
+      PLayGroup = ^TLayGroup;
+      TLayGroup = record
+        name: AnsiString;
+        ctls: array of LayControlIdx;
+      end;
+
+      TLayCtlArray = array of TLayControl;
+      TLayGrpArray = array of TLayGroup;
+
+  private
+    ctlist: TLayCtlArray;
+    groups: array[0..1] of TLayGrpArray; // horiz, vert
+
+    firstTime: Boolean;
+    groupElementChanged: Boolean;
+    wrappingChanged: Boolean;
+
+  private
+    procedure fixFlags (cidx: LayControlIdx);
+    procedure doChildren (parent: LayControlIdx; child: ControlT);
+    procedure appendToGroup (const gname: AnsiString;cidx: LayControlIdx;gidx: Integer);
+    procedure setupGroups ();
+
+    // this also sets `tempFlex`
+    procedure calcMaxSizeInternal (cidx: LayControlIdx);
+
+    procedure fixLine (me: PLayControl; i0, i1: LayControlIdx; cury: Integer; var spaceLeft: Single; var flexTotal: Integer; var flexBoxCount: Integer);
+    // do box layouting; call `layBox()` recursively if necessary
+    procedure layBox (boxidx: LayControlIdx);
+
+    procedure firstPass ();
+    procedure secondPass ();
+    procedure thirdPass ();
+    procedure fourthPass ();
+
+    procedure dumpList (cidx: LayControlIdx; indent: Integer);
+
+  public
+    type
+      TChildrenEnumerator = record
+      private
+        ctls: TLayCtlArray;
+        cur: Integer;
+        first: Boolean;
+      public
+        constructor Create (constref actls: TLayCtlArray; acur: Integer);
+        function moveNext (): Boolean; inline;
+        function getCurrent (): PLayControl; inline;
+        function getEnumerator (): TChildrenEnumerator; inline;
+        property current: PLayControl read getCurrent;
+      end;
+
+  public
+    constructor Create ();
+    destructor Destroy (); override;
+
+    // clear build lists
+    procedure clear ();
+
+    // build control and group lists
+    procedure setup (root: ControlT);
+
+    function forChildren (cidx: LayControlIdx): TChildrenEnumerator; inline;
+
+    procedure layout ();
+
+    procedure dumpFlat ();
+    procedure dump ();
+  end;
+
+
+implementation
+
+uses
+  utils;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+procedure TFlexLayouterBase.TLayControl.initialize (); inline;
+begin
+  FillChar(self, 0, sizeof(self));
+  parent := -1;
+  firstChild := -1;
+  nextSibling := -1;
+end;
+
+function TFlexLayouterBase.TLayControl.horizBox (): Boolean; inline; begin result := ((flags and FlagHorizBox) <> 0); end;
+function TFlexLayouterBase.TLayControl.lineStart (): Boolean; inline; begin result := ((flags and FlagLineStart) <> 0); end;
+function TFlexLayouterBase.TLayControl.canWrap (): Boolean; inline; begin result := ((flags and FlagLineCanWrap) <> 0); end;
+function TFlexLayouterBase.TLayControl.inGroup (): Boolean; inline; begin result := ((flags and FlagInGroup) <> 0); end;
+function TFlexLayouterBase.TLayControl.expand (): Boolean; inline; begin result := ((flags and FlagExpand) <> 0); end;
+function TFlexLayouterBase.TLayControl.firstInLine (): Boolean; inline; begin result := ((flags and FlagLineFirst) <> 0); end;
+
+function TFlexLayouterBase.TLayControl.getDidWrap (): Boolean; inline; begin result := ((flags and FlagLineDidWrap) <> 0); end;
+procedure TFlexLayouterBase.TLayControl.setDidWrap (v: Boolean); inline; begin if (v) then flags := flags or FlagLineDidWrap else flags := flags and (not FlagLineDidWrap); end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+constructor TFlexLayouterBase.TChildrenEnumerator.Create (constref actls: TLayCtlArray; acur: Integer);
+begin
+  ctls := actls;
+  cur := acur;
+  first := true;
+end;
+
+function TFlexLayouterBase.TChildrenEnumerator.moveNext (): Boolean; inline;
+begin
+  if first then
+  begin
+    if (cur >= 0) and (cur < Length(ctls)) then cur := ctls[cur].firstChild else cur := -1;
+    first := false;
+  end
+  else
+  begin
+    cur := ctls[cur].nextSibling;
+  end;
+  result := (cur >= 0);
+end;
+
+function TFlexLayouterBase.TChildrenEnumerator.getCurrent (): PLayControl; inline;
+begin
+  result := @ctls[cur];
+end;
+
+function TFlexLayouterBase.TChildrenEnumerator.getEnumerator (): TChildrenEnumerator; inline;
+begin
+  result := self;
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+constructor TFlexLayouterBase.Create ();
+begin
+  ctlist := nil;
+  groups[0] := nil;
+  groups[1] := nil;
+
+  firstTime := false;
+  groupElementChanged := false;
+  wrappingChanged := false;
+end;
+
+
+destructor TFlexLayouterBase.Destroy ();
+begin
+  clear();
+  inherited;
+end;
+
+
+function TFlexLayouterBase.forChildren (cidx: LayControlIdx): TChildrenEnumerator; inline;
+begin
+  result := TChildrenEnumerator.Create(ctlist, cidx);
+end;
+
+
+procedure TFlexLayouterBase.clear ();
+begin
+  ctlist := nil;
+  groups[0] := nil;
+  groups[1] := nil;
+end;
+
+
+procedure TFlexLayouterBase.fixFlags (cidx: LayControlIdx);
+var
+  lc: PLayControl;
+begin
+  assert((cidx >= 0) and (cidx < Length(ctlist)));
+  lc := @ctlist[cidx];
+  //lc.flags := 0;
+  if (lc.ctl.isHorizBox) then lc.flags := lc.flags or FlagHorizBox;
+  if (lc.ctl.isLineStart) then lc.flags := lc.flags or FlagLineStart;
+  if (lc.ctl.canWrap) then lc.flags := lc.flags or FlagLineCanWrap;
+  if (lc.ctl.getExpand) then lc.flags := lc.flags or FlagExpand;
+  lc.aligndir := lc.ctl.getAlign;
+end;
+
+
+procedure TFlexLayouterBase.doChildren (parent: LayControlIdx; child: ControlT);
+var
+  cidx: LayControlIdx = -1;
+  lc: PLayControl;
+begin
+  assert((parent >= 0) and (parent < Length(ctlist)));
+  assert(ctlist[parent].firstChild = -1);
+  while (child <> nil) do
+  begin
+    SetLength(ctlist, Length(ctlist)+1);
+    lc := @ctlist[High(ctlist)];
+    if (cidx = -1) then
+    begin
+      cidx := LayControlIdx(High(ctlist));
+      ctlist[parent].firstChild := cidx;
+      // first child is always linestart
+      lc.flags := lc.flags or FlagLineStart or FlagLineFirst;
+    end
+    else
+    begin
+      ctlist[cidx].nextSibling := LayControlIdx(High(ctlist));
+      cidx := LayControlIdx(High(ctlist));
+    end;
+    lc.myidx := cidx;
+    lc.ctl := child;
+    lc.parent := parent;
+    fixFlags(cidx);
+    doChildren(cidx, child.firstChild);
+    child := child.nextSibling;
+  end;
+end;
+
+
+procedure TFlexLayouterBase.appendToGroup (const gname: AnsiString; cidx: LayControlIdx; gidx: Integer);
+var
+  f: Integer;
+begin
+  if (Length(gname) = 0) then exit;
+  assert((cidx >= 0) and (cidx < Length(ctlist)));
+  assert((gidx = 0) or (gidx = 1));
+  ctlist[cidx].flags := ctlist[cidx].flags or FlagInGroup;
+  for f := 0 to High(groups[gidx]) do
+  begin
+    if (groups[gidx][f].name = gname) then
+    begin
+      SetLength(groups[gidx][f].ctls, Length(groups[gidx][f].ctls)+1);
+      groups[gidx][f].ctls[High(groups[gidx][f].ctls)] := cidx;
+      exit;
+    end;
+  end;
+  // new group
+  f := Length(groups[gidx]);
+  SetLength(groups[gidx], f+1);
+  groups[gidx][f].name := gname;
+  SetLength(groups[gidx][f].ctls, Length(groups[gidx][f].ctls)+1);
+  groups[gidx][f].ctls[High(groups[gidx][f].ctls)] := cidx;
+end;
+
+
+procedure TFlexLayouterBase.setupGroups ();
+var
+  idx: Integer;
+  lc: PLayControl;
+begin
+  for idx := 0 to High(ctlist) do
+  begin
+    lc := @ctlist[idx];
+    appendToGroup(lc.ctl.getHGroup, LayControlIdx(idx), 0);
+    appendToGroup(lc.ctl.getVGroup, LayControlIdx(idx), 1);
+  end;
+end;
+
+
+// build control and group lists
+procedure TFlexLayouterBase.setup (root: ControlT);
+begin
+  clear();
+  if (root = nil) then exit;
+  try
+    SetLength(ctlist, 1);
+    ctlist[0].myidx := 0;
+    ctlist[0].ctl := root;
+    fixFlags(0);
+    ctlist[0].flags := ctlist[0].flags or FlagLineStart or FlagLineFirst;
+    doChildren(0, root.firstChild);
+    setupGroups();
+  except
+    clear();
+    raise;
+  end;
+end;
+
+
+// this also sets `tempFlex`
+procedure TFlexLayouterBase.calcMaxSizeInternal (cidx: LayControlIdx);
+var
+  lc, c: PLayControl;
+  msz: TLaySize;
+  negw{, negh}: Boolean;
+  curwdt, curhgt, totalhgt: Integer;
+  doWrap: Boolean;
+begin
+  if (cidx < 0) or (cidx >= Length(ctlist)) then exit;
+
+  lc := @ctlist[cidx];
+  msz := lc.ctl.getMaxSize;
+  //lc.wantsize := lc.ctl.getDefSize;
+  negw := (lc.wantsize.w <= 0);
+  //negh := (lc.wantsize.h <= 0);
+
+  //if (lc.wantsize.w < msz.w) lc.wantsize.w := msz.w;
+  //if (lc.wantsize.h < msz.h) lc.wantsize.h := msz.h;
+
+  //writeln('calcsize #', cidx, '; wantsize=', lc.wantsize, '; ctl.maxsize=', msz);
+
+  lc.tempFlex := lc.ctl.getFlex;
+
+  for c in forChildren(cidx) do calcMaxSizeInternal(c.myidx);
+
+  if (lc.horizBox) then
+  begin
+    // horizontal boxes
+    if (negw) then lc.tempFlex := 0; // size is negative: don't expand
+    curwdt := 0;
+    curhgt := 0;
+    totalhgt := 0;
+    for c in forChildren(cidx) do
+    begin
+      // new line?
+      doWrap := (not c.firstInLine) and (c.lineStart);
+      // need to wrap?
+      if (not doWrap) and (lc.canWrap) and (c.canWrap) and (msz.w > 0) and (curwdt+c.wantsize.w > lc.wantsize.w) then doWrap := true;
+      if (doWrap) then
+      begin
+        totalhgt += curhgt;
+        if (lc.wantsize.w < curwdt) then lc.wantsize.w := curwdt;
+        curwdt := 0;
+        curhgt := 0;
+      end;
+      curwdt += c.wantsize.w;
+      if (curhgt < c.wantsize.h) then curhgt := c.wantsize.h;
+    end;
+    totalhgt += curhgt;
+    if (lc.wantsize.w < curwdt) then lc.wantsize.w := curwdt;
+    if (lc.wantsize.h < totalhgt) then lc.wantsize.h := totalhgt;
+  end
+  else
+  begin
+    // vertical boxes
+    curhgt := 0;
+    for c in forChildren(cidx) do
+    begin
+      if (lc.wantsize.w < c.wantsize.w) then lc.wantsize.w := c.wantsize.w;
+      curhgt += c.wantsize.h;
+    end;
+    if (lc.wantsize.h < curhgt) then lc.wantsize.h := curhgt;
+  end;
+  if (lc.wantsize.w < 1) then lc.wantsize.w := 1;
+  if (lc.wantsize.h < 1) then lc.wantsize.h := 1;
+  lc.maxsize := msz;
+  if (lc.maxsize.w < lc.wantsize.w) then lc.maxsize.w := lc.wantsize.w;
+  if (lc.maxsize.h < lc.wantsize.h) then lc.maxsize.h := lc.wantsize.h;
+end;
+
+
+procedure TFlexLayouterBase.firstPass ();
+var
+  f, c: Integer;
+  needRecalcMaxSize: Boolean;
+  gtype: Integer;
+  grp: PLayGroup;
+  maxsz: Integer;
+  cidx: LayControlIdx;
+begin
+  // reset all 'laywrap' flags for controls, set initial 'wantsize'
+  for f := 0 to High(ctlist) do
+  begin
+    ctlist[f].didWrap := false;
+    ctlist[f].wantsize := ctlist[f].ctl.getDefSize;
+  end;
+  // setup sizes
+  calcMaxSizeInternal(0); // this also sets `tempFlex`
+  // find max size for group, adjust 'wantsize' controls to group max size
+  needRecalcMaxSize := false;
+  for gtype := 0 to 1 do
+  begin
+    for f := 0 to High(groups[gtype]) do
+    begin
+      grp := @groups[gtype][f];
+      maxsz := 0;
+      for c := 0 to High(grp.ctls) do
+      begin
+        cidx := grp.ctls[c];
+        if (maxsz < ctlist[cidx].wantsize[gtype]) then maxsz := ctlist[cidx].wantsize[gtype];
+      end;
+      for c := 0 to High(grp.ctls) do
+      begin
+        cidx := grp.ctls[c];
+        if (maxsz <> ctlist[cidx].wantsize[gtype]) then
+        begin
+          needRecalcMaxSize := true;
+          ctlist[cidx].wantsize[gtype] := maxsz;
+        end;
+      end;
+    end;
+  end;
+  // recalc maxsize if necessary
+  if (needRecalcMaxSize) then calcMaxSizeInternal(0);
+  // set flags
+  firstTime := true;
+end;
+
+
+procedure TFlexLayouterBase.fixLine (me: PLayControl; i0, i1: LayControlIdx; cury: Integer; var spaceLeft: Single; var flexTotal: Integer; var flexBoxCount: Integer);
+var
+  curx: Integer;
+  lc: PLayControl;
+  osz: TLaySize;
+  toadd: Integer;
+begin
+  curx := 0;
+  while (i0 <> i1) do
+  begin
+    lc := @ctlist[i0];
+    osz := lc.desiredsize;
+    lc.desiredsize := lc.wantsize;
+    lc.desiredpos.x := curx;
+    lc.desiredpos.y := cury;
+    curx += lc.desiredsize.w;
+    // fix flexbox size
+    if (lc.tempFlex > 0) and (spaceLeft > 0) then
+    begin
+      toadd := trunc(spaceLeft*lc.tempFlex/flexTotal+0.5);
+      if (toadd > 0) then
+      begin
+        // size changed
+        lc.desiredsize.w += toadd;
+        curx += toadd;
+        // compensate (crudely) rounding errors
+        if (curx > me.desiredsize.w) then begin lc.desiredsize.w -= 1; curx -= 1; end;
+        // relayout children
+        layBox(lc.firstChild);
+      end;
+    end;
+    if (lc.inGroup) and (not lc.desiredsize.equals(osz)) then groupElementChanged := true;
+    i0 := lc.nextSibling;
+  end;
+  flexTotal := 0;
+  flexBoxCount := 0;
+  spaceLeft := me.wantsize.w;
+end;
+
+
+// do box layouting; call `layBox()` recursively if necessary
+procedure TFlexLayouterBase.layBox (boxidx: LayControlIdx);
+var
+  me: PLayControl;
+  flexTotal: Integer; // total sum of flex fields
+  flexBoxCount: Integer; // number of boxes
+  spaceLeft: Single;
+  cury: Integer;
+  maxwdt, maxhgt: Integer;
+  lineStartIdx: LayControlIdx;
+  lc: PLayControl;
+  doWrap: Boolean;
+  toadd: Integer;
+begin
+  if (boxidx < 0) or (boxidx >= Length(ctlist)) then exit;
+  me := @ctlist[boxidx];
+
+  // if we have no children, just set desired size and exit
+  me.desiredsize := me.wantsize;
+  if (me.firstChild = -1) then exit;
+
+  // first, layout all children; also, gather some flex data
+  for lc in forChildren(boxidx) do layBox(lc.myidx);
+
+  // second, layout lines, distribute flex data
+  if (me.horizBox) then
+  begin
+    // horizontal boxes
+    cury := 0;
+    maxhgt := 0;
+
+    fixLine(me, -1, -1, cury, spaceLeft, flexTotal, flexBoxCount); //HACK!
+
+    lineStartIdx := me.firstChild;
+
+    for lc in forChildren(boxidx) do
+    begin
+      // new line?
+      doWrap := (not lc.firstInLine) and (lc.lineStart);
+      // need to wrap?
+      if (not doWrap) and (lc.canWrap) and (lc.canWrap) and (lc.desiredsize.w > 0) and (spaceLeft < lc.desiredsize.w) then doWrap := true;
+      if (doWrap) then
+      begin
+        // new line, fix this one
+        if (not lc.didWrap) then
+        begin
+          wrappingChanged := true;
+          lc.didWrap := true;
+        end;
+        fixLine(me, lineStartIdx, lc.myidx, cury, spaceLeft, flexTotal, flexBoxCount);
+        cury += maxhgt;
+        lineStartIdx := lc.myidx;
+      end
+      else
+      begin
+        if (lc.didWrap) then
+        begin
+          wrappingChanged := true;
+          lc.didWrap := false;
+        end;
+      end;
+      spaceLeft -= lc.desiredsize.w;
+      if (maxhgt < lc.desiredsize.h) then maxhgt := lc.desiredsize.h;
+      if (lc.tempFlex > 0) then
+      begin
+        flexTotal += lc.tempFlex;
+        flexBoxCount += 1;
+      end;
+    end;
+    // fix last line
+    fixLine(me, lineStartIdx, -1, cury, spaceLeft, flexTotal, flexBoxCount);
+  end
+  else
+  begin
+    // vertical boxes
+    maxwdt := 0;
+    flexTotal := 0;
+    flexBoxCount := 0;
+    spaceLeft := me.wantsize.h;
+
+    // calc flex
+    for lc in forChildren(boxidx) do
+    begin
+      spaceLeft -= lc.desiredsize.h;
+      if (maxwdt < lc.desiredsize.w) then maxwdt := lc.desiredsize.w;
+      if (lc.tempFlex > 0) then
+      begin
+        flexTotal += lc.tempFlex;
+        flexBoxCount += 1;
+      end;
+    end;
+
+    // distribute space
+    cury := 0;
+    for lc in forChildren(boxidx) do
+    begin
+      lc.desiredsize := lc.wantsize;
+      lc.desiredpos.x := 0;
+      lc.desiredpos.y := cury;
+      cury += lc.desiredsize.h;
+      // fix flexbox size
+      if (lc.tempFlex > 0) and (spaceLeft > 0) then
+      begin
+        toadd := trunc(spaceLeft*lc.tempFlex/flexTotal+0.5);
+        if (toadd > 0) then
+        begin
+          // size changed
+          lc.desiredsize.h += toadd;
+          cury += toadd;
+          // compensate (crudely) rounding errors
+          if (cury > me.desiredsize.h) then begin lc.desiredsize.h -= 1; cury -= 1; end;
+          // relayout children
+          layBox(lc.firstChild);
+        end;
+      end;
+    end;
+  end;
+end;
+
+
+(*
+second pass:
+  calcluate desired sizes (process flexes) using 'wantsize', set 'desiredsize' and 'desiredpos'
+    if control has children, call 'second pass' recursively with this control as parent
+  flags set:
+    'group-element-changed', if any group element size was changed
+    'wrapping-changed', if not 'firsttime', and wrapping was changed (i.e. first pass will not set the flag)
+*)
+procedure TFlexLayouterBase.secondPass ();
+begin
+  // reset flags
+  groupElementChanged := false;
+  wrappingChanged := false;
+
+  if (Length(ctlist) > 0) then
+  begin
+    ctlist[0].desiredpos := TLayPos.Create(0, 0);
+    layBox(0);
+  end;
+
+  // fix 'wrapping-changed' flag
+  if (firstTime) then begin wrappingChanged := false; firstTime := false; end;
+end;
+
+
+(*
+third pass:
+  if 'group-element-changed':
+    for each group: adjust controls to max desired size (wantsize), set 'temp-flex' flags to 0 for 'em, set 'second-again' flag
+  for other controls: if 'desiredsize' > 'maxsize', set 'wantsize' to 'maxsize', set 'temp-flex' flag to 0, set 'second-again' flag
+  if 'second-again' or 'wrapping-changed':
+    reset 'second-again'
+    reset 'wrapping-changed'
+    reset 'firsttime'
+    goto second pass
+*)
+procedure TFlexLayouterBase.thirdPass ();
+var
+  secondAgain: Boolean;
+begin
+  while true do
+  begin
+    secondAgain := false;
+    if (groupElementChanged) then
+    begin
+      // do it
+    end;
+    if (not secondAgain) and (not wrappingChanged) then break;
+    firstTime := false;
+    secondPass();
+  end;
+end;
+
+
+(*
+fourth pass:
+  set 'actualsize' and 'actualpos' to 'desiredsize' and 'desiredpos'
+  return
+*)
+procedure TFlexLayouterBase.fourthPass ();
+var
+  f: Integer;
+begin
+  for f := 0 to High(ctlist) do
+  begin
+    ctlist[f].ctl.setActualSizePos(ctlist[f].desiredpos, ctlist[f].desiredsize);
+  end;
+end;
+
+
+procedure TFlexLayouterBase.layout ();
+begin
+  firstPass();
+  secondPass();
+  thirdPass();
+  fourthPass();
+end;
+
+
+procedure TFlexLayouterBase.dumpFlat ();
+var
+  f: Integer;
+  lc: PLayControl;
+  ds, ms: TLaySize;
+begin
+  for f := 0 to High(ctlist) do
+  begin
+    lc := @ctlist[f];
+    ds := lc.ctl.getDefSize;
+    ms := lc.ctl.getMaxSize;
+    writeln(lc.myidx, ': wantsize:', lc.wantsize.toString(), '; desiredsize=', lc.desiredsize.toString(), '; maxsize=', lc.maxsize.toString(), '; tempFlex=', lc.tempFlex, '; flags=', lc.flags,
+      '; parent=', lc.parent, '; next=', lc.nextSibling, '; child=', lc.firstChild, '; ctl.size=', ds.toString(), '; ctl.maxsize=', ms.toString());
+  end;
+end;
+
+
+procedure TFlexLayouterBase.dumpList (cidx: LayControlIdx; indent: Integer);
+var
+  lc: PLayControl;
+  f: Integer;
+begin
+  while (cidx >= 0) do
+  begin
+    lc := @ctlist[cidx];
+    for f := 0 to High(indent) do write(' ');
+    writeln(lc.myidx, ': wantsize:', lc.wantsize.toString, '; desiredsize=', lc.desiredsize.toString, '; maxsize=', lc.maxsize.toString, '; tempFlex=', lc.tempFlex, '; despos=', lc.desiredpos.toString);
+    dumpList(lc.firstChild, indent+2);
+    cidx := lc.nextSibling;
+  end;
+end;
+
+
+procedure TFlexLayouterBase.dump ();
+begin
+  dumpList(0, 0);
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+(*
+void main () begin
+  auto win := new GuiControl();
+  (win ~= new GuiControl()).mSize := TLaySize(10, 5);
+  (win ~= new GuiControl()).mSize := TLaySize(16, 8);
+
+  //win.mSize := TLaySize(40, 20);
+
+  auto lay := TFlexLayouterBase!GuiControl();
+  lay.setup(win);
+
+  writeln('============================');
+  lay.dumpFlat();
+
+  writeln('=== initial ===');
+  lay.dump();
+
+  //lay.calcMaxSizeInternal(0);
+  /*
+  lay.firstPass();
+  writeln('=== after first pass ===');
+  lay.dump();
+
+  lay.secondPass();
+  writeln('=== after second pass ===');
+  lay.dump();
+  */
+  lay.layout();
+  writeln('=== final ===');
+  lay.dump();
+*)
+end.

diff --git a/src/gx/gh_ui.pas b/src/gx/gh_ui.pas
index f67757acd82a2ddebb790b1b73378c22bd8ca75a..774795d13daeecdcb197f396d602cd24b285f71b 100644 (file)
--- a/src/gx/gh_ui.pas
+++ b/src/gx/gh_ui.pas
@@ -80,7 +80,7 @@ type
     actionCB: TActionCB;
 
   private
-    mSize: TLaySize; // default size
+    mDefSize: TLaySize; // default size
     mMaxSize: TLaySize; // maximum size
     mActSize: TLaySize; // actual (calculated) size
     mActPos: TLayPos; // actual (calculated) position
@@ -90,13 +90,15 @@ type
     mLineStart: Boolean;
     mHGroup: AnsiString;
     mVGroup: AnsiString;
+    mAlign: Integer;
+    mExpand: Boolean;
 
   public
     // layouter interface
-    function getSize (): TLaySize; inline; // default size; <0: use max size
-    procedure setSize (constref sz: TLaySize); inline; // default size; <0: use max size
+    function getDefSize (): TLaySize; inline; // default size; <0: use max size
+    procedure setDefSize (const sz: TLaySize); inline; // default size; <0: use max size
     function getMaxSize (): TLaySize; inline; // max size; <0: set to some huge value
-    procedure setMaxSize (constref sz: TLaySize); inline; // max size; <0: set to some huge value
+    procedure setMaxSize (const sz: TLaySize); inline; // max size; <0: set to some huge value
     function getFlex (): Integer; inline; // <=0: not flexible
     function isHorizBox (): Boolean; inline; // horizontal layout for children?
     procedure setHorizBox (v: Boolean); inline; // horizontal layout for children?
@@ -104,17 +106,28 @@ type
     procedure setCanWrap (v: Boolean); inline; // for horizontal boxes: can wrap children? for child: `false` means 'nonbreakable at *next* ctl'
     function isLineStart (): Boolean; inline; // `true` if this ctl should start a new line; ignored for vertical boxes
     procedure setLineStart (v: Boolean); inline; // `true` if this ctl should start a new line; ignored for vertical boxes
+    function getAlign (): Integer; inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
+    procedure setAlign (v: Integer); inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
+    function getExpand (): Boolean; inline; // expanding in non-main direction: `true` will ignore align and eat all available space
+    procedure setExpand (v: Boolean); inline; // expanding in non-main direction: `true` will ignore align and eat all available space
     procedure setActualSizePos (constref apos: TLayPos; constref asize: TLaySize); inline;
     function getHGroup (): AnsiString; inline; // empty: not grouped
     procedure setHGroup (const v: AnsiString); inline; // empty: not grouped
     function getVGroup (): AnsiString; inline; // empty: not grouped
     procedure setVGroup (const v: AnsiString); inline; // empty: not grouped
-    function hasSibling (): Boolean; inline;
-    //function nextSibling (): THControl; inline;
-    function hasChildren (): Boolean; inline;
-    //function firstChild (): THControl; inline;
 
     property flex: Integer read mFlex write mFlex;
+    property flDefaultSize: TLaySize read getDefSize write setDefSize;
+    property flMaxSize: TLaySize read getMaxSize write setMaxSize;
+    property flHoriz: Boolean read isHorizBox write setHorizBox;
+    property flCanWrap: Boolean read canWrap write setCanWrap;
+    property flLineStart: Boolean read isLineStart write setLineStart;
+    property flAlign: Integer read getAlign write setAlign;
+    property flExpand: Boolean read getExpand write setExpand;
+    property flHGroup: AnsiString read getHGroup write setHGroup;
+    property flVGroup: AnsiString read getVGroup write setVGroup;
+    property flActualSize: TLaySize read mActSize write mActSize;
+    property flActualPos: TLayPos read mActPos write mActPos;
 
   public
     constructor Create (ax, ay, aw, ah: Integer; aparent: THControl=nil);
@@ -248,12 +261,38 @@ procedure uiRemoveWindow (ctl: THControl);
 function uiVisibleWindow (ctl: THControl): Boolean;
 
 
+// do layouting
+procedure uiLayoutCtl (ctl: THControl);
+
+
 var
   gh_ui_scale: Single = 1.0;
 
 
 implementation
 
+uses
+  gh_flexlay;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+type
+  TFlexLayouter = specialize TFlexLayouterBase<THControl>;
+
+procedure uiLayoutCtl (ctl: THControl);
+var
+  lay: TFlexLayouter;
+begin
+  if (ctl = nil) then exit;
+  lay := TFlexLayouter.Create();
+  try
+    lay.setup(ctl);
+    lay.layout();
+  finally
+    FreeAndNil(lay);
+  end;
+end;
+
 
 // ////////////////////////////////////////////////////////////////////////// //
 var
@@ -415,7 +454,7 @@ begin
   mDrawShadow := false;
   actionCB := nil;
   // layouter interface
-  mSize := TLaySize.Create(64, 10); // default size
+  mDefSize := TLaySize.Create(64, 10); // default size
   mMaxSize := TLaySize.Create(-1, -1); // maximum size
   mActSize := TLaySize.Create(0, 0); // actual (calculated) size
   mActPos := TLayPos.Create(0, 0); // actual (calculated) position
@@ -425,6 +464,8 @@ begin
   mLineStart := false;
   mHGroup := '';
   mVGroup := '';
+  mAlign := -1; // left/top
+  mExpand := false;
 end;
 
 
@@ -453,10 +494,10 @@ begin
 end;
 
 
-function THControl.getSize (): TLaySize; inline; begin result := mSize; end;
-procedure THControl.setSize (constref sz: TLaySize); inline; begin mSize := sz; end;
+function THControl.getDefSize (): TLaySize; inline; begin result := mDefSize; end;
+procedure THControl.setDefSize (const sz: TLaySize); inline; begin mDefSize := sz; end;
 function THControl.getMaxSize (): TLaySize; inline; begin result := mMaxSize; end;
-procedure THControl.setMaxSize (constref sz: TLaySize); inline; begin mMaxSize := sz; end;
+procedure THControl.setMaxSize (const sz: TLaySize); inline; begin mMaxSize := sz; end;
 function THControl.getFlex (): Integer; inline; begin result := mFlex; end;
 function THControl.isHorizBox (): Boolean; inline; begin result := mHoriz; end;
 procedure THControl.setHorizBox (v: Boolean); inline; begin mHoriz := v; end;
@@ -464,15 +505,15 @@ function THControl.canWrap (): Boolean; inline; begin result := mCanWrap; end;
 procedure THControl.setCanWrap (v: Boolean); inline; begin mCanWrap := v; end;
 function THControl.isLineStart (): Boolean; inline; begin result := mLineStart; end;
 procedure THControl.setLineStart (v: Boolean); inline; begin mLineStart := v; end;
+function THControl.getAlign (): Integer; inline; begin result := mAlign; end;
+procedure THControl.setAlign (v: Integer); inline; begin mAlign := v; end;
+function THControl.getExpand (): Boolean; inline; begin result := mExpand; end;
+procedure THControl.setExpand (v: Boolean); inline; begin mExpand := v; end;
 procedure THControl.setActualSizePos (constref apos: TLayPos; constref asize: TLaySize); inline; begin mActPos := apos; mActSize := asize; end;
 function THControl.getHGroup (): AnsiString; inline; begin result := mHGroup; end;
 procedure THControl.setHGroup (const v: AnsiString); inline; begin mHGroup := v; end;
 function THControl.getVGroup (): AnsiString; inline; begin result := mVGroup; end;
 procedure THControl.setVGroup (const v: AnsiString); inline; begin mVGroup := v; end;
-function THControl.hasSibling (): Boolean; inline; begin result := (nextSibling <> nil) end;
-//function THControl.nextSibling (): THControl; inline; begin result := nextSibling; end;
-function THControl.hasChildren (): Boolean; inline; begin result := (firstChild <> nil); end;
-//function THControl.firstChild (): THControl; inline; begin result := firstChild; end;
 
 
 procedure THControl.activated ();

diff --git a/src/gx/glgfx.pas b/src/gx/glgfx.pas
index fb7e593847e1f33009cefe780c7569fe6960fc58..d6f8763b401724947277acb25e5b7c79d28beb8a 100644 (file)
--- a/src/gx/glgfx.pas
+++ b/src/gx/glgfx.pas
@@ -24,6 +24,26 @@ uses
   sdlcarcass;
 
 
+// ////////////////////////////////////////////////////////////////////////// //
+type
+  TGxRGBA = packed record
+  public
+    r, g, b, a: Byte;
+
+  public
+    constructor Create (ar, ag, ab: Integer; aa: Integer=255);
+
+    function asUInt (): LongWord; inline;
+    function isOpaque (): Boolean; inline;
+    function isTransparent (): Boolean; inline;
+
+    // WARNING! This function does blending in RGB space, and RGB space is not linear!
+    // alpha value of `self` doesn't matter
+    // `aa` means: 255 for replace color, 0 for keep `self`
+    function blend (ar, ag, ab, aa: Integer): TGxRGBA; inline;
+  end;
+
+
 // ////////////////////////////////////////////////////////////////////////// //
 type
   THMouseEvent = record
@@ -219,6 +239,45 @@ function THKeyEvent.press (): Boolean; inline; begin result := (kind = TKind.Pre
 function THKeyEvent.release (): Boolean; inline; begin result := (kind = TKind.Release); end;
 
 
+// ////////////////////////////////////////////////////////////////////////// //
+constructor TGxRGBA.Create (ar, ag, ab: Integer; aa: Integer=255);
+begin
+  if (ar < 0) then r := 0 else if (ar > 255) then r := 255 else r := Byte(ar);
+  if (ag < 0) then g := 0 else if (ag > 255) then g := 255 else g := Byte(ag);
+  if (ab < 0) then b := 0 else if (ab > 255) then b := 255 else b := Byte(ab);
+  if (aa < 0) then a := 0 else if (aa > 255) then a := 255 else a := Byte(aa);
+end;
+
+function TGxRGBA.asUInt (): LongWord; inline; begin result := LongWord(r) or (LongWord(g) shl 8) or (LongWord(b) shl 16) or (LongWord(a) shl 24); end;
+
+function TGxRGBA.isOpaque (): Boolean; inline; begin result := (a = 255); end;
+function TGxRGBA.isTransparent (): Boolean; inline; begin result := (a = 0); end;
+
+function TGxRGBA.blend (ar, ag, ab, aa: Integer): TGxRGBA; inline;
+var
+  me, it, a_tmp_, dc_tmp_, srb_tmp_, sg_tmp_, drb_tmp_, dg_tmp_, orb_tmp_, og_tmp_: LongWord;
+begin
+  if (aa <= 0) then begin result := self; exit; end;
+  result := TGxRGBA.Create(ar, ag, ab, aa);
+  if (aa >= 255) then begin result.a := a; exit; end;
+  me := asUInt;
+  it := result.asUInt;
+  a_tmp_ := (256-(255-(it shr 24))) and (-(1-(((255-(it shr 24))+1) shr 8))); // to not loose bits, but 255 should become 0
+  dc_tmp_ := me and $ffffff;
+  srb_tmp_ := (it and $ff00ff);
+  sg_tmp_ := (it and $00ff00);
+  drb_tmp_ := (dc_tmp_ and $ff00ff);
+  dg_tmp_ := (dc_tmp_ and $00ff00);
+  orb_tmp_ := (drb_tmp_+(((srb_tmp_-drb_tmp_)*a_tmp_+$800080) shr 8)) and $ff00ff;
+  og_tmp_ := (dg_tmp_+(((sg_tmp_-dg_tmp_)*a_tmp_+$008000) shr 8)) and $00ff00;
+  me := (orb_tmp_ or og_tmp_); // or $ff000000; /* and $ffffff;*/
+  result.r := Byte(me and $ff);
+  result.g := Byte((me shr 8) and $ff);
+  result.b := Byte((me shr 16) and $ff);
+  result.a := a;
+end;
+
+
 // ////////////////////////////////////////////////////////////////////////// //
 // any mods = 255: nothing was defined
 function parseModKeys (const s: AnsiString; out kmods: Byte; out mbuts: Byte): AnsiString;