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   THCtlTextLabel = class(THControl)
 323   private
 324     mText: AnsiString;
 325     mHAlign: Integer; // -1: left; 0: center; 1: right; default: left
 326     mVAlign: Integer; // -1: top; 0: center; 1: bottom; default: center
 327
 328   public
 329     constructor Create (const atext: AnsiString);
 330     //destructor Destroy (); override;
 331
 332     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
 333
 334     procedure drawControl (gx, gy: Integer); override;
 335
 336     function mouseEvent (var ev: THMouseEvent): Boolean; override;
 337     function keyEvent (var ev: THKeyEvent): Boolean; override;
 338   end;
 339
 340
 341 // ////////////////////////////////////////////////////////////////////////// //
 342 function uiMouseEvent (ev: THMouseEvent): Boolean;
 343 function uiKeyEvent (ev: THKeyEvent): Boolean;
 344 procedure uiDraw ();
 345
 346
 347 // ////////////////////////////////////////////////////////////////////////// //
 348 procedure uiAddWindow (ctl: THControl);
 349 procedure uiRemoveWindow (ctl: THControl); // will free window if `mFreeOnClose` is `true`
 350 function uiVisibleWindow (ctl: THControl): Boolean;
 351
 352
 353 // ////////////////////////////////////////////////////////////////////////// //
 354 // do layouting
 355 procedure uiLayoutCtl (ctl: THControl);
 356
 357
 358 // ////////////////////////////////////////////////////////////////////////// //
 359 var
 360   gh_ui_scale: Single = 1.0;
 361
 362
 363 implementation
 364
 365 uses
 366   gh_flexlay,
 367   utils;
 368
 369
 370 // ////////////////////////////////////////////////////////////////////////// //
 371 var
 372   knownCtlClasses: array of record
 373     klass: THControlClass;
 374     name: AnsiString;
 375   end = nil;
 376
 377
 378 procedure registerCtlClass (aklass: THControlClass; const aname: AnsiString);
 379 begin
 380   assert(aklass <> nil);
 381   assert(Length(aname) > 0);
 382   SetLength(knownCtlClasses, Length(knownCtlClasses)+1);
 383   knownCtlClasses[High(knownCtlClasses)].klass := aklass;
 384   knownCtlClasses[High(knownCtlClasses)].name := aname;
 385 end;
 386
 387
 388 function findCtlClass (const aname: AnsiString): THControlClass;
 389 var
 390   f: Integer;
 391 begin
 392   for f := 0 to High(knownCtlClasses) do
 393   begin
 394     if (strEquCI1251(aname, knownCtlClasses[f].name)) then
 395     begin
 396       result := knownCtlClasses[f].klass;
 397       exit;
 398     end;
 399   end;
 400   result := nil;
 401 end;
 402
 403
 404 // ////////////////////////////////////////////////////////////////////////// //
 405 type
 406   TFlexLayouter = specialize TFlexLayouterBase<THControl>;
 407
 408 procedure uiLayoutCtl (ctl: THControl);
 409 var
 410   lay: TFlexLayouter;
 411 begin
 412   if (ctl = nil) then exit;
 413   lay := TFlexLayouter.Create();
 414   try
 415     lay.setup(ctl);
 416     //lay.layout();
 417
 418     //writeln('============================'); lay.dumpFlat();
 419
 420     //writeln('=== initial ==='); lay.dump();
 421
 422     //lay.calcMaxSizeInternal(0);
 423     {
 424     lay.firstPass();
 425     writeln('=== after first pass ===');
 426     lay.dump();
 427
 428     lay.secondPass();
 429     writeln('=== after second pass ===');
 430     lay.dump();
 431     }
 432
 433     lay.layout();
 434     //writeln('=== final ==='); 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       if uiTopList[f].toLocal(ev.x, ev.y, lx, ly) then
 463       begin
 464         result := true;
 465         if uiTopList[f].mEnabled and (f <> High(uiTopList)) then
 466         begin
 467           uiTopList[High(uiTopList)].blurred();
 468           ctmp := uiTopList[f];
 469           ctmp.mGrab := nil;
 470           for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
 471           uiTopList[High(uiTopList)] := ctmp;
 472           ctmp.activated();
 473           result := ctmp.mouseEvent(ev);
 474         end;
 475         exit;
 476       end;
 477     end;
 478   end;
 479 end;
 480
 481
 482 function uiKeyEvent (ev: THKeyEvent): Boolean;
 483 begin
 484   ev.x := trunc(ev.x/gh_ui_scale);
 485   ev.y := trunc(ev.y/gh_ui_scale);
 486   if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].keyEvent(ev);
 487   if (ev.release) then begin result := true; exit; end;
 488 end;
 489
 490
 491 procedure uiDraw ();
 492 var
 493   f: Integer;
 494   ctl: THControl;
 495 begin
 496   glMatrixMode(GL_MODELVIEW);
 497   glPushMatrix();
 498   try
 499     glLoadIdentity();
 500     glScalef(gh_ui_scale, gh_ui_scale, 1);
 501     for f := 0 to High(uiTopList) do
 502     begin
 503       ctl := uiTopList[f];
 504       ctl.draw();
 505       if (f <> High(uiTopList)) then darkenRect(ctl.x0, ctl.y0, ctl.width, ctl.height, 128);
 506     end;
 507   finally
 508     glMatrixMode(GL_MODELVIEW);
 509     glPopMatrix();
 510   end;
 511 end;
 512
 513
 514 procedure uiAddWindow (ctl: THControl);
 515 var
 516   f, c: Integer;
 517 begin
 518   if (ctl = nil) then exit;
 519   ctl := ctl.topLevel;
 520   if not (ctl is THTopWindow) then exit; // alas
 521   for f := 0 to High(uiTopList) do
 522   begin
 523     if (uiTopList[f] = ctl) then
 524     begin
 525       if (f <> High(uiTopList)) then
 526       begin
 527         uiTopList[High(uiTopList)].blurred();
 528         for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
 529         uiTopList[High(uiTopList)] := ctl;
 530         ctl.activated();
 531       end;
 532       exit;
 533     end;
 534   end;
 535   if (Length(uiTopList) > 0) then uiTopList[High(uiTopList)].blurred();
 536   SetLength(uiTopList, Length(uiTopList)+1);
 537   uiTopList[High(uiTopList)] := ctl;
 538   ctl.activated();
 539 end;
 540
 541
 542 procedure uiRemoveWindow (ctl: THControl);
 543 var
 544   f, c: Integer;
 545 begin
 546   if (ctl = nil) then exit;
 547   ctl := ctl.topLevel;
 548   if not (ctl is THTopWindow) then exit; // alas
 549   for f := 0 to High(uiTopList) do
 550   begin
 551     if (uiTopList[f] = ctl) then
 552     begin
 553       ctl.blurred();
 554       for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
 555       SetLength(uiTopList, Length(uiTopList)-1);
 556       if (ctl is THTopWindow) then
 557       begin
 558         try
 559           if assigned(THTopWindow(ctl).closeCB) then THTopWindow(ctl).closeCB(ctl, 0);
 560         finally
 561           if (THTopWindow(ctl).mFreeOnClose) then FreeAndNil(ctl);
 562         end;
 563       end;
 564       exit;
 565     end;
 566   end;
 567 end;
 568
 569
 570 function uiVisibleWindow (ctl: THControl): Boolean;
 571 var
 572   f: Integer;
 573 begin
 574   result := false;
 575   if (ctl = nil) then exit;
 576   ctl := ctl.topLevel;
 577   if not (ctl is THTopWindow) then exit; // alas
 578   for f := 0 to High(uiTopList) do
 579   begin
 580     if (uiTopList[f] = ctl) then begin result := true; exit; end;
 581   end;
 582 end;
 583
 584
 585 // ////////////////////////////////////////////////////////////////////////// //
 586 constructor THControl.Create ();
 587 begin
 588   mParent := nil;
 589   mX := 0;
 590   mY := 0;
 591   mWidth := 64;
 592   mHeight := 8;
 593   mFrameWidth := 0;
 594   mFrameHeight := 0;
 595   mEnabled := true;
 596   mCanFocus := true;
 597   mChildren := nil;
 598   mFocused := nil;
 599   mGrab := nil;
 600   mEscClose := false;
 601   mEatKeys := false;
 602   scallowed := false;
 603   mDrawShadow := false;
 604   actionCB := nil;
 605   // layouter interface
 606   //mDefSize := TLaySize.Create(64, 8); // default size
 607   mDefSize := TLaySize.Create(0, 0); // default size
 608   mMaxSize := TLaySize.Create(-1, -1); // maximum size
 609   mFlex := 0;
 610   mHoriz := true;
 611   mCanWrap := false;
 612   mLineStart := false;
 613   mHGroup := '';
 614   mVGroup := '';
 615   mAlign := -1; // left/top
 616   mExpand := false;
 617 end;
 618
 619
 620 constructor THControl.Create (ax, ay, aw, ah: Integer);
 621 begin
 622   Create();
 623   mX := ax;
 624   mY := ay;
 625   mWidth := aw;
 626   mHeight := ah;
 627 end;
 628
 629
 630 destructor THControl.Destroy ();
 631 var
 632   f, c: Integer;
 633 begin
 634   if (mParent <> nil) then
 635   begin
 636     setFocused(false);
 637     for f := 0 to High(mParent.mChildren) do
 638     begin
 639       if (mParent.mChildren[f] = self) then
 640       begin
 641         for c := f+1 to High(mParent.mChildren) do mParent.mChildren[c-1] := mParent.mChildren[c];
 642         SetLength(mParent.mChildren, Length(mParent.mChildren)-1);
 643       end;
 644     end;
 645   end;
 646   for f := 0 to High(mChildren) do
 647   begin
 648     mChildren[f].mParent := nil;
 649     mChildren[f].Free();
 650   end;
 651   mChildren := nil;
 652 end;
 653
 654
 655 // ////////////////////////////////////////////////////////////////////////// //
 656 function THControl.getDefSize (): TLaySize; inline; begin result := mLayDefSize; end;
 657 function THControl.getMaxSize (): TLaySize; inline; begin result := mLayMaxSize; end;
 658 function THControl.getFlex (): Integer; inline; begin result := mFlex; end;
 659 function THControl.isHorizBox (): Boolean; inline; begin result := mHoriz; end;
 660 procedure THControl.setHorizBox (v: Boolean); inline; begin mHoriz := v; end;
 661 function THControl.canWrap (): Boolean; inline; begin result := mCanWrap; end;
 662 procedure THControl.setCanWrap (v: Boolean); inline; begin mCanWrap := v; end;
 663 function THControl.isLineStart (): Boolean; inline; begin result := mLineStart; end;
 664 procedure THControl.setLineStart (v: Boolean); inline; begin mLineStart := v; end;
 665 function THControl.getAlign (): Integer; inline; begin result := mAlign; end;
 666 procedure THControl.setAlign (v: Integer); inline; begin mAlign := v; end;
 667 function THControl.getExpand (): Boolean; inline; begin result := mExpand; end;
 668 procedure THControl.setExpand (v: Boolean); inline; begin mExpand := v; end;
 669 function THControl.getHGroup (): AnsiString; inline; begin result := mHGroup; end;
 670 procedure THControl.setHGroup (const v: AnsiString); inline; begin mHGroup := v; end;
 671 function THControl.getVGroup (): AnsiString; inline; begin result := mVGroup; end;
 672 procedure THControl.setVGroup (const v: AnsiString); inline; begin mVGroup := v; end;
 673
 674 function THControl.getMargins (): TLayMargins; inline;
 675 begin
 676   result := TLayMargins.Create(mFrameHeight, mFrameWidth, mFrameHeight, mFrameWidth);
 677 end;
 678
 679 procedure THControl.setActualSizePos (constref apos: TLayPos; constref asize: TLaySize); inline; begin
 680   //writeln(self.className, '; pos=', apos.toString, '; size=', asize.toString);
 681   if (mParent <> nil) then
 682   begin
 683     mX := apos.x;
 684     mY := apos.y;
 685   end;
 686   mWidth := asize.w;
 687   mHeight := asize.h;
 688 end;
 689
 690 procedure THControl.layPrepare ();
 691 begin
 692   mLayDefSize := mDefSize;
 693   mLayMaxSize := mMaxSize;
 694   if (mLayMaxSize.w >= 0) then mLayMaxSize.w += mFrameWidth*2;
 695   if (mLayMaxSize.h >= 0) then mLayMaxSize.h += mFrameHeight*2;
 696 end;
 697
 698
 699 // ////////////////////////////////////////////////////////////////////////// //
 700 function THControl.parsePos (par: TTextParser): TLayPos;
 701 var
 702   ech: AnsiChar = ')';
 703 begin
 704   if (par.eatDelim('[')) then ech := ']' else par.expectDelim('(');
 705   result.x := par.expectInt();
 706   par.eatDelim(','); // optional comma
 707   result.y := par.expectInt();
 708   par.eatDelim(','); // optional comma
 709   par.expectDelim(ech);
 710 end;
 711
 712 function THControl.parseSize (par: TTextParser): TLaySize;
 713 var
 714   ech: AnsiChar = ')';
 715 begin
 716   if (par.eatDelim('[')) then ech := ']' else par.expectDelim('(');
 717   result.h := par.expectInt();
 718   par.eatDelim(','); // optional comma
 719   result.w := par.expectInt();
 720   par.eatDelim(','); // optional comma
 721   par.expectDelim(ech);
 722 end;
 723
 724 function THControl.parseBool (par: TTextParser): Boolean;
 725 begin
 726   result :=
 727     par.eatIdOrStr('true', false) or
 728     par.eatIdOrStr('yes', false) or
 729     par.eatIdOrStr('tan', false);
 730   if not result then
 731   begin
 732     if (not par.eatIdOrStr('false', false)) and (not par.eatIdOrStr('no', false)) and (not par.eatIdOrStr('ona', false)) then
 733     begin
 734       par.error('boolean value expected');
 735     end;
 736   end;
 737 end;
 738
 739 function THControl.parseAnyAlign (par: TTextParser): Integer;
 740 begin
 741        if (par.eatIdOrStr('left', false)) or (par.eatIdOrStr('top', false)) then result := -1
 742   else if (par.eatIdOrStr('right', false)) or (par.eatIdOrStr('bottom', false)) then result := 1
 743   else if (par.eatIdOrStr('center', false)) then result := 0
 744   else par.error('invalid align value');
 745 end;
 746
 747 function THControl.parseHAlign (par: TTextParser): Integer;
 748 begin
 749        if (par.eatIdOrStr('left', false)) then result := -1
 750   else if (par.eatIdOrStr('right', false)) then result := 1
 751   else if (par.eatIdOrStr('center', false)) then result := 0
 752   else par.error('invalid horizontal align value');
 753 end;
 754
 755 function THControl.parseVAlign (par: TTextParser): Integer;
 756 begin
 757        if (par.eatIdOrStr('top', false)) then result := -1
 758   else if (par.eatIdOrStr('bottom', false)) then result := 1
 759   else if (par.eatIdOrStr('center', false)) then result := 0
 760   else par.error('invalid vertical align value');
 761 end;
 762
 763 procedure THControl.parseTextAlign (par: TTextParser; var h, v: Integer);
 764 var
 765   wasH: Boolean = false;
 766   wasV: Boolean = false;
 767 begin
 768   while true do
 769   begin
 770     if (par.eatIdOrStr('left', false)) then
 771     begin
 772       if wasH then par.error('too many align directives');
 773       wasH := true;
 774       h := -1;
 775       continue;
 776     end;
 777     if (par.eatIdOrStr('right', false)) then
 778     begin
 779       if wasH then par.error('too many align directives');
 780       wasH := true;
 781       h := 1;
 782       continue;
 783     end;
 784     if (par.eatIdOrStr('hcenter', false)) then
 785     begin
 786       if wasH then par.error('too many align directives');
 787       wasH := true;
 788       h := 0;
 789       continue;
 790     end;
 791     if (par.eatIdOrStr('top', false)) then
 792     begin
 793       if wasV then par.error('too many align directives');
 794       wasV := true;
 795       v := -1;
 796       continue;
 797     end;
 798     if (par.eatIdOrStr('bottom', false)) then
 799     begin
 800       if wasV then par.error('too many align directives');
 801       wasV := true;
 802       v := 1;
 803       continue;
 804     end;
 805     if (par.eatIdOrStr('vcenter', false)) then
 806     begin
 807       if wasV then par.error('too many align directives');
 808       wasV := true;
 809       v := 0;
 810       continue;
 811     end;
 812     if (par.eatIdOrStr('center', false)) then
 813     begin
 814       if wasV or wasH then par.error('too many align directives');
 815       wasV := true;
 816       wasH := true;
 817       h := 0;
 818       v := 0;
 819       continue;
 820     end;
 821     break;
 822   end;
 823   if not wasV and not wasH then par.error('invalid align value');
 824 end;
 825
 826 // par should be on '{'; final '}' is eaten
 827 procedure THControl.parseProperties (par: TTextParser);
 828 var
 829   pn: AnsiString;
 830 begin
 831   if (not par.eatDelim('{')) then exit;
 832   while (not par.eatDelim('}')) do
 833   begin
 834     if (not par.isIdOrStr) then par.error('property name expected');
 835     pn := par.tokStr;
 836     par.skipToken();
 837     par.eatDelim(':'); // optional
 838     if not parseProperty(pn, par) then par.errorfmt('invalid property name ''%s''', [pn]);
 839     par.eatDelim(','); // optional
 840   end;
 841 end;
 842
 843 // par should be on '{'
 844 procedure THControl.parseChildren (par: TTextParser);
 845 var
 846   cc: THControlClass;
 847   ctl: THControl;
 848 begin
 849   par.expectDelim('{');
 850   while (not par.eatDelim('}')) do
 851   begin
 852     if (not par.isIdOrStr) then par.error('control name expected');
 853     cc := findCtlClass(par.tokStr);
 854     if (cc = nil) then par.errorfmt('unknown control name: ''%s''', [par.tokStr]);
 855     //writeln('children for <', par.tokStr, '>: <', cc.className, '>');
 856     par.skipToken();
 857     par.eatDelim(':'); // optional
 858     ctl := cc.Create();
 859     //writeln('  mHoriz=', ctl.mHoriz);
 860     try
 861       ctl.parseProperties(par);
 862     except
 863       FreeAndNil(ctl);
 864       raise;
 865     end;
 866     //writeln(': ', ctl.mDefSize.toString);
 867     appendChild(ctl);
 868     par.eatDelim(','); // optional
 869   end;
 870 end;
 871
 872
 873 function THControl.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
 874 begin
 875   result := true;
 876   if (strEquCI1251(prname, 'id')) then begin mId := par.expectStrOrId(true); exit; end; // allow empty strings
 877   if (strEquCI1251(prname, 'flex')) then begin flex := par.expectInt(); exit; end;
 878   // sizes
 879   if (strEquCI1251(prname, 'defsize')) then begin mDefSize := parseSize(par); exit; end;
 880   if (strEquCI1251(prname, 'maxsize')) then begin mMaxSize := parseSize(par); exit; end;
 881   if (strEquCI1251(prname, 'wrap')) then begin mCanWrap := parseBool(par); exit; end;
 882   if (strEquCI1251(prname, 'linestart')) then begin mLineStart := parseBool(par); exit; end;
 883   if (strEquCI1251(prname, 'expand')) then begin mExpand := parseBool(par); exit; end;
 884   // align
 885   if (strEquCI1251(prname, 'align')) then begin mAlign := parseAnyAlign(par); exit; end;
 886   if (strEquCI1251(prname, 'hgroup')) then begin mHGroup := par.expectStrOrId(true); exit; end; // allow empty strings
 887   if (strEquCI1251(prname, 'vgroup')) then begin mVGroup := par.expectStrOrId(true); exit; end; // allow empty strings
 888   // other
 889   if (strEquCI1251(prname, 'canfocus')) then begin mCanFocus := parseBool(par); exit; end;
 890   if (strEquCI1251(prname, 'enabled')) then begin mEnabled := parseBool(par); exit; end;
 891   if (strEquCI1251(prname, 'disabled')) then begin mEnabled := not parseBool(par); exit; end;
 892   if (strEquCI1251(prname, 'escclose')) then begin mEscClose := not parseBool(par); exit; end;
 893   if (strEquCI1251(prname, 'eatkeys')) then begin mEatKeys := not parseBool(par); exit; end;
 894   result := false;
 895 end;
 896
 897
 898 // ////////////////////////////////////////////////////////////////////////// //
 899 procedure THControl.activated ();
 900 begin
 901 end;
 902
 903
 904 procedure THControl.blurred ();
 905 begin
 906   mGrab := nil;
 907 end;
 908
 909
 910 function THControl.topLevel (): THControl; inline;
 911 begin
 912   result := self;
 913   while (result.mParent <> nil) do result := result.mParent;
 914 end;
 915
 916
 917 function THControl.getEnabled (): Boolean;
 918 var
 919   ctl: THControl;
 920 begin
 921   result := false;
 922   if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
 923   ctl := mParent;
 924   while (ctl <> nil) do
 925   begin
 926     if (not ctl.mEnabled) or (ctl.mWidth < 1) or (ctl.mHeight < 1) then exit;
 927     ctl := ctl.mParent;
 928   end;
 929   result := true;
 930 end;
 931
 932
 933 procedure THControl.setEnabled (v: Boolean); inline;
 934 begin
 935   if (mEnabled = v) then exit;
 936   mEnabled := v;
 937   if not v and focused then setFocused(false);
 938 end;
 939
 940
 941 function THControl.getFocused (): Boolean; inline;
 942 begin
 943   if (mParent = nil) then result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = self) else result := (topLevel.mFocused = self);
 944 end;
 945
 946
 947 procedure THControl.setFocused (v: Boolean); inline;
 948 var
 949   tl: THControl;
 950 begin
 951   tl := topLevel;
 952   if not v then
 953   begin
 954     if (tl.mFocused = self) then
 955     begin
 956       tl.blurred();
 957       tl.mFocused := tl.findNextFocus(self);
 958       if (tl.mFocused = self) then tl.mFocused := nil;
 959     end;
 960     exit;
 961   end;
 962   if (not mEnabled) or (not mCanFocus) then exit;
 963   if (tl.mFocused <> self) then
 964   begin
 965     tl.mFocused.blurred();
 966     tl.mFocused := self;
 967     if (tl.mGrab <> self) then tl.mGrab := nil;
 968     activated();
 969   end;
 970 end;
 971
 972
 973 function THControl.isMyChild (ctl: THControl): Boolean;
 974 begin
 975   result := true;
 976   while (ctl <> nil) do
 977   begin
 978     if (ctl.mParent = self) then exit;
 979     ctl := ctl.mParent;
 980   end;
 981   result := false;
 982 end;
 983
 984
 985 // returns `true` if global coords are inside this control
 986 function THControl.toLocal (var x, y: Integer): Boolean;
 987 var
 988   ctl: THControl;
 989 begin
 990   ctl := self;
 991   while (ctl <> nil) do
 992   begin
 993     Dec(x, ctl.mX);
 994     Dec(y, ctl.mY);
 995     ctl := ctl.mParent;
 996   end;
 997   result := (x >= 0) and (y >= 0) and (x < mWidth) and (y < mHeight);
 998 end;
 999
