src/game/g_gui.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 g_gui;
  18
  19 interface
  20
  21 uses
  22   {$IFDEF USE_MEMPOOL}mempool,{$ENDIF}
  23   e_graphics, e_input, e_log, g_playermodel, g_basic, MAPDEF, utils;
  24
  25 const
  26   MAINMENU_HEADER_COLOR: TRGB = (R:255; G:255; B:255);
  27   MAINMENU_ITEMS_COLOR: TRGB = (R:255; G:255; B:255);
  28   MAINMENU_UNACTIVEITEMS_COLOR: TRGB = (R:192; G:192; B:192);
  29   MAINMENU_CLICKSOUND = 'MENU_SELECT';
  30   MAINMENU_CHANGESOUND = 'MENU_CHANGE';
  31   MAINMENU_SPACE = 4;
  32   MAINMENU_MARKER1 = 'MAINMENU_MARKER1';
  33   MAINMENU_MARKER2 = 'MAINMENU_MARKER2';
  34   MAINMENU_MARKERDELAY = 24;
  35   WINDOW_CLOSESOUND = 'MENU_CLOSE';
  36   MENU_HEADERCOLOR: TRGB = (R:255; G:255; B:255);
  37   MENU_ITEMSTEXT_COLOR: TRGB = (R:255; G:255; B:255);
  38   MENU_UNACTIVEITEMS_COLOR: TRGB = (R:128; G:128; B:128);
  39   MENU_ITEMSCTRL_COLOR: TRGB = (R:255; G:0; B:0);
  40   MENU_VSPACE = 2;
  41   MENU_HSPACE = 32;
  42   MENU_CLICKSOUND = 'MENU_SELECT';
  43   MENU_CHANGESOUND = 'MENU_CHANGE';
  44   MENU_MARKERDELAY = 24;
  45   SCROLL_LEFT = 'SCROLL_LEFT';
  46   SCROLL_RIGHT = 'SCROLL_RIGHT';
  47   SCROLL_MIDDLE = 'SCROLL_MIDDLE';
  48   SCROLL_MARKER = 'SCROLL_MARKER';
  49   SCROLL_ADDSOUND = 'SCROLL_ADD';
  50   SCROLL_SUBSOUND = 'SCROLL_SUB';
  51   EDIT_LEFT = 'EDIT_LEFT';
  52   EDIT_RIGHT = 'EDIT_RIGHT';
  53   EDIT_MIDDLE = 'EDIT_MIDDLE';
  54   EDIT_CURSORCOLOR: TRGB = (R:200; G:0; B:0);
  55   EDIT_CURSORLEN = 10;
  56   KEYREAD_QUERY = '<...>';
  57   KEYREAD_CLEAR = '???';
  58   KEYREAD_TIMEOUT = 24;
  59   MAPPREVIEW_WIDTH = 8;
  60   MAPPREVIEW_HEIGHT = 8;
  61   BOX1 = 'BOX1';
  62   BOX2 = 'BOX2';
  63   BOX3 = 'BOX3';
  64   BOX4 = 'BOX4';
  65   BOX5 = 'BOX5';
  66   BOX6 = 'BOX6';
  67   BOX7 = 'BOX7';
  68   BOX8 = 'BOX8';
  69   BOX9 = 'BOX9';
  70   BSCROLL_UPA = 'BSCROLL_UP_A';
  71   BSCROLL_UPU = 'BSCROLL_UP_U';
  72   BSCROLL_DOWNA = 'BSCROLL_DOWN_A';
  73   BSCROLL_DOWNU = 'BSCROLL_DOWN_U';
  74   BSCROLL_MIDDLE = 'BSCROLL_MIDDLE';
  75   WM_KEYDOWN = 101;
  76   WM_CHAR    = 102;
  77   WM_USER    = 110;
  78
  79 type
  80   TMessage = record
  81     Msg: DWORD;
  82     wParam: LongInt;
  83     lParam: LongInt;
  84   end;
  85
  86   TFontType = (Texture, Character);
  87
  88   TFont = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
  89   private
  90     ID: DWORD;
  91     FScale: Single;
  92     FFontType: TFontType;
  93   public
  94     constructor Create(FontID: DWORD; FontType: TFontType);
  95     destructor Destroy; override;
  96     procedure Draw(X, Y: Integer; Text: string; R, G, B: Byte);
  97     procedure GetTextSize(Text: string; var w, h: Word);
  98     property Scale: Single read FScale write FScale;
  99   end;
 100
 101   TGUIControl = class;
 102   TGUIWindow = class;
 103
 104   TOnKeyDownEvent = procedure(Key: Byte);
 105   TOnKeyDownEventEx = procedure(win: TGUIWindow; Key: Byte);
 106   TOnCloseEvent = procedure;
 107   TOnShowEvent = procedure;
 108   TOnClickEvent = procedure;
 109   TOnChangeEvent = procedure(Sender: TGUIControl);
 110   TOnEnterEvent = procedure(Sender: TGUIControl);
 111
 112   TGUIControl = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
 113   private
 114     FX, FY: Integer;
 115     FEnabled: Boolean;
 116     FWindow : TGUIWindow;
 117     FName: string;
 118     FUserData: Pointer;
 119     FRightAlign: Boolean; //HACK! this works only for "normal" menus, only for menu text labels, and generally sux. sorry.
 120     FMaxWidth: Integer; //HACK! used for right-aligning labels
 121   public
 122     constructor Create;
 123     procedure OnMessage(var Msg: TMessage); virtual;
 124     procedure Update; virtual;
 125     procedure Draw; virtual;
 126     function GetWidth(): Integer; virtual;
 127     function GetHeight(): Integer; virtual;
 128     function WantActivationKey (key: LongInt): Boolean; virtual;
 129     property X: Integer read FX write FX;
 130     property Y: Integer read FY write FY;
 131     property Enabled: Boolean read FEnabled write FEnabled;
 132     property Name: string read FName write FName;
 133     property UserData: Pointer read FUserData write FUserData;
 134     property RightAlign: Boolean read FRightAlign write FRightAlign; // for menu
 135   end;
 136
 137   TGUIWindow = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
 138   private
 139     FActiveControl: TGUIControl;
 140     FDefControl: string;
 141     FPrevWindow: TGUIWindow;
 142     FName: string;
 143     FBackTexture: string;
 144     FMainWindow: Boolean;
 145     FOnKeyDown: TOnKeyDownEvent;
 146     FOnKeyDownEx: TOnKeyDownEventEx;
 147     FOnCloseEvent: TOnCloseEvent;
 148     FOnShowEvent: TOnShowEvent;
 149     FUserData: Pointer;
 150   public
 151     Childs: array of TGUIControl;
 152     constructor Create(Name: string);
 153     destructor Destroy; override;
 154     function AddChild(Child: TGUIControl): TGUIControl;
 155     procedure OnMessage(var Msg: TMessage);
 156     procedure Update;
 157     procedure Draw;
 158     procedure SetActive(Control: TGUIControl);
 159     function GetControl(Name: string): TGUIControl;
 160     property OnKeyDown: TOnKeyDownEvent read FOnKeyDown write FOnKeyDown;
 161     property OnKeyDownEx: TOnKeyDownEventEx read FOnKeyDownEx write FOnKeyDownEx;
 162     property OnClose: TOnCloseEvent read FOnCloseEvent write FOnCloseEvent;
 163     property OnShow: TOnShowEvent read FOnShowEvent write FOnShowEvent;
 164     property Name: string read FName;
 165     property DefControl: string read FDefControl write FDefControl;
 166     property BackTexture: string read FBackTexture write FBackTexture;
 167     property MainWindow: Boolean read FMainWindow write FMainWindow;
 168     property UserData: Pointer read FUserData write FUserData;
 169   end;
 170
 171   TGUITextButton = class(TGUIControl)
 172   private
 173     FText: string;
 174     FColor: TRGB;
 175     FFont: TFont;
 176     FSound: string;
 177     FShowWindow: string;
 178   public
 179     Proc: procedure;
 180     ProcEx: procedure (sender: TGUITextButton);
 181     constructor Create(aProc: Pointer; FontID: DWORD; Text: string);
 182     destructor Destroy(); override;
 183     procedure OnMessage(var Msg: TMessage); override;
 184     procedure Update(); override;
 185     procedure Draw(); override;
 186     function GetWidth(): Integer; override;
 187     function GetHeight(): Integer; override;
 188     procedure Click(Silent: Boolean = False);
 189     property Caption: string read FText write FText;
 190     property Color: TRGB read FColor write FColor;
 191     property Font: TFont read FFont write FFont;
 192     property ShowWindow: string read FShowWindow write FShowWindow;
 193   end;
 194
 195   TGUILabel = class(TGUIControl)
 196   private
 197     FText: string;
 198     FColor: TRGB;
 199     FFont: TFont;
 200     FFixedLen: Word;
 201     FOnClickEvent: TOnClickEvent;
 202   public
 203     constructor Create(Text: string; FontID: DWORD);
 204     procedure OnMessage(var Msg: TMessage); override;
 205     procedure Draw; override;
 206     function GetWidth: Integer; override;
 207     function GetHeight: Integer; override;
 208     property OnClick: TOnClickEvent read FOnClickEvent write FOnClickEvent;
 209     property FixedLength: Word read FFixedLen write FFixedLen;
 210     property Text: string read FText write FText;
 211     property Color: TRGB read FColor write FColor;
 212     property Font: TFont read FFont write FFont;
 213   end;
 214
 215   TGUIScroll = class(TGUIControl)
 216   private
 217     FValue: Integer;
 218     FMax: Word;
 219     FLeftID: DWORD;
 220     FRightID: DWORD;
 221     FMiddleID: DWORD;
 222     FMarkerID: DWORD;
 223     FOnChangeEvent: TOnChangeEvent;
 224     procedure FSetValue(a: Integer);
 225   public
 226     constructor Create();
 227     procedure OnMessage(var Msg: TMessage); override;
 228     procedure Update; override;
 229     procedure Draw; override;
 230     function GetWidth(): Integer; override;
 231     property OnChange: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent;
 232     property Max: Word read FMax write FMax;
 233     property Value: Integer read FValue write FSetValue;
 234  end;
 235
 236   TGUISwitch = class(TGUIControl)
 237   private
 238     FFont: TFont;
 239     FItems: array of string;
 240     FIndex: Integer;
 241     FColor: TRGB;
 242     FOnChangeEvent: TOnChangeEvent;
 243   public
 244     constructor Create(FontID: DWORD);
 245     procedure OnMessage(var Msg: TMessage); override;
 246     procedure AddItem(Item: string);
 247     procedure Update; override;
 248     procedure Draw; override;
 249     function GetWidth(): Integer; override;
 250     function GetText: string;
 251     property ItemIndex: Integer read FIndex write FIndex;
 252     property Color: TRGB read FColor write FColor;
 253     property Font: TFont read FFont write FFont;
 254     property OnChange: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent;
 255   end;
 256
 257   TGUIEdit = class(TGUIControl)
 258   private
 259     FFont: TFont;
 260     FCaretPos: Integer;
 261     FMaxLength: Word;
 262     FWidth: Word;
 263     FText: string;
 264     FColor: TRGB;
 265     FOnlyDigits: Boolean;
 266     FLeftID: DWORD;
 267     FRightID: DWORD;
 268     FMiddleID: DWORD;
 269     FOnChangeEvent: TOnChangeEvent;
 270     FOnEnterEvent: TOnEnterEvent;
 271     FInvalid: Boolean;
 272     procedure SetText(Text: string);
 273   public
 274     constructor Create(FontID: DWORD);
 275     procedure OnMessage(var Msg: TMessage); override;
 276     procedure Update; override;
 277     procedure Draw; override;
 278     function GetWidth(): Integer; override;
 279     property OnChange: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent;
 280     property OnEnter: TOnEnterEvent read FOnEnterEvent write FOnEnterEvent;
 281     property Width: Word read FWidth write FWidth;
 282     property MaxLength: Word read FMaxLength write FMaxLength;
 283     property OnlyDigits: Boolean read FOnlyDigits write FOnlyDigits;
 284     property Text: string read FText write SetText;
 285     property Color: TRGB read FColor write FColor;
 286     property Font: TFont read FFont write FFont;
 287     property Invalid: Boolean read FInvalid write FInvalid;
 288   end;
 289
 290   TGUIKeyRead = class(TGUIControl)
 291   private
 292     FFont: TFont;
 293     FColor: TRGB;
 294     FKey: Word;
 295     FIsQuery: Boolean;
 296   public
 297     constructor Create(FontID: DWORD);
 298     procedure OnMessage(var Msg: TMessage); override;
 299     procedure Draw; override;
 300     function GetWidth(): Integer; override;
 301     function WantActivationKey (key: LongInt): Boolean; override;
 302     property Key: Word read FKey write FKey;
 303     property Color: TRGB read FColor write FColor;
 304     property Font: TFont read FFont write FFont;
 305   end;
 306
 307   // can hold two keys
 308   TGUIKeyRead2 = class(TGUIControl)
 309   private
 310     FFont: TFont;
 311     FFontID: DWORD;
 312     FColor: TRGB;
 313     FKey0, FKey1: Word; // this should be an array. sorry.
 314     FKeyIdx: Integer;
 315     FIsQuery: Boolean;
 316     FMaxKeyNameWdt: Integer;
 317   public
 318     constructor Create(FontID: DWORD);
 319     procedure OnMessage(var Msg: TMessage); override;
 320     procedure Draw; override;
 321     function GetWidth(): Integer; override;
 322     function WantActivationKey (key: LongInt): Boolean; override;
 323     property Key0: Word read FKey0 write FKey0;
 324     property Key1: Word read FKey1 write FKey1;
 325     property Color: TRGB read FColor write FColor;
 326     property Font: TFont read FFont write FFont;
 327   end;
 328
 329   TGUIModelView = class(TGUIControl)
 330   private
 331     FModel: TPlayerModel;
 332     a: Boolean;
 333   public
 334     constructor Create;
 335     destructor Destroy; override;
 336     procedure OnMessage(var Msg: TMessage); override;
 337     procedure SetModel(ModelName: string);
 338     procedure SetColor(Red, Green, Blue: Byte);
 339     procedure NextAnim();
 340     procedure NextWeapon();
 341     procedure Update; override;
 342     procedure Draw; override;
 343     property  Model: TPlayerModel read FModel;
 344   end;
 345
 346   TPreviewPanel = record
 347     X1, Y1, X2, Y2: Integer;
 348     PanelType: Word;
 349   end;
 350
 351   TGUIMapPreview = class(TGUIControl)
 352   private
 353     FMapData: array of TPreviewPanel;
 354     FMapSize: TDFPoint;
 355     FScale: Single;
 356   public
 357     constructor Create();
 358     destructor Destroy(); override;
 359     procedure OnMessage(var Msg: TMessage); override;
 360     procedure SetMap(Res: string);
 361     procedure ClearMap();
 362     procedure Update(); override;
 363     procedure Draw(); override;
 364     function GetScaleStr: String;
 365   end;
 366
 367   TGUIImage = class(TGUIControl)
 368   private
 369     FImageRes: string;
 370     FDefaultRes: string;
 371   public
 372     constructor Create();
 373     destructor Destroy(); override;
 374     procedure OnMessage(var Msg: TMessage); override;
 375     procedure SetImage(Res: string);
 376     procedure ClearImage();
 377     procedure Update(); override;
 378     procedure Draw(); override;
 379     property DefaultRes: string read FDefaultRes write FDefaultRes;
 380   end;
 381
 382   TGUIListBox = class(TGUIControl)
 383   private
 384     FItems: SSArray;
 385     FActiveColor: TRGB;
 386     FUnActiveColor: TRGB;
 387     FFont: TFont;
 388     FStartLine: Integer;
 389     FIndex: Integer;
 390     FWidth: Word;
 391     FHeight: Word;
 392     FSort: Boolean;
 393     FDrawBack: Boolean;
 394     FDrawScroll: Boolean;
 395     FOnChangeEvent: TOnChangeEvent;
 396
 397     procedure FSetItems(Items: SSArray);
 398     procedure FSetIndex(aIndex: Integer);
 399
 400   public
 401     constructor Create(FontID: DWORD; Width, Height: Word);
 402     procedure OnMessage(var Msg: TMessage); override;
 403     procedure Draw(); override;
 404     procedure AddItem(Item: String);
 405     procedure SelectItem(Item: String);
 406     procedure Clear();
 407     function  GetWidth(): Integer; override;
 408     function  GetHeight(): Integer; override;
 409     function  SelectedItem(): String;
 410
 411     property OnChange: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent;
 412     property Sort: Boolean read FSort write FSort;
 413     property ItemIndex: Integer read FIndex write FSetIndex;
 414     property Items: SSArray read FItems write FSetItems;
 415     property DrawBack: Boolean read FDrawBack write FDrawBack;
 416     property DrawScrollBar: Boolean read FDrawScroll write FDrawScroll;
 417     property ActiveColor: TRGB read FActiveColor write FActiveColor;
 418     property UnActiveColor: TRGB read FUnActiveColor write FUnActiveColor;
 419     property Font: TFont read FFont write FFont;
 420   end;
 421
 422   TGUIFileListBox = class(TGUIListBox)
 423   private
 424     FBasePath: String;
 425     FPath: String;
 426     FFileMask: String;
 427     FDirs: Boolean;
 428
 429     procedure OpenDir(path: String);
 430
 431   public
 432     procedure OnMessage(var Msg: TMessage); override;
 433     procedure SetBase(path: String);
 434     function  SelectedItem(): String;
 435     procedure UpdateFileList();
 436
 437     property Dirs: Boolean read FDirs write FDirs;
 438     property FileMask: String read FFileMask write FFileMask;
 439     property Path: String read FPath;
 440   end;
 441
 442   TGUIMemo = class(TGUIControl)
 443   private
 444     FLines: SSArray;
 445     FFont: TFont;
 446     FStartLine: Integer;
 447     FWidth: Word;
 448     FHeight: Word;
 449     FColor: TRGB;
 450     FDrawBack: Boolean;
 451     FDrawScroll: Boolean;
 452   public
 453     constructor Create(FontID: DWORD; Width, Height: Word);
 454     procedure OnMessage(var Msg: TMessage); override;
 455     procedure Draw; override;
 456     procedure Clear;
 457     function GetWidth(): Integer; override;
 458     function GetHeight(): Integer; override;
 459     procedure SetText(Text: string);
 460     property DrawBack: Boolean read FDrawBack write FDrawBack;
 461     property DrawScrollBar: Boolean read FDrawScroll write FDrawScroll;
 462     property Color: TRGB read FColor write FColor;
 463     property Font: TFont read FFont write FFont;
 464   end;
 465
 466   TGUIMainMenu = class(TGUIControl)
 467   private
 468     FButtons: array of TGUITextButton;
 469     FHeader: TGUILabel;
 470     FIndex: Integer;
 471     FFontID: DWORD;
 472     FCounter: Byte;
 473     FMarkerID1: DWORD;
 474     FMarkerID2: DWORD;
 475   public
 476     constructor Create(FontID: DWORD; Header: string);
 477     destructor Destroy; override;
 478     procedure OnMessage(var Msg: TMessage); override;
 479     function AddButton(fProc: Pointer; Caption: string; ShowWindow: string = ''): TGUITextButton;
 480     function GetButton(aName: string): TGUITextButton;
 481     procedure EnableButton(aName: string; e: Boolean);
 482     procedure AddSpace();
 483     procedure Update; override;
 484     procedure Draw; override;
 485   end;
 486
 487   TControlType = class of TGUIControl;
 488
 489   PMenuItem = ^TMenuItem;
 490   TMenuItem = record
 491     Text: TGUILabel;
 492     ControlType: TControlType;
 493     Control: TGUIControl;
 494   end;
 495
 496   TGUIMenu = class(TGUIControl)
 497   private
 498     FItems: array of TMenuItem;
 499     FHeader: TGUILabel;
 500     FIndex: Integer;
 501     FFontID: DWORD;
 502     FCounter: Byte;
 503     FAlign: Boolean;
 504     FLeft: Integer;
 505     FYesNo: Boolean;
 506     function NewItem(): Integer;
 507   public
 508     constructor Create(HeaderFont, ItemsFont: DWORD; Header: string);
 509     destructor Destroy; override;
 510     procedure OnMessage(var Msg: TMessage); override;
 511     procedure AddSpace();
 512     procedure AddLine(fText: string);
 513     procedure AddText(fText: string; MaxWidth: Word);
 514     function AddLabel(fText: string): TGUILabel;
 515     function AddButton(Proc: Pointer; fText: string; _ShowWindow: string = ''): TGUITextButton;
 516     function AddScroll(fText: string): TGUIScroll;
 517     function AddSwitch(fText: string): TGUISwitch;
 518     function AddEdit(fText: string): TGUIEdit;
 519     function AddKeyRead(fText: string): TGUIKeyRead;
 520     function AddKeyRead2(fText: string): TGUIKeyRead2;
 521     function AddList(fText: string; Width, Height: Word): TGUIListBox;
 522     function AddFileList(fText: string; Width, Height: Word): TGUIFileListBox;
 523     function AddMemo(fText: string; Width, Height: Word): TGUIMemo;
 524     procedure ReAlign();
 525     function GetControl(aName: string): TGUIControl;
 526     function GetControlsText(aName: string): TGUILabel;
 527     procedure Draw; override;
 528     procedure Update; override;
 529     procedure UpdateIndex();
 530     property Align: Boolean read FAlign write FAlign;
 531     property Left: Integer read FLeft write FLeft;
 532     property YesNo: Boolean read FYesNo write FYesNo;
 533   end;
 534
 535 var
 536   g_GUIWindows: array of TGUIWindow;
 537   g_ActiveWindow: TGUIWindow = nil;
 538
 539 procedure g_GUI_Init();
 540 function  g_GUI_AddWindow(Window: TGUIWindow): TGUIWindow;
 541 function  g_GUI_GetWindow(Name: string): TGUIWindow;
 542 procedure g_GUI_ShowWindow(Name: string);
 543 procedure g_GUI_HideWindow(PlaySound: Boolean = True);
 544 function  g_GUI_Destroy(): Boolean;
 545 procedure g_GUI_SaveMenuPos();
 546 procedure g_GUI_LoadMenuPos();
 547
 548
 549 implementation
 550
 551 uses
 552   GL, GLExt, g_textures, g_sound, SysUtils,
 553   g_game, Math, StrUtils, g_player, g_options,
 554   g_map, g_weapons, xdynrec, wadreader;
 555
 556
 557 var
 558   Box: Array [0..8] of DWORD;
 559   Saved_Windows: SSArray;
 560
 561
 562 procedure g_GUI_Init();
 563 begin
 564   g_Texture_Get(BOX1, Box[0]);
 565   g_Texture_Get(BOX2, Box[1]);
 566   g_Texture_Get(BOX3, Box[2]);
 567   g_Texture_Get(BOX4, Box[3]);
 568   g_Texture_Get(BOX5, Box[4]);
 569   g_Texture_Get(BOX6, Box[5]);
 570   g_Texture_Get(BOX7, Box[6]);
 571   g_Texture_Get(BOX8, Box[7]);
 572   g_Texture_Get(BOX9, Box[8]);
 573 end;
 574
 575 function g_GUI_Destroy(): Boolean;
 576 var
 577   i: Integer;
 578 begin
 579   Result := (Length(g_GUIWindows) > 0);
 580
 581   for i := 0 to High(g_GUIWindows) do
 582     g_GUIWindows[i].Free();
 583
 584   g_GUIWindows := nil;
 585   g_ActiveWindow := nil;
 586 end;
 587
 588 function g_GUI_AddWindow(Window: TGUIWindow): TGUIWindow;
 589 begin
 590   SetLength(g_GUIWindows, Length(g_GUIWindows)+1);
 591   g_GUIWindows[High(g_GUIWindows)] := Window;
 592
 593   Result := Window;
 594 end;
 595
 596 function g_GUI_GetWindow(Name: string): TGUIWindow;
 597 var
 598   i: Integer;
 599 begin
 600   Result := nil;
 601
 602   if g_GUIWindows <> nil then
 603     for i := 0 to High(g_GUIWindows) do
 604       if g_GUIWindows[i].FName = Name then
 605       begin
 606         Result := g_GUIWindows[i];
 607         Break;
 608       end;
 609
 610   Assert(Result <> nil, 'GUI_Window "'+Name+'" not found');
 611 end;
 612
 613 procedure g_GUI_ShowWindow(Name: string);
 614 var
 615   i: Integer;
 616 begin
 617   if g_GUIWindows = nil then
 618     Exit;
 619
 620   for i := 0 to High(g_GUIWindows) do
 621     if g_GUIWindows[i].FName = Name then
 622     begin
 623       g_GUIWindows[i].FPrevWindow := g_ActiveWindow;
 624       g_ActiveWindow := g_GUIWindows[i];
 625
 626       if g_ActiveWindow.MainWindow then
 627         g_ActiveWindow.FPrevWindow := nil;
 628
 629       if g_ActiveWindow.FDefControl <> '' then
 630         g_ActiveWindow.SetActive(g_ActiveWindow.GetControl(g_ActiveWindow.FDefControl))
 631       else
 632         g_ActiveWindow.SetActive(nil);
 633
 634       if @g_ActiveWindow.FOnShowEvent <> nil then
 635         g_ActiveWindow.FOnShowEvent();
 636
 637       Break;
 638     end;
 639 end;
 640
 641 procedure g_GUI_HideWindow(PlaySound: Boolean = True);
 642 begin
 643   if g_ActiveWindow <> nil then
 644   begin
 645     if @g_ActiveWindow.OnClose <> nil then
 646       g_ActiveWindow.OnClose();
 647     g_ActiveWindow := g_ActiveWindow.FPrevWindow;
 648     if PlaySound then
 649       g_Sound_PlayEx(WINDOW_CLOSESOUND);
 650   end;
 651 end;
 652
 653 procedure g_GUI_SaveMenuPos();
 654 var
 655   len: Integer;
 656   win: TGUIWindow;
 657 begin
 658   SetLength(Saved_Windows, 0);
 659   win := g_ActiveWindow;
 660
 661   while win <> nil do
 662   begin
 663     len := Length(Saved_Windows);
 664     SetLength(Saved_Windows, len + 1);
 665
 666     Saved_Windows[len] := win.Name;
 667
 668     if win.MainWindow then
 669       win := nil
 670     else
 671       win := win.FPrevWindow;
 672   end;
 673 end;
 674
 675 procedure g_GUI_LoadMenuPos();
 676 var
 677   i, j, k, len: Integer;
 678   ok: Boolean;
 679 begin
 680   g_ActiveWindow := nil;
 681   len := Length(Saved_Windows);
 682
 683   if len = 0 then
 684     Exit;
 685
 686 // Îêíî ñ ãëàâíûì ìåíþ:
 687   g_GUI_ShowWindow(Saved_Windows[len-1]);
 688
 689 // Íå ïåðåêëþ÷èëîñü (èëè íåêóäà äàëüøå):
 690   if (len = 1) or (g_ActiveWindow = nil) then
 691     Exit;
 692
 693 // Èùåì êíîïêè â îñòàëüíûõ îêíàõ:
 694   for k := len-1 downto 1 do
 695   begin
 696     ok := False;
 697
 698     for i := 0 to Length(g_ActiveWindow.Childs)-1 do
 699     begin
 700       if g_ActiveWindow.Childs[i] is TGUIMainMenu then
 701         begin // GUI_MainMenu
 702           with TGUIMainMenu(g_ActiveWindow.Childs[i]) do
 703             for j := 0 to Length(FButtons)-1 do
 704               if FButtons[j].ShowWindow = Saved_Windows[k-1] then
 705               begin
 706                 FButtons[j].Click(True);
 707                 ok := True;
 708                 Break;
 709               end;
 710         end
 711       else // GUI_Menu
 712         if g_ActiveWindow.Childs[i] is TGUIMenu then
 713           with TGUIMenu(g_ActiveWindow.Childs[i]) do
 714             for j := 0 to Length(FItems)-1 do
 715               if FItems[j].ControlType = TGUITextButton then
 716                 if TGUITextButton(FItems[j].Control).ShowWindow = Saved_Windows[k-1] then
 717                 begin
 718                   TGUITextButton(FItems[j].Control).Click(True);
 719                   ok := True;
 720                   Break;
 721                 end;
 722
 723       if ok then
 724         Break;
 725     end;
 726
 727   // Íå ïåðåêëþ÷èëîñü:
 728     if (not ok) or
 729        (g_ActiveWindow.Name = Saved_Windows[k]) then
 730       Break;
 731   end;
 732 end;
 733
 734 procedure DrawBox(X, Y: Integer; Width, Height: Word);
 735 begin
 736   e_Draw(Box[0], X, Y, 0, False, False);
 737   e_DrawFill(Box[1], X+4, Y, Width*4, 1, 0, False, False);
 738   e_Draw(Box[2], X+4+Width*16, Y, 0, False, False);
 739   e_DrawFill(Box[3], X, Y+4, 1, Height*4, 0, False, False);
 740   e_DrawFill(Box[4], X+4, Y+4, Width, Height, 0, False, False);
 741   e_DrawFill(Box[5], X+4+Width*16, Y+4, 1, Height*4, 0, False, False);
 742   e_Draw(Box[6], X, Y+4+Height*16, 0, False, False);
 743   e_DrawFill(Box[7], X+4, Y+4+Height*16, Width*4, 1, 0, False, False);
 744   e_Draw(Box[8], X+4+Width*16, Y+4+Height*16, 0, False, False);
 745 end;
 746
 747 procedure DrawScroll(X, Y: Integer; Height: Word; Up, Down: Boolean);
 748 var
 749   ID: DWORD;
 750 begin
 751   if Height < 3 then Exit;
 752
 753   if Up then
 754     g_Texture_Get(BSCROLL_UPA, ID)
 755   else
 756     g_Texture_Get(BSCROLL_UPU, ID);
 757   e_Draw(ID, X, Y, 0, False, False);
 758
 759   if Down then
 760     g_Texture_Get(BSCROLL_DOWNA, ID)
 761   else
 762     g_Texture_Get(BSCROLL_DOWNU, ID);
 763   e_Draw(ID, X, Y+(Height-1)*16, 0, False, False);
 764
 765   g_Texture_Get(BSCROLL_MIDDLE, ID);
 766   e_DrawFill(ID, X, Y+16, 1, Height-2, 0, False, False);
 767 end;
 768
 769 { TGUIWindow }
 770
 771 constructor TGUIWindow.Create(Name: string);
 772 begin
 773   Childs := nil;
 774   FActiveControl := nil;
 775   FName := Name;
 776   FOnKeyDown := nil;
 777   FOnKeyDownEx := nil;
 778   FOnCloseEvent := nil;
 779   FOnShowEvent := nil;
 780 end;
 781
 782 destructor TGUIWindow.Destroy;
 783 var
 784   i: Integer;
 785 begin
 786   if Childs = nil then
 787     Exit;
 788
 789   for i := 0 to High(Childs) do
 790     Childs[i].Free();
 791 end;
 792
 793 function TGUIWindow.AddChild(Child: TGUIControl): TGUIControl;
 794 begin
 795   Child.FWindow := Self;
 796
 797   SetLength(Childs, Length(Childs) + 1);
 798   Childs[High(Childs)] := Child;
 799
 800   Result := Child;
 801 end;
 802
 803 procedure TGUIWindow.Update;
 804 var
 805   i: Integer;
 806 begin
 807   for i := 0 to High(Childs) do
 808     if Childs[i] <> nil then Childs[i].Update;
 809 end;
 810
 811 procedure TGUIWindow.Draw;
 812 var
 813   i: Integer;
 814   ID: DWORD;
 815 begin
 816   if FBackTexture <> '' then
 817     if g_Texture_Get(FBackTexture, ID) then
 818       e_DrawSize(ID, 0, 0, 0, False, False, gScreenWidth, gScreenHeight)
 819     else
 820       e_Clear(GL_COLOR_BUFFER_BIT, 0.5, 0.5, 0.5);
 821
 822   for i := 0 to High(Childs) do
 823     if Childs[i] <> nil then Childs[i].Draw;
 824 end;
 825
 826 procedure TGUIWindow.OnMessage(var Msg: TMessage);
 827 begin
 828   if FActiveControl <> nil then FActiveControl.OnMessage(Msg);
 829   if @FOnKeyDown <> nil then FOnKeyDown(Msg.wParam);
 830   if @FOnKeyDownEx <> nil then FOnKeyDownEx(self, Msg.wParam);
 831
 832   if Msg.Msg = WM_KEYDOWN then
 833     if Msg.wParam = IK_ESCAPE then
 834     begin
 835       g_GUI_HideWindow;
 836       Exit;
 837     end;
 838 end;
 839
 840 procedure TGUIWindow.SetActive(Control: TGUIControl);
 841 begin
 842   FActiveControl := Control;
 843 end;
 844
 845 function TGUIWindow.GetControl(Name: String): TGUIControl;
 846 var
 847   i: Integer;
 848 begin
 849   Result := nil;
 850
 851   if Childs <> nil then
 852     for i := 0 to High(Childs) do
 853       if Childs[i] <> nil then
 854         if LowerCase(Childs[i].FName) = LowerCase(Name) then
 855         begin
 856           Result := Childs[i];
 857           Break;
 858         end;
 859
 860   Assert(Result <> nil, 'Window Control "'+Name+'" not Found!');
 861 end;
 862
 863 { TGUIControl }
 864
 865 constructor TGUIControl.Create();
 866 begin
 867   FX := 0;
 868   FY := 0;
 869
 870   FEnabled := True;
 871   FRightAlign := false;
 872   FMaxWidth := -1;
 873 end;
 874
 875 procedure TGUIControl.OnMessage(var Msg: TMessage);
 876 begin
 877   if not FEnabled then
 878     Exit;
 879 end;
 880
 881 procedure TGUIControl.Update();
 882 begin
 883 end;
 884
 885 procedure TGUIControl.Draw();
 886 begin
 887 end;
 888
 889 function TGUIControl.WantActivationKey (key: LongInt): Boolean;
 890 begin
 891   result := false;
 892 end;
 893
 894 function TGUIControl.GetWidth(): Integer;
 895 begin
 896   result := 0;
 897 end;
 898
 899 function TGUIControl.GetHeight(): Integer;
 900 begin
 901   result := 0;
 902 end;
 903
 904 { TGUITextButton }
 905
 906 procedure TGUITextButton.Click(Silent: Boolean = False);
 907 begin
 908   if (FSound <> '') and (not Silent) then g_Sound_PlayEx(FSound);
 909
 910   if @Proc <> nil then Proc();
 911   if @ProcEx <> nil then ProcEx(self);
 912
 913   if FShowWindow <> '' then g_GUI_ShowWindow(FShowWindow);
 914 end;
 915
 916 constructor TGUITextButton.Create(aProc: Pointer; FontID: DWORD; Text: string);
 917 begin
 918   inherited Create();
 919
 920   Self.Proc := aProc;
 921   ProcEx := nil;
 922
 923   FFont := TFont.Create(FontID, TFontType.Character);
 924
 925   FText := Text;
 926 end;
 927
 928 destructor TGUITextButton.Destroy;
 929 begin
 930
 931  inherited;
 932 end;
 933
 934 procedure TGUITextButton.Draw;
 935 begin
 936   FFont.Draw(FX, FY, FText, FColor.R, FColor.G, FColor.B)
 937 end;
 938
 939 function TGUITextButton.GetHeight: Integer;
 940 var
 941   w, h: Word;
 942 begin
 943   FFont.GetTextSize(FText, w, h);
 944   Result := h;
 945 end;
 946
 947 function TGUITextButton.GetWidth: Integer;
 948 var
 949   w, h: Word;
 950 begin
 951   FFont.GetTextSize(FText, w, h);
 952   Result := w;
 953 end;
 954
 955 procedure TGUITextButton.OnMessage(var Msg: TMessage);
 956 begin
 957   if not FEnabled then Exit;
 958
 959   inherited;
 960
 961   case Msg.Msg of
 962     WM_KEYDOWN:
 963       case Msg.wParam of
 964         IK_RETURN, IK_KPRETURN: Click();
 965       end;
 966   end;
 967 end;
 968
 969 procedure TGUITextButton.Update;
 970 begin
 971   inherited;
 972 end;
 973
 974 { TFont }
 975
 976 constructor TFont.Create(FontID: DWORD; FontType: TFontType);
 977 begin
 978   ID := FontID;
 979
 980   FScale := 1;
 981   FFontType := FontType;
 982 end;
 983
 984 destructor TFont.Destroy;
 985 begin
 986
 987   inherited;
 988 end;
 989
 990 procedure TFont.Draw(X, Y: Integer; Text: string; R, G, B: Byte);
 991 begin
 992   if FFontType = TFontType.Character then e_CharFont_PrintEx(ID, X, Y, Text, _RGB(R, G, B), FScale)
 993   else e_TextureFontPrintEx(X, Y, Text, ID, R, G, B, FScale);
 994 end;
 995
 996 procedure TFont.GetTextSize(Text: string; var w, h: Word);
 997 var
 998   cw, ch: Byte;
 999 begin
