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