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 unit gh_ui;
  18
  19 interface
  20
  21 uses
  22   SysUtils, Classes,
  23   GL, GLExt, SDL2,
  24   gh_ui_common,
  25   sdlcarcass, glgfx;
  26
  27
  28 // ////////////////////////////////////////////////////////////////////////// //
  29 type
  30   THControl = class
  31   public
  32     type TActionCB = procedure (me: THControl; uinfo: Integer);
  33
  34   private
  35     mParent: THControl;
  36     mX, mY: Integer;
  37     mWidth, mHeight: Integer;
  38     mFrameWidth, mFrameHeight: Integer;
  39     mEnabled: Boolean;
  40     mCanFocus: Boolean;
  41     mChildren: array of THControl;
  42     mFocused: THControl; // valid only for top-level controls
  43     mGrab: THControl; // valid only for top-level controls
  44     mEscClose: Boolean; // valid only for top-level controls
  45     mEatKeys: Boolean;
  46     mDrawShadow: Boolean;
  47
  48   private
  49     scis: TScissorSave;
  50     scallowed: Boolean;
  51
  52   protected
  53     function getEnabled (): Boolean;
  54     procedure setEnabled (v: Boolean); inline;
  55
  56     function getFocused (): Boolean; inline;
  57     procedure setFocused (v: Boolean); inline;
  58
  59     function isMyChild (ctl: THControl): Boolean;
  60
  61     function findFirstFocus (): THControl;
  62     function findLastFocus (): THControl;
  63
  64     function findNextFocus (cur: THControl): THControl;
  65     function findPrevFocus (cur: THControl): THControl;
  66
  67     procedure activated (); virtual;
  68     procedure blurred (); virtual;
  69
  70     //WARNING! do not call scissor functions outside `.draw*()` API!
  71     // reset scissor to whole control
  72     procedure resetScissor ();
  73     // set scissor to this internal rect (in local coords)
  74     procedure setScissor (lx, ly, lw, lh: Integer);
  75
  76     // DO NOT USE!
  77     procedure setScissorGLInternal (x, y, w, h: Integer);
  78
  79   public
  80     actionCB: TActionCB;
  81
  82   private
  83     mDefSize: TLaySize; // default size
  84     mMaxSize: TLaySize; // maximum size
  85     mActSize: TLaySize; // actual (calculated) size
  86     mActPos: TLayPos; // actual (calculated) position
  87     mFlex: Integer;
  88     mHoriz: Boolean;
  89     mCanWrap: Boolean;
  90     mLineStart: Boolean;
  91     mHGroup: AnsiString;
  92     mVGroup: AnsiString;
  93     mAlign: Integer;
  94     mExpand: Boolean;
  95
  96   public
  97     // layouter interface
  98     function getDefSize (): TLaySize; inline; // default size; <0: use max size
  99     procedure setDefSize (const sz: TLaySize); inline; // default size; <0: use max size
 100     function getMaxSize (): TLaySize; inline; // max size; <0: set to some huge value
 101     procedure setMaxSize (const sz: TLaySize); inline; // max size; <0: set to some huge value
 102     function getFlex (): Integer; inline; // <=0: not flexible
 103     function isHorizBox (): Boolean; inline; // horizontal layout for children?
 104     procedure setHorizBox (v: Boolean); inline; // horizontal layout for children?
 105     function canWrap (): Boolean; inline; // for horizontal boxes: can wrap children? for child: `false` means 'nonbreakable at *next* ctl'
 106     procedure setCanWrap (v: Boolean); inline; // for horizontal boxes: can wrap children? for child: `false` means 'nonbreakable at *next* ctl'
 107     function isLineStart (): Boolean; inline; // `true` if this ctl should start a new line; ignored for vertical boxes
 108     procedure setLineStart (v: Boolean); inline; // `true` if this ctl should start a new line; ignored for vertical boxes
 109     function getAlign (): Integer; inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
 110     procedure setAlign (v: Integer); inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
 111     function getExpand (): Boolean; inline; // expanding in non-main direction: `true` will ignore align and eat all available space
 112     procedure setExpand (v: Boolean); inline; // expanding in non-main direction: `true` will ignore align and eat all available space
 113     procedure setActualSizePos (constref apos: TLayPos; constref asize: TLaySize); inline;
 114     function getHGroup (): AnsiString; inline; // empty: not grouped
 115     procedure setHGroup (const v: AnsiString); inline; // empty: not grouped
 116     function getVGroup (): AnsiString; inline; // empty: not grouped
 117     procedure setVGroup (const v: AnsiString); inline; // empty: not grouped
 118
 119     property flex: Integer read mFlex write mFlex;
 120     property flDefaultSize: TLaySize read getDefSize write setDefSize;
 121     property flMaxSize: TLaySize read getMaxSize write setMaxSize;
 122     property flHoriz: Boolean read isHorizBox write setHorizBox;
 123     property flCanWrap: Boolean read canWrap write setCanWrap;
 124     property flLineStart: Boolean read isLineStart write setLineStart;
 125     property flAlign: Integer read getAlign write setAlign;
 126     property flExpand: Boolean read getExpand write setExpand;
 127     property flHGroup: AnsiString read getHGroup write setHGroup;
 128     property flVGroup: AnsiString read getVGroup write setVGroup;
 129     property flActualSize: TLaySize read mActSize write mActSize;
 130     property flActualPos: TLayPos read mActPos write mActPos;
 131
 132   public
 133     constructor Create (ax, ay, aw, ah: Integer; aparent: THControl=nil);
 134     destructor Destroy (); override;
 135
 136     // `sx` and `sy` are screen coordinates
 137     procedure drawControl (sx, sy: Integer); virtual;
 138
 139     // called after all children drawn
 140     procedure drawControlPost (sx, sy: Integer); virtual;
 141
 142     procedure draw (); virtual;
 143
 144     function topLevel (): THControl; inline;
 145
 146     // returns `true` if global coords are inside this control
 147     function toLocal (var x, y: Integer): Boolean;
 148     procedure toGlobal (var x, y: Integer);
 149
 150     // x and y are global coords
 151     function controlAtXY (x, y: Integer): THControl;
 152
 153     function mouseEvent (var ev: THMouseEvent): Boolean; virtual; // returns `true` if event was eaten
 154     function keyEvent (var ev: THKeyEvent): Boolean; virtual; // returns `true` if event was eaten
 155
 156     function prevSibling (): THControl;
 157     function nextSibling (): THControl;
 158     function firstChild (): THControl; inline;
 159     function lastChild (): THControl; inline;
 160
 161     procedure appendChild (ctl: THControl); virtual;
 162
 163   public
 164     property x0: Integer read mX;
 165     property y0: Integer read mY;
 166     property height: Integer read mHeight;
 167     property width: Integer read mWidth;
 168     property enabled: Boolean read getEnabled write setEnabled;
 169     property parent: THControl read mParent;
 170     property focused: Boolean read getFocused write setFocused;
 171     property escClose: Boolean read mEscClose write mEscClose;
 172     property eatKeys: Boolean read mEatKeys write mEatKeys;
 173   end;
 174
 175
 176   THTopWindow = class(THControl)
 177   private
 178     mTitle: AnsiString;
 179     mDragging: Boolean;
 180     mDragStartX, mDragStartY: Integer;
 181     mWaitingClose: Boolean;
 182     mInClose: Boolean;
 183
 184   protected
 185     procedure blurred (); override;
 186
 187   public
 188     closeCB: TActionCB; // called after window was removed from ui window list
 189
 190   public
 191     constructor Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
 192
 193     procedure centerInScreen ();
 194
 195     // `sx` and `sy` are screen coordinates
 196     procedure drawControl (sx, sy: Integer); override;
 197     procedure drawControlPost (sx, sy: Integer); override;
 198
 199     function keyEvent (var ev: THKeyEvent): Boolean; override; // returns `true` if event was eaten
 200     function mouseEvent (var ev: THMouseEvent): Boolean; override; // returns `true` if event was eaten
 201   end;
 202
 203
 204   THCtlSimpleText = class(THControl)
 205   private
 206     type
 207       PItem = ^TItem;
 208       TItem = record
 209         title: AnsiString;
 210         centered: Boolean;
 211         hline: Boolean;
 212       end;
 213   private
 214     mItems: array of TItem;
 215
 216   public
 217     constructor Create (ax, ay: Integer; aparent: THControl=nil);
 218     destructor Destroy (); override;
 219
 220     procedure appendItem (const atext: AnsiString; acentered: Boolean=false; ahline: Boolean=false);
 221
 222     procedure drawControl (sx, sy: Integer); override;
 223
 224     function mouseEvent (var ev: THMouseEvent): Boolean; override;
 225     function keyEvent (var ev: THKeyEvent): Boolean; override;
 226   end;
 227
 228
 229   THCtlCBListBox = class(THControl)
 230   private
 231     type
 232       PItem = ^TItem;
 233       TItem = record
 234         title: AnsiString;
 235         varp: PBoolean;
 236         actionCB: TActionCB;
 237       end;
 238   private
 239     mItems: array of TItem;
 240     mCurIndex: Integer;
 241
 242   public
 243     constructor Create (ax, ay: Integer; aparent: THControl=nil);
 244     destructor Destroy (); override;
 245
 246     procedure appendItem (const atext: AnsiString; bv: PBoolean; aaction: TActionCB=nil);
 247
 248     procedure drawControl (sx, sy: Integer); override;
 249
 250     function mouseEvent (var ev: THMouseEvent): Boolean; override;
 251     function keyEvent (var ev: THKeyEvent): Boolean; override;
 252   end;
 253
 254
 255 function uiMouseEvent (ev: THMouseEvent): Boolean;
 256 function uiKeyEvent (ev: THKeyEvent): Boolean;
 257 procedure uiDraw ();
 258
 259 procedure uiAddWindow (ctl: THControl);
 260 procedure uiRemoveWindow (ctl: THControl);
 261 function uiVisibleWindow (ctl: THControl): Boolean;
 262
 263
 264 // do layouting
 265 procedure uiLayoutCtl (ctl: THControl);
 266
 267
 268 var
 269   gh_ui_scale: Single = 1.0;
 270
 271
 272 implementation
 273
 274 uses
 275   gh_flexlay;
 276
 277
 278 // ////////////////////////////////////////////////////////////////////////// //
 279 type
 280   TFlexLayouter = specialize TFlexLayouterBase<THControl>;
 281
 282 procedure uiLayoutCtl (ctl: THControl);
 283 var
 284   lay: TFlexLayouter;
 285 begin
 286   if (ctl = nil) then exit;
 287   lay := TFlexLayouter.Create();
 288   try
 289     lay.setup(ctl);
 290     lay.layout();
 291   finally
 292     FreeAndNil(lay);
 293   end;
 294 end;
 295
 296
 297 // ////////////////////////////////////////////////////////////////////////// //
 298 var
 299   uiTopList: array of THControl = nil;
 300
 301
 302 function uiMouseEvent (ev: THMouseEvent): Boolean;
 303 var
 304   f, c: Integer;
 305   lx, ly: Integer;
 306   ctmp: THControl;
 307 begin
 308   ev.x := trunc(ev.x/gh_ui_scale);
 309   ev.y := trunc(ev.y/gh_ui_scale);
 310   ev.dx := trunc(ev.dx/gh_ui_scale); //FIXME
 311   ev.dy := trunc(ev.dy/gh_ui_scale); //FIXME
 312   if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].mouseEvent(ev);
 313   if not result and (ev.press) then
 314   begin
 315     for f := High(uiTopList) downto 0 do
 316     begin
 317       lx := ev.x;
 318       ly := ev.y;
 319       if uiTopList[f].toLocal(lx, ly) then
 320       begin
 321         result := true;
 322         if uiTopList[f].mEnabled and (f <> High(uiTopList)) then
 323         begin
 324           uiTopList[High(uiTopList)].blurred();
 325           ctmp := uiTopList[f];
 326           ctmp.mGrab := nil;
 327           for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
 328           uiTopList[High(uiTopList)] := ctmp;
 329           ctmp.activated();
 330           result := ctmp.mouseEvent(ev);
 331         end;
 332         exit;
 333       end;
 334     end;
 335   end;
 336 end;
 337
 338
 339 function uiKeyEvent (ev: THKeyEvent): Boolean;
 340 begin
 341   ev.x := trunc(ev.x/gh_ui_scale);
 342   ev.y := trunc(ev.y/gh_ui_scale);
 343   if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].keyEvent(ev);
 344   if (ev.release) then begin result := true; exit; end;
 345 end;
 346
 347
 348 procedure uiDraw ();
 349 var
 350   f: Integer;
 351   ctl: THControl;
 352 begin
 353   glMatrixMode(GL_MODELVIEW);
 354   glPushMatrix();
 355   try
 356     glLoadIdentity();
 357     glScalef(gh_ui_scale, gh_ui_scale, 1);
 358     for f := 0 to High(uiTopList) do
 359     begin
 360       ctl := uiTopList[f];
 361       ctl.draw();
 362       if (f <> High(uiTopList)) then darkenRect(ctl.x0, ctl.y0, ctl.width, ctl.height, 128);
 363     end;
 364   finally
 365     glMatrixMode(GL_MODELVIEW);
 366     glPopMatrix();
 367   end;
 368 end;
 369
 370
 371 procedure uiAddWindow (ctl: THControl);
 372 var
 373   f, c: Integer;
 374 begin
 375   if (ctl = nil) then exit;
 376   ctl := ctl.topLevel;
 377   for f := 0 to High(uiTopList) do
 378   begin
 379     if (uiTopList[f] = ctl) then
 380     begin
 381       if (f <> High(uiTopList)) then
 382       begin
 383         uiTopList[High(uiTopList)].blurred();
 384         for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
 385         uiTopList[High(uiTopList)] := ctl;
 386         ctl.activated();
 387       end;
 388       exit;
 389     end;
 390   end;
 391   if (Length(uiTopList) > 0) then uiTopList[High(uiTopList)].blurred();
 392   SetLength(uiTopList, Length(uiTopList)+1);
 393   uiTopList[High(uiTopList)] := ctl;
 394   ctl.activated();
 395 end;
 396
 397
 398 // won't free object
 399 procedure uiRemoveWindow (ctl: THControl);
 400 var
 401   f, c: Integer;
 402 begin
 403   if (ctl = nil) then exit;
 404   ctl := ctl.topLevel;
 405   for f := 0 to High(uiTopList) do
 406   begin
 407     if (uiTopList[f] = ctl) then
 408     begin
 409       ctl.blurred();
 410       for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
 411       SetLength(uiTopList, Length(uiTopList)-1);
 412       if (ctl is THTopWindow) then
 413       begin
 414         if assigned(THTopWindow(ctl).closeCB) then THTopWindow(ctl).closeCB(ctl, 0);
 415       end;
 416       exit;
 417     end;
 418   end;
 419 end;
 420
 421
 422 function uiVisibleWindow (ctl: THControl): Boolean;
 423 var
 424   f: Integer;
 425 begin
 426   result := false;
 427   if (ctl = nil) then exit;
 428   ctl := ctl.topLevel;
 429   for f := 0 to High(uiTopList) do
 430   begin
 431     if (uiTopList[f] = ctl) then begin result := true; exit; end;
 432   end;
 433 end;
 434
 435
 436 // ////////////////////////////////////////////////////////////////////////// //
 437 constructor THControl.Create (ax, ay, aw, ah: Integer; aparent: THControl=nil);
 438 begin
 439   mParent := aparent;
 440   mX := ax;
 441   mY := ay;
 442   mWidth := aw;
 443   mHeight := ah;
 444   mFrameWidth := 0;
 445   mFrameHeight := 0;
 446   mEnabled := true;
 447   mCanFocus := true;
 448   mChildren := nil;
 449   mFocused := nil;
 450   mGrab := nil;
 451   mEscClose := false;
 452   mEatKeys := false;
 453   scallowed := false;
 454   mDrawShadow := false;
 455   actionCB := nil;
 456   // layouter interface
 457   mDefSize := TLaySize.Create(64, 10); // default size
 458   mMaxSize := TLaySize.Create(-1, -1); // maximum size
 459   mActSize := TLaySize.Create(0, 0); // actual (calculated) size
 460   mActPos := TLayPos.Create(0, 0); // actual (calculated) position
 461   mFlex := 0;
 462   mHoriz := true;
 463   mCanWrap := false;
 464   mLineStart := false;
 465   mHGroup := '';
 466   mVGroup := '';
 467   mAlign := -1; // left/top
 468   mExpand := false;
 469 end;
 470
 471
 472 destructor THControl.Destroy ();
 473 var
 474   f, c: Integer;
 475 begin
 476   if (mParent <> nil) then
 477   begin
 478     setFocused(false);
 479     for f := 0 to High(mParent.mChildren) do
 480     begin
 481       if (mParent.mChildren[f] = self) then
 482       begin
 483         for c := f+1 to High(mParent.mChildren) do mParent.mChildren[c-1] := mParent.mChildren[c];
 484         SetLength(mParent.mChildren, Length(mParent.mChildren)-1);
 485       end;
 486     end;
 487   end;
 488   for f := 0 to High(mChildren) do
 489   begin
 490     mChildren[f].mParent := nil;
 491     mChildren[f].Free();
 492   end;
 493   mChildren := nil;
 494 end;
 495
 496
 497 function THControl.getDefSize (): TLaySize; inline; begin result := mDefSize; end;
 498 procedure THControl.setDefSize (const sz: TLaySize); inline; begin mDefSize := sz; end;
 499 function THControl.getMaxSize (): TLaySize; inline; begin result := mMaxSize; end;
 500 procedure THControl.setMaxSize (const sz: TLaySize); inline; begin mMaxSize := sz; end;
 501 function THControl.getFlex (): Integer; inline; begin result := mFlex; end;
 502 function THControl.isHorizBox (): Boolean; inline; begin result := mHoriz; end;
 503 procedure THControl.setHorizBox (v: Boolean); inline; begin mHoriz := v; end;
 504 function THControl.canWrap (): Boolean; inline; begin result := mCanWrap; end;
 505 procedure THControl.setCanWrap (v: Boolean); inline; begin mCanWrap := v; end;
 506 function THControl.isLineStart (): Boolean; inline; begin result := mLineStart; end;
 507 procedure THControl.setLineStart (v: Boolean); inline; begin mLineStart := v; end;
 508 function THControl.getAlign (): Integer; inline; begin result := mAlign; end;
 509 procedure THControl.setAlign (v: Integer); inline; begin mAlign := v; end;
 510 function THControl.getExpand (): Boolean; inline; begin result := mExpand; end;
 511 procedure THControl.setExpand (v: Boolean); inline; begin mExpand := v; end;
 512 procedure THControl.setActualSizePos (constref apos: TLayPos; constref asize: TLaySize); inline; begin mActPos := apos; mActSize := asize; end;
 513 function THControl.getHGroup (): AnsiString; inline; begin result := mHGroup; end;
 514 procedure THControl.setHGroup (const v: AnsiString); inline; begin mHGroup := v; end;
 515 function THControl.getVGroup (): AnsiString; inline; begin result := mVGroup; end;
 516 procedure THControl.setVGroup (const v: AnsiString); inline; begin mVGroup := v; end;
 517
 518
 519 procedure THControl.activated ();
 520 begin
 521 end;
 522
 523
 524 procedure THControl.blurred ();
 525 begin
 526   mGrab := nil;
 527 end;
 528
 529
 530 function THControl.topLevel (): THControl; inline;
 531 begin
 532   result := self;
 533   while (result.mParent <> nil) do result := result.mParent;
 534 end;
 535
 536
 537 function THControl.getEnabled (): Boolean;
 538 var
 539   ctl: THControl;
 540 begin
 541   result := false;
 542   if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
 543   ctl := mParent;
 544   while (ctl <> nil) do
 545   begin
 546     if (not ctl.mEnabled) or (ctl.mWidth < 1) or (ctl.mHeight < 1) then exit;
 547     ctl := ctl.mParent;
 548   end;
 549   result := true;
 550 end;
 551
 552
 553 procedure THControl.setEnabled (v: Boolean); inline;
 554 begin
 555   if (mEnabled = v) then exit;
 556   mEnabled := v;
 557   if not v and focused then setFocused(false);
 558 end;
 559
 560
 561 function THControl.getFocused (): Boolean; inline;
 562 begin
 563   if (mParent = nil) then result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = self) else result := (topLevel.mFocused = self);
 564 end;
 565
 566
 567 procedure THControl.setFocused (v: Boolean); inline;
 568 var
 569   tl: THControl;
 570 begin
 571   tl := topLevel;
 572   if not v then
 573   begin
 574     if (tl.mFocused = self) then
 575     begin
 576       tl.blurred();
 577       tl.mFocused := tl.findNextFocus(self);
 578       if (tl.mFocused = self) then tl.mFocused := nil;
 579     end;
 580     exit;
 581   end;
 582   if (not mEnabled) or (not mCanFocus) then exit;
 583   if (tl.mFocused <> self) then
 584   begin
 585     tl.mFocused.blurred();
 586     tl.mFocused := self;
 587     if (tl.mGrab <> self) then tl.mGrab := nil;
 588     activated();
 589   end;
 590 end;
 591
 592
 593 function THControl.isMyChild (ctl: THControl): Boolean;
 594 begin
 595   result := true;
 596   while (ctl <> nil) do
 597   begin
 598     if (ctl.mParent = self) then exit;
 599     ctl := ctl.mParent;
 600   end;
 601   result := false;
 602 end;
 603
 604
 605 // returns `true` if global coords are inside this control
 606 function THControl.toLocal (var x, y: Integer): Boolean;
 607 var
 608   ctl: THControl;
 609 begin
 610   ctl := self;
 611   while (ctl <> nil) do
 612   begin
 613     Dec(x, ctl.mX);
 614     Dec(y, ctl.mY);
 615     ctl := ctl.mParent;
 616   end;
 617   result := (x >= 0) and (y >= 0) and (x < mWidth) and (y < mHeight);
 618 end;
 619
 620
 621 procedure THControl.toGlobal (var x, y: Integer);
 622 var
 623   ctl: THControl;
 624 begin
 625   ctl := self;
 626   while (ctl <> nil) do
 627   begin
 628     Inc(x, ctl.mX);
 629     Inc(y, ctl.mY);
 630     ctl := ctl.mParent;
 631   end;
 632 end;
 633
 634
 635 // x and y are global coords
 636 function THControl.controlAtXY (x, y: Integer): THControl;
 637 var
 638   lx, ly: Integer;
 639   f: Integer;
 640 begin
 641   result := nil;
 642   if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
 643   lx := x;
 644   ly := y;
 645   if not toLocal(lx, ly) then exit;
 646   for f := High(mChildren) downto 0 do
 647   begin
 648     result := mChildren[f].controlAtXY(x, y);
 649     if (result <> nil) then exit;
 650   end;
 651   result := self;
 652 end;
 653
 654
 655 function THControl.prevSibling (): THControl;
 656 var
 657   f: Integer;
 658 begin
 659   if (mParent <> nil) then
 660   begin
 661     for f := 1 to High(mParent.mChildren) do
 662     begin
 663       if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f-1]; exit; end;
 664     end;
 665   end;
 666   result := nil;
 667 end;
 668
 669 function THControl.nextSibling (): THControl;
 670 var
 671   f: Integer;
 672 begin
 673   if (mParent <> nil) then
 674   begin
 675     for f := 0 to High(mParent.mChildren)-1 do
 676     begin
 677       if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f+1]; exit; end;
 678     end;
 679   end;
 680   result := nil;
 681 end;
 682
 683 function THControl.firstChild (): THControl; inline;
 684 begin
 685   if (Length(mChildren) <> 0) then result := mChildren[0] else result := nil;
 686 end;
 687
 688 function THControl.lastChild (): THControl; inline;
 689 begin
 690   if (Length(mChildren) <> 0) then result := mChildren[High(mChildren)] else result := nil;
 691 end;
 692
 693
 694 function THControl.findFirstFocus (): THControl;
 695 var
 696   f: Integer;
 697 begin
 698   result := nil;
 699   if enabled then
 700   begin
 701     for f := 0 to High(mChildren) do
 702     begin
 703       result := mChildren[f].findFirstFocus();
 704       if (result <> nil) then exit;
 705     end;
 706     if mCanFocus then result := self;
 707   end;
 708 end;
 709
 710
 711 function THControl.findLastFocus (): THControl;
 712 var
 713   f: Integer;
 714 begin
 715   result := nil;
 716   if enabled then
 717   begin
 718     for f := High(mChildren) downto 0 do
 719     begin
 720       result := mChildren[f].findLastFocus();
 721       if (result <> nil) then exit;
 722     end;
 723     if mCanFocus then result := self;
 724   end;
 725 end;
 726
 727
 728 function THControl.findNextFocus (cur: THControl): THControl;
 729 begin
 730   result := nil;
 731   if enabled then
 732   begin
 733     if not isMyChild(cur) then cur := nil;
 734     if (cur = nil) then begin result := findFirstFocus(); exit; end;
 735     result := cur.findFirstFocus();
 736     if (result <> nil) and (result <> cur) then exit;
 737     while true do
 738     begin
 739       cur := cur.nextSibling;
 740       if (cur = nil) then break;
 741       result := cur.findFirstFocus();
 742       if (result <> nil) then exit;
 743     end;
 744     result := findFirstFocus();
 745   end;
 746 end;
 747
 748
 749 function THControl.findPrevFocus (cur: THControl): THControl;
 750 begin
 751   result := nil;
 752   if enabled then
 753   begin
 754     if not isMyChild(cur) then cur := nil;
 755     if (cur = nil) then begin result := findLastFocus(); exit; end;
 756     //FIXME!
 757     result := cur.findLastFocus();
 758     if (result <> nil) and (result <> cur) then exit;
 759     while true do
 760     begin
 761       cur := cur.prevSibling;
 762       if (cur = nil) then break;
 763       result := cur.findLastFocus();
 764       if (result <> nil) then exit;
 765     end;
 766     result := findLastFocus();
 767   end;
 768 end;
 769
 770
 771 procedure THControl.appendChild (ctl: THControl);
 772 begin
 773   if (ctl = nil) then exit;
 774   if (ctl.mParent <> nil) then exit;
 775   SetLength(mChildren, Length(mChildren)+1);
 776   mChildren[High(mChildren)] := ctl;
 777   ctl.mParent := self;
 778   Inc(ctl.mX, mFrameWidth);
 779   Inc(ctl.mY, mFrameHeight);
 780   if (ctl.mWidth > 0) and (ctl.mHeight > 0) and
 781      (ctl.mX+ctl.mWidth > mFrameWidth) and (ctl.mY+ctl.mHeight > mFrameHeight) then
 782   begin
 783     if (mWidth+mFrameWidth < ctl.mX+ctl.mWidth) then mWidth := ctl.mX+ctl.mWidth+mFrameWidth;
 784     if (mHeight+mFrameHeight < ctl.mY+ctl.mHeight) then mHeight := ctl.mY+ctl.mHeight+mFrameHeight;
 785   end;
 786   if (mFocused = nil) and ctl.mEnabled and ctl.mCanFocus and (ctl.mWidth > 0) and (ctl.mHeight > 0) then mFocused := ctl;
 787 end;
 788
 789
 790 procedure THControl.setScissorGLInternal (x, y, w, h: Integer);
 791 begin
 792   if not scallowed then exit;
 793   x := trunc(x*gh_ui_scale);
 794   y := trunc(y*gh_ui_scale);
 795   w := trunc(w*gh_ui_scale);
 796   h := trunc(h*gh_ui_scale);
 797   //y := gWinSizeY-(y+h);
 798   scis.setRect(x, y, w, h);
 799 end;
 800
 801
 802 procedure THControl.resetScissor ();
 803 var
 804   x, y: Integer;
 805 begin
 806   if not scallowed then exit;
 807   x := 0;
 808   y := 0;
 809   toGlobal(x, y);
 810   setScissorGLInternal(x, y, mWidth, mHeight);
 811 end;
 812
 813
 814 procedure THControl.setScissor (lx, ly, lw, lh: Integer);
 815 var
 816   x, y: Integer;
 817 begin
 818   if not scallowed then exit;
 819   if not intersectRect(lx, ly, lw, lh, 0, 0, mWidth, mHeight) then begin glScissor(0, 0, 0, 0); exit; end;
 820   x := lx;
 821   y := ly;
 822   toGlobal(x, y);
 823   setScissorGLInternal(x, y, lw, lh);
 824 end;
 825
 826
 827 procedure THControl.draw ();
 828 var
 829   f: Integer;
 830   x, y: Integer;
 831 begin
 832   if (mWidth < 1) or (mHeight < 1) then exit;
 833   x := 0;
 834   y := 0;
 835   toGlobal(x, y);
 836   //conwritefln('[%s]: (%d,%d)-(%d,%d)  (%d,%d)', [ClassName, mX, mY, mWidth, mHeight, x, y]);
 837
 838   scis.save(true); // scissoring enabled
 839   try
 840     //glEnable(GL_SCISSOR_TEST);
 841     scallowed := true;
 842     resetScissor();
 843     drawControl(x, y);
 844     if (mFrameWidth <> 0) or (mFrameHeight <> 0) then setScissor(mFrameWidth, mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2);
 845     for f := 0 to High(mChildren) do mChildren[f].draw();
 846     if (mFrameWidth <> 0) or (mFrameHeight <> 0) then resetScissor();
 847     drawControlPost(x, y);
 848   finally
 849     scis.restore();
 850     scallowed := false;
 851   end;
 852 end;
 853
 854
 855 procedure THControl.drawControl (sx, sy: Integer);
 856 begin
 857   if (mParent = nil) then darkenRect(sx, sy, mWidth, mHeight, 64);
 858 end;
 859
 860
 861 procedure THControl.drawControlPost (sx, sy: Integer);
 862 begin
 863   if mDrawShadow and (mWidth > 0) and (mHeight > 0) then
 864   begin
 865     setScissorGLInternal(sx+8, sy+8, mWidth, mHeight);
 866     darkenRect(sx+mWidth, sy+8, 8, mHeight, 128);
 867     darkenRect(sx+8, sy+mHeight, mWidth-8, 8, 128);
 868   end;
 869 end;
 870
 871
 872 function THControl.mouseEvent (var ev: THMouseEvent): Boolean;
 873 var
 874   ctl: THControl;
 875 begin
 876   result := false;
 877   if not mEnabled then exit;
 878   if (mParent = nil) then
 879   begin
 880     if (mGrab <> nil) then
 881     begin
 882       result := mGrab.mouseEvent(ev);
 883       if (ev.release) then mGrab := nil;
 884       exit;
 885     end;
 886   end;
 887   if (mWidth < 1) or (mHeight < 1) then exit;
 888   ctl := controlAtXY(ev.x, ev.y);
 889   if (ctl <> nil) and (ctl <> self) then
 890   begin
 891     if (ctl <> topLevel.mFocused) then ctl.setFocused(true);
 892     result := ctl.mouseEvent(ev);
 893   end
 894   else if (ctl = self) and assigned(actionCB) then
 895   begin
 896     actionCB(self, 0);
 897   end;
 898 end;
 899
 900
 901 function THControl.keyEvent (var ev: THKeyEvent): Boolean;
 902 var
 903   ctl: THControl;
 904 begin
 905   result := false;
 906   if not mEnabled then exit;
 907   if (topLevel.mFocused <> self) and isMyChild(topLevel.mFocused) and topLevel.mFocused.mEnabled then result := topLevel.mFocused.keyEvent(ev);
 908   if (mParent = nil) then
 909   begin
 910     if (ev = 'S-Tab') then
 911     begin
 912       result := true;
 913       ctl := findPrevFocus(mFocused);
 914       if (ctl <> mFocused) then
 915       begin
 916         mGrab := nil;
 917         mFocused := ctl;
 918       end;
 919       exit;
 920     end;
 921     if (ev = 'Tab') then
 922     begin
 923       result := true;
 924       ctl := findNextFocus(mFocused);
 925       if (ctl <> mFocused) then
 926       begin
 927         mGrab := nil;
 928         mFocused := ctl;
 929       end;
 930       exit;
 931     end;
 932     if mEscClose and (ev = 'Escape') then
 933     begin
 934       result := true;
 935       uiRemoveWindow(self);
 936       exit;
 937     end;
 938   end;
 939   if mEatKeys then result := true;
 940 end;
 941
 942
 943 // ////////////////////////////////////////////////////////////////////////// //
 944 constructor THTopWindow.Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
 945 begin
 946   inherited Create(ax, ay, aw, ah, nil);
 947   mFrameWidth := 8;
 948   mFrameHeight := 8;
 949   mTitle := atitle;
 950   if (mWidth < mFrameWidth*2+3*8) then mWidth := mFrameWidth*2+3*8;
 951   if (mHeight < mFrameHeight*2) then mHeight := mFrameHeight*2;
 952   if (Length(mTitle) > 0) then
 953   begin
 954     if (mWidth < Length(mTitle)*8+mFrameWidth*2+3*8) then mWidth := Length(mTitle)*8+mFrameWidth*2+3*8;
 955   end;
 956   mDragging := false;
 957   mDrawShadow := true;
 958   mWaitingClose := false;
 959   mInClose := false;
 960   closeCB := nil;
 961 end;
 962
 963
 964 procedure THTopWindow.centerInScreen ();
 965 begin
 966   if (mWidth > 0) and (mHeight > 0) then
 967   begin
 968     mX := trunc((gScrWidth/gh_ui_scale-mWidth)/2);
 969     mY := trunc((gScrHeight/gh_ui_scale-mHeight)/2);
 970   end;
 971 end;
 972
 973
 974 procedure THTopWindow.drawControl (sx, sy: Integer);
 975 begin
 976   fillRect(sx, sy, mWidth, mHeight, 0, 0, 128);
 977 end;
 978
 979
 980 procedure THTopWindow.drawControlPost (sx, sy: Integer);
 981 const r = 255;
 982 const g = 255;
 983 const b = 255;
 984 var
 985   tx: Integer;
 986 begin
 987   if mDragging then
 988   begin
 989     drawRectUI(mX+4, mY+4, mWidth-8, mHeight-8, r, g, b);
 990   end
 991   else
 992   begin
 993     drawRectUI(mX+3, mY+3, mWidth-6, mHeight-6, r, g, b);
 994     drawRectUI(mX+5, mY+5, mWidth-10, mHeight-10, r, g, b);
 995     setScissor(mFrameWidth, 0, 3*8, 8);
 996     fillRect(mX+mFrameWidth, mY, 3*8, 8, 0, 0, 128);
 997     drawText8(mX+mFrameWidth, mY, '[ ]', r, g, b);
 998     if mInClose then drawText8(mX+mFrameWidth+7, mY, '#', 0, 255, 0)
 999     else drawText8(mX+mFrameWidth+7, mY, '*', 0, 255, 0);
