DEADSOFTWARE

Fix furnace timings
[cavecraft.git] / src / phy.pas
1 unit phy;
3 interface
4 procedure loadObject(_x, _y, _w, _h, _velx, _vely:integer; _jmp:boolean);
6 function isSolid(x, y, velx, vely:integer):boolean;
8 function mapCollType(_type, x, y, w, h:integer):boolean;
10 function CollTwoObj(x1,y1,w1,h1,x2,y2,w2,h2:integer):boolean;
12 procedure jumpObj(vel:integer);
13 procedure calc(gravity:boolean);
15 function getX:integer;
16 function getY:integer;
17 function getVelX:integer;
18 function getVelY:integer;
19 function getJmp:boolean;
21 function canSeeObj(x1, y1, x2, y2:integer):boolean;
23 implementation
24 uses items_store, maps, vars;
25 const
26 MAX_VELY=32;
27 TILE_SIZE=16;
28 var
29 x, y, w, h, velx, vely:integer;
30 jmp:boolean;
32 function CollTwoObj(x1,y1,w1,h1,x2,y2,w2,h2:integer):boolean;
33 begin
34 if (x1+w1>x2) and (x1<x2+w2) and (y1+h1>y2) and (y1<y2+h2) then
35 CollTwoObj:=true;
36 end;
38 procedure loadObject(_x, _y, _w, _h, _velx, _vely:integer; _jmp:boolean);
39 begin
40 x:=_x;
41 y:=_y;
42 w:=_w;
43 h:=_h;
44 velx:=_velx;
45 vely:=_vely;
46 jmp:=_jmp;
47 end;
49 function mapBoundCheck(x, y : Integer) : Boolean;
50 begin
51 mapBoundCheck := (x < 0) or (x > MAP_W * TILE_SIZE);
52 end;
54 function onMapObjectCheck(x, y, w, h : Integer) : Boolean;
55 begin
56 onMapObjectCheck := mapBoundCheck(x, y) or mapBoundCheck(x + w, y + h);
57 end;
59 function isSolid(x, y, velx, vely:integer):boolean;
60 begin
61 isSolid := getBlockColl(getMap(x, y)) <> 0;
62 end;
64 function mapColl(x, y, w, h, velx, vely:integer):boolean;
65 var
66 i, j:integer;
67 minx, miny, maxx, maxy:integer;
68 begin
69 if onMapObjectCheck(x, y, w, h) then
70 begin
71 mapColl := true;
72 exit;
73 end;
75 minx:=x div TILE_SIZE;
76 miny:=y div TILE_SIZE;
77 maxx:=(x+w-1) div TILE_SIZE;
78 maxy:=(y+h-1) div TILE_SIZE;
79 for i:=minx to maxx do
80 for j:=miny to maxy do
81 begin
82 if isSolid(i, j, velx, vely) then
83 begin
84 mapColl:=true;
85 exit;
86 end;
87 end;
88 end;
90 function canSeeObj(x1, y1, x2, y2:integer):boolean;
91 var
92 deltax, deltay:integer;
93 signx, signy:integer;
94 error, error2:integer;
95 begin
96 x1:=x1/TILE_SIZE;
97 y1:=y1/TILE_SIZE;
98 x2:=x2/TILE_SIZE;
99 y2:=y2/TILE_SIZE;
101 deltax:=abs(x2-x1);
102 deltay:=abs(y2-y1);
104 if x1<x2 then
105 signx:=1;
106 else
107 signx:=-1;
109 if y1<y2 then
110 signy:=1;
111 else
112 signy:=-1;
114 error:=deltaX-deltaY;
116 while((x1<>x2) or (y1<>y2)) do
117 begin
118 if isSolid(x1, y1, 0, 0) then
119 exit;
121 error2:=error<<1;
122 if error2>-deltaY then
123 begin
124 error:=error-deltaY;
125 x1:=x1+signX;
126 end;
128 if error2<deltaX then
129 begin
130 error:=error+deltaX;
131 y1:=y1+signY;
132 end;
133 end;
134 canSeeObj:=true;
135 end;
137 function mapCollType(_type, x, y, w, h:integer):boolean;
138 var
139 i, j:integer;
140 minx, miny, maxx, maxy:integer;
141 begin
142 minx:=x div TILE_SIZE;
143 miny:=y div TILE_SIZE;
144 maxx:=(x+w-1) div TILE_SIZE;
145 maxy:=(y+h-1) div TILE_SIZE;
146 for i:=minx to maxx do
147 for j:=miny to maxy do
148 begin
149 if getMap(i, j)=_type then
150 begin
151 mapCollType:=true;
152 exit;
153 end;
154 end;
155 end;
157 procedure calcGravity;
158 var
159 i:integer;
160 begin
161 vely:=vely+1;
162 if vely>MAX_VELY then
163 vely:=MAX_VELY;
165 jmp:=false;
167 if vely>0 then
168 for i:=1 to vely do
169 begin
170 y:=y+1;
171 if mapColl(x, y, w, h, velx, vely) then
172 begin
173 y:=y-1;
174 vely:=0;
175 jmp:=true;
176 break;
177 end;
178 end;
179 else
180 for i:=1 to abs(vely) do
181 begin
182 y:=y-1;
183 if mapColl(x, y, w, h, velx, vely) then
184 begin
185 y:=y+1;
186 vely:=0;
187 jmp:=false;
188 break;
189 end;
190 end;
191 end;
193 function fixVYup:boolean;
194 begin
195 if (vely>-5) and
196 (mapCollType(49, x, y, w, h) or
197 mapCollType(103, x, y, w, h) or
198 mapCollType(108, x, y, w, h)) then
199 vely:=vely-2;
200 else
201 if (vely>-4) and
202 (mapCollType(50, x, y, w, h) or
203 mapCollType(51, x, y, w, h)) then
204 vely:=vely-2;
205 else
206 fixVYup:=true;
207 end;
209 procedure fixVYdown;
210 begin
211 if (vely>5) and
212 (mapCollType(49, x, y, w, h) or
213 mapCollType(103, x, y, w, h)) then
214 vely:=5;
215 else
216 if (vely>4) and
217 (mapCollType(50, x, y, w, h) or
218 mapCollType(51, x, y, w, h)) then
219 vely:=4;
220 end;
222 procedure jumpObj(vel:integer);
223 begin
224 if fixVYup then
225 if jmp then
226 begin
227 vely:=-vel;
228 jmp:=false;
229 end;
230 end;
232 procedure calcX;
233 var
234 i:integer;
235 begin
236 if velx>0 then
237 for i:=1 to velx do
238 begin
239 x:=x+1;
240 if mapColl(x, y, w, h, velx, vely) then
241 begin
242 x:=x-1;
243 velx:=0;
244 break;
245 end;
246 end;
247 else
248 if velx<0 then
249 for i:=1 to abs(velx) do //there for-downto-do have a bug!
250 begin
251 x:=x-1;
252 if mapColl(x, y, w, h, velx, vely) then
253 begin
254 x:=x+1;
255 velx:=0;
256 break;
257 end;
258 end;
260 if velx>0 then
261 velx:=velx-1;
262 else
263 if velx<0 then
264 velx:=velx+1;
265 end;
267 procedure calcY;
268 var
269 i:integer;
270 begin
271 if vely>0 then
272 for i:=1 to vely do
273 begin
274 y:=y+1;
275 if mapColl(x, y, w, h, velx, vely) then
276 begin
277 y:=y-1;
278 vely:=0;
279 break;
280 end;
281 end;
282 else
283 if vely<0 then
284 for i:=1 to abs(vely) do //there for-downto-do have a bug!
285 begin
286 y:=y-1;
287 if mapColl(x, y, w, h, velx, vely) then
288 begin
289 y:=y+1;
290 velx:=0;
291 break;
292 end;
293 end;
295 if vely>0 then
296 vely:=vely-1;
297 else
298 if vely<0 then
299 vely:=vely+1;
300 end;
302 function getX:integer;
303 begin
304 getX:=x;
305 end;
307 function getY:integer;
308 begin
309 getY:=y;
310 end;
312 function getVelX:integer;
313 begin
314 getVelX:=velx;
315 end;
317 function getVelY:integer;
318 begin
319 getVelY:=vely;
320 end;
322 function getJmp:boolean;
323 begin
324 getJmp:=jmp;
325 end;
327 procedure calc(gravity:boolean);
328 begin
329 calcX;
331 if gravity then
332 begin
333 calcGravity;
334 fixVYdown;
335 end;
336 else
337 calcY;
338 end;
340 end.