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';
31 UID_MAX_PLAYER
= $7FFF;
32 UID_MAX_MONSTER
= $FFFF;
35 TDirection
= (D_LEFT
, D_RIGHT
);
36 WArray
= array of Word;
37 DWArray
= array of DWORD
;
38 String20
= String[20];
40 function g_CreateUID(UIDType
: Byte): Word;
41 function g_GetUIDType(UID
: Word): Byte;
42 function g_Collide(X1
, Y1
: Integer; Width1
, Height1
: Word;
43 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean; inline;
44 function g_CollideLine(x1
, y1
, x2
, y2
, rX
, rY
: Integer; rWidth
, rHeight
: Word): Boolean;
45 function g_CollidePoint(X
, Y
, X2
, Y2
: Integer; Width
, Height
: Word): Boolean; inline;
46 function g_CollideLevel(X
, Y
: Integer; Width
, Height
: Word): Boolean; inline;
47 function g_CollideAround(X1
, Y1
: Integer; Width1
, Height1
: Word;
48 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean; inline;
49 function g_CollidePlayer(X
, Y
: Integer; Width
, Height
: Word): Boolean; inline;
50 function g_PatchLength(X1
, Y1
, X2
, Y2
: Integer): Word;
51 function g_TraceVector(X1
, Y1
, X2
, Y2
: Integer): Boolean; // `true`: no wall hit
52 function g_GetAcidHit(X
, Y
: Integer; Width
, Height
: Word): Byte;
53 function g_Look(a
, b
: PObj
; d
: TDirection
): Boolean;
54 procedure IncMax(var A
: Integer; B
, Max
: Integer); overload
;
55 procedure IncMax(var A
: Single; B
, Max
: Single); overload
;
56 procedure IncMax(var A
: Integer; Max
: Integer); overload
;
57 procedure IncMax(var A
: Single; Max
: Single); overload
;
58 procedure IncMax(var A
: Word; B
, Max
: Word); overload
;
59 procedure IncMax(var A
: Word; Max
: Word); overload
;
60 procedure IncMax(var A
: SmallInt
; B
, Max
: SmallInt
); overload
;
61 procedure IncMax(var A
: SmallInt
; Max
: SmallInt
); overload
;
62 procedure DecMin(var A
: Integer; B
, Min
: Integer); overload
;
63 procedure DecMin(var A
: Single; B
, Min
: Single); overload
;
64 procedure DecMin(var A
: Integer; Min
: Integer); overload
;
65 procedure DecMin(var A
: Single; Min
: Single); overload
;
66 procedure DecMin(var A
: Word; B
, Min
: Word); overload
;
67 procedure DecMin(var A
: Word; Min
: Word); overload
;
68 procedure DecMin(var A
: Byte; B
, Min
: Byte); overload
;
69 procedure DecMin(var A
: Byte; Min
: Byte); overload
;
70 function Sign(A
: Integer): ShortInt
; overload
;
71 function Sign(A
: Single): ShortInt
; overload
;
72 function PointToRect(X
, Y
, X1
, Y1
: Integer; Width
, Height
: Word): Integer;
73 function GetAngle(baseX
, baseY
, pointX
, PointY
: Integer): SmallInt
;
74 function GetAngle2(vx
, vy
: Integer): SmallInt
;
75 function GetLines(Text: string; FontID
: DWORD
; MaxWidth
: Word): SSArray
;
76 procedure Sort(var a
: SSArray
);
77 function Sscanf(const s
: string; const fmt
: string;
78 const Pointers
: array of Pointer): Integer;
79 function InDWArray(a
: DWORD
; arr
: DWArray
): Boolean;
80 function InWArray(a
: Word; arr
: WArray
): Boolean;
81 function InSArray(a
: string; arr
: SSArray
): Boolean;
82 function GetPos(UID
: Word; o
: PObj
): Boolean;
83 function parse(s
: string): SSArray
;
84 function parse2(s
: string; delim
: Char): SSArray
;
85 function g_GetFileTime(fileName
: String): Integer;
86 function g_SetFileTime(fileName
: String; time
: Integer): Boolean;
87 procedure SortSArray(var S
: SSArray
);
88 function b_Text_Format(S
: string): string;
89 function b_Text_Unformat(S
: string): string;
93 gmon_dbg_los_enabled
: Boolean = true;
98 Math
, geom
, e_log
, g_map
, g_gfx
, g_player
, SysUtils
, MAPDEF
,
99 StrUtils
, e_graphics
, g_monsters
, g_items
, g_game
;
101 function g_PatchLength(X1
, Y1
, X2
, Y2
: Integer): Word;
103 Result
:= Min(Round(Hypot(Abs(X2
-X1
), Abs(Y2
-Y1
))), 65535);
106 function g_CollideLevel(X
, Y
: Integer; Width
, Height
: Word): Boolean; inline;
108 result
:= g_Map_CollidePanel(X
, Y
, Width
, Height
, (PANEL_WALL
or PANEL_CLOSEDOOR
or PANEL_OPENDOOR
), false);
119 for a := 0 to High(gWalls) do
120 if gWalls[a].Enabled and
121 not ( ((Y + Height <= gWalls[a].Y) or
122 (Y >= gWalls[a].Y + gWalls[a].Height)) or
123 ((X + Width <= gWalls[a].X) or
124 (X >= gWalls[a].X + gWalls[a].Width)) ) then
132 function g_CollidePlayer(X
, Y
: Integer; Width
, Height
: Word): Boolean; inline;
138 if gPlayers
= nil then Exit
;
140 for a
:= 0 to High(gPlayers
) do
141 if (gPlayers
[a
] <> nil) and gPlayers
[a
].alive
then
142 if gPlayers
[a
].Collide(X
, Y
, Width
, Height
) then
150 function g_TraceVector(X1
, Y1
, X2
, Y2
: Integer): Boolean;
152 wallHitX
: Integer = 0;
153 wallHitY
: Integer = 0;
157 Xerr, Yerr, d: LongWord;
165 Assert(gCollideMap <> nil, 'g_TraceVector: gCollideMap = nil');
172 if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0;
173 if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0;
178 if dx > dy then d := dx else d := dy;
198 if (y > gMapInfo.Height-1) or
199 (y < 0) or (x > gMapInfo.Width-1) or (x < 0) then
201 if ByteBool(gCollideMap[y, x] and MARK_BLOCKED) then
208 // `true` if no obstacles
209 if (g_profile_los
) then g_Mons_LOS_Start();
210 result
:= (g_Map_traceToNearestWall(x1
, y1
, x2
, y2
, @wallHitX
, @wallHitY
) = nil);
211 if (g_profile_los
) then g_Mons_LOS_End();
215 function g_CreateUID(UIDType
: Byte): Word;
226 Result
:= UID_MAX_GAME
+$1+Random(UID_MAX_PLAYER
-UID_MAX_GAME
+$1);
229 if gPlayers
<> nil then
230 for i
:= 0 to High(gPlayers
) do
231 if gPlayers
[i
] <> nil then
232 if Result
= gPlayers
[i
].UID
then
245 result
:= UID_MAX_PLAYER
+$1+Random(UID_MAX_MONSTER
-UID_MAX_GAME
-UID_MAX_PLAYER
+$1);
246 if (g_Monsters_ByUID(result
) = nil) then break
;
252 function g_GetUIDType(UID
: Word): Byte;
254 if UID
<= UID_MAX_GAME
then
257 if UID
<= UID_MAX_PLAYER
then
260 Result
:= UID_MONSTER
;
263 function g_Collide(X1
, Y1
: Integer; Width1
, Height1
: Word;
264 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean; inline;
266 Result
:= not ( ((Y1
+ Height1
<= Y2
) or
267 (Y2
+ Height2
<= Y1
)) or
268 ((X1
+ Width1
<= X2
) or
269 (X2
+ Width2
<= X1
)) );
272 function g_CollideAround(X1
, Y1
: Integer; Width1
, Height1
: Word;
273 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean; inline;
275 Result
:= g_Collide(X1
, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
276 g_Collide(X1
+1, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
277 g_Collide(X1
-1, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
278 g_Collide(X1
, Y1
+1, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
279 g_Collide(X1
, Y1
-1, Width1
, Height1
, X2
, Y2
, Width2
, Height2
);
282 function c(X1
, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
: Integer): Boolean; inline;
284 Result
:= not (((Y1
+ Height1
<= Y2
) or
285 (Y1
>= Y2
+ Height2
)) or
286 ((X1
+ Width1
<= X2
) or
287 (X1
>= X2
+ Width2
)));
290 function g_Collide2(X1
, Y1
, X2
, Y2
, X3
, Y3
, X4
, Y4
: Integer): Boolean; inline;
292 //Result := not (((Y2 <= Y3) or (Y1 >= Y4)) or ((X2 <= X3) or (X1 >= X4)));
293 Result
:= c(X1
, Y1
, X2
-X1
, Y2
-Y1
, X3
, Y3
, X4
-X3
, Y4
-Y3
);
296 function g_CollidePoint(X
, Y
, X2
, Y2
: Integer; Width
, Height
: Word): Boolean; inline;
300 Result
:= (x
>= 0) and (x
<= Width
) and
301 (y
>= 0) and (y
<= Height
);
304 procedure IncMax(var A
: Integer; B
, Max
: Integer);
306 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
309 procedure IncMax(var A
: Single; B
, Max
: Single);
311 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
314 procedure DecMin(var A
: Integer; B
, Min
: Integer);
316 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
319 procedure DecMin(var A
: Word; B
, Min
: Word);
321 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
324 procedure DecMin(var A
: Single; B
, Min
: Single);
326 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
329 procedure IncMax(var A
: Integer; Max
: Integer);
331 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
334 procedure IncMax(var A
: Single; Max
: Single);
336 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
339 procedure IncMax(var A
: Word; B
, Max
: Word);
341 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
344 procedure IncMax(var A
: Word; Max
: Word);
346 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
349 procedure IncMax(var A
: SmallInt
; B
, Max
: SmallInt
);
351 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
354 procedure IncMax(var A
: SmallInt
; Max
: SmallInt
);
356 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
359 procedure DecMin(var A
: Integer; Min
: Integer);
361 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
364 procedure DecMin(var A
: Single; Min
: Single);
366 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
369 procedure DecMin(var A
: Word; Min
: Word);
371 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
374 procedure DecMin(var A
: Byte; B
, Min
: Byte);
376 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
379 procedure DecMin(var A
: Byte; Min
: Byte); overload
;
381 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
384 function Sign(A
: Integer): ShortInt
;
386 if A
< 0 then Result
:= -1
387 else if A
> 0 then Result
:= 1
391 function Sign(A
: Single): ShortInt
;
395 if Abs(A
) < Eps
then Result
:= 0
396 else if A
< 0 then Result
:= -1
400 function PointToRect(X
, Y
, X1
, Y1
: Integer; Width
, Height
: Word): Integer;
402 X
:= X
-X1
; // A(0;0) --- B(W;0)
407 if Y
< 0 then // Ñëåâà ñâåðõó: ðàññòîÿíèå äî A
408 Result
:= Round(Hypot(X
, Y
))
410 if Y
> Height
then // Ñëåâà ñíèçó: ðàññòîÿíèå äî D
411 Result
:= Round(Hypot(X
, Y
-Height
))
412 else // Ñëåâà ïîñåðåäèíå: ðàññòîÿíèå äî AD
419 if y
< 0 then // Ñïðàâà ñâåðõó: ðàññòîÿíèå äî B
420 Result
:= Round(Hypot(X
, Y
))
422 if Y
> Height
then // Ñïðàâà ñíèçó: ðàññòîÿíèå äî C
423 Result
:= Round(Hypot(X
, Y
-Height
))
424 else // Ñïðàâà ïîñåðåäèíå: ðàññòîÿíèå äî BC
429 if Y
< 0 then // Ïîñåðåäèíå ñâåðõó: ðàññòîÿíèå äî AB
432 if Y
> Height
then // Ïîñåðåäèíå ñíèçó: ðàññòîÿíèå äî DC
434 else // Âíóòðè ïðÿìîóãîëüíèêà: ðàññòîÿíèå 0
439 function g_GetAcidHit(X
, Y
: Integer; Width
, Height
: Word): Byte;
441 tab
: array[0..3] of Byte = (0, 5, 10, 20);
447 if g_Map_CollidePanel(X
, Y
, Width
, Height
, PANEL_ACID1
, False) then a
:= a
or 1;
448 if g_Map_CollidePanel(X
, Y
, Width
, Height
, PANEL_ACID2
, False) then a
:= a
or 2;
453 function g_Look(a
, b
: PObj
; d
: TDirection
): Boolean;
455 if not gmon_dbg_los_enabled
then begin result
:= false; exit
; end; // always "wall hit"
457 if ((b
^.X
> a
^.X
) and (d
= TDirection
.D_LEFT
)) or
458 ((b
^.X
< a
^.X
) and (d
= TDirection
.D_RIGHT
)) then
464 Result
:= g_TraceVector(a
^.X
+a
^.Rect
.X
+(a
^.Rect
.Width
div 2),
465 a
^.Y
+a
^.Rect
.Y
+(a
^.Rect
.Height
div 2),
466 b
^.X
+b
^.Rect
.X
+(b
^.Rect
.Width
div 2),
467 b
^.Y
+b
^.Rect
.Y
+(b
^.Rect
.Height
div 2));
470 function GetAngle(baseX
, baseY
, pointX
, PointY
: Integer): SmallInt
;
475 a
:= abs(pointX
-baseX
);
476 b
:= abs(pointY
-baseY
);
478 if a
= 0 then c
:= 90
479 else c
:= RadToDeg(ArcTan(b
/a
));
481 if pointY
< baseY
then c
:= -c
;
482 if pointX
> baseX
then c
:= 180-c
;
487 function GetAngle2(vx
, vy
: Integer): SmallInt
;
498 c
:= RadToDeg(ArcTan(b
/a
));
510 {function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
512 table: array[0..8, 0..8] of Byte =
513 ((0, 0, 3, 3, 1, 2, 2, 0, 1),
514 (0, 0, 0, 0, 4, 7, 2, 0, 1),
515 (3, 0, 0, 0, 4, 4, 1, 3, 1),
516 (3, 0, 0, 0, 0, 0, 5, 6, 1),
517 (1, 4, 4, 0, 0, 0, 5, 5, 1),
518 (2, 7, 4, 0, 0, 0, 0, 0, 1),
519 (2, 2, 1, 5, 5, 0, 0, 0, 1),
520 (0, 0, 3, 6, 5, 0, 0, 0, 1),
521 (1, 1, 1, 1, 1, 1, 1, 1, 1));
523 function GetClass(x, y: Integer): Byte;
527 if x < rX then Result := 7
528 else if x < rX+rWidth then Result := 0
531 else if y < rY+rHeight then
533 if x < rX then Result := 6
534 else if x < rX+rWidth then Result := 8
539 if x < rX then Result := 5
540 else if x < rX+rWidth then Result := 4
546 case table[GetClass(x1, y1), GetClass(x2, y2)] of
549 2: Result := Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1));
550 3: Result := Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1));
551 4: Result := Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1));
552 5: Result := Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1));
553 6: Result := (Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1))) and
554 (Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1)));
555 7: Result := (Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1))) and
556 (Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1)));
557 else Result := False;
561 function g_CollideLine(x1
, y1
, x2
, y2
, rX
, rY
: Integer; rWidth
, rHeight
: Word): Boolean;
571 result
:= lineAABBIntersects(x1
, y1
, x2
, y2
, rX
, rY
, rWidth
, rHeight
);
580 if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0;
581 if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0;
586 if dx > dy then d := dx else d := dy;
606 if (x >= rX) and (x <= (rX + rWidth - 1)) and
607 (y >= rY) and (y <= (rY + rHeight - 1)) then Exit;
614 function GetStr(var Str
: string): string;
619 for a
:= 1 to Length(Str
) do
620 if (a
= Length(Str
)) or (Str
[a
+1] = ' ') then
622 Result
:= Copy(Str
, 1, a
);
629 {function GetLines(Text: string; MaxChars: Word): SSArray;
637 while Pos(' ', Text) <> 0 do Text := AnsiReplaceStr(Text, ' ', ' ');
641 SetLength(b, Length(b)+1);
642 b[High(b)] := GetStr(Text);
648 if a > High(b) then Break;
653 if Length(str) >= MaxChars then
657 SetLength(Result, Length(Result)+1);
658 Result[High(Result)] := Copy(str, 1, MaxChars);
659 Delete(str, 1, MaxChars);
665 while (a <= High(b)) and (Length(str+' '+b[a]) <= MaxChars) do
671 SetLength(Result, Length(Result)+1);
672 Result[High(Result)] := str;
676 function GetLines(Text: string; FontID
: DWORD
; MaxWidth
: Word): SSArray
;
678 function TextLen(Text: string): Word;
682 e_CharFont_GetSize(FontID
, Text, Result
, h
);
690 SetLength(Result
, 0);
695 // Óäàëÿåì ìíîæåñòâåííûå ïðîáåëû:
696 while Pos(' ', Text) <> 0 do
697 Text := AnsiReplaceStr(Text, ' ', ' ');
701 SetLength(b
, Length(b
)+1);
702 b
[High(b
)] := GetStr(Text);
714 if TextLen(str
) > MaxWidth
then
715 begin // Òåêóùàÿ ñòðîêà ñëèøêîì äëèííàÿ => ðàçáèâàåì
718 SetLength(Result
, Length(Result
)+1);
721 while (c
< Length(str
)) and
722 (TextLen(Copy(str
, 1, c
+1)) < MaxWidth
) do
725 Result
[High(Result
)] := Copy(str
, 1, c
);
729 else // Ñòðîêà íîðìàëüíîé äëèíû => ñîåäèíÿåì ñî ñëåäóþùèìè
731 while (a
<= High(b
)) and
732 (TextLen(str
+' '+b
[a
]) < MaxWidth
) do
738 SetLength(Result
, Length(Result
)+1);
739 Result
[High(Result
)] := str
;
744 procedure Sort(var a
: SSArray
);
749 if a
= nil then Exit
;
751 for i
:= High(a
) downto Low(a
) do
752 for j
:= Low(a
) to High(a
)-1 do
753 if LowerCase(a
[j
]) > LowerCase(a
[j
+1]) then
761 function Sscanf(const s
: String; const fmt
: String;
762 const Pointers
: array of Pointer): Integer;
769 function GetInt(): Integer;
772 while (n
<= Length(s
)) and (s
[n
] = ' ') do
775 while (n
<= Length(s
)) and (s
[n
] in ['0'..'9', '+', '-']) do
781 Result
:= Length(s1
);
784 function GetFloat(): Integer;
787 while (n
<= Length(s
)) and (s
[n
] = ' ') do
790 while (n
<= Length(s
)) and //jd >= rather than >
791 (s
[n
] in ['0'..'9', '+', '-', '.', 'e', 'E']) do
797 Result
:= Length(s1
);
800 function GetString(): Integer;
803 while (n
<= Length(s
)) and (s
[n
] = ' ') do
806 while (n
<= Length(s
)) and (s
[n
] <> ' ') do
812 Result
:= Length(s1
);
815 function ScanStr(c
: Char): Boolean;
817 while (n
<= Length(s
)) and (s
[n
] <> c
) do
821 Result
:= (n
<= Length(s
));
824 function GetFmt(): Integer;
830 while (fmt
[m
] = ' ') and (m
< Length(fmt
)) do
832 if (m
>= Length(fmt
)) then
835 if (fmt
[m
] = '%') then
839 'd': Result
:= vtInteger
;
840 'f': Result
:= vtExtended
;
841 's': Result
:= vtString
;
847 if (not ScanStr(fmt
[m
])) then
859 for i
:= 0 to High(Pointers
) do
868 L
:= StrToIntDef(s1
, 0);
869 Move(L
, Pointers
[i
]^, SizeOf(LongInt));
878 if GetFloat() > 0 then
880 X
:= StrToFloatDef(s1
, 0.0);
881 Move(X
, Pointers
[i
]^, SizeOf(Extended
));
890 if GetString() > 0 then
892 Move(s1
, Pointers
[i
]^, Length(s1
)+1);
905 function InDWArray(a
: DWORD
; arr
: DWArray
): Boolean;
911 if arr
= nil then Exit
;
913 for b
:= 0 to High(arr
) do
921 function InWArray(a
: Word; arr
: WArray
): Boolean;
927 if arr
= nil then Exit
;
929 for b
:= 0 to High(arr
) do
937 function InSArray(a
: string; arr
: SSArray
): Boolean;
943 if arr
= nil then Exit
;
945 a
:= AnsiLowerCase(a
);
947 for b
:= 0 to High(arr
) do
948 if AnsiLowerCase(arr
[b
]) = a
then
955 function GetPos(UID
: Word; o
: PObj
): Boolean;
962 case g_GetUIDType(UID
) of
965 p
:= g_Player_Get(UID
);
966 if p
= nil then Exit
;
967 if not p
.alive
then Exit
;
974 m
:= g_Monsters_ByUID(UID
);
975 if m
= nil then Exit
;
976 if not m
.alive
then Exit
;
986 function parse(s
: String): SSArray
;
996 for a
:= 1 to Length(s
) do
997 if (s
[a
] = ',') or (a
= Length(s
)) then
999 SetLength(Result
, Length(Result
)+1);
1002 Result
[High(Result
)] := Copy(s
, 1, a
-1)
1003 else // Êîíåö ñòðîêè
1004 Result
[High(Result
)] := s
;
1012 function parse2(s
: string; delim
: Char): SSArray
;
1017 if s
= '' then Exit
;
1021 for a
:= 1 to Length(s
) do
1022 if (s
[a
] = delim
) or (a
= Length(s
)) then
1024 SetLength(Result
, Length(Result
)+1);
1026 if s
[a
] = delim
then Result
[High(Result
)] := Copy(s
, 1, a
-1)
1027 else Result
[High(Result
)] := s
;
1035 function g_GetFileTime(fileName
: String): Integer;
1039 if not FileExists(fileName
) then
1045 AssignFile(F
, fileName
);
1047 Result
:= FileGetDate(TFileRec(F
).Handle
);
1051 function g_SetFileTime(fileName
: String; time
: Integer): Boolean;
1055 if (not FileExists(fileName
)) or (time
< 0) then
1061 AssignFile(F
, fileName
);
1063 Result
:= (FileSetDate(TFileRec(F
).Handle
, time
) = 0);
1067 procedure SortSArray(var S
: SSArray
);
1075 for i
:= Low(S
) to High(S
) - 1 do
1076 if S
[i
] > S
[i
+ 1] then begin
1085 function b_Text_Format(S
: string): string;
1093 for I
:= 1 to Length(S
) do
1095 if (not Spec
) and (S
[I
] = '\') and (I
+ 1 <= Length(S
)) then
1105 Result
:= Result
+ #10;
1107 Result
:= Result
+ #1;
1109 Result
:= Result
+ #2;
1111 Result
:= Result
+ #3;
1113 Result
:= Result
+ #4;
1115 Result
:= Result
+ #18;
1117 Result
:= Result
+ #19;
1119 Result
:= Result
+ #20;
1121 Result
:= Result
+ #21;
1123 Result
:= Result
+ '\';
1125 Result
:= Result
+ '\' + S
[I
];
1129 Result
:= Result
+ S
[I
];
1131 // reset to white at end
1132 if Rst
then Result
:= Result
+ #2;
1135 function b_Text_Unformat(S
: string): string;
1142 for I
:= 1 to Length(S
) do
1144 if S
[I
] in [#1, #2, #3, #4, #10, #18, #19, #20, #21] then
1149 if (not Spec
) and (S
[I
] = '\') and (I
+ 1 <= Length(S
)) then
1166 '\': Result
:= Result
+ '\';
1168 Result
:= Result
+ '\' + S
[I
];
1172 Result
:= Result
+ S
[I
];