src/game/g_gui.pas

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