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