69 WriteToConsole('Generating collision info... '); |
69 WriteToConsole('Generating collision info... '); |
70 |
70 |
71 if SDL_MustLock(Image) then |
71 if SDL_MustLock(Image) then |
72 SDLTry(SDL_LockSurface(Image) >= 0, true); |
72 SDLTry(SDL_LockSurface(Image) >= 0, true); |
73 |
73 |
74 bpp:= Image.format.BytesPerPixel; |
74 bpp:= Image^.format^.BytesPerPixel; |
75 WriteToConsole('('+inttostr(bpp)+') '); |
75 WriteToConsole('('+inttostr(bpp)+') '); |
76 p:= Image.pixels; |
76 p:= Image^.pixels; |
77 case bpp of |
77 case bpp of |
78 1: OutError('We don''t work with 8 bit surfaces', true); |
78 1: OutError('We don''t work with 8 bit surfaces', true); |
79 2: for y:= 0 to Pred(Image.h) do |
79 2: for y:= 0 to Pred(Image^.h) do |
80 begin |
80 begin |
81 for x:= 0 to Pred(Image.w) do |
81 for x:= 0 to Pred(Image^.w) do |
82 if PWord(@p[x * 2])^ <> 0 then Land[cpY + y, cpX + x]:= COLOR_LAND; |
82 if PWord(@(p^[x * 2]))^ <> 0 then Land[cpY + y, cpX + x]:= COLOR_LAND; |
83 p:= @p[Image.pitch]; |
83 p:= @(p^[Image^.pitch]); |
84 end; |
84 end; |
85 3: for y:= 0 to Pred(Image.h) do |
85 3: for y:= 0 to Pred(Image^.h) do |
86 begin |
86 begin |
87 for x:= 0 to Pred(Image.w) do |
87 for x:= 0 to Pred(Image^.w) do |
88 if (p[x * 3 + 0] <> 0) |
88 if (p^[x * 3 + 0] <> 0) |
89 or (p[x * 3 + 1] <> 0) |
89 or (p^[x * 3 + 1] <> 0) |
90 or (p[x * 3 + 2] <> 0) then Land[cpY + y, cpX + x]:= COLOR_LAND; |
90 or (p^[x * 3 + 2] <> 0) then Land[cpY + y, cpX + x]:= COLOR_LAND; |
91 p:= @p[Image.pitch]; |
91 p:= @(p^[Image^.pitch]); |
92 end; |
92 end; |
93 4: for y:= 0 to Pred(Image.h) do |
93 4: for y:= 0 to Pred(Image^.h) do |
94 begin |
94 begin |
95 for x:= 0 to Pred(Image.w) do |
95 for x:= 0 to Pred(Image^.w) do |
96 if PLongword(@p[x * 4])^ <> 0 then Land[cpY + y, cpX + x]:= COLOR_LAND; |
96 if PLongword(@(p^[x * 4]))^ <> 0 then Land[cpY + y, cpX + x]:= COLOR_LAND; |
97 p:= @p[Image.pitch]; |
97 p:= @(p^[Image^.pitch]); |
98 end; |
98 end; |
99 end; |
99 end; |
100 if SDL_MustLock(Image) then |
100 if SDL_MustLock(Image) then |
101 SDL_UnlockSurface(Image); |
101 SDL_UnlockSurface(Image); |
102 WriteLnToConsole(msgOK) |
102 WriteLnToConsole(msgOK) |
103 end; |
103 end; |
104 |
104 |
105 procedure AddRect(x1, y1, w1, h1: integer); |
105 procedure AddRect(x1, y1, w1, h1: integer); |
106 begin |
106 begin |
107 with Rects[RectCount] do |
107 with Rects^[RectCount] do |
108 begin |
108 begin |
109 x:= x1; |
109 x:= x1; |
110 y:= y1; |
110 y:= y1; |
111 w:= w1; |
111 w:= w1; |
112 h:= h1 |
112 h:= h1 |
126 Dispose(rects) |
126 Dispose(rects) |
127 end; |
127 end; |
128 |
128 |
129 function CheckIntersect(x1, y1, w1, h1: integer): boolean; |
129 function CheckIntersect(x1, y1, w1, h1: integer): boolean; |
130 var i: Longword; |
130 var i: Longword; |
|
131 Result: boolean; |
131 begin |
132 begin |
132 Result:= false; |
133 Result:= false; |
133 i:= 0; |
134 i:= 0; |
134 if RectCount > 0 then |
135 if RectCount > 0 then |
135 repeat |
136 repeat |
136 with Rects[i] do |
137 with Rects^[i] do |
137 Result:= (x < x1 + w1) and (x1 < x + w) and |
138 Result:= (x < x1 + w1) and (x1 < x + w) and |
138 (y < y1 + h1) and (y1 < y + h); |
139 (y < y1 + h1) and (y1 < y + h); |
139 inc(i) |
140 inc(i) |
140 until (i = RectCount) or (Result) |
141 until (i = RectCount) or (Result); |
|
142 CheckIntersect:= Result |
141 end; |
143 end; |
142 |
144 |
143 function AddGirder(gX: integer; Surface: PSDL_Surface): boolean; |
145 function AddGirder(gX: integer; Surface: PSDL_Surface): boolean; |
144 var tmpsurf: PSDL_Surface; |
146 var tmpsurf: PSDL_Surface; |
145 x1, x2, y, k, i: integer; |
147 x1, x2, y, k, i: integer; |
146 r, rr: TSDL_Rect; |
148 r, rr: TSDL_Rect; |
|
149 Result: boolean; |
147 |
150 |
148 function CountNonZeroz(x, y: integer): Longword; |
151 function CountNonZeroz(x, y: integer): Longword; |
149 var i: integer; |
152 var i: integer; |
|
153 Result: Longword; |
150 begin |
154 begin |
151 Result:= 0; |
155 Result:= 0; |
152 for i:= y to y + 15 do |
156 for i:= y to y + 15 do |
153 if Land[i, x] <> 0 then inc(Result) |
157 if Land[i, x] <> 0 then inc(Result); |
|
158 CountNonZeroz:= Result |
154 end; |
159 end; |
155 |
160 |
156 begin |
161 begin |
157 y:= 150; |
162 y:= 150; |
158 repeat |
163 repeat |
197 SDL_UpperBlit(tmpsurf, @r, Surface, @rr); |
202 SDL_UpperBlit(tmpsurf, @r, Surface, @rr); |
198 SDL_FreeSurface(tmpsurf); |
203 SDL_FreeSurface(tmpsurf); |
199 AddRect(x1 - 8, y - 32, x2 - x1 + 16, 80); |
204 AddRect(x1 - 8, y - 32, x2 - x1 + 16, 80); |
200 for k:= y to y + 15 do |
205 for k:= y to y + 15 do |
201 for i:= x1 to x2 do Land[k, i]:= $FFFFFF |
206 for i:= x1 to x2 do Land[k, i]:= $FFFFFF |
202 end else Result:= false |
207 end else Result:= false; |
|
208 AddGirder:= Result |
203 end; |
209 end; |
204 |
210 |
205 function CheckLand(rect: TSDL_Rect; dX, dY, Color: Longword): boolean; |
211 function CheckLand(rect: TSDL_Rect; dX, dY, Color: Longword): boolean; |
206 var i: Longword; |
212 var i: Longword; |
|
213 Result: boolean; |
207 begin |
214 begin |
208 Result:= true; |
215 Result:= true; |
209 inc(rect.x, dX); |
216 inc(rect.x, dX); |
210 inc(rect.y, dY); |
217 inc(rect.y, dY); |
211 i:= 0; |
218 i:= 0; |
220 begin |
227 begin |
221 Result:= (Land[rect.y + i, rect.x] = Color) and (Land[rect.y + i, rect.x + rect.w] = Color); |
228 Result:= (Land[rect.y + i, rect.x] = Color) and (Land[rect.y + i, rect.x + rect.w] = Color); |
222 inc(i) |
229 inc(i) |
223 end; |
230 end; |
224 {$WARNINGS ON} |
231 {$WARNINGS ON} |
|
232 CheckLand:= Result |
225 end; |
233 end; |
226 |
234 |
227 function CheckCanPlace(x, y: Longword; var Obj: TThemeObject): boolean; |
235 function CheckCanPlace(x, y: Longword; var Obj: TThemeObject): boolean; |
228 var i: Longword; |
236 var i: Longword; |
|
237 Result: boolean; |
229 begin |
238 begin |
230 with Obj do |
239 with Obj do |
231 if CheckLand(inland, x, y, $FFFFFF) then |
240 if CheckLand(inland, x, y, $FFFFFF) then |
232 begin |
241 begin |
233 Result:= true; |
242 Result:= true; |
238 inc(i) |
247 inc(i) |
239 end; |
248 end; |
240 if Result then |
249 if Result then |
241 Result:= not CheckIntersect(x, y, Width, Height) |
250 Result:= not CheckIntersect(x, y, Width, Height) |
242 end else |
251 end else |
243 Result:= false |
252 Result:= false; |
|
253 CheckCanPlace:= Result |
244 end; |
254 end; |
245 |
255 |
246 function TryPut(var Obj: TThemeObject; Surface: PSDL_Surface): boolean; overload; |
256 function TryPut(var Obj: TThemeObject; Surface: PSDL_Surface): boolean; overload; |
247 const MaxPointsIndex = 2047; |
257 const MaxPointsIndex = 2047; |
248 var x, y: Longword; |
258 var x, y: Longword; |
249 ar: array[0..MaxPointsIndex] of TPoint; |
259 ar: array[0..MaxPointsIndex] of TPoint; |
250 cnt, i: Longword; |
260 cnt, i: Longword; |
|
261 Result: boolean; |
251 begin |
262 begin |
252 cnt:= 0; |
263 cnt:= 0; |
253 with Obj do |
264 with Obj do |
254 begin |
265 begin |
255 if Maxcnt = 0 then |
266 if Maxcnt = 0 then |
256 begin |
267 exit(false); |
257 Result:= false; |
|
258 exit |
|
259 end; |
|
260 x:= 0; |
268 x:= 0; |
261 repeat |
269 repeat |
262 y:= 0; |
270 y:= 0; |
263 repeat |
271 repeat |
264 if CheckCanPlace(x, y, Obj) then |
272 if CheckCanPlace(x, y, Obj) then |
282 i:= getrandom(cnt); |
290 i:= getrandom(cnt); |
283 BlitImageAndGenerateCollisionInfo(ar[i].x, ar[i].y, Obj.Surf, Surface); |
291 BlitImageAndGenerateCollisionInfo(ar[i].x, ar[i].y, Obj.Surf, Surface); |
284 AddRect(ar[i].x, ar[i].y, Width, Height); |
292 AddRect(ar[i].x, ar[i].y, Width, Height); |
285 dec(Maxcnt) |
293 dec(Maxcnt) |
286 end else Maxcnt:= 0 |
294 end else Maxcnt:= 0 |
287 end |
295 end; |
|
296 TryPut:= Result |
288 end; |
297 end; |
289 |
298 |
290 function TryPut(var Obj: TSprayObject; Surface: PSDL_Surface): boolean; overload; |
299 function TryPut(var Obj: TSprayObject; Surface: PSDL_Surface): boolean; overload; |
291 const MaxPointsIndex = 8095; |
300 const MaxPointsIndex = 8095; |
292 var x, y: Longword; |
301 var x, y: Longword; |
293 ar: array[0..MaxPointsIndex] of TPoint; |
302 ar: array[0..MaxPointsIndex] of TPoint; |
294 cnt, i: Longword; |
303 cnt, i: Longword; |
295 r: TSDL_Rect; |
304 r: TSDL_Rect; |
|
305 Result: boolean; |
296 begin |
306 begin |
297 cnt:= 0; |
307 cnt:= 0; |
298 with Obj do |
308 with Obj do |
299 begin |
309 begin |
300 if Maxcnt = 0 then |
310 if Maxcnt = 0 then |
301 begin |
311 exit(false); |
302 Result:= false; |
|
303 exit |
|
304 end; |
|
305 x:= 0; |
312 x:= 0; |
306 r.x:= 0; |
313 r.x:= 0; |
307 r.y:= 0; |
314 r.y:= 0; |
308 r.w:= Width; |
315 r.w:= Width; |
309 r.h:= Height + 16; |
316 r.h:= Height + 16; |
336 r.h:= Height; |
343 r.h:= Height; |
337 SDL_UpperBlit(Obj.Surf, nil, Surface, @r); |
344 SDL_UpperBlit(Obj.Surf, nil, Surface, @r); |
338 AddRect(ar[i].x - 32, ar[i].y - 32, Width + 64, Height + 64); |
345 AddRect(ar[i].x - 32, ar[i].y - 32, Width + 64, Height + 64); |
339 dec(Maxcnt) |
346 dec(Maxcnt) |
340 end else Maxcnt:= 0 |
347 end else Maxcnt:= 0 |
341 end |
348 end; |
|
349 TryPut:= Result |
342 end; |
350 end; |
343 |
351 |
344 procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSprayObjects); |
352 procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSprayObjects); |
345 var s: string; |
353 var s: string; |
346 f: textfile; |
354 f: textfile; |
347 i, ii: integer; |
355 i, ii: integer; |
348 begin |
356 begin |
349 s:= Pathz[ptCurrTheme] + '/' + cThemeCFGFilename; |
357 s:= Pathz[ptCurrTheme] + '/' + cThemeCFGFilename; |
350 WriteLnToConsole('Reading objects info...'); |
358 WriteLnToConsole('Reading objects info...'); |
351 AssignFile(f, s); |
359 Assign(f, s); |
352 {$I-} |
360 {$I-} |
353 Reset(f); |
361 Reset(f); |
354 Readln(f, s); // skip color |
362 Readln(f, s); // skip color |
355 Readln(f, ThemeObjects.Count); |
363 Readln(f, ThemeObjects.Count); |
356 for i:= 0 to Pred(ThemeObjects.Count) do |
364 for i:= 0 to Pred(ThemeObjects.Count) do |
357 begin |
365 begin |
358 Readln(f, s); // filename |
366 Readln(f, s); // filename |
359 with ThemeObjects.objs[i] do |
367 with ThemeObjects.objs[i] do |
360 begin |
368 begin |
361 Surf:= LoadImage(Pathz[ptCurrTheme] + '/' + s, false); |
369 Surf:= LoadImage(Pathz[ptCurrTheme] + '/' + s, false, true, true); |
362 Width:= Surf.w; |
370 Width:= Surf^.w; |
363 Height:= Surf.h; |
371 Height:= Surf^.h; |
364 with inland do Read(f, x, y, w, h); |
372 with inland do Read(f, x, y, w, h); |
365 Read(f, rectcnt); |
373 Read(f, rectcnt); |
366 for ii:= 1 to rectcnt do |
374 for ii:= 1 to rectcnt do |
367 with outland[ii] do Read(f, x, y, w, h); |
375 with outland[ii] do Read(f, x, y, w, h); |
368 Maxcnt:= 3; |
376 Maxcnt:= 3; |
374 for i:= 0 to Pred(SprayObjects.Count) do |
382 for i:= 0 to Pred(SprayObjects.Count) do |
375 begin |
383 begin |
376 Readln(f, s); // filename |
384 Readln(f, s); // filename |
377 with SprayObjects.objs[i] do |
385 with SprayObjects.objs[i] do |
378 begin |
386 begin |
379 Surf:= LoadImage(Pathz[ptCurrTheme] + '/' + s, false); |
387 Surf:= LoadImage(Pathz[ptCurrTheme] + '/' + s, false, true, true); |
380 Width:= Surf.w; |
388 Width:= Surf^.w; |
381 Height:= Surf.h; |
389 Height:= Surf^.h; |
382 ReadLn(f, Maxcnt) |
390 ReadLn(f, Maxcnt) |
383 end; |
391 end; |
384 end; |
392 end; |
385 Closefile(f); |
393 Close(f); |
386 {$I+} |
394 {$I+} |
387 TryDo(IOResult = 0, 'Bad data or cannot access file ' + cThemeCFGFilename, true) |
395 TryDo(IOResult = 0, 'Bad data or cannot access file ' + cThemeCFGFilename, true) |
388 end; |
396 end; |
389 |
397 |
390 procedure AddThemeObjects(Surface: PSDL_Surface; var ThemeObjects: TThemeObjects; MaxCount: integer); |
398 procedure AddThemeObjects(Surface: PSDL_Surface; var ThemeObjects: TThemeObjects; MaxCount: integer); |