hedgewars/uLand.pas
changeset 767 697728ffe39f
parent 766 cdc8f75ab7bc
child 768 2886dafa5bcf
equal deleted inserted replaced
766:cdc8f75ab7bc 767:697728ffe39f
    28      LandTexture: PTexture = nil;
    28      LandTexture: PTexture = nil;
    29 
    29 
    30 procedure GenMap;
    30 procedure GenMap;
    31 function  GenPreview: TPreview;
    31 function  GenPreview: TPreview;
    32 procedure CheckLandDigest(s: shortstring);
    32 procedure CheckLandDigest(s: shortstring);
    33 procedure UpdateLandTexture;
    33 procedure UpdateLandTexture(Y, Height: LongInt);
    34 
    34 
    35 implementation
    35 implementation
    36 uses uConsole, uStore, uMisc, uRandom, uTeams, uLandObjects, uSHA, uIO;
    36 uses uConsole, uStore, uMisc, uRandom, uTeams, uLandObjects, uSHA, uIO;
    37 
    37 
    38 type TPixAr = record
    38 type TPixAr = record
   531 AddProgress;
   531 AddProgress;
   532 SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, 0);
   532 SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, 0);
   533 AddObjects(tmpsurf, LandSurface);
   533 AddObjects(tmpsurf, LandSurface);
   534 SDL_FreeSurface(tmpsurf);
   534 SDL_FreeSurface(tmpsurf);
   535 
   535 
   536 UpdateLandTexture;
   536 UpdateLandTexture(0, 1024);
   537 AddProgress
   537 AddProgress
   538 end;
   538 end;
   539 
   539 
   540 procedure MakeFortsMap;
   540 procedure MakeFortsMap;
   541 var tmpsurf: PSDL_Surface;
   541 var tmpsurf: PSDL_Surface;
   553 
   553 
   554 tmpsurf:= LoadImage(Pathz[ptForts] + '/' + TeamsArray[1]^.FortName + 'R', false, true, true);
   554 tmpsurf:= LoadImage(Pathz[ptForts] + '/' + TeamsArray[1]^.FortName + 'R', false, true, true);
   555 BlitImageAndGenerateCollisionInfo(1024, 0, tmpsurf, LandSurface);
   555 BlitImageAndGenerateCollisionInfo(1024, 0, tmpsurf, LandSurface);
   556 SDL_FreeSurface(tmpsurf);
   556 SDL_FreeSurface(tmpsurf);
   557 
   557 
   558 UpdateLandTexture
   558 UpdateLandTexture(0, 1024)
   559 end;
   559 end;
   560 
   560 
   561 procedure LoadMap;
   561 procedure LoadMap;
   562 var x, y: Longword;
   562 var x, y: Longword;
   563     p: PByteArray;
   563     p: PByteArray;
   591      end;
   591      end;
   592 
   592 
   593 if SDL_MustLock(LandSurface) then
   593 if SDL_MustLock(LandSurface) then
   594    SDL_UnlockSurface(LandSurface);
   594    SDL_UnlockSurface(LandSurface);
   595 
   595 
   596 UpdateLandTexture
   596 UpdateLandTexture(0, 1024)
   597 end;
   597 end;
   598 
   598 
   599 procedure GenMap;
   599 procedure GenMap;
   600 begin
   600 begin
   601 if (GameFlags and gfForts) = 0 then
   601 if (GameFlags and gfForts) = 0 then
   627             end
   627             end
   628         end;
   628         end;
   629 GenPreview:= Preview
   629 GenPreview:= Preview
   630 end;
   630 end;
   631 
   631 
   632 procedure UpdateLandTexture;
   632 procedure UpdateLandTexture(Y, Height: LongInt);
   633 begin
   633 var p: pointer;
   634 if LandTexture <> nil then FreeTexture(LandTexture);
   634 begin
   635 LandTexture:= Surface2Tex(LandSurface)
   635 if LandTexture <> nil then
       
   636    begin
       
   637    if SDL_MustLock(LandSurface) then
       
   638       SDLTry(SDL_LockSurface(LandSurface) >= 0, true);
       
   639 
       
   640    glBindTexture(GL_TEXTURE_2D, LandTexture^.id);
       
   641 
       
   642    p:= @PByteArray(LandSurface^.pixels)^[LandSurface^.pitch * Y];
       
   643    glTexSubImage2D(GL_TEXTURE_2D, 0, 0, Y, 2048, Height, GL_RGBA, GL_UNSIGNED_BYTE, p);
       
   644 
       
   645    if SDL_MustLock(LandSurface) then
       
   646       SDL_UnlockSurface(LandSurface);
       
   647    end else
       
   648    LandTexture:= Surface2Tex(LandSurface)
   636 end;
   649 end;
   637 
   650 
   638 initialization
   651 initialization
   639 
   652 
   640 end.
   653 end.