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