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
697 // Óäàëÿåì ìíîæåñòâåííûå ïðîáåëû:
702 begin
709 begin
711 Break;
719 begin
730 end
732 begin
735 begin
747 var
750 begin
756 begin
765 var
772 begin
778 begin
787 begin
794 begin
803 begin
809 begin
818 begin
827 begin
831 begin
835 Break;
838 begin
846 Break;
850 Break;
855 begin
862 begin
866 vtInteger :
867 begin
869 begin
873 end
874 else
875 Break;
878 vtExtended :
879 begin
881 begin
885 end
886 else
887 Break;
890 vtString :
891 begin
893 begin
896 end
897 else
898 Break;
902 Break;
908 var
910 begin
917 begin
919 Exit;
924 var
926 begin
933 begin
935 Exit;
940 var
942 begin
951 begin
953 Exit;
958 var
961 begin
965 UID_PLAYER:
966 begin
974 UID_MONSTER:
975 begin
989 var
991 begin
994 Exit;
997 begin
1000 begin
1009 Break;
1015 var
1017 begin
1022 begin
1025 begin
1032 Break;
1038 var
1040 begin
1042 begin
1044 Exit;
1054 var
1056 begin
1058 begin
1060 Exit;
1070 var
1074 begin
1075 repeat
1088 var
1091 begin
1096 begin
1098 begin
1101 continue;
1104 begin
1126 else
1130 end else
1133 // reset to white at end
1138 var
1141 begin
1145 begin
1147 begin
1149 continue;
1152 begin
1154 continue;
1157 begin
1169 else
1173 end else
1179 begin
1184 var
1186 begin