src/gx/gh_ui.pas

   1 (* coded by Ketmar // Invisible Vector <ketmar@ketmar.no-ip.org>
   2  * Understanding is not required. Only obedience.
   3  *
   4  * This program is free software: you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation, either version 3 of the License, or
   7  * (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License
  15  * along with this program. If not, see <http://www.gnu.org/licenses/>.
  16  *)
  17 {$INCLUDE ../shared/a_modes.inc}
  18 {$M+}
  19 unit gh_ui;
  20
  21 interface
  22
  23 uses
  24   SysUtils, Classes,
  25   GL, GLExt, SDL2,
  26   gh_ui_common,
  27   gh_ui_style,
  28   sdlcarcass, glgfx,
  29   xparser;
  30
  31
  32 // ////////////////////////////////////////////////////////////////////////// //
  33 type
  34   TUIControlClass = class of TUIControl;
  35
  36   TUIControl = class
  37   public
  38     type TActionCB = procedure (me: TUIControl; uinfo: Integer);
  39
  40   public
  41     const ClrIdxActive = 0;
  42     const ClrIdxDisabled = 1;
  43     const ClrIdxInactive = 2;
  44     const ClrIdxMax = 2;
  45
  46   private
  47     mParent: TUIControl;
  48     mId: AnsiString;
  49     mStyleId: AnsiString;
  50     mX, mY: Integer;
  51     mWidth, mHeight: Integer;
  52     mFrameWidth, mFrameHeight: Integer;
  53     mEnabled: Boolean;
  54     mCanFocus: Boolean;
  55     mChildren: array of TUIControl;
  56     mFocused: TUIControl; // valid only for top-level controls
  57     mGrab: TUIControl; // valid only for top-level controls
  58     mEscClose: Boolean; // valid only for top-level controls
  59     mEatKeys: Boolean;
  60     mDrawShadow: Boolean;
  61     // colors
  62     mCtl4Style: AnsiString;
  63     mBackColor: array[0..ClrIdxMax] of TGxRGBA;
  64     mTextColor: array[0..ClrIdxMax] of TGxRGBA;
  65     mFrameColor: array[0..ClrIdxMax] of TGxRGBA;
  66     mFrameTextColor: array[0..ClrIdxMax] of TGxRGBA;
  67     mFrameIconColor: array[0..ClrIdxMax] of TGxRGBA;
  68     mDarken: array[0..ClrIdxMax] of Integer; // -1: none
  69
  70   private
  71     scis: TScissorSave;
  72     scallowed: Boolean;
  73
  74   protected
  75     procedure updateStyle (); virtual;
  76     procedure cacheStyle (root: TUIStyle); virtual;
  77     function getColorIndex (): Integer; inline;
  78
  79   protected
  80     function getEnabled (): Boolean;
  81     procedure setEnabled (v: Boolean); inline;
  82
  83     function getFocused (): Boolean; inline;
  84     procedure setFocused (v: Boolean); inline;
  85
  86     function isMyChild (ctl: TUIControl): Boolean;
  87
  88     function findFirstFocus (): TUIControl;
  89     function findLastFocus (): TUIControl;
  90
  91     function findNextFocus (cur: TUIControl): TUIControl;
  92     function findPrevFocus (cur: TUIControl): TUIControl;
  93
  94     procedure activated (); virtual;
  95     procedure blurred (); virtual;
  96
  97     //WARNING! do not call scissor functions outside `.draw*()` API!
  98     // set scissor to this rect (in local coords)
  99     procedure setScissor (lx, ly, lw, lh: Integer);
 100     // reset scissor to whole control
 101     procedure resetScissor (fullArea: Boolean); inline; // "full area" means "with frame"
 102
 103     // DO NOT USE!
 104     // set scissor to this rect (in global coords)
 105     procedure setScissorGLInternal (x, y, w, h: Integer);
 106
 107   public
 108     actionCB: TActionCB;
 109
 110   private
 111     mDefSize: TLaySize; // default size
 112     mMaxSize: TLaySize; // maximum size
 113     mFlex: Integer;
 114     mHoriz: Boolean;
 115     mCanWrap: Boolean;
 116     mLineStart: Boolean;
 117     mHGroup: AnsiString;
 118     mVGroup: AnsiString;
 119     mAlign: Integer;
 120     mExpand: Boolean;
 121     mLayDefSize: TLaySize;
 122     mLayMaxSize: TLaySize;
 123
 124   public
 125     // layouter interface
 126     function getDefSize (): TLaySize; inline; // default size; <0: use max size
 127     //procedure setDefSize (const sz: TLaySize); inline; // default size; <0: use max size
 128     function getMargins (): TLayMargins; inline;
 129     function getMaxSize (): TLaySize; inline; // max size; <0: set to some huge value
 130     //procedure setMaxSize (const sz: TLaySize); inline; // max size; <0: set to some huge value
 131     function getFlex (): Integer; inline; // <=0: not flexible
 132     function isHorizBox (): Boolean; inline; // horizontal layout for children?
 133     procedure setHorizBox (v: Boolean); inline; // horizontal layout for children?
 134     function canWrap (): Boolean; inline; // for horizontal boxes: can wrap children? for child: `false` means 'nonbreakable at *next* ctl'
 135     procedure setCanWrap (v: Boolean); inline; // for horizontal boxes: can wrap children? for child: `false` means 'nonbreakable at *next* ctl'
 136     function isLineStart (): Boolean; inline; // `true` if this ctl should start a new line; ignored for vertical boxes
 137     procedure setLineStart (v: Boolean); inline; // `true` if this ctl should start a new line; ignored for vertical boxes
 138     function getAlign (): Integer; inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
 139     procedure setAlign (v: Integer); inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
 140     function getExpand (): Boolean; inline; // expanding in non-main direction: `true` will ignore align and eat all available space
 141     procedure setExpand (v: Boolean); inline; // expanding in non-main direction: `true` will ignore align and eat all available space
 142     function getHGroup (): AnsiString; inline; // empty: not grouped
 143     procedure setHGroup (const v: AnsiString); inline; // empty: not grouped
 144     function getVGroup (): AnsiString; inline; // empty: not grouped
 145     procedure setVGroup (const v: AnsiString); inline; // empty: not grouped
 146
 147     procedure setActualSizePos (constref apos: TLayPos; constref asize: TLaySize); inline;
 148
 149     procedure layPrepare (); virtual; // called before registering control in layouter
 150
 151   public
 152     property flex: Integer read mFlex write mFlex;
 153     property flDefaultSize: TLaySize read mDefSize write mDefSize;
 154     property flMaxSize: TLaySize read mMaxSize write mMaxSize;
 155     property flHoriz: Boolean read isHorizBox write setHorizBox;
 156     property flCanWrap: Boolean read canWrap write setCanWrap;
 157     property flLineStart: Boolean read isLineStart write setLineStart;
 158     property flAlign: Integer read getAlign write setAlign;
 159     property flExpand: Boolean read getExpand write setExpand;
 160     property flHGroup: AnsiString read getHGroup write setHGroup;
 161     property flVGroup: AnsiString read getVGroup write setVGroup;
 162
 163   protected
 164     function parsePos (par: TTextParser): TLayPos;
 165     function parseSize (par: TTextParser): TLaySize;
 166     function parseBool (par: TTextParser): Boolean;
 167     function parseAnyAlign (par: TTextParser): Integer;
 168     function parseHAlign (par: TTextParser): Integer;
 169     function parseVAlign (par: TTextParser): Integer;
 170     function parseOrientation (const prname: AnsiString; par: TTextParser): Boolean;
 171     procedure parseTextAlign (par: TTextParser; var h, v: Integer);
 172     procedure parseChildren (par: TTextParser); // par should be on '{'; final '}' is eaten
 173
 174   public
 175     // par is on property data
 176     // there may be more data in text stream, don't eat it!
 177     // return `true` if property name is valid and value was parsed
 178     // return `false` if property name is invalid; don't advance parser in this case
 179     // throw on property data errors
 180     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; virtual;
 181
 182     // par should be on '{'; final '}' is eaten
 183     procedure parseProperties (par: TTextParser);
 184
 185   public
 186     constructor Create ();
 187     constructor Create (ax, ay, aw, ah: Integer);
 188     destructor Destroy (); override;
 189
 190     // `sx` and `sy` are screen coordinates
 191     procedure drawControl (gx, gy: Integer); virtual;
 192
 193     // called after all children drawn
 194     procedure drawControlPost (gx, gy: Integer); virtual;
 195
 196     procedure draw (); virtual;
 197
 198     function topLevel (): TUIControl; inline;
 199
 200     // returns `true` if global coords are inside this control
 201     function toLocal (var x, y: Integer): Boolean;
 202     function toLocal (gx, gy: Integer; out x, y: Integer): Boolean; inline;
 203     procedure toGlobal (var x, y: Integer);
 204     procedure toGlobal (lx, ly: Integer; out x, y: Integer); inline;
 205
 206     // x and y are global coords
 207     function controlAtXY (x, y: Integer): TUIControl;
 208
 209     function mouseEvent (var ev: THMouseEvent): Boolean; virtual; // returns `true` if event was eaten
 210     function keyEvent (var ev: THKeyEvent): Boolean; virtual; // returns `true` if event was eaten
 211
 212     function prevSibling (): TUIControl;
 213     function nextSibling (): TUIControl;
 214     function firstChild (): TUIControl; inline;
 215     function lastChild (): TUIControl; inline;
 216
 217     procedure appendChild (ctl: TUIControl); virtual;
 218
 219   public
 220     property id: AnsiString read mId;
 221     property styleId: AnsiString read mStyleId;
 222     property x0: Integer read mX;
 223     property y0: Integer read mY;
 224     property height: Integer read mHeight;
 225     property width: Integer read mWidth;
 226     property enabled: Boolean read getEnabled write setEnabled;
 227     property parent: TUIControl read mParent;
 228     property focused: Boolean read getFocused write setFocused;
 229     property escClose: Boolean read mEscClose write mEscClose;
 230     property eatKeys: Boolean read mEatKeys write mEatKeys;
 231   end;
 232
 233
 234   TUITopWindow = class(TUIControl)
 235   private
 236     mTitle: AnsiString;
 237     mDragging: Boolean;
 238     mDragStartX, mDragStartY: Integer;
 239     mWaitingClose: Boolean;
 240     mInClose: Boolean;
 241     mFreeOnClose: Boolean; // default: false
 242     mDoCenter: Boolean; // after layouting
 243
 244   protected
 245     procedure cacheStyle (root: TUIStyle); override;
 246
 247   protected
 248     procedure activated (); override;
 249     procedure blurred (); override;
 250
 251   public
 252     closeCB: TActionCB; // called after window was removed from ui window list
 253
 254   public
 255     constructor Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
 256
 257     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 258
 259     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
 260
 261     procedure centerInScreen ();
 262
 263     // `sx` and `sy` are screen coordinates
 264     procedure drawControl (gx, gy: Integer); override;
 265     procedure drawControlPost (gx, gy: Integer); override;
 266
 267     function keyEvent (var ev: THKeyEvent): Boolean; override; // returns `true` if event was eaten
 268     function mouseEvent (var ev: THMouseEvent): Boolean; override; // returns `true` if event was eaten
 269
 270   public
 271     property freeOnClose: Boolean read mFreeOnClose write mFreeOnClose;
 272   end;
 273
 274
 275   TUISimpleText = class(TUIControl)
 276   private
 277     type
 278       PItem = ^TItem;
 279       TItem = record
 280         title: AnsiString;
 281         centered: Boolean;
 282         hline: Boolean;
 283       end;
 284   private
 285     mItems: array of TItem;
 286
 287   public
 288     constructor Create (ax, ay: Integer);
 289     destructor Destroy (); override;
 290
 291     procedure appendItem (const atext: AnsiString; acentered: Boolean=false; ahline: Boolean=false);
 292
 293     procedure drawControl (gx, gy: Integer); override;
 294
 295     function mouseEvent (var ev: THMouseEvent): Boolean; override;
 296     function keyEvent (var ev: THKeyEvent): Boolean; override;
 297   end;
 298
 299
 300   TUICBListBox = class(TUIControl)
 301   private
 302     type
 303       PItem = ^TItem;
 304       TItem = record
 305         title: AnsiString;
 306         varp: PBoolean;
 307         actionCB: TActionCB;
 308       end;
 309   private
 310     mItems: array of TItem;
 311     mCurIndex: Integer;
 312
 313   public
 314     constructor Create (ax, ay: Integer);
 315     destructor Destroy (); override;
 316
 317     procedure appendItem (const atext: AnsiString; bv: PBoolean; aaction: TActionCB=nil);
 318
 319     procedure drawControl (gx, gy: Integer); override;
 320
 321     function mouseEvent (var ev: THMouseEvent): Boolean; override;
 322     function keyEvent (var ev: THKeyEvent): Boolean; override;
 323   end;
 324
 325   // ////////////////////////////////////////////////////////////////////// //
 326   TUIBox = class(TUIControl)
 327   private
 328     mHasFrame: Boolean;
 329     mCaption: AnsiString;
 330
 331   public
 332     constructor Create (ahoriz: Boolean);
 333
 334     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 335
 336     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
 337
 338     procedure drawControl (gx, gy: Integer); override;
 339
 340     function mouseEvent (var ev: THMouseEvent): Boolean; override;
 341     function keyEvent (var ev: THKeyEvent): Boolean; override;
 342   end;
 343
 344   TUIHBox = class(TUIBox)
 345   public
 346     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 347   end;
 348
 349   TUIVBox = class(TUIBox)
 350   public
 351     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 352   end;
 353
 354   // ////////////////////////////////////////////////////////////////////// //
 355   TUISpan = class(TUIControl)
 356   public
 357     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 358
 359     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
 360
 361     procedure drawControl (gx, gy: Integer); override;
 362   end;
 363
 364   // ////////////////////////////////////////////////////////////////////// //
 365   TUILine = class(TUIControl)
 366   public
 367     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 368
 369     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
 370
 371     procedure drawControl (gx, gy: Integer); override;
 372   end;
 373
 374   TUIHLine = class(TUILine)
 375   public
 376     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 377   end;
 378
 379   TUIVLine = class(TUILine)
 380   public
 381     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 382   end;
 383
 384   // ////////////////////////////////////////////////////////////////////// //
 385   TUITextLabel = class(TUIControl)
 386   private
 387     mText: AnsiString;
 388     mHAlign: Integer; // -1: left; 0: center; 1: right; default: left
 389     mVAlign: Integer; // -1: top; 0: center; 1: bottom; default: center
 390
 391   public
 392     constructor Create (const atext: AnsiString);
 393
 394     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 395
 396     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
 397
 398     procedure drawControl (gx, gy: Integer); override;
 399
 400     function mouseEvent (var ev: THMouseEvent): Boolean; override;
 401     function keyEvent (var ev: THKeyEvent): Boolean; override;
 402   end;
 403
 404
 405 // ////////////////////////////////////////////////////////////////////////// //
 406 function uiMouseEvent (ev: THMouseEvent): Boolean;
 407 function uiKeyEvent (ev: THKeyEvent): Boolean;
 408 procedure uiDraw ();
 409
 410
 411 // ////////////////////////////////////////////////////////////////////////// //
 412 procedure uiAddWindow (ctl: TUIControl);
 413 procedure uiRemoveWindow (ctl: TUIControl); // will free window if `mFreeOnClose` is `true`
 414 function uiVisibleWindow (ctl: TUIControl): Boolean;
 415
 416 procedure uiUpdateStyles ();
 417
 418
 419 // ////////////////////////////////////////////////////////////////////////// //
 420 // do layouting
 421 procedure uiLayoutCtl (ctl: TUIControl);
 422
 423
 424 // ////////////////////////////////////////////////////////////////////////// //
 425 var
 426   gh_ui_scale: Single = 1.0;
 427
 428
 429 implementation
 430
 431 uses
 432   gh_flexlay,
 433   utils;
 434
 435
 436 // ////////////////////////////////////////////////////////////////////////// //
 437 var
 438   knownCtlClasses: array of record
 439     klass: TUIControlClass;
 440     name: AnsiString;
 441   end = nil;
 442
 443
 444 procedure registerCtlClass (aklass: TUIControlClass; const aname: AnsiString);
 445 begin
 446   assert(aklass <> nil);
 447   assert(Length(aname) > 0);
 448   SetLength(knownCtlClasses, Length(knownCtlClasses)+1);
 449   knownCtlClasses[High(knownCtlClasses)].klass := aklass;
 450   knownCtlClasses[High(knownCtlClasses)].name := aname;
 451 end;
 452
 453
 454 function findCtlClass (const aname: AnsiString): TUIControlClass;
 455 var
 456   f: Integer;
 457 begin
 458   for f := 0 to High(knownCtlClasses) do
 459   begin
 460     if (strEquCI1251(aname, knownCtlClasses[f].name)) then
 461     begin
 462       result := knownCtlClasses[f].klass;
 463       exit;
 464     end;
 465   end;
 466   result := nil;
 467 end;
 468
 469
 470 // ////////////////////////////////////////////////////////////////////////// //
 471 type
 472   TFlexLayouter = specialize TFlexLayouterBase<TUIControl>;
 473
 474 procedure uiLayoutCtl (ctl: TUIControl);
 475 var
 476   lay: TFlexLayouter;
 477 begin
 478   if (ctl = nil) then exit;
 479   lay := TFlexLayouter.Create();
 480   try
 481     lay.setup(ctl);
 482     //lay.layout();
 483
 484     //writeln('============================'); lay.dumpFlat();
 485
 486     //writeln('=== initial ==='); lay.dump();
 487
 488     //lay.calcMaxSizeInternal(0);
 489     {
 490     lay.firstPass();
 491     writeln('=== after first pass ===');
 492     lay.dump();
 493
 494     lay.secondPass();
 495     writeln('=== after second pass ===');
 496     lay.dump();
 497     }
 498
 499     lay.layout();
 500     //writeln('=== final ==='); lay.dump();
 501
 502     if (ctl.mParent = nil) and (ctl is TUITopWindow) and (TUITopWindow(ctl).mDoCenter) then
 503     begin
 504       TUITopWindow(ctl).centerInScreen();
 505     end;
 506
 507   finally
 508     FreeAndNil(lay);
 509   end;
 510 end;
 511
 512
 513 // ////////////////////////////////////////////////////////////////////////// //
 514 var
 515   uiTopList: array of TUIControl = nil;
 516
 517
 518 procedure uiUpdateStyles ();
 519 var
 520   ctl: TUIControl;
 521 begin
 522   for ctl in uiTopList do ctl.updateStyle();
 523 end;
 524
 525
 526 function uiMouseEvent (ev: THMouseEvent): Boolean;
 527 var
 528   f, c: Integer;
 529   lx, ly: Integer;
 530   ctmp: TUIControl;
 531 begin
 532   ev.x := trunc(ev.x/gh_ui_scale);
 533   ev.y := trunc(ev.y/gh_ui_scale);
 534   ev.dx := trunc(ev.dx/gh_ui_scale); //FIXME
 535   ev.dy := trunc(ev.dy/gh_ui_scale); //FIXME
 536   if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].mouseEvent(ev);
 537   if not result and (ev.press) then
 538   begin
 539     for f := High(uiTopList) downto 0 do
 540     begin
 541       if uiTopList[f].toLocal(ev.x, ev.y, lx, ly) then
 542       begin
 543         result := true;
 544         if uiTopList[f].mEnabled and (f <> High(uiTopList)) then
 545         begin
 546           uiTopList[High(uiTopList)].blurred();
 547           ctmp := uiTopList[f];
 548           ctmp.mGrab := nil;
 549           for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
 550           uiTopList[High(uiTopList)] := ctmp;
 551           ctmp.activated();
 552           result := ctmp.mouseEvent(ev);
 553         end;
 554         exit;
 555       end;
 556     end;
 557   end;
 558 end;
 559
 560
 561 function uiKeyEvent (ev: THKeyEvent): Boolean;
 562 begin
 563   ev.x := trunc(ev.x/gh_ui_scale);
 564   ev.y := trunc(ev.y/gh_ui_scale);
 565   if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].keyEvent(ev);
 566   if (ev.release) then begin result := true; exit; end;
 567 end;
 568
 569
 570 procedure uiDraw ();
 571 var
 572   f, cidx: Integer;
 573   ctl: TUIControl;
 574 begin
 575   glMatrixMode(GL_MODELVIEW);
 576   glPushMatrix();
 577   try
 578     glLoadIdentity();
 579     glScalef(gh_ui_scale, gh_ui_scale, 1);
 580     for f := 0 to High(uiTopList) do
 581     begin
 582       ctl := uiTopList[f];
 583       ctl.draw();
 584       cidx := ctl.getColorIndex;
 585       //if (f <> High(uiTopList)) then darkenRect(ctl.x0, ctl.y0, ctl.width, ctl.height, 128);
 586       if (ctl.mDarken[cidx] > 0) then darkenRect(ctl.x0, ctl.y0, ctl.width, ctl.height, ctl.mDarken[cidx]);
 587     end;
 588   finally
 589     glMatrixMode(GL_MODELVIEW);
 590     glPopMatrix();
 591   end;
 592 end;
 593
 594
 595 procedure uiAddWindow (ctl: TUIControl);
 596 var
 597   f, c: Integer;
 598 begin
 599   if (ctl = nil) then exit;
 600   ctl := ctl.topLevel;
 601   if not (ctl is TUITopWindow) then exit; // alas
 602   for f := 0 to High(uiTopList) do
 603   begin
 604     if (uiTopList[f] = ctl) then
 605     begin
 606       if (f <> High(uiTopList)) then
 607       begin
 608         uiTopList[High(uiTopList)].blurred();
 609         for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
 610         uiTopList[High(uiTopList)] := ctl;
 611         ctl.activated();
 612       end;
 613       exit;
 614     end;
 615   end;
 616   if (Length(uiTopList) > 0) then uiTopList[High(uiTopList)].blurred();
 617   SetLength(uiTopList, Length(uiTopList)+1);
 618   uiTopList[High(uiTopList)] := ctl;
 619   ctl.updateStyle();
 620   ctl.activated();
 621 end;
 622
 623
 624 procedure uiRemoveWindow (ctl: TUIControl);
 625 var
 626   f, c: Integer;
 627 begin
 628   if (ctl = nil) then exit;
 629   ctl := ctl.topLevel;
 630   if not (ctl is TUITopWindow) then exit; // alas
 631   for f := 0 to High(uiTopList) do
 632   begin
 633     if (uiTopList[f] = ctl) then
 634     begin
 635       ctl.blurred();
 636       for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
 637       SetLength(uiTopList, Length(uiTopList)-1);
 638       if (ctl is TUITopWindow) then
 639       begin
 640         try
 641           if assigned(TUITopWindow(ctl).closeCB) then TUITopWindow(ctl).closeCB(ctl, 0);
 642         finally
 643           if (TUITopWindow(ctl).mFreeOnClose) then FreeAndNil(ctl);
 644         end;
 645       end;
 646       exit;
 647     end;
 648   end;
 649 end;
 650
 651
 652 function uiVisibleWindow (ctl: TUIControl): Boolean;
 653 var
 654   f: Integer;
 655 begin
 656   result := false;
 657   if (ctl = nil) then exit;
 658   ctl := ctl.topLevel;
 659   if not (ctl is TUITopWindow) then exit; // alas
 660   for f := 0 to High(uiTopList) do
 661   begin
 662     if (uiTopList[f] = ctl) then begin result := true; exit; end;
 663   end;
 664 end;
 665
 666
 667 // ////////////////////////////////////////////////////////////////////////// //
 668 constructor TUIControl.Create ();
 669 begin
 670   mParent := nil;
 671   mId := '';
 672   mX := 0;
 673   mY := 0;
 674   mWidth := 64;
 675   mHeight := 8;
 676   mFrameWidth := 0;
 677   mFrameHeight := 0;
 678   mEnabled := true;
 679   mCanFocus := true;
 680   mChildren := nil;
 681   mFocused := nil;
 682   mGrab := nil;
 683   mEscClose := false;
 684   mEatKeys := false;
 685   scallowed := false;
 686   mDrawShadow := false;
 687   actionCB := nil;
 688   // layouter interface
 689   //mDefSize := TLaySize.Create(64, 8); // default size
 690   mDefSize := TLaySize.Create(0, 0); // default size
 691   mMaxSize := TLaySize.Create(-1, -1); // maximum size
 692   mFlex := 0;
 693   mHoriz := true;
 694   mCanWrap := false;
 695   mLineStart := false;
 696   mHGroup := '';
 697   mVGroup := '';
 698   mStyleId := '';
 699   mCtl4Style := '';
 700   mAlign := -1; // left/top
 701   mExpand := false;
 702 end;
 703
 704
 705 constructor TUIControl.Create (ax, ay, aw, ah: Integer);
 706 begin
 707   Create();
 708   mX := ax;
 709   mY := ay;
 710   mWidth := aw;
 711   mHeight := ah;
 712 end;
 713
 714
 715 destructor TUIControl.Destroy ();
 716 var
 717   f, c: Integer;
 718 begin
 719   if (mParent <> nil) then
 720   begin
 721     setFocused(false);
 722     for f := 0 to High(mParent.mChildren) do
 723     begin
 724       if (mParent.mChildren[f] = self) then
 725       begin
 726         for c := f+1 to High(mParent.mChildren) do mParent.mChildren[c-1] := mParent.mChildren[c];
 727         SetLength(mParent.mChildren, Length(mParent.mChildren)-1);
 728       end;
 729     end;
 730   end;
 731   for f := 0 to High(mChildren) do
 732   begin
 733     mChildren[f].mParent := nil;
 734     mChildren[f].Free();
 735   end;
 736   mChildren := nil;
 737 end;
 738
 739
 740 function TUIControl.getColorIndex (): Integer; inline;
 741 begin
 742   if (not mEnabled) then begin result := ClrIdxDisabled; exit; end;
 743   if (getFocused) then begin result := ClrIdxActive; exit; end;
 744   result := ClrIdxInactive;
 745 end;
 746
 747 procedure TUIControl.updateStyle ();
 748 var
 749   stl: TUIStyle = nil;
 750   ctl: TUIControl;
 751 begin
 752   ctl := self;
 753   while (ctl <> nil) do
 754   begin
 755     if (Length(ctl.mStyleId) <> 0) then begin stl := uiFindStyle(ctl.mStyleId); break; end;
 756     ctl := ctl.mParent;
 757   end;
 758   if (stl = nil) then stl := uiFindStyle(''); // default
 759   cacheStyle(stl);
 760   for ctl in mChildren do ctl.updateStyle();
 761 end;
 762
 763 procedure TUIControl.cacheStyle (root: TUIStyle);
 764 var
 765   cst: AnsiString = '';
 766 begin
 767   //writeln('caching style for <', className, '> (', mCtl4Style, ')...');
 768   if (Length(mCtl4Style) > 0) then
 769   begin
 770     cst := mCtl4Style;
 771     if (cst[1] <> '@') then cst := '@'+cst;
 772   end;
 773   // active
 774   mBackColor[ClrIdxActive] := root['back-color'+cst].asRGBADef(TGxRGBA.Create(0, 0, 128));
 775   mTextColor[ClrIdxActive] := root['text-color'+cst].asRGBADef(TGxRGBA.Create(255, 255, 255));
 776   mFrameColor[ClrIdxActive] := root['frame-color'+cst].asRGBADef(TGxRGBA.Create(255, 255, 255));
 777   mFrameTextColor[ClrIdxActive] := root['frame-text-color'+cst].asRGBADef(TGxRGBA.Create(255, 255, 255));
 778   mFrameIconColor[ClrIdxActive] := root['frame-icon-color'+cst].asRGBADef(TGxRGBA.Create(0, 255, 0));
 779   mDarken[ClrIdxActive] := root['darken'+cst].asIntDef(-1);
 780   // disabled
 781   mBackColor[ClrIdxDisabled] := root['back-color#disabled'+cst].asRGBADef(TGxRGBA.Create(0, 0, 128));
 782   mTextColor[ClrIdxDisabled] := root['text-color#disabled'+cst].asRGBADef(TGxRGBA.Create(127, 127, 127));
 783   mFrameColor[ClrIdxDisabled] := root['frame-color#disabled'+cst].asRGBADef(TGxRGBA.Create(127, 127, 127));
 784   mFrameTextColor[ClrIdxDisabled] := root['frame-text-color#disabled'+cst].asRGBADef(TGxRGBA.Create(127, 127, 127));
 785   mFrameIconColor[ClrIdxDisabled] := root['frame-icon-color#disabled'+cst].asRGBADef(TGxRGBA.Create(0, 127, 0));
 786   mDarken[ClrIdxDisabled] := root['darken#disabled'+cst].asIntDef(128);
 787   // inactive
 788   mBackColor[ClrIdxInactive] := root['back-color#inactive'+cst].asRGBADef(TGxRGBA.Create(0, 0, 128));
 789   mTextColor[ClrIdxInactive] := root['text-color#inactive'+cst].asRGBADef(TGxRGBA.Create(255, 255, 255));
 790   mFrameColor[ClrIdxInactive] := root['frame-color#inactive'+cst].asRGBADef(TGxRGBA.Create(255, 255, 255));
 791   mFrameTextColor[ClrIdxInactive] := root['frame-text-color#inactive'+cst].asRGBADef(TGxRGBA.Create(255, 255, 255));
 792   mFrameIconColor[ClrIdxInactive] := root['frame-icon-color#inactive'+cst].asRGBADef(TGxRGBA.Create(0, 255, 0));
 793   mDarken[ClrIdxInactive] := root['darken#inactive'+cst].asIntDef(128);
 794 end;
 795
 796
 797 // ////////////////////////////////////////////////////////////////////////// //
 798 function TUIControl.getDefSize (): TLaySize; inline; begin result := mLayDefSize; end;
 799 function TUIControl.getMaxSize (): TLaySize; inline; begin result := mLayMaxSize; end;
 800 function TUIControl.getFlex (): Integer; inline; begin result := mFlex; end;
 801 function TUIControl.isHorizBox (): Boolean; inline; begin result := mHoriz; end;
 802 procedure TUIControl.setHorizBox (v: Boolean); inline; begin mHoriz := v; end;
 803 function TUIControl.canWrap (): Boolean; inline; begin result := mCanWrap; end;
 804 procedure TUIControl.setCanWrap (v: Boolean); inline; begin mCanWrap := v; end;
 805 function TUIControl.isLineStart (): Boolean; inline; begin result := mLineStart; end;
 806 procedure TUIControl.setLineStart (v: Boolean); inline; begin mLineStart := v; end;
 807 function TUIControl.getAlign (): Integer; inline; begin result := mAlign; end;
 808 procedure TUIControl.setAlign (v: Integer); inline; begin mAlign := v; end;
 809 function TUIControl.getExpand (): Boolean; inline; begin result := mExpand; end;
 810 procedure TUIControl.setExpand (v: Boolean); inline; begin mExpand := v; end;
 811 function TUIControl.getHGroup (): AnsiString; inline; begin result := mHGroup; end;
 812 procedure TUIControl.setHGroup (const v: AnsiString); inline; begin mHGroup := v; end;
 813 function TUIControl.getVGroup (): AnsiString; inline; begin result := mVGroup; end;
 814 procedure TUIControl.setVGroup (const v: AnsiString); inline; begin mVGroup := v; end;
 815
 816 function TUIControl.getMargins (): TLayMargins; inline;
 817 begin
 818   result := TLayMargins.Create(mFrameHeight, mFrameWidth, mFrameHeight, mFrameWidth);
 819 end;
 820
 821 procedure TUIControl.setActualSizePos (constref apos: TLayPos; constref asize: TLaySize); inline; begin
 822   //writeln(self.className, '; pos=', apos.toString, '; size=', asize.toString);
 823   if (mParent <> nil) then
 824   begin
 825     mX := apos.x;
 826     mY := apos.y;
 827   end;
 828   mWidth := asize.w;
 829   mHeight := asize.h;
 830 end;
 831
 832 procedure TUIControl.layPrepare ();
 833 begin
 834   mLayDefSize := mDefSize;
 835   mLayMaxSize := mMaxSize;
 836   if (mLayMaxSize.w >= 0) then mLayMaxSize.w += mFrameWidth*2;
 837   if (mLayMaxSize.h >= 0) then mLayMaxSize.h += mFrameHeight*2;
 838 end;
 839
 840
 841 // ////////////////////////////////////////////////////////////////////////// //
 842 function TUIControl.parsePos (par: TTextParser): TLayPos;
 843 var
 844   ech: AnsiChar = ')';
 845 begin
 846   if (par.eatDelim('[')) then ech := ']' else par.expectDelim('(');
 847   result.x := par.expectInt();
 848   par.eatDelim(','); // optional comma
 849   result.y := par.expectInt();
 850   par.eatDelim(','); // optional comma
 851   par.expectDelim(ech);
 852 end;
 853
 854 function TUIControl.parseSize (par: TTextParser): TLaySize;
 855 var
 856   ech: AnsiChar = ')';
 857 begin
 858   if (par.eatDelim('[')) then ech := ']' else par.expectDelim('(');
 859   result.w := par.expectInt();
 860   par.eatDelim(','); // optional comma
 861   result.h := par.expectInt();
 862   par.eatDelim(','); // optional comma
 863   par.expectDelim(ech);
 864 end;
 865
 866 function TUIControl.parseBool (par: TTextParser): Boolean;
 867 begin
 868   result :=
 869     par.eatIdOrStrCI('true') or
 870     par.eatIdOrStrCI('yes') or
 871     par.eatIdOrStrCI('tan');
 872   if not result then
 873   begin
 874     if (not par.eatIdOrStrCI('false')) and (not par.eatIdOrStrCI('no')) and (not par.eatIdOrStrCI('ona')) then
 875     begin
 876       par.error('boolean value expected');
 877     end;
 878   end;
 879 end;
 880
 881 function TUIControl.parseAnyAlign (par: TTextParser): Integer;
 882 begin
 883        if (par.eatIdOrStrCI('left')) or (par.eatIdOrStrCI('top')) then result := -1
 884   else if (par.eatIdOrStrCI('right')) or (par.eatIdOrStrCI('bottom')) then result := 1
 885   else if (par.eatIdOrStrCI('center')) then result := 0
 886   else par.error('invalid align value');
 887 end;
 888
 889 function TUIControl.parseHAlign (par: TTextParser): Integer;
 890 begin
 891        if (par.eatIdOrStrCI('left')) then result := -1
 892   else if (par.eatIdOrStrCI('right')) then result := 1
 893   else if (par.eatIdOrStrCI('center')) then result := 0
 894   else par.error('invalid horizontal align value');
 895 end;
 896
 897 function TUIControl.parseVAlign (par: TTextParser): Integer;
 898 begin
 899        if (par.eatIdOrStrCI('top')) then result := -1
 900   else if (par.eatIdOrStrCI('bottom')) then result := 1
 901   else if (par.eatIdOrStrCI('center')) then result := 0
 902   else par.error('invalid vertical align value');
 903 end;
 904
 905 procedure TUIControl.parseTextAlign (par: TTextParser; var h, v: Integer);
 906 var
 907   wasH: Boolean = false;
 908   wasV: Boolean = false;
 909 begin
 910   while true do
 911   begin
 912     if (par.eatIdOrStrCI('left')) then
 913     begin
 914       if wasH then par.error('too many align directives');
 915       wasH := true;
 916       h := -1;
 917       continue;
 918     end;
 919     if (par.eatIdOrStrCI('right')) then
 920     begin
 921       if wasH then par.error('too many align directives');
 922       wasH := true;
 923       h := 1;
 924       continue;
 925     end;
 926     if (par.eatIdOrStrCI('hcenter')) then
 927     begin
 928       if wasH then par.error('too many align directives');
 929       wasH := true;
 930       h := 0;
 931       continue;
 932     end;
 933     if (par.eatIdOrStrCI('top')) then
 934     begin
 935       if wasV then par.error('too many align directives');
 936       wasV := true;
 937       v := -1;
 938       continue;
 939     end;
 940     if (par.eatIdOrStrCI('bottom')) then
 941     begin
 942       if wasV then par.error('too many align directives');
 943       wasV := true;
 944       v := 1;
 945       continue;
 946     end;
 947     if (par.eatIdOrStrCI('vcenter')) then
 948     begin
 949       if wasV then par.error('too many align directives');
 950       wasV := true;
 951       v := 0;
 952       continue;
 953     end;
 954     if (par.eatIdOrStrCI('center')) then
 955     begin
 956       if wasV or wasH then par.error('too many align directives');
 957       wasV := true;
 958       wasH := true;
 959       h := 0;
 960       v := 0;
 961       continue;
 962     end;
 963     break;
 964   end;
 965   if not wasV and not wasH then par.error('invalid align value');
 966 end;
 967
 968 function TUIControl.parseOrientation (const prname: AnsiString; par: TTextParser): Boolean;
 969 begin
 970   if (strEquCI1251(prname, 'orientation')) or (strEquCI1251(prname, 'orient')) then
 971   begin
 972          if (par.eatIdOrStrCI('horizontal')) or (par.eatIdOrStrCI('horiz')) then mHoriz := true
 973     else if (par.eatIdOrStrCI('vertical')) or (par.eatIdOrStrCI('vert')) then mHoriz := false
 974     else par.error('`horizontal` or `vertical` expected');
 975     result := true;
 976   end
 977   else
 978   begin
 979     result := false;
 980   end;
 981 end;
 982
 983 // par should be on '{'; final '}' is eaten
 984 procedure TUIControl.parseProperties (par: TTextParser);
 985 var
 986   pn: AnsiString;
 987 begin
 988   if (not par.eatDelim('{')) then exit;
 989   while (not par.eatDelim('}')) do
 990   begin
 991     if (not par.isIdOrStr) then par.error('property name expected');
 992     pn := par.tokStr;
 993     par.skipToken();
 994     par.eatDelim(':'); // optional
 995     if not parseProperty(pn, par) then par.errorfmt('invalid property name ''%s''', [pn]);
 996     par.eatDelim(','); // optional
 997   end;
 998 end;
 999
