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