1 (* Copyright (C) Doom 2D: Forever Developers
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.
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.
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/>.
15 {$INCLUDE ../shared/a_modes.inc}
24 GAME_VERSION
= '0.667';
25 GAME_BUILDDATE
= {$I %DATE%};
26 GAME_BUILDTIME
= {$I %TIME%};
32 UID_MAX_PLAYER
= $7FFF;
33 UID_MAX_MONSTER
= $FFFF;
36 TDirection
= (D_LEFT
, D_RIGHT
);
37 WArray
= array of Word;
38 DWArray
= array of DWORD
;
39 String20
= String[20];
41 function g_GetBuilderName (): AnsiString
;
42 function g_GetBuildHash (full
: Boolean = True): AnsiString
;
44 function g_CreateUID(UIDType
: Byte): Word;
45 function g_GetUIDType(UID
: Word): Byte;
46 function g_Collide(X1
, Y1
: Integer; Width1
, Height1
: Word;
47 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean; inline;
48 function g_CollideLine(x1
, y1
, x2
, y2
, rX
, rY
: Integer; rWidth
, rHeight
: Word): Boolean;
49 function g_CollidePoint(X
, Y
, X2
, Y2
: Integer; Width
, Height
: Word): Boolean; inline;
50 function g_CollideLevel(X
, Y
: Integer; Width
, Height
: Word): Boolean; inline;
51 function g_CollideAround(X1
, Y1
: Integer; Width1
, Height1
: Word;
52 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean; inline;
53 function g_CollidePlayer(X
, Y
: Integer; Width
, Height
: Word): Boolean; inline;
54 function g_PatchLength(X1
, Y1
, X2
, Y2
: Integer): Word;
55 function g_TraceVector(X1
, Y1
, X2
, Y2
: Integer): Boolean; // `true`: no wall hit
56 function g_GetAcidHit(X
, Y
: Integer; Width
, Height
: Word): Byte;
57 function g_Look(a
, b
: PObj
; d
: TDirection
): Boolean;
58 procedure IncMax(var A
: Integer; B
, Max
: Integer); overload
;
59 procedure IncMax(var A
: Single; B
, Max
: Single); overload
;
60 procedure IncMax(var A
: Integer; Max
: Integer); overload
;
61 procedure IncMax(var A
: Single; Max
: Single); overload
;
62 procedure IncMax(var A
: Word; B
, Max
: Word); overload
;
63 procedure IncMax(var A
: Word; Max
: Word); overload
;
64 procedure IncMax(var A
: SmallInt
; B
, Max
: SmallInt
); overload
;
65 procedure IncMax(var A
: SmallInt
; Max
: SmallInt
); overload
;
66 procedure DecMin(var A
: Integer; B
, Min
: Integer); overload
;
67 procedure DecMin(var A
: Single; B
, Min
: Single); overload
;
68 procedure DecMin(var A
: Integer; Min
: Integer); overload
;
69 procedure DecMin(var A
: Single; Min
: Single); overload
;
70 procedure DecMin(var A
: Word; B
, Min
: Word); overload
;
71 procedure DecMin(var A
: Word; Min
: Word); overload
;
72 procedure DecMin(var A
: Byte; B
, Min
: Byte); overload
;
73 procedure DecMin(var A
: Byte; Min
: Byte); overload
;
74 function Sign(A
: Integer): ShortInt
; overload
;
75 function Sign(A
: Single): ShortInt
; overload
;
76 function PointToRect(X
, Y
, X1
, Y1
: Integer; Width
, Height
: Word): Integer;
77 function GetAngle(baseX
, baseY
, pointX
, PointY
: Integer): SmallInt
;
78 function GetAngle2(vx
, vy
: Integer): SmallInt
;
79 function GetLines(Text: string; FontID
: DWORD
; MaxWidth
: Word): SSArray
;
80 procedure Sort(var a
: SSArray
);
81 function Sscanf(const s
: string; const fmt
: string;
82 const Pointers
: array of Pointer): Integer;
83 function InDWArray(a
: DWORD
; arr
: DWArray
): Boolean;
84 function InWArray(a
: Word; arr
: WArray
): Boolean;
85 function InSArray(a
: string; arr
: SSArray
): Boolean;
86 function GetPos(UID
: Word; o
: PObj
): Boolean;
87 function parse(s
: string): SSArray
;
88 function parse2(s
: string; delim
: Char): SSArray
;
89 function g_GetFileTime(fileName
: String): Integer;
90 function g_SetFileTime(fileName
: String; time
: Integer): Boolean;
91 procedure SortSArray(var S
: SSArray
);
92 function b_Text_Format(S
: string): string;
93 function b_Text_Unformat(S
: string): string;
94 function b_Text_Wrap(S
: string; LineLen
: Integer): string;
95 function b_Text_LineCount(S
: string): Integer;
98 gmon_dbg_los_enabled
: Boolean = true;
103 Math
, geom
, e_log
, g_map
, g_gfx
, g_player
, SysUtils
, MAPDEF
,
104 StrUtils
, e_graphics
, g_monsters
, g_items
, g_game
;
107 {$WARN 2054 OFF} // unknwon env var
108 {$WARN 6018 OFF} // unreachable code
109 function g_GetBuilderName (): AnsiString
;
111 if {$I %D2DF_BUILD_USER%} <> '' then
112 result
:= {$I %D2DF_BUILD_USER%} // custom
113 else if {$I %USER%} <> '' then
114 result
:= {$I %USER%} // unix username
115 else if {$I %USERNAME%} <> '' then
116 result
:= {$I %USERNAME%} // windows username
121 function g_GetBuildHash (full
: Boolean = True): AnsiString
;
123 if {$I %D2DF_BUILD_HASH%} <> '' then
125 result
:= {$I %D2DF_BUILD_HASH%}
127 result
:= Copy({$I %D2DF_BUILD_HASH%}, 1, 7)
129 result
:= 'custom build'
133 function g_PatchLength(X1
, Y1
, X2
, Y2
: Integer): Word;
135 Result
:= Min(Round(Hypot(Abs(X2
-X1
), Abs(Y2
-Y1
))), 65535);
138 function g_CollideLevel(X
, Y
: Integer; Width
, Height
: Word): Boolean; inline;
140 result
:= g_Map_CollidePanel(X
, Y
, Width
, Height
, (PANEL_WALL
or PANEL_CLOSEDOOR
or PANEL_OPENDOOR
), false);
151 for a := 0 to High(gWalls) do
152 if gWalls[a].Enabled and
153 not ( ((Y + Height <= gWalls[a].Y) or
154 (Y >= gWalls[a].Y + gWalls[a].Height)) or
155 ((X + Width <= gWalls[a].X) or
156 (X >= gWalls[a].X + gWalls[a].Width)) ) then
164 function g_CollidePlayer(X
, Y
: Integer; Width
, Height
: Word): Boolean; inline;
170 if gPlayers
= nil then Exit
;
172 for a
:= 0 to High(gPlayers
) do
173 if (gPlayers
[a
] <> nil) and gPlayers
[a
].alive
then
174 if gPlayers
[a
].Collide(X
, Y
, Width
, Height
) then
182 function g_TraceVector(X1
, Y1
, X2
, Y2
: Integer): Boolean;
184 wallHitX
: Integer = 0;
185 wallHitY
: Integer = 0;
189 Xerr, Yerr, d: LongWord;
197 Assert(gCollideMap <> nil, 'g_TraceVector: gCollideMap = nil');
204 if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0;
205 if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0;
210 if dx > dy then d := dx else d := dy;
230 if (y > gMapInfo.Height-1) or
231 (y < 0) or (x > gMapInfo.Width-1) or (x < 0) then
233 if ByteBool(gCollideMap[y, x] and MARK_BLOCKED) then
240 // `true` if no obstacles
241 if (g_profile_los
) then g_Mons_LOS_Start();
242 result
:= (g_Map_traceToNearestWall(x1
, y1
, x2
, y2
, @wallHitX
, @wallHitY
) = nil);
243 if (g_profile_los
) then g_Mons_LOS_End();
247 function g_CreateUID(UIDType
: Byte): Word;
258 Result
:= UID_MAX_GAME
+$1+Random(UID_MAX_PLAYER
-UID_MAX_GAME
+$1);
261 if gPlayers
<> nil then
262 for i
:= 0 to High(gPlayers
) do
263 if gPlayers
[i
] <> nil then
264 if Result
= gPlayers
[i
].UID
then
277 result
:= UID_MAX_PLAYER
+$1+Random(UID_MAX_MONSTER
-UID_MAX_GAME
-UID_MAX_PLAYER
+$1);
278 if (g_Monsters_ByUID(result
) = nil) then break
;
284 function g_GetUIDType(UID
: Word): Byte;
286 if UID
<= UID_MAX_GAME
then
289 if UID
<= UID_MAX_PLAYER
then
292 Result
:= UID_MONSTER
;
295 function g_Collide(X1
, Y1
: Integer; Width1
, Height1
: Word;
296 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean; inline;
298 Result
:= not ( ((Y1
+ Height1
<= Y2
) or
299 (Y2
+ Height2
<= Y1
)) or
300 ((X1
+ Width1
<= X2
) or
301 (X2
+ Width2
<= X1
)) );
304 function g_CollideAround(X1
, Y1
: Integer; Width1
, Height1
: Word;
305 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean; inline;
307 Result
:= g_Collide(X1
, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
308 g_Collide(X1
+1, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
309 g_Collide(X1
-1, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
310 g_Collide(X1
, Y1
+1, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
311 g_Collide(X1
, Y1
-1, Width1
, Height1
, X2
, Y2
, Width2
, Height2
);
314 function c(X1
, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
: Integer): Boolean; inline;
316 Result
:= not (((Y1
+ Height1
<= Y2
) or
317 (Y1
>= Y2
+ Height2
)) or
318 ((X1
+ Width1
<= X2
) or
319 (X1
>= X2
+ Width2
)));
322 function g_Collide2(X1
, Y1
, X2
, Y2
, X3
, Y3
, X4
, Y4
: Integer): Boolean; inline;
324 //Result := not (((Y2 <= Y3) or (Y1 >= Y4)) or ((X2 <= X3) or (X1 >= X4)));
325 Result
:= c(X1
, Y1
, X2
-X1
, Y2
-Y1
, X3
, Y3
, X4
-X3
, Y4
-Y3
);
328 function g_CollidePoint(X
, Y
, X2
, Y2
: Integer; Width
, Height
: Word): Boolean; inline;
332 Result
:= (x
>= 0) and (x
<= Width
) and
333 (y
>= 0) and (y
<= Height
);
336 procedure IncMax(var A
: Integer; B
, Max
: Integer);
338 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
341 procedure IncMax(var A
: Single; B
, Max
: Single);
343 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
346 procedure DecMin(var A
: Integer; B
, Min
: Integer);
348 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
351 procedure DecMin(var A
: Word; B
, Min
: Word);
353 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
356 procedure DecMin(var A
: Single; B
, Min
: Single);
358 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
361 procedure IncMax(var A
: Integer; Max
: Integer);
363 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
366 procedure IncMax(var A
: Single; Max
: Single);
368 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
371 procedure IncMax(var A
: Word; B
, Max
: Word);
373 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
376 procedure IncMax(var A
: Word; Max
: Word);
378 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
381 procedure IncMax(var A
: SmallInt
; B
, Max
: SmallInt
);
383 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
386 procedure IncMax(var A
: SmallInt
; Max
: SmallInt
);
388 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
391 procedure DecMin(var A
: Integer; Min
: Integer);
393 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
396 procedure DecMin(var A
: Single; Min
: Single);
398 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
401 procedure DecMin(var A
: Word; Min
: Word);
403 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
406 procedure DecMin(var A
: Byte; B
, Min
: Byte);
408 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
411 procedure DecMin(var A
: Byte; Min
: Byte); overload
;
413 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
416 function Sign(A
: Integer): ShortInt
;
418 if A
< 0 then Result
:= -1
419 else if A
> 0 then Result
:= 1
423 function Sign(A
: Single): ShortInt
;
427 if Abs(A
) < Eps
then Result
:= 0
428 else if A
< 0 then Result
:= -1
432 function PointToRect(X
, Y
, X1
, Y1
: Integer; Width
, Height
: Word): Integer;
434 X
:= X
-X1
; // A(0;0) --- B(W;0)
439 if Y
< 0 then // Ñëåâà ñâåðõó: ðàññòîÿíèå äî A
440 Result
:= Round(Hypot(X
, Y
))
442 if Y
> Height
then // Ñëåâà ñíèçó: ðàññòîÿíèå äî D
443 Result
:= Round(Hypot(X
, Y
-Height
))
444 else // Ñëåâà ïîñåðåäèíå: ðàññòîÿíèå äî AD
451 if y
< 0 then // Ñïðàâà ñâåðõó: ðàññòîÿíèå äî B
452 Result
:= Round(Hypot(X
, Y
))
454 if Y
> Height
then // Ñïðàâà ñíèçó: ðàññòîÿíèå äî C
455 Result
:= Round(Hypot(X
, Y
-Height
))
456 else // Ñïðàâà ïîñåðåäèíå: ðàññòîÿíèå äî BC
461 if Y
< 0 then // Ïîñåðåäèíå ñâåðõó: ðàññòîÿíèå äî AB
464 if Y
> Height
then // Ïîñåðåäèíå ñíèçó: ðàññòîÿíèå äî DC
466 else // Âíóòðè ïðÿìîóãîëüíèêà: ðàññòîÿíèå 0
471 function g_GetAcidHit(X
, Y
: Integer; Width
, Height
: Word): Byte;
473 tab
: array[0..3] of Byte = (0, 5, 10, 20);
479 if g_Map_CollidePanel(X
, Y
, Width
, Height
, PANEL_ACID1
, False) then a
:= a
or 1;
480 if g_Map_CollidePanel(X
, Y
, Width
, Height
, PANEL_ACID2
, False) then a
:= a
or 2;
485 function g_Look(a
, b
: PObj
; d
: TDirection
): Boolean;
487 if not gmon_dbg_los_enabled
then begin result
:= false; exit
; end; // always "wall hit"
489 if ((b
^.X
> a
^.X
) and (d
= TDirection
.D_LEFT
)) or
490 ((b
^.X
< a
^.X
) and (d
= TDirection
.D_RIGHT
)) then
496 Result
:= g_TraceVector(a
^.X
+a
^.Rect
.X
+(a
^.Rect
.Width
div 2),
497 a
^.Y
+a
^.Rect
.Y
+(a
^.Rect
.Height
div 2),
498 b
^.X
+b
^.Rect
.X
+(b
^.Rect
.Width
div 2),
499 b
^.Y
+b
^.Rect
.Y
+(b
^.Rect
.Height
div 2));
502 function GetAngle(baseX
, baseY
, pointX
, PointY
: Integer): SmallInt
;
507 a
:= abs(pointX
-baseX
);
508 b
:= abs(pointY
-baseY
);
510 if a
= 0 then c
:= 90
511 else c
:= RadToDeg(ArcTan(b
/a
));
513 if pointY
< baseY
then c
:= -c
;
514 if pointX
> baseX
then c
:= 180-c
;
519 function GetAngle2(vx
, vy
: Integer): SmallInt
;
530 c
:= RadToDeg(ArcTan(b
/a
));
542 {function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
544 table: array[0..8, 0..8] of Byte =
545 ((0, 0, 3, 3, 1, 2, 2, 0, 1),
546 (0, 0, 0, 0, 4, 7, 2, 0, 1),
547 (3, 0, 0, 0, 4, 4, 1, 3, 1),
548 (3, 0, 0, 0, 0, 0, 5, 6, 1),
549 (1, 4, 4, 0, 0, 0, 5, 5, 1),
550 (2, 7, 4, 0, 0, 0, 0, 0, 1),
551 (2, 2, 1, 5, 5, 0, 0, 0, 1),
552 (0, 0, 3, 6, 5, 0, 0, 0, 1),
553 (1, 1, 1, 1, 1, 1, 1, 1, 1));
555 function GetClass(x, y: Integer): Byte;
559 if x < rX then Result := 7
560 else if x < rX+rWidth then Result := 0
563 else if y < rY+rHeight then
565 if x < rX then Result := 6
566 else if x < rX+rWidth then Result := 8
571 if x < rX then Result := 5
572 else if x < rX+rWidth then Result := 4
578 case table[GetClass(x1, y1), GetClass(x2, y2)] of
581 2: Result := Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1));
582 3: Result := Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1));
583 4: Result := Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1));
584 5: Result := Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1));
585 6: Result := (Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1))) and
586 (Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1)));
587 7: Result := (Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1))) and
588 (Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1)));
589 else Result := False;
593 function g_CollideLine(x1
, y1
, x2
, y2
, rX
, rY
: Integer; rWidth
, rHeight
: Word): Boolean;
603 result
:= lineAABBIntersects(x1
, y1
, x2
, y2
, rX
, rY
, rWidth
, rHeight
);
612 if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0;
613 if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0;
618 if dx > dy then d := dx else d := dy;
638 if (x >= rX) and (x <= (rX + rWidth - 1)) and
639 (y >= rY) and (y <= (rY + rHeight - 1)) then Exit;
646 function GetStr(var Str
: string): string;
651 for a
:= 1 to Length(Str
) do
652 if (a
= Length(Str
)) or (Str
[a
+1] = ' ') then
654 Result
:= Copy(Str
, 1, a
);
661 function GetLines (Text: string; FontID
: DWORD
; MaxWidth
: Word): SSArray
;
662 var i
, j
, len
, lines
: Integer;
664 function GetLine (j
, i
: Integer): String;
666 result
:= Copy(text, j
, i
- j
+ 1);
669 function GetWidth (j
, i
: Integer): Integer;
672 e_CharFont_GetSize(FontID
, GetLine(j
, i
), w
, h
);
677 result
:= nil; lines
:= 0;
678 j
:= 1; i
:= 1; len
:= Length(Text);
679 // e_LogWritefln('GetLines @%s len=%s [%s]', [MaxWidth, len, Text]);
682 (* --- Get longest possible sequence --- *)
683 while (i
+ 1 <= len
) and (GetWidth(j
, i
+ 1) <= MaxWidth
) do Inc(i
);
684 (* --- Do not include part of word --- *)
685 if (i
< len
) and (text[i
] <> ' ') then
686 while (i
>= j
) and (text[i
] <> ' ') do Dec(i
);
687 (* --- Do not include spaces --- *)
688 while (i
>= j
) and (text[i
] = ' ') do Dec(i
);
689 (* --- Add line --- *)
690 SetLength(result
, lines
+ 1);
691 result
[lines
] := GetLine(j
, i
);
692 // e_LogWritefln(' -> (%s:%s::%s) [%s]', [j, i, GetWidth(j, i), result[lines]]);
694 (* --- Skip spaces --- *)
695 while (i
<= len
) and (text[i
] = ' ') do Inc(i
);
700 procedure Sort(var a
: SSArray
);
705 if a
= nil then Exit
;
707 for i
:= High(a
) downto Low(a
) do
708 for j
:= Low(a
) to High(a
)-1 do
709 if LowerCase(a
[j
]) > LowerCase(a
[j
+1]) then
717 function Sscanf(const s
: String; const fmt
: String;
718 const Pointers
: array of Pointer): Integer;
725 function GetInt(): Integer;
728 while (n
<= Length(s
)) and (s
[n
] = ' ') do
731 while (n
<= Length(s
)) and (s
[n
] in ['0'..'9', '+', '-']) do
737 Result
:= Length(s1
);
740 function GetFloat(): Integer;
743 while (n
<= Length(s
)) and (s
[n
] = ' ') do
746 while (n
<= Length(s
)) and //jd >= rather than >
747 (s
[n
] in ['0'..'9', '+', '-', '.', 'e', 'E']) do
753 Result
:= Length(s1
);
756 function GetString(): Integer;
759 while (n
<= Length(s
)) and (s
[n
] = ' ') do
762 while (n
<= Length(s
)) and (s
[n
] <> ' ') do
768 Result
:= Length(s1
);
771 function ScanStr(c
: Char): Boolean;
773 while (n
<= Length(s
)) and (s
[n
] <> c
) do
777 Result
:= (n
<= Length(s
));
780 function GetFmt(): Integer;
786 while (fmt
[m
] = ' ') and (m
< Length(fmt
)) do
788 if (m
>= Length(fmt
)) then
791 if (fmt
[m
] = '%') then
795 'd': Result
:= vtInteger
;
796 'f': Result
:= vtExtended
;
797 's': Result
:= vtString
;
803 if (not ScanStr(fmt
[m
])) then
815 for i
:= 0 to High(Pointers
) do
824 L
:= StrToIntDef(s1
, 0);
825 Move(L
, Pointers
[i
]^, SizeOf(LongInt));
834 if GetFloat() > 0 then
836 X
:= StrToFloatDef(s1
, 0.0);
837 Move(X
, Pointers
[i
]^, SizeOf(Extended
));
846 if GetString() > 0 then
848 Move(s1
, Pointers
[i
]^, Length(s1
)+1);
861 function InDWArray(a
: DWORD
; arr
: DWArray
): Boolean;
867 if arr
= nil then Exit
;
869 for b
:= 0 to High(arr
) do
877 function InWArray(a
: Word; arr
: WArray
): Boolean;
883 if arr
= nil then Exit
;
885 for b
:= 0 to High(arr
) do
893 function InSArray(a
: string; arr
: SSArray
): Boolean;
899 if arr
= nil then Exit
;
901 a
:= AnsiLowerCase(a
);
903 for b
:= 0 to High(arr
) do
904 if AnsiLowerCase(arr
[b
]) = a
then
911 function GetPos(UID
: Word; o
: PObj
): Boolean;
918 case g_GetUIDType(UID
) of
921 p
:= g_Player_Get(UID
);
922 if p
= nil then Exit
;
923 if not p
.alive
then Exit
;
930 m
:= g_Monsters_ByUID(UID
);
931 if m
= nil then Exit
;
932 if not m
.alive
then Exit
;
942 function parse(s
: String): SSArray
;
952 for a
:= 1 to Length(s
) do
953 if (s
[a
] = ',') or (a
= Length(s
)) then
955 SetLength(Result
, Length(Result
)+1);
958 Result
[High(Result
)] := Copy(s
, 1, a
-1)
960 Result
[High(Result
)] := s
;
968 function parse2(s
: string; delim
: Char): SSArray
;
977 for a
:= 1 to Length(s
) do
978 if (s
[a
] = delim
) or (a
= Length(s
)) then
980 SetLength(Result
, Length(Result
)+1);
982 if s
[a
] = delim
then Result
[High(Result
)] := Copy(s
, 1, a
-1)
983 else Result
[High(Result
)] := s
;
991 function g_GetFileTime(fileName
: String): Integer;
995 if not FileExists(fileName
) then
1001 AssignFile(F
, fileName
);
1003 Result
:= FileGetDate(TFileRec(F
).Handle
);
1007 function g_SetFileTime(fileName
: String; time
: Integer): Boolean;
1011 if (not FileExists(fileName
)) or (time
< 0) then
1017 AssignFile(F
, fileName
);
1019 Result
:= (FileSetDate(TFileRec(F
).Handle
, time
) = 0);
1023 procedure SortSArray(var S
: SSArray
);
1031 for i
:= Low(S
) to High(S
) - 1 do
1032 if S
[i
] > S
[i
+ 1] then begin
1041 function b_Text_Format(S
: string): string;
1049 for I
:= 1 to Length(S
) do
1051 if (not Spec
) and (S
[I
] = '\') and (I
+ 1 <= Length(S
)) then
1061 Result
:= Result
+ #10;
1063 Result
:= Result
+ #1;
1065 Result
:= Result
+ #2;
1067 Result
:= Result
+ #3;
1069 Result
:= Result
+ #4;
1071 Result
:= Result
+ #18;
1073 Result
:= Result
+ #19;
1075 Result
:= Result
+ #20;
1077 Result
:= Result
+ #21;
1079 Result
:= Result
+ '\';
1081 Result
:= Result
+ '\' + S
[I
];
1085 Result
:= Result
+ S
[I
];
1087 // reset to white at end
1088 if Rst
then Result
:= Result
+ #2;
1091 function b_Text_Unformat(S
: string): string;
1098 for I
:= 1 to Length(S
) do
1100 if S
[I
] in [#1, #2, #3, #4, #10, #18, #19, #20, #21] then
1105 if (not Spec
) and (S
[I
] = '\') and (I
+ 1 <= Length(S
)) then
1122 '\': Result
:= Result
+ '\';
1124 Result
:= Result
+ '\' + S
[I
];
1128 Result
:= Result
+ S
[I
];
1132 function b_Text_Wrap(S
: string; LineLen
: Integer): string;
1134 Result
:= WrapText(S
, ''#10, [#10, ' ', '-'], LineLen
);
1137 function b_Text_LineCount(S
: string): Integer;
1141 Result
:= IfThen(S
= '', 0, 1);
1142 for I
:= 1 to High(S
) do