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