1 (* Copyright (C) Doom 2D: Forever Developers
2 *
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.
6 *
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.
11 *
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/>.
14 *)
15 {$INCLUDE ../shared/a_modes.inc}
18 interface
20 uses
23 const
35 type
94 var
97 implementation
99 uses
104 begin
109 begin
110 result := g_Map_CollidePanel(X, Y, Width, Height, (PANEL_WALL or PANEL_CLOSEDOOR or PANEL_OPENDOOR), false);
112 (*
113 var
114 a: Integer;
115 begin
116 Result := False;
118 if gWalls = nil then
119 Exit;
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
127 begin
128 Result := True;
129 Exit;
130 end;
131 end;
132 *)
135 var
137 begin
145 begin
147 Exit;
153 var
156 (*
157 i: Integer;
158 dx, dy: Integer;
159 Xerr, Yerr, d: LongWord;
160 incX, incY: Integer;
161 x, y: Integer;
162 *)
163 begin
164 (*
165 result := False;
167 Assert(gCollideMap <> nil, 'g_TraceVector: gCollideMap = nil');
169 Xerr := 0;
170 Yerr := 0;
171 dx := X2-X1;
172 dy := Y2-Y1;
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;
177 dx := abs(dx);
178 dy := abs(dy);
180 if dx > dy then d := dx else d := dy;
182 x := X1;
183 y := Y1;
185 for i := 1 to d do
186 begin
187 Inc(Xerr, dx);
188 Inc(Yerr, dy);
189 if Xerr>d then
190 begin
191 Dec(Xerr, d);
192 Inc(x, incX);
193 end;
194 if Yerr > d then
195 begin
196 Dec(Yerr, d);
197 Inc(y, incY);
198 end;
200 if (y > gMapInfo.Height-1) or
201 (y < 0) or (x > gMapInfo.Width-1) or (x < 0) then
202 Exit;
203 if ByteBool(gCollideMap[y, x] and MARK_BLOCKED) then
204 Exit;
205 end;
207 Result := True;
208 *)
210 // `true` if no obstacles
218 var
221 begin
225 UID_PLAYER:
226 begin
227 repeat
235 begin
237 Break;
242 UID_MONSTER:
243 begin
244 //FIXME!!!
246 begin
255 begin
257 Result := UID_GAME
258 else
260 Result := UID_PLAYER
261 else
267 begin
276 begin
285 begin
293 begin
294 //Result := not (((Y2 <= Y3) or (Y1 >= Y4)) or ((X2 <= X3) or (X1 >= X4)));
299 begin
307 begin
312 begin
317 begin
322 begin
327 begin
332 begin
337 begin
342 begin
347 begin
352 begin
357 begin
362 begin
367 begin
372 begin
377 begin
382 begin
387 begin
394 const
396 begin
403 begin
406 // D(0;H) --- C(W;H)
411 else
416 end
417 else
423 else
428 end
430 begin
432 Result := -Y
433 else
442 const
444 var
446 begin
456 begin
461 begin
463 Exit;
473 var
476 begin
490 var
493 begin
499 else
512 {function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
513 const
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;
526 begin
527 if y < rY then
528 begin
529 if x < rX then Result := 7
530 else if x < rX+rWidth then Result := 0
531 else Result := 1;
532 end
533 else if y < rY+rHeight then
534 begin
535 if x < rX then Result := 6
536 else if x < rX+rWidth then Result := 8
537 else Result := 2;
538 end
539 else
540 begin
541 if x < rX then Result := 5
542 else if x < rX+rWidth then Result := 4
543 else Result := 3;
544 end;
545 end;
547 begin
548 case table[GetClass(x1, y1), GetClass(x2, y2)] of
549 0: Result := False;
550 1: Result := True;
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;
560 end;
561 end;}
564 {
565 var
566 i: Integer;
567 dx, dy: Integer;
568 Xerr, Yerr: Integer;
569 incX, incY: Integer;
570 x, y, d: Integer;
571 }
572 begin
574 {
575 Result := True;
577 Xerr := 0;
578 Yerr := 0;
579 dx := X2-X1;
580 dy := Y2-Y1;
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;
585 dx := abs(dx);
586 dy := abs(dy);
588 if dx > dy then d := dx else d := dy;
590 x := X1;
591 y := Y1;
593 for i := 1 to d+1 do
594 begin
595 Inc(Xerr, dx);
596 Inc(Yerr, dy);
597 if Xerr > d then
598 begin
599 Dec(Xerr, d);
600 Inc(x, incX);
601 end;
602 if Yerr > d then
603 begin
604 Dec(Yerr, d);
605 Inc(y, incY);
606 end;
608 if (x >= rX) and (x <= (rX + rWidth - 1)) and
609 (y >= rY) and (y <= (rY + rHeight - 1)) then Exit;
610 end;
612 Result := False;
613 }
617 var
619 begin
623 begin
627 Exit;
631 {function GetLines(Text: string; MaxChars: Word): SSArray;
632 var
633 a: Integer;
634 b: array of string;
635 str: string;
636 begin
637 Text := Trim(Text);
639 while Pos(' ', Text) <> 0 do Text := AnsiReplaceStr(Text, ' ', ' ');
641 while Text <> '' do
642 begin
643 SetLength(b, Length(b)+1);
644 b[High(b)] := GetStr(Text);
645 end;
647 a := 0;
648 while True do
649 begin
650 if a > High(b) then Break;
652 str := b[a];
653 a := a+1;
655 if Length(str) >= MaxChars then
656 begin
657 while str <> '' do
658 begin
659 SetLength(Result, Length(Result)+1);
660 Result[High(Result)] := Copy(str, 1, MaxChars);
661 Delete(str, 1, MaxChars);
662 end;
664 Continue;
665 end;
667 while (a <= High(b)) and (Length(str+' '+b[a]) <= MaxChars) do
668 begin
669 str := str+' '+b[a];
670 a := a+1;
671 end;
673 SetLength(Result, Length(Result)+1);
674 Result[High(Result)] := str;
675 end;
676 end;}
681 var
683 begin
687 var
691 begin
692 {
693 SetLength(Result, 0);
694 SetLength(b, 0);
696 Text := Trim(Text);
698 // Óäàëÿåì ìíîæåñòâåííûå ïðîáåëû:
699 while Pos(' ', Text) <> 0 do
700 Text := AnsiReplaceStr(Text, ' ', ' ');
702 while Text <> '' do
703 begin
704 SetLength(b, Length(b)+1);
705 b[High(b)] := GetStr(Text);
706 end;
708 a := 0;
709 while True do
710 begin
711 if a > High(b) then
712 Break;
714 str := b[a];
715 a := a+1;
717 if TextLen(str) > MaxWidth then
718 begin // Òåêóùàÿ ñòðîêà ñëèøêîì äëèííàÿ => ðàçáèâàåì
719 while (str[0] <> #0) and (str <> '') do
720 begin
721 SetLength(Result, Length(Result)+1);
723 c := 0;
724 while (c < Length(str)) and
725 (TextLen(Copy(str, 1, c+1)) < MaxWidth) do
726 c := c+1;
728 Result[High(Result)] := Copy(str, 1, c);
729 Delete(str, 1, c);
730 end;
731 end
732 else // Ñòðîêà íîðìàëüíîé äëèíû => ñîåäèíÿåì ñî ñëåäóþùèìè
733 begin
734 while (a <= High(b)) and
735 (TextLen(str+' '+b[a]) < MaxWidth) do
736 begin
737 str := str+' '+b[a];
738 a := a + 1;
739 end;
741 SetLength(Result, Length(Result)+1);
742 Result[High(Result)] := str;
743 end;
744 end;
745 }
750 var
753 begin
759 begin
768 var
775 begin
781 begin
790 begin
797 begin
806 begin
812 begin
821 begin
830 begin
834 begin
838 Break;
841 begin
849 Break;
853 Break;
858 begin
865 begin
869 vtInteger :
870 begin
872 begin
876 end
877 else
878 Break;
881 vtExtended :
882 begin
884 begin
888 end
889 else
890 Break;
893 vtString :
894 begin
896 begin
899 end
900 else
901 Break;
905 Break;
911 var
913 begin
920 begin
922 Exit;
927 var
929 begin
936 begin
938 Exit;
943 var
945 begin
954 begin
956 Exit;
961 var
964 begin
968 UID_PLAYER:
969 begin
977 UID_MONSTER:
978 begin
992 var
994 begin
997 Exit;
1000 begin
1003 begin
1012 Break;
1018 var
1020 begin
1025 begin
1028 begin
1035 Break;
1041 var
1043 begin
1045 begin
1047 Exit;
1057 var
1059 begin
1061 begin
1063 Exit;
1073 var
1077 begin
1078 repeat
1091 var
1094 begin
1099 begin
1101 begin
1104 continue;
1107 begin
1129 else
1133 end else
1136 // reset to white at end
1141 var
1144 begin
1148 begin
1150 begin
1152 continue;
1155 begin
1157 continue;
1160 begin
1172 else
1176 end else
1182 begin
1187 var
1189 begin