src/game/g_gui.pas

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