296 end; |
296 end; |
297 end; |
297 end; |
298 |
298 |
299 procedure ColorizeLand(Surface: PSDL_Surface); |
299 procedure ColorizeLand(Surface: PSDL_Surface); |
300 var tmpsurf: PSDL_Surface; |
300 var tmpsurf: PSDL_Surface; |
301 r: TSDL_Rect; |
301 r, rr: TSDL_Rect; |
|
302 x, yd, yu: LongInt; |
302 begin |
303 begin |
303 tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/LandTex', false, true, false); |
304 tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/LandTex', false, true, false); |
304 r.y:= 0; |
305 r.y:= 0; |
305 while r.y < 1024 do |
306 while r.y < 1024 do |
306 begin |
307 begin |
307 r.x:= 0; |
308 r.x:= 0; |
308 while r.x < 2048 do |
309 while r.x < 2048 do |
309 begin |
310 begin |
310 SDL_UpperBlit(tmpsurf, nil, Surface, @r); |
311 SDL_UpperBlit(tmpsurf, nil, Surface, @r); |
311 inc(r.x, tmpsurf^.w) |
312 inc(r.x, tmpsurf^.w) |
312 end; |
313 end; |
313 inc(r.y, tmpsurf^.h) |
314 inc(r.y, tmpsurf^.h) |
314 end; |
315 end; |
315 SDL_FreeSurface(tmpsurf); |
316 SDL_FreeSurface(tmpsurf); |
316 |
317 |
317 |
|
318 tmpsurf:= SDL_CreateRGBSurfaceFrom(@Land, 2048, 1024, 32, 2048*4, RMask, GMask, BMask, 0); |
|
319 SDLTry(tmpsurf <> nil, true); |
|
320 SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, SDL_MapRGB(tmpsurf^.format, $FF, $FF, $FF)); |
|
321 SDL_UpperBlit(tmpsurf, nil, Surface, nil); |
|
322 SDL_FreeSurface(tmpsurf) |
|
323 end; |
|
324 |
|
325 procedure AddBorder(Surface: PSDL_Surface); |
|
326 var tmpsurf: PSDL_Surface; |
|
327 r, rr: TSDL_Rect; |
|
328 x, yd, yu: LongInt; |
|
329 begin |
|
330 tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/Border', false, true, true); |
318 tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/Border', false, true, true); |
331 for x:= 0 to 2047 do |
319 for x:= 0 to 2047 do |
332 begin |
320 begin |
333 yd:= 1023; |
321 yd:= 1023; |
334 repeat |
322 repeat |
335 while (yd > 0 ) and (Land[yd, x] = 0) do dec(yd); |
323 while (yd > 0 ) and (Land[yd, x] = 0) do dec(yd); |
336 if (yd < 0) then yd:= 0; |
324 |
337 while (yd < 1024) and (Land[yd, x] <> 0) do inc(yd); |
325 if (yd < 0) then yd:= 0; |
338 dec(yd); |
326 |
339 yu:= yd; |
327 while (yd < 1024) and (Land[yd, x] <> 0) do inc(yd); |
340 while (yu > 0 ) and (Land[yu, x] <> 0) do dec(yu); |
328 dec(yd); |
341 while (yu < yd ) and (Land[yu, x] = 0) do inc(yu); |
329 yu:= yd; |
342 if (yd < 1023) and ((yd - yu) >= 16) then |
330 |
343 begin |
331 while (yu > 0 ) and (Land[yu, x] <> 0) do dec(yu); |
344 rr.x:= x; |
332 while (yu < yd ) and (Land[yu, x] = 0) do inc(yu); |
345 rr.y:= yd - 15; |
333 |
346 r.x:= x mod tmpsurf^.w; |
334 if (yd < 1023) and ((yd - yu) >= 16) then |
347 r.y:= 16; |
335 begin |
348 r.w:= 1; |
336 rr.x:= x; |
349 r.h:= 16; |
337 rr.y:= yd - 15; |
350 SDL_UpperBlit(tmpsurf, @r, Surface, @rr); |
338 r.x:= x mod tmpsurf^.w; |
351 end; |
339 r.y:= 16; |
352 if (yu > 0) then |
340 r.w:= 1; |
353 begin |
341 r.h:= 16; |
354 rr.x:= x; |
342 SDL_UpperBlit(tmpsurf, @r, Surface, @rr); |
355 rr.y:= yu; |
343 end; |
356 r.x:= x mod tmpsurf^.w; |
344 if (yu > 0) then |
357 r.y:= 0; |
345 begin |
358 r.w:= 1; |
346 rr.x:= x; |
359 r.h:= min(16, yd - yu + 1); |
347 rr.y:= yu; |
360 SDL_UpperBlit(tmpsurf, @r, Surface, @rr); |
348 r.x:= x mod tmpsurf^.w; |
361 end; |
349 r.y:= 0; |
362 yd:= yu - 1; |
350 r.w:= 1; |
363 until yd < 0; |
351 r.h:= min(16, yd - yu + 1); |
364 end; |
352 SDL_UpperBlit(tmpsurf, @r, Surface, @rr); |
|
353 end; |
|
354 yd:= yu - 1; |
|
355 until yd < 0; |
|
356 end; |
365 end; |
357 end; |
366 |
358 |
367 procedure SetPoints(var Template: TEdgeTemplate; var pa: TPixAr); |
359 procedure SetPoints(var Template: TEdgeTemplate; var pa: TPixAr); |
368 var i: LongInt; |
360 var i: LongInt; |
369 begin |
361 begin |
506 function SelectTemplate: LongInt; |
498 function SelectTemplate: LongInt; |
507 begin |
499 begin |
508 SelectTemplate:= getrandom(Succ(High(EdgeTemplates))) |
500 SelectTemplate:= getrandom(Succ(High(EdgeTemplates))) |
509 end; |
501 end; |
510 |
502 |
511 procedure LandSurface2Land(LandSurface: PSDL_Surface); |
503 procedure LandSurface2LandPixels(Surface: PSDL_Surface); |
512 begin |
504 var x, y: LongInt; |
513 TryDo(LandSurface <> nil, 'Assert (LandSurface <> nil) failed', true); |
505 p: PLongwordArray; |
514 LandTexture:= Surface2Tex(LandSurface); |
506 begin |
515 |
507 TryDo(Surface <> nil, 'Assert (LandSurface <> nil) failed', true); |
516 if SDL_MustLock(LandSurface) then |
508 |
517 SDLTry(SDL_LockSurface(LandSurface) >= 0, true); |
509 if SDL_MustLock(Surface) then |
518 |
510 SDLTry(SDL_LockSurface(Surface) >= 0, true); |
519 Move(LandSurface^.pixels^, LandPixels, 2048 * 1024 * 4); |
511 |
520 |
512 p:= Surface^.pixels; |
521 if SDL_MustLock(LandSurface) then |
513 for y:= 0 to 1023 do |
522 SDL_UnlockSurface(LandSurface) |
514 begin |
|
515 for x:= 0 to 2047 do |
|
516 if Land[y, x] <> 0 then LandPixels[y, x]:= p^[x] or $FF000000; |
|
517 p:= @(p^[Surface^.pitch div 4]); |
|
518 end; |
|
519 |
|
520 if SDL_MustLock(Surface) then |
|
521 SDL_UnlockSurface(Surface) |
523 end; |
522 end; |
524 |
523 |
525 procedure GenLandSurface; |
524 procedure GenLandSurface; |
526 var tmpsurf: PSDL_Surface; |
525 var tmpsurf: PSDL_Surface; |
527 begin |
526 begin |
533 |
532 |
534 tmpsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, 2048, 1024, 32, RMask, GMask, BMask, 0); |
533 tmpsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, 2048, 1024, 32, RMask, GMask, BMask, 0); |
535 |
534 |
536 TryDo(tmpsurf <> nil, 'Error creating pre-land surface', true); |
535 TryDo(tmpsurf <> nil, 'Error creating pre-land surface', true); |
537 ColorizeLand(tmpsurf); |
536 ColorizeLand(tmpsurf); |
538 AddBorder(tmpsurf); |
537 |
539 |
538 LandSurface2LandPixels(tmpsurf); |
540 LandSurface2Land(tmpsurf); |
|
541 SDL_FreeSurface(tmpsurf); |
539 SDL_FreeSurface(tmpsurf); |
542 |
540 |
543 AddProgress; |
541 AddProgress; |
544 |
542 |
545 AddObjects; |
543 AddObjects; |