hedgewars/uLand.pas
changeset 1779 9d88af62a3bb
parent 1776 dd5648e250e4
child 1784 dfe9bafb4590
equal deleted inserted replaced
1778:1d9395d1e104 1779:9d88af62a3bb
    36 
    36 
    37 procedure GenMap;
    37 procedure GenMap;
    38 function  GenPreview: TPreview;
    38 function  GenPreview: TPreview;
    39 procedure CheckLandDigest(s: shortstring);
    39 procedure CheckLandDigest(s: shortstring);
    40 procedure UpdateLandTexture(Y, Height: LongInt);
    40 procedure UpdateLandTexture(Y, Height: LongInt);
       
    41 procedure RealLandTexUpdate;
    41 
    42 
    42 implementation
    43 implementation
    43 uses uConsole, uStore, uMisc, uRandom, uTeams, uLandObjects, uSHA, uIO;
    44 uses uConsole, uStore, uMisc, uRandom, uTeams, uLandObjects, uSHA, uIO;
    44 
    45 
    45 type TPixAr = record
    46 type TPixAr = record
    46               Count: Longword;
    47               Count: Longword;
    47               ar: array[0..Pred(cMaxEdgePoints)] of TPoint;
    48               ar: array[0..Pred(cMaxEdgePoints)] of TPoint;
    48               end;
    49               end;
       
    50 
       
    51 var updTopY: LongInt = LAND_HEIGHT;
       
    52     updBottomY: LongInt = 0;
    49 
    53 
    50 procedure LogLandDigest;
    54 procedure LogLandDigest;
    51 var ctx: TSHA1Context;
    55 var ctx: TSHA1Context;
    52     dig: TSHA1Digest;
    56     dig: TSHA1Digest;
    53     s: shortstring;
    57     s: shortstring;
   728 if (Height <= 0) then exit;
   732 if (Height <= 0) then exit;
   729 
   733 
   730 TryDo((Y >= 0) and (Y < LAND_HEIGHT), 'UpdateLandTexture: wrong Y parameter', true);
   734 TryDo((Y >= 0) and (Y < LAND_HEIGHT), 'UpdateLandTexture: wrong Y parameter', true);
   731 TryDo(Y + Height <= LAND_HEIGHT, 'UpdateLandTexture: wrong Height parameter', true);
   735 TryDo(Y + Height <= LAND_HEIGHT, 'UpdateLandTexture: wrong Height parameter', true);
   732 
   736 
       
   737 if Y < updTopY then updTopY:= Y;
       
   738 if Y + Height > updBottomY then updBottomY:= Y + Height
       
   739 end;
       
   740 
       
   741 procedure RealLandTexUpdate;
       
   742 begin
       
   743 if updBottomY = 0 then exit;
       
   744 
   733 if LandTexture = nil then
   745 if LandTexture = nil then
   734 	LandTexture:= NewTexture(LAND_WIDTH, LAND_HEIGHT, @LandPixels)
   746 	LandTexture:= NewTexture(LAND_WIDTH, LAND_HEIGHT, @LandPixels)
   735 else
   747 else
   736 	begin
   748 	begin
   737 	glBindTexture(GL_TEXTURE_2D, LandTexture^.id);
   749 	glBindTexture(GL_TEXTURE_2D, LandTexture^.id);
   738 	glTexSubImage2D(GL_TEXTURE_2D, 0, 0, Y, LAND_WIDTH, Height, GL_RGBA, GL_UNSIGNED_BYTE, @LandPixels[Y, 0]);
   750 	glTexSubImage2D(GL_TEXTURE_2D, 0, 0, updTopY, LAND_WIDTH, updBottomY - updTopY, GL_RGBA, GL_UNSIGNED_BYTE, @LandPixels[updTopY, 0]);
   739 	end
   751 	end;
   740 end;
   752 
       
   753 updTopY:= LAND_HEIGHT + 1;
       
   754 updBottomY:= 0
       
   755 end;
       
   756 
   741 
   757 
   742 initialization
   758 initialization
   743 
   759 
   744 end.
   760 end.