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;
747 var
753 begin
754 // Skip leading spaces.
761 begin
762 // Exclude trailing spaces from the line.
771 begin
776 begin
779 //e_LogWritefln('GetLines @%s len=%s [%s]', [MaxWidth, len, text]);
782 begin
783 // Get longest possible sequence (this is not constant because fonts are not monospaced).
785 repeat
791 // Do not include part of a word if possible.
795 // Add line.
798 //e_LogWritefln(' -> (%s:%s::%s) [%s]', [k, i, LineWidth(), Result[lines]]);
806 var
809 begin
815 begin
824 var
831 begin
837 begin
846 begin
853 begin
862 begin
868 begin
877 begin
886 begin
890 begin
894 Break;
897 begin
905 Break;
909 Break;
914 begin
921 begin
925 vtInteger :
926 begin
928 begin
932 end
933 else
934 Break;
937 vtExtended :
938 begin
940 begin
944 end
945 else
946 Break;
949 vtString :
950 begin
952 begin
955 end
956 else
957 Break;
961 Break;
967 var
969 begin
976 begin
978 Exit;
983 var
985 begin
992 begin
994 Exit;
999 var
1001 begin
1010 begin
1012 Exit;
1017 var
1020 begin
1024 UID_PLAYER:
1025 begin
1033 UID_MONSTER:
1034 begin
1048 var
1050 begin
1053 Exit;
1056 begin
1059 begin
1068 Break;
1074 var
1076 begin
1081 begin
1084 begin
1091 Break;
1097 var
1099 begin
1101 begin
1103 Exit;
1113 var
1115 begin
1117 begin
1119 Exit;
1129 var
1133 begin
1134 repeat
1147 var
1150 begin
1155 begin
1157 begin
1160 continue;
1163 begin
1185 else
1189 end else
1192 // reset to white at end
1197 var
1200 begin
1204 begin
1206 begin
1208 continue;
1211 begin
1213 continue;
1216 begin
1228 else
1232 end else
1238 begin
1243 var
1245 begin