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