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