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