summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 56ec1de)
raw | patch | inline | side by side (parent: 56ec1de)
| author | Ketmar Dark <ketmar@ketmar.no-ip.org> | |
| Sun, 24 Sep 2017 13:35:47 +0000 (16:35 +0300) | ||
| committer | Ketmar Dark <ketmar@ketmar.no-ip.org> | |
| Sun, 24 Sep 2017 13:38:01 +0000 (16:38 +0300) |
| src/gx/gh_flexlay.pas | patch | blob | history | |
| src/gx/gh_ui.pas | patch | blob | history | |
| src/gx/gh_ui_common.pas | patch | blob | history | |
| src/shared/xparser.pas | patch | blob | history |
diff --git a/src/gx/gh_flexlay.pas b/src/gx/gh_flexlay.pas
index cc01bb69fa685eb0750cfe1bffcf289513763a55..3eed2e410e14dd7b1f8c94026aabc540518be32c 100644 (file)
--- a/src/gx/gh_flexlay.pas
+++ b/src/gx/gh_flexlay.pas
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
+ build group arrays; for each group: find max size for group, adjust 'startsize' 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'
+ calcluate desired sizes (process flexes) using 'startsize', 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
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
+ for each group: adjust controls to max desired size (startsize), set 'temp-flex' flags to 0 for 'em, set 'second-again' flag
+ for other controls: if 'desiredsize' > 'maxsize', set 'startsize' to 'maxsize', set 'temp-flex' flag to 0, set 'second-again' flag
if 'second-again' or 'wrapping-changed':
reset 'second-again'
reset 'wrapping-changed'
return
calc max size:
- set 'wantsize' to max(size, maxsize, 0)
+ set 'startsize' 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'
+ set 'desiredmax' to 'startsize'
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'
+ set 'startsize' to 'desiredmax'
return
(*
+ control default size will be increased by margins
+ negative margins are ignored
ControlT:
+ procedure layPrepare (); // called before registering control in layouter
function getDefSize (): TLaySize; // default size; <0: use max size
+ function getMargins (): TLayMargins;
function getMaxSize (): TLaySize; // max size; <0: set to some huge value
function getFlex (): Integer; // <=0: not flexible
function isHorizBox (): Boolean; // horizontal layout for children?
tempFlex: Integer;
flags: LongWord; // see below
aligndir: Integer;
- wantsize, desiredsize, maxsize: TLaySize;
+ startsize: TLaySize; // current
+ desiredsize: TLaySize;
+ maxsize: TLaySize;
+ margins: TLayMargins; // can never be negative
desiredpos: TLayPos;
ctl: ControlT;
parent: LayControlIdx; // = -1;
assert(ctlist[parent].firstChild = -1);
while (child <> nil) do
begin
+ child.layPrepare;
SetLength(ctlist, Length(ctlist)+1);
lc := @ctlist[High(ctlist)];
+ lc.initialize();
if (cidx = -1) then
begin
cidx := LayControlIdx(High(ctlist));
begin
clear();
if (root = nil) then exit;
+ root.layPrepare;
try
SetLength(ctlist, 1);
+ ctlist[0].initialize();
ctlist[0].myidx := 0;
ctlist[0].ctl := root;
fixFlags(0);
var
lc, c: PLayControl;
msz: TLaySize;
- negw{, negh}: Boolean;
+ negw, negh: Boolean;
curwdt, curhgt, totalhgt: Integer;
doWrap: Boolean;
begin
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);
+ negw := (lc.startsize.w <= 0);
+ negh := (lc.startsize.h <= 0);
lc.tempFlex := lc.ctl.getFlex;
begin
// horizontal boxes
if (negw) then lc.tempFlex := 0; // size is negative: don't expand
- curwdt := 0;
- curhgt := 0;
+ curwdt := lc.margins.horiz;
+ curhgt := lc.margins.vert;
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 (not doWrap) and (lc.canWrap) and (c.canWrap) and (msz.w > 0) and (curwdt+c.startsize.w > lc.startsize.w) then doWrap := true;
if (doWrap) then
begin
totalhgt += curhgt;
- if (lc.wantsize.w < curwdt) then lc.wantsize.w := curwdt;
+ if (lc.startsize.w < curwdt) then lc.startsize.w := curwdt;
curwdt := 0;
curhgt := 0;
end;
- curwdt += c.wantsize.w;
- if (curhgt < c.wantsize.h) then curhgt := c.wantsize.h;
+ curwdt += c.startsize.w;
+ if (curhgt < c.startsize.h) then curhgt := c.startsize.h;
end;
totalhgt += curhgt;
- if (lc.wantsize.w < curwdt) then lc.wantsize.w := curwdt;
- if (lc.wantsize.h < totalhgt) then lc.wantsize.h := totalhgt;
+ if (lc.startsize.w < curwdt) then lc.startsize.w := curwdt;
+ if (lc.startsize.h < totalhgt) then lc.startsize.h := totalhgt;
end
else
begin
// vertical boxes
- curhgt := 0;
+ if (negh) then lc.tempFlex := 0; // size is negative: don't expand
+ curhgt := lc.margins.vert;
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;
+ if (lc.startsize.w < c.startsize.w+lc.margins.horiz) then lc.startsize.w := c.startsize.w+lc.margins.horiz;
+ curhgt += c.startsize.h;
end;
- if (lc.wantsize.h < curhgt) then lc.wantsize.h := curhgt;
+ if (lc.startsize.h < curhgt) then lc.startsize.h := curhgt;
end;
- if (lc.wantsize.w < 1) then lc.wantsize.w := 1;
- if (lc.wantsize.h < 1) then lc.wantsize.h := 1;
+ if (lc.startsize.w < 0) then lc.startsize.w := 0;
+ if (lc.startsize.h < 0) then lc.startsize.h := 0;
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;
+ if (lc.maxsize.w < lc.startsize.w) then lc.maxsize.w := lc.startsize.w;
+ if (lc.maxsize.h < lc.startsize.h) then lc.maxsize.h := lc.startsize.h;
end;
grp: PLayGroup;
maxsz: Integer;
cidx: LayControlIdx;
+ mr: TLayMargins;
begin
- // reset all 'laywrap' flags for controls, set initial 'wantsize'
+ // reset all 'laywrap' flags for controls, set initial 'startsize'
for f := 0 to High(ctlist) do
begin
ctlist[f].didWrap := false;
- ctlist[f].wantsize := ctlist[f].ctl.getDefSize;
+ ctlist[f].startsize := ctlist[f].ctl.getDefSize;
+ mr := ctlist[f].ctl.getMargins;
+ ctlist[f].margins := mr;
+ ctlist[f].startsize.w += mr.horiz;
+ ctlist[f].startsize.h += mr.vert;
end;
// setup sizes
calcMaxSizeInternal(0); // this also sets `tempFlex`
- // find max size for group, adjust 'wantsize' controls to group max size
+ // find max size for group, adjust 'startsize' controls to group max size
needRecalcMaxSize := false;
for gtype := 0 to 1 do
begin
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];
+ if (maxsz < ctlist[cidx].startsize[gtype]) then maxsz := ctlist[cidx].startsize[gtype];
end;
for c := 0 to High(grp.ctls) do
begin
cidx := grp.ctls[c];
- if (maxsz <> ctlist[cidx].wantsize[gtype]) then
+ if (maxsz <> ctlist[cidx].startsize[gtype]) then
begin
needRecalcMaxSize := true;
- ctlist[cidx].wantsize[gtype] := maxsz;
+ ctlist[cidx].startsize[gtype] := maxsz;
end;
end;
end;
end;
// recalc maxsize if necessary
if (needRecalcMaxSize) then calcMaxSizeInternal(0);
+ // set "desired size" to "start size"
+ for f := 0 to High(ctlist) do ctlist[f].desiredsize := ctlist[f].startsize;
// set flags
firstTime := true;
+ //writeln('=== calculated max size ===');
+ //dump();
end;
lc: PLayControl;
osz: TLaySize;
toadd: Integer;
+ sti0: Integer;
+ lineh: Integer;
begin
- curx := 0;
+ curx := me.margins.left;
+ sti0 := i0;
+ // calc minimal line height
+ lineh := 0;
+ while (i0 <> i1) do
+ begin
+ lc := @ctlist[i0];
+ lineh := nmax(lineh, lc.startsize.h);
+ i0 := lc.nextSibling;
+ end;
+ // distribute space, expand/align
+ i0 := sti0;
while (i0 <> i1) do
begin
lc := @ctlist[i0];
osz := lc.desiredsize;
- lc.desiredsize := lc.wantsize;
+ lc.desiredsize := lc.startsize;
lc.desiredpos.x := curx;
lc.desiredpos.y := cury;
curx += lc.desiredsize.w;
lc.desiredsize.w += toadd;
curx += toadd;
// compensate (crudely) rounding errors
- if (curx > me.desiredsize.w) then begin lc.desiredsize.w -= 1; curx -= 1; end;
+ if (curx > me.desiredsize.w-me.margins.horiz) 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;
+ // expand or align
+ if (lc.expand) then lc.desiredsize.h := nmin(lc.maxsize.h, lineh) // expand
+ else if (lc.aligndir > 0) then lc.desiredpos.y := cury+(lineh-lc.desiredsize.h) // bottom align
+ else if (lc.aligndir = 0) then lc.desiredpos.y := cury+(lineh-lc.desiredsize.h) div 2; // center
+ if (not osz.equals(lc.desiredsize)) then
+ begin
+ if (lc.inGroup) then groupElementChanged := true;
+ // relayout children
+ layBox(lc.firstChild);
+ end;
i0 := lc.nextSibling;
end;
flexTotal := 0;
flexBoxCount := 0;
- spaceLeft := me.wantsize.w;
+ spaceLeft := me.desiredsize.w-me.margins.horiz;
end;
lc: PLayControl;
doWrap: Boolean;
toadd: Integer;
+ osz: TLaySize;
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 we have no children, there's nothing to do
if (me.firstChild = -1) then exit;
- // first, layout all children; also, gather some flex data
+ // first, layout all children
for lc in forChildren(boxidx) do layBox(lc.myidx);
// second, layout lines, distribute flex data
if (me.horizBox) then
begin
// horizontal boxes
- cury := 0;
+ cury := me.margins.top;
maxhgt := 0;
fixLine(me, -1, -1, cury, spaceLeft, flexTotal, flexBoxCount); //HACK!
maxwdt := 0;
flexTotal := 0;
flexBoxCount := 0;
- spaceLeft := me.wantsize.h;
+ spaceLeft := me.desiredsize.h-me.margins.vert;
// calc flex
for lc in forChildren(boxidx) do
end;
// distribute space
- cury := 0;
+ cury := me.margins.top;
+ //writeln('me: ', boxidx, '; margins: ', me.margins.toString);
for lc in forChildren(boxidx) do
begin
- lc.desiredsize := lc.wantsize;
- lc.desiredpos.x := 0;
+ osz := lc.desiredsize;
+ lc.desiredsize := lc.startsize;
+ lc.desiredpos.x := me.margins.left;
lc.desiredpos.y := cury;
cury += lc.desiredsize.h;
// fix flexbox size
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);
+ if (cury > me.desiredsize.h-me.margins.vert) then begin lc.desiredsize.h -= 1; cury -= 1; end;
end;
end;
+ // expand or align
+ if (lc.expand) then lc.desiredsize.w := nmin(lc.maxsize.w, me.desiredsize.w-me.margins.vert) // expand
+ else if (lc.aligndir > 0) then lc.desiredpos.x := me.desiredsize.w-me.margins.right-lc.desiredsize.w // right align
+ else if (lc.aligndir = 0) then lc.desiredpos.x := (me.desiredsize.w-me.margins.horiz-lc.desiredsize.w) div 2; // center
+ if (not osz.equals(lc.desiredsize)) then
+ begin
+ if (lc.inGroup) then groupElementChanged := true;
+ // relayout children
+ layBox(lc.firstChild);
+ end;
end;
end;
end;
(*
second pass:
- calcluate desired sizes (process flexes) using 'wantsize', set 'desiredsize' and 'desiredpos'
+ calcluate desired sizes (process flexes) using 'startsize', 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
(*
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
+ for each group: adjust controls to max desired size (startsize), set 'temp-flex' flags to 0 for 'em, set 'second-again' flag
+ for other controls: if 'desiredsize' > 'maxsize', set 'startsize' to 'maxsize', set 'temp-flex' flag to 0, set 'second-again' flag
if 'second-again' or 'wrapping-changed':
reset 'second-again'
reset 'wrapping-changed'
procedure TFlexLayouterBase.thirdPass ();
var
secondAgain: Boolean;
+ gtype: Integer;
+ maxsz: Integer;
+ grp: PLayGroup;
+ f, c: Integer;
+ cidx: LayControlIdx;
begin
while true do
begin
+ secondPass();
secondAgain := false;
if (groupElementChanged) then
begin
- // do it
+ secondAgain := true;
+ // find max size for group, adjust 'startsize' controls to group max size
+ 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].startsize[gtype]) then maxsz := ctlist[cidx].startsize[gtype];
+ end;
+ for c := 0 to High(grp.ctls) do
+ begin
+ cidx := grp.ctls[c];
+ ctlist[cidx].startsize[gtype] := maxsz;
+ ctlist[cidx].desiredsize[gtype] := maxsz;
+ ctlist[cidx].tempFlex := 0; // don't change control size anymore
+ end;
+ end;
+ end;
+ end
+ else
+ begin
+ for f := 0 to High(ctlist) do
+ begin
+ for c := 0 to 1 do
+ begin
+ if (ctlist[f].maxsize[c] <= 0) then continue;
+ if (ctlist[f].desiredsize[c] > ctlist[f].maxsize[c]) then
+ begin
+ //writeln('ctl #', f, '; dimension #', c, ': desired=', ctlist[f].desiredsize[c], '; max=', ctlist[f].maxsize[c]);
+ ctlist[f].startsize[c] := ctlist[f].maxsize[c];
+ ctlist[f].desiredsize[c] := ctlist[f].maxsize[c];
+ ctlist[f].tempFlex := 0; // don't change control size anymore
+ secondAgain := true;
+ end;
+ end;
+ end;
end;
if (not secondAgain) and (not wrappingChanged) then break;
firstTime := false;
- secondPass();
end;
end;
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,
+ writeln(lc.myidx, ': startsize:', lc.startsize.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;
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);
+ for f := 0 to indent do write(' ');
+ writeln(lc.myidx, ': startsize:', lc.startsize.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;
diff --git a/src/gx/gh_ui.pas b/src/gx/gh_ui.pas
index 774795d13daeecdcb197f396d602cd24b285f71b..a8593adacd9a4111c9e29fe2d9ae5b162094f131 100644 (file)
--- a/src/gx/gh_ui.pas
+++ b/src/gx/gh_ui.pas
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
{$INCLUDE ../shared/a_modes.inc}
+{$M+}
unit gh_ui;
interface
SysUtils, Classes,
GL, GLExt, SDL2,
gh_ui_common,
- sdlcarcass, glgfx;
+ sdlcarcass, glgfx,
+ xparser;
// ////////////////////////////////////////////////////////////////////////// //
type
+ THControlClass = class of THControl;
+
THControl = class
public
type TActionCB = procedure (me: THControl; uinfo: Integer);
private
mDefSize: TLaySize; // default size
mMaxSize: TLaySize; // maximum size
- mActSize: TLaySize; // actual (calculated) size
- mActPos: TLayPos; // actual (calculated) position
mFlex: Integer;
mHoriz: Boolean;
mCanWrap: Boolean;
mVGroup: AnsiString;
mAlign: Integer;
mExpand: Boolean;
+ mLayDefSize: TLaySize;
+ mLayMaxSize: TLaySize;
public
// layouter interface
function getDefSize (): TLaySize; inline; // default size; <0: use max size
- procedure setDefSize (const sz: TLaySize); inline; // default size; <0: use max size
+ //procedure setDefSize (const sz: TLaySize); inline; // default size; <0: use max size
+ function getMargins (): TLayMargins; inline;
function getMaxSize (): TLaySize; inline; // max size; <0: set to some huge value
- procedure setMaxSize (const 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?
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
+ procedure setActualSizePos (constref apos: TLayPos; constref asize: TLaySize); inline;
+
+ procedure layPrepare (); virtual; // called before registering control in layouter
+
+ public
property flex: Integer read mFlex write mFlex;
- property flDefaultSize: TLaySize read getDefSize write setDefSize;
- property flMaxSize: TLaySize read getMaxSize write setMaxSize;
+ property flDefaultSize: TLaySize read mDefSize write mDefSize;
+ property flMaxSize: TLaySize read mMaxSize write mMaxSize;
property flHoriz: Boolean read isHorizBox write setHorizBox;
property flCanWrap: Boolean read canWrap write setCanWrap;
property flLineStart: Boolean read isLineStart write setLineStart;
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;
+
+ protected
+ function parsePos (par: TTextParser): TLayPos;
+ function parseSize (par: TTextParser): TLaySize;
+ function parseBool (par: TTextParser): Boolean;
+ function parseAnyAlign (par: TTextParser): Integer;
+ function parseHAlign (par: TTextParser): Integer;
+ function parseVAlign (par: TTextParser): Integer;
+ procedure parseTextAlign (par: TTextParser; var h, v: Integer);
+ procedure parseChildren (par: TTextParser); // par should be on '{'; final '}' is eaten
public
+ // par is on property data
+ // there may be more data in text stream, don't eat it!
+ // return `true` if property name is valid and value was parsed
+ // return `false` if property name is invalid; don't advance parser in this case
+ // throw on property data errors
+ function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; virtual;
+
+ // par should be on '{'; final '}' is eaten
+ procedure parseProperties (par: TTextParser);
+
+ public
+ constructor Create ();
+ constructor Create (aparent: THControl);
constructor Create (ax, ay, aw, ah: Integer; aparent: THControl=nil);
destructor Destroy (); override;
mDragStartX, mDragStartY: Integer;
mWaitingClose: Boolean;
mInClose: Boolean;
+ mFreeOnClose: Boolean; // default: false
protected
procedure blurred (); override;
public
constructor Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
+ function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
+
procedure centerInScreen ();
// `sx` and `sy` are screen coordinates
function keyEvent (var ev: THKeyEvent): Boolean; override; // returns `true` if event was eaten
function mouseEvent (var ev: THMouseEvent): Boolean; override; // returns `true` if event was eaten
+
+ public
+ property freeOnClose: Boolean read mFreeOnClose write mFreeOnClose;
end;
function keyEvent (var ev: THKeyEvent): Boolean; override;
end;
+ // ////////////////////////////////////////////////////////////////////// //
+ THCtlBox = class(THControl)
+ private
+ mHasFrame: Boolean;
+ mCaption: AnsiString;
+
+ public
+ constructor Create (ahoriz: Boolean; aparent: THControl=nil);
+ //destructor Destroy (); override;
+
+ function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
+
+ procedure drawControl (sx, sy: Integer); override;
+
+ function mouseEvent (var ev: THMouseEvent): Boolean; override;
+ function keyEvent (var ev: THKeyEvent): Boolean; override;
+ end;
+
+ THCtlHBox = class(THCtlBox)
+ public
+ constructor Create (aparent: THControl=nil);
+ end;
+
+ THCtlVBox = class(THCtlBox)
+ public
+ constructor Create (aparent: THControl=nil);
+ end;
+
+
+ THCtlTextLabel = class(THControl)
+ private
+ mText: AnsiString;
+ mHAlign: Integer; // -1: left; 0: center; 1: right; default: left
+ mVAlign: Integer; // -1: top; 0: center; 1: bottom; default: center
+
+ public
+ constructor Create (const atext: AnsiString; aparent: THControl=nil);
+ //destructor Destroy (); override;
+
+ function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
+
+ procedure drawControl (sx, sy: Integer); override;
+ function mouseEvent (var ev: THMouseEvent): Boolean; override;
+ function keyEvent (var ev: THKeyEvent): Boolean; override;
+ end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
function uiMouseEvent (ev: THMouseEvent): Boolean;
function uiKeyEvent (ev: THKeyEvent): Boolean;
procedure uiDraw ();
+
+// ////////////////////////////////////////////////////////////////////////// //
procedure uiAddWindow (ctl: THControl);
-procedure uiRemoveWindow (ctl: THControl);
+procedure uiRemoveWindow (ctl: THControl); // will free window if `mFreeOnClose` is `true`
function uiVisibleWindow (ctl: THControl): Boolean;
+// ////////////////////////////////////////////////////////////////////////// //
// do layouting
procedure uiLayoutCtl (ctl: THControl);
+// ////////////////////////////////////////////////////////////////////////// //
var
gh_ui_scale: Single = 1.0;
implementation
uses
- gh_flexlay;
+ gh_flexlay,
+ utils;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+var
+ knownCtlClasses: array of record
+ klass: THControlClass;
+ name: AnsiString;
+ end = nil;
+
+
+procedure registerCtlClass (aklass: THControlClass; const aname: AnsiString);
+begin
+ assert(aklass <> nil);
+ assert(Length(aname) > 0);
+ SetLength(knownCtlClasses, Length(knownCtlClasses)+1);
+ knownCtlClasses[High(knownCtlClasses)].klass := aklass;
+ knownCtlClasses[High(knownCtlClasses)].name := aname;
+end;
+
+
+function findCtlClass (const aname: AnsiString): THControlClass;
+var
+ f: Integer;
+begin
+ for f := 0 to High(knownCtlClasses) do
+ begin
+ if (strEquCI1251(aname, knownCtlClasses[f].name)) then
+ begin
+ result := knownCtlClasses[f].klass;
+ exit;
+ end;
+ end;
+ result := nil;
+end;
// ////////////////////////////////////////////////////////////////////////// //
lay := TFlexLayouter.Create();
try
lay.setup(ctl);
+ //lay.layout();
+
+ 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();
+
finally
FreeAndNil(lay);
end;
begin
if (ctl = nil) then exit;
ctl := ctl.topLevel;
+ if not (ctl is THTopWindow) then exit; // alas
for f := 0 to High(uiTopList) do
begin
if (uiTopList[f] = ctl) then
end;
-// won't free object
procedure uiRemoveWindow (ctl: THControl);
var
f, c: Integer;
begin
if (ctl = nil) then exit;
ctl := ctl.topLevel;
+ if not (ctl is THTopWindow) then exit; // alas
for f := 0 to High(uiTopList) do
begin
if (uiTopList[f] = ctl) then
SetLength(uiTopList, Length(uiTopList)-1);
if (ctl is THTopWindow) then
begin
- if assigned(THTopWindow(ctl).closeCB) then THTopWindow(ctl).closeCB(ctl, 0);
+ try
+ if assigned(THTopWindow(ctl).closeCB) then THTopWindow(ctl).closeCB(ctl, 0);
+ finally
+ if (THTopWindow(ctl).mFreeOnClose) then FreeAndNil(ctl);
+ end;
end;
exit;
end;
result := false;
if (ctl = nil) then exit;
ctl := ctl.topLevel;
+ if not (ctl is THTopWindow) then exit; // alas
for f := 0 to High(uiTopList) do
begin
if (uiTopList[f] = ctl) then begin result := true; exit; end;
// ////////////////////////////////////////////////////////////////////////// //
-constructor THControl.Create (ax, ay, aw, ah: Integer; aparent: THControl=nil);
+constructor THControl.Create ();
begin
- mParent := aparent;
- mX := ax;
- mY := ay;
- mWidth := aw;
- mHeight := ah;
+ mParent := nil;
+ mX := 0;
+ mY := 0;
+ mWidth := 64;
+ mHeight := 8;
mFrameWidth := 0;
mFrameHeight := 0;
mEnabled := true;
mDrawShadow := false;
actionCB := nil;
// layouter interface
- mDefSize := TLaySize.Create(64, 10); // default size
+ mDefSize := TLaySize.Create(64, 8); // 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
mFlex := 0;
mHoriz := true;
mCanWrap := false;
end;
+constructor THControl.Create (ax, ay, aw, ah: Integer; aparent: THControl=nil);
+begin
+ Create(aparent);
+ mX := ax;
+ mY := ay;
+ mWidth := aw;
+ mHeight := ah;
+end;
+
+
+constructor THControl.Create (aparent: THControl);
+begin
+ Create();
+ mParent := aparent;
+end;
+
+
destructor THControl.Destroy ();
var
f, c: Integer;
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 (const sz: TLaySize); inline; begin mMaxSize := sz; end;
+// ////////////////////////////////////////////////////////////////////////// //
+function THControl.getDefSize (): TLaySize; inline; begin result := mLayDefSize; end;
+function THControl.getMaxSize (): TLaySize; inline; begin result := mLayMaxSize; 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;
@@ -509,13 +674,233 @@ 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.getMargins (): TLayMargins; inline;
+begin
+ result := TLayMargins.Create(mFrameHeight, mFrameWidth, mFrameHeight, mFrameWidth);
+end;
+
+procedure THControl.setActualSizePos (constref apos: TLayPos; constref asize: TLaySize); inline; begin
+ if (mParent <> nil) then
+ begin
+ mX := apos.x;
+ mY := apos.y;
+ end;
+ mWidth := asize.w;
+ mHeight := asize.h;
+end;
+
+procedure THControl.layPrepare ();
+begin
+ mLayDefSize := mDefSize;
+ mLayMaxSize := mMaxSize;
+ if (mLayMaxSize.w >= 0) then mLayMaxSize.w += mFrameWidth*2;
+ if (mLayMaxSize.h >= 0) then mLayMaxSize.h += mFrameHeight*2;
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+function THControl.parsePos (par: TTextParser): TLayPos;
+var
+ ech: AnsiChar = ')';
+begin
+ if (par.eatDelim('[')) then ech := ']' else par.expectDelim('(');
+ result.x := par.expectInt();
+ par.eatDelim(','); // optional comma
+ result.y := par.expectInt();
+ par.eatDelim(','); // optional comma
+ par.expectDelim(ech);
+end;
+
+function THControl.parseSize (par: TTextParser): TLaySize;
+var
+ ech: AnsiChar = ')';
+begin
+ if (par.eatDelim('[')) then ech := ']' else par.expectDelim('(');
+ result.h := par.expectInt();
+ par.eatDelim(','); // optional comma
+ result.w := par.expectInt();
+ par.eatDelim(','); // optional comma
+ par.expectDelim(ech);
+end;
+
+function THControl.parseBool (par: TTextParser): Boolean;
+begin
+ result :=
+ par.eatIdOrStr('true', false) or
+ par.eatIdOrStr('yes', false) or
+ par.eatIdOrStr('tan', false);
+ if not result then
+ begin
+ if (not par.eatIdOrStr('false', false)) and (not par.eatIdOrStr('no', false)) and (not par.eatIdOrStr('ona', false)) then
+ begin
+ par.error('boolean value expected');
+ end;
+ end;
+end;
+
+function THControl.parseAnyAlign (par: TTextParser): Integer;
+begin
+ if (par.eatIdOrStr('left', false)) or (par.eatIdOrStr('top', false)) then result := -1
+ else if (par.eatIdOrStr('right', false)) or (par.eatIdOrStr('bottom', false)) then result := 1
+ else if (par.eatIdOrStr('center', false)) then result := 0
+ else par.error('invalid align value');
+end;
+
+function THControl.parseHAlign (par: TTextParser): Integer;
+begin
+ if (par.eatIdOrStr('left', false)) then result := -1
+ else if (par.eatIdOrStr('right', false)) then result := 1
+ else if (par.eatIdOrStr('center', false)) then result := 0
+ else par.error('invalid horizontal align value');
+end;
+
+function THControl.parseVAlign (par: TTextParser): Integer;
+begin
+ if (par.eatIdOrStr('top', false)) then result := -1
+ else if (par.eatIdOrStr('bottom', false)) then result := 1
+ else if (par.eatIdOrStr('center', false)) then result := 0
+ else par.error('invalid vertical align value');
+end;
+
+procedure THControl.parseTextAlign (par: TTextParser; var h, v: Integer);
+var
+ wasH: Boolean = false;
+ wasV: Boolean = false;
+begin
+ while true do
+ begin
+ if (par.eatIdOrStr('left', false)) then
+ begin
+ if wasH then par.error('too many align directives');
+ wasH := true;
+ h := -1;
+ continue;
+ end;
+ if (par.eatIdOrStr('right', false)) then
+ begin
+ if wasH then par.error('too many align directives');
+ wasH := true;
+ h := 1;
+ continue;
+ end;
+ if (par.eatIdOrStr('hcenter', false)) then
+ begin
+ if wasH then par.error('too many align directives');
+ wasH := true;
+ h := 0;
+ continue;
+ end;
+ if (par.eatIdOrStr('top', false)) then
+ begin
+ if wasV then par.error('too many align directives');
+ wasV := true;
+ v := -1;
+ continue;
+ end;
+ if (par.eatIdOrStr('bottom', false)) then
+ begin
+ if wasV then par.error('too many align directives');
+ wasV := true;
+ v := 1;
+ continue;
+ end;
+ if (par.eatIdOrStr('vcenter', false)) then
+ begin
+ if wasV then par.error('too many align directives');
+ wasV := true;
+ v := 0;
+ continue;
+ end;
+ if (par.eatIdOrStr('center', false)) then
+ begin
+ if wasV or wasH then par.error('too many align directives');
+ wasV := true;
+ wasH := true;
+ h := 0;
+ v := 0;
+ continue;
+ end;
+ break;
+ end;
+ if not wasV and not wasH then par.error('invalid align value');
+end;
+
+// par should be on '{'; final '}' is eaten
+procedure THControl.parseProperties (par: TTextParser);
+var
+ pn: AnsiString;
+begin
+ if (not par.eatDelim('{')) then exit;
+ while (not par.eatDelim('}')) do
+ begin
+ if (par.tokType <> par.TTId) and (par.tokType <> par.TTStr) then par.error('property name expected');
+ pn := par.tokStr;
+ par.skipToken();
+ par.eatDelim(':'); // optional
+ if not parseProperty(pn, par) then par.errorfmt('invalid property name ''%s''', [pn]);
+ par.eatDelim(','); // optional
+ end;
+end;
+
+// par should be on '{'
+procedure THControl.parseChildren (par: TTextParser);
+var
+ cc: THControlClass;
+ ctl: THControl;
+begin
+ par.expectDelim('{');
+ while (not par.eatDelim('}')) do
+ begin
+ if (par.tokType <> par.TTId) then par.error('control name expected');
+ cc := findCtlClass(par.tokStr);
+ if (cc = nil) then par.errorfmt('unknown control name: ''%s''', [par.tokStr]);
+ //writeln('children for <', par.tokStr, '>: <', cc.className, '>');
+ par.skipToken();
+ par.eatDelim(':'); // optional
+ ctl := cc.Create(nil);
+ try
+ ctl.parseProperties(par);
+ except
+ FreeAndNil(ctl);
+ raise;
+ end;
+ //writeln(': ', ctl.mDefSize.toString);
+ appendChild(ctl);
+ par.eatDelim(','); // optional
+ end;
+end;
+
+
+function THControl.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
+begin
+ result := true;
+ if (strEquCI1251(prname, 'flex')) then begin flex := par.expectInt(); exit; end;
+ // sizes
+ if (strEquCI1251(prname, 'defsize')) then begin mDefSize := parseSize(par); exit; end;
+ if (strEquCI1251(prname, 'maxsize')) then begin mMaxSize := parseSize(par); exit; end;
+ if (strEquCI1251(prname, 'wrap')) then begin mCanWrap := parseBool(par); exit; end;
+ if (strEquCI1251(prname, 'linestart')) then begin mLineStart := parseBool(par); exit; end;
+ if (strEquCI1251(prname, 'expand')) then begin mExpand := parseBool(par); exit; end;
+ // align
+ if (strEquCI1251(prname, 'align')) then begin mAlign := parseAnyAlign(par); exit; end;
+ if (strEquCI1251(prname, 'hgroup')) then begin mHGroup := par.expectStrOrId(true); exit; end; // allow empty strings
+ if (strEquCI1251(prname, 'vgroup')) then begin mVGroup := par.expectStrOrId(true); exit; end; // allow empty strings
+ // other
+ if (strEquCI1251(prname, 'canfocus')) then begin mCanFocus := parseBool(par); exit; end;
+ if (strEquCI1251(prname, 'enabled')) then begin mEnabled := parseBool(par); exit; end;
+ if (strEquCI1251(prname, 'disabled')) then begin mEnabled := not parseBool(par); exit; end;
+ if (strEquCI1251(prname, 'escclose')) then begin mEscClose := not parseBool(par); exit; end;
+ if (strEquCI1251(prname, 'eatkeys')) then begin mEatKeys := not parseBool(par); exit; end;
+ result := false;
+end;
+
+// ////////////////////////////////////////////////////////////////////////// //
procedure THControl.activated ();
begin
end;
end;
+function THTopWindow.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
+begin
+ if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
+ begin
+ mTitle := par.expectStrOrId(true);
+ result := true;
+ exit;
+ end;
+ if (strEquCI1251(prname, 'children')) then
+ begin
+ parseChildren(par);
+ result := true;
+ exit;
+ end;
+ if (strEquCI1251(prname, 'orientation')) or (strEquCI1251(prname, 'orient')) then
+ begin
+ if (par.eatIdOrStr('horizontal', false)) or (par.eatIdOrStr('horiz', false)) then mHoriz := true
+ else if (par.eatIdOrStr('vertical', false)) or (par.eatIdOrStr('vert', false)) then mHoriz := false
+ else par.error('`horizontal` or `vertical` expected');
+ result := true;
+ exit;
+ end;
+ result := inherited parseProperty(prname, par);
+end;
+
+
procedure THTopWindow.centerInScreen ();
begin
if (mWidth > 0) and (mHeight > 0) then
end;
+// ////////////////////////////////////////////////////////////////////////// //
+constructor THCtlBox.Create (ahoriz: Boolean; aparent: THControl=nil);
+begin
+ inherited Create(aparent);
+ mHoriz := ahoriz;
+end;
+
+
+function THCtlBox.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
+begin
+ if (strEquCI1251(prname, 'orientation')) or (strEquCI1251(prname, 'orient')) then
+ begin
+ if (par.eatIdOrStr('horizontal', false)) or (par.eatIdOrStr('horiz', false)) then mHoriz := true
+ else if (par.eatIdOrStr('vertical', false)) or (par.eatIdOrStr('vert', false)) then mHoriz := false
+ else par.error('`horizontal` or `vertical` expected');
+ result := true;
+ exit;
+ end;
+ if (strEquCI1251(prname, 'frame')) then
+ begin
+ mHasFrame := parseBool(par);
+ if (mHasFrame) then begin mFrameWidth := 8; mFrameHeight := 8; end else begin mFrameWidth := 0; mFrameHeight := 0; end;
+ result := true;
+ exit;
+ end;
+ if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
+ begin
+ mCaption := par.expectStrOrId(true);
+ mDefSize := TLaySize.Create(Length(mCaption)*8+2+8*2, 8*2+2);
+ result := true;
+ exit;
+ end;
+ if (strEquCI1251(prname, 'children')) then
+ begin
+ parseChildren(par);
+ result := true;
+ exit;
+ end;
+ result := inherited parseProperty(prname, par);
+end;
+
+
+procedure THCtlBox.drawControl (sx, sy: Integer);
+var
+ r, g, b: Integer;
+ tx: Integer;
+begin
+ if focused then begin r := 255; g := 255; b := 255; end else begin r := 255; g := 255; b := 0; end;
+ if mHasFrame then
+ begin
+ // draw frame
+ drawRectUI(mX+3, mY+3, mWidth-6, mHeight-6, r, g, b);
+ end;
+ if (Length(mCaption) > 0) then
+ begin
+ setScissor(mFrameWidth+1, 0, mWidth-mFrameWidth-2, 8);
+ tx := mX+((mWidth-Length(mCaption)*8) div 2)-1;
+ if mHasFrame then fillRect(tx, mY, Length(mCaption)*8+2, 8, 0, 0, 128);
+ drawText8(tx+1, mY, mCaption, r, g, b);
+ end;
+end;
+
+function THCtlBox.mouseEvent (var ev: THMouseEvent): Boolean;
+var
+ lx, ly: Integer;
+begin
+ result := inherited mouseEvent(ev);
+ lx := ev.x;
+ ly := ev.y;
+ if not result and toLocal(lx, ly) then
+ begin
+ result := true;
+ end;
+end;
+
+
+//TODO: navigation with arrow keys, according to box orientation
+function THCtlBox.keyEvent (var ev: THKeyEvent): Boolean;
+begin
+ result := inherited keyEvent(ev);
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+constructor THCtlHBox.Create (aparent: THControl=nil);
+begin
+ inherited Create(true, aparent);
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+constructor THCtlVBox.Create (aparent: THControl=nil);
+begin
+ inherited Create(false, aparent);
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+constructor THCtlTextLabel.Create (const atext: AnsiString; aparent: THControl=nil);
+begin
+ inherited Create(aparent);
+ mHAlign := -1;
+ mVAlign := 0;
+ mText := atext;
+ mDefSize := TLaySize.Create(Length(atext)*8, 8);
+end;
+
+
+function THCtlTextLabel.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
+begin
+ if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
+ begin
+ mText := par.expectStrOrId(true);
+ mDefSize := TLaySize.Create(Length(mText)*8, 8);
+ result := true;
+ exit;
+ end;
+ if (strEquCI1251(prname, 'textalign')) then
+ begin
+ parseTextAlign(par, mHAlign, mVAlign);
+ result := true;
+ exit;
+ end;
+ result := inherited parseProperty(prname, par);
+end;
+
+
+procedure THCtlTextLabel.drawControl (sx, sy: Integer);
+var
+ xpos, ypos: Integer;
+begin
+ // debug
+ fillRect(sx, sy, mWidth, mHeight, 96, 96, 0);
+ drawRectUI(sx, sy, mWidth, mHeight, 96, 96, 96);
+
+ if (Length(mText) > 0) then
+ begin
+ if (mHAlign < 0) then xpos := 0
+ else if (mHAlign > 0) then xpos := mWidth-Length(mText)*8
+ else xpos := (mWidth-Length(mText)*8) div 2;
+
+ if (mVAlign < 0) then ypos := 0
+ else if (mVAlign > 0) then ypos := mHeight-8
+ else ypos := (mHeight-8) div 2;
+
+ drawText8(sx+xpos, sy+ypos, mText, 255, 255, 255);
+ end;
+end;
+
+
+function THCtlTextLabel.mouseEvent (var ev: THMouseEvent): Boolean;
+var
+ lx, ly: Integer;
+begin
+ result := inherited mouseEvent(ev);
+ lx := ev.x;
+ ly := ev.y;
+ if not result and toLocal(lx, ly) then
+ begin
+ result := true;
+ end;
+end;
+
+
+function THCtlTextLabel.keyEvent (var ev: THKeyEvent): Boolean;
+begin
+ result := inherited keyEvent(ev);
+end;
+
+
+initialization
+ registerCtlClass(THCtlBox, 'box');
+ registerCtlClass(THCtlHBox, 'hbox');
+ registerCtlClass(THCtlVBox, 'vbox');
+ registerCtlClass(THCtlTextLabel, 'label');
end.
index 7143501e947dc2e78f7e8463a6aa380c59e92e93..0c1aa7596868bfbe5aee5b11704379f74be8ffbc 100644 (file)
--- a/src/gx/gh_ui_common.pas
+++ b/src/gx/gh_ui_common.pas
property item[idx: Integer]: Integer read getIdx write setIdx; default;
end;
+ TLayMargins = record
+ public
+ top, right, bottom, left: Integer;
+
+ public
+ constructor Create (atop, aright, abottom, aleft: Integer);
+
+ function toString (): AnsiString;
+
+ function horiz (): Integer; inline;
+ function vert (): Integer; inline;
+ end;
implementation
function TLayPos.toString (): AnsiString; begin result := formatstrf('(%d,%d)', [x, y]); end;
function TLayPos.equals (constref a: TLayPos): Boolean; inline; begin result := (x = a.x) and (y = a.y); end;
+constructor TLayMargins.Create (atop, aright, abottom, aleft: Integer);
+begin
+ if (atop < 0) then atop := 0;
+ if (aright < 0) then aright := 0;
+ if (abottom < 0) then abottom := 0;
+ if (aleft < 0) then aleft := 0;
+ left := aleft;
+ right := aright;
+ top := atop;
+ bottom := abottom;
+end;
+function TLayMargins.toString (): AnsiString; begin result := formatstrf('(%s,%s,%s,%s)', [top, right, bottom, left]); end;
+function TLayMargins.horiz (): Integer; inline; begin result := left+right; end;
+function TLayMargins.vert (): Integer; inline; begin result := top+bottom; end;
+
end.
diff --git a/src/shared/xparser.pas b/src/shared/xparser.pas
index 7d7a9ed5d3bbdeb237376833203c68374a90986c..b985f1a30a781724b03a058c5b644621b9d0c851 100644 (file)
--- a/src/shared/xparser.pas
+++ b/src/shared/xparser.pas
interface
uses
- Classes{$IFDEF USE_MEMPOOL}, mempool{$ENDIF};
+ SysUtils, Classes{$IFDEF USE_MEMPOOL}, mempool{$ENDIF};
// ////////////////////////////////////////////////////////////////////////// //
type
+ TTextParser = class;
+
+ TParserException = class(Exception)
+ public
+ tokLine, tokCol: Integer;
+
+ public
+ constructor Create (pr: TTextParser; const amsg: AnsiString);
+ constructor CreateFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const);
+ end;
+
TTextParser = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
public
const
constructor Create (aopts: TOptions=[TOption.SignedNumbers]);
destructor Destroy (); override;
+ procedure error (const amsg: AnsiString); noreturn;
+ procedure errorfmt (const afmt: AnsiString; const args: array of const); noreturn;
+
function isEOF (): Boolean; inline;
function skipChar (): Boolean; // returns `false` on eof
{$ENDIF}
function expectId (): AnsiString;
- procedure expectId (const aid: AnsiString);
- function eatId (const aid: AnsiString): Boolean;
+ procedure expectId (const aid: AnsiString; caseSens: Boolean=true);
+ function eatId (const aid: AnsiString; caseSens: Boolean=true): Boolean;
+ function eatIdOrStr (const aid: AnsiString; caseSens: Boolean=true): Boolean;
function expectStr (allowEmpty: Boolean=false): AnsiString;
function expectInt (): Integer;
implementation
uses
- SysUtils, utils;
+ utils;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+constructor TParserException.Create (pr: TTextParser; const amsg: AnsiString);
+begin
+ if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end;
+ inherited Create(amsg);
+end;
+
+constructor TParserException.CreateFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const);
+begin
+ if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end;
+ inherited Create(formatstrf(afmt, args));
+end;
// ////////////////////////////////////////////////////////////////////////// //
end;
+procedure TTextParser.error (const amsg: AnsiString); noreturn;
+begin
+ raise TParserException.Create(self, amsg);
+end;
+
+
+procedure TTextParser.errorfmt (const afmt: AnsiString; const args: array of const); noreturn;
+begin
+ raise TParserException.CreateFmt(self, afmt, args);
+end;
+
+
function TTextParser.isEOF (): Boolean; inline; begin result := (mCurChar = #0); end;
end;
-procedure TTextParser.expectId (const aid: AnsiString);
+procedure TTextParser.expectId (const aid: AnsiString; caseSens: Boolean=true);
begin
- if (mTokType <> TTId) or (mTokStr <> aid) then raise Exception.Create('identifier '''+aid+''' expected');
+ if caseSens then
+ begin
+ if (mTokType <> TTId) or (mTokStr <> aid) then raise Exception.Create('identifier '''+aid+''' expected');
+ end
+ else
+ begin
+ if (mTokType <> TTId) or (not strEquCI1251(mTokStr, aid)) then raise Exception.Create('identifier '''+aid+''' expected');
+ end;
skipToken();
end;
-function TTextParser.eatId (const aid: AnsiString): Boolean;
+function TTextParser.eatId (const aid: AnsiString; caseSens: Boolean=true): Boolean;
begin
- result := (mTokType = TTId) and (mTokStr = aid);
+ if caseSens then
+ begin
+ result := (mTokType = TTId) and (mTokStr = aid);
+ end
+ else
+ begin
+ result := (mTokType = TTId) and strEquCI1251(mTokStr, aid);
+ end;
+ if result then skipToken();
+end;
+
+
+function TTextParser.eatIdOrStr (const aid: AnsiString; caseSens: Boolean=true): Boolean;
+begin
+ if caseSens then
+ begin
+ result := (mTokType = TTId) and (mTokStr = aid);
+ if not result then result := (mTokType = TTStr) and (mTokStr = aid);
+ end
+ else
+ begin
+ result := (mTokType = TTId) and strEquCI1251(mTokStr, aid);
+ if not result then result := (mTokType = TTStr) and strEquCI1251(mTokStr, aid);
+ end;
if result then skipToken();
end;