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