125 Dispose(rects) |
125 Dispose(rects) |
126 end; |
126 end; |
127 |
127 |
128 function CheckIntersect(x1, y1, w1, h1: LongInt): boolean; |
128 function CheckIntersect(x1, y1, w1, h1: LongInt): boolean; |
129 var i: Longword; |
129 var i: Longword; |
130 Result: boolean; |
130 res: boolean = false; |
131 begin |
131 begin |
132 Result:= false; |
132 |
133 i:= 0; |
133 i:= 0; |
134 if RectCount > 0 then |
134 if RectCount > 0 then |
135 repeat |
135 repeat |
136 with Rects^[i] do |
136 with Rects^[i] do |
137 Result:= (x < x1 + w1) and (x1 < x + w) and |
137 res:= (x < x1 + w1) and (x1 < x + w) and |
138 (y < y1 + h1) and (y1 < y + h); |
138 (y < y1 + h1) and (y1 < y + h); |
139 inc(i) |
139 inc(i) |
140 until (i = RectCount) or (Result); |
140 until (i = RectCount) or (res); |
141 CheckIntersect:= Result |
141 CheckIntersect:= res; |
142 end; |
142 end; |
143 |
143 |
144 function AddGirder(gX: LongInt): boolean; |
144 function AddGirder(gX: LongInt): boolean; |
145 var tmpsurf: PSDL_Surface; |
145 var tmpsurf: PSDL_Surface; |
146 x1, x2, y, k, i: LongInt; |
146 x1, x2, y, k, i: LongInt; |
147 rr: TSDL_Rect; |
147 rr: TSDL_Rect; |
148 Result: boolean; |
148 bRes: boolean; |
149 |
149 |
150 function CountNonZeroz(x, y: LongInt): Longword; |
150 function CountNonZeroz(x, y: LongInt): Longword; |
151 var i: LongInt; |
151 var i: LongInt; |
152 Result: Longword; |
152 lRes: Longword; |
153 begin |
153 begin |
154 Result:= 0; |
154 lRes:= 0; |
155 for i:= y to y + 15 do |
155 for i:= y to y + 15 do |
156 if Land[i, x] <> 0 then inc(Result); |
156 if Land[i, x] <> 0 then inc(lRes); |
157 CountNonZeroz:= Result |
157 CountNonZeroz:= lRes; |
158 end; |
158 end; |
159 |
159 |
160 begin |
160 begin |
161 y:= topY+150; |
161 y:= topY+150; |
162 repeat |
162 repeat |
200 inc(rr.x, tmpsurf^.w); |
200 inc(rr.x, tmpsurf^.w); |
201 end; |
201 end; |
202 SDL_FreeSurface(tmpsurf); |
202 SDL_FreeSurface(tmpsurf); |
203 |
203 |
204 AddRect(x1 - 8, y - 32, x2 - x1 + 16, 80); |
204 AddRect(x1 - 8, y - 32, x2 - x1 + 16, 80); |
205 end else Result:= false; |
205 end |
206 |
206 else bRes:= false; |
207 AddGirder:= Result |
207 |
|
208 AddGirder:= bRes; |
208 end; |
209 end; |
209 |
210 |
210 function CheckLand(rect: TSDL_Rect; dX, dY, Color: Longword): boolean; |
211 function CheckLand(rect: TSDL_Rect; dX, dY, Color: Longword): boolean; |
211 var i: Longword; |
212 var i: Longword; |
212 Result: boolean; |
213 bRes: boolean = true; |
213 begin |
214 begin |
214 Result:= true; |
|
215 inc(rect.x, dX); |
215 inc(rect.x, dX); |
216 inc(rect.y, dY); |
216 inc(rect.y, dY); |
217 i:= 0; |
217 i:= 0; |
218 {$WARNINGS OFF} |
218 {$WARNINGS OFF} |
219 while (i <= rect.w) and Result do |
219 while (i <= rect.w) and bRes do |
220 begin |
220 begin |
221 Result:= (Land[rect.y, rect.x + i] = Color) and (Land[rect.y + rect.h, rect.x + i] = Color); |
221 bRes:= (Land[rect.y, rect.x + i] = Color) and (Land[rect.y + rect.h, rect.x + i] = Color); |
222 inc(i) |
222 inc(i) |
223 end; |
223 end; |
224 i:= 0; |
224 i:= 0; |
225 while (i <= rect.h) and Result do |
225 while (i <= rect.h) and bRes do |
226 begin |
226 begin |
227 Result:= (Land[rect.y + i, rect.x] = Color) and (Land[rect.y + i, rect.x + rect.w] = Color); |
227 bRes:= (Land[rect.y + i, rect.x] = Color) and (Land[rect.y + i, rect.x + rect.w] = Color); |
228 inc(i) |
228 inc(i) |
229 end; |
229 end; |
230 {$WARNINGS ON} |
230 {$WARNINGS ON} |
231 CheckLand:= Result |
231 CheckLand:= bRes; |
232 end; |
232 end; |
233 |
233 |
234 function CheckCanPlace(x, y: Longword; var Obj: TThemeObject): boolean; |
234 function CheckCanPlace(x, y: Longword; var Obj: TThemeObject): boolean; |
235 var i: Longword; |
235 var i: Longword; |
236 Result: boolean; |
236 bRes: boolean; |
237 begin |
237 begin |
238 with Obj do |
238 with Obj do |
239 if CheckLand(inland, x, y, COLOR_LAND) then |
239 if CheckLand(inland, x, y, COLOR_LAND) then |
240 begin |
240 begin |
241 Result:= true; |
241 bRes:= true; |
242 i:= 1; |
242 i:= 1; |
243 while Result and (i <= rectcnt) do |
243 while bRes and (i <= rectcnt) do |
244 begin |
244 begin |
245 Result:= CheckLand(outland[i], x, y, 0); |
245 bRes:= CheckLand(outland[i], x, y, 0); |
246 inc(i) |
246 inc(i) |
247 end; |
247 end; |
248 if Result then |
248 if bRes then |
249 Result:= not CheckIntersect(x, y, Width, Height) |
249 bRes:= not CheckIntersect(x, y, Width, Height) |
250 end else |
250 end else |
251 Result:= false; |
251 bRes:= false; |
252 CheckCanPlace:= Result |
252 CheckCanPlace:= bRes; |
253 end; |
253 end; |
254 |
254 |
255 function TryPut(var Obj: TThemeObject): boolean; overload; |
255 function TryPut(var Obj: TThemeObject): boolean; overload; |
256 const MaxPointsIndex = 2047; |
256 const MaxPointsIndex = 2047; |
257 var x, y: Longword; |
257 var x, y: Longword; |
258 ar: array[0..MaxPointsIndex] of TPoint; |
258 ar: array[0..MaxPointsIndex] of TPoint; |
259 cnt, i: Longword; |
259 cnt, i: Longword; |
260 Result: boolean; |
260 bRes: boolean; |
261 begin |
261 begin |
262 cnt:= 0; |
262 cnt:= 0; |
263 Obj.Maxcnt:= (Obj.Maxcnt * MaxHedgehogs) div 18; |
263 Obj.Maxcnt:= (Obj.Maxcnt * MaxHedgehogs) div 18; |
264 with Obj do |
264 with Obj do |
265 begin |
265 begin |
282 end; |
282 end; |
283 inc(y, 3); |
283 inc(y, 3); |
284 until y > LAND_HEIGHT - 1 - Height; |
284 until y > LAND_HEIGHT - 1 - Height; |
285 inc(x, getrandom(6) + 3) |
285 inc(x, getrandom(6) + 3) |
286 until x > LAND_WIDTH - 1 - Width; |
286 until x > LAND_WIDTH - 1 - Width; |
287 Result:= cnt <> 0; |
287 bRes:= cnt <> 0; |
288 if Result then |
288 if bRes then |
289 begin |
289 begin |
290 i:= getrandom(cnt); |
290 i:= getrandom(cnt); |
291 BlitImageAndGenerateCollisionInfo(ar[i].x, ar[i].y, 0, Obj.Surf); |
291 BlitImageAndGenerateCollisionInfo(ar[i].x, ar[i].y, 0, Obj.Surf); |
292 AddRect(ar[i].x, ar[i].y, Width, Height); |
292 AddRect(ar[i].x, ar[i].y, Width, Height); |
293 dec(Maxcnt) |
293 dec(Maxcnt) |
294 end else Maxcnt:= 0 |
294 end else Maxcnt:= 0 |
295 end; |
295 end; |
296 TryPut:= Result |
296 TryPut:= bRes; |
297 end; |
297 end; |
298 |
298 |
299 function TryPut(var Obj: TSprayObject; Surface: PSDL_Surface): boolean; overload; |
299 function TryPut(var Obj: TSprayObject; Surface: PSDL_Surface): boolean; overload; |
300 const MaxPointsIndex = 8095; |
300 const MaxPointsIndex = 8095; |
301 var x, y: Longword; |
301 var x, y: Longword; |
302 ar: array[0..MaxPointsIndex] of TPoint; |
302 ar: array[0..MaxPointsIndex] of TPoint; |
303 cnt, i: Longword; |
303 cnt, i: Longword; |
304 r: TSDL_Rect; |
304 r: TSDL_Rect; |
305 Result: boolean; |
305 bRes: boolean; |
306 begin |
306 begin |
307 cnt:= 0; |
307 cnt:= 0; |
308 Obj.Maxcnt:= (Obj.Maxcnt * MaxHedgehogs) div 18; |
308 Obj.Maxcnt:= (Obj.Maxcnt * MaxHedgehogs) div 18; |
309 with Obj do |
309 with Obj do |
310 begin |
310 begin |
345 SDL_UpperBlit(Obj.Surf, nil, Surface, @r); |
345 SDL_UpperBlit(Obj.Surf, nil, Surface, @r); |
346 AddRect(ar[i].x - 32, ar[i].y - 32, Width + 64, Height + 64); |
346 AddRect(ar[i].x - 32, ar[i].y - 32, Width + 64, Height + 64); |
347 dec(Maxcnt) |
347 dec(Maxcnt) |
348 end else Maxcnt:= 0 |
348 end else Maxcnt:= 0 |
349 end; |
349 end; |
350 TryPut:= Result |
350 TryPut:= bRes; |
351 end; |
351 end; |
352 |
352 |
353 procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSprayObjects); |
353 procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSprayObjects); |
354 var s: string; |
354 var s: string; |
355 f: textfile; |
355 f: textfile; |