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')) then begin mDefSize := parseSize(par); exit; end;
 892   if (strEquCI1251(prname, 'maxsize')) then begin mMaxSize := parseSize(par); exit; end;
 893   if (strEquCI1251(prname, 'wrap')) then begin mCanWrap := parseBool(par); exit; end;
 894   if (strEquCI1251(prname, 'linestart')) then begin mLineStart := parseBool(par); exit; end;
 895   if (strEquCI1251(prname, 'expand')) then begin mExpand := parseBool(par); exit; end;
 896   // align
 897   if (strEquCI1251(prname, 'align')) then begin mAlign := parseAnyAlign(par); exit; end;
 898   if (strEquCI1251(prname, 'hgroup')) then begin mHGroup := par.expectStrOrId(true); exit; end; // allow empty strings
 899   if (strEquCI1251(prname, 'vgroup')) then begin mVGroup := par.expectStrOrId(true); exit; end; // allow empty strings
 900   // other
 901   if (strEquCI1251(prname, 'canfocus')) then begin mCanFocus := parseBool(par); exit; end;
 902   if (strEquCI1251(prname, 'enabled')) then begin mEnabled := parseBool(par); exit; end;
 903   if (strEquCI1251(prname, 'disabled')) then begin mEnabled := not parseBool(par); exit; end;
 904   if (strEquCI1251(prname, 'escclose')) then begin mEscClose := not parseBool(par); exit; end;
 905   if (strEquCI1251(prname, 'eatkeys')) then begin mEatKeys := not parseBool(par); exit; end;
 906   result := false;
 907 end;
 908
 909
 910 // ////////////////////////////////////////////////////////////////////////// //
 911 procedure THControl.activated ();
 912 begin
 913 end;
 914
 915
 916 procedure THControl.blurred ();
 917 begin
 918   mGrab := nil;
 919 end;
 920
 921
 922 function THControl.topLevel (): THControl; inline;
 923 begin
 924   result := self;
 925   while (result.mParent <> nil) do result := result.mParent;
 926 end;
 927
 928
 929 function THControl.getEnabled (): Boolean;
 930 var
 931   ctl: THControl;
 932 begin
 933   result := false;
 934   if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
 935   ctl := mParent;
 936   while (ctl <> nil) do
 937   begin
 938     if (not ctl.mEnabled) or (ctl.mWidth < 1) or (ctl.mHeight < 1) then exit;
 939     ctl := ctl.mParent;
 940   end;
 941   result := true;
 942 end;
 943
 944
 945 procedure THControl.setEnabled (v: Boolean); inline;
 946 begin
 947   if (mEnabled = v) then exit;
 948   mEnabled := v;
 949   if not v and focused then setFocused(false);
 950 end;
 951
 952
 953 function THControl.getFocused (): Boolean; inline;
 954 begin
 955   if (mParent = nil) then result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = self) else result := (topLevel.mFocused = self);
 956 end;
 957
 958
 959 procedure THControl.setFocused (v: Boolean); inline;
 960 var
 961   tl: THControl;
 962 begin
 963   tl := topLevel;
 964   if not v then
 965   begin
 966     if (tl.mFocused = self) then
 967     begin
 968       tl.blurred();
 969       tl.mFocused := tl.findNextFocus(self);
 970       if (tl.mFocused = self) then tl.mFocused := nil;
 971     end;
 972     exit;
 973   end;
 974   if (not mEnabled) or (not mCanFocus) then exit;
 975   if (tl.mFocused <> self) then
 976   begin
 977     tl.mFocused.blurred();
 978     tl.mFocused := self;
 979     if (tl.mGrab <> self) then tl.mGrab := nil;
 980     activated();
 981   end;
 982 end;
 983
 984
 985 function THControl.isMyChild (ctl: THControl): Boolean;
 986 begin
 987   result := true;
 988   while (ctl <> nil) do
 989   begin
 990     if (ctl.mParent = self) then exit;
 991     ctl := ctl.mParent;
 992   end;
 993   result := false;
 994 end;
 995
 996
 997 // returns `true` if global coords are inside this control
 998 function THControl.toLocal (var x, y: Integer): Boolean;
 999 var
