src/game/g_gui.pas

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