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 {
563 var
564 i: Integer;
565 dx, dy: Integer;
566 Xerr, Yerr: Integer;
567 incX, incY: Integer;
568 x, y, d: Integer;
569 }
570 begin
572 {
573 Result := True;
575 Xerr := 0;
576 Yerr := 0;
577 dx := X2-X1;
578 dy := Y2-Y1;
580 if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0;
581 if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0;
583 dx := abs(dx);
584 dy := abs(dy);
586 if dx > dy then d := dx else d := dy;
588 x := X1;
589 y := Y1;
591 for i := 1 to d+1 do
592 begin
593 Inc(Xerr, dx);
594 Inc(Yerr, dy);
595 if Xerr > d then
596 begin
597 Dec(Xerr, d);
598 Inc(x, incX);
599 end;
600 if Yerr > d then
601 begin
602 Dec(Yerr, d);
603 Inc(y, incY);
604 end;
606 if (x >= rX) and (x <= (rX + rWidth - 1)) and
607 (y >= rY) and (y <= (rY + rHeight - 1)) then Exit;
608 end;
610 Result := False;
611 }
615 var
617 begin
621 begin
625 Exit;
629 {function GetLines(Text: string; MaxChars: Word): SSArray;
630 var
631 a: Integer;
632 b: array of string;
633 str: string;
634 begin
635 Text := Trim(Text);
637 while Pos(' ', Text) <> 0 do Text := AnsiReplaceStr(Text, ' ', ' ');
639 while Text <> '' do
640 begin
641 SetLength(b, Length(b)+1);
642 b[High(b)] := GetStr(Text);
643 end;
645 a := 0;
646 while True do
647 begin
648 if a > High(b) then Break;
650 str := b[a];
651 a := a+1;
653 if Length(str) >= MaxChars then
654 begin
655 while str <> '' do
656 begin
657 SetLength(Result, Length(Result)+1);
658 Result[High(Result)] := Copy(str, 1, MaxChars);
659 Delete(str, 1, MaxChars);
660 end;
662 Continue;
663 end;
665 while (a <= High(b)) and (Length(str+' '+b[a]) <= MaxChars) do
666 begin
667 str := str+' '+b[a];
668 a := a+1;
669 end;
671 SetLength(Result, Length(Result)+1);
672 Result[High(Result)] := str;
673 end;
674 end;}
679 var
681 begin
685 var
689 begin
695 // Óäàëÿåì ìíîæåñòâåííûå ïðîáåëû:
700 begin
707 begin
709 Break;
717 begin
728 end
730 begin
733 begin
745 var
748 begin
754 begin
763 var
770 begin
776 begin
785 begin
792 begin
801 begin
807 begin
816 begin
825 begin
829 begin
833 Break;
836 begin
844 Break;
848 Break;
853 begin
860 begin
864 vtInteger :
865 begin
867 begin
871 end
872 else
873 Break;
876 vtExtended :
877 begin
879 begin
883 end
884 else
885 Break;
888 vtString :
889 begin
891 begin
894 end
895 else
896 Break;
900 Break;
906 var
908 begin
915 begin
917 Exit;
922 var
924 begin
931 begin
933 Exit;
938 var
940 begin
949 begin
951 Exit;
956 var
959 begin
963 UID_PLAYER:
964 begin
972 UID_MONSTER:
973 begin
987 var
989 begin
992 Exit;
995 begin
998 begin
1007 Break;
1013 var
1015 begin
1020 begin
1023 begin
1030 Break;
1036 var
1038 begin
1040 begin
1042 Exit;
1052 var
1054 begin
1056 begin
1058 Exit;
1068 var
1072 begin
1073 repeat
1086 var
1089 begin
1094 begin
1096 begin
1099 continue;
1102 begin
1124 else
1128 end else
1131 // reset to white at end
1136 var
1139 begin
1143 begin
1145 begin
1147 continue;
1150 begin
1152 continue;
1155 begin
1167 else
1171 end else