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