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