src/game/g_holmes_ui.inc

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