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