DEADSOFTWARE

sfs and wad code refactoring: part 1
[d2df-sdl.git] / src / game / g_basic.pas
1 unit g_basic;
3 interface
5 uses
6 wadreader, g_phys;
8 const
9 GAME_VERSION = '0.667';
10 UID_GAME = 1;
11 UID_PLAYER = 2;
12 UID_MONSTER = 3;
13 UID_ITEM = 10;
14 UID_MAX_GAME = $10;
15 UID_MAX_PLAYER = $7FFF;
16 UID_MAX_MONSTER = $FFFF;
18 type
19 TDirection = (D_LEFT, D_RIGHT);
20 WArray = array of Word;
21 DWArray = array of DWORD;
22 String20 = String[20];
24 function g_CreateUID(UIDType: Byte): Word;
25 function g_GetUIDType(UID: Word): Byte;
26 function g_Collide(X1, Y1: Integer; Width1, Height1: Word;
27 X2, Y2: Integer; Width2, Height2: Word): Boolean;
28 function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
29 function g_CollidePoint(X, Y, X2, Y2: Integer; Width, Height: Word): Boolean;
30 function g_CollideLevel(X, Y: Integer; Width, Height: Word): Boolean;
31 function g_CollideAround(X1, Y1: Integer; Width1, Height1: Word;
32 X2, Y2: Integer; Width2, Height2: Word): Boolean;
33 function g_CollidePlayer(X, Y: Integer; Width, Height: Word): Boolean;
34 function g_CollideMonster(X, Y: Integer; Width, Height: Word): Boolean;
35 function g_CollideItem(X, Y: Integer; Width, Height: Word): Boolean;
36 function g_PatchLength(X1, Y1, X2, Y2: Integer): Word;
37 function g_TraceVector(X1, Y1, X2, Y2: Integer): Boolean;
38 function g_GetAcidHit(X, Y: Integer; Width, Height: Word): Byte;
39 function g_Look(a, b: PObj; d: TDirection): Boolean;
40 procedure IncMax(var A: Integer; B, Max: Integer); overload;
41 procedure IncMax(var A: Single; B, Max: Single); overload;
42 procedure IncMax(var A: Integer; Max: Integer); overload;
43 procedure IncMax(var A: Single; Max: Single); overload;
44 procedure IncMax(var A: Word; B, Max: Word); overload;
45 procedure IncMax(var A: Word; Max: Word); overload;
46 procedure IncMax(var A: SmallInt; B, Max: SmallInt); overload;
47 procedure IncMax(var A: SmallInt; Max: SmallInt); overload;
48 procedure DecMin(var A: Integer; B, Min: Integer); overload;
49 procedure DecMin(var A: Single; B, Min: Single); overload;
50 procedure DecMin(var A: Integer; Min: Integer); overload;
51 procedure DecMin(var A: Single; Min: Single); overload;
52 procedure DecMin(var A: Word; B, Min: Word); overload;
53 procedure DecMin(var A: Word; Min: Word); overload;
54 procedure DecMin(var A: Byte; B, Min: Byte); overload;
55 procedure DecMin(var A: Byte; Min: Byte); overload;
56 function Sign(A: Integer): ShortInt; overload;
57 function Sign(A: Single): ShortInt; overload;
58 function PointToRect(X, Y, X1, Y1: Integer; Width, Height: Word): Integer;
59 function GetAngle(baseX, baseY, pointX, PointY: Integer): SmallInt;
60 function GetAngle2(vx, vy: Integer): SmallInt;
61 function GetLines(Text: string; FontID: DWORD; MaxWidth: Word): SArray;
62 procedure Sort(var a: SArray);
63 function Sscanf(const s: string; const fmt: string;
64 const Pointers: array of Pointer): Integer;
65 function InDWArray(a: DWORD; arr: DWArray): Boolean;
66 function InWArray(a: Word; arr: WArray): Boolean;
67 function InSArray(a: string; arr: SArray): Boolean;
68 function GetPos(UID: Word; o: PObj): Boolean;
69 function parse(s: string): SArray;
70 function parse2(s: string; delim: Char): SArray;
71 function g_GetFileTime(fileName: String): Integer;
72 function g_SetFileTime(fileName: String; time: Integer): Boolean;
73 procedure SortSArray(var S: SArray);
74 function b_Text_Format(S: string): string;
75 function b_Text_Unformat(S: string): string;
77 implementation
79 uses
80 Math, g_map, g_gfx, g_player, SysUtils, MAPDEF,
81 StrUtils, e_graphics, g_monsters, g_items;
83 function g_PatchLength(X1, Y1, X2, Y2: Integer): Word;
84 begin
85 Result := Min(Round(Hypot(Abs(X2-X1), Abs(Y2-Y1))), 65535);
86 end;
88 function g_CollideLevel(X, Y: Integer; Width, Height: Word): Boolean;
89 var
90 a: Integer;
91 begin
92 Result := False;
94 if gWalls = nil then
95 Exit;
97 for a := 0 to High(gWalls) do
98 if gWalls[a].Enabled and
99 not ( ((Y + Height <= gWalls[a].Y) or
100 (Y >= gWalls[a].Y + gWalls[a].Height)) or
101 ((X + Width <= gWalls[a].X) or
102 (X >= gWalls[a].X + gWalls[a].Width)) ) then
103 begin
104 Result := True;
105 Exit;
106 end;
107 end;
109 function g_CollidePlayer(X, Y: Integer; Width, Height: Word): Boolean;
110 var
111 a: Integer;
112 begin
113 Result := False;
115 if gPlayers = nil then Exit;
117 for a := 0 to High(gPlayers) do
118 if (gPlayers[a] <> nil) and gPlayers[a].Live then
119 if gPlayers[a].Collide(X, Y, Width, Height) then
120 begin
121 Result := True;
122 Exit;
123 end;
124 end;
126 function g_CollideMonster(X, Y: Integer; Width, Height: Word): Boolean;
127 var
128 a: Integer;
129 begin
130 Result := False;
132 if gMonsters = nil then Exit;
134 for a := 0 to High(gMonsters) do
135 if (gMonsters[a] <> nil) and gMonsters[a].Live then
136 if g_Obj_Collide(X, Y, Width, Height, @gMonsters[a].Obj) then
137 begin
138 Result := True;
139 Exit;
140 end;
141 end;
143 function g_CollideItem(X, Y: Integer; Width, Height: Word): Boolean;
144 var
145 a: Integer;
146 begin
147 Result := False;
149 if gItems = nil then
150 Exit;
152 for a := 0 to High(gItems) do
153 if gItems[a].Live then
154 if g_Obj_Collide(X, Y, Width, Height, @gItems[a].Obj) then
155 begin
156 Result := True;
157 Exit;
158 end;
159 end;
161 function g_TraceVector(X1, Y1, X2, Y2: Integer): Boolean;
162 var
163 i: Integer;
164 dx, dy: Integer;
165 Xerr, Yerr, d: LongWord;
166 incX, incY: Integer;
167 x, y: Integer;
168 begin
169 Result := False;
171 Assert(gCollideMap <> nil, 'g_TraceVector: gCollideMap = nil');
173 Xerr := 0;
174 Yerr := 0;
175 dx := X2-X1;
176 dy := Y2-Y1;
178 if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0;
179 if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0;
181 dx := abs(dx);
182 dy := abs(dy);
184 if dx > dy then d := dx else d := dy;
186 x := X1;
187 y := Y1;
189 for i := 1 to d do
190 begin
191 Inc(Xerr, dx);
192 Inc(Yerr, dy);
193 if Xerr>d then
194 begin
195 Dec(Xerr, d);
196 Inc(x, incX);
197 end;
198 if Yerr > d then
199 begin
200 Dec(Yerr, d);
201 Inc(y, incY);
202 end;
204 if (y > gMapInfo.Height-1) or
205 (y < 0) or (x > gMapInfo.Width-1) or (x < 0) then
206 Exit;
207 if ByteBool(gCollideMap[y, x] and MARK_BLOCKED) then
208 Exit;
209 end;
211 Result := True;
212 end;
214 function g_CreateUID(UIDType: Byte): Word;
215 var
216 ok: Boolean;
217 i: Integer;
218 begin
219 Result := $0;
221 case UIDType of
222 UID_PLAYER:
223 begin
224 repeat
225 Result := UID_MAX_GAME+$1+Random(UID_MAX_PLAYER-UID_MAX_GAME+$1);
227 ok := True;
228 if gPlayers <> nil then
229 for i := 0 to High(gPlayers) do
230 if gPlayers[i] <> nil then
231 if Result = gPlayers[i].UID then
232 begin
233 ok := False;
234 Break;
235 end;
236 until ok;
237 end;
239 UID_MONSTER:
240 begin
241 repeat
242 Result := UID_MAX_PLAYER+$1+Random(UID_MAX_MONSTER-UID_MAX_GAME-UID_MAX_PLAYER+$1);
244 ok := True;
245 if gMonsters <> nil then
246 for i := 0 to High(gMonsters) do
247 if gMonsters[i] <> nil then
248 if Result = gMonsters[i].UID then
249 begin
250 ok := False;
251 Break;
252 end;
253 until ok;
254 end;
255 end;
256 end;
258 function g_GetUIDType(UID: Word): Byte;
259 begin
260 if UID <= UID_MAX_GAME then
261 Result := UID_GAME
262 else
263 if UID <= UID_MAX_PLAYER then
264 Result := UID_PLAYER
265 else
266 Result := UID_MONSTER;
267 end;
269 function g_Collide(X1, Y1: Integer; Width1, Height1: Word;
270 X2, Y2: Integer; Width2, Height2: Word): Boolean;
271 begin
272 Result := not ( ((Y1 + Height1 <= Y2) or
273 (Y2 + Height2 <= Y1)) or
274 ((X1 + Width1 <= X2) or
275 (X2 + Width2 <= X1)) );
276 end;
278 function g_CollideAround(X1, Y1: Integer; Width1, Height1: Word;
279 X2, Y2: Integer; Width2, Height2: Word): Boolean;
280 begin
281 Result := g_Collide(X1, Y1, Width1, Height1, X2, Y2, Width2, Height2) or
282 g_Collide(X1+1, 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, Y1+1, Width1, Height1, X2, Y2, Width2, Height2) or
285 g_Collide(X1, Y1-1, Width1, Height1, X2, Y2, Width2, Height2);
286 end;
288 function c(X1, Y1, Width1, Height1, X2, Y2, Width2, Height2: Integer): Boolean;
289 begin
290 Result := not (((Y1 + Height1 <= Y2) or
291 (Y1 >= Y2 + Height2)) or
292 ((X1 + Width1 <= X2) or
293 (X1 >= X2 + Width2)));
294 end;
296 function g_Collide2(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer): Boolean;
297 begin
298 //Result := not (((Y2 <= Y3) or (Y1 >= Y4)) or ((X2 <= X3) or (X1 >= X4)));
299 Result := c(X1, Y1, X2-X1, Y2-Y1, X3, Y3, X4-X3, Y4-Y3);
300 end;
302 function g_CollidePoint(X, Y, X2, Y2: Integer; Width, Height: Word): Boolean;
303 begin
304 X := X-X2;
305 Y := Y-Y2;
306 Result := (x >= 0) and (x <= Width) and
307 (y >= 0) and (y <= Height);
308 end;
310 procedure IncMax(var A: Integer; B, Max: Integer);
311 begin
312 if A+B > Max then A := Max else A := A+B;
313 end;
315 procedure IncMax(var A: Single; B, Max: Single);
316 begin
317 if A+B > Max then A := Max else A := A+B;
318 end;
320 procedure DecMin(var A: Integer; B, Min: Integer);
321 begin
322 if A-B < Min then A := Min else A := A-B;
323 end;
325 procedure DecMin(var A: Word; B, Min: Word);
326 begin
327 if A-B < Min then A := Min else A := A-B;
328 end;
330 procedure DecMin(var A: Single; B, Min: Single);
331 begin
332 if A-B < Min then A := Min else A := A-B;
333 end;
335 procedure IncMax(var A: Integer; Max: Integer);
336 begin
337 if A+1 > Max then A := Max else A := A+1;
338 end;
340 procedure IncMax(var A: Single; Max: Single);
341 begin
342 if A+1 > Max then A := Max else A := A+1;
343 end;
345 procedure IncMax(var A: Word; B, Max: Word);
346 begin
347 if A+B > Max then A := Max else A := A+B;
348 end;
350 procedure IncMax(var A: Word; Max: Word);
351 begin
352 if A+1 > Max then A := Max else A := A+1;
353 end;
355 procedure IncMax(var A: SmallInt; B, Max: SmallInt);
356 begin
357 if A+B > Max then A := Max else A := A+B;
358 end;
360 procedure IncMax(var A: SmallInt; Max: SmallInt);
361 begin
362 if A+1 > Max then A := Max else A := A+1;
363 end;
365 procedure DecMin(var A: Integer; Min: Integer);
366 begin
367 if A-1 < Min then A := Min else A := A-1;
368 end;
370 procedure DecMin(var A: Single; Min: Single);
371 begin
372 if A-1 < Min then A := Min else A := A-1;
373 end;
375 procedure DecMin(var A: Word; Min: Word);
376 begin
377 if A-1 < Min then A := Min else A := A-1;
378 end;
380 procedure DecMin(var A: Byte; B, Min: Byte);
381 begin
382 if A-B < Min then A := Min else A := A-B;
383 end;
385 procedure DecMin(var A: Byte; Min: Byte); overload;
386 begin
387 if A-1 < Min then A := Min else A := A-1;
388 end;
390 function Sign(A: Integer): ShortInt;
391 begin
392 if A < 0 then Result := -1
393 else if A > 0 then Result := 1
394 else Result := 0;
395 end;
397 function Sign(A: Single): ShortInt;
398 const
399 Eps = 1.0E-5;
400 begin
401 if Abs(A) < Eps then Result := 0
402 else if A < 0 then Result := -1
403 else Result := 1;
404 end;
406 function PointToRect(X, Y, X1, Y1: Integer; Width, Height: Word): Integer;
407 begin
408 X := X-X1; // A(0;0) --- B(W;0)
409 Y := Y-Y1; // | |
410 // D(0;H) --- C(W;H)
411 if X < 0 then
412 begin // Ñëåâà
413 if Y < 0 then // Ñëåâà ñâåðõó: ðàññòîÿíèå äî A
414 Result := Round(Hypot(X, Y))
415 else
416 if Y > Height then // Ñëåâà ñíèçó: ðàññòîÿíèå äî D
417 Result := Round(Hypot(X, Y-Height))
418 else // Ñëåâà ïîñåðåäèíå: ðàññòîÿíèå äî AD
419 Result := -X;
420 end
421 else
422 if X > Width then
423 begin // Ñïðàâà
424 X := X-Width;
425 if y < 0 then // Ñïðàâà ñâåðõó: ðàññòîÿíèå äî B
426 Result := Round(Hypot(X, Y))
427 else
428 if Y > Height then // Ñïðàâà ñíèçó: ðàññòîÿíèå äî C
429 Result := Round(Hypot(X, Y-Height))
430 else // Ñïðàâà ïîñåðåäèíå: ðàññòîÿíèå äî BC
431 Result := X;
432 end
433 else // Ïîñåðåäèíå
434 begin
435 if Y < 0 then // Ïîñåðåäèíå ñâåðõó: ðàññòîÿíèå äî AB
436 Result := -Y
437 else
438 if Y > Height then // Ïîñåðåäèíå ñíèçó: ðàññòîÿíèå äî DC
439 Result := Y-Height
440 else // Âíóòðè ïðÿìîóãîëüíèêà: ðàññòîÿíèå 0
441 Result := 0;
442 end;
443 end;
445 function g_GetAcidHit(X, Y: Integer; Width, Height: Word): Byte;
446 const
447 tab: array[0..3] of Byte = (0, 5, 10, 20);
448 var
449 a: Byte;
450 begin
451 a := 0;
453 if g_Map_CollidePanel(X, Y, Width, Height, PANEL_ACID1, False) then a := a or 1;
454 if g_Map_CollidePanel(X, Y, Width, Height, PANEL_ACID2, False) then a := a or 2;
456 Result := tab[a];
457 end;
459 function g_Look(a, b: PObj; d: TDirection): Boolean;
460 begin
461 if ((b^.X > a^.X) and (d = D_LEFT)) or
462 ((b^.X < a^.X) and (d = D_RIGHT)) then
463 begin
464 Result := False;
465 Exit;
466 end;
468 Result := g_TraceVector(a^.X+a^.Rect.X+(a^.Rect.Width div 2),
469 a^.Y+a^.Rect.Y+(a^.Rect.Height div 2),
470 b^.X+b^.Rect.X+(b^.Rect.Width div 2),
471 b^.Y+b^.Rect.Y+(b^.Rect.Height div 2));
472 end;
474 function GetAngle(baseX, baseY, pointX, PointY: Integer): SmallInt;
475 var
476 c: Single;
477 a, b: Integer;
478 begin
479 a := abs(pointX-baseX);
480 b := abs(pointY-baseY);
482 if a = 0 then c := 90
483 else c := RadToDeg(ArcTan(b/a));
485 if pointY < baseY then c := -c;
486 if pointX > baseX then c := 180-c;
488 Result := Round(c);
489 end;
491 function GetAngle2(vx, vy: Integer): SmallInt;
492 var
493 c: Single;
494 a, b: Integer;
495 begin
496 a := abs(vx);
497 b := abs(vy);
499 if a = 0 then
500 c := 0
501 else
502 c := RadToDeg(ArcTan(b/a));
504 if vy < 0 then
505 c := -c;
506 if vx > 0 then
507 c := 180 - c;
509 c := c + 180;
511 Result := Round(c);
512 end;
514 {function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
515 const
516 table: array[0..8, 0..8] of Byte =
517 ((0, 0, 3, 3, 1, 2, 2, 0, 1),
518 (0, 0, 0, 0, 4, 7, 2, 0, 1),
519 (3, 0, 0, 0, 4, 4, 1, 3, 1),
520 (3, 0, 0, 0, 0, 0, 5, 6, 1),
521 (1, 4, 4, 0, 0, 0, 5, 5, 1),
522 (2, 7, 4, 0, 0, 0, 0, 0, 1),
523 (2, 2, 1, 5, 5, 0, 0, 0, 1),
524 (0, 0, 3, 6, 5, 0, 0, 0, 1),
525 (1, 1, 1, 1, 1, 1, 1, 1, 1));
527 function GetClass(x, y: Integer): Byte;
528 begin
529 if y < rY then
530 begin
531 if x < rX then Result := 7
532 else if x < rX+rWidth then Result := 0
533 else Result := 1;
534 end
535 else if y < rY+rHeight then
536 begin
537 if x < rX then Result := 6
538 else if x < rX+rWidth then Result := 8
539 else Result := 2;
540 end
541 else
542 begin
543 if x < rX then Result := 5
544 else if x < rX+rWidth then Result := 4
545 else Result := 3;
546 end;
547 end;
549 begin
550 case table[GetClass(x1, y1), GetClass(x2, y2)] of
551 0: Result := False;
552 1: Result := True;
553 2: Result := Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1));
554 3: Result := Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1));
555 4: Result := Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1));
556 5: Result := Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1));
557 6: Result := (Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1))) and
558 (Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1)));
559 7: Result := (Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1))) and
560 (Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1)));
561 else Result := False;
562 end;
563 end;}
565 function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
566 var
567 i: Integer;
568 dx, dy: Integer;
569 Xerr, Yerr: Integer;
570 incX, incY: Integer;
571 x, y, d: Integer;
572 begin
573 Result := True;
575 Xerr := 0;
576 Yerr := 0;
577 dx := X2-X1;
578 dy := Y2-Y1;
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;
583 dx := abs(dx);
584 dy := abs(dy);
586 if dx > dy then d := dx else d := dy;
588 x := X1;
589 y := Y1;
591 for i := 1 to d+1 do
592 begin
593 Inc(Xerr, dx);
594 Inc(Yerr, dy);
595 if Xerr > d then
596 begin
597 Dec(Xerr, d);
598 Inc(x, incX);
599 end;
600 if Yerr > d then
601 begin
602 Dec(Yerr, d);
603 Inc(y, incY);
604 end;
606 if (x >= rX) and (x <= (rX + rWidth - 1)) and
607 (y >= rY) and (y <= (rY + rHeight - 1)) then Exit;
608 end;
610 Result := False;
611 end;
613 function GetStr(var Str: string): string;
614 var
615 a: Integer;
616 begin
617 Result := '';
618 for a := 1 to Length(Str) do
619 if (a = Length(Str)) or (Str[a+1] = ' ') then
620 begin
621 Result := Copy(Str, 1, a);
622 Delete(Str, 1, a+1);
623 Str := Trim(Str);
624 Exit;
625 end;
626 end;
628 {function GetLines(Text: string; MaxChars: Word): SArray;
629 var
630 a: Integer;
631 b: array of string;
632 str: string;
633 begin
634 Text := Trim(Text);
636 while Pos(' ', Text) <> 0 do Text := AnsiReplaceStr(Text, ' ', ' ');
638 while Text <> '' do
639 begin
640 SetLength(b, Length(b)+1);
641 b[High(b)] := GetStr(Text);
642 end;
644 a := 0;
645 while True do
646 begin
647 if a > High(b) then Break;
649 str := b[a];
650 a := a+1;
652 if Length(str) >= MaxChars then
653 begin
654 while str <> '' do
655 begin
656 SetLength(Result, Length(Result)+1);
657 Result[High(Result)] := Copy(str, 1, MaxChars);
658 Delete(str, 1, MaxChars);
659 end;
661 Continue;
662 end;
664 while (a <= High(b)) and (Length(str+' '+b[a]) <= MaxChars) do
665 begin
666 str := str+' '+b[a];
667 a := a+1;
668 end;
670 SetLength(Result, Length(Result)+1);
671 Result[High(Result)] := str;
672 end;
673 end;}
675 function GetLines(Text: string; FontID: DWORD; MaxWidth: Word): SArray;
677 function TextLen(Text: string): Word;
678 var
679 h: Word;
680 begin
681 e_CharFont_GetSize(FontID, Text, Result, h);
682 end;
684 var
685 a, c: Integer;
686 b: array of string;
687 str: string;
688 begin
689 SetLength(Result, 0);
690 SetLength(b, 0);
692 Text := Trim(Text);
694 // Óäàëÿåì ìíîæåñòâåííûå ïðîáåëû:
695 while Pos(' ', Text) <> 0 do
696 Text := AnsiReplaceStr(Text, ' ', ' ');
698 while Text <> '' do
699 begin
700 SetLength(b, Length(b)+1);
701 b[High(b)] := GetStr(Text);
702 end;
704 a := 0;
705 while True do
706 begin
707 if a > High(b) then
708 Break;
710 str := b[a];
711 a := a+1;
713 if TextLen(str) > MaxWidth then
714 begin // Òåêóùàÿ ñòðîêà ñëèøêîì äëèííàÿ => ðàçáèâàåì
715 while str <> '' do
716 begin
717 SetLength(Result, Length(Result)+1);
719 c := 0;
720 while (c < Length(str)) and
721 (TextLen(Copy(str, 1, c+1)) < MaxWidth) do
722 c := c+1;
724 Result[High(Result)] := Copy(str, 1, c);
725 Delete(str, 1, c);
726 end;
727 end
728 else // Ñòðîêà íîðìàëüíîé äëèíû => ñîåäèíÿåì ñî ñëåäóþùèìè
729 begin
730 while (a <= High(b)) and
731 (TextLen(str+' '+b[a]) < MaxWidth) do
732 begin
733 str := str+' '+b[a];
734 a := a + 1;
735 end;
737 SetLength(Result, Length(Result)+1);
738 Result[High(Result)] := str;
739 end;
740 end;
741 end;
743 procedure Sort(var a: SArray);
744 var
745 i, j: Integer;
746 s: string;
747 begin
748 if a = nil then Exit;
750 for i := High(a) downto Low(a) do
751 for j := Low(a) to High(a)-1 do
752 if LowerCase(a[j]) > LowerCase(a[j+1]) then
753 begin
754 s := a[j];
755 a[j] := a[j+1];
756 a[j+1] := s;
757 end;
758 end;
760 function Sscanf(const s: String; const fmt: String;
761 const Pointers: array of Pointer): Integer;
762 var
763 i, j, n, m: Integer;
764 s1: ShortString;
765 L: LongInt;
766 X: Extended;
768 function GetInt(): Integer;
769 begin
770 s1 := '';
771 while (n <= Length(s)) and (s[n] = ' ') do
772 Inc(n);
774 while (n <= Length(s)) and (s[n] in ['0'..'9', '+', '-']) do
775 begin
776 s1 := s1 + s[n];
777 Inc(n);
778 end;
780 Result := Length(s1);
781 end;
783 function GetFloat(): Integer;
784 begin
785 s1 := '';
786 while (n <= Length(s)) and (s[n] = ' ') do
787 Inc(n);
789 while (n <= Length(s)) and //jd >= rather than >
790 (s[n] in ['0'..'9', '+', '-', '.', 'e', 'E']) do
791 begin
792 s1 := s1 + s[n];
793 Inc(n);
794 end;
796 Result := Length(s1);
797 end;
799 function GetString(): Integer;
800 begin
801 s1 := '';
802 while (n <= Length(s)) and (s[n] = ' ') do
803 Inc(n);
805 while (n <= Length(s)) and (s[n] <> ' ') do
806 begin
807 s1 := s1 + s[n];
808 Inc(n);
809 end;
811 Result := Length(s1);
812 end;
814 function ScanStr(c: Char): Boolean;
815 begin
816 while (n <= Length(s)) and (s[n] <> c) do
817 Inc(n);
818 Inc(n);
820 Result := (n <= Length(s));
821 end;
823 function GetFmt(): Integer;
824 begin
825 Result := -1;
827 while (True) do
828 begin
829 while (fmt[m] = ' ') and (m < Length(fmt)) do
830 Inc(m);
831 if (m >= Length(fmt)) then
832 Break;
834 if (fmt[m] = '%') then
835 begin
836 Inc(m);
837 case fmt[m] of
838 'd': Result := vtInteger;
839 'f': Result := vtExtended;
840 's': Result := vtString;
841 end;
842 Inc(m);
843 Break;
844 end;
846 if (not ScanStr(fmt[m])) then
847 Break;
848 Inc(m);
849 end;
850 end;
852 begin
853 n := 1;
854 m := 1;
855 Result := 0;
856 s1 := '';
858 for i := 0 to High(Pointers) do
859 begin
860 j := GetFmt();
862 case j of
863 vtInteger :
864 begin
865 if GetInt() > 0 then
866 begin
867 L := StrToIntDef(s1, 0);
868 Move(L, Pointers[i]^, SizeOf(LongInt));
869 Inc(Result);
870 end
871 else
872 Break;
873 end;
875 vtExtended :
876 begin
877 if GetFloat() > 0 then
878 begin
879 X := StrToFloatDef(s1, 0.0);
880 Move(X, Pointers[i]^, SizeOf(Extended));
881 Inc(Result);
882 end
883 else
884 Break;
885 end;
887 vtString :
888 begin
889 if GetString() > 0 then
890 begin
891 Move(s1, Pointers[i]^, Length(s1)+1);
892 Inc(Result);
893 end
894 else
895 Break;
896 end;
898 else {case}
899 Break;
900 end; {case}
901 end;
902 end;
904 function InDWArray(a: DWORD; arr: DWArray): Boolean;
905 var
906 b: Integer;
907 begin
908 Result := False;
910 if arr = nil then Exit;
912 for b := 0 to High(arr) do
913 if arr[b] = a then
914 begin
915 Result := True;
916 Exit;
917 end;
918 end;
920 function InWArray(a: Word; arr: WArray): Boolean;
921 var
922 b: Integer;
923 begin
924 Result := False;
926 if arr = nil then Exit;
928 for b := 0 to High(arr) do
929 if arr[b] = a then
930 begin
931 Result := True;
932 Exit;
933 end;
934 end;
936 function InSArray(a: string; arr: SArray): Boolean;
937 var
938 b: Integer;
939 begin
940 Result := False;
942 if arr = nil then Exit;
944 a := AnsiLowerCase(a);
946 for b := 0 to High(arr) do
947 if AnsiLowerCase(arr[b]) = a then
948 begin
949 Result := True;
950 Exit;
951 end;
952 end;
954 function GetPos(UID: Word; o: PObj): Boolean;
955 var
956 p: TPlayer;
957 m: TMonster;
958 begin
959 Result := False;
961 case g_GetUIDType(UID) of
962 UID_PLAYER:
963 begin
964 p := g_Player_Get(UID);
965 if p = nil then Exit;
966 if not p.Live then Exit;
968 o^ := p.Obj;
969 end;
971 UID_MONSTER:
972 begin
973 m := g_Monsters_Get(UID);
974 if m = nil then Exit;
975 if not m.Live then Exit;
977 o^ := m.Obj;
978 end;
979 else Exit;
980 end;
982 Result := True;
983 end;
985 function parse(s: String): SArray;
986 var
987 a: Integer;
988 begin
989 Result := nil;
990 if s = '' then
991 Exit;
993 while s <> '' do
994 begin
995 for a := 1 to Length(s) do
996 if (s[a] = ',') or (a = Length(s)) then
997 begin
998 SetLength(Result, Length(Result)+1);
1000 if s[a] = ',' then
1001 Result[High(Result)] := Copy(s, 1, a-1)
1002 else // Êîíåö ñòðîêè
1003 Result[High(Result)] := s;
1005 Delete(s, 1, a);
1006 Break;
1007 end;
1008 end;
1009 end;
1011 function parse2(s: string; delim: Char): SArray;
1012 var
1013 a: Integer;
1014 begin
1015 Result := nil;
1016 if s = '' then Exit;
1018 while s <> '' do
1019 begin
1020 for a := 1 to Length(s) do
1021 if (s[a] = delim) or (a = Length(s)) then
1022 begin
1023 SetLength(Result, Length(Result)+1);
1025 if s[a] = delim then Result[High(Result)] := Copy(s, 1, a-1)
1026 else Result[High(Result)] := s;
1028 Delete(s, 1, a);
1029 Break;
1030 end;
1031 end;
1032 end;
1034 function g_GetFileTime(fileName: String): Integer;
1035 var
1036 F: File;
1037 begin
1038 if not FileExists(fileName) then
1039 begin
1040 Result := -1;
1041 Exit;
1042 end;
1044 AssignFile(F, fileName);
1045 Reset(F);
1046 Result := FileGetDate(TFileRec(F).Handle);
1047 CloseFile(F);
1048 end;
1050 function g_SetFileTime(fileName: String; time: Integer): Boolean;
1051 var
1052 F: File;
1053 begin
1054 if (not FileExists(fileName)) or (time < 0) then
1055 begin
1056 Result := False;
1057 Exit;
1058 end;
1060 AssignFile(F, fileName);
1061 Reset(F);
1062 Result := (FileSetDate(TFileRec(F).Handle, time) = 0);
1063 CloseFile(F);
1064 end;
1066 procedure SortSArray(var S: SArray);
1067 var
1068 b: Boolean;
1069 i: Integer;
1070 sw: ShortString;
1071 begin
1072 repeat
1073 b := False;
1074 for i := Low(S) to High(S) - 1 do
1075 if S[i] > S[i + 1] then begin
1076 sw := S[i];
1077 S[i] := S[i + 1];
1078 S[i + 1] := sw;
1079 b := True;
1080 end;
1081 until not b;
1082 end;
1084 function b_Text_Format(S: string): string;
1085 var
1086 Spec, Rst: Boolean;
1087 I: Integer;
1088 begin
1089 Result := '';
1090 Spec := False;
1091 Rst := False;
1092 for I := 1 to Length(S) do
1093 begin
1094 if (not Spec) and (S[I] = '\') and (I + 1 <= Length(S)) then
1095 begin
1096 Spec := True;
1097 Rst := True;
1098 continue;
1099 end;
1100 if Spec then
1101 begin
1102 case S[I] of
1103 'n': // line feed
1104 Result := Result + #10;
1105 '0': // black
1106 Result := Result + #1;
1107 '1': // white
1108 Result := Result + #2;
1109 'd': // darker
1110 Result := Result + #3;
1111 'l': // lighter
1112 Result := Result + #4;
1113 'r': // red
1114 Result := Result + #18;
1115 'g': // green
1116 Result := Result + #19;
1117 'b': // blue
1118 Result := Result + #20;
1119 'y': // yellow
1120 Result := Result + #21;
1121 '\': // escape
1122 Result := Result + '\';
1123 else
1124 Result := Result + '\' + S[I];
1125 end;
1126 Spec := False;
1127 end else
1128 Result := Result + S[I];
1129 end;
1130 // reset to white at end
1131 if Rst then Result := Result + #2;
1132 end;
1134 function b_Text_Unformat(S: string): string;
1135 var
1136 Spec: Boolean;
1137 I: Integer;
1138 begin
1139 Result := '';
1140 Spec := False;
1141 for I := 1 to Length(S) do
1142 begin
1143 if S[I] in [#1, #2, #3, #4, #10, #18, #19, #20, #21] then
1144 begin
1145 Spec := False;
1146 continue;
1147 end;
1148 if (not Spec) and (S[I] = '\') and (I + 1 <= Length(S)) then
1149 begin
1150 Spec := True;
1151 continue;
1152 end;
1153 if Spec then
1154 begin
1155 case S[I] of
1156 'n': ;
1157 '0': ;
1158 '1': ;
1159 'd': ;
1160 'l': ;
1161 'r': ;
1162 'g': ;
1163 'b': ;
1164 'y': ;
1165 '\': Result := Result + '\';
1166 else
1167 Result := Result + '\' + S[I];
1168 end;
1169 Spec := False;
1170 end else
1171 Result := Result + S[I];
1172 end;
1173 end;
1175 end.