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