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
95 var
98 implementation
100 uses
104 {$PUSH}
108 begin
115 else
120 begin
124 else
126 else
129 {$POP}
132 begin
137 begin
138 result := g_Map_CollidePanel(X, Y, Width, Height, (PANEL_WALL or PANEL_CLOSEDOOR or PANEL_OPENDOOR), false);
140 (*
141 var
142 a: Integer;
143 begin
144 Result := False;
146 if gWalls = nil then
147 Exit;
149 for a := 0 to High(gWalls) do
150 if gWalls[a].Enabled and
151 not ( ((Y + Height <= gWalls[a].Y) or
152 (Y >= gWalls[a].Y + gWalls[a].Height)) or
153 ((X + Width <= gWalls[a].X) or
154 (X >= gWalls[a].X + gWalls[a].Width)) ) then
155 begin
156 Result := True;
157 Exit;
158 end;
159 end;
160 *)
163 var
165 begin
173 begin
175 Exit;
181 var
184 (*
185 i: Integer;
186 dx, dy: Integer;
187 Xerr, Yerr, d: LongWord;
188 incX, incY: Integer;
189 x, y: Integer;
190 *)
191 begin
192 (*
193 result := False;
195 Assert(gCollideMap <> nil, 'g_TraceVector: gCollideMap = nil');
197 Xerr := 0;
198 Yerr := 0;
199 dx := X2-X1;
200 dy := Y2-Y1;
202 if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0;
203 if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0;
205 dx := abs(dx);
206 dy := abs(dy);
208 if dx > dy then d := dx else d := dy;
210 x := X1;
211 y := Y1;
213 for i := 1 to d do
214 begin
215 Inc(Xerr, dx);
216 Inc(Yerr, dy);
217 if Xerr>d then
218 begin
219 Dec(Xerr, d);
220 Inc(x, incX);
221 end;
222 if Yerr > d then
223 begin
224 Dec(Yerr, d);
225 Inc(y, incY);
226 end;
228 if (y > gMapInfo.Height-1) or
229 (y < 0) or (x > gMapInfo.Width-1) or (x < 0) then
230 Exit;
231 if ByteBool(gCollideMap[y, x] and MARK_BLOCKED) then
232 Exit;
233 end;
235 Result := True;
236 *)
238 // `true` if no obstacles
246 var
249 begin
253 UID_PLAYER:
254 begin
255 repeat
263 begin
265 Break;
270 UID_MONSTER:
271 begin
272 //FIXME!!!
274 begin
283 begin
285 Result := UID_GAME
286 else
288 Result := UID_PLAYER
289 else
295 begin
304 begin
313 begin
321 begin
322 //Result := not (((Y2 <= Y3) or (Y1 >= Y4)) or ((X2 <= X3) or (X1 >= X4)));
327 begin
335 begin
340 begin
345 begin
350 begin
355 begin
360 begin
365 begin
370 begin
375 begin
380 begin
385 begin
390 begin
395 begin
400 begin
405 begin
410 begin
415 begin
422 const
424 begin
431 begin
434 // D(0;H) --- C(W;H)
439 else
444 end
445 else
451 else
456 end
458 begin
460 Result := -Y
461 else
470 const
472 var
474 begin
484 begin
489 begin
491 Exit;
501 var
504 begin
518 var
521 begin
527 else
540 {function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
541 const
542 table: array[0..8, 0..8] of Byte =
543 ((0, 0, 3, 3, 1, 2, 2, 0, 1),
544 (0, 0, 0, 0, 4, 7, 2, 0, 1),
545 (3, 0, 0, 0, 4, 4, 1, 3, 1),
546 (3, 0, 0, 0, 0, 0, 5, 6, 1),
547 (1, 4, 4, 0, 0, 0, 5, 5, 1),
548 (2, 7, 4, 0, 0, 0, 0, 0, 1),
549 (2, 2, 1, 5, 5, 0, 0, 0, 1),
550 (0, 0, 3, 6, 5, 0, 0, 0, 1),
551 (1, 1, 1, 1, 1, 1, 1, 1, 1));
553 function GetClass(x, y: Integer): Byte;
554 begin
555 if y < rY then
556 begin
557 if x < rX then Result := 7
558 else if x < rX+rWidth then Result := 0
559 else Result := 1;
560 end
561 else if y < rY+rHeight then
562 begin
563 if x < rX then Result := 6
564 else if x < rX+rWidth then Result := 8
565 else Result := 2;
566 end
567 else
568 begin
569 if x < rX then Result := 5
570 else if x < rX+rWidth then Result := 4
571 else Result := 3;
572 end;
573 end;
575 begin
576 case table[GetClass(x1, y1), GetClass(x2, y2)] of
577 0: Result := False;
578 1: Result := True;
579 2: Result := Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1));
580 3: Result := Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1));
581 4: Result := Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1));
582 5: Result := Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1));
583 6: Result := (Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1))) and
584 (Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1)));
585 7: Result := (Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1))) and
586 (Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1)));
587 else Result := False;
588 end;
589 end;}
592 {
593 var
594 i: Integer;
595 dx, dy: Integer;
596 Xerr, Yerr: Integer;
597 incX, incY: Integer;
598 x, y, d: Integer;
599 }
600 begin
602 {
603 Result := True;
605 Xerr := 0;
606 Yerr := 0;
607 dx := X2-X1;
608 dy := Y2-Y1;
610 if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0;
611 if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0;
613 dx := abs(dx);
614 dy := abs(dy);
616 if dx > dy then d := dx else d := dy;
618 x := X1;
619 y := Y1;
621 for i := 1 to d+1 do
622 begin
623 Inc(Xerr, dx);
624 Inc(Yerr, dy);
625 if Xerr > d then
626 begin
627 Dec(Xerr, d);
628 Inc(x, incX);
629 end;
630 if Yerr > d then
631 begin
632 Dec(Yerr, d);
633 Inc(y, incY);
634 end;
636 if (x >= rX) and (x <= (rX + rWidth - 1)) and
637 (y >= rY) and (y <= (rY + rHeight - 1)) then Exit;
638 end;
640 Result := False;
641 }
645 var
647 begin
651 begin
655 Exit;
661 var
668 begin
674 begin
683 begin
690 begin
699 begin
705 begin
714 begin
723 begin
727 begin
731 Break;
734 begin
742 Break;
746 Break;
751 begin
758 begin
762 vtInteger :
763 begin
765 begin
769 end
770 else
771 Break;
774 vtExtended :
775 begin
777 begin
781 end
782 else
783 Break;
786 vtString :
787 begin
789 begin
792 end
793 else
794 Break;
798 Break;
804 var
806 begin
813 begin
815 Exit;
820 var
822 begin
829 begin
831 Exit;
836 var
838 begin
847 begin
849 Exit;
854 var
857 begin
861 UID_PLAYER:
862 begin
870 UID_MONSTER:
871 begin
885 var
887 begin
890 Exit;
893 begin
896 begin
905 Break;
911 var
913 begin
918 begin
921 begin
928 Break;
934 var
936 begin
938 begin
940 Exit;
950 var
952 begin
954 begin
956 Exit;
966 var
970 begin
971 repeat
984 var
987 begin
992 begin
994 begin
997 continue;
1000 begin
1022 else
1026 end else
1029 // reset to white at end
1034 var
1037 begin
1041 begin
1043 begin
1045 continue;
1048 begin
1050 continue;
1053 begin
1065 else
1069 end else
1075 begin
1080 var
1082 begin