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
;
43 function g_GetBuildArch (): AnsiString
;
45 function g_CreateUID(UIDType
: Byte): Word;
46 function g_GetUIDType(UID
: Word): Byte;
47 function g_Collide(X1
, Y1
: Integer; Width1
, Height1
: Word;
48 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean; inline;
49 function g_CollideLine(x1
, y1
, x2
, y2
, rX
, rY
: Integer; rWidth
, rHeight
: Word): Boolean;
50 function g_CollidePoint(X
, Y
, X2
, Y2
: Integer; Width
, Height
: Word): Boolean; inline;
51 function g_CollideLevel(X
, Y
: Integer; Width
, Height
: Word): Boolean; inline;
52 function g_CollideAround(X1
, Y1
: Integer; Width1
, Height1
: Word;
53 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean; inline;
54 function g_CollidePlayer(X
, Y
: Integer; Width
, Height
: Word): Boolean; inline;
55 function g_PatchLength(X1
, Y1
, X2
, Y2
: Integer): Word;
56 function g_TraceVector(X1
, Y1
, X2
, Y2
: Integer): Boolean; // `true`: no wall hit
57 function g_GetAcidHit(X
, Y
: Integer; Width
, Height
: Word): Byte;
58 function g_Look(a
, b
: PObj
; d
: TDirection
): Boolean;
59 procedure IncMax(var A
: Integer; B
, Max
: Integer); overload
;
60 procedure IncMax(var A
: Single; B
, Max
: Single); overload
;
61 procedure IncMax(var A
: Integer; Max
: Integer); overload
;
62 procedure IncMax(var A
: Single; Max
: Single); overload
;
63 procedure IncMax(var A
: Word; B
, Max
: Word); overload
;
64 procedure IncMax(var A
: Word; Max
: Word); overload
;
65 procedure IncMax(var A
: SmallInt
; B
, Max
: SmallInt
); overload
;
66 procedure IncMax(var A
: SmallInt
; Max
: SmallInt
); overload
;
67 procedure DecMin(var A
: Integer; B
, Min
: Integer); overload
;
68 procedure DecMin(var A
: Single; B
, Min
: Single); overload
;
69 procedure DecMin(var A
: Integer; Min
: Integer); overload
;
70 procedure DecMin(var A
: Single; Min
: Single); overload
;
71 procedure DecMin(var A
: Word; B
, Min
: Word); overload
;
72 procedure DecMin(var A
: Word; Min
: Word); overload
;
73 procedure DecMin(var A
: Byte; B
, Min
: Byte); overload
;
74 procedure DecMin(var A
: Byte; Min
: Byte); overload
;
75 function Sign(A
: Integer): ShortInt
; overload
;
76 function Sign(A
: Single): ShortInt
; overload
;
77 function PointToRect(X
, Y
, X1
, Y1
: Integer; Width
, Height
: Word): Integer;
78 function GetAngle(baseX
, baseY
, pointX
, PointY
: Integer): SmallInt
;
79 function GetAngle2(vx
, vy
: Integer): SmallInt
;
80 function GetLines(Text: string; FontID
: DWORD
; MaxWidth
: Word): SSArray
;
81 procedure Sort(var a
: SSArray
);
82 function Sscanf(const s
: string; const fmt
: string;
83 const Pointers
: array of Pointer): Integer;
84 function InDWArray(a
: DWORD
; arr
: DWArray
): Boolean;
85 function InWArray(a
: Word; arr
: WArray
): Boolean;
86 function InSArray(a
: string; arr
: SSArray
): Boolean;
87 function GetPos(UID
: Word; o
: PObj
): Boolean;
88 function parse(s
: string): SSArray
;
89 function parse2(s
: string; delim
: Char): SSArray
;
90 function g_GetFileTime(fileName
: String): Integer;
91 function g_SetFileTime(fileName
: String; time
: Integer): Boolean;
92 procedure SortSArray(var S
: SSArray
);
93 function b_Text_Format(S
: string): string;
94 function b_Text_Unformat(S
: string): string;
95 function b_Text_Wrap(S
: string; LineLen
: Integer): string;
96 function b_Text_LineCount(S
: string): Integer;
99 gmon_dbg_los_enabled
: Boolean = true;
104 Math
, geom
, e_log
, g_map
, g_gfx
, g_player
, SysUtils
, MAPDEF
,
105 StrUtils
, e_graphics
, g_monsters
, g_items
, g_game
;
108 {$WARN 2054 OFF} // unknwon env var
109 {$WARN 6018 OFF} // unreachable code
110 function g_GetBuilderName (): AnsiString
;
112 if {$I %D2DF_BUILD_USER%} <> '' then
113 result
:= {$I %D2DF_BUILD_USER%} // custom
114 else if {$I %USER%} <> '' then
115 result
:= {$I %USER%} // unix username
116 else if {$I %USERNAME%} <> '' then
117 result
:= {$I %USERNAME%} // windows username
122 function g_GetBuildHash (full
: Boolean = True): AnsiString
;
124 if {$I %D2DF_BUILD_HASH%} <> '' then
126 result
:= {$I %D2DF_BUILD_HASH%}
128 result
:= Copy({$I %D2DF_BUILD_HASH%}, 1, 7)
130 result
:= 'custom build'
134 function g_GetBuildArch (): AnsiString
;
135 var cpu
, mode
, fpu
: AnsiString
;
137 {$IF DEFINED(CPUX86_64) OR DEFINED(CPUAMD64) OR DEFINED(CPUX64)}
139 {$ELSEIF DEFINED(CPUI386) OR DEFINED(CPU386)}
141 {$ELSEIF DEFINED(CPUI8086)}
143 {$ELSEIF DEFINED(CPUI64)}
145 {$ELSEIF DEFINED(CPUARM)}
147 {$ELSEIF DEFINED(CPUAVR)}
149 {$ELSEIF DEFINED(CPUPOWERPC32)}
151 {$ELSEIF DEFINED(CPUPOWERPC64)}
153 {$ELSEIF DEFINED(CPUALPHA)}}
155 {$ELSEIF DEFINED(CPUSPARC32)}
157 {$ELSEIF DEFINED(CPUM68020)}
159 {$ELSEIF DEFINED(CPU68K) OR DEFINED(CPUM68K)}
161 {$ELSEIF DEFINED(CPUSPARC)}
162 cpu
:= 'unknown-sparc';
163 {$ELSEIF DEFINED(CPUPOWERPC)}
164 cpu
:= 'unknown-ppc';
165 {$ELSEIF DEFINED(CPU86) OR DEFINED(CPU87)}
166 cpu
:= 'unknown-intel';
168 cpu
:= 'unknown-arch';
173 {$ELSEIF DEFINED(CPU32)}
175 {$ELSEIF DEFINED(CPU16)}
178 mode
:= 'unknown-mode';
181 {$IF DEFINED(FPUSOFT)}
183 {$ELSEIF DEFINED(FPUSSE3)}
185 {$ELSEIF DEFINED(FPUSSE2)}
187 {$ELSEIF DEFINED(FPUSSE)}
189 {$ELSEIF DEFINED(FPUSSE64)}
191 {$ELSEIF DEFINED(FPULIBGCC)}
193 {$ELSEIF DEFINED(FPU68881)}
195 {$ELSEIF DEFINED(FPUVFP)}
197 {$ELSEIF DEFINED(FPUFPA11)}
199 {$ELSEIF DEFINED(FPUFPA10)}
201 {$ELSEIF DEFINED(FPUFPA)}
203 {$ELSEIF DEFINED(FPUX87)}
205 {$ELSEIF DEFINED(FPUITANIUM)}
207 {$ELSEIF DEFINED(FPUSTANDARD)}
209 {$ELSEIF DEFINED(FPUHARD)}
212 fpu
:= 'unknown-fpu';
215 result
:= cpu
+ ' ' + mode
+ ' ' + fpu
;
218 function g_PatchLength(X1
, Y1
, X2
, Y2
: Integer): Word;
220 Result
:= Min(Round(Hypot(Abs(X2
-X1
), Abs(Y2
-Y1
))), 65535);
223 function g_CollideLevel(X
, Y
: Integer; Width
, Height
: Word): Boolean; inline;
225 result
:= g_Map_CollidePanel(X
, Y
, Width
, Height
, (PANEL_WALL
or PANEL_CLOSEDOOR
or PANEL_OPENDOOR
), false);
236 for a := 0 to High(gWalls) do
237 if gWalls[a].Enabled and
238 not ( ((Y + Height <= gWalls[a].Y) or
239 (Y >= gWalls[a].Y + gWalls[a].Height)) or
240 ((X + Width <= gWalls[a].X) or
241 (X >= gWalls[a].X + gWalls[a].Width)) ) then
249 function g_CollidePlayer(X
, Y
: Integer; Width
, Height
: Word): Boolean; inline;
255 if gPlayers
= nil then Exit
;
257 for a
:= 0 to High(gPlayers
) do
258 if (gPlayers
[a
] <> nil) and gPlayers
[a
].alive
then
259 if gPlayers
[a
].Collide(X
, Y
, Width
, Height
) then
267 function g_TraceVector(X1
, Y1
, X2
, Y2
: Integer): Boolean;
269 wallHitX
: Integer = 0;
270 wallHitY
: Integer = 0;
274 Xerr, Yerr, d: LongWord;
282 Assert(gCollideMap <> nil, 'g_TraceVector: gCollideMap = nil');
289 if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0;
290 if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0;
295 if dx > dy then d := dx else d := dy;
315 if (y > gMapInfo.Height-1) or
316 (y < 0) or (x > gMapInfo.Width-1) or (x < 0) then
318 if ByteBool(gCollideMap[y, x] and MARK_BLOCKED) then
325 // `true` if no obstacles
326 if (g_profile_los
) then g_Mons_LOS_Start();
327 result
:= (g_Map_traceToNearestWall(x1
, y1
, x2
, y2
, @wallHitX
, @wallHitY
) = nil);
328 if (g_profile_los
) then g_Mons_LOS_End();
332 function g_CreateUID(UIDType
: Byte): Word;
343 Result
:= UID_MAX_GAME
+$1+Random(UID_MAX_PLAYER
-UID_MAX_GAME
+$1);
346 if gPlayers
<> nil then
347 for i
:= 0 to High(gPlayers
) do
348 if gPlayers
[i
] <> nil then
349 if Result
= gPlayers
[i
].UID
then
362 result
:= UID_MAX_PLAYER
+$1+Random(UID_MAX_MONSTER
-UID_MAX_GAME
-UID_MAX_PLAYER
+$1);
363 if (g_Monsters_ByUID(result
) = nil) then break
;
369 function g_GetUIDType(UID
: Word): Byte;
371 if UID
<= UID_MAX_GAME
then
374 if UID
<= UID_MAX_PLAYER
then
377 Result
:= UID_MONSTER
;
380 function g_Collide(X1
, Y1
: Integer; Width1
, Height1
: Word;
381 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean; inline;
383 Result
:= not ( ((Y1
+ Height1
<= Y2
) or
384 (Y2
+ Height2
<= Y1
)) or
385 ((X1
+ Width1
<= X2
) or
386 (X2
+ Width2
<= X1
)) );
389 function g_CollideAround(X1
, Y1
: Integer; Width1
, Height1
: Word;
390 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean; inline;
392 Result
:= g_Collide(X1
, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
393 g_Collide(X1
+1, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
394 g_Collide(X1
-1, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
395 g_Collide(X1
, Y1
+1, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
396 g_Collide(X1
, Y1
-1, Width1
, Height1
, X2
, Y2
, Width2
, Height2
);
399 function c(X1
, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
: Integer): Boolean; inline;
401 Result
:= not (((Y1
+ Height1
<= Y2
) or
402 (Y1
>= Y2
+ Height2
)) or
403 ((X1
+ Width1
<= X2
) or
404 (X1
>= X2
+ Width2
)));
407 function g_Collide2(X1
, Y1
, X2
, Y2
, X3
, Y3
, X4
, Y4
: Integer): Boolean; inline;
409 //Result := not (((Y2 <= Y3) or (Y1 >= Y4)) or ((X2 <= X3) or (X1 >= X4)));
410 Result
:= c(X1
, Y1
, X2
-X1
, Y2
-Y1
, X3
, Y3
, X4
-X3
, Y4
-Y3
);
413 function g_CollidePoint(X
, Y
, X2
, Y2
: Integer; Width
, Height
: Word): Boolean; inline;
417 Result
:= (x
>= 0) and (x
<= Width
) and
418 (y
>= 0) and (y
<= Height
);
421 procedure IncMax(var A
: Integer; B
, Max
: Integer);
423 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
426 procedure IncMax(var A
: Single; B
, Max
: Single);
428 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
431 procedure DecMin(var A
: Integer; B
, Min
: Integer);
433 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
436 procedure DecMin(var A
: Word; B
, Min
: Word);
438 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
441 procedure DecMin(var A
: Single; B
, Min
: Single);
443 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
446 procedure IncMax(var A
: Integer; Max
: Integer);
448 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
451 procedure IncMax(var A
: Single; Max
: Single);
453 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
456 procedure IncMax(var A
: Word; B
, Max
: Word);
458 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
461 procedure IncMax(var A
: Word; Max
: Word);
463 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
466 procedure IncMax(var A
: SmallInt
; B
, Max
: SmallInt
);
468 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
471 procedure IncMax(var A
: SmallInt
; Max
: SmallInt
);
473 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
476 procedure DecMin(var A
: Integer; Min
: Integer);
478 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
481 procedure DecMin(var A
: Single; Min
: Single);
483 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
486 procedure DecMin(var A
: Word; Min
: Word);
488 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
491 procedure DecMin(var A
: Byte; B
, Min
: Byte);
493 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
496 procedure DecMin(var A
: Byte; Min
: Byte); overload
;
498 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
501 function Sign(A
: Integer): ShortInt
;
503 if A
< 0 then Result
:= -1
504 else if A
> 0 then Result
:= 1
508 function Sign(A
: Single): ShortInt
;
512 if Abs(A
) < Eps
then Result
:= 0
513 else if A
< 0 then Result
:= -1
517 function PointToRect(X
, Y
, X1
, Y1
: Integer; Width
, Height
: Word): Integer;
519 X
:= X
-X1
; // A(0;0) --- B(W;0)
524 if Y
< 0 then // Ñëåâà ñâåðõó: ðàññòîÿíèå äî A
525 Result
:= Round(Hypot(X
, Y
))
527 if Y
> Height
then // Ñëåâà ñíèçó: ðàññòîÿíèå äî D
528 Result
:= Round(Hypot(X
, Y
-Height
))
529 else // Ñëåâà ïîñåðåäèíå: ðàññòîÿíèå äî AD
536 if y
< 0 then // Ñïðàâà ñâåðõó: ðàññòîÿíèå äî B
537 Result
:= Round(Hypot(X
, Y
))
539 if Y
> Height
then // Ñïðàâà ñíèçó: ðàññòîÿíèå äî C
540 Result
:= Round(Hypot(X
, Y
-Height
))
541 else // Ñïðàâà ïîñåðåäèíå: ðàññòîÿíèå äî BC
546 if Y
< 0 then // Ïîñåðåäèíå ñâåðõó: ðàññòîÿíèå äî AB
549 if Y
> Height
then // Ïîñåðåäèíå ñíèçó: ðàññòîÿíèå äî DC
551 else // Âíóòðè ïðÿìîóãîëüíèêà: ðàññòîÿíèå 0
556 function g_GetAcidHit(X
, Y
: Integer; Width
, Height
: Word): Byte;
558 tab
: array[0..3] of Byte = (0, 5, 10, 20);
564 if g_Map_CollidePanel(X
, Y
, Width
, Height
, PANEL_ACID1
, False) then a
:= a
or 1;
565 if g_Map_CollidePanel(X
, Y
, Width
, Height
, PANEL_ACID2
, False) then a
:= a
or 2;
570 function g_Look(a
, b
: PObj
; d
: TDirection
): Boolean;
572 if not gmon_dbg_los_enabled
then begin result
:= false; exit
; end; // always "wall hit"
574 if ((b
^.X
> a
^.X
) and (d
= TDirection
.D_LEFT
)) or
575 ((b
^.X
< a
^.X
) and (d
= TDirection
.D_RIGHT
)) then
581 Result
:= g_TraceVector(a
^.X
+a
^.Rect
.X
+(a
^.Rect
.Width
div 2),
582 a
^.Y
+a
^.Rect
.Y
+(a
^.Rect
.Height
div 2),
583 b
^.X
+b
^.Rect
.X
+(b
^.Rect
.Width
div 2),
584 b
^.Y
+b
^.Rect
.Y
+(b
^.Rect
.Height
div 2));
587 function GetAngle(baseX
, baseY
, pointX
, PointY
: Integer): SmallInt
;
592 a
:= abs(pointX
-baseX
);
593 b
:= abs(pointY
-baseY
);
595 if a
= 0 then c
:= 90
596 else c
:= RadToDeg(ArcTan(b
/a
));
598 if pointY
< baseY
then c
:= -c
;
599 if pointX
> baseX
then c
:= 180-c
;
604 function GetAngle2(vx
, vy
: Integer): SmallInt
;
615 c
:= RadToDeg(ArcTan(b
/a
));
627 {function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
629 table: array[0..8, 0..8] of Byte =
630 ((0, 0, 3, 3, 1, 2, 2, 0, 1),
631 (0, 0, 0, 0, 4, 7, 2, 0, 1),
632 (3, 0, 0, 0, 4, 4, 1, 3, 1),
633 (3, 0, 0, 0, 0, 0, 5, 6, 1),
634 (1, 4, 4, 0, 0, 0, 5, 5, 1),
635 (2, 7, 4, 0, 0, 0, 0, 0, 1),
636 (2, 2, 1, 5, 5, 0, 0, 0, 1),
637 (0, 0, 3, 6, 5, 0, 0, 0, 1),
638 (1, 1, 1, 1, 1, 1, 1, 1, 1));
640 function GetClass(x, y: Integer): Byte;
644 if x < rX then Result := 7
645 else if x < rX+rWidth then Result := 0
648 else if y < rY+rHeight then
650 if x < rX then Result := 6
651 else if x < rX+rWidth then Result := 8
656 if x < rX then Result := 5
657 else if x < rX+rWidth then Result := 4
663 case table[GetClass(x1, y1), GetClass(x2, y2)] of
666 2: Result := Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1));
667 3: Result := Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1));
668 4: Result := Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1));
669 5: Result := Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1));
670 6: Result := (Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1))) and
671 (Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1)));
672 7: Result := (Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1))) and
673 (Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1)));
674 else Result := False;
678 function g_CollideLine(x1
, y1
, x2
, y2
, rX
, rY
: Integer; rWidth
, rHeight
: Word): Boolean;
688 result
:= lineAABBIntersects(x1
, y1
, x2
, y2
, rX
, rY
, rWidth
, rHeight
);
697 if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0;
698 if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0;
703 if dx > dy then d := dx else d := dy;
723 if (x >= rX) and (x <= (rX + rWidth - 1)) and
724 (y >= rY) and (y <= (rY + rHeight - 1)) then Exit;
731 function GetStr(var Str
: string): string;
736 for a
:= 1 to Length(Str
) do
737 if (a
= Length(Str
)) or (Str
[a
+1] = ' ') then
739 Result
:= Copy(Str
, 1, a
);
746 function GetLines (text: string; FontID
: DWORD
; MaxWidth
: Word): SSArray
;
750 i
, len
, lastsep
: Integer;
752 function PrepareStep (): Boolean; inline;
754 // Skip leading spaces.
755 while PChar(text)[k
-1] = ' ' do k
+= 1;
760 function GetLine (j
: Integer; Strip
: Boolean): String; inline;
762 // Exclude trailing spaces from the line.
764 while text[j
] = ' ' do j
-= 1;
766 Result
:= Copy(text, k
, j
-k
+1);
769 function LineWidth (): Integer; inline;
772 e_CharFont_GetSize(FontID
, GetLine(i
, False), w
, h
);
779 //e_LogWritefln('GetLines @%s len=%s [%s]', [MaxWidth, len, text]);
781 while PrepareStep() do
783 // Get longest possible sequence (this is not constant because fonts are not monospaced).
786 if text[i
] in [' ', '.', ',', ':', ';']
789 until (i
> len
) or (LineWidth() > MaxWidth
);
791 // Do not include part of a word if possible.
792 if (lastsep
-k
> 3) and (i
<= len
) and (text[i
] <> ' ')
793 then i
:= lastsep
+ 1;
796 SetLength(Result
, lines
+ 1);
797 Result
[lines
] := GetLine(i
-1, True);
798 //e_LogWritefln(' -> (%s:%s::%s) [%s]', [k, i, LineWidth(), Result[lines]]);
805 procedure Sort(var a
: SSArray
);
810 if a
= nil then Exit
;
812 for i
:= High(a
) downto Low(a
) do
813 for j
:= Low(a
) to High(a
)-1 do
814 if LowerCase(a
[j
]) > LowerCase(a
[j
+1]) then
822 function Sscanf(const s
: String; const fmt
: String;
823 const Pointers
: array of Pointer): Integer;
830 function GetInt(): Integer;
833 while (n
<= Length(s
)) and (s
[n
] = ' ') do
836 while (n
<= Length(s
)) and (s
[n
] in ['0'..'9', '+', '-']) do
842 Result
:= Length(s1
);
845 function GetFloat(): Integer;
848 while (n
<= Length(s
)) and (s
[n
] = ' ') do
851 while (n
<= Length(s
)) and //jd >= rather than >
852 (s
[n
] in ['0'..'9', '+', '-', '.', 'e', 'E']) do
858 Result
:= Length(s1
);
861 function GetString(): Integer;
864 while (n
<= Length(s
)) and (s
[n
] = ' ') do
867 while (n
<= Length(s
)) and (s
[n
] <> ' ') do
873 Result
:= Length(s1
);
876 function ScanStr(c
: Char): Boolean;
878 while (n
<= Length(s
)) and (s
[n
] <> c
) do
882 Result
:= (n
<= Length(s
));
885 function GetFmt(): Integer;
891 while (fmt
[m
] = ' ') and (m
< Length(fmt
)) do
893 if (m
>= Length(fmt
)) then
896 if (fmt
[m
] = '%') then
900 'd': Result
:= vtInteger
;
901 'f': Result
:= vtExtended
;
902 's': Result
:= vtString
;
908 if (not ScanStr(fmt
[m
])) then
920 for i
:= 0 to High(Pointers
) do
929 L
:= StrToIntDef(s1
, 0);
930 Move(L
, Pointers
[i
]^, SizeOf(LongInt));
939 if GetFloat() > 0 then
941 X
:= StrToFloatDef(s1
, 0.0);
942 Move(X
, Pointers
[i
]^, SizeOf(Extended
));
951 if GetString() > 0 then
953 Move(s1
, Pointers
[i
]^, Length(s1
)+1);
966 function InDWArray(a
: DWORD
; arr
: DWArray
): Boolean;
972 if arr
= nil then Exit
;
974 for b
:= 0 to High(arr
) do
982 function InWArray(a
: Word; arr
: WArray
): Boolean;
988 if arr
= nil then Exit
;
990 for b
:= 0 to High(arr
) do
998 function InSArray(a
: string; arr
: SSArray
): Boolean;
1004 if arr
= nil then Exit
;
1006 a
:= AnsiLowerCase(a
);
1008 for b
:= 0 to High(arr
) do
1009 if AnsiLowerCase(arr
[b
]) = a
then
1016 function GetPos(UID
: Word; o
: PObj
): Boolean;
1023 case g_GetUIDType(UID
) of
1026 p
:= g_Player_Get(UID
);
1027 if p
= nil then Exit
;
1028 if not p
.alive
then Exit
;
1035 m
:= g_Monsters_ByUID(UID
);
1036 if m
= nil then Exit
;
1037 if not m
.alive
then Exit
;
1047 function parse(s
: String): SSArray
;
1057 for a
:= 1 to Length(s
) do
1058 if (s
[a
] = ',') or (a
= Length(s
)) then
1060 SetLength(Result
, Length(Result
)+1);
1063 Result
[High(Result
)] := Copy(s
, 1, a
-1)
1064 else // Êîíåö ñòðîêè
1065 Result
[High(Result
)] := s
;
1073 function parse2(s
: string; delim
: Char): SSArray
;
1078 if s
= '' then Exit
;
1082 for a
:= 1 to Length(s
) do
1083 if (s
[a
] = delim
) or (a
= Length(s
)) then
1085 SetLength(Result
, Length(Result
)+1);
1087 if s
[a
] = delim
then Result
[High(Result
)] := Copy(s
, 1, a
-1)
1088 else Result
[High(Result
)] := s
;
1096 function g_GetFileTime(fileName
: String): Integer;
1100 if not FileExists(fileName
) then
1106 AssignFile(F
, fileName
);
1108 Result
:= FileGetDate(TFileRec(F
).Handle
);
1112 function g_SetFileTime(fileName
: String; time
: Integer): Boolean;
1116 if (not FileExists(fileName
)) or (time
< 0) then
1122 AssignFile(F
, fileName
);
1124 Result
:= (FileSetDate(TFileRec(F
).Handle
, time
) = 0);
1128 procedure SortSArray(var S
: SSArray
);
1136 for i
:= Low(S
) to High(S
) - 1 do
1137 if S
[i
] > S
[i
+ 1] then begin
1146 function b_Text_Format(S
: string): string;
1154 for I
:= 1 to Length(S
) do
1156 if (not Spec
) and (S
[I
] = '\') and (I
+ 1 <= Length(S
)) then
1166 Result
:= Result
+ #10;
1168 Result
:= Result
+ #1;
1170 Result
:= Result
+ #2;
1172 Result
:= Result
+ #3;
1174 Result
:= Result
+ #4;
1176 Result
:= Result
+ #18;
1178 Result
:= Result
+ #19;
1180 Result
:= Result
+ #20;
1182 Result
:= Result
+ #21;
1184 Result
:= Result
+ '\';
1186 Result
:= Result
+ '\' + S
[I
];
1190 Result
:= Result
+ S
[I
];
1192 // reset to white at end
1193 if Rst
then Result
:= Result
+ #2;
1196 function b_Text_Unformat(S
: string): string;
1203 for I
:= 1 to Length(S
) do
1205 if S
[I
] in [#1, #2, #3, #4, #10, #18, #19, #20, #21] then
1210 if (not Spec
) and (S
[I
] = '\') and (I
+ 1 <= Length(S
)) then
1227 '\': Result
:= Result
+ '\';
1229 Result
:= Result
+ '\' + S
[I
];
1233 Result
:= Result
+ S
[I
];
1237 function b_Text_Wrap(S
: string; LineLen
: Integer): string;
1239 Result
:= WrapText(S
, ''#10, [#10, ' ', '-'], LineLen
);
1242 function b_Text_LineCount(S
: string): Integer;
1246 Result
:= IfThen(S
= '', 0, 1);
1247 for I
:= 1 to High(S
) do