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