src/game/g_gui.pas

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