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, version 3 of the License ONLY.
6 *
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
11 *
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
14 *)
15 {$INCLUDE ../shared/a_modes.inc}
18 interface
20 uses
23 const
35 type
98 var
101 implementation
103 uses
107 {$PUSH}
111 begin
118 else
123 begin
127 else
129 else
132 {$POP}
136 begin
137 {$IF DEFINED(CPUX86_64) OR DEFINED(CPUAMD64) OR DEFINED(CPUX64)}
139 {$ELSEIF DEFINED(CPUI386) OR DEFINED(CPU386)}
141 {$ELSEIF DEFINED(CPUI8086)}
143 {$ELSEIF DEFINED(CPUI64)}
145 {$ELSEIF DEFINED(CPUARM)}
147 {$ELSEIF DEFINED(CPUAVR)}
149 {$ELSEIF DEFINED(CPUPOWERPC32)}
151 {$ELSEIF DEFINED(CPUPOWERPC64)}
153 {$ELSEIF DEFINED(CPUALPHA)}}
155 {$ELSEIF DEFINED(CPUSPARC32)}
157 {$ELSEIF DEFINED(CPUM68020)}
159 {$ELSEIF DEFINED(CPU68K) OR DEFINED(CPUM68K)}
161 {$ELSEIF DEFINED(CPUSPARC)}
163 {$ELSEIF DEFINED(CPUPOWERPC)}
165 {$ELSEIF DEFINED(CPU86) OR DEFINED(CPU87)}
167 {$ELSE}
169 {$ENDIF}
171 {$IF DEFINED(CPU64)}
173 {$ELSEIF DEFINED(CPU32)}
175 {$ELSEIF DEFINED(CPU16)}
177 {$ELSE}
179 {$ENDIF}
181 {$IF DEFINED(FPUSOFT)}
183 {$ELSEIF DEFINED(FPUSSE3)}
185 {$ELSEIF DEFINED(FPUSSE2)}
187 {$ELSEIF DEFINED(FPUSSE)}
189 {$ELSEIF DEFINED(FPUSSE64)}
191 {$ELSEIF DEFINED(FPULIBGCC)}
193 {$ELSEIF DEFINED(FPU68881)}
195 {$ELSEIF DEFINED(FPUVFP)}
197 {$ELSEIF DEFINED(FPUFPA11)}
199 {$ELSEIF DEFINED(FPUFPA10)}
201 {$ELSEIF DEFINED(FPUFPA)}
203 {$ELSEIF DEFINED(FPUX87)}
205 {$ELSEIF DEFINED(FPUITANIUM)}
207 {$ELSEIF DEFINED(FPUSTANDARD)}
209 {$ELSEIF DEFINED(FPUHARD)}
211 {$ELSE}
213 {$ENDIF}
219 begin
224 begin
225 result := g_Map_CollidePanel(X, Y, Width, Height, (PANEL_WALL or PANEL_CLOSEDOOR or PANEL_OPENDOOR), false);
227 (*
228 var
229 a: Integer;
230 begin
231 Result := False;
233 if gWalls = nil then
234 Exit;
236 for a := 0 to High(gWalls) do
237 if gWalls[a].Enabled and
238 not ( ((Y + Height <= gWalls[a].Y) or
239 (Y >= gWalls[a].Y + gWalls[a].Height)) or
240 ((X + Width <= gWalls[a].X) or
241 (X >= gWalls[a].X + gWalls[a].Width)) ) then
242 begin
243 Result := True;
244 Exit;
245 end;
246 end;
247 *)
250 var
252 begin
260 begin
262 Exit;
268 var
271 (*
272 i: Integer;
273 dx, dy: Integer;
274 Xerr, Yerr, d: LongWord;
275 incX, incY: Integer;
276 x, y: Integer;
277 *)
278 begin
279 (*
280 result := False;
282 Assert(gCollideMap <> nil, 'g_TraceVector: gCollideMap = nil');
284 Xerr := 0;
285 Yerr := 0;
286 dx := X2-X1;
287 dy := Y2-Y1;
289 if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0;
290 if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0;
292 dx := abs(dx);
293 dy := abs(dy);
295 if dx > dy then d := dx else d := dy;
297 x := X1;
298 y := Y1;
300 for i := 1 to d do
301 begin
302 Inc(Xerr, dx);
303 Inc(Yerr, dy);
304 if Xerr>d then
305 begin
306 Dec(Xerr, d);
307 Inc(x, incX);
308 end;
309 if Yerr > d then
310 begin
311 Dec(Yerr, d);
312 Inc(y, incY);
313 end;
315 if (y > gMapInfo.Height-1) or
316 (y < 0) or (x > gMapInfo.Width-1) or (x < 0) then
317 Exit;
318 if ByteBool(gCollideMap[y, x] and MARK_BLOCKED) then
319 Exit;
320 end;
322 Result := True;
323 *)
325 // `true` if no obstacles
333 var
336 begin
340 UID_PLAYER:
341 begin
342 repeat
350 begin
352 Break;
357 UID_MONSTER:
358 begin
359 //FIXME!!!
361 begin
370 begin
372 Result := UID_GAME
373 else
375 Result := UID_PLAYER
376 else
382 begin
391 begin
400 begin
408 begin
409 //Result := not (((Y2 <= Y3) or (Y1 >= Y4)) or ((X2 <= X3) or (X1 >= X4)));
414 begin
422 begin
427 begin
432 begin
437 begin
442 begin
447 begin
452 begin
457 begin
462 begin
467 begin
472 begin
477 begin
482 begin
487 begin
492 begin
497 begin
502 begin
509 const
511 begin
518 begin
521 // D(0;H) --- C(W;H)
526 else
531 end
532 else
538 else
543 end
545 begin
547 Result := -Y
548 else
557 const
559 var
561 begin
571 begin
576 begin
578 Exit;
588 var
591 begin
605 var
608 begin
614 else
627 {function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
628 const
629 table: array[0..8, 0..8] of Byte =
630 ((0, 0, 3, 3, 1, 2, 2, 0, 1),
631 (0, 0, 0, 0, 4, 7, 2, 0, 1),
632 (3, 0, 0, 0, 4, 4, 1, 3, 1),
633 (3, 0, 0, 0, 0, 0, 5, 6, 1),
634 (1, 4, 4, 0, 0, 0, 5, 5, 1),
635 (2, 7, 4, 0, 0, 0, 0, 0, 1),
636 (2, 2, 1, 5, 5, 0, 0, 0, 1),
637 (0, 0, 3, 6, 5, 0, 0, 0, 1),
638 (1, 1, 1, 1, 1, 1, 1, 1, 1));
640 function GetClass(x, y: Integer): Byte;
641 begin
642 if y < rY then
643 begin
644 if x < rX then Result := 7
645 else if x < rX+rWidth then Result := 0
646 else Result := 1;
647 end
648 else if y < rY+rHeight then
649 begin
650 if x < rX then Result := 6
651 else if x < rX+rWidth then Result := 8
652 else Result := 2;
653 end
654 else
655 begin
656 if x < rX then Result := 5
657 else if x < rX+rWidth then Result := 4
658 else Result := 3;
659 end;
660 end;
662 begin
663 case table[GetClass(x1, y1), GetClass(x2, y2)] of
664 0: Result := False;
665 1: Result := True;
666 2: Result := Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1));
667 3: Result := Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1));
668 4: Result := Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1));
669 5: Result := Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1));
670 6: Result := (Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1))) and
671 (Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1)));
672 7: Result := (Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1))) and
673 (Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1)));
674 else Result := False;
675 end;
676 end;}
679 {
680 var
681 i: Integer;
682 dx, dy: Integer;
683 Xerr, Yerr: Integer;
684 incX, incY: Integer;
685 x, y, d: Integer;
686 }
687 begin
689 {
690 Result := True;
692 Xerr := 0;
693 Yerr := 0;
694 dx := X2-X1;
695 dy := Y2-Y1;
697 if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0;
698 if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0;
700 dx := abs(dx);
701 dy := abs(dy);
703 if dx > dy then d := dx else d := dy;
705 x := X1;
706 y := Y1;
708 for i := 1 to d+1 do
709 begin
710 Inc(Xerr, dx);
711 Inc(Yerr, dy);
712 if Xerr > d then
713 begin
714 Dec(Xerr, d);
715 Inc(x, incX);
716 end;
717 if Yerr > d then
718 begin
719 Dec(Yerr, d);
720 Inc(y, incY);
721 end;
723 if (x >= rX) and (x <= (rX + rWidth - 1)) and
724 (y >= rY) and (y <= (rY + rHeight - 1)) then Exit;
725 end;
727 Result := False;
728 }
732 var
734 begin
738 begin
742 Exit;
750 begin
756 begin
758 result := w
761 begin
764 // e_LogWritefln('GetLines @%s len=%s [%s]', [MaxWidth, len, Text]);
766 begin
767 (* --- Get longest possible sequence --- *)
769 (* --- Do not include part of word --- *)
772 (* --- Do not include spaces --- *)
774 (* --- Add line --- *)
777 // e_LogWritefln(' -> (%s:%s::%s) [%s]', [j, i, GetWidth(j, i), result[lines]]);
779 (* --- Skip spaces --- *)
786 var
789 begin
795 begin
804 var
811 begin
817 begin
826 begin
833 begin
842 begin
848 begin
857 begin
866 begin
870 begin
874 Break;
877 begin
885 Break;
889 Break;
894 begin
901 begin
905 vtInteger :
906 begin
908 begin
912 end
913 else
914 Break;
917 vtExtended :
918 begin
920 begin
924 end
925 else
926 Break;
929 vtString :
930 begin
932 begin
935 end
936 else
937 Break;
941 Break;
947 var
949 begin
956 begin
958 Exit;
963 var
965 begin
972 begin
974 Exit;
979 var
981 begin
990 begin
992 Exit;
997 var
1000 begin
1004 UID_PLAYER:
1005 begin
1013 UID_MONSTER:
1014 begin
1028 var
1030 begin
1033 Exit;
1036 begin
1039 begin
1048 Break;
1054 var
1056 begin
1061 begin
1064 begin
1071 Break;
1077 var
1079 begin
1081 begin
1083 Exit;
1093 var
1095 begin
1097 begin
1099 Exit;
1109 var
1113 begin
1114 repeat
1127 var
1130 begin
1135 begin
1137 begin
1140 continue;
1143 begin
1165 else
1169 end else
1172 // reset to white at end
1177 var
1180 begin
1184 begin
1186 begin
1188 continue;
1191 begin
1193 continue;
1196 begin
1208 else
1212 end else
1218 begin
1223 var
1225 begin