diff --git a/src/game/g_gui.pas b/src/game/g_gui.pas
index 2f9bc08380d79cf1ba7447ce1800a727463e3ec4..fbab591b37059bcbad512a6615e9f4f88067c78d 100644 (file)
--- a/src/game/g_gui.pas
+++ b/src/game/g_gui.pas
+(* Copyright (C) DooM 2D:Forever Developers
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program. If not, see <http://www.gnu.org/licenses/>.
+ *)
+{$MODE DELPHI}
unit g_gui;
interface
uses
- e_graphics, e_input, g_playermodel, g_basic, MAPSTRUCT, WADEDITOR;
+ e_graphics, e_input, e_log, g_playermodel, g_basic, MAPSTRUCT, wadreader;
const
MAINMENU_HEADER_COLOR: TRGB = (R:255; G:255; B:255);
end;
TGUIControl = class;
+ TGUIWindow = class;
TOnKeyDownEvent = procedure(Key: Byte);
+ TOnKeyDownEventEx = procedure(win: TGUIWindow; Key: Byte);
TOnCloseEvent = procedure;
TOnShowEvent = procedure;
TOnClickEvent = procedure;
TOnChangeEvent = procedure(Sender: TGUIControl);
TOnEnterEvent = procedure(Sender: TGUIControl);
- TGUIWindow = class;
-
TGUIControl = class
private
FX, FY: Integer;
FEnabled: Boolean;
FWindow : TGUIWindow;
FName: string;
+ FUserData: Pointer;
public
constructor Create;
procedure OnMessage(var Msg: TMessage); virtual;
property Y: Integer read FY write FY;
property Enabled: Boolean read FEnabled write FEnabled;
property Name: string read FName write FName;
+ property UserData: Pointer read FUserData write FUserData;
end;
TGUIWindow = class
FBackTexture: string;
FMainWindow: Boolean;
FOnKeyDown: TOnKeyDownEvent;
+ FOnKeyDownEx: TOnKeyDownEventEx;
FOnCloseEvent: TOnCloseEvent;
FOnShowEvent: TOnShowEvent;
+ FUserData: Pointer;
public
Childs: array of TGUIControl;
constructor Create(Name: string);
procedure SetActive(Control: TGUIControl);
function GetControl(Name: string): TGUIControl;
property OnKeyDown: TOnKeyDownEvent read FOnKeyDown write FOnKeyDown;
+ property OnKeyDownEx: TOnKeyDownEventEx read FOnKeyDownEx write FOnKeyDownEx;
property OnClose: TOnCloseEvent read FOnCloseEvent write FOnCloseEvent;
property OnShow: TOnShowEvent read FOnShowEvent write FOnShowEvent;
property Name: string read FName;
property DefControl: string read FDefControl write FDefControl;
property BackTexture: string read FBackTexture write FBackTexture;
property MainWindow: Boolean read FMainWindow write FMainWindow;
+ property UserData: Pointer read FUserData write FUserData;
end;
TGUITextButton = class(TGUIControl)
FShowWindow: string;
public
Proc: procedure;
+ ProcEx: procedure (sender: TGUITextButton);
constructor Create(Proc: Pointer; FontID: DWORD; Text: string);
destructor Destroy(); override;
procedure OnMessage(var Msg: TMessage); override;
FCounter: Byte;
FAlign: Boolean;
FLeft: Integer;
+ FYesNo: Boolean;
function NewItem(): Integer;
public
constructor Create(HeaderFont, ItemsFont: DWORD; Header: string);
procedure UpdateIndex();
property Align: Boolean read FAlign write FAlign;
property Left: Integer read FLeft write FLeft;
+ property YesNo: Boolean read FYesNo write FYesNo;
end;
var
FActiveControl := nil;
FName := Name;
FOnKeyDown := nil;
+ FOnKeyDownEx := nil;
FOnCloseEvent := nil;
FOnShowEvent := nil;
end;
begin
if FActiveControl <> nil then FActiveControl.OnMessage(Msg);
if @FOnKeyDown <> nil then FOnKeyDown(Msg.wParam);
+ if @FOnKeyDownEx <> nil then FOnKeyDownEx(self, Msg.wParam);
if Msg.Msg = WM_KEYDOWN then
if Msg.wParam = IK_ESCAPE then
procedure TGUITextButton.Click(Silent: Boolean = False);
begin
- if (FSound <> '') and (not Silent) then
- g_Sound_PlayEx(FSound);
+ if (FSound <> '') and (not Silent) then g_Sound_PlayEx(FSound);
+
+ if @Proc <> nil then Proc();
+ if @ProcEx <> nil then ProcEx(self);
- if @Proc <> nil then
- Proc();
- if FShowWindow <> '' then
- g_GUI_ShowWindow(FShowWindow);
+ if FShowWindow <> '' then g_GUI_ShowWindow(FShowWindow);
end;
constructor TGUITextButton.Create(Proc: Pointer; FontID: DWORD; Text: string);
inherited Create();
Self.Proc := Proc;
+ ProcEx := nil;
FFont := TFont.Create(FontID, FONT_CHAR);
with FItems[i] do
begin
Text := TGUILabel.Create(l[a], FFontID);
- with Text do
+ if FYesNo then
begin
- FColor := MENU_ITEMSTEXT_COLOR;
+ with Text do begin FColor := _RGB(255, 0, 0); end;
+ end
+ else
+ begin
+ with Text do begin FColor := MENU_ITEMSTEXT_COLOR; end;
end;
Control := nil;
FFontID := ItemsFont;
FCounter := MENU_MARKERDELAY;
FAlign := True;
+ FYesNo := false;
FHeader := TGUILabel.Create(Header, HeaderFont);
with FHeader do
if FItems[FIndex].Control <> nil then
FItems[FIndex].Control.OnMessage(Msg);
end;
- IK_RETURN, IK_KPRETURN:
+ IK_RETURN, IK_KPRETURN, IK_BACKSPACE:
begin
if FIndex <> -1 then
- if FItems[FIndex].Control <> nil then
- FItems[FIndex].Control.OnMessage(Msg);
-
+ begin
+ if FItems[FIndex].Control <> nil then FItems[FIndex].Control.OnMessage(Msg);
+ end;
g_Sound_PlayEx(MENU_CLICKSOUND);
end;
+ // dirty hacks
+ IK_Y:
+ if FYesNo and (length(FItems) > 1) then
+ begin
+ Msg.wParam := IK_RETURN; // to register keypress
+ FIndex := High(FItems)-1;
+ if FItems[FIndex].Control <> nil then FItems[FIndex].Control.OnMessage(Msg);
+ end;
+ IK_N:
+ if FYesNo and (length(FItems) > 1) then
+ begin
+ Msg.wParam := IK_RETURN; // to register keypress
+ FIndex := High(FItems);
+ if FItems[FIndex].Control <> nil then FItems[FIndex].Control.OnMessage(Msg);
+ end;
end;
end;
end;
cx := 0;
for a := 0 to High(FItems) do
+ begin
with FItems[a] do
begin
if (Text <> nil) and (Control = nil) then Continue;
-
w := 0;
if Text <> nil then w := tx+Text.GetWidth;
-
if w > cx then cx := w;
end;
+ end;
cx := cx+MENU_HSPACE;
h := FHeader.GetHeight*2+MENU_VSPACE*(Length(FItems)-1);
for a := 0 to High(FItems) do
+ begin
with FItems[a] do
begin
if (ControlType = TGUIListBox) or (ControlType = TGUIFileListBox) then
else
h := h+e_CharFont_GetMaxHeight(FFontID);
end;
+ end;
h := (gScreenHeight div 2)-(h div 2);
else
Inc(h, e_CharFont_GetMaxHeight(FFontID)+MENU_VSPACE);
end;
+
+ // another ugly hack
+ if FYesNo and (length(FItems) > 1) then
+ begin
+ w := -1;
+ for a := High(FItems)-1 to High(FItems) do
+ begin
+ if (FItems[a].Control <> nil) and (FItems[a].ControlType = TGUITextButton) then
+ begin
+ cx := (FItems[a].Control as TGUITextButton).GetWidth;
+ if cx > w then w := cx;
+ end;
+ end;
+ if w > 0 then
+ begin
+ for a := High(FItems)-1 to High(FItems) do
+ begin
+ if (FItems[a].Control <> nil) and (FItems[a].ControlType = TGUITextButton) then
+ begin
+ FItems[a].Control.FX := (gScreenWidth-w) div 2;
+ end;
+ end;
+ end;
+ end;
end;
function TGUIMenu.AddScroll(fText: string): TGUIScroll;
end;
procedure TGUIKeyRead.OnMessage(var Msg: TMessage);
+ procedure actDefCtl ();
+ begin
+ with FWindow do
+ if FDefControl <> '' then
+ SetActive(GetControl(FDefControl))
+ else
+ SetActive(nil);
+ end;
+
begin
inherited;
case wParam of
IK_ESCAPE:
begin
- if FIsQuery then
- with FWindow do
- if FDefControl <> '' then
- SetActive(GetControl(FDefControl))
- else
- SetActive(nil);
-
+ if FIsQuery then actDefCtl();
FIsQuery := False;
end;
IK_RETURN, IK_KPRETURN:
begin
FKey := IK_ENTER; // <Enter>
FIsQuery := False;
-
- with FWindow do
- if FDefControl <> '' then
- SetActive(GetControl(FDefControl))
- else
- SetActive(nil);
+ actDefCtl();
end;
end;
+ IK_BACKSPACE: // clear keybinding if we aren't waiting for a key
+ begin
+ if not FIsQuery then
+ begin
+ FKey := 0;
+ actDefCtl();
+ end;
+ end;
end;
MESSAGE_DIKEY:
- if FIsQuery and (wParam <> IK_ENTER) and (wParam <> IK_KPRETURN) then // Not <Enter
begin
- if e_KeyNames[wParam] <> '' then
- FKey := wParam;
- FIsQuery := False;
-
- with FWindow do
- if FDefControl <> '' then
- SetActive(GetControl(FDefControl))
- else
- SetActive(nil);
+ if not FIsQuery and (wParam = IK_BACKSPACE) then
+ begin
+ FKey := 0;
+ actDefCtl();
+ end
+ else if FIsQuery and (wParam <> IK_ENTER) and (wParam <> IK_KPRETURN) then // Not <Enter
+ begin
+ e_WriteLog(Format('HIT! %s', ['3']), MSG_WARNING);
+ if e_KeyNames[wParam] <> '' then
+ FKey := wParam;
+ FIsQuery := False;
+ actDefCtl();
+ end;
end;
end;
end;
procedure TGUIMapPreview.SetMap(Res: string);
var
- WAD: TWADEditor_1;
+ WAD: TWADFile;
MapReader: TMapReader_1;
panels: TPanelsRec1Array;
header: TMapHeaderRec_1;
a: Integer;
- FileName, SectionName, ResName: string;
+ FileName: string;
Data: Pointer;
Len: Integer;
rX, rY: Single;
begin
- g_ProcessResourceStr(Res, FileName, SectionName, ResName);
+ FileName := g_ExtractWadName(Res);
- WAD := TWADEditor_1.Create();
+ WAD := TWADFile.Create();
if not WAD.ReadFile(FileName) then
begin
WAD.Free();
Exit;
end;
- if not WAD.GetResource('', ResName, Data, Len) then
+ //k8: ignores path again
+ if not WAD.GetMapResource(g_ExtractFileName(Res), Data, Len) then
begin
WAD.Free();
Exit;
var
SR: TSearchRec;
i: Integer;
+ sm, sc: string;
begin
Clear();
path := IncludeTrailingPathDelimiter(path);
path := ExpandFileName(path);
-// Êàòàëîãè:
+ // Êàòàëîãè:
if FDirs then
begin
if FindFirst(path+'*', faDirectory, SR) = 0 then
FindClose(SR);
end;
-// Ôàéëû:
- if FindFirst(path+FFileMask, faAnyFile, SR) = 0 then
- repeat
- AddItem(SR.Name);
- until FindNext(SR) <> 0;
- FindClose(SR);
-
- //FIXME: HACK!
- if FFileMask = '*.wad' then
+ // Ôàéëû:
+ sm := FFileMask;
+ while sm <> '' do
begin
- if FindFirst(path+'*.pk3', faAnyFile, SR) = 0 then
- repeat
- AddItem(SR.Name);
- until FindNext(SR) <> 0;
+ i := Pos('|', sm);
+ if i = 0 then i := length(sm)+1;
+ sc := Copy(sm, 1, i-1);
+ Delete(sm, 1, i);
+ if FindFirst(path+sc, faAnyFile, SR) = 0 then repeat AddItem(SR.Name); until FindNext(SR) <> 0;
FindClose(SR);
end;