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