1f3add5d538fe6837f5ca0d3a942207da171fcb2
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 *)
204 //result := false;
206 begin
207 // check distance
208 //result := ((wallHitX-x1)*(wallHitX-x1)+(wallHitY-y1)*(wallHitY-y1) > (x2-x1)*(x2-x1)+(y2-y1)*(y2-y1));
210 end
211 else
212 begin
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
460 begin
462 Exit;
472 var
475 begin
489 var
492 begin
498 else
511 {function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
512 const
513 table: array[0..8, 0..8] of Byte =
514 ((0, 0, 3, 3, 1, 2, 2, 0, 1),
515 (0, 0, 0, 0, 4, 7, 2, 0, 1),
516 (3, 0, 0, 0, 4, 4, 1, 3, 1),
517 (3, 0, 0, 0, 0, 0, 5, 6, 1),
518 (1, 4, 4, 0, 0, 0, 5, 5, 1),
519 (2, 7, 4, 0, 0, 0, 0, 0, 1),
520 (2, 2, 1, 5, 5, 0, 0, 0, 1),
521 (0, 0, 3, 6, 5, 0, 0, 0, 1),
522 (1, 1, 1, 1, 1, 1, 1, 1, 1));
524 function GetClass(x, y: Integer): Byte;
525 begin
526 if y < rY then
527 begin
528 if x < rX then Result := 7
529 else if x < rX+rWidth then Result := 0
530 else Result := 1;
531 end
532 else if y < rY+rHeight then
533 begin
534 if x < rX then Result := 6
535 else if x < rX+rWidth then Result := 8
536 else Result := 2;
537 end
538 else
539 begin
540 if x < rX then Result := 5
541 else if x < rX+rWidth then Result := 4
542 else Result := 3;
543 end;
544 end;
546 begin
547 case table[GetClass(x1, y1), GetClass(x2, y2)] of
548 0: Result := False;
549 1: Result := True;
550 2: Result := Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1));
551 3: Result := Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1));
552 4: Result := Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1));
553 5: Result := Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1));
554 6: Result := (Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1))) and
555 (Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1)));
556 7: Result := (Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1))) and
557 (Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1)));
558 else Result := False;
559 end;
560 end;}
563 var
569 begin
589 begin
593 begin
598 begin
611 var
613 begin
617 begin
621 Exit;
625 {function GetLines(Text: string; MaxChars: Word): SArray;
626 var
627 a: Integer;
628 b: array of string;
629 str: string;
630 begin
631 Text := Trim(Text);
633 while Pos(' ', Text) <> 0 do Text := AnsiReplaceStr(Text, ' ', ' ');
635 while Text <> '' do
636 begin
637 SetLength(b, Length(b)+1);
638 b[High(b)] := GetStr(Text);
639 end;
641 a := 0;
642 while True do
643 begin
644 if a > High(b) then Break;
646 str := b[a];
647 a := a+1;
649 if Length(str) >= MaxChars then
650 begin
651 while str <> '' do
652 begin
653 SetLength(Result, Length(Result)+1);
654 Result[High(Result)] := Copy(str, 1, MaxChars);
655 Delete(str, 1, MaxChars);
656 end;
658 Continue;
659 end;
661 while (a <= High(b)) and (Length(str+' '+b[a]) <= MaxChars) do
662 begin
663 str := str+' '+b[a];
664 a := a+1;
665 end;
667 SetLength(Result, Length(Result)+1);
668 Result[High(Result)] := str;
669 end;
670 end;}
675 var
677 begin
681 var
685 begin
691 // Óäàëÿåì ìíîæåñòâåííûå ïðîáåëû:
696 begin
703 begin
705 Break;
713 begin
724 end
726 begin
729 begin
741 var
744 begin
750 begin
759 var
766 begin
772 begin
781 begin
788 begin
797 begin
803 begin
812 begin
821 begin
825 begin
829 Break;
832 begin
840 Break;
844 Break;
849 begin
856 begin
860 vtInteger :
861 begin
863 begin
867 end
868 else
869 Break;
872 vtExtended :
873 begin
875 begin
879 end
880 else
881 Break;
884 vtString :
885 begin
887 begin
890 end
891 else
892 Break;
896 Break;
902 var
904 begin
911 begin
913 Exit;
918 var
920 begin
927 begin
929 Exit;
934 var
936 begin
945 begin
947 Exit;
952 var
955 begin
959 UID_PLAYER:
960 begin
968 UID_MONSTER:
969 begin
983 var
985 begin
988 Exit;
991 begin
994 begin
1003 Break;
1009 var
1011 begin
1016 begin
1019 begin
1026 Break;
1032 var
1034 begin
1036 begin
1038 Exit;
1048 var
1050 begin
1052 begin
1054 Exit;
1064 var
1068 begin
1069 repeat
1082 var
1085 begin
1090 begin
1092 begin
1095 continue;
1098 begin
1120 else
1124 end else
1127 // reset to white at end
1132 var
1135 begin
1139 begin
1141 begin
1143 continue;
1146 begin
1148 continue;
1151 begin
1163 else
1167 end else