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