src/game/g_gui.pas

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