1000 // par should be on '{'
1001 procedure TUIControl.parseChildren (par: TTextParser);
1002 var
1003   cc: TUIControlClass;
1004   ctl: TUIControl;
1005 begin
1006   par.expectDelim('{');
1007   while (not par.eatDelim('}')) do
1008   begin
1009     if (not par.isIdOrStr) then par.error('control name expected');
1010     cc := findCtlClass(par.tokStr);
1011     if (cc = nil) then par.errorfmt('unknown control name: ''%s''', [par.tokStr]);
1012     //writeln('children for <', par.tokStr, '>: <', cc.className, '>');
1013     par.skipToken();
1014     par.eatDelim(':'); // optional
1015     ctl := cc.Create();
1016     //writeln('  mHoriz=', ctl.mHoriz);
1017     try
1018       ctl.parseProperties(par);
1019     except
1020       FreeAndNil(ctl);
1021       raise;
1022     end;
1023     //writeln(': ', ctl.mDefSize.toString);
1024     appendChild(ctl);
1025     par.eatDelim(','); // optional
1026   end;
1027 end;
1028
1029
1030 function TUIControl.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
1031 begin
1032   result := true;
1033   if (strEquCI1251(prname, 'id')) then begin mId := par.expectIdOrStr(true); exit; end; // allow empty strings
1034   if (strEquCI1251(prname, 'style')) then begin mStyleId := par.expectIdOrStr(); exit; end; // no empty strings
1035   if (strEquCI1251(prname, 'flex')) then begin flex := par.expectInt(); exit; end;
1036   // sizes
1037   if (strEquCI1251(prname, 'defsize')) or (strEquCI1251(prname, 'size')) then begin mDefSize := parseSize(par); exit; end;
1038   if (strEquCI1251(prname, 'maxsize')) then begin mMaxSize := parseSize(par); exit; end;
1039   if (strEquCI1251(prname, 'defwidth')) or (strEquCI1251(prname, 'width')) then begin mDefSize.w := par.expectInt(); exit; end;
1040   if (strEquCI1251(prname, 'defheight')) or (strEquCI1251(prname, 'height')) then begin mDefSize.h := par.expectInt(); exit; end;
1041   if (strEquCI1251(prname, 'maxwidth')) then begin mMaxSize.w := par.expectInt(); exit; end;
1042   if (strEquCI1251(prname, 'maxheight')) then begin mMaxSize.h := par.expectInt(); exit; end;
1043   // flags
1044   if (strEquCI1251(prname, 'wrap')) then begin mCanWrap := parseBool(par); exit; end;
1045   if (strEquCI1251(prname, 'linestart')) then begin mLineStart := parseBool(par); exit; end;
1046   if (strEquCI1251(prname, 'expand')) then begin mExpand := parseBool(par); exit; end;
1047   // align
1048   if (strEquCI1251(prname, 'align')) then begin mAlign := parseAnyAlign(par); exit; end;
1049   if (strEquCI1251(prname, 'hgroup')) then begin mHGroup := par.expectIdOrStr(true); exit; end; // allow empty strings
1050   if (strEquCI1251(prname, 'vgroup')) then begin mVGroup := par.expectIdOrStr(true); exit; end; // allow empty strings
1051   // other
1052   if (strEquCI1251(prname, 'canfocus')) then begin mCanFocus := parseBool(par); exit; end;
1053   if (strEquCI1251(prname, 'enabled')) then begin mEnabled := parseBool(par); exit; end;
1054   if (strEquCI1251(prname, 'disabled')) then begin mEnabled := not parseBool(par); exit; end;
1055   if (strEquCI1251(prname, 'escclose')) then begin mEscClose := not parseBool(par); exit; end;
1056   if (strEquCI1251(prname, 'eatkeys')) then begin mEatKeys := not parseBool(par); exit; end;
1057   result := false;
1058 end;
1059
1060
1061 // ////////////////////////////////////////////////////////////////////////// //
1062 procedure TUIControl.activated ();
1063 begin
1064 end;
1065
1066
1067 procedure TUIControl.blurred ();
1068 begin
1069   mGrab := nil;
1070 end;
1071
1072
1073 function TUIControl.topLevel (): TUIControl; inline;
1074 begin
1075   result := self;
1076   while (result.mParent <> nil) do result := result.mParent;
1077 end;
1078
1079
1080 function TUIControl.getEnabled (): Boolean;
1081 var
1082   ctl: TUIControl;
1083 begin
1084   result := false;
1085   if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
1086   ctl := mParent;
1087   while (ctl <> nil) do
1088   begin
1089     if (not ctl.mEnabled) or (ctl.mWidth < 1) or (ctl.mHeight < 1) then exit;
1090     ctl := ctl.mParent;
1091   end;
1092   result := true;
1093 end;
1094
1095
1096 procedure TUIControl.setEnabled (v: Boolean); inline;
1097 begin
1098   if (mEnabled = v) then exit;
1099   mEnabled := v;
1100   if not v and focused then setFocused(false);
1101 end;
1102
1103
1104 function TUIControl.getFocused (): Boolean; inline;
1105 begin
1106   if (mParent = nil) then
1107   begin
1108     result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = self);
1109   end
1110   else
1111   begin
1112     result := (topLevel.mFocused = self);
1113     if (result) then result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = topLevel);
1114   end;
1115 end;
1116
1117
1118 procedure TUIControl.setFocused (v: Boolean); inline;
1119 var
1120   tl: TUIControl;
1121 begin
1122   tl := topLevel;
1123   if not v then
1124   begin
1125     if (tl.mFocused = self) then
1126     begin
1127       tl.blurred();
1128       tl.mFocused := tl.findNextFocus(self);
1129       if (tl.mFocused = self) then tl.mFocused := nil;
1130     end;
1131     exit;
1132   end;
1133   if (not mEnabled) or (not mCanFocus) then exit;
1134   if (tl.mFocused <> self) then
1135   begin
1136     if (tl.mFocused <> nil) then tl.mFocused.blurred();
1137     tl.mFocused := self;
1138     if (tl.mGrab <> self) then tl.mGrab := nil;
1139     activated();
1140   end;
1141 end;
1142
1143
1144 function TUIControl.isMyChild (ctl: TUIControl): Boolean;
1145 begin
1146   result := true;
1147   while (ctl <> nil) do
1148   begin
1149     if (ctl.mParent = self) then exit;
1150     ctl := ctl.mParent;
1151   end;
1152   result := false;
1153 end;
1154
1155
1156 // returns `true` if global coords are inside this control
1157 function TUIControl.toLocal (var x, y: Integer): Boolean;
1158 var
1159   ctl: TUIControl;
1160 begin
1161   ctl := self;
1162   while (ctl <> nil) do
1163   begin
1164     Dec(x, ctl.mX);
1165     Dec(y, ctl.mY);
1166     ctl := ctl.mParent;
1167   end;
1168   result := (x >= 0) and (y >= 0) and (x < mWidth) and (y < mHeight);
1169 end;
1170
1171 function TUIControl.toLocal (gx, gy: Integer; out x, y: Integer): Boolean; inline;
1172 begin
1173   x := gx;
1174   y := gy;
1175   result := toLocal(x, y);
1176 end;
1177
1178 procedure TUIControl.toGlobal (var x, y: Integer);
1179 var
1180   ctl: TUIControl;
1181 begin
1182   ctl := self;
1183   while (ctl <> nil) do
1184   begin
1185     Inc(x, ctl.mX);
1186     Inc(y, ctl.mY);
1187     ctl := ctl.mParent;
1188   end;
1189 end;
1190
1191 procedure TUIControl.toGlobal (lx, ly: Integer; out x, y: Integer); inline;
1192 begin
1193   x := lx;
1194   y := ly;
1195   toGlobal(x, y);
1196 end;
1197
1198
1199 // x and y are global coords
1200 function TUIControl.controlAtXY (x, y: Integer): TUIControl;
1201 var
1202   lx, ly: Integer;
1203   f: Integer;
1204 begin
1205   result := nil;
1206   if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
1207   if not toLocal(x, y, lx, ly) then exit;
1208   for f := High(mChildren) downto 0 do
1209   begin
1210     result := mChildren[f].controlAtXY(x, y);
1211     if (result <> nil) then exit;
1212   end;
1213   result := self;
1214 end;
1215
1216
1217 function TUIControl.prevSibling (): TUIControl;
1218 var
1219   f: Integer;
1220 begin
1221   if (mParent <> nil) then
1222   begin
1223     for f := 1 to High(mParent.mChildren) do
1224     begin
1225       if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f-1]; exit; end;
1226     end;
1227   end;
1228   result := nil;
1229 end;
1230
1231 function TUIControl.nextSibling (): TUIControl;
1232 var
1233   f: Integer;
1234 begin
1235   if (mParent <> nil) then
1236   begin
1237     for f := 0 to High(mParent.mChildren)-1 do
1238     begin
1239       if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f+1]; exit; end;
1240     end;
1241   end;
1242   result := nil;
1243 end;
1244
1245 function TUIControl.firstChild (): TUIControl; inline;
1246 begin
1247   if (Length(mChildren) <> 0) then result := mChildren[0] else result := nil;
1248 end;
1249
1250 function TUIControl.lastChild (): TUIControl; inline;
1251 begin
1252   if (Length(mChildren) <> 0) then result := mChildren[High(mChildren)] else result := nil;
1253 end;
1254
1255
1256 function TUIControl.findFirstFocus (): TUIControl;
1257 var
1258   f: Integer;
1259 begin
1260   result := nil;
1261   if enabled then
1262   begin
1263     for f := 0 to High(mChildren) do
1264     begin
1265       result := mChildren[f].findFirstFocus();
1266       if (result <> nil) then exit;
1267     end;
1268     if mCanFocus then result := self;
1269   end;
1270 end;
1271
1272
1273 function TUIControl.findLastFocus (): TUIControl;
1274 var
1275   f: Integer;
1276 begin
1277   result := nil;
1278   if enabled then
1279   begin
1280     for f := High(mChildren) downto 0 do
1281     begin
1282       result := mChildren[f].findLastFocus();
1283       if (result <> nil) then exit;
1284     end;
1285     if mCanFocus then result := self;
1286   end;
1287 end;
1288
1289
1290 function TUIControl.findNextFocus (cur: TUIControl): TUIControl;
1291 begin
1292   result := nil;
1293   if enabled then
1294   begin
1295     if not isMyChild(cur) then cur := nil;
1296     if (cur = nil) then begin result := findFirstFocus(); exit; end;
1297     result := cur.findFirstFocus();
1298     if (result <> nil) and (result <> cur) then exit;
1299     while true do
1300     begin
1301       cur := cur.nextSibling;
1302       if (cur = nil) then break;
1303       result := cur.findFirstFocus();
1304       if (result <> nil) then exit;
1305     end;
1306     result := findFirstFocus();
1307   end;
1308 end;
1309
1310
1311 function TUIControl.findPrevFocus (cur: TUIControl): TUIControl;
1312 begin
1313   result := nil;
1314   if enabled then
1315   begin
1316     if not isMyChild(cur) then cur := nil;
1317     if (cur = nil) then begin result := findLastFocus(); exit; end;
1318     //FIXME!
1319     result := cur.findLastFocus();
1320     if (result <> nil) and (result <> cur) then exit;
1321     while true do
1322     begin
1323       cur := cur.prevSibling;
1324       if (cur = nil) then break;
1325       result := cur.findLastFocus();
1326       if (result <> nil) then exit;
1327     end;
1328     result := findLastFocus();
1329   end;
1330 end;
1331
1332
1333 procedure TUIControl.appendChild (ctl: TUIControl);
1334 begin
1335   if (ctl = nil) then exit;
1336   if (ctl.mParent <> nil) then exit;
1337   SetLength(mChildren, Length(mChildren)+1);
1338   mChildren[High(mChildren)] := ctl;
1339   ctl.mParent := self;
1340   Inc(ctl.mX, mFrameWidth);
1341   Inc(ctl.mY, mFrameHeight);
1342   if (ctl.mWidth > 0) and (ctl.mHeight > 0) and
1343      (ctl.mX+ctl.mWidth > mFrameWidth) and (ctl.mY+ctl.mHeight > mFrameHeight) then
1344   begin
1345     if (mWidth+mFrameWidth < ctl.mX+ctl.mWidth) then mWidth := ctl.mX+ctl.mWidth+mFrameWidth;
1346     if (mHeight+mFrameHeight < ctl.mY+ctl.mHeight) then mHeight := ctl.mY+ctl.mHeight+mFrameHeight;
1347   end;
1348   //if (mFocused = nil) and ctl.mEnabled and ctl.mCanFocus and (ctl.mWidth > 0) and (ctl.mHeight > 0) then mFocused := ctl;
1349 end;
1350
1351
1352 // ////////////////////////////////////////////////////////////////////////// //
1353 procedure TUIControl.setScissorGLInternal (x, y, w, h: Integer);
1354 begin
1355   if not scallowed then exit;
1356   x := trunc(x*gh_ui_scale);
1357   y := trunc(y*gh_ui_scale);
1358   w := trunc(w*gh_ui_scale);
1359   h := trunc(h*gh_ui_scale);
1360   scis.combineRect(x, y, w, h);
1361 end;
1362
1363 procedure TUIControl.setScissor (lx, ly, lw, lh: Integer);
1364 var
1365   gx, gy: Integer;
1366   //ox, oy, ow, oh: Integer;
1367 begin
1368   if not scallowed then exit;
1369   //ox := lx; oy := ly; ow := lw; oh := lh;
1370   if not intersectRect(lx, ly, lw, lh, 0, 0, mWidth, mHeight) then
1371   begin
1372     //writeln('oops: <', self.className, '>: old=(', ox, ',', oy, ')-[', ow, ',', oh, ']');
1373     glScissor(0, 0, 0, 0);
1374     exit;
1375   end;
1376   toGlobal(lx, ly, gx, gy);
1377   setScissorGLInternal(gx, gy, lw, lh);
1378 end;
1379
1380 procedure TUIControl.resetScissor (fullArea: Boolean); inline;
1381 begin
1382   if not scallowed then exit;
1383   if (fullArea) then
1384   begin
1385     setScissor(0, 0, mWidth, mHeight);
1386   end
1387   else
1388   begin
1389     setScissor(mFrameWidth, mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2);
1390   end;
1391 end;
1392
1393
1394 // ////////////////////////////////////////////////////////////////////////// //
1395 procedure TUIControl.draw ();
1396 var
1397   f: Integer;
1398   gx, gy: Integer;
1399 begin
1400   if (mWidth < 1) or (mHeight < 1) then exit;
1401   toGlobal(0, 0, gx, gy);
1402   //conwritefln('[%s]: (%d,%d)-(%d,%d)  (%d,%d)', [ClassName, mX, mY, mWidth, mHeight, x, y]);
1403
1404   scis.save(true); // scissoring enabled
1405   try
1406     scallowed := true;
1407     resetScissor(true); // full area
1408     drawControl(gx, gy);
1409     resetScissor(false); // client area
1410     for f := 0 to High(mChildren) do mChildren[f].draw();
1411     resetScissor(true); // full area
1412     drawControlPost(gx, gy);
1413   finally
1414     scis.restore();
1415     scallowed := false;
1416   end;
1417 end;
1418
1419 procedure TUIControl.drawControl (gx, gy: Integer);
1420 begin
1421   //if (mParent = nil) then darkenRect(gx, gy, mWidth, mHeight, 64);
1422 end;
1423
1424 procedure TUIControl.drawControlPost (gx, gy: Integer);
1425 begin
1426   // shadow
1427   if mDrawShadow and (mWidth > 0) and (mHeight > 0) then
1428   begin
1429     setScissorGLInternal(gx+8, gy+8, mWidth, mHeight);
1430     darkenRect(gx+mWidth, gy+8, 8, mHeight, 128);
1431     darkenRect(gx+8, gy+mHeight, mWidth-8, 8, 128);
1432   end;
1433 end;
1434
1435
1436 // ////////////////////////////////////////////////////////////////////////// //
1437 function TUIControl.mouseEvent (var ev: THMouseEvent): Boolean;
1438 var
1439   ctl: TUIControl;
1440 begin
1441   result := false;
1442   if not mEnabled then exit;
1443   if (mParent = nil) then
1444   begin
1445     if (mGrab <> nil) then
1446     begin
1447       result := mGrab.mouseEvent(ev);
1448       if (ev.release) then mGrab := nil;
1449       exit;
1450     end;
1451   end;
1452   if (mWidth < 1) or (mHeight < 1) then exit;
1453   ctl := controlAtXY(ev.x, ev.y);
1454   if (ctl <> nil) and (ctl <> self) then
1455   begin
1456     if (ctl <> topLevel.mFocused) then ctl.setFocused(true);
1457     result := ctl.mouseEvent(ev);
1458   end
1459   else if (ctl = self) and assigned(actionCB) then
1460   begin
1461     actionCB(self, 0);
1462   end;
1463 end;
1464
1465
1466 function TUIControl.keyEvent (var ev: THKeyEvent): Boolean;
1467 var
1468   ctl: TUIControl;
1469 begin
1470   result := false;
1471   if not mEnabled then exit;
1472   if (topLevel.mFocused <> self) and isMyChild(topLevel.mFocused) and topLevel.mFocused.mEnabled then result := topLevel.mFocused.keyEvent(ev);
1473   if (mParent = nil) then
1474   begin
1475     if (ev = 'S-Tab') then
1476     begin
1477       result := true;
1478       ctl := findPrevFocus(mFocused);
1479       if (ctl <> mFocused) then
1480       begin
1481         mGrab := nil;
1482         mFocused := ctl;
1483       end;
1484       exit;
1485     end;
1486     if (ev = 'Tab') then
1487     begin
1488       result := true;
1489       ctl := findNextFocus(mFocused);
1490       if (ctl <> mFocused) then
1491       begin
1492         mGrab := nil;
1493         mFocused := ctl;
1494       end;
1495       exit;
1496     end;
1497     if mEscClose and (ev = 'Escape') then
1498     begin
1499       result := true;
1500       uiRemoveWindow(self);
1501       exit;
1502     end;
1503   end;
1504   if mEatKeys then result := true;
1505 end;
1506
1507
1508 // ////////////////////////////////////////////////////////////////////////// //
1509 constructor TUITopWindow.Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
1510 begin
1511   inherited Create(ax, ay, aw, ah);
1512   mFrameWidth := 8;
1513   mFrameHeight := 8;
1514   mTitle := atitle;
1515 end;
1516
1517 procedure TUITopWindow.AfterConstruction ();
1518 begin
1519   inherited AfterConstruction();
1520   if (mWidth < mFrameWidth*2+3*8) then mWidth := mFrameWidth*2+3*8;
1521   if (mHeight < mFrameHeight*2) then mHeight := mFrameHeight*2;
1522   if (Length(mTitle) > 0) then
1523   begin
1524     if (mWidth < Length(mTitle)*8+mFrameWidth*2+3*8) then mWidth := Length(mTitle)*8+mFrameWidth*2+3*8;
1525   end;
1526   mDragging := false;
1527   mDrawShadow := true;
1528   mWaitingClose := false;
1529   mInClose := false;
1530   closeCB := nil;
1531   mCtl4Style := '';
1532 end;
1533
1534
1535 function TUITopWindow.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
1536 begin
1537   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
1538   begin
1539     mTitle := par.expectIdOrStr(true);
1540     result := true;
1541     exit;
1542   end;
1543   if (strEquCI1251(prname, 'children')) then
1544   begin
1545     parseChildren(par);
1546     result := true;
1547     exit;
1548   end;
1549   if (strEquCI1251(prname, 'position')) then
1550   begin
1551          if (par.eatIdOrStrCI('default')) then mDoCenter := false
1552     else if (par.eatIdOrStrCI('center')) then mDoCenter := true
1553     else par.error('`center` or `default` expected');
1554     result := true;
1555     exit;
1556   end;
1557   if (parseOrientation(prname, par)) then begin result := true; exit; end;
1558   result := inherited parseProperty(prname, par);
1559 end;
1560
1561
1562 procedure TUITopWindow.cacheStyle (root: TUIStyle);
1563 begin
1564   inherited cacheStyle(root);
1565 end;
1566
1567
1568 procedure TUITopWindow.centerInScreen ();
1569 begin
1570   if (mWidth > 0) and (mHeight > 0) then
1571   begin
1572     mX := trunc((gScrWidth/gh_ui_scale-mWidth)/2);
1573     mY := trunc((gScrHeight/gh_ui_scale-mHeight)/2);
1574   end;
1575 end;
1576
1577
1578 procedure TUITopWindow.drawControl (gx, gy: Integer);
1579 begin
1580   fillRect(gx, gy, mWidth, mHeight, mBackColor[getColorIndex]);
1581 end;
1582
1583
1584 procedure TUITopWindow.drawControlPost (gx, gy: Integer);
1585 var
1586   cidx: Integer;
1587   tx: Integer;
1588 begin
1589   cidx := getColorIndex;
1590   if mDragging then
1591   begin
1592     drawRectUI(mX+4, mY+4, mWidth-8, mHeight-8, mFrameColor[cidx]);
1593   end
1594   else
1595   begin
1596     drawRectUI(mX+3, mY+3, mWidth-6, mHeight-6, mFrameColor[cidx]);
1597     drawRectUI(mX+5, mY+5, mWidth-10, mHeight-10, mFrameColor[cidx]);
1598     setScissor(mFrameWidth, 0, 3*8, 8);
1599     fillRect(mX+mFrameWidth, mY, 3*8, 8, mBackColor[cidx]);
1600     drawText8(mX+mFrameWidth, mY, '[ ]', mFrameColor[cidx]);
1601     if mInClose then drawText8(mX+mFrameWidth+7, mY, '#', mFrameIconColor[cidx])
1602     else drawText8(mX+mFrameWidth+7, mY, '*', mFrameIconColor[cidx]);
1603   end;
1604   if (Length(mTitle) > 0) then
1605   begin
1606     setScissor(mFrameWidth+3*8, 0, mWidth-mFrameWidth*2-3*8, 8);
1607     tx := (mX+3*8)+((mWidth-3*8)-Length(mTitle)*8) div 2;
1608     fillRect(tx-3, mY, Length(mTitle)*8+3+2, 8, mBackColor[cidx]);
1609     drawText8(tx, mY, mTitle, mFrameTextColor[cidx]);
1610   end;
1611   inherited drawControlPost(gx, gy);
1612 end;
1613
1614
1615 procedure TUITopWindow.activated ();
1616 begin
1617   if (mFocused = nil) or (mFocused = self) then
1618   begin
1619     mFocused := findFirstFocus();
1620     if (mFocused <> nil) and (mFocused <> self) then mFocused.activated();
1621   end;
1622   inherited;
1623 end;
1624
1625
1626 procedure TUITopWindow.blurred ();
1627 begin
1628   mDragging := false;
1629   mWaitingClose := false;
1630   mInClose := false;
1631   inherited;
1632 end;
1633
1634
1635 function TUITopWindow.keyEvent (var ev: THKeyEvent): Boolean;
1636 begin
1637   result := inherited keyEvent(ev);
1638   if not getFocused then exit;
1639   if (ev = 'M-F3') then
1640   begin
1641     uiRemoveWindow(self);
1642     result := true;
1643     exit;
1644   end;
1645 end;
1646
1647
1648 function TUITopWindow.mouseEvent (var ev: THMouseEvent): Boolean;
1649 var
1650   lx, ly: Integer;
1651 begin
1652   result := false;
1653   if not mEnabled then exit;
1654   if (mWidth < 1) or (mHeight < 1) then exit;
1655
1656   if mDragging then
1657   begin
1658     mX += ev.x-mDragStartX;
1659     mY += ev.y-mDragStartY;
1660     mDragStartX := ev.x;
1661     mDragStartY := ev.y;
1662     if (ev.release) then mDragging := false;
1663     result := true;
1664     exit;
1665   end;
1666
1667   if toLocal(ev.x, ev.y, lx, ly) then
1668   begin
1669     if (ev.press) then
1670     begin
1671       if (ly < 8) then
1672       begin
1673         if (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
1674         begin
1675           //uiRemoveWindow(self);
1676           mWaitingClose := true;
1677           mInClose := true;
1678         end
1679         else
1680         begin
1681           mDragging := true;
1682           mDragStartX := ev.x;
1683           mDragStartY := ev.y;
1684         end;
1685         result := true;
1686         exit;
1687       end;
1688       if (lx < mFrameWidth) or (lx >= mWidth-mFrameWidth) or (ly >= mHeight-mFrameHeight) then
1689       begin
1690         mDragging := true;
1691         mDragStartX := ev.x;
1692         mDragStartY := ev.y;
1693         result := true;
1694         exit;
1695       end;
1696     end;
1697
1698     if (ev.release) then
1699     begin
1700       if mWaitingClose and (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
1701       begin
1702         uiRemoveWindow(self);
1703         result := true;
1704         exit;
1705       end;
1706       mWaitingClose := false;
1707       mInClose := false;
1708     end;
1709
1710     if (ev.motion) then
1711     begin
1712       if mWaitingClose then
1713       begin
1714         mInClose := (lx >= mFrameWidth) and (lx < mFrameWidth+3*8);
1715         result := true;
1716         exit;
1717       end;
1718     end;
1719   end
1720   else
1721   begin
1722     mInClose := false;
1723     if (not ev.motion) then mWaitingClose := false;
1724   end;
1725
1726   result := inherited mouseEvent(ev);
1727 end;
1728
1729
1730 // ////////////////////////////////////////////////////////////////////////// //
1731 constructor TUISimpleText.Create (ax, ay: Integer);
1732 begin
1733   mItems := nil;
1734   inherited Create(ax, ay, 4, 4);
1735 end;
1736
1737
1738 destructor TUISimpleText.Destroy ();
1739 begin
1740   mItems := nil;
1741   inherited;
1742 end;
1743
1744
1745 procedure TUISimpleText.appendItem (const atext: AnsiString; acentered: Boolean=false; ahline: Boolean=false);
1746 var
1747   it: PItem;
1748 begin
1749   if (Length(atext)*8+3*8+2 > mWidth) then mWidth := Length(atext)*8+3*8+2;
1750   SetLength(mItems, Length(mItems)+1);
1751   it := @mItems[High(mItems)];
1752   it.title := atext;
1753   it.centered := acentered;
1754   it.hline := ahline;
1755   if (Length(mItems)*8 > mHeight) then mHeight := Length(mItems)*8;
1756 end;
1757
1758
1759 procedure TUISimpleText.drawControl (gx, gy: Integer);
1760 var
1761   f, tx: Integer;
1762   it: PItem;
1763   r, g, b: Integer;
1764 begin
1765   for f := 0 to High(mItems) do
1766   begin
1767     it := @mItems[f];
1768     tx := gx;
1769     r := 255;
1770     g := 255;
1771     b := 0;
1772     if it.centered then begin b := 255; tx := gx+(mWidth-Length(it.title)*8) div 2; end;
1773     if it.hline then
1774     begin
1775       b := 255;
1776       if (Length(it.title) = 0) then
1777       begin
1778         drawHLine(gx+4, gy+3, mWidth-8, TGxRGBA.Create(r, g, b));
1779       end
1780       else if (tx-3 > gx+4) then
1781       begin
1782         drawHLine(gx+4, gy+3, tx-3-(gx+3), TGxRGBA.Create(r, g, b));
1783         drawHLine(tx+Length(it.title)*8, gy+3, mWidth-4, TGxRGBA.Create(r, g, b));
1784       end;
1785     end;
1786     drawText8(tx, gy, it.title, TGxRGBA.Create(r, g, b));
1787     Inc(gy, 8);
1788   end;
1789 end;
1790
1791
1792 function TUISimpleText.mouseEvent (var ev: THMouseEvent): Boolean;
1793 var
1794   lx, ly: Integer;
1795 begin
1796   result := inherited mouseEvent(ev);
1797   if not result and toLocal(ev.x, ev.y, lx, ly) then
1798   begin
1799     result := true;
1800   end;
1801 end;
1802
1803
1804 function TUISimpleText.keyEvent (var ev: THKeyEvent): Boolean;
1805 begin
1806   result := inherited keyEvent(ev);
1807 end;
1808
1809
1810 // ////////////////////////////////////////////////////////////////////////// //
1811 constructor TUICBListBox.Create (ax, ay: Integer);
1812 begin
1813   mItems := nil;
1814   mCurIndex := -1;
1815   inherited Create(ax, ay, 4, 4);
1816 end;
1817
1818
1819 destructor TUICBListBox.Destroy ();
1820 begin
1821   mItems := nil;
1822   inherited;
1823 end;
1824
1825
1826 procedure TUICBListBox.appendItem (const atext: AnsiString; bv: PBoolean; aaction: TActionCB=nil);
1827 var
1828   it: PItem;
1829 begin
1830   if (Length(atext)*8+3*8+2 > mWidth) then mWidth := Length(atext)*8+3*8+2;
1831   SetLength(mItems, Length(mItems)+1);
1832   it := @mItems[High(mItems)];
1833   it.title := atext;
1834   it.varp := bv;
1835   it.actionCB := aaction;
1836   if (Length(mItems)*8 > mHeight) then mHeight := Length(mItems)*8;
1837   if (mCurIndex < 0) then mCurIndex := 0;
1838 end;
1839
1840
1841 procedure TUICBListBox.drawControl (gx, gy: Integer);
1842 var
1843   f, tx: Integer;
1844   it: PItem;
1845 begin
1846   for f := 0 to High(mItems) do
1847   begin
1848     it := @mItems[f];
1849     if (mCurIndex = f) then fillRect(gx, gy, mWidth, 8, TGxRGBA.Create(0, 128, 0));
1850     if (it.varp <> nil) then
1851     begin
1852       if it.varp^ then drawText8(gx, gy, '[x]', TGxRGBA.Create(255, 255, 255)) else drawText8(gx, gy, '[ ]', TGxRGBA.Create(255, 255, 255));
1853       drawText8(gx+3*8+2, gy, it.title, TGxRGBA.Create(255, 255, 0));
1854     end
1855     else if (Length(it.title) > 0) then
1856     begin
1857       tx := gx+(mWidth-Length(it.title)*8) div 2;
1858       if (tx-3 > gx+4) then
1859       begin
1860         drawHLine(gx+4, gy+3, tx-3-(gx+3), TGxRGBA.Create(255, 255, 255));
1861         drawHLine(tx+Length(it.title)*8, gy+3, mWidth-4, TGxRGBA.Create(255, 255, 255));
1862       end;
1863       drawText8(tx, gy, it.title, TGxRGBA.Create(255, 255, 255));
1864     end
1865     else
1866     begin
1867       drawHLine(gx+4, gy+3, mWidth-8, TGxRGBA.Create(255, 255, 255));
1868     end;
1869     Inc(gy, 8);
1870   end;
1871 end;
1872
1873
1874 function TUICBListBox.mouseEvent (var ev: THMouseEvent): Boolean;
1875 var
1876   lx, ly: Integer;
1877   it: PItem;
1878 begin
1879   result := inherited mouseEvent(ev);
1880   if not result and toLocal(ev.x, ev.y, lx, ly) then
1881   begin
1882     result := true;
1883     if (ev = 'lmb') then
1884     begin
1885       ly := ly div 8;
1886       if (ly >= 0) and (ly < Length(mItems)) then
1887       begin
1888         it := @mItems[ly];
1889         if (it.varp <> nil) then
1890         begin
1891           mCurIndex := ly;
1892           it.varp^ := not it.varp^;
1893           if assigned(it.actionCB) then it.actionCB(self, Integer(it.varp^));
1894           if assigned(actionCB) then actionCB(self, ly);
1895         end;
1896       end;
1897     end;
1898   end;
1899 end;
1900
1901
1902 function TUICBListBox.keyEvent (var ev: THKeyEvent): Boolean;
1903 var
1904   it: PItem;
1905 begin
1906   result := inherited keyEvent(ev);
1907   if not getFocused then exit;
1908   //result := true;
1909   if (ev = 'Home') or (ev = 'PageUp') then
1910   begin
1911     result := true;
1912     mCurIndex := 0;
1913   end;
1914   if (ev = 'End') or (ev = 'PageDown') then
1915   begin
1916     result := true;
1917     mCurIndex := High(mItems);
1918   end;
1919   if (ev = 'Up') then
1920   begin
1921     result := true;
1922     if (Length(mItems) > 0) then
1923     begin
1924       if (mCurIndex < 0) then mCurIndex := Length(mItems);
1925       while (mCurIndex > 0) do
1926       begin
1927         Dec(mCurIndex);
1928         if (mItems[mCurIndex].varp <> nil) then break;
1929       end;
1930     end
1931     else
1932     begin
1933       mCurIndex := -1;
1934     end;
1935   end;
1936   if (ev = 'Down') then
1937   begin
1938     result := true;
1939     if (Length(mItems) > 0) then
1940     begin
1941       if (mCurIndex < 0) then mCurIndex := -1;
1942       while (mCurIndex < High(mItems)) do
1943       begin
1944         Inc(mCurIndex);
1945         if (mItems[mCurIndex].varp <> nil) then break;
1946       end;
1947     end
1948     else
1949     begin
1950       mCurIndex := -1;
1951     end;
1952   end;
1953   if (ev = 'Space') or (ev = 'Enter') then
1954   begin
1955     result := true;
1956     if (mCurIndex >= 0) and (mCurIndex < Length(mItems)) and (mItems[mCurIndex].varp <> nil) then
1957     begin
1958       it := @mItems[mCurIndex];
1959       it.varp^ := not it.varp^;
1960       if assigned(it.actionCB) then it.actionCB(self, Integer(it.varp^));
1961       if assigned(actionCB) then actionCB(self, mCurIndex);
1962     end;
1963   end;
1964 end;
1965
1966
1967 // ////////////////////////////////////////////////////////////////////////// //
1968 constructor TUIBox.Create (ahoriz: Boolean);
1969 begin
1970   inherited Create();
1971   mHoriz := ahoriz;
1972 end;
1973
1974
1975 procedure TUIBox.AfterConstruction ();
1976 begin
1977   inherited AfterConstruction();
1978   mCanFocus := false;
1979   mCtl4Style := 'box';
1980 end;
1981
1982
1983 function TUIBox.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
1984 begin
1985   if (parseOrientation(prname, par)) then begin result := true; exit; end;
1986   if (strEquCI1251(prname, 'frame')) then
1987   begin
1988     mHasFrame := parseBool(par);
1989     if (mHasFrame) then begin mFrameWidth := 8; mFrameHeight := 8; end else begin mFrameWidth := 0; mFrameHeight := 0; end;
1990     result := true;
1991     exit;
1992   end;
1993   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
1994   begin
1995     mCaption := par.expectIdOrStr(true);
1996     mDefSize := TLaySize.Create(Length(mCaption)*8+3, 8);
1997     result := true;
1998     exit;
1999   end;
2000   if (strEquCI1251(prname, 'children')) then
2001   begin
2002     parseChildren(par);
2003     result := true;
2004     exit;
2005   end;
2006   result := inherited parseProperty(prname, par);
2007 end;
2008
2009
2010 procedure TUIBox.drawControl (gx, gy: Integer);
2011 var
2012   cidx: Integer;
2013   tx: Integer;
2014 begin
2015   cidx := getColorIndex;
2016   fillRect(gx, gy, mWidth, mHeight, mBackColor[cidx]);
2017   if mHasFrame then
2018   begin
2019     // draw frame
2020     drawRectUI(gx+3, gy+3, mWidth-6, mHeight-6, mFrameColor[cidx]);
2021   end;
2022   // draw caption
2023   if (Length(mCaption) > 0) then
2024   begin
2025     setScissor(mFrameWidth+1, 0, mWidth-mFrameWidth-2, 8);
2026     tx := gx+((mWidth-Length(mCaption)*8) div 2);
2027     if mHasFrame then fillRect(tx-2, gy, Length(mCaption)*8+3, 8, mBackColor[cidx]);
2028     drawText8(tx, gy, mCaption, mFrameTextColor[cidx]);
2029   end;
2030 end;
2031
2032
2033 function TUIBox.mouseEvent (var ev: THMouseEvent): Boolean;
2034 var
2035   lx, ly: Integer;
2036 begin
2037   result := inherited mouseEvent(ev);
2038   if not result and toLocal(ev.x, ev.y, lx, ly) then
2039   begin
2040     result := true;
2041   end;
2042 end;
2043
2044
2045 //TODO: navigation with arrow keys, according to box orientation
2046 function TUIBox.keyEvent (var ev: THKeyEvent): Boolean;
2047 begin
2048   result := inherited keyEvent(ev);
2049 end;
2050
2051
2052 // ////////////////////////////////////////////////////////////////////////// //
2053 procedure TUIHBox.AfterConstruction ();
2054 begin
2055   inherited AfterConstruction();
2056   mHoriz := true;
2057 end;
2058
2059
2060 // ////////////////////////////////////////////////////////////////////////// //
2061 procedure TUIVBox.AfterConstruction ();
2062 begin
2063   inherited AfterConstruction();
2064   mHoriz := false;
2065 end;
2066
2067
2068 // ////////////////////////////////////////////////////////////////////////// //
2069 procedure TUISpan.AfterConstruction ();
2070 begin
2071   inherited AfterConstruction();
2072   mExpand := true;
2073   mCanFocus := false;
2074   mCtl4Style := 'span';
2075 end;
2076
2077
2078 function TUISpan.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2079 begin
2080   if (parseOrientation(prname, par)) then begin result := true; exit; end;
2081   result := inherited parseProperty(prname, par);
2082 end;
2083
2084
2085 procedure TUISpan.drawControl (gx, gy: Integer);
2086 begin
2087 end;
2088
2089
2090 // ////////////////////////////////////////////////////////////////////// //
2091 procedure TUILine.AfterConstruction ();
2092 begin
2093   inherited AfterConstruction();
2094   mExpand := true;
2095   mCanFocus := false;
2096   mCtl4Style := 'line';
2097 end;
2098
2099
2100 function TUILine.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2101 begin
2102   if (parseOrientation(prname, par)) then begin result := true; exit; end;
2103   result := inherited parseProperty(prname, par);
2104 end;
2105
2106
2107 procedure TUILine.drawControl (gx, gy: Integer);
2108 var
2109   cidx: Integer;
2110 begin
2111   cidx := getColorIndex;
2112   if mHoriz then
2113   begin
2114     drawHLine(gx, gy+(mHeight div 2), mWidth, mTextColor[cidx]);
2115   end
2116   else
2117   begin
2118     drawVLine(gx+(mWidth div 2), gy, mHeight, mTextColor[cidx]);
2119   end;
2120 end;
2121
2122
2123 // ////////////////////////////////////////////////////////////////////////// //
2124 procedure TUIHLine.AfterConstruction ();
2125 begin
2126   inherited AfterConstruction();
2127   mHoriz := true;
2128   mDefSize.h := 1;
2129 end;
2130
2131
2132 // ////////////////////////////////////////////////////////////////////////// //
2133 procedure TUIVLine.AfterConstruction ();
2134 begin
2135   inherited AfterConstruction();
2136   mHoriz := false;
2137   mDefSize.w := 1;
2138 end;
2139
2140
2141 // ////////////////////////////////////////////////////////////////////////// //
2142 constructor TUITextLabel.Create (const atext: AnsiString);
2143 begin
2144   inherited Create();
2145   mText := atext;
2146   mDefSize := TLaySize.Create(Length(atext)*8, 8);
2147 end;
2148
2149
2150 procedure TUITextLabel.AfterConstruction ();
2151 begin
2152   inherited AfterConstruction();
2153   mHAlign := -1;
2154   mVAlign := 0;
2155   mCanFocus := false;
2156   if (mDefSize.h <= 0) then mDefSize.h := 8;
2157   mCtl4Style := 'label';
2158 end;
2159
2160
2161 function TUITextLabel.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2162 begin
2163   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
2164   begin
2165     mText := par.expectIdOrStr(true);
2166     mDefSize := TLaySize.Create(Length(mText)*8, 8);
2167     result := true;
2168     exit;
2169   end;
2170   if (strEquCI1251(prname, 'textalign')) then
2171   begin
2172     parseTextAlign(par, mHAlign, mVAlign);
2173     result := true;
2174     exit;
2175   end;
2176   result := inherited parseProperty(prname, par);
2177 end;
2178
2179
2180 procedure TUITextLabel.drawControl (gx, gy: Integer);
2181 var
2182   xpos, ypos: Integer;
2183   cidx: Integer;
2184 begin
2185   cidx := getColorIndex;
2186   fillRect(gx, gy, mWidth, mHeight, mBackColor[cidx]);
2187   if (Length(mText) > 0) then
2188   begin
2189          if (mHAlign < 0) then xpos := 0
2190     else if (mHAlign > 0) then xpos := mWidth-Length(mText)*8
2191     else xpos := (mWidth-Length(mText)*8) div 2;
2192
2193          if (mVAlign < 0) then ypos := 0
2194     else if (mVAlign > 0) then ypos := mHeight-8
2195     else ypos := (mHeight-8) div 2;
2196
2197     drawText8(gx+xpos, gy+ypos, mText, mTextColor[cidx]);
2198   end;
2199 end;
2200
2201
2202 function TUITextLabel.mouseEvent (var ev: THMouseEvent): Boolean;
2203 var
2204   lx, ly: Integer;
2205 begin
2206   result := inherited mouseEvent(ev);
2207   if not result and toLocal(ev.x, ev.y, lx, ly) then
2208   begin
2209     result := true;
2210   end;
2211 end;
2212
2213
2214 function TUITextLabel.keyEvent (var ev: THKeyEvent): Boolean;
2215 begin
2216   result := inherited keyEvent(ev);
2217 end;
2218
2219
2220 initialization
2221   registerCtlClass(TUIHBox, 'hbox');
2222   registerCtlClass(TUIVBox, 'vbox');
2223   registerCtlClass(TUISpan, 'span');
2224   registerCtlClass(TUIHLine, 'hline');
2225   registerCtlClass(TUIVLine, 'vline');
2226   registerCtlClass(TUITextLabel, 'label');
2227 end.