1000   end;
1001   if (Length(mTitle) > 0) then
1002   begin
1003     setScissor(mFrameWidth+3*8, 0, mWidth-mFrameWidth*2-3*8, 8);
1004     tx := (mX+3*8)+((mWidth-3*8)-Length(mTitle)*8) div 2;
1005     fillRect(tx-3, mY, Length(mTitle)*8+3+2, 8, 0, 0, 128);
1006     drawText8(tx, mY, mTitle, r, g, b);
1007   end;
1008   inherited drawControlPost(sx, sy);
1009 end;
1010
1011
1012 procedure THTopWindow.blurred ();
1013 begin
1014   mDragging := false;
1015   mWaitingClose := false;
1016   mInClose := false;
1017   inherited;
1018 end;
1019
1020
1021 function THTopWindow.keyEvent (var ev: THKeyEvent): Boolean;
1022 begin
1023   result := inherited keyEvent(ev);
1024   if not getFocused then exit;
1025   if (ev = 'M-F3') then
1026   begin
1027     uiRemoveWindow(self);
1028     result := true;
1029     exit;
1030   end;
1031 end;
1032
1033
1034 function THTopWindow.mouseEvent (var ev: THMouseEvent): Boolean;
1035 var
1036   lx, ly: Integer;
1037 begin
1038   result := false;
1039   if not mEnabled then exit;
1040   if (mWidth < 1) or (mHeight < 1) then exit;
1041
1042   if mDragging then
1043   begin
1044     mX += ev.x-mDragStartX;
1045     mY += ev.y-mDragStartY;
1046     mDragStartX := ev.x;
1047     mDragStartY := ev.y;
1048     if (ev.release) then mDragging := false;
1049     result := true;
1050     exit;
1051   end;
1052
1053   lx := ev.x;
1054   ly := ev.y;
1055   if toLocal(lx, ly) then
1056   begin
1057     if (ev.press) then
1058     begin
1059       if (ly < 8) then
1060       begin
1061         if (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
1062         begin
1063           //uiRemoveWindow(self);
1064           mWaitingClose := true;
1065           mInClose := true;
1066         end
1067         else
1068         begin
1069           mDragging := true;
1070           mDragStartX := ev.x;
1071           mDragStartY := ev.y;
1072         end;
1073         result := true;
1074         exit;
1075       end;
1076       if (lx < mFrameWidth) or (lx >= mWidth-mFrameWidth) or (ly >= mHeight-mFrameHeight) then
1077       begin
1078         mDragging := true;
1079         mDragStartX := ev.x;
1080         mDragStartY := ev.y;
1081         result := true;
1082         exit;
1083       end;
1084     end;
1085
1086     if (ev.release) then
1087     begin
1088       if mWaitingClose and (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
1089       begin
1090         uiRemoveWindow(self);
1091         result := true;
1092         exit;
1093       end;
1094       mWaitingClose := false;
1095       mInClose := false;
1096     end;
1097
1098     if (ev.motion) then
1099     begin
1100       if mWaitingClose then
1101       begin
1102         mInClose := (lx >= mFrameWidth) and (lx < mFrameWidth+3*8);
1103         result := true;
1104         exit;
1105       end;
1106     end;
1107   end
1108   else
1109   begin
1110     mInClose := false;
1111     if (not ev.motion) then mWaitingClose := false;
1112   end;
1113
1114   result := inherited mouseEvent(ev);
1115 end;
1116
1117
1118 // ////////////////////////////////////////////////////////////////////////// //
1119 constructor THCtlSimpleText.Create (ax, ay: Integer; aparent: THControl=nil);
1120 begin
1121   mItems := nil;
1122   inherited Create(ax, ay, 4, 4);
1123 end;
1124
1125
1126 destructor THCtlSimpleText.Destroy ();
1127 begin
1128   mItems := nil;
1129   inherited;
1130 end;
1131
1132
1133 procedure THCtlSimpleText.appendItem (const atext: AnsiString; acentered: Boolean=false; ahline: Boolean=false);
1134 var
1135   it: PItem;
1136 begin
1137   if (Length(atext)*8+3*8+2 > mWidth) then mWidth := Length(atext)*8+3*8+2;
1138   SetLength(mItems, Length(mItems)+1);
1139   it := @mItems[High(mItems)];
1140   it.title := atext;
1141   it.centered := acentered;
1142   it.hline := ahline;
1143   if (Length(mItems)*8 > mHeight) then mHeight := Length(mItems)*8;
1144 end;
1145
1146
1147 procedure THCtlSimpleText.drawControl (sx, sy: Integer);
1148 var
1149   f, tx: Integer;
1150   it: PItem;
1151   r, g, b: Integer;
1152 begin
1153   for f := 0 to High(mItems) do
1154   begin
1155     it := @mItems[f];
1156     tx := sx;
1157     r := 255;
1158     g := 255;
1159     b := 0;
1160     if it.centered then begin b := 255; tx := sx+(mWidth-Length(it.title)*8) div 2; end;
1161     if it.hline then
1162     begin
1163       b := 255;
1164       if (Length(it.title) = 0) then
1165       begin
1166         drawHLine(sx+4, sy+3, mWidth-8, r, g, b);
1167       end
1168       else if (tx-3 > sx+4) then
1169       begin
1170         drawHLine(sx+4, sy+3, tx-3-(sx+3), r, g, b);
1171         drawHLine(tx+Length(it.title)*8, sy+3, mWidth-4, r, g, b);
1172       end;
1173     end;
1174     drawText8(tx, sy, it.title, r, g, b);
1175     Inc(sy, 8);
1176   end;
1177 end;
1178
1179
1180 function THCtlSimpleText.mouseEvent (var ev: THMouseEvent): Boolean;
1181 var
1182   lx, ly: Integer;
1183 begin
1184   result := inherited mouseEvent(ev);
1185   lx := ev.x;
1186   ly := ev.y;
1187   if not result and toLocal(lx, ly) then
1188   begin
1189     result := true;
1190   end;
1191 end;
1192
1193
1194 function THCtlSimpleText.keyEvent (var ev: THKeyEvent): Boolean;
1195 begin
1196   result := inherited keyEvent(ev);
1197 end;
1198
1199
1200 // ////////////////////////////////////////////////////////////////////////// //
1201 constructor THCtlCBListBox.Create (ax, ay: Integer; aparent: THControl=nil);
1202 begin
1203   mItems := nil;
1204   mCurIndex := -1;
1205   inherited Create(ax, ay, 4, 4);
1206 end;
1207
1208
1209 destructor THCtlCBListBox.Destroy ();
1210 begin
1211   mItems := nil;
1212   inherited;
1213 end;
1214
1215
1216 procedure THCtlCBListBox.appendItem (const atext: AnsiString; bv: PBoolean; aaction: TActionCB=nil);
1217 var
1218   it: PItem;
1219 begin
1220   if (Length(atext)*8+3*8+2 > mWidth) then mWidth := Length(atext)*8+3*8+2;
1221   SetLength(mItems, Length(mItems)+1);
1222   it := @mItems[High(mItems)];
1223   it.title := atext;
1224   it.varp := bv;
1225   it.actionCB := aaction;
1226   if (Length(mItems)*8 > mHeight) then mHeight := Length(mItems)*8;
1227   if (mCurIndex < 0) then mCurIndex := 0;
1228 end;
1229
1230
1231 procedure THCtlCBListBox.drawControl (sx, sy: Integer);
1232 var
1233   f, tx: Integer;
1234   it: PItem;
1235 begin
1236   for f := 0 to High(mItems) do
1237   begin
1238     it := @mItems[f];
1239     if (mCurIndex = f) then fillRect(sx, sy, mWidth, 8, 0, 128, 0);
1240     if (it.varp <> nil) then
1241     begin
1242       if it.varp^ then drawText8(sx, sy, '[x]', 255, 255, 255) else drawText8(sx, sy, '[ ]', 255, 255, 255);
1243       drawText8(sx+3*8+2, sy, it.title, 255, 255, 0);
1244     end
1245     else if (Length(it.title) > 0) then
1246     begin
1247       tx := sx+(mWidth-Length(it.title)*8) div 2;
1248       if (tx-3 > sx+4) then
1249       begin
1250         drawHLine(sx+4, sy+3, tx-3-(sx+3), 255, 255, 255);
1251         drawHLine(tx+Length(it.title)*8, sy+3, mWidth-4, 255, 255, 255);
1252       end;
1253       drawText8(tx, sy, it.title, 255, 255, 255);
1254     end
1255     else
1256     begin
1257       drawHLine(sx+4, sy+3, mWidth-8, 255, 255, 255);
1258     end;
1259     Inc(sy, 8);
1260   end;
1261 end;
1262
1263
1264 function THCtlCBListBox.mouseEvent (var ev: THMouseEvent): Boolean;
1265 var
1266   lx, ly: Integer;
1267   it: PItem;
1268 begin
1269   result := inherited mouseEvent(ev);
1270   lx := ev.x;
1271   ly := ev.y;
1272   if not result and toLocal(lx, ly) then
1273   begin
1274     result := true;
1275     if (ev = 'lmb') then
1276     begin
1277       ly := ly div 8;
1278       if (ly >= 0) and (ly < Length(mItems)) then
1279       begin
1280         it := @mItems[ly];
1281         if (it.varp <> nil) then
1282         begin
1283           mCurIndex := ly;
1284           it.varp^ := not it.varp^;
1285           if assigned(it.actionCB) then it.actionCB(self, Integer(it.varp^));
1286           if assigned(actionCB) then actionCB(self, ly);
1287         end;
1288       end;
1289     end;
1290   end;
1291 end;
1292
1293
1294 function THCtlCBListBox.keyEvent (var ev: THKeyEvent): Boolean;
1295 var
1296   it: PItem;
1297 begin
1298   result := inherited keyEvent(ev);
1299   if not getFocused then exit;
1300   //result := true;
1301   if (ev = 'Home') or (ev = 'PageUp') then
1302   begin
1303     result := true;
1304     mCurIndex := 0;
1305   end;
1306   if (ev = 'End') or (ev = 'PageDown') then
1307   begin
1308     result := true;
1309     mCurIndex := High(mItems);
1310   end;
1311   if (ev = 'Up') then
1312   begin
1313     result := true;
1314     if (Length(mItems) > 0) then
1315     begin
1316       if (mCurIndex < 0) then mCurIndex := Length(mItems);
1317       while (mCurIndex > 0) do
1318       begin
1319         Dec(mCurIndex);
1320         if (mItems[mCurIndex].varp <> nil) then break;
1321       end;
1322     end
1323     else
1324     begin
1325       mCurIndex := -1;
1326     end;
1327   end;
1328   if (ev = 'Down') then
1329   begin
1330     result := true;
1331     if (Length(mItems) > 0) then
1332     begin
1333       if (mCurIndex < 0) then mCurIndex := -1;
1334       while (mCurIndex < High(mItems)) do
1335       begin
1336         Inc(mCurIndex);
1337         if (mItems[mCurIndex].varp <> nil) then break;
1338       end;
1339     end
1340     else
1341     begin
1342       mCurIndex := -1;
1343     end;
1344   end;
1345   if (ev = 'Space') or (ev = 'Enter') then
1346   begin
1347     result := true;
1348     if (mCurIndex >= 0) and (mCurIndex < Length(mItems)) and (mItems[mCurIndex].varp <> nil) then
1349     begin
1350       it := @mItems[mCurIndex];
1351       it.varp^ := not it.varp^;
1352       if assigned(it.actionCB) then it.actionCB(self, Integer(it.varp^));
1353       if assigned(actionCB) then actionCB(self, mCurIndex);
1354     end;
1355   end;
1356 end;
1357
1358
1359 end.