1000   ctl: THControl;
1001 begin
1002   ctl := self;
1003   while (ctl <> nil) do
1004   begin
1005     Dec(x, ctl.mX);
1006     Dec(y, ctl.mY);
1007     ctl := ctl.mParent;
1008   end;
1009   result := (x >= 0) and (y >= 0) and (x < mWidth) and (y < mHeight);
1010 end;
1011
1012 function THControl.toLocal (gx, gy: Integer; out x, y: Integer): Boolean; inline;
1013 begin
1014   x := gx;
1015   y := gy;
1016   result := toLocal(x, y);
1017 end;
1018
1019 procedure THControl.toGlobal (var x, y: Integer);
1020 var
1021   ctl: THControl;
1022 begin
1023   ctl := self;
1024   while (ctl <> nil) do
1025   begin
1026     Inc(x, ctl.mX);
1027     Inc(y, ctl.mY);
1028     ctl := ctl.mParent;
1029   end;
1030 end;
1031
1032 procedure THControl.toGlobal (lx, ly: Integer; out x, y: Integer); inline;
1033 begin
1034   x := lx;
1035   y := ly;
1036   toGlobal(x, y);
1037 end;
1038
1039
1040 // x and y are global coords
1041 function THControl.controlAtXY (x, y: Integer): THControl;
1042 var
1043   lx, ly: Integer;
1044   f: Integer;
1045 begin
1046   result := nil;
1047   if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
1048   if not toLocal(x, y, lx, ly) then exit;
1049   for f := High(mChildren) downto 0 do
1050   begin
1051     result := mChildren[f].controlAtXY(x, y);
1052     if (result <> nil) then exit;
1053   end;
1054   result := self;
1055 end;
1056
1057
1058 function THControl.prevSibling (): THControl;
1059 var
1060   f: Integer;
1061 begin
1062   if (mParent <> nil) then
1063   begin
1064     for f := 1 to High(mParent.mChildren) do
1065     begin
1066       if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f-1]; exit; end;
1067     end;
1068   end;
1069   result := nil;
1070 end;
1071
1072 function THControl.nextSibling (): THControl;
1073 var
1074   f: Integer;
1075 begin
1076   if (mParent <> nil) then
1077   begin
1078     for f := 0 to High(mParent.mChildren)-1 do
1079     begin
1080       if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f+1]; exit; end;
1081     end;
1082   end;
1083   result := nil;
1084 end;
1085
1086 function THControl.firstChild (): THControl; inline;
1087 begin
1088   if (Length(mChildren) <> 0) then result := mChildren[0] else result := nil;
1089 end;
1090
1091 function THControl.lastChild (): THControl; inline;
1092 begin
1093   if (Length(mChildren) <> 0) then result := mChildren[High(mChildren)] else result := nil;
1094 end;
1095
1096
1097 function THControl.findFirstFocus (): THControl;
1098 var
1099   f: Integer;
1100 begin
1101   result := nil;
1102   if enabled then
1103   begin
1104     for f := 0 to High(mChildren) do
1105     begin
1106       result := mChildren[f].findFirstFocus();
1107       if (result <> nil) then exit;
1108     end;
1109     if mCanFocus then result := self;
1110   end;
1111 end;
1112
1113
1114 function THControl.findLastFocus (): THControl;
1115 var
1116   f: Integer;
1117 begin
1118   result := nil;
1119   if enabled then
1120   begin
1121     for f := High(mChildren) downto 0 do
1122     begin
1123       result := mChildren[f].findLastFocus();
1124       if (result <> nil) then exit;
1125     end;
1126     if mCanFocus then result := self;
1127   end;
1128 end;
1129
1130
1131 function THControl.findNextFocus (cur: THControl): THControl;
1132 begin
1133   result := nil;
1134   if enabled then
1135   begin
1136     if not isMyChild(cur) then cur := nil;
1137     if (cur = nil) then begin result := findFirstFocus(); exit; end;
1138     result := cur.findFirstFocus();
1139     if (result <> nil) and (result <> cur) then exit;
1140     while true do
1141     begin
1142       cur := cur.nextSibling;
1143       if (cur = nil) then break;
1144       result := cur.findFirstFocus();
1145       if (result <> nil) then exit;
1146     end;
1147     result := findFirstFocus();
1148   end;
1149 end;
1150
1151
1152 function THControl.findPrevFocus (cur: THControl): THControl;
1153 begin
1154   result := nil;
1155   if enabled then
1156   begin
1157     if not isMyChild(cur) then cur := nil;
1158     if (cur = nil) then begin result := findLastFocus(); exit; end;
1159     //FIXME!
1160     result := cur.findLastFocus();
1161     if (result <> nil) and (result <> cur) then exit;
1162     while true do
1163     begin
1164       cur := cur.prevSibling;
1165       if (cur = nil) then break;
1166       result := cur.findLastFocus();
1167       if (result <> nil) then exit;
1168     end;
1169     result := findLastFocus();
1170   end;
1171 end;
1172
1173
1174 procedure THControl.appendChild (ctl: THControl);
1175 begin
1176   if (ctl = nil) then exit;
1177   if (ctl.mParent <> nil) then exit;
1178   SetLength(mChildren, Length(mChildren)+1);
1179   mChildren[High(mChildren)] := ctl;
1180   ctl.mParent := self;
1181   Inc(ctl.mX, mFrameWidth);
1182   Inc(ctl.mY, mFrameHeight);
1183   if (ctl.mWidth > 0) and (ctl.mHeight > 0) and
1184      (ctl.mX+ctl.mWidth > mFrameWidth) and (ctl.mY+ctl.mHeight > mFrameHeight) then
1185   begin
1186     if (mWidth+mFrameWidth < ctl.mX+ctl.mWidth) then mWidth := ctl.mX+ctl.mWidth+mFrameWidth;
1187     if (mHeight+mFrameHeight < ctl.mY+ctl.mHeight) then mHeight := ctl.mY+ctl.mHeight+mFrameHeight;
1188   end;
1189   if (mFocused = nil) and ctl.mEnabled and ctl.mCanFocus and (ctl.mWidth > 0) and (ctl.mHeight > 0) then mFocused := ctl;
1190 end;
1191
1192
1193 // ////////////////////////////////////////////////////////////////////////// //
1194 procedure THControl.setScissorGLInternal (x, y, w, h: Integer);
1195 begin
1196   if not scallowed then exit;
1197   x := trunc(x*gh_ui_scale);
1198   y := trunc(y*gh_ui_scale);
1199   w := trunc(w*gh_ui_scale);
1200   h := trunc(h*gh_ui_scale);
1201   scis.combineRect(x, y, w, h);
1202 end;
1203
1204 procedure THControl.setScissor (lx, ly, lw, lh: Integer);
1205 var
1206   gx, gy: Integer;
1207   //ox, oy, ow, oh: Integer;
1208 begin
1209   if not scallowed then exit;
1210   //ox := lx; oy := ly; ow := lw; oh := lh;
1211   if not intersectRect(lx, ly, lw, lh, 0, 0, mWidth, mHeight) then
1212   begin
1213     //writeln('oops: <', self.className, '>: old=(', ox, ',', oy, ')-[', ow, ',', oh, ']');
1214     glScissor(0, 0, 0, 0);
1215     exit;
1216   end;
1217   toGlobal(lx, ly, gx, gy);
1218   setScissorGLInternal(gx, gy, lw, lh);
1219 end;
1220
1221 procedure THControl.resetScissor (fullArea: Boolean); inline;
1222 begin
1223   if not scallowed then exit;
1224   if (fullArea) then
1225   begin
1226     setScissor(0, 0, mWidth, mHeight);
1227   end
1228   else
1229   begin
1230     setScissor(mFrameWidth, mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2);
1231   end;
1232 end;
1233
1234
1235 // ////////////////////////////////////////////////////////////////////////// //
1236 procedure THControl.draw ();
1237 var
1238   f: Integer;
1239   gx, gy: Integer;
1240 begin
1241   if (mWidth < 1) or (mHeight < 1) then exit;
1242   toGlobal(0, 0, gx, gy);
1243   //conwritefln('[%s]: (%d,%d)-(%d,%d)  (%d,%d)', [ClassName, mX, mY, mWidth, mHeight, x, y]);
1244
1245   scis.save(true); // scissoring enabled
1246   try
1247     scallowed := true;
1248     resetScissor(true); // full area
1249     drawControl(gx, gy);
1250     resetScissor(false); // client area
1251     for f := 0 to High(mChildren) do mChildren[f].draw();
1252     resetScissor(true); // full area
1253     drawControlPost(gx, gy);
1254   finally
1255     scis.restore();
1256     scallowed := false;
1257   end;
1258 end;
1259
1260 procedure THControl.drawControl (gx, gy: Integer);
1261 begin
1262   if (mParent = nil) then darkenRect(gx, gy, mWidth, mHeight, 64);
1263 end;
1264
1265 procedure THControl.drawControlPost (gx, gy: Integer);
1266 begin
1267   // shadow
1268   if mDrawShadow and (mWidth > 0) and (mHeight > 0) then
1269   begin
1270     setScissorGLInternal(gx+8, gy+8, mWidth, mHeight);
1271     darkenRect(gx+mWidth, gy+8, 8, mHeight, 128);
1272     darkenRect(gx+8, gy+mHeight, mWidth-8, 8, 128);
1273   end;
1274 end;
1275
1276
1277 // ////////////////////////////////////////////////////////////////////////// //
1278 function THControl.mouseEvent (var ev: THMouseEvent): Boolean;
1279 var
1280   ctl: THControl;
1281 begin
1282   result := false;
1283   if not mEnabled then exit;
1284   if (mParent = nil) then
1285   begin
1286     if (mGrab <> nil) then
1287     begin
1288       result := mGrab.mouseEvent(ev);
1289       if (ev.release) then mGrab := nil;
1290       exit;
1291     end;
1292   end;
1293   if (mWidth < 1) or (mHeight < 1) then exit;
1294   ctl := controlAtXY(ev.x, ev.y);
1295   if (ctl <> nil) and (ctl <> self) then
1296   begin
1297     if (ctl <> topLevel.mFocused) then ctl.setFocused(true);
1298     result := ctl.mouseEvent(ev);
1299   end
1300   else if (ctl = self) and assigned(actionCB) then
1301   begin
1302     actionCB(self, 0);
1303   end;
1304 end;
1305
1306
1307 function THControl.keyEvent (var ev: THKeyEvent): Boolean;
1308 var
1309   ctl: THControl;
1310 begin
1311   result := false;
1312   if not mEnabled then exit;
1313   if (topLevel.mFocused <> self) and isMyChild(topLevel.mFocused) and topLevel.mFocused.mEnabled then result := topLevel.mFocused.keyEvent(ev);
1314   if (mParent = nil) then
1315   begin
1316     if (ev = 'S-Tab') then
1317     begin
1318       result := true;
1319       ctl := findPrevFocus(mFocused);
1320       if (ctl <> mFocused) then
1321       begin
1322         mGrab := nil;
1323         mFocused := ctl;
1324       end;
1325       exit;
1326     end;
1327     if (ev = 'Tab') then
1328     begin
1329       result := true;
1330       ctl := findNextFocus(mFocused);
1331       if (ctl <> mFocused) then
1332       begin
1333         mGrab := nil;
1334         mFocused := ctl;
1335       end;
1336       exit;
1337     end;
1338     if mEscClose and (ev = 'Escape') then
1339     begin
1340       result := true;
1341       uiRemoveWindow(self);
1342       exit;
1343     end;
1344   end;
1345   if mEatKeys then result := true;
1346 end;
1347
1348
1349 // ////////////////////////////////////////////////////////////////////////// //
1350 constructor THTopWindow.Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
1351 begin
1352   inherited Create(ax, ay, aw, ah);
1353   mFrameWidth := 8;
1354   mFrameHeight := 8;
1355   mTitle := atitle;
1356   if (mWidth < mFrameWidth*2+3*8) then mWidth := mFrameWidth*2+3*8;
1357   if (mHeight < mFrameHeight*2) then mHeight := mFrameHeight*2;
1358   if (Length(mTitle) > 0) then
1359   begin
1360     if (mWidth < Length(mTitle)*8+mFrameWidth*2+3*8) then mWidth := Length(mTitle)*8+mFrameWidth*2+3*8;
1361   end;
1362   mDragging := false;
1363   mDrawShadow := true;
1364   mWaitingClose := false;
1365   mInClose := false;
1366   closeCB := nil;
1367 end;
1368
1369
1370 function THTopWindow.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
1371 begin
1372   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
1373   begin
1374     mTitle := par.expectStrOrId(true);
1375     result := true;
1376     exit;
1377   end;
1378   if (strEquCI1251(prname, 'children')) then
1379   begin
1380     parseChildren(par);
1381     result := true;
1382     exit;
1383   end;
1384   if (strEquCI1251(prname, 'orientation')) or (strEquCI1251(prname, 'orient')) then
1385   begin
1386          if (par.eatIdOrStr('horizontal', false)) or (par.eatIdOrStr('horiz', false)) then mHoriz := true
1387     else if (par.eatIdOrStr('vertical', false)) or (par.eatIdOrStr('vert', false)) then mHoriz := false
1388     else par.error('`horizontal` or `vertical` expected');
1389     result := true;
1390     exit;
1391   end;
1392   result := inherited parseProperty(prname, par);
1393 end;
1394
1395
1396 procedure THTopWindow.centerInScreen ();
1397 begin
1398   if (mWidth > 0) and (mHeight > 0) then
1399   begin
1400     mX := trunc((gScrWidth/gh_ui_scale-mWidth)/2);
1401     mY := trunc((gScrHeight/gh_ui_scale-mHeight)/2);
1402   end;
1403 end;
1404
1405
1406 procedure THTopWindow.drawControl (gx, gy: Integer);
1407 begin
1408   fillRect(gx, gy, mWidth, mHeight, 0, 0, 128);
1409 end;
1410
1411
1412 procedure THTopWindow.drawControlPost (gx, gy: Integer);
1413 const r = 255;
1414 const g = 255;
1415 const b = 255;
1416 var
1417   tx: Integer;
1418 begin
1419   if mDragging then
1420   begin
1421     drawRectUI(mX+4, mY+4, mWidth-8, mHeight-8, r, g, b);
1422   end
1423   else
1424   begin
1425     drawRectUI(mX+3, mY+3, mWidth-6, mHeight-6, r, g, b);
1426     drawRectUI(mX+5, mY+5, mWidth-10, mHeight-10, r, g, b);
1427     setScissor(mFrameWidth, 0, 3*8, 8);
1428     fillRect(mX+mFrameWidth, mY, 3*8, 8, 0, 0, 128);
1429     drawText8(mX+mFrameWidth, mY, '[ ]', r, g, b);
1430     if mInClose then drawText8(mX+mFrameWidth+7, mY, '#', 0, 255, 0)
1431     else drawText8(mX+mFrameWidth+7, mY, '*', 0, 255, 0);
1432   end;
1433   if (Length(mTitle) > 0) then
1434   begin
1435     setScissor(mFrameWidth+3*8, 0, mWidth-mFrameWidth*2-3*8, 8);
1436     tx := (mX+3*8)+((mWidth-3*8)-Length(mTitle)*8) div 2;
1437     fillRect(tx-3, mY, Length(mTitle)*8+3+2, 8, 0, 0, 128);
1438     drawText8(tx, mY, mTitle, r, g, b);
1439   end;
1440   inherited drawControlPost(gx, gy);
1441 end;
1442
1443
1444 procedure THTopWindow.blurred ();
1445 begin
1446   mDragging := false;
1447   mWaitingClose := false;
1448   mInClose := false;
1449   inherited;
1450 end;
1451
1452
1453 function THTopWindow.keyEvent (var ev: THKeyEvent): Boolean;
1454 begin
1455   result := inherited keyEvent(ev);
1456   if not getFocused then exit;
1457   if (ev = 'M-F3') then
1458   begin
1459     uiRemoveWindow(self);
1460     result := true;
1461     exit;
1462   end;
1463 end;
1464
1465
1466 function THTopWindow.mouseEvent (var ev: THMouseEvent): Boolean;
1467 var
1468   lx, ly: Integer;
1469 begin
1470   result := false;
1471   if not mEnabled then exit;
1472   if (mWidth < 1) or (mHeight < 1) then exit;
1473
1474   if mDragging then
1475   begin
1476     mX += ev.x-mDragStartX;
1477     mY += ev.y-mDragStartY;
1478     mDragStartX := ev.x;
1479     mDragStartY := ev.y;
1480     if (ev.release) then mDragging := false;
1481     result := true;
1482     exit;
1483   end;
1484
1485   if toLocal(ev.x, ev.y, lx, ly) then
1486   begin
1487     if (ev.press) then
1488     begin
1489       if (ly < 8) then
1490       begin
1491         if (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
1492         begin
1493           //uiRemoveWindow(self);
1494           mWaitingClose := true;
1495           mInClose := true;
1496         end
1497         else
1498         begin
1499           mDragging := true;
1500           mDragStartX := ev.x;
1501           mDragStartY := ev.y;
1502         end;
1503         result := true;
1504         exit;
1505       end;
1506       if (lx < mFrameWidth) or (lx >= mWidth-mFrameWidth) or (ly >= mHeight-mFrameHeight) then
1507       begin
1508         mDragging := true;
1509         mDragStartX := ev.x;
1510         mDragStartY := ev.y;
1511         result := true;
1512         exit;
1513       end;
1514     end;
1515
1516     if (ev.release) then
1517     begin
1518       if mWaitingClose and (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
1519       begin
1520         uiRemoveWindow(self);
1521         result := true;
1522         exit;
1523       end;
1524       mWaitingClose := false;
1525       mInClose := false;
1526     end;
1527
1528     if (ev.motion) then
1529     begin
1530       if mWaitingClose then
1531       begin
1532         mInClose := (lx >= mFrameWidth) and (lx < mFrameWidth+3*8);
1533         result := true;
1534         exit;
1535       end;
1536     end;
1537   end
1538   else
1539   begin
1540     mInClose := false;
1541     if (not ev.motion) then mWaitingClose := false;
1542   end;
1543
1544   result := inherited mouseEvent(ev);
1545 end;
1546
1547
1548 // ////////////////////////////////////////////////////////////////////////// //
1549 constructor THCtlSimpleText.Create (ax, ay: Integer);
1550 begin
1551   mItems := nil;
1552   inherited Create(ax, ay, 4, 4);
1553 end;
1554
1555
1556 destructor THCtlSimpleText.Destroy ();
1557 begin
1558   mItems := nil;
1559   inherited;
1560 end;
1561
1562
1563 procedure THCtlSimpleText.appendItem (const atext: AnsiString; acentered: Boolean=false; ahline: Boolean=false);
1564 var
1565   it: PItem;
1566 begin
1567   if (Length(atext)*8+3*8+2 > mWidth) then mWidth := Length(atext)*8+3*8+2;
1568   SetLength(mItems, Length(mItems)+1);
1569   it := @mItems[High(mItems)];
1570   it.title := atext;
1571   it.centered := acentered;
1572   it.hline := ahline;
1573   if (Length(mItems)*8 > mHeight) then mHeight := Length(mItems)*8;
1574 end;
1575
1576
1577 procedure THCtlSimpleText.drawControl (gx, gy: Integer);
1578 var
1579   f, tx: Integer;
1580   it: PItem;
1581   r, g, b: Integer;
1582 begin
1583   for f := 0 to High(mItems) do
1584   begin
1585     it := @mItems[f];
1586     tx := gx;
1587     r := 255;
1588     g := 255;
1589     b := 0;
1590     if it.centered then begin b := 255; tx := gx+(mWidth-Length(it.title)*8) div 2; end;
1591     if it.hline then
1592     begin
1593       b := 255;
1594       if (Length(it.title) = 0) then
1595       begin
1596         drawHLine(gx+4, gy+3, mWidth-8, r, g, b);
1597       end
1598       else if (tx-3 > gx+4) then
1599       begin
1600         drawHLine(gx+4, gy+3, tx-3-(gx+3), r, g, b);
1601         drawHLine(tx+Length(it.title)*8, gy+3, mWidth-4, r, g, b);
1602       end;
1603     end;
1604     drawText8(tx, gy, it.title, r, g, b);
1605     Inc(gy, 8);
1606   end;
1607 end;
1608
1609
1610 function THCtlSimpleText.mouseEvent (var ev: THMouseEvent): Boolean;
1611 var
1612   lx, ly: Integer;
1613 begin
1614   result := inherited mouseEvent(ev);
1615   if not result and toLocal(ev.x, ev.y, lx, ly) then
1616   begin
1617     result := true;
1618   end;
1619 end;
1620
1621
1622 function THCtlSimpleText.keyEvent (var ev: THKeyEvent): Boolean;
1623 begin
1624   result := inherited keyEvent(ev);
1625 end;
1626
1627
1628 // ////////////////////////////////////////////////////////////////////////// //
1629 constructor THCtlCBListBox.Create (ax, ay: Integer);
1630 begin
1631   mItems := nil;
1632   mCurIndex := -1;
1633   inherited Create(ax, ay, 4, 4);
1634 end;
1635
1636
1637 destructor THCtlCBListBox.Destroy ();
1638 begin
1639   mItems := nil;
1640   inherited;
1641 end;
1642
1643
1644 procedure THCtlCBListBox.appendItem (const atext: AnsiString; bv: PBoolean; aaction: TActionCB=nil);
1645 var
1646   it: PItem;
1647 begin
1648   if (Length(atext)*8+3*8+2 > mWidth) then mWidth := Length(atext)*8+3*8+2;
1649   SetLength(mItems, Length(mItems)+1);
1650   it := @mItems[High(mItems)];
1651   it.title := atext;
1652   it.varp := bv;
1653   it.actionCB := aaction;
1654   if (Length(mItems)*8 > mHeight) then mHeight := Length(mItems)*8;
1655   if (mCurIndex < 0) then mCurIndex := 0;
1656 end;
1657
1658
1659 procedure THCtlCBListBox.drawControl (gx, gy: Integer);
1660 var
1661   f, tx: Integer;
1662   it: PItem;
1663 begin
1664   for f := 0 to High(mItems) do
1665   begin
1666     it := @mItems[f];
1667     if (mCurIndex = f) then fillRect(gx, gy, mWidth, 8, 0, 128, 0);
1668     if (it.varp <> nil) then
1669     begin
1670       if it.varp^ then drawText8(gx, gy, '[x]', 255, 255, 255) else drawText8(gx, gy, '[ ]', 255, 255, 255);
1671       drawText8(gx+3*8+2, gy, it.title, 255, 255, 0);
1672     end
1673     else if (Length(it.title) > 0) then
1674     begin
1675       tx := gx+(mWidth-Length(it.title)*8) div 2;
1676       if (tx-3 > gx+4) then
1677       begin
1678         drawHLine(gx+4, gy+3, tx-3-(gx+3), 255, 255, 255);
1679         drawHLine(tx+Length(it.title)*8, gy+3, mWidth-4, 255, 255, 255);
1680       end;
1681       drawText8(tx, gy, it.title, 255, 255, 255);
1682     end
1683     else
1684     begin
1685       drawHLine(gx+4, gy+3, mWidth-8, 255, 255, 255);
1686     end;
1687     Inc(gy, 8);
1688   end;
1689 end;
1690
1691
1692 function THCtlCBListBox.mouseEvent (var ev: THMouseEvent): Boolean;
1693 var
1694   lx, ly: Integer;
1695   it: PItem;
1696 begin
1697   result := inherited mouseEvent(ev);
1698   if not result and toLocal(ev.x, ev.y, lx, ly) then
1699   begin
1700     result := true;
1701     if (ev = 'lmb') then
1702     begin
1703       ly := ly div 8;
1704       if (ly >= 0) and (ly < Length(mItems)) then
1705       begin
1706         it := @mItems[ly];
1707         if (it.varp <> nil) then
1708         begin
1709           mCurIndex := ly;
1710           it.varp^ := not it.varp^;
1711           if assigned(it.actionCB) then it.actionCB(self, Integer(it.varp^));
1712           if assigned(actionCB) then actionCB(self, ly);
1713         end;
1714       end;
1715     end;
1716   end;
1717 end;
1718
1719
1720 function THCtlCBListBox.keyEvent (var ev: THKeyEvent): Boolean;
1721 var
1722   it: PItem;
1723 begin
1724   result := inherited keyEvent(ev);
1725   if not getFocused then exit;
1726   //result := true;
1727   if (ev = 'Home') or (ev = 'PageUp') then
1728   begin
1729     result := true;
1730     mCurIndex := 0;
1731   end;
1732   if (ev = 'End') or (ev = 'PageDown') then
1733   begin
1734     result := true;
1735     mCurIndex := High(mItems);
1736   end;
1737   if (ev = 'Up') then
1738   begin
1739     result := true;
1740     if (Length(mItems) > 0) then
1741     begin
1742       if (mCurIndex < 0) then mCurIndex := Length(mItems);
1743       while (mCurIndex > 0) do
1744       begin
1745         Dec(mCurIndex);
1746         if (mItems[mCurIndex].varp <> nil) then break;
1747       end;
1748     end
1749     else
1750     begin
1751       mCurIndex := -1;
1752     end;
1753   end;
1754   if (ev = 'Down') then
1755   begin
1756     result := true;
1757     if (Length(mItems) > 0) then
1758     begin
1759       if (mCurIndex < 0) then mCurIndex := -1;
1760       while (mCurIndex < High(mItems)) do
1761       begin
1762         Inc(mCurIndex);
1763         if (mItems[mCurIndex].varp <> nil) then break;
1764       end;
1765     end
1766     else
1767     begin
1768       mCurIndex := -1;
1769     end;
1770   end;
1771   if (ev = 'Space') or (ev = 'Enter') then
1772   begin
1773     result := true;
1774     if (mCurIndex >= 0) and (mCurIndex < Length(mItems)) and (mItems[mCurIndex].varp <> nil) then
1775     begin
1776       it := @mItems[mCurIndex];
1777       it.varp^ := not it.varp^;
1778       if assigned(it.actionCB) then it.actionCB(self, Integer(it.varp^));
1779       if assigned(actionCB) then actionCB(self, mCurIndex);
1780     end;
1781   end;
1782 end;
1783
1784
1785 // ////////////////////////////////////////////////////////////////////////// //
1786 constructor THCtlBox.Create (ahoriz: Boolean);
1787 begin
1788   inherited Create();
1789   mHoriz := ahoriz;
1790 end;
1791
1792
1793 function THCtlBox.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
1794 begin
1795   if (strEquCI1251(prname, 'orientation')) or (strEquCI1251(prname, 'orient')) then
1796   begin
1797          if (par.eatIdOrStr('horizontal', false)) or (par.eatIdOrStr('horiz', false)) then mHoriz := true
1798     else if (par.eatIdOrStr('vertical', false)) or (par.eatIdOrStr('vert', false)) then mHoriz := false
1799     else par.error('`horizontal` or `vertical` expected');
1800     result := true;
1801     exit;
1802   end;
1803   if (strEquCI1251(prname, 'frame')) then
1804   begin
1805     mHasFrame := parseBool(par);
1806     if (mHasFrame) then begin mFrameWidth := 8; mFrameHeight := 8; end else begin mFrameWidth := 0; mFrameHeight := 0; end;
1807     result := true;
1808     exit;
1809   end;
1810   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
1811   begin
1812     mCaption := par.expectStrOrId(true);
1813     mDefSize := TLaySize.Create(Length(mCaption)*8+2, 8);
1814     result := true;
1815     exit;
1816   end;
1817   if (strEquCI1251(prname, 'children')) then
1818   begin
1819     parseChildren(par);
1820     result := true;
1821     exit;
1822   end;
1823   result := inherited parseProperty(prname, par);
1824 end;
1825
1826
1827 procedure THCtlBox.drawControl (gx, gy: Integer);
1828 var
1829   r, g, b: Integer;
1830   tx: Integer;
1831 begin
1832   if focused then begin r := 255; g := 255; b := 255; end else begin r := 255; g := 255; b := 0; end;
1833   if mHasFrame then
1834   begin
1835     // draw frame
1836     drawRectUI(gx+3, gy+3, mWidth-6, mHeight-6, r, g, b);
1837   end;
1838   // draw caption
1839   if (Length(mCaption) > 0) then
1840   begin
1841     setScissor(mFrameWidth+1, 0, mWidth-mFrameWidth-2, 8);
1842     tx := gx+((mWidth-Length(mCaption)*8) div 2)-1;
1843     if mHasFrame then fillRect(tx, gy, Length(mCaption)*8+2, 8, 0, 0, 128);
1844     drawText8(tx+1, gy, mCaption, r, g, b);
1845   end;
1846 end;
1847
1848
1849 function THCtlBox.mouseEvent (var ev: THMouseEvent): Boolean;
1850 var
1851   lx, ly: Integer;
1852 begin
1853   result := inherited mouseEvent(ev);
1854   if not result and toLocal(ev.x, ev.y, lx, ly) then
1855   begin
1856     result := true;
1857   end;
1858 end;
1859
1860
1861 //TODO: navigation with arrow keys, according to box orientation
1862 function THCtlBox.keyEvent (var ev: THKeyEvent): Boolean;
1863 begin
1864   result := inherited keyEvent(ev);
1865 end;
1866
1867
1868 // ////////////////////////////////////////////////////////////////////////// //
1869 procedure THCtlHBox.AfterConstruction ();
1870 begin
1871   inherited AfterConstruction();
1872   mHoriz := true;
1873 end;
1874
1875
1876 // ////////////////////////////////////////////////////////////////////////// //
1877 procedure THCtlVBox.AfterConstruction ();
1878 begin
1879   inherited AfterConstruction();
1880   mHoriz := false;
1881 end;
1882
1883
1884 // ////////////////////////////////////////////////////////////////////////// //
1885 constructor THCtlSpan.Create ();
1886 begin
1887   inherited Create();
1888   mExpand := true;
1889 end;
1890
1891 function THCtlSpan.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
1892 begin
1893   if (strEquCI1251(prname, 'orientation')) or (strEquCI1251(prname, 'orient')) then
1894   begin
1895          if (par.eatIdOrStr('horizontal', false)) or (par.eatIdOrStr('horiz', false)) then mHoriz := true
1896     else if (par.eatIdOrStr('vertical', false)) or (par.eatIdOrStr('vert', false)) then mHoriz := false
1897     else par.error('`horizontal` or `vertical` expected');
1898     result := true;
1899     exit;
1900   end;
1901   result := inherited parseProperty(prname, par);
1902 end;
1903
1904 procedure THCtlSpan.drawControl (gx, gy: Integer);
1905 begin
1906 end;
1907
1908
1909 procedure THCtlSpan.AfterConstruction ();
1910 begin
1911   inherited AfterConstruction();
1912   //mDefSize := TLaySize.Create(0, 8);
1913   mExpand := true;
1914 end;
1915
1916
1917 // ////////////////////////////////////////////////////////////////////////// //
1918 constructor THCtlTextLabel.Create (const atext: AnsiString);
1919 begin
1920   inherited Create();
1921   mHAlign := -1;
1922   mVAlign := 0;
1923   mText := atext;
1924   mDefSize := TLaySize.Create(Length(atext)*8, 8);
1925 end;
1926
1927
1928 function THCtlTextLabel.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
1929 begin
1930   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
1931   begin
1932     mText := par.expectStrOrId(true);
1933     mDefSize := TLaySize.Create(Length(mText)*8, 8);
1934     result := true;
1935     exit;
1936   end;
1937   if (strEquCI1251(prname, 'textalign')) then
1938   begin
1939     parseTextAlign(par, mHAlign, mVAlign);
1940     result := true;
1941     exit;
1942   end;
1943   result := inherited parseProperty(prname, par);
1944 end;
1945
1946
1947 procedure THCtlTextLabel.drawControl (gx, gy: Integer);
1948 var
1949   xpos, ypos: Integer;
1950 begin
1951   // debug
1952   fillRect(gx, gy, mWidth, mHeight, 96, 96, 0);
1953   drawRectUI(gx, gy, mWidth, mHeight, 96, 96, 96);
1954
1955   if (Length(mText) > 0) then
1956   begin
1957          if (mHAlign < 0) then xpos := 0
1958     else if (mHAlign > 0) then xpos := mWidth-Length(mText)*8
1959     else xpos := (mWidth-Length(mText)*8) div 2;
1960
1961          if (mVAlign < 0) then ypos := 0
1962     else if (mVAlign > 0) then ypos := mHeight-8
1963     else ypos := (mHeight-8) div 2;
1964
1965     drawText8(gx+xpos, gy+ypos, mText, 255, 255, 255);
1966   end;
1967 end;
1968
1969
1970 function THCtlTextLabel.mouseEvent (var ev: THMouseEvent): Boolean;
1971 var
1972   lx, ly: Integer;
1973 begin
1974   result := inherited mouseEvent(ev);
1975   if not result and toLocal(ev.x, ev.y, lx, ly) then
1976   begin
1977     result := true;
1978   end;
1979 end;
1980
1981
1982 function THCtlTextLabel.keyEvent (var ev: THKeyEvent): Boolean;
1983 begin
1984   result := inherited keyEvent(ev);
1985 end;
1986
1987
1988 initialization
1989   registerCtlClass(THCtlBox, 'box');
1990   registerCtlClass(THCtlHBox, 'hbox');
1991   registerCtlClass(THCtlVBox, 'vbox');
1992   registerCtlClass(THCtlSpan, 'span');
1993   registerCtlClass(THCtlTextLabel, 'label');
1994 end.