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