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, either version 3 of the License, or
6 * (at your option) any later version.
7 *
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
12 *
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 *)
16 {$INCLUDE ../shared/a_modes.inc}
19 interface
21 uses
24 const
34 type
92 var
95 implementation
97 uses
102 begin
107 begin
108 result := g_Map_CollidePanel(X, Y, Width, Height, (PANEL_WALL or PANEL_CLOSEDOOR or PANEL_OPENDOOR), false);
110 (*
111 var
112 a: Integer;
113 begin
114 Result := False;
116 if gWalls = nil then
117 Exit;
119 for a := 0 to High(gWalls) do
120 if gWalls[a].Enabled and
121 not ( ((Y + Height <= gWalls[a].Y) or
122 (Y >= gWalls[a].Y + gWalls[a].Height)) or
123 ((X + Width <= gWalls[a].X) or
124 (X >= gWalls[a].X + gWalls[a].Width)) ) then
125 begin
126 Result := True;
127 Exit;
128 end;
129 end;
130 *)
133 var
135 begin
143 begin
145 Exit;
151 var
154 (*
155 i: Integer;
156 dx, dy: Integer;
157 Xerr, Yerr, d: LongWord;
158 incX, incY: Integer;
159 x, y: Integer;
160 *)
161 begin
162 (*
163 result := False;
165 Assert(gCollideMap <> nil, 'g_TraceVector: gCollideMap = nil');
167 Xerr := 0;
168 Yerr := 0;
169 dx := X2-X1;
170 dy := Y2-Y1;
172 if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0;
173 if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0;
175 dx := abs(dx);
176 dy := abs(dy);
178 if dx > dy then d := dx else d := dy;
180 x := X1;
181 y := Y1;
183 for i := 1 to d do
184 begin
185 Inc(Xerr, dx);
186 Inc(Yerr, dy);
187 if Xerr>d then
188 begin
189 Dec(Xerr, d);
190 Inc(x, incX);
191 end;
192 if Yerr > d then
193 begin
194 Dec(Yerr, d);
195 Inc(y, incY);
196 end;
198 if (y > gMapInfo.Height-1) or
199 (y < 0) or (x > gMapInfo.Width-1) or (x < 0) then
200 Exit;
201 if ByteBool(gCollideMap[y, x] and MARK_BLOCKED) then
202 Exit;
203 end;
205 Result := True;
206 *)
208 // `true` if no obstacles
216 var
219 begin
223 UID_PLAYER:
224 begin
225 repeat
233 begin
235 Break;
240 UID_MONSTER:
241 begin
242 //FIXME!!!
244 begin
253 begin
255 Result := UID_GAME
256 else
258 Result := UID_PLAYER
259 else
265 begin
274 begin
283 begin
291 begin
292 //Result := not (((Y2 <= Y3) or (Y1 >= Y4)) or ((X2 <= X3) or (X1 >= X4)));
297 begin
305 begin
310 begin
315 begin
320 begin
325 begin
330 begin
335 begin
340 begin
345 begin
350 begin
355 begin
360 begin
365 begin
370 begin
375 begin
380 begin
385 begin
392 const
394 begin
401 begin
404 // D(0;H) --- C(W;H)
409 else
414 end
415 else
421 else
426 end
428 begin
430 Result := -Y
431 else
440 const
442 var
444 begin
454 begin
459 begin
461 Exit;
471 var
474 begin
488 var
491 begin
497 else
510 {function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
511 const
512 table: array[0..8, 0..8] of Byte =
513 ((0, 0, 3, 3, 1, 2, 2, 0, 1),
514 (0, 0, 0, 0, 4, 7, 2, 0, 1),
515 (3, 0, 0, 0, 4, 4, 1, 3, 1),
516 (3, 0, 0, 0, 0, 0, 5, 6, 1),
517 (1, 4, 4, 0, 0, 0, 5, 5, 1),
518 (2, 7, 4, 0, 0, 0, 0, 0, 1),
519 (2, 2, 1, 5, 5, 0, 0, 0, 1),
520 (0, 0, 3, 6, 5, 0, 0, 0, 1),
521 (1, 1, 1, 1, 1, 1, 1, 1, 1));
523 function GetClass(x, y: Integer): Byte;
524 begin
525 if y < rY then
526 begin
527 if x < rX then Result := 7
528 else if x < rX+rWidth then Result := 0
529 else Result := 1;
530 end
531 else if y < rY+rHeight then
532 begin
533 if x < rX then Result := 6
534 else if x < rX+rWidth then Result := 8
535 else Result := 2;
536 end
537 else
538 begin
539 if x < rX then Result := 5
540 else if x < rX+rWidth then Result := 4
541 else Result := 3;
542 end;
543 end;
545 begin
546 case table[GetClass(x1, y1), GetClass(x2, y2)] of
547 0: Result := False;
548 1: Result := True;
549 2: Result := Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1));
550 3: Result := Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1));
551 4: Result := Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1));
552 5: Result := Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1));
553 6: Result := (Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1))) and
554 (Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1)));
555 7: Result := (Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1))) and
556 (Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1)));
557 else Result := False;
558 end;
559 end;}
562 var
568 begin
588 begin
592 begin
597 begin
610 var
612 begin
616 begin
620 Exit;
624 {function GetLines(Text: string; MaxChars: Word): SArray;
625 var
626 a: Integer;
627 b: array of string;
628 str: string;
629 begin
630 Text := Trim(Text);
632 while Pos(' ', Text) <> 0 do Text := AnsiReplaceStr(Text, ' ', ' ');
634 while Text <> '' do
635 begin
636 SetLength(b, Length(b)+1);
637 b[High(b)] := GetStr(Text);
638 end;
640 a := 0;
641 while True do
642 begin
643 if a > High(b) then Break;
645 str := b[a];
646 a := a+1;
648 if Length(str) >= MaxChars then
649 begin
650 while str <> '' do
651 begin
652 SetLength(Result, Length(Result)+1);
653 Result[High(Result)] := Copy(str, 1, MaxChars);
654 Delete(str, 1, MaxChars);
655 end;
657 Continue;
658 end;
660 while (a <= High(b)) and (Length(str+' '+b[a]) <= MaxChars) do
661 begin
662 str := str+' '+b[a];
663 a := a+1;
664 end;
666 SetLength(Result, Length(Result)+1);
667 Result[High(Result)] := str;
668 end;
669 end;}
674 var
676 begin
680 var
684 begin
690 // Óäàëÿåì ìíîæåñòâåííûå ïðîáåëû:
695 begin
702 begin
704 Break;
712 begin
723 end
725 begin
728 begin
740 var
743 begin
749 begin
758 var
765 begin
771 begin
780 begin
787 begin
796 begin
802 begin
811 begin
820 begin
824 begin
828 Break;
831 begin
839 Break;
843 Break;
848 begin
855 begin
859 vtInteger :
860 begin
862 begin
866 end
867 else
868 Break;
871 vtExtended :
872 begin
874 begin
878 end
879 else
880 Break;
883 vtString :
884 begin
886 begin
889 end
890 else
891 Break;
895 Break;
901 var
903 begin
910 begin
912 Exit;
917 var
919 begin
926 begin
928 Exit;
933 var
935 begin
944 begin
946 Exit;
951 var
954 begin
958 UID_PLAYER:
959 begin
967 UID_MONSTER:
968 begin
982 var
984 begin
987 Exit;
990 begin
993 begin
1002 Break;
1008 var
1010 begin
1015 begin
1018 begin
1025 Break;
1031 var
1033 begin
1035 begin
1037 Exit;
1047 var
1049 begin
1051 begin
1053 Exit;
1063 var
1067 begin
1068 repeat
1081 var
1084 begin
1089 begin
1091 begin
1094 continue;
1097 begin
1119 else
1123 end else
1126 // reset to white at end
1131 var
1134 begin
1138 begin
1140 begin
1142 continue;
1145 begin
1147 continue;
1150 begin
1162 else
1166 end else