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
91 implementation
93 uses
98 begin
103 begin
104 result := g_Map_CollidePanel(X, Y, Width, Height, (PANEL_WALL or PANEL_CLOSEDOOR or PANEL_OPENDOOR), false);
106 (*
107 var
108 a: Integer;
109 begin
110 Result := False;
112 if gWalls = nil then
113 Exit;
115 for a := 0 to High(gWalls) do
116 if gWalls[a].Enabled and
117 not ( ((Y + Height <= gWalls[a].Y) or
118 (Y >= gWalls[a].Y + gWalls[a].Height)) or
119 ((X + Width <= gWalls[a].X) or
120 (X >= gWalls[a].X + gWalls[a].Width)) ) then
121 begin
122 Result := True;
123 Exit;
124 end;
125 end;
126 *)
129 var
131 begin
139 begin
141 Exit;
147 var
150 (*
151 i: Integer;
152 dx, dy: Integer;
153 Xerr, Yerr, d: LongWord;
154 incX, incY: Integer;
155 x, y: Integer;
156 *)
157 begin
158 (*
159 result := False;
161 Assert(gCollideMap <> nil, 'g_TraceVector: gCollideMap = nil');
163 Xerr := 0;
164 Yerr := 0;
165 dx := X2-X1;
166 dy := Y2-Y1;
168 if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0;
169 if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0;
171 dx := abs(dx);
172 dy := abs(dy);
174 if dx > dy then d := dx else d := dy;
176 x := X1;
177 y := Y1;
179 for i := 1 to d do
180 begin
181 Inc(Xerr, dx);
182 Inc(Yerr, dy);
183 if Xerr>d then
184 begin
185 Dec(Xerr, d);
186 Inc(x, incX);
187 end;
188 if Yerr > d then
189 begin
190 Dec(Yerr, d);
191 Inc(y, incY);
192 end;
194 if (y > gMapInfo.Height-1) or
195 (y < 0) or (x > gMapInfo.Width-1) or (x < 0) then
196 Exit;
197 if ByteBool(gCollideMap[y, x] and MARK_BLOCKED) then
198 Exit;
199 end;
201 Result := True;
202 *)
205 begin
206 // check distance
207 //result := ((wallHitX-x1)*(wallHitX-x1)+(wallHitY-y1)*(wallHitY-y1) > (x2-x1)*(x2-x1)+(y2-y1)*(y2-y1));
209 end
210 else
211 begin
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
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