src/gx/gh_ui.pas

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