1000   if FFontType = TFontType.Character then e_CharFont_GetSize(ID, Text, w, h)
1001   else
1002   begin
1003     e_TextureFontGetSize(ID, cw, ch);
1004     w := cw*Length(Text);
1005     h := ch;
1006   end;
1007
1008   w := Round(w*FScale);
1009   h := Round(h*FScale);
1010 end;
1011
1012 { TGUIMainMenu }
1013
1014 function TGUIMainMenu.AddButton(fProc: Pointer; Caption: string; ShowWindow: string = ''): TGUITextButton;
1015 var
1016   a, _x: Integer;
1017   h, hh: Word;
1018 begin
1019   FIndex := 0;
1020
1021   SetLength(FButtons, Length(FButtons)+1);
1022   FButtons[High(FButtons)] := TGUITextButton.Create(fProc, FFontID, Caption);
1023   FButtons[High(FButtons)].ShowWindow := ShowWindow;
1024   with FButtons[High(FButtons)] do
1025   begin
1026     if (fProc <> nil) or (ShowWindow <> '') then FColor := MAINMENU_ITEMS_COLOR
1027     else FColor := MAINMENU_UNACTIVEITEMS_COLOR;
1028     FSound := MAINMENU_CLICKSOUND;
1029   end;
1030
1031   _x := gScreenWidth div 2;
1032
1033   for a := 0 to High(FButtons) do
1034     if FButtons[a] <> nil then
1035       _x := Min(_x, (gScreenWidth div 2)-(FButtons[a].GetWidth div 2));
1036
1037   hh := FHeader.GetHeight;
1038
1039   h := hh*(2+Length(FButtons))+MAINMENU_SPACE*(Length(FButtons)-1);
1040   h := (gScreenHeight div 2)-(h div 2);
1041
1042   with FHeader do
1043   begin
1044     FX := _x;
1045     FY := h;
1046   end;
1047
1048   Inc(h, hh*2);
1049
1050   for a := 0 to High(FButtons) do
1051   begin
1052     if FButtons[a] <> nil then
1053     with FButtons[a] do
1054     begin
1055       FX := _x;
1056       FY := h;
1057     end;
1058
1059     Inc(h, hh+MAINMENU_SPACE);
1060   end;
1061
1062   Result := FButtons[High(FButtons)];
1063 end;
1064
1065 procedure TGUIMainMenu.AddSpace;
1066 begin
1067   SetLength(FButtons, Length(FButtons)+1);
1068   FButtons[High(FButtons)] := nil;
1069 end;
1070
1071 constructor TGUIMainMenu.Create(FontID: DWORD; Header: string);
1072 begin
1073   inherited Create();
1074
1075   FIndex := -1;
1076   FFontID := FontID;
1077   FCounter := MAINMENU_MARKERDELAY;
1078
1079   g_Texture_Get(MAINMENU_MARKER1, FMarkerID1);
1080   g_Texture_Get(MAINMENU_MARKER2, FMarkerID2);
1081
1082   FHeader := TGUILabel.Create(Header, FFontID);
1083   with FHeader do
1084   begin
1085     FColor := MAINMENU_HEADER_COLOR;
1086     FX := (gScreenWidth div 2)-(GetWidth div 2);
1087     FY := (gScreenHeight div 2)-(GetHeight div 2);
1088   end;
1089 end;
1090
1091 destructor TGUIMainMenu.Destroy;
1092 var
1093   a: Integer;
1094 begin
1095   if FButtons <> nil then
1096     for a := 0 to High(FButtons) do
1097       FButtons[a].Free();
1098
1099   FHeader.Free();
1100
1101   inherited;
1102 end;
1103
1104 procedure TGUIMainMenu.Draw;
1105 var
1106   a: Integer;
1107 begin
1108   inherited;
1109
1110   FHeader.Draw;
1111
1112   if FButtons <> nil then
1113   begin
1114     for a := 0 to High(FButtons) do
1115       if FButtons[a] <> nil then FButtons[a].Draw;
1116
1117     if FIndex <> -1 then
1118       e_Draw(FMarkerID1, FButtons[FIndex].FX-48, FButtons[FIndex].FY, 0, True, False);
1119   end;
1120 end;
1121
1122 procedure TGUIMainMenu.EnableButton(aName: string; e: Boolean);
1123 var
1124   a: Integer;
1125 begin
1126   if FButtons = nil then Exit;
1127
1128   for a := 0 to High(FButtons) do
1129     if (FButtons[a] <> nil) and (FButtons[a].Name = aName) then
1130     begin
1131       if e then FButtons[a].FColor := MAINMENU_ITEMS_COLOR
1132       else FButtons[a].FColor := MAINMENU_UNACTIVEITEMS_COLOR;
1133       FButtons[a].Enabled := e;
1134       Break;
1135     end;
1136 end;
1137
1138 function TGUIMainMenu.GetButton(aName: string): TGUITextButton;
1139 var
1140   a: Integer;
1141 begin
1142   Result := nil;
1143
1144   if FButtons = nil then Exit;
1145
1146   for a := 0 to High(FButtons) do
1147     if (FButtons[a] <> nil) and (FButtons[a].Name = aName) then
1148     begin
1149       Result := FButtons[a];
1150       Break;
1151     end;
1152 end;
1153
1154 procedure TGUIMainMenu.OnMessage(var Msg: TMessage);
1155 var
1156   ok: Boolean;
1157   a: Integer;
1158 begin
1159   if not FEnabled then Exit;
1160
1161   inherited;
1162
1163   if FButtons = nil then Exit;
1164
1165   ok := False;
1166   for a := 0 to High(FButtons) do
1167     if FButtons[a] <> nil then
1168     begin
1169       ok := True;
1170       Break;
1171     end;
1172
1173   if not ok then Exit;
1174
1175   case Msg.Msg of
1176     WM_KEYDOWN:
1177       case Msg.wParam of
1178         IK_UP, IK_KPUP:
1179         begin
1180           repeat
1181             Dec(FIndex);
1182             if FIndex < 0 then FIndex := High(FButtons);
1183           until FButtons[FIndex] <> nil;
1184
1185           g_Sound_PlayEx(MENU_CHANGESOUND);
1186         end;
1187         IK_DOWN, IK_KPDOWN:
1188         begin
1189           repeat
1190             Inc(FIndex);
1191             if FIndex > High(FButtons) then FIndex := 0;
1192           until FButtons[FIndex] <> nil;
1193
1194           g_Sound_PlayEx(MENU_CHANGESOUND);
1195         end;
1196         IK_RETURN, IK_KPRETURN: if (FIndex <> -1) and FButtons[FIndex].FEnabled then FButtons[FIndex].Click;
1197       end;
1198   end;
1199 end;
1200
1201 procedure TGUIMainMenu.Update;
1202 var
1203   t: DWORD;
1204 begin
1205   inherited;
1206
1207   if FCounter = 0 then
1208   begin
1209     t := FMarkerID1;
1210     FMarkerID1 := FMarkerID2;
1211     FMarkerID2 := t;
1212
1213     FCounter := MAINMENU_MARKERDELAY;
1214   end else Dec(FCounter);
1215 end;
1216
1217 { TGUILabel }
1218
1219 constructor TGUILabel.Create(Text: string; FontID: DWORD);
1220 begin
1221   inherited Create();
1222
1223   FFont := TFont.Create(FontID, TFontType.Character);
1224
1225   FText := Text;
1226   FFixedLen := 0;
1227   FOnClickEvent := nil;
1228 end;
1229
1230 procedure TGUILabel.Draw;
1231 var
1232   w, h: Word;
1233 begin
1234   if RightAlign then
1235   begin
1236     FFont.GetTextSize(FText, w, h);
1237     FFont.Draw(FX+FMaxWidth-w, FY, FText, FColor.R, FColor.G, FColor.B);
1238   end
1239   else
1240   begin
1241     FFont.Draw(FX, FY, FText, FColor.R, FColor.G, FColor.B);
1242   end;
1243 end;
1244
1245 function TGUILabel.GetHeight: Integer;
1246 var
1247   w, h: Word;
1248 begin
1249   FFont.GetTextSize(FText, w, h);
1250   Result := h;
1251 end;
1252
1253 function TGUILabel.GetWidth: Integer;
1254 var
1255   w, h: Word;
1256 begin
1257   if FFixedLen = 0 then
1258     FFont.GetTextSize(FText, w, h)
1259   else
1260     w := e_CharFont_GetMaxWidth(FFont.ID)*FFixedLen;
1261   Result := w;
1262 end;
1263
1264 procedure TGUILabel.OnMessage(var Msg: TMessage);
1265 begin
1266   if not FEnabled then Exit;
1267
1268   inherited;
1269
1270   case Msg.Msg of
1271     WM_KEYDOWN:
1272       case Msg.wParam of
1273         IK_RETURN, IK_KPRETURN: if @FOnClickEvent <> nil then FOnClickEvent();
1274       end;
1275   end;
1276 end;
1277
1278 { TGUIMenu }
1279
1280 function TGUIMenu.AddButton(Proc: Pointer; fText: string; _ShowWindow: string = ''): TGUITextButton;
1281 var
1282   i: Integer;
1283 begin
1284   i := NewItem();
1285   with FItems[i] do
1286   begin
1287     Control := TGUITextButton.Create(Proc, FFontID, fText);
1288     with Control as TGUITextButton  do
1289     begin
1290       ShowWindow := _ShowWindow;
1291       FColor := MENU_ITEMSCTRL_COLOR;
1292     end;
1293
1294     Text := nil;
1295     ControlType := TGUITextButton;
1296
1297     Result := (Control as TGUITextButton);
1298   end;
1299
1300   if FIndex = -1 then FIndex := i;
1301
1302   ReAlign();
1303 end;
1304
1305 procedure TGUIMenu.AddLine(fText: string);
1306 var
1307   i: Integer;
1308 begin
1309   i := NewItem();
1310   with FItems[i] do
1311   begin
1312     Text := TGUILabel.Create(fText, FFontID);
1313     with Text do
1314     begin
1315       FColor := MENU_ITEMSTEXT_COLOR;
1316     end;
1317
1318     Control := nil;
1319   end;
1320
1321   ReAlign();
1322 end;
1323
1324 procedure TGUIMenu.AddText(fText: string; MaxWidth: Word);
1325 var
1326   a, i: Integer;
1327   l: SSArray;
1328 begin
1329   l := GetLines(fText, FFontID, MaxWidth);
1330
1331   if l = nil then Exit;
1332
1333   for a := 0 to High(l) do
1334   begin
1335     i := NewItem();
1336     with FItems[i] do
1337     begin
1338       Text := TGUILabel.Create(l[a], FFontID);
1339       if FYesNo then
1340       begin
1341         with Text do begin FColor := _RGB(255, 0, 0); end;
1342       end
1343       else
1344       begin
1345         with Text do begin FColor := MENU_ITEMSTEXT_COLOR; end;
1346       end;
1347
1348       Control := nil;
1349     end;
1350   end;
1351
1352   ReAlign();
1353 end;
1354
1355 procedure TGUIMenu.AddSpace;
1356 var
1357   i: Integer;
1358 begin
1359   i := NewItem();
1360   with FItems[i] do
1361   begin
1362     Text := nil;
1363     Control := nil;
1364   end;
1365
1366   ReAlign();
1367 end;
1368
1369 constructor TGUIMenu.Create(HeaderFont, ItemsFont: DWORD; Header: string);
1370 begin
1371   inherited Create();
1372
1373   FItems := nil;
1374   FIndex := -1;
1375   FFontID := ItemsFont;
1376   FCounter := MENU_MARKERDELAY;
1377   FAlign := True;
1378   FYesNo := false;
1379
1380   FHeader := TGUILabel.Create(Header, HeaderFont);
1381   with FHeader do
1382   begin
1383     FX := (gScreenWidth div 2)-(GetWidth div 2);
1384     FY := 0;
1385     FColor := MAINMENU_HEADER_COLOR;
1386   end;
1387 end;
1388
1389 destructor TGUIMenu.Destroy;
1390 var
1391   a: Integer;
1392 begin
1393   if FItems <> nil then
1394     for a := 0 to High(FItems) do
1395       with FItems[a] do
1396       begin
1397         Text.Free();
1398         Control.Free();
1399       end;
1400
1401   FItems := nil;
1402
1403   FHeader.Free();
1404
1405   inherited;
1406 end;
1407
1408 procedure TGUIMenu.Draw;
1409 var
1410   a, locx, locy: Integer;
1411 begin
1412   inherited;
1413
1414   if FHeader <> nil then FHeader.Draw;
1415
1416   if FItems <> nil then
1417     for a := 0 to High(FItems) do
1418     begin
1419       if FItems[a].Text <> nil then FItems[a].Text.Draw;
1420       if FItems[a].Control <> nil then FItems[a].Control.Draw;
1421     end;
1422
1423   if (FIndex <> -1) and (FCounter > MENU_MARKERDELAY div 2) then
1424   begin
1425     locx := 0;
1426     locy := 0;
1427
1428     if FItems[FIndex].Text <> nil then
1429     begin
1430       locx := FItems[FIndex].Text.FX;
1431       locy := FItems[FIndex].Text.FY;
1432       //HACK!
1433       if FItems[FIndex].Text.RightAlign then
1434       begin
1435         locx := locx+FItems[FIndex].Text.FMaxWidth-FItems[FIndex].Text.GetWidth;
1436       end;
1437     end
1438     else if FItems[FIndex].Control <> nil then
1439     begin
1440       locx := FItems[FIndex].Control.FX;
1441       locy := FItems[FIndex].Control.FY;
1442     end;
1443
1444     locx := locx-e_CharFont_GetMaxWidth(FFontID);
1445
1446     e_CharFont_PrintEx(FFontID, locx, locy, #16, _RGB(255, 0, 0));
1447   end;
1448 end;
1449
1450 function TGUIMenu.GetControl(aName: String): TGUIControl;
1451 var
1452   a: Integer;
1453 begin
1454   Result := nil;
1455
1456   if FItems <> nil then
1457     for a := 0 to High(FItems) do
1458       if FItems[a].Control <> nil then
1459         if LowerCase(FItems[a].Control.Name) = LowerCase(aName) then
1460         begin
1461           Result := FItems[a].Control;
1462           Break;
1463         end;
1464
1465   Assert(Result <> nil, 'GUI control "'+aName+'" not found!');
1466 end;
1467
1468 function TGUIMenu.GetControlsText(aName: String): TGUILabel;
1469 var
1470   a: Integer;
1471 begin
1472   Result := nil;
1473
1474   if FItems <> nil then
1475     for a := 0 to High(FItems) do
1476       if FItems[a].Control <> nil then
1477         if LowerCase(FItems[a].Control.Name) = LowerCase(aName) then
1478         begin
1479           Result := FItems[a].Text;
1480           Break;
1481         end;
1482
1483   Assert(Result <> nil, 'GUI control''s text "'+aName+'" not found!');
1484 end;
1485
1486 function TGUIMenu.NewItem: Integer;
1487 begin
1488   SetLength(FItems, Length(FItems)+1);
1489   Result := High(FItems);
1490 end;
1491
1492 procedure TGUIMenu.OnMessage(var Msg: TMessage);
1493 var
1494   ok: Boolean;
1495   a, c: Integer;
1496 begin
1497   if not FEnabled then Exit;
1498
1499   inherited;
1500
1501   if FItems = nil then Exit;
1502
1503   ok := False;
1504   for a := 0 to High(FItems) do
1505     if FItems[a].Control <> nil then
1506     begin
1507       ok := True;
1508       Break;
1509     end;
1510
1511   if not ok then Exit;
1512
1513   if (Msg.Msg = WM_KEYDOWN) and (FIndex <> -1) and (FItems[FIndex].Control <> nil) and
1514      (FItems[FIndex].Control.WantActivationKey(Msg.wParam)) then
1515   begin
1516     FItems[FIndex].Control.OnMessage(Msg);
1517     g_Sound_PlayEx(MENU_CLICKSOUND);
1518     exit;
1519   end;
1520
1521   case Msg.Msg of
1522     WM_KEYDOWN:
1523     begin
1524       case Msg.wParam of
1525         IK_UP, IK_KPUP:
1526         begin
1527           c := 0;
1528           repeat
1529             c := c+1;
1530             if c > Length(FItems) then
1531             begin
1532               FIndex := -1;
1533               Break;
1534             end;
1535
1536             Dec(FIndex);
1537             if FIndex < 0 then FIndex := High(FItems);
1538           until (FItems[FIndex].Control <> nil) and
1539                 (FItems[FIndex].Control.Enabled);
1540
1541           FCounter := 0;
1542
1543           g_Sound_PlayEx(MENU_CHANGESOUND);
1544         end;
1545
1546         IK_DOWN, IK_KPDOWN:
1547         begin
1548           c := 0;
1549           repeat
1550             c := c+1;
1551             if c > Length(FItems) then
1552             begin
1553               FIndex := -1;
1554               Break;
1555             end;
1556
1557             Inc(FIndex);
1558             if FIndex > High(FItems) then FIndex := 0;
1559           until (FItems[FIndex].Control <> nil) and
1560                 (FItems[FIndex].Control.Enabled);
1561
1562           FCounter := 0;
1563
1564           g_Sound_PlayEx(MENU_CHANGESOUND);
1565         end;
1566
1567         IK_LEFT, IK_RIGHT, IK_KPLEFT, IK_KPRIGHT:
1568         begin
1569           if FIndex <> -1 then
1570             if FItems[FIndex].Control <> nil then
1571               FItems[FIndex].Control.OnMessage(Msg);
1572         end;
1573         IK_RETURN, IK_KPRETURN:
1574         begin
1575           if FIndex <> -1 then
1576           begin
1577             if FItems[FIndex].Control <> nil then FItems[FIndex].Control.OnMessage(Msg);
1578           end;
1579           g_Sound_PlayEx(MENU_CLICKSOUND);
1580         end;
1581         // dirty hacks
1582         IK_Y:
1583           if FYesNo and (length(FItems) > 1) then
1584           begin
1585             Msg.wParam := IK_RETURN; // to register keypress
1586             FIndex := High(FItems)-1;
1587             if FItems[FIndex].Control <> nil then FItems[FIndex].Control.OnMessage(Msg);
1588           end;
1589         IK_N:
1590           if FYesNo and (length(FItems) > 1) then
1591           begin
1592             Msg.wParam := IK_RETURN; // to register keypress
1593             FIndex := High(FItems);
1594             if FItems[FIndex].Control <> nil then FItems[FIndex].Control.OnMessage(Msg);
1595           end;
1596       end;
1597     end;
1598   end;
1599 end;
1600
1601 procedure TGUIMenu.ReAlign();
1602 var
1603   a, tx, cx, w, h: Integer;
1604   cww: array of Integer; // cached widths
1605   maxcww: Integer;
1606 begin
1607   if FItems = nil then Exit;
1608
1609   SetLength(cww, length(FItems));
1610   maxcww := 0;
1611   for a := 0 to High(FItems) do
1612   begin
1613     if FItems[a].Text <> nil then
1614     begin
1615       cww[a] := FItems[a].Text.GetWidth;
1616       if maxcww < cww[a] then maxcww := cww[a];
1617     end;
1618   end;
1619
1620   if not FAlign then
1621   begin
1622     tx := FLeft;
1623   end
1624   else
1625   begin
1626     tx := gScreenWidth;
1627     for a := 0 to High(FItems) do
1628     begin
1629       w := 0;
1630       if FItems[a].Text <> nil then w := FItems[a].Text.GetWidth;
1631       if FItems[a].Control <> nil then
1632       begin
1633         w := w+MENU_HSPACE;
1634              if FItems[a].ControlType = TGUILabel then w := w+(FItems[a].Control as TGUILabel).GetWidth
1635         else if FItems[a].ControlType = TGUITextButton then w := w+(FItems[a].Control as TGUITextButton).GetWidth
1636         else if FItems[a].ControlType = TGUIScroll then w := w+(FItems[a].Control as TGUIScroll).GetWidth
1637         else if FItems[a].ControlType = TGUISwitch then w := w+(FItems[a].Control as TGUISwitch).GetWidth
1638         else if FItems[a].ControlType = TGUIEdit then w := w+(FItems[a].Control as TGUIEdit).GetWidth
1639         else if FItems[a].ControlType = TGUIKeyRead then w := w+(FItems[a].Control as TGUIKeyRead).GetWidth
1640         else if FItems[a].ControlType = TGUIKeyRead2 then w := w+(FItems[a].Control as TGUIKeyRead2).GetWidth
1641         else if FItems[a].ControlType = TGUIListBox then w := w+(FItems[a].Control as TGUIListBox).GetWidth
1642         else if FItems[a].ControlType = TGUIFileListBox then w := w+(FItems[a].Control as TGUIFileListBox).GetWidth
1643         else if FItems[a].ControlType = TGUIMemo then w := w+(FItems[a].Control as TGUIMemo).GetWidth;
1644       end;
1645       tx := Min(tx, (gScreenWidth div 2)-(w div 2));
1646     end;
1647   end;
1648
1649   cx := 0;
1650   for a := 0 to High(FItems) do
1651   begin
1652     with FItems[a] do
1653     begin
1654       if (Text <> nil) and (Control = nil) then Continue;
1655       w := 0;
1656       if Text <> nil then w := tx+Text.GetWidth;
1657       if w > cx then cx := w;
1658     end;
1659   end;
1660
1661   cx := cx+MENU_HSPACE;
1662
1663   h := FHeader.GetHeight*2+MENU_VSPACE*(Length(FItems)-1);
1664
1665   for a := 0 to High(FItems) do
1666   begin
1667     with FItems[a] do
1668     begin
1669       if (ControlType = TGUIListBox) or (ControlType = TGUIFileListBox) then
1670         h := h+(FItems[a].Control as TGUIListBox).GetHeight()
1671       else
1672         h := h+e_CharFont_GetMaxHeight(FFontID);
1673     end;
1674   end;
1675
1676   h := (gScreenHeight div 2)-(h div 2);
1677
1678   with FHeader do
1679   begin
1680     FX := (gScreenWidth div 2)-(GetWidth div 2);
1681     FY := h;
1682
1683     Inc(h, GetHeight*2);
1684   end;
1685
1686   for a := 0 to High(FItems) do
1687   begin
1688     with FItems[a] do
1689     begin
1690       if Text <> nil then
1691       begin
1692         with Text do
1693         begin
1694           FX := tx;
1695           FY := h;
1696         end;
1697         //HACK!
1698         if Text.RightAlign and (length(cww) > a) then
1699         begin
1700           //Text.FX := Text.FX+maxcww;
1701           Text.FMaxWidth := maxcww;
1702         end;
1703       end;
1704
1705       if Control <> nil then
1706       begin
1707         with Control do
1708         begin
1709           if Text <> nil then
1710           begin
1711             FX := cx;
1712             FY := h;
1713           end
1714           else
1715           begin
1716             FX := tx;
1717             FY := h;
1718           end;
1719         end;
1720       end;
1721
1722            if (ControlType = TGUIListBox) or (ControlType = TGUIFileListBox) then Inc(h, (Control as TGUIListBox).GetHeight+MENU_VSPACE)
1723       else if ControlType = TGUIMemo then Inc(h, (Control as TGUIMemo).GetHeight+MENU_VSPACE)
1724       else Inc(h, e_CharFont_GetMaxHeight(FFontID)+MENU_VSPACE);
1725     end;
1726   end;
1727
1728   // another ugly hack
1729   if FYesNo and (length(FItems) > 1) then
1730   begin
1731     w := -1;
1732     for a := High(FItems)-1 to High(FItems) do
1733     begin
1734       if (FItems[a].Control <> nil) and (FItems[a].ControlType = TGUITextButton) then
1735       begin
1736         cx := (FItems[a].Control as TGUITextButton).GetWidth;
1737         if cx > w then w := cx;
1738       end;
1739     end;
1740     if w > 0 then
1741     begin
1742       for a := High(FItems)-1 to High(FItems) do
1743       begin
1744         if (FItems[a].Control <> nil) and (FItems[a].ControlType = TGUITextButton) then
1745         begin
1746           FItems[a].Control.FX := (gScreenWidth-w) div 2;
1747         end;
1748       end;
1749     end;
1750   end;
1751 end;
1752
1753 function TGUIMenu.AddScroll(fText: string): TGUIScroll;
1754 var
1755   i: Integer;
1756 begin
1757   i := NewItem();
1758   with FItems[i] do
1759   begin
1760     Control := TGUIScroll.Create();
1761
1762     Text := TGUILabel.Create(fText, FFontID);
1763     with Text do
1764     begin
1765       FColor := MENU_ITEMSTEXT_COLOR;
1766     end;
1767
1768     ControlType := TGUIScroll;
1769
1770     Result := (Control as TGUIScroll);
1771   end;
1772
1773   if FIndex = -1 then FIndex := i;
1774
1775   ReAlign();
1776 end;
1777
1778 function TGUIMenu.AddSwitch(fText: string): TGUISwitch;
1779 var
1780   i: Integer;
1781 begin
1782   i := NewItem();
1783   with FItems[i] do
1784   begin
1785     Control := TGUISwitch.Create(FFontID);
1786    (Control as TGUISwitch).FColor := MENU_ITEMSCTRL_COLOR;
1787
1788     Text := TGUILabel.Create(fText, FFontID);
1789     with Text do
1790     begin
1791       FColor := MENU_ITEMSTEXT_COLOR;
1792     end;
1793
1794     ControlType := TGUISwitch;
1795
1796     Result := (Control as TGUISwitch);
1797   end;
1798
1799   if FIndex = -1 then FIndex := i;
1800
1801   ReAlign();
1802 end;
1803
1804 function TGUIMenu.AddEdit(fText: string): TGUIEdit;
1805 var
1806   i: Integer;
1807 begin
1808   i := NewItem();
1809   with FItems[i] do
1810   begin
1811     Control := TGUIEdit.Create(FFontID);
1812     with Control as TGUIEdit do
1813     begin
1814       FWindow := Self.FWindow;
1815       FColor := MENU_ITEMSCTRL_COLOR;
1816     end;
1817
1818     if fText = '' then Text := nil else
1819     begin
1820       Text := TGUILabel.Create(fText, FFontID);
1821       Text.FColor := MENU_ITEMSTEXT_COLOR;
1822     end;
1823
1824     ControlType := TGUIEdit;
1825
1826     Result := (Control as TGUIEdit);
1827   end;
1828
1829   if FIndex = -1 then FIndex := i;
1830
1831   ReAlign();
1832 end;
1833
1834 procedure TGUIMenu.Update;
1835 var
1836   a: Integer;
1837 begin
1838   inherited;
1839
1840   if FCounter = 0 then FCounter := MENU_MARKERDELAY else Dec(FCounter);
1841
1842   if FItems <> nil then
1843     for a := 0 to High(FItems) do
1844       if FItems[a].Control <> nil then
1845         (FItems[a].Control as FItems[a].ControlType).Update;
1846 end;
1847
1848 function TGUIMenu.AddKeyRead(fText: string): TGUIKeyRead;
1849 var
1850   i: Integer;
1851 begin
1852   i := NewItem();
1853   with FItems[i] do
1854   begin
1855     Control := TGUIKeyRead.Create(FFontID);
1856     with Control as TGUIKeyRead do
1857     begin
1858       FWindow := Self.FWindow;
1859       FColor := MENU_ITEMSCTRL_COLOR;
1860     end;
1861
1862     Text := TGUILabel.Create(fText, FFontID);
1863     with Text do
1864     begin
1865       FColor := MENU_ITEMSTEXT_COLOR;
1866     end;
1867
1868     ControlType := TGUIKeyRead;
1869
1870     Result := (Control as TGUIKeyRead);
1871   end;
1872
1873   if FIndex = -1 then FIndex := i;
1874
1875   ReAlign();
1876 end;
1877
1878 function TGUIMenu.AddKeyRead2(fText: string): TGUIKeyRead2;
1879 var
1880   i: Integer;
1881 begin
1882   i := NewItem();
1883   with FItems[i] do
1884   begin
1885     Control := TGUIKeyRead2.Create(FFontID);
1886     with Control as TGUIKeyRead2 do
1887     begin
1888       FWindow := Self.FWindow;
1889       FColor := MENU_ITEMSCTRL_COLOR;
1890     end;
1891
1892     Text := TGUILabel.Create(fText, FFontID);
1893     with Text do
1894     begin
1895       FColor := MENU_ITEMSCTRL_COLOR; //MENU_ITEMSTEXT_COLOR;
1896       RightAlign := true;
1897     end;
1898
1899     ControlType := TGUIKeyRead2;
1900
1901     Result := (Control as TGUIKeyRead2);
1902   end;
1903
1904   if FIndex = -1 then FIndex := i;
1905
1906   ReAlign();
1907 end;
1908
1909 function TGUIMenu.AddList(fText: string; Width, Height: Word): TGUIListBox;
1910 var
1911   i: Integer;
1912 begin
1913   i := NewItem();
1914   with FItems[i] do
1915   begin
1916     Control := TGUIListBox.Create(FFontID, Width, Height);
1917     with Control as TGUIListBox do
1918     begin
1919       FWindow := Self.FWindow;
1920       FActiveColor := MENU_ITEMSCTRL_COLOR;
1921       FUnActiveColor := MENU_ITEMSTEXT_COLOR;
1922     end;
1923
1924     Text := TGUILabel.Create(fText, FFontID);
1925     with Text do
1926     begin
1927       FColor := MENU_ITEMSTEXT_COLOR;
1928     end;
1929
1930     ControlType := TGUIListBox;
1931
1932     Result := (Control as TGUIListBox);
1933   end;
1934
1935   if FIndex = -1 then FIndex := i;
1936
1937   ReAlign();
1938 end;
1939
1940 function TGUIMenu.AddFileList(fText: string; Width, Height: Word): TGUIFileListBox;
1941 var
1942   i: Integer;
1943 begin
1944   i := NewItem();
1945   with FItems[i] do
1946   begin
1947     Control := TGUIFileListBox.Create(FFontID, Width, Height);
1948     with Control as TGUIFileListBox do
1949     begin
1950       FWindow := Self.FWindow;
1951       FActiveColor := MENU_ITEMSCTRL_COLOR;
1952       FUnActiveColor := MENU_ITEMSTEXT_COLOR;
1953     end;
1954
1955     if fText = '' then Text := nil else
1956     begin
1957       Text := TGUILabel.Create(fText, FFontID);
1958       Text.FColor := MENU_ITEMSTEXT_COLOR;
1959     end;
1960
1961     ControlType := TGUIFileListBox;
1962
1963     Result := (Control as TGUIFileListBox);
1964   end;
1965
1966   if FIndex = -1 then FIndex := i;
1967
1968   ReAlign();
1969 end;
1970
1971 function TGUIMenu.AddLabel(fText: string): TGUILabel;
1972 var
1973   i: Integer;
1974 begin
1975   i := NewItem();
1976   with FItems[i] do
1977   begin
1978     Control := TGUILabel.Create('', FFontID);
1979     with Control as TGUILabel do
1980     begin
1981       FWindow := Self.FWindow;
1982       FColor := MENU_ITEMSCTRL_COLOR;
1983     end;
1984
1985     Text := TGUILabel.Create(fText, FFontID);
1986     with Text do
1987     begin
1988       FColor := MENU_ITEMSTEXT_COLOR;
1989     end;
1990
1991     ControlType := TGUILabel;
1992
1993     Result := (Control as TGUILabel);
1994   end;
1995
1996   if FIndex = -1 then FIndex := i;
1997
1998   ReAlign();
1999 end;
2000
2001 function TGUIMenu.AddMemo(fText: string; Width, Height: Word): TGUIMemo;
2002 var
2003   i: Integer;
2004 begin
2005   i := NewItem();
2006   with FItems[i] do
2007   begin
2008     Control := TGUIMemo.Create(FFontID, Width, Height);
2009     with Control as TGUIMemo do
2010     begin
2011       FWindow := Self.FWindow;
2012       FColor := MENU_ITEMSTEXT_COLOR;
2013     end;
2014
2015     if fText = '' then Text := nil else
2016     begin
2017       Text := TGUILabel.Create(fText, FFontID);
2018       Text.FColor := MENU_ITEMSTEXT_COLOR;
2019     end;
2020
2021     ControlType := TGUIMemo;
2022
2023     Result := (Control as TGUIMemo);
2024   end;
2025
2026   if FIndex = -1 then FIndex := i;
2027
2028   ReAlign();
2029 end;
2030
2031 procedure TGUIMenu.UpdateIndex();
2032 var
2033   res: Boolean;
2034 begin
2035   res := True;
2036
2037   while res do
2038   begin
2039     if (FIndex < 0) or (FIndex > High(FItems)) then
2040       begin
2041         FIndex := -1;
2042         res := False;
2043       end
2044     else
2045       if FItems[FIndex].Control.Enabled then
2046         res := False
2047       else
2048         Inc(FIndex);
2049   end;
2050 end;
2051
2052 { TGUIScroll }
2053
2054 constructor TGUIScroll.Create;
2055 begin
2056   inherited Create();
2057
2058   FMax := 0;
2059   FOnChangeEvent := nil;
2060
2061   g_Texture_Get(SCROLL_LEFT, FLeftID);
2062   g_Texture_Get(SCROLL_RIGHT, FRightID);
2063   g_Texture_Get(SCROLL_MIDDLE, FMiddleID);
2064   g_Texture_Get(SCROLL_MARKER, FMarkerID);
2065 end;
2066
2067 procedure TGUIScroll.Draw;
2068 var
2069   a: Integer;
2070 begin
2071   inherited;
2072
2073   e_Draw(FLeftID, FX, FY, 0, True, False);
2074   e_Draw(FRightID, FX+8+(FMax+1)*8, FY, 0, True, False);
2075
2076   for a := 0 to FMax do
2077     e_Draw(FMiddleID, FX+8+a*8, FY, 0, True, False);
2078
2079   e_Draw(FMarkerID, FX+8+FValue*8, FY, 0, True, False);
2080 end;
2081
2082 procedure TGUIScroll.FSetValue(a: Integer);
2083 begin
2084   if a > FMax then FValue := FMax else FValue := a;
2085 end;
2086
2087 function TGUIScroll.GetWidth: Integer;
2088 begin
2089   Result := 16+(FMax+1)*8;
2090 end;
2091
2092 procedure TGUIScroll.OnMessage(var Msg: TMessage);
2093 begin
2094   if not FEnabled then Exit;
2095
2096   inherited;
2097
2098   case Msg.Msg of
2099     WM_KEYDOWN:
2100     begin
2101       case Msg.wParam of
2102         IK_LEFT, IK_KPLEFT:
2103           if FValue > 0 then
2104           begin
2105             Dec(FValue);
2106             g_Sound_PlayEx(SCROLL_SUBSOUND);
2107             if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
2108           end;
2109         IK_RIGHT, IK_KPRIGHT:
2110           if FValue < FMax then
2111           begin
2112             Inc(FValue);
2113             g_Sound_PlayEx(SCROLL_ADDSOUND);
2114             if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
2115           end;
2116       end;
2117     end;
2118   end;
2119 end;
2120
2121 procedure TGUIScroll.Update;
2122 begin
2123   inherited;
2124
2125 end;
2126
2127 { TGUISwitch }
2128
2129 procedure TGUISwitch.AddItem(Item: string);
2130 begin
2131   SetLength(FItems, Length(FItems)+1);
2132   FItems[High(FItems)] := Item;
2133
2134   if FIndex = -1 then FIndex := 0;
2135 end;
2136
2137 constructor TGUISwitch.Create(FontID: DWORD);
2138 begin
2139   inherited Create();
2140
2141   FIndex := -1;
2142
2143   FFont := TFont.Create(FontID, TFontType.Character);
2144 end;
2145
2146 procedure TGUISwitch.Draw;
2147 begin
2148   inherited;
2149
2150   FFont.Draw(FX, FY, FItems[FIndex], FColor.R, FColor.G, FColor.B);
2151 end;
2152
2153 function TGUISwitch.GetText: string;
2154 begin
2155   if FIndex <> -1 then Result := FItems[FIndex]
2156   else Result := '';
2157 end;
2158
2159 function TGUISwitch.GetWidth: Integer;
2160 var
2161   a: Integer;
2162   w, h: Word;
2163 begin
2164   Result := 0;
2165
2166   if FItems = nil then Exit;
2167
2168   for a := 0 to High(FItems) do
2169   begin
2170     FFont.GetTextSize(FItems[a], w, h);
2171     if w > Result then Result := w;
2172   end;
2173 end;
2174
2175 procedure TGUISwitch.OnMessage(var Msg: TMessage);
2176 begin
2177   if not FEnabled then Exit;
2178
2179   inherited;
2180
2181   if FItems = nil then Exit;
2182
2183   case Msg.Msg of
2184     WM_KEYDOWN:
2185       case Msg.wParam of
2186         IK_RETURN, IK_RIGHT, IK_KPRETURN, IK_KPRIGHT:
2187         begin
2188           if FIndex < High(FItems) then
2189             Inc(FIndex)
2190           else
2191             FIndex := 0;
2192
2193           if @FOnChangeEvent <> nil then
2194             FOnChangeEvent(Self);
2195         end;
2196
2197     IK_LEFT, IK_KPLEFT:
2198       begin
2199         if FIndex > 0 then
2200           Dec(FIndex)
2201         else
2202           FIndex := High(FItems);
2203
2204         if @FOnChangeEvent <> nil then
2205           FOnChangeEvent(Self);
2206       end;
2207     end;
2208   end;
2209 end;
2210
2211 procedure TGUISwitch.Update;
2212 begin
2213   inherited;
2214
2215 end;
2216
2217 { TGUIEdit }
2218
2219 constructor TGUIEdit.Create(FontID: DWORD);
2220 begin
2221   inherited Create();
2222
2223   FFont := TFont.Create(FontID, TFontType.Character);
2224
2225   FMaxLength := 0;
2226   FWidth := 0;
2227   FInvalid := false;
2228
2229   g_Texture_Get(EDIT_LEFT, FLeftID);
2230   g_Texture_Get(EDIT_RIGHT, FRightID);
2231   g_Texture_Get(EDIT_MIDDLE, FMiddleID);
2232 end;
2233
2234 procedure TGUIEdit.Draw;
2235 var
2236   c, w, h: Word;
2237   r, g, b: Byte;
2238 begin
2239   inherited;
2240
2241   e_Draw(FLeftID, FX, FY, 0, True, False);
2242   e_Draw(FRightID, FX+8+FWidth*16, FY, 0, True, False);
2243
2244   for c := 0 to FWidth-1 do
2245     e_Draw(FMiddleID, FX+8+c*16, FY, 0, True, False);
2246
2247   r := FColor.R;
2248   g := FColor.G;
2249   b := FColor.B;
2250   if FInvalid and (FWindow.FActiveControl <> self) then begin r := 128; g := 128; b := 128; end;
2251   FFont.Draw(FX+8, FY, FText, r, g, b);
2252
2253   if (FWindow.FActiveControl = self) then
2254   begin
2255     FFont.GetTextSize(Copy(FText, 1, FCaretPos), w, h);
2256     h := e_CharFont_GetMaxHeight(FFont.ID);
2257     e_DrawLine(2, FX+8+w, FY+h-3, FX+8+w+EDIT_CURSORLEN, FY+h-3,
2258                EDIT_CURSORCOLOR.R, EDIT_CURSORCOLOR.G, EDIT_CURSORCOLOR.B);
2259   end;
2260 end;
2261
2262 function TGUIEdit.GetWidth: Integer;
2263 begin
2264   Result := 16+FWidth*16;
2265 end;
2266
2267 procedure TGUIEdit.OnMessage(var Msg: TMessage);
2268 begin
2269   if not FEnabled then Exit;
2270
2271   inherited;
2272
2273   with Msg do
2274     case Msg of
2275       WM_CHAR:
2276         if FOnlyDigits then
2277         begin
2278           if (wParam in [48..57]) and (Chr(wParam) <> '`') then
2279             if Length(Text) < FMaxLength then
2280             begin
2281               Insert(Chr(wParam), FText, FCaretPos + 1);
2282               Inc(FCaretPos);
2283             end;
2284         end
2285         else
2286         begin
2287           if (wParam in [32..255]) and (Chr(wParam) <> '`') then
2288             if Length(Text) < FMaxLength then
2289             begin
2290               Insert(Chr(wParam), FText, FCaretPos + 1);
2291               Inc(FCaretPos);
2292             end;
2293         end;
2294       WM_KEYDOWN:
2295         case wParam of
2296           IK_BACKSPACE:
2297           begin
2298             Delete(FText, FCaretPos, 1);
2299             if FCaretPos > 0 then Dec(FCaretPos);
2300           end;
2301           IK_DELETE: Delete(FText, FCaretPos + 1, 1);
2302           IK_END, IK_KPEND: FCaretPos := Length(FText);
2303           IK_HOME, IK_KPHOME: FCaretPos := 0;
2304           IK_LEFT, IK_KPLEFT: if FCaretPos > 0 then Dec(FCaretPos);
2305           IK_RIGHT, IK_KPRIGHT: if FCaretPos < Length(FText) then Inc(FCaretPos);
2306           IK_RETURN, IK_KPRETURN:
2307             with FWindow do
2308             begin
2309               if FActiveControl <> Self then
2310               begin
2311                 SetActive(Self);
2312                 if @FOnEnterEvent <> nil then FOnEnterEvent(Self);
2313               end
2314               else
2315               begin
2316                 if FDefControl <> '' then SetActive(GetControl(FDefControl))
2317                 else SetActive(nil);
2318                 if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
2319               end;
2320             end;
2321         end;
2322     end;
2323 end;
2324
2325 procedure TGUIEdit.SetText(Text: string);
2326 begin
2327   if Length(Text) > FMaxLength then SetLength(Text, FMaxLength);
2328   FText := Text;
2329   FCaretPos := Length(FText);
2330 end;
2331
2332 procedure TGUIEdit.Update;
2333 begin
2334   inherited;
2335 end;
2336
2337 { TGUIKeyRead }
2338
2339 constructor TGUIKeyRead.Create(FontID: DWORD);
2340 begin
2341   inherited Create();
2342   FKey := 0;
2343   FIsQuery := false;
2344
2345   FFont := TFont.Create(FontID, TFontType.Character);
2346 end;
2347
2348 procedure TGUIKeyRead.Draw;
2349 begin
2350   inherited;
2351
2352   FFont.Draw(FX, FY, IfThen(FIsQuery, KEYREAD_QUERY, IfThen(FKey <> 0, e_KeyNames[FKey], KEYREAD_CLEAR)),
2353              FColor.R, FColor.G, FColor.B);
2354 end;
2355
2356 function TGUIKeyRead.GetWidth: Integer;
2357 var
2358   a: Byte;
2359   w, h: Word;
2360 begin
2361   Result := 0;
2362
2363   for a := 0 to 255 do
2364   begin
2365     FFont.GetTextSize(e_KeyNames[a], w, h);
2366     Result := Max(Result, w);
2367   end;
2368
2369   FFont.GetTextSize(KEYREAD_QUERY, w, h);
2370   if w > Result then Result := w;
2371
2372   FFont.GetTextSize(KEYREAD_CLEAR, w, h);
2373   if w > Result then Result := w;
2374 end;
2375
2376 function TGUIKeyRead.WantActivationKey (key: LongInt): Boolean;
2377 begin
2378   result :=
2379     (key = IK_BACKSPACE) or
2380     false; // oops
2381 end;
2382
2383 procedure TGUIKeyRead.OnMessage(var Msg: TMessage);
2384   procedure actDefCtl ();
2385   begin
2386     with FWindow do
2387       if FDefControl <> '' then
2388         SetActive(GetControl(FDefControl))
2389       else
2390         SetActive(nil);
2391   end;
2392
2393 begin
2394   inherited;
2395
2396   if not FEnabled then
2397     Exit;
2398
2399   with Msg do
2400     case Msg of
2401       WM_KEYDOWN:
2402         case wParam of
2403           IK_ESCAPE:
2404             begin
2405               if FIsQuery then actDefCtl();
2406               FIsQuery := False;
2407             end;
2408           IK_RETURN, IK_KPRETURN:
2409             begin
2410               if not FIsQuery then
2411                 begin
2412                   with FWindow do
2413                     if FActiveControl <> Self then
2414                       SetActive(Self);
2415
2416                   FIsQuery := True;
2417                 end
2418               else
2419                 begin
2420                   FKey := IK_ENTER; // <Enter>
2421                   FIsQuery := False;
2422                   actDefCtl();
2423                 end;
2424             end;
2425           IK_BACKSPACE: // clear keybinding if we aren't waiting for a key
2426             begin
2427               if not FIsQuery then
2428               begin
2429                 FKey := 0;
2430                 actDefCtl();
2431               end;
2432             end;
2433         end;
2434
2435       MESSAGE_DIKEY:
2436         begin
2437           if not FIsQuery and (wParam = IK_BACKSPACE) then
2438           begin
2439             FKey := 0;
2440             actDefCtl();
2441           end
2442           else if FIsQuery and (wParam <> IK_ENTER) and (wParam <> IK_KPRETURN) then // Not <Enter
2443           begin
2444             if e_KeyNames[wParam] <> '' then
2445               FKey := wParam;
2446             FIsQuery := False;
2447             actDefCtl();
2448           end;
2449         end;
2450     end;
2451 end;
2452
2453 { TGUIKeyRead2 }
2454
2455 constructor TGUIKeyRead2.Create(FontID: DWORD);
2456 var
2457   a: Byte;
2458   w, h: Word;
2459 begin
2460   inherited Create();
2461
2462   FKey0 := 0;
2463   FKey1 := 0;
2464   FKeyIdx := 0;
2465   FIsQuery := False;
2466
2467   FFontID := FontID;
2468   FFont := TFont.Create(FontID, TFontType.Character);
2469
2470   FMaxKeyNameWdt := 0;
2471   for a := 0 to 255 do
2472   begin
2473     FFont.GetTextSize(e_KeyNames[a], w, h);
2474     FMaxKeyNameWdt := Max(FMaxKeyNameWdt, w);
2475   end;
2476
2477   FMaxKeyNameWdt := FMaxKeyNameWdt-(FMaxKeyNameWdt div 3);
2478
2479   FFont.GetTextSize(KEYREAD_QUERY, w, h);
2480   if w > FMaxKeyNameWdt then FMaxKeyNameWdt := w;
2481
2482   FFont.GetTextSize(KEYREAD_CLEAR, w, h);
2483   if w > FMaxKeyNameWdt then FMaxKeyNameWdt := w;
2484 end;
2485
2486 procedure TGUIKeyRead2.Draw;
2487   procedure drawText (idx: Integer);
2488   var
2489     x, y: Integer;
2490     r, g, b: Byte;
2491     kk: DWORD;
2492   begin
2493     if idx = 0 then kk := FKey0 else kk := FKey1;
2494     y := FY;
2495     if idx = 0 then x := FX+8 else x := FX+8+FMaxKeyNameWdt+16;
2496     r := 255;
2497     g := 0;
2498     b := 0;
2499     if FKeyIdx = idx then begin r := 255; g := 255; b := 255; end;
2500     if FIsQuery and (FKeyIdx = idx) then
2501       FFont.Draw(x, y, KEYREAD_QUERY, r, g, b)
2502     else
2503       FFont.Draw(x, y, IfThen(kk <> 0, e_KeyNames[kk], KEYREAD_CLEAR), r, g, b);
2504   end;
2505
2506 begin
2507   inherited;
2508
2509   //FFont.Draw(FX+8, FY, IfThen(FIsQuery and (FKeyIdx = 0), KEYREAD_QUERY, IfThen(FKey0 <> 0, e_KeyNames[FKey0], KEYREAD_CLEAR)), FColor.R, FColor.G, FColor.B);
2510   //FFont.Draw(FX+8+FMaxKeyNameWdt+16, FY, IfThen(FIsQuery and (FKeyIdx = 1), KEYREAD_QUERY, IfThen(FKey1 <> 0, e_KeyNames[FKey1], KEYREAD_CLEAR)), FColor.R, FColor.G, FColor.B);
2511   drawText(0);
2512   drawText(1);
2513 end;
2514
2515 function TGUIKeyRead2.GetWidth: Integer;
2516 begin
2517   Result := FMaxKeyNameWdt*2+8+8+16;
2518 end;
2519
2520 function TGUIKeyRead2.WantActivationKey (key: LongInt): Boolean;
2521 begin
2522   result :=
2523     (key = IK_BACKSPACE) or
2524     (key = IK_LEFT) or (key = IK_RIGHT) or
2525     (key = IK_KPLEFT) or (key = IK_KPRIGHT) or
2526     false; // oops
2527 end;
2528
2529 procedure TGUIKeyRead2.OnMessage(var Msg: TMessage);
2530   procedure actDefCtl ();
2531   begin
2532     with FWindow do
2533       if FDefControl <> '' then
2534         SetActive(GetControl(FDefControl))
2535       else
2536         SetActive(nil);
2537   end;
2538
2539 begin
2540   inherited;
2541
2542   if not FEnabled then
2543     Exit;
2544
2545   with Msg do
2546     case Msg of
2547       WM_KEYDOWN:
2548         case wParam of
2549           IK_ESCAPE:
2550             begin
2551               if FIsQuery then actDefCtl();
2552               FIsQuery := False;
2553             end;
2554           IK_RETURN, IK_KPRETURN:
2555             begin
2556               if not FIsQuery then
2557                 begin
2558                   with FWindow do
2559                     if FActiveControl <> Self then
2560                       SetActive(Self);
2561
2562                   FIsQuery := True;
2563                 end
2564               else
2565                 begin
2566                   if (FKeyIdx = 0) then FKey0 := IK_ENTER else FKey1 := IK_ENTER; // <Enter>
2567                   FIsQuery := False;
2568                   actDefCtl();
2569                 end;
2570             end;
2571           IK_BACKSPACE: // clear keybinding if we aren't waiting for a key
2572             begin
2573               if not FIsQuery then
2574               begin
2575                 if (FKeyIdx = 0) then FKey0 := 0 else FKey1 := 0;
2576                 actDefCtl();
2577               end;
2578             end;
2579           IK_LEFT, IK_KPLEFT:
2580             if not FIsQuery then
2581             begin
2582               FKeyIdx := 0;
2583               actDefCtl();
2584             end;
2585           IK_RIGHT, IK_KPRIGHT:
2586             if not FIsQuery then
2587             begin
2588               FKeyIdx := 1;
2589               actDefCtl();
2590             end;
2591         end;
2592
2593       MESSAGE_DIKEY:
2594         begin
2595           if not FIsQuery and (wParam = IK_BACKSPACE) then
2596           begin
2597             if (FKeyIdx = 0) then FKey0 := 0 else FKey1 := 0;
2598             actDefCtl();
2599           end
2600           else if FIsQuery and (wParam <> IK_ENTER) and (wParam <> IK_KPRETURN) then // Not <Enter
2601           begin
2602             if e_KeyNames[wParam] <> '' then
2603             begin
2604               if (FKeyIdx = 0) then FKey0 := wParam else FKey1 := wParam;
2605             end;
2606             FIsQuery := False;
2607             actDefCtl();
2608           end;
2609         end;
2610     end;
2611 end;
2612
2613
2614 { TGUIModelView }
2615
2616 constructor TGUIModelView.Create;
2617 begin
2618   inherited Create();
2619
2620   FModel := nil;
2621 end;
2622
2623 destructor TGUIModelView.Destroy;
2624 begin
2625   FModel.Free();
2626
2627   inherited;
2628 end;
2629
2630 procedure TGUIModelView.Draw;
2631 begin
2632   inherited;
2633
2634   DrawBox(FX, FY, 4, 4);
2635
2636   if FModel <> nil then FModel.Draw(FX+4, FY+4);
2637 end;
2638
2639 procedure TGUIModelView.NextAnim();
2640 begin
2641   if FModel = nil then
2642     Exit;
2643
2644   if FModel.Animation < A_PAIN then
2645     FModel.ChangeAnimation(FModel.Animation+1, True)
2646   else
2647     FModel.ChangeAnimation(A_STAND, True);
2648 end;
2649
2650 procedure TGUIModelView.NextWeapon();
2651 begin
2652   if FModel = nil then
2653     Exit;
2654
2655   if FModel.Weapon < WP_LAST then
2656     FModel.SetWeapon(FModel.Weapon+1)
2657   else
2658     FModel.SetWeapon(WEAPON_KASTET);
2659 end;
2660
2661 procedure TGUIModelView.OnMessage(var Msg: TMessage);
2662 begin
2663   inherited;
2664
2665 end;
2666
2667 procedure TGUIModelView.SetColor(Red, Green, Blue: Byte);
2668 begin
2669   if FModel <> nil then FModel.SetColor(Red, Green, Blue);
2670 end;
2671
2672 procedure TGUIModelView.SetModel(ModelName: string);
2673 begin
2674   FModel.Free();
2675
2676   FModel := g_PlayerModel_Get(ModelName);
2677 end;
2678
2679 procedure TGUIModelView.Update;
2680 begin
2681   inherited;
2682
2683   a := not a;
2684   if a then Exit;
2685
2686   if FModel <> nil then FModel.Update;
2687 end;
2688
2689 { TGUIMapPreview }
2690
2691 constructor TGUIMapPreview.Create();
2692 begin
2693   inherited Create();
2694   ClearMap;
2695 end;
2696
2697 destructor TGUIMapPreview.Destroy();
2698 begin
2699   ClearMap;
2700   inherited;
2701 end;
2702
2703 procedure TGUIMapPreview.Draw();
2704 var
2705   a: Integer;
2706   r, g, b: Byte;
2707 begin
2708   inherited;
2709
2710   DrawBox(FX, FY, MAPPREVIEW_WIDTH, MAPPREVIEW_HEIGHT);
2711
2712   if (FMapSize.X <= 0) or (FMapSize.Y <= 0) then
2713     Exit;
2714
2715   e_DrawFillQuad(FX+4, FY+4,
2716     FX+4 + Trunc(FMapSize.X / FScale) - 1,
2717     FY+4 + Trunc(FMapSize.Y / FScale) - 1,
2718     32, 32, 32, 0);
2719
2720   if FMapData <> nil then
2721     for a := 0 to High(FMapData) do
2722       with FMapData[a] do
2723       begin
2724         if X1 > MAPPREVIEW_WIDTH*16 then Continue;
2725         if Y1 > MAPPREVIEW_HEIGHT*16 then Continue;
2726
2727         if X2 < 0 then Continue;
2728         if Y2 < 0 then Continue;
2729
2730         if X2 > MAPPREVIEW_WIDTH*16 then X2 := MAPPREVIEW_WIDTH*16;
2731         if Y2 > MAPPREVIEW_HEIGHT*16 then Y2 := MAPPREVIEW_HEIGHT*16;
2732
2733         if X1 < 0 then X1 := 0;
2734         if Y1 < 0 then Y1 := 0;
2735
2736         case PanelType of
2737           PANEL_WALL:
2738             begin
2739               r := 255;
2740               g := 255;
2741               b := 255;
2742             end;
2743           PANEL_CLOSEDOOR:
2744             begin
2745               r := 255;
2746               g := 255;
2747               b := 0;
2748             end;
2749           PANEL_WATER:
2750             begin
2751               r := 0;
2752               g := 0;
2753               b := 192;
2754             end;
2755           PANEL_ACID1:
2756             begin
2757               r := 0;
2758               g := 176;
2759               b := 0;
2760             end;
2761           PANEL_ACID2:
2762             begin
2763               r := 176;
2764               g := 0;
2765               b := 0;
2766             end;
2767           else
2768             begin
2769               r := 128;
2770               g := 128;
2771               b := 128;
2772             end;
2773         end;
2774
2775         if ((X2-X1) > 0) and ((Y2-Y1) > 0) then
2776           e_DrawFillQuad(FX+4 + X1, FY+4 + Y1,
2777             FX+4 + X2 - 1, FY+4 + Y2 - 1, r, g, b, 0);
2778       end;
2779 end;
2780
2781 procedure TGUIMapPreview.OnMessage(var Msg: TMessage);
2782 begin
2783   inherited;
2784
2785 end;
2786
2787 procedure TGUIMapPreview.SetMap(Res: string);
2788 var
2789   WAD: TWADFile;
2790   panlist: TDynField;
2791   pan: TDynRecord;
2792   //header: TMapHeaderRec_1;
2793   FileName: string;
2794   Data: Pointer;
2795   Len: Integer;
2796   rX, rY: Single;
2797   map: TDynRecord = nil;
2798 begin
2799   FMapSize.X := 0;
2800   FMapSize.Y := 0;
2801   FScale := 0.0;
2802   FMapData := nil;
2803
2804   FileName := g_ExtractWadName(Res);
2805
2806   WAD := TWADFile.Create();
2807   if not WAD.ReadFile(FileName) then
2808   begin
2809     WAD.Free();
2810     Exit;
2811   end;
2812
2813   //k8: ignores path again
2814   if not WAD.GetMapResource(g_ExtractFileName(Res), Data, Len) then
2815   begin
2816     WAD.Free();
2817     Exit;
2818   end;
2819
2820   WAD.Free();
2821
2822   try
2823     map := g_Map_ParseMap(Data, Len);
2824   except
2825     FreeMem(Data);
2826     map.Free();
2827     //raise;
2828     exit;
2829   end;
2830
2831   FreeMem(Data);
2832
2833   if (map = nil) then exit;
2834
2835   try
2836     panlist := map.field['panel'];
2837     //header := GetMapHeader(map);
2838
2839     FMapSize.X := map.Width div 16;
2840     FMapSize.Y := map.Height div 16;
2841
2842     rX := Ceil(map.Width / (MAPPREVIEW_WIDTH*256.0));
2843     rY := Ceil(map.Height / (MAPPREVIEW_HEIGHT*256.0));
2844     FScale := max(rX, rY);
2845
2846     FMapData := nil;
2847
2848     if (panlist <> nil) then
2849     begin
2850       for pan in panlist do
2851       begin
2852         if (pan.PanelType and (PANEL_WALL or PANEL_CLOSEDOOR or
2853                                              PANEL_STEP or PANEL_WATER or
2854                                              PANEL_ACID1 or PANEL_ACID2)) <> 0 then
2855         begin
2856           SetLength(FMapData, Length(FMapData)+1);
2857           with FMapData[High(FMapData)] do
2858           begin
2859             X1 := pan.X div 16;
2860             Y1 := pan.Y div 16;
2861
2862             X2 := (pan.X + pan.Width) div 16;
2863             Y2 := (pan.Y + pan.Height) div 16;
2864
2865             X1 := Trunc(X1/FScale + 0.5);
2866             Y1 := Trunc(Y1/FScale + 0.5);
2867             X2 := Trunc(X2/FScale + 0.5);
2868             Y2 := Trunc(Y2/FScale + 0.5);
2869
2870             if (X1 <> X2) or (Y1 <> Y2) then
2871             begin
2872               if X1 = X2 then
2873                 X2 := X2 + 1;
2874               if Y1 = Y2 then
2875                 Y2 := Y2 + 1;
2876             end;
2877
2878             PanelType := pan.PanelType;
2879           end;
2880         end;
2881       end;
2882     end;
2883   finally
2884     //writeln('freeing map');
2885     map.Free();
2886   end;
2887 end;
2888
2889 procedure TGUIMapPreview.ClearMap();
2890 begin
2891   SetLength(FMapData, 0);
2892   FMapData := nil;
2893   FMapSize.X := 0;
2894   FMapSize.Y := 0;
2895   FScale := 0.0;
2896 end;
2897
2898 procedure TGUIMapPreview.Update();
2899 begin
2900   inherited;
2901
2902 end;
2903
2904 function TGUIMapPreview.GetScaleStr(): String;
2905 begin
2906   if FScale > 0.0 then
2907     begin
2908       Result := FloatToStrF(FScale*16.0, ffFixed, 3, 3);
2909       while (Result[Length(Result)] = '0') do
2910         Delete(Result, Length(Result), 1);
2911       if (Result[Length(Result)] = ',') or (Result[Length(Result)] = '.') then
2912         Delete(Result, Length(Result), 1);
2913       Result := '1 : ' + Result;
2914     end
2915   else
2916     Result := '';
2917 end;
2918
2919 { TGUIListBox }
2920
2921 procedure TGUIListBox.AddItem(Item: string);
2922 begin
2923   SetLength(FItems, Length(FItems)+1);
2924   FItems[High(FItems)] := Item;
2925
2926   if FSort then g_Basic.Sort(FItems);
2927 end;
2928
2929 procedure TGUIListBox.Clear();
2930 begin
2931   FItems := nil;
2932
2933   FStartLine := 0;
2934   FIndex := -1;
2935 end;
2936
2937 constructor TGUIListBox.Create(FontID: DWORD; Width, Height: Word);
2938 begin
2939   inherited Create();
2940
2941   FFont := TFont.Create(FontID, TFontType.Character);
2942
2943   FWidth := Width;
2944   FHeight := Height;
2945   FIndex := -1;
2946   FOnChangeEvent := nil;
2947   FDrawBack := True;
2948   FDrawScroll := True;
2949 end;
2950
2951 procedure TGUIListBox.Draw;
2952 var
2953   w2, h2: Word;
2954   a: Integer;
2955   s: string;
2956 begin
2957   inherited;
2958
2959   if FDrawBack then DrawBox(FX, FY, FWidth+1, FHeight);
2960   if FDrawScroll then
2961     DrawScroll(FX+4+FWidth*16, FY+4, FHeight, (FStartLine > 0) and (FItems <> nil),
2962               (FStartLine+FHeight-1 < High(FItems)) and (FItems <> nil));
2963
2964   if FItems <> nil then
2965     for a := FStartLine to Min(High(FItems), FStartLine+FHeight-1) do
2966     begin
2967       s := Items[a];
2968
2969       FFont.GetTextSize(s, w2, h2);
2970       while (Length(s) > 0) and (w2 > FWidth*16) do
2971       begin
2972         SetLength(s, Length(s)-1);
2973         FFont.GetTextSize(s, w2, h2);
2974       end;
2975
2976       if a = FIndex then
2977         FFont.Draw(FX+4, FY+4+(a-FStartLine)*16, s, FActiveColor.R, FActiveColor.G, FActiveColor.B)
2978       else
2979         FFont.Draw(FX+4, FY+4+(a-FStartLine)*16, s, FUnActiveColor.R, FUnActiveColor.G, FUnActiveColor.B);
2980     end;
2981 end;
2982
2983 function TGUIListBox.GetHeight: Integer;
2984 begin
2985   Result := 8+FHeight*16;
2986 end;
2987
2988 function TGUIListBox.GetWidth: Integer;
2989 begin
2990   Result := 8+(FWidth+1)*16;
2991 end;
2992
2993 procedure TGUIListBox.OnMessage(var Msg: TMessage);
2994 var
2995   a: Integer;
2996 begin
2997   if not FEnabled then Exit;
2998
2999   inherited;
3000
3001   if FItems = nil then Exit;
3002
3003   with Msg do
3004     case Msg of
3005       WM_KEYDOWN:
3006         case wParam of
3007           IK_HOME, IK_KPHOME:
3008           begin
3009             FIndex := 0;
3010             FStartLine := 0;
3011           end;
3012           IK_END, IK_KPEND:
3013           begin
3014             FIndex := High(FItems);
3015             FStartLine := Max(High(FItems)-FHeight+1, 0);
3016           end;
3017           IK_UP, IK_LEFT, IK_KPUP, IK_KPLEFT:
3018             if FIndex > 0 then
3019             begin
3020               Dec(FIndex);
3021               if FIndex < FStartLine then Dec(FStartLine);
3022               if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
3023             end;
3024           IK_DOWN, IK_RIGHT, IK_KPDOWN, IK_KPRIGHT:
3025             if FIndex < High(FItems) then
3026             begin
3027               Inc(FIndex);
3028               if FIndex > FStartLine+FHeight-1 then Inc(FStartLine);
3029               if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
3030             end;
3031           IK_RETURN, IK_KPRETURN:
3032             with FWindow do
3033             begin
3034               if FActiveControl <> Self then SetActive(Self)
3035               else
3036                 if FDefControl <> '' then SetActive(GetControl(FDefControl))
3037                 else SetActive(nil);
3038             end;
3039         end;
3040       WM_CHAR:
3041         for a := 0 to High(FItems) do
3042           if (Length(FItems[a]) > 0) and (LowerCase(FItems[a][1]) = LowerCase(Chr(wParam))) then
3043           begin
3044             FIndex := a;
3045             FStartLine := Min(Max(FIndex-1, 0), Length(FItems)-FHeight);
3046             if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
3047             Break;
3048           end;
3049     end;
3050 end;
3051
3052 function TGUIListBox.SelectedItem(): String;
3053 begin
3054   Result := '';
3055
3056   if (FIndex < 0) or (FItems = nil) or
3057      (FIndex > High(FItems)) then
3058     Exit;
3059
3060   Result := FItems[FIndex];
3061 end;
3062
3063 procedure TGUIListBox.FSetItems(Items: SSArray);
3064 begin
3065   if FItems <> nil then
3066     FItems := nil;
3067
3068   FItems := Items;
3069
3070   FStartLine := 0;
3071   FIndex := -1;
3072
3073   if FSort then g_Basic.Sort(FItems);
3074 end;
3075
3076 procedure TGUIListBox.SelectItem(Item: String);
3077 var
3078   a: Integer;
3079 begin
3080   if FItems = nil then
3081     Exit;
3082
3083   FIndex := 0;
3084   Item := LowerCase(Item);
3085
3086   for a := 0 to High(FItems) do
3087     if LowerCase(FItems[a]) = Item then
3088     begin
3089       FIndex := a;
3090       Break;
3091     end;
3092
3093   if FIndex < FHeight then
3094     FStartLine := 0
3095   else
3096     FStartLine := Min(FIndex, Length(FItems)-FHeight);
3097 end;
3098
3099 procedure TGUIListBox.FSetIndex(aIndex: Integer);
3100 begin
3101   if FItems = nil then
3102     Exit;
3103
3104   if (aIndex < 0) or (aIndex > High(FItems)) then
3105     Exit;
3106
3107   FIndex := aIndex;
3108
3109   if FIndex <= FHeight then
3110     FStartLine := 0
3111   else
3112     FStartLine := Min(FIndex, Length(FItems)-FHeight);
3113 end;
3114
3115 { TGUIFileListBox }
3116
3117 procedure TGUIFileListBox.OnMessage(var Msg: TMessage);
3118 var
3119   a: Integer;
3120 begin
3121   if not FEnabled then
3122     Exit;
3123
3124   if FItems = nil then
3125     Exit;
3126
3127   with Msg do
3128     case Msg of
3129       WM_KEYDOWN:
3130         case wParam of
3131           IK_HOME, IK_KPHOME:
3132             begin
3133               FIndex := 0;
3134               FStartLine := 0;
3135               if @FOnChangeEvent <> nil then
3136                 FOnChangeEvent(Self);
3137             end;
3138
3139           IK_END, IK_KPEND:
3140             begin
3141               FIndex := High(FItems);
3142               FStartLine := Max(High(FItems)-FHeight+1, 0);
3143               if @FOnChangeEvent <> nil then
3144                 FOnChangeEvent(Self);
3145             end;
3146
3147           IK_PAGEUP, IK_KPPAGEUP:
3148             begin
3149               if FIndex > FHeight then
3150                 FIndex := FIndex-FHeight
3151               else
3152                 FIndex := 0;
3153
3154               if FStartLine > FHeight then
3155                 FStartLine := FStartLine-FHeight
3156               else
3157                 FStartLine := 0;
3158             end;
3159
3160           IK_PAGEDN, IK_KPPAGEDN:
3161             begin
3162               if FIndex < High(FItems)-FHeight then
3163                 FIndex := FIndex+FHeight
3164               else
3165                 FIndex := High(FItems);
3166
3167               if FStartLine < High(FItems)-FHeight then
3168                 FStartLine := FStartLine+FHeight
3169               else
3170                 FStartLine := High(FItems)-FHeight+1;
3171             end;
3172
3173           IK_UP, IK_LEFT, IK_KPUP, IK_KPLEFT:
3174             if FIndex > 0 then
3175             begin
3176               Dec(FIndex);
3177               if FIndex < FStartLine then
3178                 Dec(FStartLine);
3179               if @FOnChangeEvent <> nil then
3180                 FOnChangeEvent(Self);
3181             end;
3182
3183           IK_DOWN, IK_RIGHT, IK_KPDOWN, IK_KPRIGHT:
3184             if FIndex < High(FItems) then
3185             begin
3186               Inc(FIndex);
3187               if FIndex > FStartLine+FHeight-1 then
3188                 Inc(FStartLine);
3189               if @FOnChangeEvent <> nil then
3190                 FOnChangeEvent(Self);
3191             end;
3192
3193           IK_RETURN, IK_KPRETURN:
3194             with FWindow do
3195             begin
3196               if FActiveControl <> Self then
3197                 SetActive(Self)
3198               else
3199                 begin
3200                   if FItems[FIndex][1] = #29 then // Ïàïêà
3201                   begin
3202                     OpenDir(FPath+Copy(FItems[FIndex], 2, 255));
3203                     FIndex := 0;
3204                     Exit;
3205                   end;
3206
3207                   if FDefControl <> '' then
3208                     SetActive(GetControl(FDefControl))
3209                   else
3210                     SetActive(nil);
3211                 end;
3212             end;
3213         end;
3214
3215       WM_CHAR:
3216         for a := 0 to High(FItems) do
3217           if ( (Length(FItems[a]) > 0) and
3218                (LowerCase(FItems[a][1]) = LowerCase(Chr(wParam))) ) or
3219              ( (Length(FItems[a]) > 1) and
3220                (FItems[a][1] = #29) and // Ïàïêà
3221                (LowerCase(FItems[a][2]) = LowerCase(Chr(wParam))) ) then
3222           begin
3223             FIndex := a;
3224             FStartLine := Min(Max(FIndex-1, 0), Length(FItems)-FHeight);
3225             if @FOnChangeEvent <> nil then
3226               FOnChangeEvent(Self);
3227             Break;
3228           end;
3229     end;
3230 end;
3231
3232 procedure TGUIFileListBox.OpenDir(path: String);
3233 var
3234   SR: TSearchRec;
3235   i: Integer;
3236   sm, sc: string;
3237 begin
3238   Clear();
3239
3240   path := IncludeTrailingPathDelimiter(path);
3241   path := ExpandFileName(path);
3242
3243   // Êàòàëîãè:
3244   if FDirs then
3245   begin
3246     if FindFirst(path+'*', faDirectory, SR) = 0 then
3247     repeat
3248       if not LongBool(SR.Attr and faDirectory) then
3249         Continue;
3250       if (SR.Name = '.') or
3251          ((SR.Name = '..') and (path = ExpandFileName(FBasePath))) then
3252         Continue;
3253
3254       AddItem(#1 + SR.Name);
3255     until FindNext(SR) <> 0;
3256
3257     FindClose(SR);
3258   end;
3259
3260   // Ôàéëû:
3261   sm := FFileMask;
3262   while sm <> '' do
3263   begin
3264     i := Pos('|', sm);
3265     if i = 0 then i := length(sm)+1;
3266     sc := Copy(sm, 1, i-1);
3267     Delete(sm, 1, i);
3268     if FindFirst(path+sc, faAnyFile, SR) = 0 then repeat AddItem(SR.Name); until FindNext(SR) <> 0;
3269     FindClose(SR);
3270   end;
3271
3272   for i := 0 to High(FItems) do
3273     if FItems[i][1] = #1 then
3274       FItems[i][1] := #29;
3275
3276   FPath := path;
3277 end;
3278
3279 procedure TGUIFileListBox.SetBase(path: String);
3280 begin
3281   FBasePath := path;
3282   OpenDir(FBasePath);
3283 end;
3284
3285 function TGUIFileListBox.SelectedItem(): String;
3286 begin
3287   Result := '';
3288
3289   if (FIndex = -1) or (FItems = nil) or
3290      (FIndex > High(FItems)) or
3291      (FItems[FIndex][1] = '/') or
3292      (FItems[FIndex][1] = '\') then
3293     Exit;
3294
3295   Result := FPath + FItems[FIndex];
3296 end;
3297
3298 procedure TGUIFileListBox.UpdateFileList();
3299 var
3300   fn: String;
3301 begin
3302   if (FIndex = -1) or (FItems = nil) or
3303      (FIndex > High(FItems)) or
3304      (FItems[FIndex][1] = '/') or
3305      (FItems[FIndex][1] = '\') then
3306     fn := ''
3307   else
3308     fn := FItems[FIndex];
3309
3310   OpenDir(FPath);
3311
3312   if fn <> '' then
3313     SelectItem(fn);
3314 end;
3315
3316 { TGUIMemo }
3317
3318 procedure TGUIMemo.Clear;
3319 begin
3320   FLines := nil;
3321   FStartLine := 0;
3322 end;
3323
3324 constructor TGUIMemo.Create(FontID: DWORD; Width, Height: Word);
3325 begin
3326   inherited Create();
3327
3328   FFont := TFont.Create(FontID, TFontType.Character);
3329
3330   FWidth := Width;
3331   FHeight := Height;
3332   FDrawBack := True;
3333   FDrawScroll := True;
3334 end;
3335
3336 procedure TGUIMemo.Draw;
3337 var
3338   a: Integer;
3339 begin
3340   inherited;
3341
3342   if FDrawBack then DrawBox(FX, FY, FWidth+1, FHeight);
3343   if FDrawScroll then
3344     DrawScroll(FX+4+FWidth*16, FY+4, FHeight, (FStartLine > 0) and (FLines <> nil),
3345               (FStartLine+FHeight-1 < High(FLines)) and (FLines <> nil));
3346
3347   if FLines <> nil then
3348     for a := FStartLine to Min(High(FLines), FStartLine+FHeight-1) do
3349       FFont.Draw(FX+4, FY+4+(a-FStartLine)*16, FLines[a], FColor.R, FColor.G, FColor.B);
3350 end;
3351
3352 function TGUIMemo.GetHeight: Integer;
3353 begin
3354   Result := 8+FHeight*16;
3355 end;
3356
3357 function TGUIMemo.GetWidth: Integer;
3358 begin
3359   Result := 8+(FWidth+1)*16;
3360 end;
3361
3362 procedure TGUIMemo.OnMessage(var Msg: TMessage);
3363 begin
3364   if not FEnabled then Exit;
3365
3366   inherited;
3367
3368   if FLines = nil then Exit;
3369
3370   with Msg do
3371     case Msg of
3372       WM_KEYDOWN:
3373         case wParam of
3374           IK_UP, IK_LEFT, IK_KPUP, IK_KPLEFT:
3375             if FStartLine > 0 then
3376               Dec(FStartLine);
3377           IK_DOWN, IK_RIGHT, IK_KPDOWN, IK_KPRIGHT:
3378             if FStartLine < Length(FLines)-FHeight then
3379               Inc(FStartLine);
3380           IK_RETURN, IK_KPRETURN:
3381             with FWindow do
3382             begin
3383               if FActiveControl <> Self then
3384               begin
3385                 SetActive(Self);
3386                 {FStartLine := 0;}
3387               end
3388               else
3389               if FDefControl <> '' then SetActive(GetControl(FDefControl))
3390                 else SetActive(nil);
3391             end;
3392         end;
3393     end;
3394 end;
3395
3396 procedure TGUIMemo.SetText(Text: string);
3397 begin
3398   FStartLine := 0;
3399   FLines := GetLines(Text, FFont.ID, FWidth*16);
3400 end;
3401
3402 { TGUIimage }
3403
3404 procedure TGUIimage.ClearImage();
3405 begin
3406   if FImageRes = '' then Exit;
3407
3408   g_Texture_Delete(FImageRes);
3409   FImageRes := '';
3410 end;
3411
3412 constructor TGUIimage.Create();
3413 begin
3414   inherited Create();
3415
3416   FImageRes := '';
3417 end;
3418
3419 destructor TGUIimage.Destroy();
3420 begin
3421   inherited;
3422 end;
3423
3424 procedure TGUIimage.Draw();
3425 var
3426   ID: DWORD;
3427 begin
3428   inherited;
3429
3430   if FImageRes = '' then
3431   begin
3432     if g_Texture_Get(FDefaultRes, ID) then e_Draw(ID, FX, FY, 0, True, False);
3433   end
3434   else
3435     if g_Texture_Get(FImageRes, ID) then e_Draw(ID, FX, FY, 0, True, False);
3436 end;
3437
3438 procedure TGUIimage.OnMessage(var Msg: TMessage);
3439 begin
3440   inherited;
3441 end;
3442
3443 procedure TGUIimage.SetImage(Res: string);
3444 begin
3445   ClearImage();
3446
3447   if g_Texture_CreateWADEx(Res, Res) then FImageRes := Res;
3448 end;
3449
3450 procedure TGUIimage.Update();
3451 begin
3452   inherited;
3453 end;
3454
3455 end.