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