src/game/g_gui.pas

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