hedgewars/uLand.pas
changeset 2705 2b5625c4ec16
parent 2699 249adefa9c1c
child 2747 7889a3a9724f
equal deleted inserted replaced
2704:51cda17b7c3b 2705:2b5625c4ec16
   312 end;
   312 end;
   313 
   313 
   314 function LandBackPixel(x, y: LongInt): LongWord;
   314 function LandBackPixel(x, y: LongInt): LongWord;
   315 var p: PLongWordArray;
   315 var p: PLongWordArray;
   316 begin
   316 begin
   317 	if LandBackSurface = nil then
   317 	if LandBackSurface = nil then LandBackPixel:= 0
   318 		LandBackPixel:= 0
       
   319 	else
   318 	else
   320 	begin
   319 	begin
   321 		p:= LandBackSurface^.pixels;
   320 		p:= LandBackSurface^.pixels;
   322 		LandBackPixel:= p^[LandBackSurface^.w * (y mod LandBackSurface^.h) + (x mod LandBackSurface^.w)];// or $FF000000;
   321 		LandBackPixel:= p^[LandBackSurface^.w * (y mod LandBackSurface^.h) + (x mod LandBackSurface^.w)];// or $FF000000;
   323 	end
   322 	end
   326 procedure ColorizeLand(Surface: PSDL_Surface);
   325 procedure ColorizeLand(Surface: PSDL_Surface);
   327 var tmpsurf: PSDL_Surface;
   326 var tmpsurf: PSDL_Surface;
   328     r, rr: TSDL_Rect;
   327     r, rr: TSDL_Rect;
   329     x, yd, yu: LongInt;
   328     x, yd, yu: LongInt;
   330 begin
   329 begin
   331 tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/LandTex', ifCritical or ifIgnoreCaps);
   330 	tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/LandTex', ifCritical or ifIgnoreCaps);
   332 r.y:= 0;
   331 	r.y:= 0;
   333 while r.y < LAND_HEIGHT do
   332 	while r.y < LAND_HEIGHT do
   334 	begin
   333 	begin
   335 	r.x:= 0;
   334 		r.x:= 0;
   336 	while r.x < LAND_WIDTH do
   335 		while r.x < LAND_WIDTH do
   337 		begin
   336 		begin
   338 		SDL_UpperBlit(tmpsurf, nil, Surface, @r);
   337 			SDL_UpperBlit(tmpsurf, nil, Surface, @r);
   339 		inc(r.x, tmpsurf^.w)
   338 			inc(r.x, tmpsurf^.w)
   340 		end;
   339 		end;
   341 	inc(r.y, tmpsurf^.h)
   340 		inc(r.y, tmpsurf^.h)
   342 	end;
   341 	end;
   343 SDL_FreeSurface(tmpsurf);
   342 	SDL_FreeSurface(tmpsurf);
   344 
   343 
   345 LandBackSurface:= LoadImage(Pathz[ptCurrTheme] + '/LandBackTex', ifIgnoreCaps or ifTransparent);
   344 	// freed in free_uLand() below
   346 
   345 	LandBackSurface:= LoadImage(Pathz[ptCurrTheme] + '/LandBackTex', ifIgnoreCaps or ifTransparent);
   347 tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/Border', ifCritical or ifIgnoreCaps or ifTransparent);
   346 
   348 for x:= 0 to LAND_WIDTH - 1 do
   347 	tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/Border', ifCritical or ifIgnoreCaps or ifTransparent);
       
   348 	for x:= 0 to LAND_WIDTH - 1 do
   349 	begin
   349 	begin
   350 	yd:= LAND_HEIGHT - 1;
   350 		yd:= LAND_HEIGHT - 1;
   351 	repeat
   351 		repeat
   352 		while (yd > 0) and (Land[yd, x] =  0) do dec(yd);
   352 			while (yd > 0) and (Land[yd, x] =  0) do dec(yd);
   353 
   353 
   354 		if (yd < 0) then yd:= 0;
   354 			if (yd < 0) then yd:= 0;
   355 
   355 
   356 		while (yd < LAND_HEIGHT) and (Land[yd, x] <> 0) do inc(yd);
   356 			while (yd < LAND_HEIGHT) and (Land[yd, x] <> 0) do inc(yd);
   357 		dec(yd);
   357 			dec(yd);
   358 		yu:= yd;
   358 			yu:= yd;
   359 
   359 
   360 		while (yu > 0  ) and (Land[yu, x] <> 0) do dec(yu);
   360 			while (yu > 0  ) and (Land[yu, x] <> 0) do dec(yu);
   361 		while (yu < yd ) and (Land[yu, x] =  0) do inc(yu);
   361 			while (yu < yd ) and (Land[yu, x] =  0) do inc(yu);
   362 
   362 
   363 		if (yd < LAND_HEIGHT - 1) and ((yd - yu) >= 16) then
   363 			if (yd < LAND_HEIGHT - 1) and ((yd - yu) >= 16) then
   364 			begin
   364 			begin
   365 			rr.x:= x;
   365 				rr.x:= x;
   366 			rr.y:= yd - 15;
   366 				rr.y:= yd - 15;
   367 			r.x:= x mod tmpsurf^.w;
   367 				r.x:= x mod tmpsurf^.w;
   368 			r.y:= 16;
   368 				r.y:= 16;
   369 			r.w:= 1;
   369 				r.w:= 1;
   370 			r.h:= 16;
   370 				r.h:= 16;
   371 			SDL_UpperBlit(tmpsurf, @r, Surface, @rr);
   371 				SDL_UpperBlit(tmpsurf, @r, Surface, @rr);
   372 			end;
   372 			end;
   373 		if (yu > 0) then
   373 			if (yu > 0) then
   374 			begin
   374 			begin
   375 			rr.x:= x;
   375 				rr.x:= x;
   376 			rr.y:= yu;
   376 				rr.y:= yu;
   377 			r.x:= x mod tmpsurf^.w;
   377 				r.x:= x mod tmpsurf^.w;
   378 			r.y:= 0;
   378 				r.y:= 0;
   379 			r.w:= 1;
   379 				r.w:= 1;
   380 			r.h:= min(16, yd - yu + 1);
   380 				r.h:= min(16, yd - yu + 1);
   381 			SDL_UpperBlit(tmpsurf, @r, Surface, @rr);
   381 				SDL_UpperBlit(tmpsurf, @r, Surface, @rr);
   382 			end;
   382 			end;
   383 		yd:= yu - 1;
   383 			yd:= yu - 1;
   384 	until yd < 0;
   384 		until yd < 0;
   385 	end;
   385 	end;
       
   386 	SDL_FreeSurface(tmpsurf);
   386 end;
   387 end;
   387 
   388 
   388 procedure SetPoints(var Template: TEdgeTemplate; var pa: TPixAr);
   389 procedure SetPoints(var Template: TEdgeTemplate; var pa: TPixAr);
   389 var i: LongInt;
   390 var i: LongInt;
   390 begin
   391 begin
   636 end;
   637 end;
   637 
   638 
   638 procedure GenLandSurface;
   639 procedure GenLandSurface;
   639 var tmpsurf: PSDL_Surface;
   640 var tmpsurf: PSDL_Surface;
   640 begin
   641 begin
   641 WriteLnToConsole('Generating land...');
   642 	WriteLnToConsole('Generating land...');
   642 
   643 	GenBlank(EdgeTemplates[SelectTemplate]);
   643 GenBlank(EdgeTemplates[SelectTemplate]);
   644 	AddProgress();
   644 
   645 
   645 AddProgress;
   646 	tmpsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, LAND_WIDTH, LAND_HEIGHT, 32, RMask, GMask, BMask, 0);
   646 
   647 
   647 tmpsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, LAND_WIDTH, LAND_HEIGHT, 32, RMask, GMask, BMask, 0);
   648 	TryDo(tmpsurf <> nil, 'Error creating pre-land surface', true);
   648 
   649 	ColorizeLand(tmpsurf);
   649 TryDo(tmpsurf <> nil, 'Error creating pre-land surface', true);
   650 	AddOnLandObjects(tmpsurf);
   650 ColorizeLand(tmpsurf);
   651 
   651 AddOnLandObjects(tmpsurf);
   652 	LandSurface2LandPixels(tmpsurf);
   652 
   653 	SDL_FreeSurface(tmpsurf);
   653 LandSurface2LandPixels(tmpsurf);
   654 	AddProgress();
   654 SDL_FreeSurface(tmpsurf);
       
   655 
       
   656 AddProgress;
       
   657 
       
   658 end;
   655 end;
   659 
   656 
   660 procedure MakeFortsMap;
   657 procedure MakeFortsMap;
   661 var tmpsurf: PSDL_Surface;
   658 var tmpsurf: PSDL_Surface;
   662 begin
   659 begin
   687 procedure LoadMask;
   684 procedure LoadMask;
   688 var tmpsurf: PSDL_Surface;
   685 var tmpsurf: PSDL_Surface;
   689     p: PLongwordArray;
   686     p: PLongwordArray;
   690     x, y, cpX, cpY: Longword;
   687     x, y, cpX, cpY: Longword;
   691 begin
   688 begin
   692 tmpsurf:= LoadImage(Pathz[ptMapCurrent] + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps);
   689 	tmpsurf:= LoadImage(Pathz[ptMapCurrent] + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps);
   693 if (tmpsurf <> nil) and (tmpsurf^.w <= LAND_WIDTH) and (tmpsurf^.h <= LAND_HEIGHT) and (tmpsurf^.format^.BytesPerPixel = 4) then
   690 	if (tmpsurf <> nil) and (tmpsurf^.w <= LAND_WIDTH) and (tmpsurf^.h <= LAND_HEIGHT) and (tmpsurf^.format^.BytesPerPixel = 4) then
   694     begin
   691 	begin
   695 	cpX:= (LAND_WIDTH - tmpsurf^.w) div 2;
   692 		cpX:= (LAND_WIDTH - tmpsurf^.w) div 2;
   696 	cpY:= LAND_HEIGHT - tmpsurf^.h;
   693 		cpY:= LAND_HEIGHT - tmpsurf^.h;
   697     if SDL_MustLock(tmpsurf) then
   694 		if SDL_MustLock(tmpsurf) then
   698        SDLTry(SDL_LockSurface(tmpsurf) >= 0, true);
   695 			SDLTry(SDL_LockSurface(tmpsurf) >= 0, true);
   699 
   696 
   700     p:= tmpsurf^.pixels;
   697 			p:= tmpsurf^.pixels;
   701     for y:= 0 to Pred(tmpsurf^.h) do
   698 			for y:= 0 to Pred(tmpsurf^.h) do
   702         begin
   699 			begin
   703         for x:= 0 to Pred(tmpsurf^.w) do
   700 				for x:= 0 to Pred(tmpsurf^.w) do
   704             begin
   701 				begin
   705             if ((AMask and p^[x]) = 0) then  // Tiy was having trouble generating transparent black
   702 					if ((AMask and p^[x]) = 0) then  // Tiy was having trouble generating transparent black
   706                 Land[cpY + y, cpX + x]:= 0
   703 						Land[cpY + y, cpX + x]:= 0
   707             else if p^[x] = (AMask or RMask) then
   704 					else if p^[x] = (AMask or RMask) then
   708                 Land[cpY + y, cpX + x]:= COLOR_INDESTRUCTIBLE
   705 						Land[cpY + y, cpX + x]:= COLOR_INDESTRUCTIBLE
   709             else if p^[x] = $FFFFFFFF then
   706 					else if p^[x] = $FFFFFFFF then
   710                 Land[cpY + y, cpX + x]:= COLOR_LAND;
   707 						Land[cpY + y, cpX + x]:= COLOR_LAND;
   711 
   708 				end;
   712             end;
   709 				p:= @(p^[tmpsurf^.pitch div 4]);
   713         p:= @(p^[tmpsurf^.pitch div 4]);
   710 			end;
   714         end;
   711 
   715 
   712 		if SDL_MustLock(tmpsurf) then
   716     if SDL_MustLock(tmpsurf) then
   713 			SDL_UnlockSurface(tmpsurf);
   717        SDL_UnlockSurface(tmpsurf);
   714 	end;
   718     SDL_FreeSurface(tmpsurf);
   715 	if (tmpsurf <> nil) then 
   719     end;
   716 		SDL_FreeSurface(tmpsurf);
   720 end;
   717 end;
   721 
   718 
   722 procedure LoadMap;
   719 procedure LoadMap;
   723 var tmpsurf: PSDL_Surface;
   720 var tmpsurf: PSDL_Surface;
   724 	s: string;
   721 	s: string;
   735 Assign(f, s);
   732 Assign(f, s);
   736 Reset(f);
   733 Reset(f);
   737 Readln(f);
   734 Readln(f);
   738 if not eof(f) then Readln(f, MaxHedgehogs);
   735 if not eof(f) then Readln(f, MaxHedgehogs);
   739 
   736 
   740 if(MaxHedgehogs = 0) then MaxHedgehogs:= 18;
   737 if (MaxHedgehogs = 0) then MaxHedgehogs:= 18;
   741 
   738 
   742 playHeight:= tmpsurf^.h;
   739 playHeight:= tmpsurf^.h;
   743 playWidth:= tmpsurf^.w;
   740 playWidth:= tmpsurf^.w;
   744 leftX:= (LAND_WIDTH - playWidth) div 2;
   741 leftX:= (LAND_WIDTH - playWidth) div 2;
   745 rightX:= (playWidth + ((LAND_WIDTH - playWidth) div 2)) - 1;
   742 rightX:= (playWidth + ((LAND_WIDTH - playWidth) div 2)) - 1;