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;
633 begin
637 begin
640 begin
643 begin
644 // alt: while (i >= j) and (Text[i] <> ' ') do Dec(i);
648 (* --- *)
652 (* --- *)
654 begin
667 var
670 begin
676 begin
685 var
692 begin
698 begin
707 begin
714 begin
723 begin
729 begin
738 begin
747 begin
751 begin
755 Break;
758 begin
766 Break;
770 Break;
775 begin
782 begin
786 vtInteger :
787 begin
789 begin
793 end
794 else
795 Break;
798 vtExtended :
799 begin
801 begin
805 end
806 else
807 Break;
810 vtString :
811 begin
813 begin
816 end
817 else
818 Break;
822 Break;
828 var
830 begin
837 begin
839 Exit;
844 var
846 begin
853 begin
855 Exit;
860 var
862 begin
871 begin
873 Exit;
878 var
881 begin
885 UID_PLAYER:
886 begin
894 UID_MONSTER:
895 begin
909 var
911 begin
914 Exit;
917 begin
920 begin
929 Break;
935 var
937 begin
942 begin
945 begin
952 Break;
958 var
960 begin
962 begin
964 Exit;
974 var
976 begin
978 begin
980 Exit;
990 var
994 begin
995 repeat
1008 var
1011 begin
1016 begin
1018 begin
1021 continue;
1024 begin
1046 else
1050 end else
1053 // reset to white at end
1058 var
1061 begin
1065 begin
1067 begin
1069 continue;
1072 begin
1074 continue;
1077 begin
1089 else
1093 end else
1099 begin
1104 var
1106 begin