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
36 type
95 var
98 implementation
100 uses
105 begin
110 begin
111 result := g_Map_CollidePanel(X, Y, Width, Height, (PANEL_WALL or PANEL_CLOSEDOOR or PANEL_OPENDOOR), false);
113 (*
114 var
115 a: Integer;
116 begin
117 Result := False;
119 if gWalls = nil then
120 Exit;
122 for a := 0 to High(gWalls) do
123 if gWalls[a].Enabled and
124 not ( ((Y + Height <= gWalls[a].Y) or
125 (Y >= gWalls[a].Y + gWalls[a].Height)) or
126 ((X + Width <= gWalls[a].X) or
127 (X >= gWalls[a].X + gWalls[a].Width)) ) then
128 begin
129 Result := True;
130 Exit;
131 end;
132 end;
133 *)
136 var
138 begin
146 begin
148 Exit;
154 var
157 (*
158 i: Integer;
159 dx, dy: Integer;
160 Xerr, Yerr, d: LongWord;
161 incX, incY: Integer;
162 x, y: Integer;
163 *)
164 begin
165 (*
166 result := False;
168 Assert(gCollideMap <> nil, 'g_TraceVector: gCollideMap = nil');
170 Xerr := 0;
171 Yerr := 0;
172 dx := X2-X1;
173 dy := Y2-Y1;
175 if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0;
176 if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0;
178 dx := abs(dx);
179 dy := abs(dy);
181 if dx > dy then d := dx else d := dy;
183 x := X1;
184 y := Y1;
186 for i := 1 to d do
187 begin
188 Inc(Xerr, dx);
189 Inc(Yerr, dy);
190 if Xerr>d then
191 begin
192 Dec(Xerr, d);
193 Inc(x, incX);
194 end;
195 if Yerr > d then
196 begin
197 Dec(Yerr, d);
198 Inc(y, incY);
199 end;
201 if (y > gMapInfo.Height-1) or
202 (y < 0) or (x > gMapInfo.Width-1) or (x < 0) then
203 Exit;
204 if ByteBool(gCollideMap[y, x] and MARK_BLOCKED) then
205 Exit;
206 end;
208 Result := True;
209 *)
211 // `true` if no obstacles
219 var
222 begin
226 UID_PLAYER:
227 begin
228 repeat
236 begin
238 Break;
243 UID_MONSTER:
244 begin
245 //FIXME!!!
247 begin
256 begin
258 Result := UID_GAME
259 else
261 Result := UID_PLAYER
262 else
268 begin
277 begin
286 begin
294 begin
295 //Result := not (((Y2 <= Y3) or (Y1 >= Y4)) or ((X2 <= X3) or (X1 >= X4)));
300 begin
308 begin
313 begin
318 begin
323 begin
328 begin
333 begin
338 begin
343 begin
348 begin
353 begin
358 begin
363 begin
368 begin
373 begin
378 begin
383 begin
388 begin
395 const
397 begin
404 begin
407 // D(0;H) --- C(W;H)
412 else
417 end
418 else
424 else
429 end
431 begin
433 Result := -Y
434 else
443 const
445 var
447 begin
457 begin
462 begin
464 Exit;
474 var
477 begin
491 var
494 begin
500 else
513 {function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
514 const
515 table: array[0..8, 0..8] of Byte =
516 ((0, 0, 3, 3, 1, 2, 2, 0, 1),
517 (0, 0, 0, 0, 4, 7, 2, 0, 1),
518 (3, 0, 0, 0, 4, 4, 1, 3, 1),
519 (3, 0, 0, 0, 0, 0, 5, 6, 1),
520 (1, 4, 4, 0, 0, 0, 5, 5, 1),
521 (2, 7, 4, 0, 0, 0, 0, 0, 1),
522 (2, 2, 1, 5, 5, 0, 0, 0, 1),
523 (0, 0, 3, 6, 5, 0, 0, 0, 1),
524 (1, 1, 1, 1, 1, 1, 1, 1, 1));
526 function GetClass(x, y: Integer): Byte;
527 begin
528 if y < rY then
529 begin
530 if x < rX then Result := 7
531 else if x < rX+rWidth then Result := 0
532 else Result := 1;
533 end
534 else if y < rY+rHeight then
535 begin
536 if x < rX then Result := 6
537 else if x < rX+rWidth then Result := 8
538 else Result := 2;
539 end
540 else
541 begin
542 if x < rX then Result := 5
543 else if x < rX+rWidth then Result := 4
544 else Result := 3;
545 end;
546 end;
548 begin
549 case table[GetClass(x1, y1), GetClass(x2, y2)] of
550 0: Result := False;
551 1: Result := True;
552 2: Result := Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1));
553 3: Result := Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1));
554 4: Result := Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1));
555 5: Result := Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1));
556 6: Result := (Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1))) and
557 (Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1)));
558 7: Result := (Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1))) and
559 (Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1)));
560 else Result := False;
561 end;
562 end;}
565 {
566 var
567 i: Integer;
568 dx, dy: Integer;
569 Xerr, Yerr: Integer;
570 incX, incY: Integer;
571 x, y, d: Integer;
572 }
573 begin
575 {
576 Result := True;
578 Xerr := 0;
579 Yerr := 0;
580 dx := X2-X1;
581 dy := Y2-Y1;
583 if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0;
584 if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0;
586 dx := abs(dx);
587 dy := abs(dy);
589 if dx > dy then d := dx else d := dy;
591 x := X1;
592 y := Y1;
594 for i := 1 to d+1 do
595 begin
596 Inc(Xerr, dx);
597 Inc(Yerr, dy);
598 if Xerr > d then
599 begin
600 Dec(Xerr, d);
601 Inc(x, incX);
602 end;
603 if Yerr > d then
604 begin
605 Dec(Yerr, d);
606 Inc(y, incY);
607 end;
609 if (x >= rX) and (x <= (rX + rWidth - 1)) and
610 (y >= rY) and (y <= (rY + rHeight - 1)) then Exit;
611 end;
613 Result := False;
614 }
618 var
620 begin
624 begin
628 Exit;
632 {function GetLines(Text: string; MaxChars: Word): SSArray;
633 var
634 a: Integer;
635 b: array of string;
636 str: string;
637 begin
638 Text := Trim(Text);
640 while Pos(' ', Text) <> 0 do Text := AnsiReplaceStr(Text, ' ', ' ');
642 while Text <> '' do
643 begin
644 SetLength(b, Length(b)+1);
645 b[High(b)] := GetStr(Text);
646 end;
648 a := 0;
649 while True do
650 begin
651 if a > High(b) then Break;
653 str := b[a];
654 a := a+1;
656 if Length(str) >= MaxChars then
657 begin
658 while str <> '' do
659 begin
660 SetLength(Result, Length(Result)+1);
661 Result[High(Result)] := Copy(str, 1, MaxChars);
662 Delete(str, 1, MaxChars);
663 end;
665 Continue;
666 end;
668 while (a <= High(b)) and (Length(str+' '+b[a]) <= MaxChars) do
669 begin
670 str := str+' '+b[a];
671 a := a+1;
672 end;
674 SetLength(Result, Length(Result)+1);
675 Result[High(Result)] := str;
676 end;
677 end;}
682 var
684 begin
688 var
692 begin
698 // Óäàëÿåì ìíîæåñòâåííûå ïðîáåëû:
703 begin
710 begin
712 Break;
720 begin
731 end
733 begin
736 begin
748 var
751 begin
757 begin
766 var
773 begin
779 begin
788 begin
795 begin
804 begin
810 begin
819 begin
828 begin
832 begin
836 Break;
839 begin
847 Break;
851 Break;
856 begin
863 begin
867 vtInteger :
868 begin
870 begin
874 end
875 else
876 Break;
879 vtExtended :
880 begin
882 begin
886 end
887 else
888 Break;
891 vtString :
892 begin
894 begin
897 end
898 else
899 Break;
903 Break;
909 var
911 begin
918 begin
920 Exit;
925 var
927 begin
934 begin
936 Exit;
941 var
943 begin
952 begin
954 Exit;
959 var
962 begin
966 UID_PLAYER:
967 begin
975 UID_MONSTER:
976 begin
990 var
992 begin
995 Exit;
998 begin
1001 begin
1010 Break;
1016 var
1018 begin
1023 begin
1026 begin
1033 Break;
1039 var
1041 begin
1043 begin
1045 Exit;
1055 var
1057 begin
1059 begin
1061 Exit;
1071 var
1075 begin
1076 repeat
1089 var
1092 begin
1097 begin
1099 begin
1102 continue;
1105 begin
1127 else
1131 end else
1134 // reset to white at end
1139 var
1142 begin
1146 begin
1148 begin
1150 continue;
1153 begin
1155 continue;
1158 begin
1170 else
1174 end else
1180 begin
1185 var
1187 begin