src/game/g_gui.pas

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