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