src/game/g_gui.pas

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