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, either version 3 of the License, or
6 * (at your option) any later version.
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
16 {$INCLUDE ../shared/a_modes.inc}
25 GAME_VERSION
= '0.667';
26 GAME_BUILDDATE
= {$I %DATE%};
27 GAME_BUILDTIME
= {$I %TIME%};
33 UID_MAX_PLAYER
= $7FFF;
34 UID_MAX_MONSTER
= $FFFF;
37 TDirection
= (D_LEFT
, D_RIGHT
);
38 WArray
= array of Word;
39 DWArray
= array of DWORD
;
40 String20
= String[20];
42 function g_CreateUID(UIDType
: Byte): Word;
43 function g_GetUIDType(UID
: Word): Byte;
44 function g_Collide(X1
, Y1
: Integer; Width1
, Height1
: Word;
45 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean; inline;
46 function g_CollideLine(x1
, y1
, x2
, y2
, rX
, rY
: Integer; rWidth
, rHeight
: Word): Boolean;
47 function g_CollidePoint(X
, Y
, X2
, Y2
: Integer; Width
, Height
: Word): Boolean; inline;
48 function g_CollideLevel(X
, Y
: Integer; Width
, Height
: Word): Boolean; inline;
49 function g_CollideAround(X1
, Y1
: Integer; Width1
, Height1
: Word;
50 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean; inline;
51 function g_CollidePlayer(X
, Y
: Integer; Width
, Height
: Word): Boolean; inline;
52 function g_PatchLength(X1
, Y1
, X2
, Y2
: Integer): Word;
53 function g_TraceVector(X1
, Y1
, X2
, Y2
: Integer): Boolean; // `true`: no wall hit
54 function g_GetAcidHit(X
, Y
: Integer; Width
, Height
: Word): Byte;
55 function g_Look(a
, b
: PObj
; d
: TDirection
): Boolean;
56 procedure IncMax(var A
: Integer; B
, Max
: Integer); overload
;
57 procedure IncMax(var A
: Single; B
, Max
: Single); overload
;
58 procedure IncMax(var A
: Integer; Max
: Integer); overload
;
59 procedure IncMax(var A
: Single; Max
: Single); overload
;
60 procedure IncMax(var A
: Word; B
, Max
: Word); overload
;
61 procedure IncMax(var A
: Word; Max
: Word); overload
;
62 procedure IncMax(var A
: SmallInt
; B
, Max
: SmallInt
); overload
;
63 procedure IncMax(var A
: SmallInt
; Max
: SmallInt
); overload
;
64 procedure DecMin(var A
: Integer; B
, Min
: Integer); overload
;
65 procedure DecMin(var A
: Single; B
, Min
: Single); overload
;
66 procedure DecMin(var A
: Integer; Min
: Integer); overload
;
67 procedure DecMin(var A
: Single; Min
: Single); overload
;
68 procedure DecMin(var A
: Word; B
, Min
: Word); overload
;
69 procedure DecMin(var A
: Word; Min
: Word); overload
;
70 procedure DecMin(var A
: Byte; B
, Min
: Byte); overload
;
71 procedure DecMin(var A
: Byte; Min
: Byte); overload
;
72 function Sign(A
: Integer): ShortInt
; overload
;
73 function Sign(A
: Single): ShortInt
; overload
;
74 function PointToRect(X
, Y
, X1
, Y1
: Integer; Width
, Height
: Word): Integer;
75 function GetAngle(baseX
, baseY
, pointX
, PointY
: Integer): SmallInt
;
76 function GetAngle2(vx
, vy
: Integer): SmallInt
;
77 function GetLines(Text: string; FontID
: DWORD
; MaxWidth
: Word): SSArray
;
78 procedure Sort(var a
: SSArray
);
79 function Sscanf(const s
: string; const fmt
: string;
80 const Pointers
: array of Pointer): Integer;
81 function InDWArray(a
: DWORD
; arr
: DWArray
): Boolean;
82 function InWArray(a
: Word; arr
: WArray
): Boolean;
83 function InSArray(a
: string; arr
: SSArray
): Boolean;
84 function GetPos(UID
: Word; o
: PObj
): Boolean;
85 function parse(s
: string): SSArray
;
86 function parse2(s
: string; delim
: Char): SSArray
;
87 function g_GetFileTime(fileName
: String): Integer;
88 function g_SetFileTime(fileName
: String; time
: Integer): Boolean;
89 procedure SortSArray(var S
: SSArray
);
90 function b_Text_Format(S
: string): string;
91 function b_Text_Unformat(S
: string): string;
92 function b_Text_Wrap(S
: string; LineLen
: Integer): string;
95 gmon_dbg_los_enabled
: Boolean = true;
100 Math
, geom
, e_log
, g_map
, g_gfx
, g_player
, SysUtils
, MAPDEF
,
101 StrUtils
, e_graphics
, g_monsters
, g_items
, g_game
;
103 function g_PatchLength(X1
, Y1
, X2
, Y2
: Integer): Word;
105 Result
:= Min(Round(Hypot(Abs(X2
-X1
), Abs(Y2
-Y1
))), 65535);
108 function g_CollideLevel(X
, Y
: Integer; Width
, Height
: Word): Boolean; inline;
110 result
:= g_Map_CollidePanel(X
, Y
, Width
, Height
, (PANEL_WALL
or PANEL_CLOSEDOOR
or PANEL_OPENDOOR
), false);
121 for a := 0 to High(gWalls) do
122 if gWalls[a].Enabled and
123 not ( ((Y + Height <= gWalls[a].Y) or
124 (Y >= gWalls[a].Y + gWalls[a].Height)) or
125 ((X + Width <= gWalls[a].X) or
126 (X >= gWalls[a].X + gWalls[a].Width)) ) then
134 function g_CollidePlayer(X
, Y
: Integer; Width
, Height
: Word): Boolean; inline;
140 if gPlayers
= nil then Exit
;
142 for a
:= 0 to High(gPlayers
) do
143 if (gPlayers
[a
] <> nil) and gPlayers
[a
].alive
then
144 if gPlayers
[a
].Collide(X
, Y
, Width
, Height
) then
152 function g_TraceVector(X1
, Y1
, X2
, Y2
: Integer): Boolean;
154 wallHitX
: Integer = 0;
155 wallHitY
: Integer = 0;
159 Xerr, Yerr, d: LongWord;
167 Assert(gCollideMap <> nil, 'g_TraceVector: gCollideMap = nil');
174 if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0;
175 if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0;
180 if dx > dy then d := dx else d := dy;
200 if (y > gMapInfo.Height-1) or
201 (y < 0) or (x > gMapInfo.Width-1) or (x < 0) then
203 if ByteBool(gCollideMap[y, x] and MARK_BLOCKED) then
210 // `true` if no obstacles
211 if (g_profile_los
) then g_Mons_LOS_Start();
212 result
:= (g_Map_traceToNearestWall(x1
, y1
, x2
, y2
, @wallHitX
, @wallHitY
) = nil);
213 if (g_profile_los
) then g_Mons_LOS_End();
217 function g_CreateUID(UIDType
: Byte): Word;
228 Result
:= UID_MAX_GAME
+$1+Random(UID_MAX_PLAYER
-UID_MAX_GAME
+$1);
231 if gPlayers
<> nil then
232 for i
:= 0 to High(gPlayers
) do
233 if gPlayers
[i
] <> nil then
234 if Result
= gPlayers
[i
].UID
then
247 result
:= UID_MAX_PLAYER
+$1+Random(UID_MAX_MONSTER
-UID_MAX_GAME
-UID_MAX_PLAYER
+$1);
248 if (g_Monsters_ByUID(result
) = nil) then break
;
254 function g_GetUIDType(UID
: Word): Byte;
256 if UID
<= UID_MAX_GAME
then
259 if UID
<= UID_MAX_PLAYER
then
262 Result
:= UID_MONSTER
;
265 function g_Collide(X1
, Y1
: Integer; Width1
, Height1
: Word;
266 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean; inline;
268 Result
:= not ( ((Y1
+ Height1
<= Y2
) or
269 (Y2
+ Height2
<= Y1
)) or
270 ((X1
+ Width1
<= X2
) or
271 (X2
+ Width2
<= X1
)) );
274 function g_CollideAround(X1
, Y1
: Integer; Width1
, Height1
: Word;
275 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean; inline;
277 Result
:= g_Collide(X1
, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
278 g_Collide(X1
+1, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
279 g_Collide(X1
-1, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
280 g_Collide(X1
, Y1
+1, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
281 g_Collide(X1
, Y1
-1, Width1
, Height1
, X2
, Y2
, Width2
, Height2
);
284 function c(X1
, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
: Integer): Boolean; inline;
286 Result
:= not (((Y1
+ Height1
<= Y2
) or
287 (Y1
>= Y2
+ Height2
)) or
288 ((X1
+ Width1
<= X2
) or
289 (X1
>= X2
+ Width2
)));
292 function g_Collide2(X1
, Y1
, X2
, Y2
, X3
, Y3
, X4
, Y4
: Integer): Boolean; inline;
294 //Result := not (((Y2 <= Y3) or (Y1 >= Y4)) or ((X2 <= X3) or (X1 >= X4)));
295 Result
:= c(X1
, Y1
, X2
-X1
, Y2
-Y1
, X3
, Y3
, X4
-X3
, Y4
-Y3
);
298 function g_CollidePoint(X
, Y
, X2
, Y2
: Integer; Width
, Height
: Word): Boolean; inline;
302 Result
:= (x
>= 0) and (x
<= Width
) and
303 (y
>= 0) and (y
<= Height
);
306 procedure IncMax(var A
: Integer; B
, Max
: Integer);
308 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
311 procedure IncMax(var A
: Single; B
, Max
: Single);
313 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
316 procedure DecMin(var A
: Integer; B
, Min
: Integer);
318 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
321 procedure DecMin(var A
: Word; B
, Min
: Word);
323 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
326 procedure DecMin(var A
: Single; B
, Min
: Single);
328 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
331 procedure IncMax(var A
: Integer; Max
: Integer);
333 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
336 procedure IncMax(var A
: Single; Max
: Single);
338 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
341 procedure IncMax(var A
: Word; B
, Max
: Word);
343 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
346 procedure IncMax(var A
: Word; Max
: Word);
348 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
351 procedure IncMax(var A
: SmallInt
; B
, Max
: SmallInt
);
353 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
356 procedure IncMax(var A
: SmallInt
; Max
: SmallInt
);
358 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
361 procedure DecMin(var A
: Integer; Min
: Integer);
363 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
366 procedure DecMin(var A
: Single; Min
: Single);
368 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
371 procedure DecMin(var A
: Word; Min
: Word);
373 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
376 procedure DecMin(var A
: Byte; B
, Min
: Byte);
378 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
381 procedure DecMin(var A
: Byte; Min
: Byte); overload
;
383 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
386 function Sign(A
: Integer): ShortInt
;
388 if A
< 0 then Result
:= -1
389 else if A
> 0 then Result
:= 1
393 function Sign(A
: Single): ShortInt
;
397 if Abs(A
) < Eps
then Result
:= 0
398 else if A
< 0 then Result
:= -1
402 function PointToRect(X
, Y
, X1
, Y1
: Integer; Width
, Height
: Word): Integer;
404 X
:= X
-X1
; // A(0;0) --- B(W;0)
409 if Y
< 0 then // Ñëåâà ñâåðõó: ðàññòîÿíèå äî A
410 Result
:= Round(Hypot(X
, Y
))
412 if Y
> Height
then // Ñëåâà ñíèçó: ðàññòîÿíèå äî D
413 Result
:= Round(Hypot(X
, Y
-Height
))
414 else // Ñëåâà ïîñåðåäèíå: ðàññòîÿíèå äî AD
421 if y
< 0 then // Ñïðàâà ñâåðõó: ðàññòîÿíèå äî B
422 Result
:= Round(Hypot(X
, Y
))
424 if Y
> Height
then // Ñïðàâà ñíèçó: ðàññòîÿíèå äî C
425 Result
:= Round(Hypot(X
, Y
-Height
))
426 else // Ñïðàâà ïîñåðåäèíå: ðàññòîÿíèå äî BC
431 if Y
< 0 then // Ïîñåðåäèíå ñâåðõó: ðàññòîÿíèå äî AB
434 if Y
> Height
then // Ïîñåðåäèíå ñíèçó: ðàññòîÿíèå äî DC
436 else // Âíóòðè ïðÿìîóãîëüíèêà: ðàññòîÿíèå 0
441 function g_GetAcidHit(X
, Y
: Integer; Width
, Height
: Word): Byte;
443 tab
: array[0..3] of Byte = (0, 5, 10, 20);
449 if g_Map_CollidePanel(X
, Y
, Width
, Height
, PANEL_ACID1
, False) then a
:= a
or 1;
450 if g_Map_CollidePanel(X
, Y
, Width
, Height
, PANEL_ACID2
, False) then a
:= a
or 2;
455 function g_Look(a
, b
: PObj
; d
: TDirection
): Boolean;
457 if not gmon_dbg_los_enabled
then begin result
:= false; exit
; end; // always "wall hit"
459 if ((b
^.X
> a
^.X
) and (d
= TDirection
.D_LEFT
)) or
460 ((b
^.X
< a
^.X
) and (d
= TDirection
.D_RIGHT
)) then
466 Result
:= g_TraceVector(a
^.X
+a
^.Rect
.X
+(a
^.Rect
.Width
div 2),
467 a
^.Y
+a
^.Rect
.Y
+(a
^.Rect
.Height
div 2),
468 b
^.X
+b
^.Rect
.X
+(b
^.Rect
.Width
div 2),
469 b
^.Y
+b
^.Rect
.Y
+(b
^.Rect
.Height
div 2));
472 function GetAngle(baseX
, baseY
, pointX
, PointY
: Integer): SmallInt
;
477 a
:= abs(pointX
-baseX
);
478 b
:= abs(pointY
-baseY
);
480 if a
= 0 then c
:= 90
481 else c
:= RadToDeg(ArcTan(b
/a
));
483 if pointY
< baseY
then c
:= -c
;
484 if pointX
> baseX
then c
:= 180-c
;
489 function GetAngle2(vx
, vy
: Integer): SmallInt
;
500 c
:= RadToDeg(ArcTan(b
/a
));
512 {function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
514 table: array[0..8, 0..8] of Byte =
515 ((0, 0, 3, 3, 1, 2, 2, 0, 1),
516 (0, 0, 0, 0, 4, 7, 2, 0, 1),
517 (3, 0, 0, 0, 4, 4, 1, 3, 1),
518 (3, 0, 0, 0, 0, 0, 5, 6, 1),
519 (1, 4, 4, 0, 0, 0, 5, 5, 1),
520 (2, 7, 4, 0, 0, 0, 0, 0, 1),
521 (2, 2, 1, 5, 5, 0, 0, 0, 1),
522 (0, 0, 3, 6, 5, 0, 0, 0, 1),
523 (1, 1, 1, 1, 1, 1, 1, 1, 1));
525 function GetClass(x, y: Integer): Byte;
529 if x < rX then Result := 7
530 else if x < rX+rWidth then Result := 0
533 else if y < rY+rHeight then
535 if x < rX then Result := 6
536 else if x < rX+rWidth then Result := 8
541 if x < rX then Result := 5
542 else if x < rX+rWidth then Result := 4
548 case table[GetClass(x1, y1), GetClass(x2, y2)] of
551 2: Result := Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1));
552 3: Result := Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1));
553 4: Result := Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1));
554 5: Result := Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1));
555 6: Result := (Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1))) and
556 (Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1)));
557 7: Result := (Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1))) and
558 (Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1)));
559 else Result := False;
563 function g_CollideLine(x1
, y1
, x2
, y2
, rX
, rY
: Integer; rWidth
, rHeight
: Word): Boolean;
573 result
:= lineAABBIntersects(x1
, y1
, x2
, y2
, rX
, rY
, rWidth
, rHeight
);
582 if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0;
583 if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0;
588 if dx > dy then d := dx else d := dy;
608 if (x >= rX) and (x <= (rX + rWidth - 1)) and
609 (y >= rY) and (y <= (rY + rHeight - 1)) then Exit;
616 function GetStr(var Str
: string): string;
621 for a
:= 1 to Length(Str
) do
622 if (a
= Length(Str
)) or (Str
[a
+1] = ' ') then
624 Result
:= Copy(Str
, 1, a
);
631 {function GetLines(Text: string; MaxChars: Word): SSArray;
639 while Pos(' ', Text) <> 0 do Text := AnsiReplaceStr(Text, ' ', ' ');
643 SetLength(b, Length(b)+1);
644 b[High(b)] := GetStr(Text);
650 if a > High(b) then Break;
655 if Length(str) >= MaxChars then
659 SetLength(Result, Length(Result)+1);
660 Result[High(Result)] := Copy(str, 1, MaxChars);
661 Delete(str, 1, MaxChars);
667 while (a <= High(b)) and (Length(str+' '+b[a]) <= MaxChars) do
673 SetLength(Result, Length(Result)+1);
674 Result[High(Result)] := str;
678 function GetLines(Text: string; FontID
: DWORD
; MaxWidth
: Word): SSArray
;
680 function TextLen(Text: string): Word;
684 e_CharFont_GetSize(FontID
, Text, Result
, h
);
692 SetLength(Result
, 0);
697 // Óäàëÿåì ìíîæåñòâåííûå ïðîáåëû:
698 while Pos(' ', Text) <> 0 do
699 Text := AnsiReplaceStr(Text, ' ', ' ');
703 SetLength(b
, Length(b
)+1);
704 b
[High(b
)] := GetStr(Text);
716 if TextLen(str
) > MaxWidth
then
717 begin // Òåêóùàÿ ñòðîêà ñëèøêîì äëèííàÿ => ðàçáèâàåì
720 SetLength(Result
, Length(Result
)+1);
723 while (c
< Length(str
)) and
724 (TextLen(Copy(str
, 1, c
+1)) < MaxWidth
) do
727 Result
[High(Result
)] := Copy(str
, 1, c
);
731 else // Ñòðîêà íîðìàëüíîé äëèíû => ñîåäèíÿåì ñî ñëåäóþùèìè
733 while (a
<= High(b
)) and
734 (TextLen(str
+' '+b
[a
]) < MaxWidth
) do
740 SetLength(Result
, Length(Result
)+1);
741 Result
[High(Result
)] := str
;
746 procedure Sort(var a
: SSArray
);
751 if a
= nil then Exit
;
753 for i
:= High(a
) downto Low(a
) do
754 for j
:= Low(a
) to High(a
)-1 do
755 if LowerCase(a
[j
]) > LowerCase(a
[j
+1]) then
763 function Sscanf(const s
: String; const fmt
: String;
764 const Pointers
: array of Pointer): Integer;
771 function GetInt(): Integer;
774 while (n
<= Length(s
)) and (s
[n
] = ' ') do
777 while (n
<= Length(s
)) and (s
[n
] in ['0'..'9', '+', '-']) do
783 Result
:= Length(s1
);
786 function GetFloat(): Integer;
789 while (n
<= Length(s
)) and (s
[n
] = ' ') do
792 while (n
<= Length(s
)) and //jd >= rather than >
793 (s
[n
] in ['0'..'9', '+', '-', '.', 'e', 'E']) do
799 Result
:= Length(s1
);
802 function GetString(): Integer;
805 while (n
<= Length(s
)) and (s
[n
] = ' ') do
808 while (n
<= Length(s
)) and (s
[n
] <> ' ') do
814 Result
:= Length(s1
);
817 function ScanStr(c
: Char): Boolean;
819 while (n
<= Length(s
)) and (s
[n
] <> c
) do
823 Result
:= (n
<= Length(s
));
826 function GetFmt(): Integer;
832 while (fmt
[m
] = ' ') and (m
< Length(fmt
)) do
834 if (m
>= Length(fmt
)) then
837 if (fmt
[m
] = '%') then
841 'd': Result
:= vtInteger
;
842 'f': Result
:= vtExtended
;
843 's': Result
:= vtString
;
849 if (not ScanStr(fmt
[m
])) then
861 for i
:= 0 to High(Pointers
) do
870 L
:= StrToIntDef(s1
, 0);
871 Move(L
, Pointers
[i
]^, SizeOf(LongInt));
880 if GetFloat() > 0 then
882 X
:= StrToFloatDef(s1
, 0.0);
883 Move(X
, Pointers
[i
]^, SizeOf(Extended
));
892 if GetString() > 0 then
894 Move(s1
, Pointers
[i
]^, Length(s1
)+1);
907 function InDWArray(a
: DWORD
; arr
: DWArray
): Boolean;
913 if arr
= nil then Exit
;
915 for b
:= 0 to High(arr
) do
923 function InWArray(a
: Word; arr
: WArray
): Boolean;
929 if arr
= nil then Exit
;
931 for b
:= 0 to High(arr
) do
939 function InSArray(a
: string; arr
: SSArray
): Boolean;
945 if arr
= nil then Exit
;
947 a
:= AnsiLowerCase(a
);
949 for b
:= 0 to High(arr
) do
950 if AnsiLowerCase(arr
[b
]) = a
then
957 function GetPos(UID
: Word; o
: PObj
): Boolean;
964 case g_GetUIDType(UID
) of
967 p
:= g_Player_Get(UID
);
968 if p
= nil then Exit
;
969 if not p
.alive
then Exit
;
976 m
:= g_Monsters_ByUID(UID
);
977 if m
= nil then Exit
;
978 if not m
.alive
then Exit
;
988 function parse(s
: String): SSArray
;
998 for a
:= 1 to Length(s
) do
999 if (s
[a
] = ',') or (a
= Length(s
)) then
1001 SetLength(Result
, Length(Result
)+1);
1004 Result
[High(Result
)] := Copy(s
, 1, a
-1)
1005 else // Êîíåö ñòðîêè
1006 Result
[High(Result
)] := s
;
1014 function parse2(s
: string; delim
: Char): SSArray
;
1019 if s
= '' then Exit
;
1023 for a
:= 1 to Length(s
) do
1024 if (s
[a
] = delim
) or (a
= Length(s
)) then
1026 SetLength(Result
, Length(Result
)+1);
1028 if s
[a
] = delim
then Result
[High(Result
)] := Copy(s
, 1, a
-1)
1029 else Result
[High(Result
)] := s
;
1037 function g_GetFileTime(fileName
: String): Integer;
1041 if not FileExists(fileName
) then
1047 AssignFile(F
, fileName
);
1049 Result
:= FileGetDate(TFileRec(F
).Handle
);
1053 function g_SetFileTime(fileName
: String; time
: Integer): Boolean;
1057 if (not FileExists(fileName
)) or (time
< 0) then
1063 AssignFile(F
, fileName
);
1065 Result
:= (FileSetDate(TFileRec(F
).Handle
, time
) = 0);
1069 procedure SortSArray(var S
: SSArray
);
1077 for i
:= Low(S
) to High(S
) - 1 do
1078 if S
[i
] > S
[i
+ 1] then begin
1087 function b_Text_Format(S
: string): string;
1095 for I
:= 1 to Length(S
) do
1097 if (not Spec
) and (S
[I
] = '\') and (I
+ 1 <= Length(S
)) then
1107 Result
:= Result
+ #10;
1109 Result
:= Result
+ #1;
1111 Result
:= Result
+ #2;
1113 Result
:= Result
+ #3;
1115 Result
:= Result
+ #4;
1117 Result
:= Result
+ #18;
1119 Result
:= Result
+ #19;
1121 Result
:= Result
+ #20;
1123 Result
:= Result
+ #21;
1125 Result
:= Result
+ '\';
1127 Result
:= Result
+ '\' + S
[I
];
1131 Result
:= Result
+ S
[I
];
1133 // reset to white at end
1134 if Rst
then Result
:= Result
+ #2;
1137 function b_Text_Unformat(S
: string): string;
1144 for I
:= 1 to Length(S
) do
1146 if S
[I
] in [#1, #2, #3, #4, #10, #18, #19, #20, #21] then
1151 if (not Spec
) and (S
[I
] = '\') and (I
+ 1 <= Length(S
)) then
1168 '\': Result
:= Result
+ '\';
1170 Result
:= Result
+ '\' + S
[I
];
1174 Result
:= Result
+ S
[I
];
1178 function b_Text_Wrap(S
: string; LineLen
: Integer): string;
1180 Result
:= WrapText(S
, ''#10, [#10, ' ', '-'], LineLen
);