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