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