34 unit uLandObjects; |
34 unit uLandObjects; |
35 interface |
35 interface |
36 uses SDLh; |
36 uses SDLh; |
37 {$include options.inc} |
37 {$include options.inc} |
38 |
38 |
39 procedure AddObjects(Surface: PSDL_Surface); |
39 procedure AddObjects(InSurface, Surface: PSDL_Surface); |
40 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image, Surface: PSDL_Surface); |
40 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image, Surface: PSDL_Surface); |
41 |
41 |
42 implementation |
42 implementation |
43 uses uLand, uStore, uConsts, uMisc, uConsole, uRandom; |
43 uses uLand, uStore, uConsts, uMisc, uConsole, uRandom; |
44 const MaxRects = 256; |
44 const MaxRects = 256; |
45 MAXOBJECTRECTS = 16; |
45 MAXOBJECTRECTS = 16; |
46 type PRectArray = ^TRectsArray; |
46 MAXTHEMEOBJECTS = 32; |
47 TRectsArray = array[0..MaxRects] of TSDL_rect; |
47 |
48 |
48 type PRectArray = ^TRectsArray; |
49 type TThemeObject = record |
49 TRectsArray = array[0..MaxRects] of TSDL_Rect; |
|
50 TThemeObject = record |
50 Surf: PSDL_Surface; |
51 Surf: PSDL_Surface; |
51 inland: TSDL_Rect; |
52 inland: TSDL_Rect; |
52 outland: array[1..MAXOBJECTRECTS] of TSDL_Rect; |
53 outland: array[0..Pred(MAXOBJECTRECTS)] of TSDL_Rect; |
53 rectcnt: Longword; |
54 rectcnt: Longword; |
54 Width, Height: Longword; |
55 Width, Height: Longword; |
55 Maxcnt: Longword; |
56 Maxcnt: Longword; |
56 end; |
57 end; |
|
58 TThemeObjects = record |
|
59 Count: integer; |
|
60 objs: array[0..Pred(MAXTHEMEOBJECTS)] of TThemeObject; |
|
61 end; |
|
62 TSprayObject = record |
|
63 Surf: PSDL_Surface; |
|
64 Width, Height: Longword; |
|
65 Maxcnt: Longword; |
|
66 end; |
|
67 TSprayObjects = record |
|
68 Count: integer; |
|
69 objs: array[0..Pred(MAXTHEMEOBJECTS)] of TSprayObject |
|
70 end; |
57 |
71 |
58 var Rects: PRectArray; |
72 var Rects: PRectArray; |
59 RectCount: Longword; |
73 RectCount: Longword; |
60 |
74 |
61 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image, Surface: PSDL_Surface); |
75 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image, Surface: PSDL_Surface); |
79 1: OutError('We don''t work with 8 bit surfaces', true); |
93 1: OutError('We don''t work with 8 bit surfaces', true); |
80 2: for y:= 0 to Pred(Image.h) do |
94 2: for y:= 0 to Pred(Image.h) do |
81 begin |
95 begin |
82 i:= Longword(@Land[cpY + y, cpX]); |
96 i:= Longword(@Land[cpY + y, cpX]); |
83 for x:= 0 to Pred(Image.w) do |
97 for x:= 0 to Pred(Image.w) do |
84 if PWord(p + x * 2)^ <> 0 then PLongWord(i + x * 4)^:= $FFFFFF; |
98 if PWord(p + x * 2)^ <> 0 then PLongWord(i + x * 4)^:= COLOR_LAND; |
85 inc(p, Image.pitch); |
99 inc(p, Image.pitch); |
86 end; |
100 end; |
87 3: for y:= 0 to Pred(Image.h) do |
101 3: for y:= 0 to Pred(Image.h) do |
88 begin |
102 begin |
89 i:= Longword(@Land[cpY + y, cpX]); |
103 i:= Longword(@Land[cpY + y, cpX]); |
90 for x:= 0 to Pred(Image.w) do |
104 for x:= 0 to Pred(Image.w) do |
91 if (PByte(p + x * 3 + 0)^ <> 0) |
105 if (PByte(p + x * 3 + 0)^ <> 0) |
92 or (PByte(p + x * 3 + 1)^ <> 0) |
106 or (PByte(p + x * 3 + 1)^ <> 0) |
93 or (PByte(p + x * 3 + 2)^ <> 0) then PLongWord(i + x * 4)^:= $FFFFFF; |
107 or (PByte(p + x * 3 + 2)^ <> 0) then PLongWord(i + x * 4)^:= COLOR_LAND; |
94 inc(p, Image.pitch); |
108 inc(p, Image.pitch); |
95 end; |
109 end; |
96 4: for y:= 0 to Pred(Image.h) do |
110 4: for y:= 0 to Pred(Image.h) do |
97 begin |
111 begin |
98 i:= Longword(@Land[cpY + y, cpX]); |
112 i:= Longword(@Land[cpY + y, cpX]); |
99 for x:= 0 to Pred(Image.w) do |
113 for x:= 0 to Pred(Image.w) do |
100 if PLongword(p + x * 4)^ <> 0 then PLongWord(i + x * 4)^:= $FFFFFF; |
114 if PLongword(p + x * 4)^ <> 0 then PLongWord(i + x * 4)^:= COLOR_LAND; |
101 inc(p, Image.pitch); |
115 inc(p, Image.pitch); |
102 end; |
116 end; |
103 end; |
117 end; |
104 if SDL_MustLock(Image) then |
118 if SDL_MustLock(Image) then |
105 SDL_UnlockSurface(Image); |
119 SDL_UnlockSurface(Image); |
289 dec(Maxcnt) |
303 dec(Maxcnt) |
290 end else Maxcnt:= 0 |
304 end else Maxcnt:= 0 |
291 end |
305 end |
292 end; |
306 end; |
293 |
307 |
294 procedure AddThemeObjects(Surface: PSDL_Surface; MaxCount: Longword); |
308 function TryPut(var Obj: TSprayObject; Surface: PSDL_Surface): boolean; overload; |
295 const MAXTHEMEOBJECTS = 32; |
309 const MaxPointsIndex = 8095; |
296 var f: textfile; |
310 var x, y: Longword; |
297 s: string; |
311 ar: array[0..MaxPointsIndex] of TPoint; |
298 ThemeObjects: array[1..MAXTHEMEOBJECTS] of TThemeObject; |
312 cnt, i: Longword; |
299 i, ii, t, n: Longword; |
313 r: TSDL_Rect; |
300 b: boolean; |
314 begin |
|
315 cnt:= 0; |
|
316 with Obj do |
|
317 begin |
|
318 if Maxcnt = 0 then |
|
319 begin |
|
320 Result:= false; |
|
321 exit |
|
322 end; |
|
323 x:= 0; |
|
324 r.x:= 0; |
|
325 r.y:= 0; |
|
326 r.w:= Width; |
|
327 r.h:= Height + 16; |
|
328 repeat |
|
329 y:= 8; |
|
330 repeat |
|
331 if CheckLand(r, x, y - 8, $FFFFFF) |
|
332 and not CheckIntersect(x, y, Width, Height) then |
|
333 begin |
|
334 ar[cnt].x:= x; |
|
335 ar[cnt].y:= y; |
|
336 inc(cnt); |
|
337 if cnt > MaxPointsIndex then // buffer is full, do not check the rest land |
|
338 begin |
|
339 y:= 5000; |
|
340 x:= 5000; |
|
341 end |
|
342 end; |
|
343 inc(y, 12); |
|
344 until y > 1023 - Height - 8; |
|
345 inc(x, getrandom(12) + 12) |
|
346 until x > 2047 - Width; |
|
347 Result:= cnt <> 0; |
|
348 if Result then |
|
349 begin |
|
350 i:= getrandom(cnt); |
|
351 r.x:= ar[i].X; |
|
352 r.y:= ar[i].Y; |
|
353 r.w:= Width; |
|
354 r.h:= Height; |
|
355 SDL_UpperBlit(Obj.Surf, nil, Surface, @r); |
|
356 AddRect(ar[i].x - 32, ar[i].y - 32, Width + 64, Height + 64); |
|
357 dec(Maxcnt) |
|
358 end else Maxcnt:= 0 |
|
359 end |
|
360 end; |
|
361 |
|
362 procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSprayObjects); |
|
363 var s: string; |
|
364 f: textfile; |
|
365 i, ii: integer; |
301 begin |
366 begin |
302 s:= Pathz[ptThemeCurrent] + '/' + cThemeCFGFilename; |
367 s:= Pathz[ptThemeCurrent] + '/' + cThemeCFGFilename; |
303 WriteLnToConsole('Adding objects...'); |
368 WriteLnToConsole('Reading objects info...'); |
304 AssignFile(f, s); |
369 AssignFile(f, s); |
305 {$I-} |
370 {$I-} |
306 Reset(f); |
371 Reset(f); |
307 Readln(f, s); // skip color |
372 Readln(f, s); // skip color |
308 Readln(f, n); |
373 Readln(f, ThemeObjects.Count); |
309 for i:= 1 to n do |
374 for i:= 0 to Pred(ThemeObjects.Count) do |
310 begin |
375 begin |
311 Readln(f, s); // filename |
376 Readln(f, s); // filename |
312 with ThemeObjects[i] do |
377 with ThemeObjects.objs[i] do |
313 begin |
378 begin |
314 Surf:= LoadImage(Pathz[ptThemeCurrent] + '/' + s + '.png', false); |
379 Surf:= LoadImage(Pathz[ptThemeCurrent] + '/' + s + '.png', false); |
315 Read(f, Width, Height); |
380 Read(f, Width, Height); |
316 with inland do Read(f, x, y, w, h); |
381 with inland do Read(f, x, y, w, h); |
317 Read(f, rectcnt); |
382 Read(f, rectcnt); |
318 for ii:= 1 to rectcnt do |
383 for ii:= 1 to rectcnt do |
319 with outland[ii] do Read(f, x, y, w, h); |
384 with outland[ii] do Read(f, x, y, w, h); |
320 Maxcnt:= 2; |
385 Maxcnt:= 3; |
321 ReadLn(f) |
386 ReadLn(f) |
|
387 end; |
|
388 end; |
|
389 |
|
390 Readln(f, SprayObjects.Count); |
|
391 for i:= 0 to Pred(SprayObjects.Count) do |
|
392 begin |
|
393 Readln(f, s); // filename |
|
394 with SprayObjects.objs[i] do |
|
395 begin |
|
396 Surf:= LoadImage(Pathz[ptThemeCurrent] + '/' + s + '.png', false); |
|
397 Width:= Surf.w; |
|
398 Height:= Surf.h; |
|
399 ReadLn(f, Maxcnt) |
322 end; |
400 end; |
323 end; |
401 end; |
324 Closefile(f); |
402 Closefile(f); |
325 {$I+} |
403 {$I+} |
326 TryDo(IOResult = 0, 'Bad data or cannot access file ' + cThemeCFGFilename, true); |
404 TryDo(IOResult = 0, 'Bad data or cannot access file ' + cThemeCFGFilename, true) |
327 |
405 end; |
328 // loaded objects, try to put on land |
406 |
329 if n = 0 then exit; |
407 procedure AddThemeObjects(Surface: PSDL_Surface; var ThemeObjects: TThemeObjects; MaxCount: integer); |
|
408 var i, ii, t: integer; |
|
409 b: boolean; |
|
410 begin |
|
411 if ThemeObjects.Count = 0 then exit; |
|
412 WriteLnToConsole('Adding theme objects...'); |
330 i:= 1; |
413 i:= 1; |
331 repeat |
414 repeat |
332 t:= getrandom(n) + 1; |
415 t:= getrandom(ThemeObjects.Count); |
333 ii:= t; |
416 ii:= t; |
334 repeat |
417 repeat |
335 inc(ii); |
418 inc(ii); |
336 if ii > n then ii:= 1; |
419 if ii = ThemeObjects.Count then ii:= 0; |
337 b:= TryPut(ThemeObjects[ii], Surface) |
420 b:= TryPut(ThemeObjects.objs[ii], Surface) |
338 until b or (ii = t); |
421 until b or (ii = t); |
339 inc(i) |
422 inc(i) |
340 until (i > MaxCount) or not b |
423 until (i > MaxCount) or not b; |
341 end; |
424 end; |
342 |
425 |
343 procedure AddObjects(Surface: PSDL_Surface); |
426 procedure AddSprayObjects(Surface: PSDL_Surface; var SprayObjects: TSprayObjects; MaxCount: Longword); |
|
427 var i: Longword; |
|
428 ii, t: integer; |
|
429 b: boolean; |
|
430 begin |
|
431 if SprayObjects.Count = 0 then exit; |
|
432 WriteLnToConsole('Adding spray objects...'); |
|
433 i:= 1; |
|
434 repeat |
|
435 t:= getrandom(SprayObjects.Count); |
|
436 ii:= t; |
|
437 repeat |
|
438 inc(ii); |
|
439 if ii = SprayObjects.Count then ii:= 0; |
|
440 b:= TryPut(SprayObjects.objs[ii], Surface) |
|
441 until b or (ii = t); |
|
442 inc(i) |
|
443 until (i > MaxCount) or not b; |
|
444 end; |
|
445 |
|
446 procedure AddObjects(InSurface, Surface: PSDL_Surface); |
|
447 var ThemeObjects: TThemeObjects; |
|
448 SprayObjects: TSprayObjects; |
344 begin |
449 begin |
345 InitRects; |
450 InitRects; |
|
451 AddGirder(256, Surface); |
346 AddGirder(512, Surface); |
452 AddGirder(512, Surface); |
|
453 AddGirder(768, Surface); |
347 AddGirder(1024, Surface); |
454 AddGirder(1024, Surface); |
348 AddGirder(1300, Surface); |
455 AddGirder(1280, Surface); |
349 AddGirder(1536, Surface); |
456 AddGirder(1536, Surface); |
350 AddThemeObjects(Surface, 8); |
457 AddGirder(1792, Surface); |
|
458 ReadThemeInfo(ThemeObjects, SprayObjects); |
|
459 AddThemeObjects(Surface, ThemeObjects, 8); |
|
460 AddProgress; |
|
461 SDL_UpperBlit(InSurface, nil, Surface, nil); |
|
462 AddSprayObjects(Surface, SprayObjects, 10); |
351 FreeRects |
463 FreeRects |
352 end; |
464 end; |
353 |
465 |
354 end. |
466 end. |