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