diff --git a/src/game/g_basic.pas b/src/game/g_basic.pas
index 2c540aad0a617fc7c2c51f3bc8060e7e4d057861..c7a834beb158b26c35bb5741491706f7fb87fe44 100644 (file)
--- a/src/game/g_basic.pas
+++ b/src/game/g_basic.pas
-(* Copyright (C) DooM 2D:Forever Developers
+(* 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.
+ * the Free Software Foundation, version 3 of the License ONLY.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
interface
uses
- wadreader, g_phys;
+ utils, g_phys;
const
GAME_VERSION = '0.667';
+ GAME_BUILDDATE = {$I %DATE%};
+ GAME_BUILDTIME = {$I %TIME%};
UID_GAME = 1;
UID_PLAYER = 2;
UID_MONSTER = 3;
DWArray = array of DWORD;
String20 = String[20];
+function g_GetBuilderName (): AnsiString;
+function g_GetBuildHash (full: Boolean = True): AnsiString;
+function g_GetBuildArch (): AnsiString;
+
function g_CreateUID(UIDType: Byte): Word;
function g_GetUIDType(UID: Word): Byte;
function g_Collide(X1, Y1: Integer; Width1, Height1: Word;
- X2, Y2: Integer; Width2, Height2: Word): Boolean;
+ X2, Y2: Integer; Width2, Height2: Word): Boolean; inline;
function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
-function g_CollidePoint(X, Y, X2, Y2: Integer; Width, Height: Word): Boolean;
-function g_CollideLevel(X, Y: Integer; Width, Height: Word): Boolean;
+function g_CollidePoint(X, Y, X2, Y2: Integer; Width, Height: Word): Boolean; inline;
+function g_CollideLevel(X, Y: Integer; Width, Height: Word): Boolean; inline;
function g_CollideAround(X1, Y1: Integer; Width1, Height1: Word;
- X2, Y2: Integer; Width2, Height2: Word): Boolean;
-function g_CollidePlayer(X, Y: Integer; Width, Height: Word): Boolean;
-function g_CollideMonster(X, Y: Integer; Width, Height: Word): Boolean;
-function g_CollideItem(X, Y: Integer; Width, Height: Word): Boolean;
+ X2, Y2: Integer; Width2, Height2: Word): Boolean; inline;
+function g_CollidePlayer(X, Y: Integer; Width, Height: Word): Boolean; inline;
function g_PatchLength(X1, Y1, X2, Y2: Integer): Word;
-function g_TraceVector(X1, Y1, X2, Y2: Integer): Boolean;
+function g_TraceVector(X1, Y1, X2, Y2: Integer): Boolean; // `true`: no wall hit
function g_GetAcidHit(X, Y: Integer; Width, Height: Word): Byte;
function g_Look(a, b: PObj; d: TDirection): Boolean;
procedure IncMax(var A: Integer; B, Max: Integer); overload;
function PointToRect(X, Y, X1, Y1: Integer; Width, Height: Word): Integer;
function GetAngle(baseX, baseY, pointX, PointY: Integer): SmallInt;
function GetAngle2(vx, vy: Integer): SmallInt;
-function GetLines(Text: string; FontID: DWORD; MaxWidth: Word): SArray;
-procedure Sort(var a: SArray);
+function GetLines(Text: string; FontID: DWORD; MaxWidth: Word): SSArray;
+procedure Sort(var a: SSArray);
function Sscanf(const s: string; const fmt: string;
const Pointers: array of Pointer): Integer;
function InDWArray(a: DWORD; arr: DWArray): Boolean;
function InWArray(a: Word; arr: WArray): Boolean;
-function InSArray(a: string; arr: SArray): Boolean;
+function InSArray(a: string; arr: SSArray): Boolean;
function GetPos(UID: Word; o: PObj): Boolean;
-function parse(s: string): SArray;
-function parse2(s: string; delim: Char): SArray;
+function parse(s: string): SSArray;
+function parse2(s: string; delim: Char): SSArray;
function g_GetFileTime(fileName: String): Integer;
function g_SetFileTime(fileName: String; time: Integer): Boolean;
-procedure SortSArray(var S: SArray);
+procedure SortSArray(var S: SSArray);
function b_Text_Format(S: string): string;
function b_Text_Unformat(S: string): string;
+function b_Text_Wrap(S: string; LineLen: Integer): string;
+function b_Text_LineCount(S: string): Integer;
+
+var
+ gmon_dbg_los_enabled: Boolean = true;
implementation
uses
- Math, g_map, g_gfx, g_player, SysUtils, MAPDEF,
- StrUtils, e_graphics, g_monsters, g_items;
+ Math, geom, e_log, g_map, g_gfx, g_player, SysUtils, MAPDEF,
+ StrUtils, e_graphics, g_monsters, g_items, g_game;
+
+{$PUSH}
+{$WARN 2054 OFF} // unknwon env var
+{$WARN 6018 OFF} // unreachable code
+function g_GetBuilderName (): AnsiString;
+begin
+ if {$I %D2DF_BUILD_USER%} <> '' then
+ result := {$I %D2DF_BUILD_USER%} // custom
+ else if {$I %USER%} <> '' then
+ result := {$I %USER%} // unix username
+ else if {$I %USERNAME%} <> '' then
+ result := {$I %USERNAME%} // windows username
+ else
+ result := 'unknown'
+end;
+
+function g_GetBuildHash (full: Boolean = True): AnsiString;
+begin
+ if {$I %D2DF_BUILD_HASH%} <> '' then
+ if full then
+ result := {$I %D2DF_BUILD_HASH%}
+ else
+ result := Copy({$I %D2DF_BUILD_HASH%}, 1, 7)
+ else
+ result := 'custom build'
+end;
+{$POP}
+
+function g_GetBuildArch (): AnsiString;
+ var cpu, mode, fpu: AnsiString;
+begin
+ {$IF DEFINED(CPUX86_64) OR DEFINED(CPUAMD64) OR DEFINED(CPUX64)}
+ cpu := 'x86_64';
+ {$ELSEIF DEFINED(CPUI386) OR DEFINED(CPU386)}
+ cpu := 'x86';
+ {$ELSEIF DEFINED(CPUI8086)}
+ cpu := 'i8086';
+ {$ELSEIF DEFINED(CPUI64)}
+ cpu := 'Itanium64';
+ {$ELSEIF DEFINED(CPUARM)}
+ cpu := 'ARM';
+ {$ELSEIF DEFINED(CPUAVR)}
+ cpu := 'AVR';
+ {$ELSEIF DEFINED(CPUPOWERPC32)}
+ cpu := 'PowerPC_32';
+ {$ELSEIF DEFINED(CPUPOWERPC64)}
+ cpu := 'PowerPC_64';
+ {$ELSEIF DEFINED(CPUALPHA)}}
+ cpu := 'Alpha';
+ {$ELSEIF DEFINED(CPUSPARC32)}
+ cpu := 'Sparc32';
+ {$ELSEIF DEFINED(CPUM68020)}
+ cpu := 'M68020';
+ {$ELSEIF DEFINED(CPU68K) OR DEFINED(CPUM68K)}
+ cpu := 'm68k';
+ {$ELSEIF DEFINED(CPUSPARC)}
+ cpu := 'unknown-sparc';
+ {$ELSEIF DEFINED(CPUPOWERPC)}
+ cpu := 'unknown-ppc';
+ {$ELSEIF DEFINED(CPU86) OR DEFINED(CPU87)}
+ cpu := 'unknown-intel';
+ {$ELSE}
+ cpu := 'unknown-arch';
+ {$ENDIF}
+
+ {$IF DEFINED(CPU64)}
+ mode := '64-bit';
+ {$ELSEIF DEFINED(CPU32)}
+ mode := '32-bit';
+ {$ELSEIF DEFINED(CPU16)}
+ mode := '16-bit';
+ {$ELSE}
+ mode := 'unknown-mode';
+ {$ENDIF}
+
+ {$IF DEFINED(FPUSOFT)}
+ fpu := 'soft';
+ {$ELSEIF DEFINED(FPUSSE3)}
+ fpu := 'sse3';
+ {$ELSEIF DEFINED(FPUSSE2)}
+ fpu := 'sse2';
+ {$ELSEIF DEFINED(FPUSSE)}
+ fpu := 'sse';
+ {$ELSEIF DEFINED(FPUSSE64)}
+ fpu := 'sse64';
+ {$ELSEIF DEFINED(FPULIBGCC)}
+ fpu := 'libgcc';
+ {$ELSEIF DEFINED(FPU68881)}
+ fpu := '68881';
+ {$ELSEIF DEFINED(FPUVFP)}
+ fpu := 'vfp';
+ {$ELSEIF DEFINED(FPUFPA11)}
+ fpu := 'fpa11';
+ {$ELSEIF DEFINED(FPUFPA10)}
+ fpu := 'fpa10';
+ {$ELSEIF DEFINED(FPUFPA)}
+ fpu := 'fpa';
+ {$ELSEIF DEFINED(FPUX87)}
+ fpu := 'x87';
+ {$ELSEIF DEFINED(FPUITANIUM)}
+ fpu := 'itanium';
+ {$ELSEIF DEFINED(FPUSTANDARD)}
+ fpu := 'standard';
+ {$ELSEIF DEFINED(FPUHARD)}
+ fpu := 'hard';
+ {$ELSE}
+ fpu := 'unknown-fpu';
+ {$ENDIF}
+
+ result := cpu + ' ' + mode + ' ' + fpu;
+end;
function g_PatchLength(X1, Y1, X2, Y2: Integer): Word;
begin
Result := Min(Round(Hypot(Abs(X2-X1), Abs(Y2-Y1))), 65535);
end;
-function g_CollideLevel(X, Y: Integer; Width, Height: Word): Boolean;
+function g_CollideLevel(X, Y: Integer; Width, Height: Word): Boolean; inline;
begin
result := g_Map_CollidePanel(X, Y, Width, Height, (PANEL_WALL or PANEL_CLOSEDOOR or PANEL_OPENDOOR), false);
end;
end;
*)
-function g_CollidePlayer(X, Y: Integer; Width, Height: Word): Boolean;
+function g_CollidePlayer(X, Y: Integer; Width, Height: Word): Boolean; inline;
var
a: Integer;
begin
if gPlayers = nil then Exit;
for a := 0 to High(gPlayers) do
- if (gPlayers[a] <> nil) and gPlayers[a].Live then
+ if (gPlayers[a] <> nil) and gPlayers[a].alive then
if gPlayers[a].Collide(X, Y, Width, Height) then
begin
Result := True;
end;
end;
-function g_CollideMonster(X, Y: Integer; Width, Height: Word): Boolean;
-var
- a: Integer;
-begin
- Result := False;
-
- if gMonsters = nil then Exit;
-
- for a := 0 to High(gMonsters) do
- if (gMonsters[a] <> nil) and gMonsters[a].Live then
- if g_Obj_Collide(X, Y, Width, Height, @gMonsters[a].Obj) then
- begin
- Result := True;
- Exit;
- end;
-end;
-
-function g_CollideItem(X, Y: Integer; Width, Height: Word): Boolean;
-var
- a: Integer;
-begin
- Result := False;
-
- if gItems = nil then
- Exit;
-
- for a := 0 to High(gItems) do
- if gItems[a].Live then
- if g_Obj_Collide(X, Y, Width, Height, @gItems[a].Obj) then
- begin
- Result := True;
- Exit;
- end;
-end;
function g_TraceVector(X1, Y1, X2, Y2: Integer): Boolean;
var
+ wallHitX: Integer = 0;
+ wallHitY: Integer = 0;
+(*
i: Integer;
dx, dy: Integer;
Xerr, Yerr, d: LongWord;
incX, incY: Integer;
x, y: Integer;
+*)
begin
- Result := False;
+ (*
+ result := False;
Assert(gCollideMap <> nil, 'g_TraceVector: gCollideMap = nil');
end;
Result := True;
+ *)
+
+ // `true` if no obstacles
+ if (g_profile_los) then g_Mons_LOS_Start();
+ result := (g_Map_traceToNearestWall(x1, y1, x2, y2, @wallHitX, @wallHitY) = nil);
+ if (g_profile_los) then g_Mons_LOS_End();
end;
+
function g_CreateUID(UIDType: Byte): Word;
var
ok: Boolean;
UID_MONSTER:
begin
- repeat
- Result := UID_MAX_PLAYER+$1+Random(UID_MAX_MONSTER-UID_MAX_GAME-UID_MAX_PLAYER+$1);
-
- ok := True;
- if gMonsters <> nil then
- for i := 0 to High(gMonsters) do
- if gMonsters[i] <> nil then
- if Result = gMonsters[i].UID then
- begin
- ok := False;
- Break;
- end;
- until ok;
+ //FIXME!!!
+ while true do
+ begin
+ result := UID_MAX_PLAYER+$1+Random(UID_MAX_MONSTER-UID_MAX_GAME-UID_MAX_PLAYER+$1);
+ if (g_Monsters_ByUID(result) = nil) then break;
+ end;
end;
end;
end;
end;
function g_Collide(X1, Y1: Integer; Width1, Height1: Word;
- X2, Y2: Integer; Width2, Height2: Word): Boolean;
+ X2, Y2: Integer; Width2, Height2: Word): Boolean; inline;
begin
Result := not ( ((Y1 + Height1 <= Y2) or
(Y2 + Height2 <= Y1)) or
end;
function g_CollideAround(X1, Y1: Integer; Width1, Height1: Word;
- X2, Y2: Integer; Width2, Height2: Word): Boolean;
+ X2, Y2: Integer; Width2, Height2: Word): Boolean; inline;
begin
Result := g_Collide(X1, Y1, Width1, Height1, X2, Y2, Width2, Height2) or
g_Collide(X1+1, Y1, Width1, Height1, X2, Y2, Width2, Height2) or
g_Collide(X1, Y1-1, Width1, Height1, X2, Y2, Width2, Height2);
end;
-function c(X1, Y1, Width1, Height1, X2, Y2, Width2, Height2: Integer): Boolean;
+function c(X1, Y1, Width1, Height1, X2, Y2, Width2, Height2: Integer): Boolean; inline;
begin
Result := not (((Y1 + Height1 <= Y2) or
(Y1 >= Y2 + Height2)) or
(X1 >= X2 + Width2)));
end;
-function g_Collide2(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer): Boolean;
+function g_Collide2(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer): Boolean; inline;
begin
//Result := not (((Y2 <= Y3) or (Y1 >= Y4)) or ((X2 <= X3) or (X1 >= X4)));
Result := c(X1, Y1, X2-X1, Y2-Y1, X3, Y3, X4-X3, Y4-Y3);
end;
-function g_CollidePoint(X, Y, X2, Y2: Integer; Width, Height: Word): Boolean;
+function g_CollidePoint(X, Y, X2, Y2: Integer; Width, Height: Word): Boolean; inline;
begin
X := X-X2;
Y := Y-Y2;
function g_Look(a, b: PObj; d: TDirection): Boolean;
begin
- if ((b^.X > a^.X) and (d = D_LEFT)) or
- ((b^.X < a^.X) and (d = D_RIGHT)) then
+ if not gmon_dbg_los_enabled then begin result := false; exit; end; // always "wall hit"
+
+ if ((b^.X > a^.X) and (d = TDirection.D_LEFT)) or
+ ((b^.X < a^.X) and (d = TDirection.D_RIGHT)) then
begin
Result := False;
Exit;
end;}
function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
+{
var
i: Integer;
dx, dy: Integer;
Xerr, Yerr: Integer;
incX, incY: Integer;
x, y, d: Integer;
+}
begin
+ result := lineAABBIntersects(x1, y1, x2, y2, rX, rY, rWidth, rHeight);
+{
Result := True;
Xerr := 0;
end;
Result := False;
+}
end;
function GetStr(var Str: string): string;
end;
end;
-{function GetLines(Text: string; MaxChars: Word): SArray;
-var
- a: Integer;
- b: array of string;
- str: string;
-begin
- Text := Trim(Text);
-
- while Pos(' ', Text) <> 0 do Text := AnsiReplaceStr(Text, ' ', ' ');
-
- while Text <> '' do
- begin
- SetLength(b, Length(b)+1);
- b[High(b)] := GetStr(Text);
- end;
-
- a := 0;
- while True do
- begin
- if a > High(b) then Break;
-
- str := b[a];
- a := a+1;
+function GetLines (Text: string; FontID: DWORD; MaxWidth: Word): SSArray;
+ var i, j, len, lines: Integer;
- if Length(str) >= MaxChars then
+ function GetLine (j, i: Integer): String;
begin
- while str <> '' do
- begin
- SetLength(Result, Length(Result)+1);
- Result[High(Result)] := Copy(str, 1, MaxChars);
- Delete(str, 1, MaxChars);
- end;
-
- Continue;
+ result := Copy(text, j, i - j + 1);
end;
- while (a <= High(b)) and (Length(str+' '+b[a]) <= MaxChars) do
+ function GetWidth (j, i: Integer): Integer;
+ var w, h: Word;
begin
- str := str+' '+b[a];
- a := a+1;
+ e_CharFont_GetSize(FontID, GetLine(j, i), w, h);
+ result := w
end;
- SetLength(Result, Length(Result)+1);
- Result[High(Result)] := str;
- end;
-end;}
-
-function GetLines(Text: string; FontID: DWORD; MaxWidth: Word): SArray;
-
-function TextLen(Text: string): Word;
-var
- h: Word;
-begin
- e_CharFont_GetSize(FontID, Text, Result, h);
-end;
-
-var
- a, c: Integer;
- b: array of string;
- str: string;
begin
- SetLength(Result, 0);
- SetLength(b, 0);
-
- Text := Trim(Text);
-
-// Óäàëÿåì ìíîæåñòâåííûå ïðîáåëû:
- while Pos(' ', Text) <> 0 do
- Text := AnsiReplaceStr(Text, ' ', ' ');
-
- while Text <> '' do
+ result := nil; lines := 0;
+ j := 1; i := 1; len := Length(Text);
+ // e_LogWritefln('GetLines @%s len=%s [%s]', [MaxWidth, len, Text]);
+ while j <= len do
begin
- SetLength(b, Length(b)+1);
- b[High(b)] := GetStr(Text);
- end;
-
- a := 0;
- while True do
- begin
- if a > High(b) then
- Break;
-
- str := b[a];
- a := a+1;
-
- if TextLen(str) > MaxWidth then
- begin // Òåêóùàÿ ñòðîêà ñëèøêîì äëèííàÿ => ðàçáèâàåì
- while str <> '' do
- begin
- SetLength(Result, Length(Result)+1);
-
- c := 0;
- while (c < Length(str)) and
- (TextLen(Copy(str, 1, c+1)) < MaxWidth) do
- c := c+1;
-
- Result[High(Result)] := Copy(str, 1, c);
- Delete(str, 1, c);
- end;
- end
- else // Ñòðîêà íîðìàëüíîé äëèíû => ñîåäèíÿåì ñî ñëåäóþùèìè
- begin
- while (a <= High(b)) and
- (TextLen(str+' '+b[a]) < MaxWidth) do
- begin
- str := str+' '+b[a];
- a := a + 1;
- end;
-
- SetLength(Result, Length(Result)+1);
- Result[High(Result)] := str;
- end;
+ (* --- Get longest possible sequence --- *)
+ while (i + 1 <= len) and (GetWidth(j, i + 1) <= MaxWidth) do Inc(i);
+ (* --- Do not include part of word --- *)
+ if (i < len) and (text[i] <> ' ') then
+ while (i >= j) and (text[i] <> ' ') do Dec(i);
+ (* --- Do not include spaces --- *)
+ while (i >= j) and (text[i] = ' ') do Dec(i);
+ (* --- Add line --- *)
+ SetLength(result, lines + 1);
+ result[lines] := GetLine(j, i);
+ // e_LogWritefln(' -> (%s:%s::%s) [%s]', [j, i, GetWidth(j, i), result[lines]]);
+ Inc(lines);
+ (* --- Skip spaces --- *)
+ while (i <= len) and (text[i] = ' ') do Inc(i);
+ j := i + 2;
end;
end;
-procedure Sort(var a: SArray);
+procedure Sort(var a: SSArray);
var
i, j: Integer;
s: string;
end;
end;
-function InSArray(a: string; arr: SArray): Boolean;
+function InSArray(a: string; arr: SSArray): Boolean;
var
b: Integer;
begin
begin
p := g_Player_Get(UID);
if p = nil then Exit;
- if not p.Live then Exit;
+ if not p.alive then Exit;
o^ := p.Obj;
end;
UID_MONSTER:
begin
- m := g_Monsters_Get(UID);
+ m := g_Monsters_ByUID(UID);
if m = nil then Exit;
- if not m.Live then Exit;
+ if not m.alive then Exit;
o^ := m.Obj;
end;
Result := True;
end;
-function parse(s: String): SArray;
+function parse(s: String): SSArray;
var
a: Integer;
begin
end;
end;
-function parse2(s: string; delim: Char): SArray;
+function parse2(s: string; delim: Char): SSArray;
var
a: Integer;
begin
CloseFile(F);
end;
-procedure SortSArray(var S: SArray);
+procedure SortSArray(var S: SSArray);
var
b: Boolean;
i: Integer;
end;
end;
+function b_Text_Wrap(S: string; LineLen: Integer): string;
+begin
+ Result := WrapText(S, ''#10, [#10, ' ', '-'], LineLen);
+end;
+
+function b_Text_LineCount(S: string): Integer;
+var
+ I: Integer;
+begin
+ Result := IfThen(S = '', 0, 1);
+ for I := 1 to High(S) do
+ if S[I] = #10 then
+ Inc(Result);
+end;
+
end.