hedgewars/uLand.pas
changeset 1760 55a1edd97911
parent 1754 a37392548124
child 1767 d0560fe17932
equal deleted inserted replaced
1759:88b0cf9d6de5 1760:55a1edd97911
    18 
    18 
    19 unit uLand;
    19 unit uLand;
    20 interface
    20 interface
    21 uses SDLh, uLandTemplates, uFloat, GL, uConsts;
    21 uses SDLh, uLandTemplates, uFloat, GL, uConsts;
    22 {$include options.inc}
    22 {$include options.inc}
    23 type TLandArray = packed array[0..LAND_HEIGHT, 0..LAND_WIDTH] of LongWord;
    23 type TLandArray = packed array[0 .. LAND_HEIGHT - 1, 0 .. LAND_WIDTH - 1] of LongWord;
    24      TPreview = packed array[0..127, 0..31] of byte;
    24 	TPreview  = packed array[0..127, 0..31] of byte;
    25      TDirtyTag = packed array[0..63, 0..127] of byte;
    25 	TDirtyTag = packed array[0 .. LAND_HEIGHT div 32 - 1, 0 .. LAND_WIDTH div 32 - 1] of byte;
    26 
    26 
    27 var  Land: TLandArray;
    27 var  Land: TLandArray;
    28      LandPixels: TLandArray;
    28      LandPixels: TLandArray;
    29      LandTexture: PTexture = nil;
    29      LandTexture: PTexture = nil;
    30      LandDirty: TDirtyTag;
    30      LandDirty: TDirtyTag;
   243 
   243 
   244     procedure Push(_xl, _xr, _y, _dir: LongInt);
   244     procedure Push(_xl, _xr, _y, _dir: LongInt);
   245     begin
   245     begin
   246     TryDo(Stack.Count <= 8192, 'FillLand: stack overflow', true);
   246     TryDo(Stack.Count <= 8192, 'FillLand: stack overflow', true);
   247     _y:= _y + _dir;
   247     _y:= _y + _dir;
   248     if (_y < 0) or (_y > LAND_HEIGHT) then exit;
   248     if (_y < 0) or (_y >= LAND_HEIGHT) then exit;
   249     with Stack.points[Stack.Count] do
   249     with Stack.points[Stack.Count] do
   250          begin
   250          begin
   251          xl:= _xl;
   251          xl:= _xl;
   252          xr:= _xr;
   252          xr:= _xr;
   253          y:= _y;
   253          y:= _y;
   277 Push(xl, xr, y,  1);
   277 Push(xl, xr, y,  1);
   278 while Stack.Count > 0 do
   278 while Stack.Count > 0 do
   279       begin
   279       begin
   280       Pop(xl, xr, y, dir);
   280       Pop(xl, xr, y, dir);
   281       while (xl > 0) and (Land[y, xl] <> 0) do dec(xl);
   281       while (xl > 0) and (Land[y, xl] <> 0) do dec(xl);
   282       while (xr < LAND_WIDTH) and (Land[y, xr] <> 0) do inc(xr);
   282       while (xr < LAND_WIDTH - 1) and (Land[y, xr] <> 0) do inc(xr);
   283       while (xl < xr) do
   283       while (xl < xr) do
   284             begin
   284             begin
   285             while (xl <= xr) and (Land[y, xl] = 0) do inc(xl);
   285             while (xl <= xr) and (Land[y, xl] = 0) do inc(xl);
   286             x:= xl;
   286             x:= xl;
   287             while (xl <= xr) and (Land[y, xl] <> 0) do
   287             while (xl <= xr) and (Land[y, xl] <> 0) do
   303     r, rr: TSDL_Rect;
   303     r, rr: TSDL_Rect;
   304     x, yd, yu: LongInt;
   304     x, yd, yu: LongInt;
   305 begin
   305 begin
   306 tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/LandTex', false, true, false);
   306 tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/LandTex', false, true, false);
   307 r.y:= 0;
   307 r.y:= 0;
   308 while r.y < 2048 do
   308 while r.y < LAND_HEIGHT do
   309 	begin
   309 	begin
   310 	r.x:= 0;
   310 	r.x:= 0;
   311 	while r.x <= LAND_WIDTH do
   311 	while r.x < LAND_WIDTH do
   312 		begin
   312 		begin
   313 		SDL_UpperBlit(tmpsurf, nil, Surface, @r);
   313 		SDL_UpperBlit(tmpsurf, nil, Surface, @r);
   314 		inc(r.x, tmpsurf^.w)
   314 		inc(r.x, tmpsurf^.w)
   315 		end;
   315 		end;
   316 	inc(r.y, tmpsurf^.h)
   316 	inc(r.y, tmpsurf^.h)
   317 	end;
   317 	end;
   318 SDL_FreeSurface(tmpsurf);
   318 SDL_FreeSurface(tmpsurf);
   319 
   319 
   320 tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/Border', false, true, true);
   320 tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/Border', false, true, true);
   321 for x:= 0 to 4095 do
   321 for x:= 0 to LAND_WIDTH - 1 do
   322 	begin
   322 	begin
   323 	yd:= LAND_HEIGHT;
   323 	yd:= LAND_HEIGHT - 1;
   324 	repeat
   324 	repeat
   325 		while (yd > 0   ) and (Land[yd, x] =  0) do dec(yd);
   325 		while (yd > 0) and (Land[yd, x] =  0) do dec(yd);
   326 		
   326 		
   327 		if (yd < 0) then yd:= 0;
   327 		if (yd < 0) then yd:= 0;
   328 
   328 
   329 		while (yd <= LAND_HEIGHT) and (Land[yd, x] <> 0) do inc(yd);
   329 		while (yd < LAND_HEIGHT) and (Land[yd, x] <> 0) do inc(yd);
   330 		dec(yd);
   330 		dec(yd);
   331 		yu:= yd;
   331 		yu:= yd;
   332 		
   332 		
   333 		while (yu > 0  ) and (Land[yu, x] <> 0) do dec(yu);
   333 		while (yu > 0  ) and (Land[yu, x] <> 0) do dec(yu);
   334 		while (yu < yd ) and (Land[yu, x] =  0) do inc(yu);
   334 		while (yu < yd ) and (Land[yu, x] =  0) do inc(yu);
   335 		
   335 		
   336 		if (yd < LAND_HEIGHT) and ((yd - yu) >= 16) then
   336 		if (yd < LAND_HEIGHT - 1) and ((yd - yu) >= 16) then
   337 			begin
   337 			begin
   338 			rr.x:= x;
   338 			rr.x:= x;
   339 			rr.y:= yd - 15;
   339 			rr.y:= yd - 15;
   340 			r.x:= x mod tmpsurf^.w;
   340 			r.x:= x mod tmpsurf^.w;
   341 			r.y:= 16;
   341 			r.y:= 16;
   373      if canMirror then
   373      if canMirror then
   374         if getrandom(2) = 0 then
   374         if getrandom(2) = 0 then
   375            begin
   375            begin
   376            for i:= 0 to pred(BasePointsCount) do
   376            for i:= 0 to pred(BasePointsCount) do
   377              if pa.ar[i].x <> NTPX then
   377              if pa.ar[i].x <> NTPX then
   378                pa.ar[i].x:= LAND_WIDTH - pa.ar[i].x;
   378                pa.ar[i].x:= LAND_WIDTH - 1 - pa.ar[i].x;
   379            for i:= 0 to pred(FillPointsCount) do
   379            for i:= 0 to pred(FillPointsCount) do
   380                FillPoints^[i].x:= LAND_WIDTH - FillPoints^[i].x;
   380                FillPoints^[i].x:= LAND_WIDTH - 1 - FillPoints^[i].x;
   381            end;
   381            end;
   382 
   382 
   383      if canFlip then
   383      if canFlip then
   384         if getrandom(2) = 0 then
   384         if getrandom(2) = 0 then
   385            begin
   385            begin
   386            for i:= 0 to pred(BasePointsCount) do
   386            for i:= 0 to pred(BasePointsCount) do
   387                pa.ar[i].y:= LAND_HEIGHT - pa.ar[i].y;
   387                pa.ar[i].y:= LAND_HEIGHT - 1 - pa.ar[i].y;
   388            for i:= 0 to pred(FillPointsCount) do
   388            for i:= 0 to pred(FillPointsCount) do
   389                FillPoints^[i].y:= LAND_HEIGHT - FillPoints^[i].y;
   389                FillPoints^[i].y:= LAND_HEIGHT - 1 - FillPoints^[i].y;
   390            end;
   390            end;
   391      end
   391      end
   392 end;
   392 end;
   393 
   393 
   394 function CheckIntersect(V1, V2, V3, V4: TPoint): boolean;
   394 function CheckIntersect(V1, V2, V3, V4: TPoint): boolean;
   438 radz[0]:= 0;
   438 radz[0]:= 0;
   439 for i:= 0 to Pred(pa.Count) do
   439 for i:= 0 to Pred(pa.Count) do
   440   with pa.ar[i] do
   440   with pa.ar[i] do
   441     if x <> NTPX then
   441     if x <> NTPX then
   442       begin
   442       begin
   443       radz[i]:= Min(Max(x - cEdge, 0), Max(LAND_WIDTH + 1 - cEdge - x, 0));
   443       radz[i]:= Min(Max(x - cEdge, 0), Max(LAND_WIDTH - cEdge - x, 0));
   444       radz[i]:= Min(radz[i], Min(Max(y - cEdge, 0), Max(LAND_HEIGHT + 1 - cEdge - y, 0)));
   444       radz[i]:= Min(radz[i], Min(Max(y - cEdge, 0), Max(LAND_HEIGHT - cEdge - y, 0)));
   445       if radz[i] > 0 then
   445       if radz[i] > 0 then
   446         for k:= 0 to Pred(i) do
   446         for k:= 0 to Pred(i) do
   447           begin
   447           begin
   448           dist:= Max(abs(x - pa.ar[k].x), abs(y - pa.ar[k].y));
   448           dist:= Max(abs(x - pa.ar[k].x), abs(y - pa.ar[k].y));
   449           radz[k]:= Max(0, Min((dist - cMinDist) div 2, radz[k]));
   449           radz[k]:= Max(0, Min((dist - cMinDist) div 2, radz[k]));
   471 procedure GenBlank(var Template: TEdgeTemplate);
   471 procedure GenBlank(var Template: TEdgeTemplate);
   472 var pa: TPixAr;
   472 var pa: TPixAr;
   473     i: Longword;
   473     i: Longword;
   474     y, x: Longword;
   474     y, x: Longword;
   475 begin
   475 begin
   476 for y:= 0 to LAND_HEIGHT do
   476 for y:= 0 to LAND_HEIGHT - 1 do
   477     for x:= 0 to LAND_WIDTH do
   477     for x:= 0 to LAND_WIDTH - 1 do
   478         Land[y, x]:= COLOR_LAND;
   478         Land[y, x]:= COLOR_LAND;
   479 
   479 
   480 SetPoints(Template, pa);
   480 SetPoints(Template, pa);
   481 for i:= 1 to Template.BezierizeCount do
   481 for i:= 1 to Template.BezierizeCount do
   482     begin
   482     begin
   510 
   510 
   511 if SDL_MustLock(Surface) then
   511 if SDL_MustLock(Surface) then
   512 	SDLTry(SDL_LockSurface(Surface) >= 0, true);
   512 	SDLTry(SDL_LockSurface(Surface) >= 0, true);
   513 
   513 
   514 p:= Surface^.pixels;
   514 p:= Surface^.pixels;
   515 for y:= 0 to LAND_HEIGHT do
   515 for y:= 0 to LAND_HEIGHT - 1 do
   516 	begin
   516 	begin
   517 	for x:= 0 to LAND_WIDTH do
   517 	for x:= 0 to LAND_WIDTH - 1 do
   518 		if Land[y, x] <> 0 then LandPixels[y, x]:= p^[x] or $FF000000;
   518 		if Land[y, x] <> 0 then LandPixels[y, x]:= p^[x] or $FF000000;
       
   519 		
   519 	p:= @(p^[Surface^.pitch div 4]);
   520 	p:= @(p^[Surface^.pitch div 4]);
   520 	end;
   521 	end;
   521 
   522 
   522 if SDL_MustLock(Surface) then
   523 if SDL_MustLock(Surface) then
   523 	SDL_UnlockSurface(Surface);
   524 	SDL_UnlockSurface(Surface);
   530 
   531 
   531 GenBlank(EdgeTemplates[SelectTemplate]);
   532 GenBlank(EdgeTemplates[SelectTemplate]);
   532 
   533 
   533 AddProgress;
   534 AddProgress;
   534 
   535 
   535 tmpsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, LAND_WIDTH+1, LAND_HEIGHT+1, 32, RMask, GMask, BMask, 0);
   536 tmpsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, LAND_WIDTH, LAND_HEIGHT, 32, RMask, GMask, BMask, 0);
   536 
   537 
   537 TryDo(tmpsurf <> nil, 'Error creating pre-land surface', true);
   538 TryDo(tmpsurf <> nil, 'Error creating pre-land surface', true);
   538 ColorizeLand(tmpsurf);
   539 ColorizeLand(tmpsurf);
   539 AddOnLandObjects(tmpsurf);
   540 AddOnLandObjects(tmpsurf);
   540 
   541 
   552 var tmpsurf: PSDL_Surface;
   553 var tmpsurf: PSDL_Surface;
   553 begin
   554 begin
   554 WriteLnToConsole('Generating forts land...');
   555 WriteLnToConsole('Generating forts land...');
   555 
   556 
   556 tmpsurf:= LoadImage(Pathz[ptForts] + '/' + ClansArray[0]^.Teams[0]^.FortName + 'L', true, true, true);
   557 tmpsurf:= LoadImage(Pathz[ptForts] + '/' + ClansArray[0]^.Teams[0]^.FortName + 'L', true, true, true);
   557 BlitImageAndGenerateCollisionInfo(0, 0, LAND_WIDTH+1, tmpsurf);
   558 BlitImageAndGenerateCollisionInfo(0, 0, LAND_HEIGHT, tmpsurf);
   558 SDL_FreeSurface(tmpsurf);
   559 SDL_FreeSurface(tmpsurf);
   559 
   560 
   560 tmpsurf:= LoadImage(Pathz[ptForts] + '/' + ClansArray[1]^.Teams[0]^.FortName + 'R', true, true, true);
   561 tmpsurf:= LoadImage(Pathz[ptForts] + '/' + ClansArray[1]^.Teams[0]^.FortName + 'R', true, true, true);
   561 BlitImageAndGenerateCollisionInfo(2048, 0, LAND_WIDTH+1, tmpsurf);
   562 BlitImageAndGenerateCollisionInfo(LAND_WIDTH - 1024, 0, LAND_HEIGHT, tmpsurf);
   562 SDL_FreeSurface(tmpsurf);
   563 SDL_FreeSurface(tmpsurf);
   563 
       
   564 end;
   564 end;
   565 
   565 
   566 procedure LoadMap;
   566 procedure LoadMap;
   567 var tmpsurf: PSDL_Surface;
   567 var tmpsurf: PSDL_Surface;
   568 begin
   568 begin
   569 WriteLnToConsole('Loading land from file...');
   569 WriteLnToConsole('Loading land from file...');
   570 AddProgress;
   570 AddProgress;
   571 tmpsurf:= LoadImage(Pathz[ptMapCurrent] + '/map', true, true, true);
   571 tmpsurf:= LoadImage(Pathz[ptMapCurrent] + '/map', true, true, true);
   572 TryDo((tmpsurf^.w = LAND_WIDTH+1) and (tmpsurf^.h = LAND_HEIGHT+1), 'Map dimensions should be 4096x2048!', true);
   572 TryDo((tmpsurf^.w <= LAND_WIDTH) and (tmpsurf^.h <= LAND_HEIGHT), 'Map dimensions too big!', true);
   573 
   573 
   574 TryDo(tmpsurf^.format^.BytesPerPixel = 4, 'Map should be 32bit', true);
   574 TryDo(tmpsurf^.format^.BytesPerPixel = 4, 'Map should be 32bit', true);
   575 
   575 
   576 BlitImageAndGenerateCollisionInfo(0, 0, LAND_WIDTH+1, tmpsurf);
   576 BlitImageAndGenerateCollisionInfo(0, 0, LAND_WIDTH, tmpsurf);
   577 SDL_FreeSurface(tmpsurf);
   577 SDL_FreeSurface(tmpsurf);
   578 
   578 
   579 end;
   579 end;
   580 
   580 
   581 procedure GenMap;
   581 procedure GenMap;
   582 var x, y: LongInt;
       
   583     c: LongWord;
       
   584 begin
   582 begin
   585 LoadThemeConfig;
   583 LoadThemeConfig;
   586 
   584 
   587 if (GameFlags and gfForts) = 0 then
   585 if (GameFlags and gfForts) = 0 then
   588    if Pathz[ptMapCurrent] <> '' then LoadMap
   586    if Pathz[ptMapCurrent] <> '' then LoadMap
   589                                 else GenLandSurface
   587                                 else GenLandSurface
   590                                else MakeFortsMap;
   588                                else MakeFortsMap;
   591 AddProgress;
   589 AddProgress;
       
   590 
   592 {$IFDEF DEBUGFILE}LogLandDigest;{$ENDIF}
   591 {$IFDEF DEBUGFILE}LogLandDigest;{$ENDIF}
   593 
       
   594 for y:= 0 to 63 do
       
   595 	for x:= 0 to 127 do
       
   596 	    LandDirty[y, x]:= 0;  // TODO - ask unC0Rr why he took this out of merge - doesn't it need initialising? seems random values could result in some unintended smoothing of initial map edges. also be slower.
       
   597 
       
   598 // experiment hardcoding cave
       
   599 for y:= 0 to LAND_HEIGHT do
       
   600     begin
       
   601     Land[y, 0]:= COLOR_INDESTRUCTIBLE;
       
   602     Land[y, 1]:= COLOR_INDESTRUCTIBLE;
       
   603     Land[y, 2]:= COLOR_INDESTRUCTIBLE;
       
   604     Land[y, LAND_WIDTH-2]:= COLOR_INDESTRUCTIBLE;
       
   605     Land[y, LAND_WIDTH-1]:= COLOR_INDESTRUCTIBLE;
       
   606     Land[y, LAND_WIDTH]:= COLOR_INDESTRUCTIBLE;
       
   607     if y mod 32 < 16 then c:= $FF000000
       
   608     else c:= $FF00FFFF;   
       
   609     LandPixels[y, 0]:= c;           
       
   610     LandPixels[y, 1]:= c;           
       
   611     LandPixels[y, 2]:= c;           
       
   612     LandPixels[y, LAND_WIDTH-2]:= c;           
       
   613     LandPixels[y, LAND_WIDTH-1]:= c;           
       
   614     LandPixels[y, LAND_WIDTH]:= c;           
       
   615     end;
       
   616 
       
   617 for x:= 0 to LAND_WIDTH do
       
   618     begin
       
   619     Land[0, x]:= COLOR_INDESTRUCTIBLE;
       
   620     Land[1, x]:= COLOR_INDESTRUCTIBLE;
       
   621     Land[2, x]:= COLOR_INDESTRUCTIBLE;
       
   622     if x mod 32 < 16 then c:= $FF000000
       
   623     else c:= $FF00FFFF;   
       
   624     LandPixels[0, x]:= c;           
       
   625     LandPixels[1, x]:= c;           
       
   626     LandPixels[2, x]:= c;           
       
   627     end;
       
   628 
   592 
   629 UpdateLandTexture(0, LAND_HEIGHT);
   593 UpdateLandTexture(0, LAND_HEIGHT);
   630 end;
   594 end;
   631 
   595 
   632 function GenPreview: TPreview;
   596 function GenPreview: TPreview;
   641         begin
   605         begin
   642         Preview[y, x]:= 0;
   606         Preview[y, x]:= 0;
   643         for bit:= 0 to 7 do
   607         for bit:= 0 to 7 do
   644             begin
   608             begin
   645             t:= 0;
   609             t:= 0;
   646             for yy:= y * 16 to y * 16 + 7 do
   610             for yy:= y * (LAND_HEIGHT div 128) to y * (LAND_HEIGHT div 128) + 7 do
   647                 for xx:= x * 128 + bit * 8 to x * 128 + bit * 8 + 7 do
   611                 for xx:= x * (LAND_WIDTH div 32) + bit * 8 to x * (LAND_WIDTH div 32) + bit * 8 + 7 do
   648                     if Land[yy, xx] <> 0 then inc(t);
   612                     if Land[yy, xx] <> 0 then inc(t);
   649             if t > 8 then Preview[y, x]:= Preview[y, x] or ($80 shr bit)
   613             if t > 8 then Preview[y, x]:= Preview[y, x] or ($80 shr bit)
   650             end
   614             end
   651         end;
   615         end;
   652 GenPreview:= Preview
   616 GenPreview:= Preview
   653 end;
   617 end;
   654 
   618 
   655 procedure UpdateLandTexture(Y, Height: LongInt);
   619 procedure UpdateLandTexture(Y, Height: LongInt);
   656 begin
   620 begin
   657 if (Height <= 0) then exit;
   621 if (Height <= 0) then exit;
   658 TryDo((Y >= 0) and (Y <= LAND_HEIGHT), 'UpdateLandTexture: wrong Y parameter', true);
   622 
   659 TryDo(Y + Height <= LAND_WIDTH, 'UpdateLandTexture: wrong Height parameter', true);
   623 TryDo((Y >= 0) and (Y < LAND_HEIGHT), 'UpdateLandTexture: wrong Y parameter', true);
       
   624 TryDo(Y + Height <= LAND_HEIGHT, 'UpdateLandTexture: wrong Height parameter', true);
   660 
   625 
   661 if LandTexture = nil then
   626 if LandTexture = nil then
   662 	LandTexture:= NewTexture(LAND_WIDTH+1, LAND_HEIGHT+1, @LandPixels)
   627 	LandTexture:= NewTexture(LAND_WIDTH, LAND_HEIGHT, @LandPixels)
   663 else
   628 else
   664 	begin
   629 	begin
   665 	glBindTexture(GL_TEXTURE_2D, LandTexture^.id);
   630 	glBindTexture(GL_TEXTURE_2D, LandTexture^.id);
   666 	glTexSubImage2D(GL_TEXTURE_2D, 0, 0, Y, LAND_WIDTH+1, Height, GL_RGBA, GL_UNSIGNED_BYTE, @LandPixels[Y, 0]);
   631 	glTexSubImage2D(GL_TEXTURE_2D, 0, 0, Y, LAND_WIDTH, Height, GL_RGBA, GL_UNSIGNED_BYTE, @LandPixels[Y, 0]);
   667 	end
   632 	end
   668 end;
   633 end;
   669 
   634 
   670 initialization
   635 initialization
   671 
   636