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;
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;
46 function g_CollideLevel(X
, Y
: Integer; Width
, Height
: Word): Boolean;
47 function g_CollideAround(X1
, Y1
: Integer; Width1
, Height1
: Word;
48 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean;
49 function g_CollidePlayer(X
, Y
: Integer; Width
, Height
: Word): Boolean;
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): SArray
;
76 procedure Sort(var a
: SArray
);
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
: SArray
): Boolean;
82 function GetPos(UID
: Word; o
: PObj
): Boolean;
83 function parse(s
: string): SArray
;
84 function parse2(s
: string; delim
: Char): SArray
;
85 function g_GetFileTime(fileName
: String): Integer;
86 function g_SetFileTime(fileName
: String; time
: Integer): Boolean;
87 procedure SortSArray(var S
: SArray
);
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
, g_map
, g_gfx
, g_player
, SysUtils
, MAPDEF
,
99 StrUtils
, e_graphics
, g_monsters
, g_items
;
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;
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;
138 if gPlayers
= nil then Exit
;
140 for a
:= 0 to High(gPlayers
) do
141 if (gPlayers
[a
] <> nil) and gPlayers
[a
].Live
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
209 if g_Map_traceToNearestWall(x1
, y1
, x2
, y2
, @wallHitX
, @wallHitY
) then
212 //result := ((wallHitX-x1)*(wallHitX-x1)+(wallHitY-y1)*(wallHitY-y1) > (x2-x1)*(x2-x1)+(y2-y1)*(y2-y1));
217 result
:= true; // no obstacles
222 function g_CreateUID(UIDType
: Byte): Word;
233 Result
:= UID_MAX_GAME
+$1+Random(UID_MAX_PLAYER
-UID_MAX_GAME
+$1);
236 if gPlayers
<> nil then
237 for i
:= 0 to High(gPlayers
) do
238 if gPlayers
[i
] <> nil then
239 if Result
= gPlayers
[i
].UID
then
252 result
:= UID_MAX_PLAYER
+$1+Random(UID_MAX_MONSTER
-UID_MAX_GAME
-UID_MAX_PLAYER
+$1);
253 if (g_Monsters_ByUID(result
) = nil) then break
;
259 function g_GetUIDType(UID
: Word): Byte;
261 if UID
<= UID_MAX_GAME
then
264 if UID
<= UID_MAX_PLAYER
then
267 Result
:= UID_MONSTER
;
270 function g_Collide(X1
, Y1
: Integer; Width1
, Height1
: Word;
271 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean;
273 Result
:= not ( ((Y1
+ Height1
<= Y2
) or
274 (Y2
+ Height2
<= Y1
)) or
275 ((X1
+ Width1
<= X2
) or
276 (X2
+ Width2
<= X1
)) );
279 function g_CollideAround(X1
, Y1
: Integer; Width1
, Height1
: Word;
280 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean;
282 Result
:= g_Collide(X1
, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
283 g_Collide(X1
+1, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
284 g_Collide(X1
-1, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
285 g_Collide(X1
, Y1
+1, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
286 g_Collide(X1
, Y1
-1, Width1
, Height1
, X2
, Y2
, Width2
, Height2
);
289 function c(X1
, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
: Integer): Boolean;
291 Result
:= not (((Y1
+ Height1
<= Y2
) or
292 (Y1
>= Y2
+ Height2
)) or
293 ((X1
+ Width1
<= X2
) or
294 (X1
>= X2
+ Width2
)));
297 function g_Collide2(X1
, Y1
, X2
, Y2
, X3
, Y3
, X4
, Y4
: Integer): Boolean;
299 //Result := not (((Y2 <= Y3) or (Y1 >= Y4)) or ((X2 <= X3) or (X1 >= X4)));
300 Result
:= c(X1
, Y1
, X2
-X1
, Y2
-Y1
, X3
, Y3
, X4
-X3
, Y4
-Y3
);
303 function g_CollidePoint(X
, Y
, X2
, Y2
: Integer; Width
, Height
: Word): Boolean;
307 Result
:= (x
>= 0) and (x
<= Width
) and
308 (y
>= 0) and (y
<= Height
);
311 procedure IncMax(var A
: Integer; B
, Max
: Integer);
313 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
316 procedure IncMax(var A
: Single; B
, Max
: Single);
318 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
321 procedure DecMin(var A
: Integer; B
, Min
: Integer);
323 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
326 procedure DecMin(var A
: Word; B
, Min
: Word);
328 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
331 procedure DecMin(var A
: Single; B
, Min
: Single);
333 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
336 procedure IncMax(var A
: Integer; Max
: Integer);
338 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
341 procedure IncMax(var A
: Single; Max
: Single);
343 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
346 procedure IncMax(var A
: Word; B
, Max
: Word);
348 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
351 procedure IncMax(var A
: Word; Max
: Word);
353 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
356 procedure IncMax(var A
: SmallInt; B
, Max
: SmallInt);
358 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
361 procedure IncMax(var A
: SmallInt; Max
: SmallInt);
363 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
366 procedure DecMin(var A
: Integer; Min
: Integer);
368 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
371 procedure DecMin(var A
: Single; Min
: Single);
373 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
376 procedure DecMin(var A
: Word; Min
: Word);
378 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
381 procedure DecMin(var A
: Byte; B
, Min
: Byte);
383 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
386 procedure DecMin(var A
: Byte; Min
: Byte); overload
;
388 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
391 function Sign(A
: Integer): ShortInt;
393 if A
< 0 then Result
:= -1
394 else if A
> 0 then Result
:= 1
398 function Sign(A
: Single): ShortInt;
402 if Abs(A
) < Eps
then Result
:= 0
403 else if A
< 0 then Result
:= -1
407 function PointToRect(X
, Y
, X1
, Y1
: Integer; Width
, Height
: Word): Integer;
409 X
:= X
-X1
; // A(0;0) --- B(W;0)
414 if Y
< 0 then // Ñëåâà ñâåðõó: ðàññòîÿíèå äî A
415 Result
:= Round(Hypot(X
, Y
))
417 if Y
> Height
then // Ñëåâà ñíèçó: ðàññòîÿíèå äî D
418 Result
:= Round(Hypot(X
, Y
-Height
))
419 else // Ñëåâà ïîñåðåäèíå: ðàññòîÿíèå äî AD
426 if y
< 0 then // Ñïðàâà ñâåðõó: ðàññòîÿíèå äî B
427 Result
:= Round(Hypot(X
, Y
))
429 if Y
> Height
then // Ñïðàâà ñíèçó: ðàññòîÿíèå äî C
430 Result
:= Round(Hypot(X
, Y
-Height
))
431 else // Ñïðàâà ïîñåðåäèíå: ðàññòîÿíèå äî BC
436 if Y
< 0 then // Ïîñåðåäèíå ñâåðõó: ðàññòîÿíèå äî AB
439 if Y
> Height
then // Ïîñåðåäèíå ñíèçó: ðàññòîÿíèå äî DC
441 else // Âíóòðè ïðÿìîóãîëüíèêà: ðàññòîÿíèå 0
446 function g_GetAcidHit(X
, Y
: Integer; Width
, Height
: Word): Byte;
448 tab
: array[0..3] of Byte = (0, 5, 10, 20);
454 if g_Map_CollidePanel(X
, Y
, Width
, Height
, PANEL_ACID1
, False) then a
:= a
or 1;
455 if g_Map_CollidePanel(X
, Y
, Width
, Height
, PANEL_ACID2
, False) then a
:= a
or 2;
460 function g_Look(a
, b
: PObj
; d
: TDirection
): Boolean;
462 if not gmon_dbg_los_enabled
then begin result
:= false; exit
; end; // always "wall hit"
464 if ((b
^.X
> a
^.X
) and (d
= D_LEFT
)) or
465 ((b
^.X
< a
^.X
) and (d
= D_RIGHT
)) then
471 Result
:= g_TraceVector(a
^.X
+a
^.Rect
.X
+(a
^.Rect
.Width
div 2),
472 a
^.Y
+a
^.Rect
.Y
+(a
^.Rect
.Height
div 2),
473 b
^.X
+b
^.Rect
.X
+(b
^.Rect
.Width
div 2),
474 b
^.Y
+b
^.Rect
.Y
+(b
^.Rect
.Height
div 2));
477 function GetAngle(baseX
, baseY
, pointX
, PointY
: Integer): SmallInt;
482 a
:= abs(pointX
-baseX
);
483 b
:= abs(pointY
-baseY
);
485 if a
= 0 then c
:= 90
486 else c
:= RadToDeg(ArcTan(b
/a
));
488 if pointY
< baseY
then c
:= -c
;
489 if pointX
> baseX
then c
:= 180-c
;
494 function GetAngle2(vx
, vy
: Integer): SmallInt;
505 c
:= RadToDeg(ArcTan(b
/a
));
517 {function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
519 table: array[0..8, 0..8] of Byte =
520 ((0, 0, 3, 3, 1, 2, 2, 0, 1),
521 (0, 0, 0, 0, 4, 7, 2, 0, 1),
522 (3, 0, 0, 0, 4, 4, 1, 3, 1),
523 (3, 0, 0, 0, 0, 0, 5, 6, 1),
524 (1, 4, 4, 0, 0, 0, 5, 5, 1),
525 (2, 7, 4, 0, 0, 0, 0, 0, 1),
526 (2, 2, 1, 5, 5, 0, 0, 0, 1),
527 (0, 0, 3, 6, 5, 0, 0, 0, 1),
528 (1, 1, 1, 1, 1, 1, 1, 1, 1));
530 function GetClass(x, y: Integer): Byte;
534 if x < rX then Result := 7
535 else if x < rX+rWidth then Result := 0
538 else if y < rY+rHeight then
540 if x < rX then Result := 6
541 else if x < rX+rWidth then Result := 8
546 if x < rX then Result := 5
547 else if x < rX+rWidth then Result := 4
553 case table[GetClass(x1, y1), GetClass(x2, y2)] of
556 2: Result := Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1));
557 3: Result := Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1));
558 4: Result := Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1));
559 5: Result := Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1));
560 6: Result := (Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1))) and
561 (Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1)));
562 7: Result := (Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1))) and
563 (Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1)));
564 else Result := False;
568 function g_CollideLine(x1
, y1
, x2
, y2
, rX
, rY
: Integer; rWidth
, rHeight
: Word): Boolean;
583 if dx
> 0 then incX
:= 1 else if dx
< 0 then incX
:= -1 else incX
:= 0;
584 if dy
> 0 then incY
:= 1 else if dy
< 0 then incY
:= -1 else incY
:= 0;
589 if dx
> dy
then d
:= dx
else d
:= dy
;
609 if (x
>= rX
) and (x
<= (rX
+ rWidth
- 1)) and
610 (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): SArray;
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): SArray
;
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
: SArray
);
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
: SArray
): 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
.Live
then Exit
;
976 m
:= g_Monsters_ByUID(UID
);
977 if m
= nil then Exit
;
978 if not m
.Live
then Exit
;
988 function parse(s
: String): SArray
;
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): SArray
;
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
: SArray
);
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
];