1000 function THControl.toLocal (gx, gy: Integer; out x, y: Integer): Boolean; inline;
1001 begin
1002   x := gx;
1003   y := gy;
1004   result := toLocal(x, y);
1005 end;
1006
1007 procedure THControl.toGlobal (var x, y: Integer);
1008 var
1009   ctl: THControl;
1010 begin
1011   ctl := self;
1012   while (ctl <> nil) do
1013   begin
1014     Inc(x, ctl.mX);
1015     Inc(y, ctl.mY);
1016     ctl := ctl.mParent;
1017   end;
1018 end;
1019
1020 procedure THControl.toGlobal (lx, ly: Integer; out x, y: Integer); inline;
1021 begin
1022   x := lx;
1023   y := ly;
1024   toGlobal(x, y);
1025 end;
1026
1027
1028 // x and y are global coords
1029 function THControl.controlAtXY (x, y: Integer): THControl;
1030 var
1031   lx, ly: Integer;
1032   f: Integer;
1033 begin
1034   result := nil;
1035   if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
1036   if not toLocal(x, y, lx, ly) then exit;
1037   for f := High(mChildren) downto 0 do
1038   begin
1039     result := mChildren[f].controlAtXY(x, y);
1040     if (result <> nil) then exit;
1041   end;
1042   result := self;
1043 end;
1044
1045
1046 function THControl.prevSibling (): THControl;
1047 var
1048   f: Integer;
1049 begin
1050   if (mParent <> nil) then
1051   begin
1052     for f := 1 to High(mParent.mChildren) do
1053     begin
1054       if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f-1]; exit; end;
1055     end;
1056   end;
1057   result := nil;
1058 end;
1059
1060 function THControl.nextSibling (): THControl;
1061 var
1062   f: Integer;
1063 begin
1064   if (mParent <> nil) then
1065   begin
1066     for f := 0 to High(mParent.mChildren)-1 do
1067     begin
1068       if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f+1]; exit; end;
1069     end;
1070   end;
1071   result := nil;
1072 end;
1073
1074 function THControl.firstChild (): THControl; inline;
1075 begin
1076   if (Length(mChildren) <> 0) then result := mChildren[0] else result := nil;
1077 end;
1078
1079 function THControl.lastChild (): THControl; inline;
1080 begin
1081   if (Length(mChildren) <> 0) then result := mChildren[High(mChildren)] else result := nil;
1082 end;
1083
1084
1085 function THControl.findFirstFocus (): THControl;
1086 var
1087   f: Integer;
1088 begin
1089   result := nil;
1090   if enabled then
1091   begin
1092     for f := 0 to High(mChildren) do
1093     begin
1094       result := mChildren[f].findFirstFocus();
1095       if (result <> nil) then exit;
1096     end;
1097     if mCanFocus then result := self;
1098   end;
1099 end;
1100
1101
1102 function THControl.findLastFocus (): THControl;
1103 var
1104   f: Integer;
1105 begin
1106   result := nil;
1107   if enabled then
1108   begin
1109     for f := High(mChildren) downto 0 do
1110     begin
1111       result := mChildren[f].findLastFocus();
1112       if (result <> nil) then exit;
1113     end;
1114     if mCanFocus then result := self;
1115   end;
1116 end;
1117
1118
1119 function THControl.findNextFocus (cur: THControl): THControl;
1120 begin
1121   result := nil;
1122   if enabled then
1123   begin
1124     if not isMyChild(cur) then cur := nil;
1125     if (cur = nil) then begin result := findFirstFocus(); exit; end;
1126     result := cur.findFirstFocus();
1127     if (result <> nil) and (result <> cur) then exit;
1128     while true do
1129     begin
1130       cur := cur.nextSibling;
1131       if (cur = nil) then break;
1132       result := cur.findFirstFocus();
1133       if (result <> nil) then exit;
1134     end;
1135     result := findFirstFocus();
1136   end;
1137 end;
1138
1139
1140 function THControl.findPrevFocus (cur: THControl): THControl;
1141 begin
1142   result := nil;
1143   if enabled then
1144   begin
1145     if not isMyChild(cur) then cur := nil;
1146     if (cur = nil) then begin result := findLastFocus(); exit; end;
1147     //FIXME!
1148     result := cur.findLastFocus();
1149     if (result <> nil) and (result <> cur) then exit;
1150     while true do
1151     begin
1152       cur := cur.prevSibling;
1153       if (cur = nil) then break;
1154       result := cur.findLastFocus();
1155       if (result <> nil) then exit;
1156     end;
1157     result := findLastFocus();
1158   end;
1159 end;
1160
1161
1162 procedure THControl.appendChild (ctl: THControl);
1163 begin
1164   if (ctl = nil) then exit;
1165   if (ctl.mParent <> nil) then exit;
1166   SetLength(mChildren, Length(mChildren)+1);
1167   mChildren[High(mChildren)] := ctl;
1168   ctl.mParent := self;
1169   Inc(ctl.mX, mFrameWidth);
1170   Inc(ctl.mY, mFrameHeight);
1171   if (ctl.mWidth > 0) and (ctl.mHeight > 0) and
1172      (ctl.mX+ctl.mWidth > mFrameWidth) and (ctl.mY+ctl.mHeight > mFrameHeight) then
1173   begin
1174     if (mWidth+mFrameWidth < ctl.mX+ctl.mWidth) then mWidth := ctl.mX+ctl.mWidth+mFrameWidth;
1175     if (mHeight+mFrameHeight < ctl.mY+ctl.mHeight) then mHeight := ctl.mY+ctl.mHeight+mFrameHeight;
1176   end;
1177   if (mFocused = nil) and ctl.mEnabled and ctl.mCanFocus and (ctl.mWidth > 0) and (ctl.mHeight > 0) then mFocused := ctl;
1178 end;
1179
1180
1181 // ////////////////////////////////////////////////////////////////////////// //
1182 procedure THControl.setScissorGLInternal (x, y, w, h: Integer);
1183 begin
1184   if not scallowed then exit;
1185   x := trunc(x*gh_ui_scale);
1186   y := trunc(y*gh_ui_scale);
1187   w := trunc(w*gh_ui_scale);
1188   h := trunc(h*gh_ui_scale);
1189   scis.combineRect(x, y, w, h);
1190 end;
1191
1192 procedure THControl.setScissor (lx, ly, lw, lh: Integer);
1193 var
1194   gx, gy: Integer;
1195   //ox, oy, ow, oh: Integer;
1196 begin
1197   if not scallowed then exit;
1198   //ox := lx; oy := ly; ow := lw; oh := lh;
1199   if not intersectRect(lx, ly, lw, lh, 0, 0, mWidth, mHeight) then
1200   begin
1201     //writeln('oops: <', self.className, '>: old=(', ox, ',', oy, ')-[', ow, ',', oh, ']');
1202     glScissor(0, 0, 0, 0);
1203     exit;
1204   end;
1205   toGlobal(lx, ly, gx, gy);
1206   setScissorGLInternal(gx, gy, lw, lh);
1207 end;
1208
1209 procedure THControl.resetScissor (fullArea: Boolean); inline;
1210 begin
1211   if not scallowed then exit;
1212   if (fullArea) then
1213   begin
1214     setScissor(0, 0, mWidth, mHeight);
1215   end
1216   else
1217   begin
1218     setScissor(mFrameWidth, mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2);
1219   end;
1220 end;
1221
1222
1223 // ////////////////////////////////////////////////////////////////////////// //
1224 procedure THControl.draw ();
1225 var
1226   f: Integer;
1227   gx, gy: Integer;
1228 begin
1229   if (mWidth < 1) or (mHeight < 1) then exit;
1230   toGlobal(0, 0, gx, gy);
1231   //conwritefln('[%s]: (%d,%d)-(%d,%d)  (%d,%d)', [ClassName, mX, mY, mWidth, mHeight, x, y]);
1232
1233   scis.save(true); // scissoring enabled
1234   try
1235     scallowed := true;
1236     resetScissor(true); // full area
1237     drawControl(gx, gy);
1238     resetScissor(false); // client area
1239     for f := 0 to High(mChildren) do mChildren[f].draw();
1240     resetScissor(true); // full area
1241     drawControlPost(gx, gy);
1242   finally
1243     scis.restore();
1244     scallowed := false;
1245   end;
1246 end;
1247
1248 procedure THControl.drawControl (gx, gy: Integer);
1249 begin
1250   if (mParent = nil) then darkenRect(gx, gy, mWidth, mHeight, 64);
1251 end;
1252
1253 procedure THControl.drawControlPost (gx, gy: Integer);
1254 begin
1255   // shadow
1256   if mDrawShadow and (mWidth > 0) and (mHeight > 0) then
1257   begin
1258     setScissorGLInternal(gx+8, gy+8, mWidth, mHeight);
1259     darkenRect(gx+mWidth, gy+8, 8, mHeight, 128);
1260     darkenRect(gx+8, gy+mHeight, mWidth-8, 8, 128);
1261   end;
1262 end;
1263
1264
1265 // ////////////////////////////////////////////////////////////////////////// //
1266 function THControl.mouseEvent (var ev: THMouseEvent): Boolean;
1267 var
1268   ctl: THControl;
1269 begin
1270   result := false;
1271   if not mEnabled then exit;
1272   if (mParent = nil) then
1273   begin
1274     if (mGrab <> nil) then
1275     begin
1276       result := mGrab.mouseEvent(ev);
1277       if (ev.release) then mGrab := nil;
1278       exit;
1279     end;
1280   end;
1281   if (mWidth < 1) or (mHeight < 1) then exit;
1282   ctl := controlAtXY(ev.x, ev.y);
1283   if (ctl <> nil) and (ctl <> self) then
1284   begin
1285     if (ctl <> topLevel.mFocused) then ctl.setFocused(true);
1286     result := ctl.mouseEvent(ev);
1287   end
1288   else if (ctl = self) and assigned(actionCB) then
1289   begin
1290     actionCB(self, 0);
1291   end;
1292 end;
1293
1294
1295 function THControl.keyEvent (var ev: THKeyEvent): Boolean;
1296 var
1297   ctl: THControl;
1298 begin
1299   result := false;
1300   if not mEnabled then exit;
1301   if (topLevel.mFocused <> self) and isMyChild(topLevel.mFocused) and topLevel.mFocused.mEnabled then result := topLevel.mFocused.keyEvent(ev);
1302   if (mParent = nil) then
1303   begin
1304     if (ev = 'S-Tab') then
1305     begin
1306       result := true;
1307       ctl := findPrevFocus(mFocused);
1308       if (ctl <> mFocused) then
1309       begin
1310         mGrab := nil;
1311         mFocused := ctl;
1312       end;
1313       exit;
1314     end;
1315     if (ev = 'Tab') then
1316     begin
1317       result := true;
1318       ctl := findNextFocus(mFocused);
1319       if (ctl <> mFocused) then
1320       begin
1321         mGrab := nil;
1322         mFocused := ctl;
1323       end;
1324       exit;
1325     end;
1326     if mEscClose and (ev = 'Escape') then
1327     begin
1328       result := true;
1329       uiRemoveWindow(self);
1330       exit;
1331     end;
1332   end;
1333   if mEatKeys then result := true;
1334 end;
1335
1336
1337 // ////////////////////////////////////////////////////////////////////////// //
1338 constructor THTopWindow.Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
1339 begin
1340   inherited Create(ax, ay, aw, ah);
1341   mFrameWidth := 8;
1342   mFrameHeight := 8;
1343   mTitle := atitle;
1344   if (mWidth < mFrameWidth*2+3*8) then mWidth := mFrameWidth*2+3*8;
1345   if (mHeight < mFrameHeight*2) then mHeight := mFrameHeight*2;
1346   if (Length(mTitle) > 0) then
1347   begin
1348     if (mWidth < Length(mTitle)*8+mFrameWidth*2+3*8) then mWidth := Length(mTitle)*8+mFrameWidth*2+3*8;
1349   end;
1350   mDragging := false;
1351   mDrawShadow := true;
1352   mWaitingClose := false;
1353   mInClose := false;
1354   closeCB := nil;
1355 end;
1356
1357
1358 function THTopWindow.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
1359 begin
1360   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
1361   begin
1362     mTitle := par.expectStrOrId(true);
1363     result := true;
1364     exit;
1365   end;
1366   if (strEquCI1251(prname, 'children')) then
1367   begin
1368     parseChildren(par);
1369     result := true;
1370     exit;
1371   end;
1372   if (strEquCI1251(prname, 'orientation')) or (strEquCI1251(prname, 'orient')) then
1373   begin
1374          if (par.eatIdOrStr('horizontal', false)) or (par.eatIdOrStr('horiz', false)) then mHoriz := true
1375     else if (par.eatIdOrStr('vertical', false)) or (par.eatIdOrStr('vert', false)) then mHoriz := false
1376     else par.error('`horizontal` or `vertical` expected');
1377     result := true;
1378     exit;
1379   end;
1380   result := inherited parseProperty(prname, par);
1381 end;
1382
1383
1384 procedure THTopWindow.centerInScreen ();
1385 begin
1386   if (mWidth > 0) and (mHeight > 0) then
1387   begin
1388     mX := trunc((gScrWidth/gh_ui_scale-mWidth)/2);
1389     mY := trunc((gScrHeight/gh_ui_scale-mHeight)/2);
1390   end;
1391 end;
1392
1393
1394 procedure THTopWindow.drawControl (gx, gy: Integer);
1395 begin
1396   fillRect(gx, gy, mWidth, mHeight, 0, 0, 128);
1397 end;
1398
1399
1400 procedure THTopWindow.drawControlPost (gx, gy: Integer);
1401 const r = 255;
1402 const g = 255;
1403 const b = 255;
1404 var
1405   tx: Integer;
1406 begin
1407   if mDragging then
1408   begin
1409     drawRectUI(mX+4, mY+4, mWidth-8, mHeight-8, r, g, b);
1410   end
1411   else
1412   begin
1413     drawRectUI(mX+3, mY+3, mWidth-6, mHeight-6, r, g, b);
1414     drawRectUI(mX+5, mY+5, mWidth-10, mHeight-10, r, g, b);
1415     setScissor(mFrameWidth, 0, 3*8, 8);
1416     fillRect(mX+mFrameWidth, mY, 3*8, 8, 0, 0, 128);
1417     drawText8(mX+mFrameWidth, mY, '[ ]', r, g, b);
1418     if mInClose then drawText8(mX+mFrameWidth+7, mY, '#', 0, 255, 0)
1419     else drawText8(mX+mFrameWidth+7, mY, '*', 0, 255, 0);
1420   end;
1421   if (Length(mTitle) > 0) then
1422   begin
1423     setScissor(mFrameWidth+3*8, 0, mWidth-mFrameWidth*2-3*8, 8);
1424     tx := (mX+3*8)+((mWidth-3*8)-Length(mTitle)*8) div 2;
1425     fillRect(tx-3, mY, Length(mTitle)*8+3+2, 8, 0, 0, 128);
1426     drawText8(tx, mY, mTitle, r, g, b);
1427   end;
1428   inherited drawControlPost(gx, gy);
1429 end;
1430
1431
1432 procedure THTopWindow.blurred ();
1433 begin
1434   mDragging := false;
1435   mWaitingClose := false;
1436   mInClose := false;
1437   inherited;
1438 end;
1439
1440
1441 function THTopWindow.keyEvent (var ev: THKeyEvent): Boolean;
1442 begin
1443   result := inherited keyEvent(ev);
1444   if not getFocused then exit;
1445   if (ev = 'M-F3') then
1446   begin
1447     uiRemoveWindow(self);
1448     result := true;
1449     exit;
1450   end;
1451 end;
1452
1453
1454 function THTopWindow.mouseEvent (var ev: THMouseEvent): Boolean;
1455 var
1456   lx, ly: Integer;
1457 begin
1458   result := false;
1459   if not mEnabled then exit;
1460   if (mWidth < 1) or (mHeight < 1) then exit;
1461
1462   if mDragging then
1463   begin
1464     mX += ev.x-mDragStartX;
1465     mY += ev.y-mDragStartY;
1466     mDragStartX := ev.x;
1467     mDragStartY := ev.y;
1468     if (ev.release) then mDragging := false;
1469     result := true;
1470     exit;
1471   end;
1472
1473   if toLocal(ev.x, ev.y, lx, ly) then
1474   begin
1475     if (ev.press) then
1476     begin
1477       if (ly < 8) then
1478       begin
1479         if (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
1480         begin
1481           //uiRemoveWindow(self);
1482           mWaitingClose := true;
1483           mInClose := true;
1484         end
1485         else
1486         begin
1487           mDragging := true;
1488           mDragStartX := ev.x;
1489           mDragStartY := ev.y;
1490         end;
1491         result := true;
1492         exit;
1493       end;
1494       if (lx < mFrameWidth) or (lx >= mWidth-mFrameWidth) or (ly >= mHeight-mFrameHeight) then
1495       begin
1496         mDragging := true;
1497         mDragStartX := ev.x;
1498         mDragStartY := ev.y;
1499         result := true;
1500         exit;
1501       end;
1502     end;
1503
1504     if (ev.release) then
1505     begin
1506       if mWaitingClose and (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
1507       begin
1508         uiRemoveWindow(self);
1509         result := true;
1510         exit;
1511       end;
1512       mWaitingClose := false;
1513       mInClose := false;
1514     end;
1515
1516     if (ev.motion) then
1517     begin
1518       if mWaitingClose then
1519       begin
1520         mInClose := (lx >= mFrameWidth) and (lx < mFrameWidth+3*8);
1521         result := true;
1522         exit;
1523       end;
1524     end;
1525   end
1526   else
1527   begin
1528     mInClose := false;
1529     if (not ev.motion) then mWaitingClose := false;
1530   end;
1531
1532   result := inherited mouseEvent(ev);
1533 end;
1534
1535
1536 // ////////////////////////////////////////////////////////////////////////// //
1537 constructor THCtlSimpleText.Create (ax, ay: Integer);
1538 begin
1539   mItems := nil;
1540   inherited Create(ax, ay, 4, 4);
1541 end;
1542
1543
1544 destructor THCtlSimpleText.Destroy ();
1545 begin
1546   mItems := nil;
1547   inherited;
1548 end;
1549
1550
1551 procedure THCtlSimpleText.appendItem (const atext: AnsiString; acentered: Boolean=false; ahline: Boolean=false);
1552 var
1553   it: PItem;
1554 begin
1555   if (Length(atext)*8+3*8+2 > mWidth) then mWidth := Length(atext)*8+3*8+2;
1556   SetLength(mItems, Length(mItems)+1);
1557   it := @mItems[High(mItems)];
1558   it.title := atext;
1559   it.centered := acentered;
1560   it.hline := ahline;
1561   if (Length(mItems)*8 > mHeight) then mHeight := Length(mItems)*8;
1562 end;
1563
1564
1565 procedure THCtlSimpleText.drawControl (gx, gy: Integer);
1566 var
1567   f, tx: Integer;
1568   it: PItem;
1569   r, g, b: Integer;
1570 begin
1571   for f := 0 to High(mItems) do
1572   begin
1573     it := @mItems[f];
1574     tx := gx;
1575     r := 255;
1576     g := 255;
1577     b := 0;
1578     if it.centered then begin b := 255; tx := gx+(mWidth-Length(it.title)*8) div 2; end;
1579     if it.hline then
1580     begin
1581       b := 255;
1582       if (Length(it.title) = 0) then
1583       begin
1584         drawHLine(gx+4, gy+3, mWidth-8, r, g, b);
1585       end
1586       else if (tx-3 > gx+4) then
1587       begin
1588         drawHLine(gx+4, gy+3, tx-3-(gx+3), r, g, b);
1589         drawHLine(tx+Length(it.title)*8, gy+3, mWidth-4, r, g, b);
1590       end;
1591     end;
1592     drawText8(tx, gy, it.title, r, g, b);
1593     Inc(gy, 8);
1594   end;
1595 end;
1596
1597
1598 function THCtlSimpleText.mouseEvent (var ev: THMouseEvent): Boolean;
1599 var
1600   lx, ly: Integer;
1601 begin
1602   result := inherited mouseEvent(ev);
1603   if not result and toLocal(ev.x, ev.y, lx, ly) then
1604   begin
1605     result := true;
1606   end;
1607 end;
1608
1609
1610 function THCtlSimpleText.keyEvent (var ev: THKeyEvent): Boolean;
1611 begin
1612   result := inherited keyEvent(ev);
1613 end;
1614
1615
1616 // ////////////////////////////////////////////////////////////////////////// //
1617 constructor THCtlCBListBox.Create (ax, ay: Integer);
1618 begin
1619   mItems := nil;
1620   mCurIndex := -1;
1621   inherited Create(ax, ay, 4, 4);
1622 end;
1623
1624
1625 destructor THCtlCBListBox.Destroy ();
1626 begin
1627   mItems := nil;
1628   inherited;
1629 end;
1630
1631
1632 procedure THCtlCBListBox.appendItem (const atext: AnsiString; bv: PBoolean; aaction: TActionCB=nil);
1633 var
1634   it: PItem;
1635 begin
1636   if (Length(atext)*8+3*8+2 > mWidth) then mWidth := Length(atext)*8+3*8+2;
1637   SetLength(mItems, Length(mItems)+1);
1638   it := @mItems[High(mItems)];
1639   it.title := atext;
1640   it.varp := bv;
1641   it.actionCB := aaction;
1642   if (Length(mItems)*8 > mHeight) then mHeight := Length(mItems)*8;
1643   if (mCurIndex < 0) then mCurIndex := 0;
1644 end;
1645
1646
1647 procedure THCtlCBListBox.drawControl (gx, gy: Integer);
1648 var
1649   f, tx: Integer;
1650   it: PItem;
1651 begin
1652   for f := 0 to High(mItems) do
1653   begin
1654     it := @mItems[f];
1655     if (mCurIndex = f) then fillRect(gx, gy, mWidth, 8, 0, 128, 0);
1656     if (it.varp <> nil) then
1657     begin
1658       if it.varp^ then drawText8(gx, gy, '[x]', 255, 255, 255) else drawText8(gx, gy, '[ ]', 255, 255, 255);
1659       drawText8(gx+3*8+2, gy, it.title, 255, 255, 0);
1660     end
1661     else if (Length(it.title) > 0) then
1662     begin
1663       tx := gx+(mWidth-Length(it.title)*8) div 2;
1664       if (tx-3 > gx+4) then
1665       begin
1666         drawHLine(gx+4, gy+3, tx-3-(gx+3), 255, 255, 255);
1667         drawHLine(tx+Length(it.title)*8, gy+3, mWidth-4, 255, 255, 255);
1668       end;
1669       drawText8(tx, gy, it.title, 255, 255, 255);
1670     end
1671     else
1672     begin
1673       drawHLine(gx+4, gy+3, mWidth-8, 255, 255, 255);
1674     end;
1675     Inc(gy, 8);
1676   end;
1677 end;
1678
1679
1680 function THCtlCBListBox.mouseEvent (var ev: THMouseEvent): Boolean;
1681 var
1682   lx, ly: Integer;
1683   it: PItem;
1684 begin
1685   result := inherited mouseEvent(ev);
1686   if not result and toLocal(ev.x, ev.y, 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);
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 (gx, gy: 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(gx+3, gy+3, mWidth-6, mHeight-6, r, g, b);
1825   end;
1826   // draw caption
1827   if (Length(mCaption) > 0) then
1828   begin
1829     setScissor(mFrameWidth+1, 0, mWidth-mFrameWidth-2, 8);
1830     tx := gx+((mWidth-Length(mCaption)*8) div 2)-1;
1831     if mHasFrame then fillRect(tx, gy, Length(mCaption)*8+2, 8, 0, 0, 128);
1832     drawText8(tx+1, gy, mCaption, r, g, b);
1833   end;
1834 end;
1835
1836
1837 function THCtlBox.mouseEvent (var ev: THMouseEvent): Boolean;
1838 var
1839   lx, ly: Integer;
1840 begin
1841   result := inherited mouseEvent(ev);
1842   if not result and toLocal(ev.x, ev.y, lx, ly) then
1843   begin
1844     result := true;
1845   end;
1846 end;
1847
1848
1849 //TODO: navigation with arrow keys, according to box orientation
1850 function THCtlBox.keyEvent (var ev: THKeyEvent): Boolean;
1851 begin
1852   result := inherited keyEvent(ev);
1853 end;
1854
1855
1856 // ////////////////////////////////////////////////////////////////////////// //
1857 procedure THCtlHBox.AfterConstruction ();
1858 begin
1859   inherited AfterConstruction();
1860   mHoriz := true;
1861 end;
1862
1863
1864 // ////////////////////////////////////////////////////////////////////////// //
1865 procedure THCtlVBox.AfterConstruction ();
1866 begin
1867   inherited AfterConstruction();
1868   mHoriz := false;
1869 end;
1870
1871 // ////////////////////////////////////////////////////////////////////////// //
1872 constructor THCtlTextLabel.Create (const atext: AnsiString);
1873 begin
1874   inherited Create();
1875   mHAlign := -1;
1876   mVAlign := 0;
1877   mText := atext;
1878   mDefSize := TLaySize.Create(Length(atext)*8, 8);
1879 end;
1880
1881
1882 function THCtlTextLabel.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
1883 begin
1884   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
1885   begin
1886     mText := par.expectStrOrId(true);
1887     mDefSize := TLaySize.Create(Length(mText)*8, 8);
1888     result := true;
1889     exit;
1890   end;
1891   if (strEquCI1251(prname, 'textalign')) then
1892   begin
1893     parseTextAlign(par, mHAlign, mVAlign);
1894     result := true;
1895     exit;
1896   end;
1897   result := inherited parseProperty(prname, par);
1898 end;
1899
1900
1901 procedure THCtlTextLabel.drawControl (gx, gy: Integer);
1902 var
1903   xpos, ypos: Integer;
1904 begin
1905   // debug
1906   fillRect(gx, gy, mWidth, mHeight, 96, 96, 0);
1907   drawRectUI(gx, gy, mWidth, mHeight, 96, 96, 96);
1908
1909   if (Length(mText) > 0) then
1910   begin
1911          if (mHAlign < 0) then xpos := 0
1912     else if (mHAlign > 0) then xpos := mWidth-Length(mText)*8
1913     else xpos := (mWidth-Length(mText)*8) div 2;
1914
1915          if (mVAlign < 0) then ypos := 0
1916     else if (mVAlign > 0) then ypos := mHeight-8
1917     else ypos := (mHeight-8) div 2;
1918
1919     drawText8(gx+xpos, gy+ypos, mText, 255, 255, 255);
1920   end;
1921 end;
1922
1923
1924 function THCtlTextLabel.mouseEvent (var ev: THMouseEvent): Boolean;
1925 var
1926   lx, ly: Integer;
1927 begin
1928   result := inherited mouseEvent(ev);
1929   if not result and toLocal(ev.x, ev.y, lx, ly) then
1930   begin
1931     result := true;
1932   end;
1933 end;
1934
1935
1936 function THCtlTextLabel.keyEvent (var ev: THKeyEvent): Boolean;
1937 begin
1938   result := inherited keyEvent(ev);
1939 end;
1940
1941
1942 initialization
1943   registerCtlClass(THCtlBox, 'box');
1944   registerCtlClass(THCtlHBox, 'hbox');
1945   registerCtlClass(THCtlVBox, 'vbox');
1946   registerCtlClass(THCtlTextLabel, 'label');
1947 end.