src/game/g_gui.pas

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