src/game/g_gui.pas

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