Mercurial Mercurial > hedgewars / comparison
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
hedgewars/uLandTexture.pas
changeset 7186 013deb83086b
parent 7080 dbf43c07a507
parent 7172 f68d62711a5c
child 11317 62287d4044e7
equal deleted inserted replaced
7138:f8248bcba8f1 7186:013deb83086b 
    22 interface
 
    22 interface
 
    23 uses SDLh;
 
    23 uses SDLh;
 
    24 
    24 
    25 procedure initModule;
 
    25 procedure initModule;
 
    26 procedure freeModule;
 
    26 procedure freeModule;
 
    27 procedure UpdateLandTexture(X, Width, Y, Height: LongInt);
 
    27 procedure UpdateLandTexture(X, Width, Y, Height: LongInt; landAdded: boolean);
 
    28 procedure DrawLand(dX, dY: LongInt);
 
    28 procedure DrawLand(dX, dY: LongInt);
 
    29 procedure ResetLand;
 
    29 procedure ResetLand;
 
    30 
    30 
    31 implementation
 
    31 implementation
 
    32 uses uConsts, GLunit, uTypes, uVariables, uTextures, uDebug, uRender;
 
    32 uses uConsts, GLunit, uTypes, uVariables, uTextures, uDebug, uRender;
 
    33 
    33 
    34 const TEXSIZE = 512;
 
    34 const TEXSIZE = 128;
 
    35 
    35 
    36 type TLandRecord = record
 
    36 type TLandRecord = record
 
    37             shouldUpdate: boolean;
 
    37             shouldUpdate, landAdded: boolean;
 
    38             tex: PTexture;
 
    38             tex: PTexture;
 
    39             end;
 
    39             end;
 
    40 
    40 
    41 var LandTextures: array of array of TLandRecord;
 
    41 var LandTextures: array of array of TLandRecord;
 
    42     tmpPixels: array [0..TEXSIZE - 1, 0..TEXSIZE - 1] of LongWord;
 
    42     tmpPixels: array [0..TEXSIZE - 1, 0..TEXSIZE - 1] of LongWord;
 
    60         tmpPixels[ty, tx]:= Land[y * TEXSIZE + ty, x * TEXSIZE + tx] or AMask;
 
    60         tmpPixels[ty, tx]:= Land[y * TEXSIZE + ty, x * TEXSIZE + tx] or AMask;
 
    61 
    61 
    62 Pixels2:= @tmpPixels
 
    62 Pixels2:= @tmpPixels
 
    63 end;
 
    63 end;
 
    64 
    64 
    65 procedure UpdateLandTexture(X, Width, Y, Height: LongInt);
 
    65 procedure UpdateLandTexture(X, Width, Y, Height: LongInt; landAdded: boolean);
 
    66 var tx, ty: Longword;
 
    66 var tx, ty: Longword;
 
    67 begin
 
    67 begin
 
    68     if (Width <= 0) or (Height <= 0) then
 
    68     if (Width <= 0) or (Height <= 0) then
 
    69         exit;
 
    69         exit;
 
    70     TryDo((X >= 0) and (X < LAND_WIDTH), 'UpdateLandTexture: wrong X parameter', true);
 
    70     TryDo((X >= 0) and (X < LAND_WIDTH), 'UpdateLandTexture: wrong X parameter', true);
 
    73     TryDo(Y + Height <= LAND_HEIGHT, 'UpdateLandTexture: wrong Height parameter', true);
 
    73     TryDo(Y + Height <= LAND_HEIGHT, 'UpdateLandTexture: wrong Height parameter', true);
 
    74 
    74 
    75     if (cReducedQuality and rqBlurryLand) = 0 then
 
    75     if (cReducedQuality and rqBlurryLand) = 0 then
 
    76         for ty:= Y div TEXSIZE to (Y + Height - 1) div TEXSIZE do
 
    76         for ty:= Y div TEXSIZE to (Y + Height - 1) div TEXSIZE do
 
    77             for tx:= X div TEXSIZE to (X + Width - 1) div TEXSIZE do
 
    77             for tx:= X div TEXSIZE to (X + Width - 1) div TEXSIZE do
 
    78                 LandTextures[tx, ty].shouldUpdate:= true
 
    78                 begin
 
       
    79                 LandTextures[tx, ty].shouldUpdate:= true;
 
       
    80                 LandTextures[tx, ty].landAdded:= landAdded
 
       
    81                 end
 
    79     else
 
    82     else
 
    80         for ty:= (Y div TEXSIZE) div 2 to ((Y + Height - 1) div TEXSIZE) div 2 do
 
    83         for ty:= (Y div TEXSIZE) div 2 to ((Y + Height - 1) div TEXSIZE) div 2 do
 
    81             for tx:= (X div TEXSIZE) div 2 to ((X + Width - 1) div TEXSIZE) div 2 do
 
    84             for tx:= (X div TEXSIZE) div 2 to ((X + Width - 1) div TEXSIZE) div 2 do
 
       
    85                 begin
 
    82                 LandTextures[tx, ty].shouldUpdate:= true;
 
    86                 LandTextures[tx, ty].shouldUpdate:= true;
 
       
    87                 LandTextures[tx, ty].landAdded:= landAdded
 
       
    88                 end
 
    83 end;
 
    89 end;
 
    84 
    90 
    85 procedure RealLandTexUpdate;
 
    91 procedure RealLandTexUpdate;
 
    86 var x, y: LongWord;
 
    92 var x, y, ty, tx, lx, ly : LongWord;
 
    87 begin
 
    93     isEmpty: boolean;
 
       
    94 begin
 
       
    95 (*
 
    88 if LandTextures[0, 0].tex = nil then
 
    96 if LandTextures[0, 0].tex = nil then
 
    89     for x:= 0 to LANDTEXARW -1 do
 
    97     for x:= 0 to LANDTEXARW -1 do
 
    90         for y:= 0 to LANDTEXARH - 1 do
 
    98         for y:= 0 to LANDTEXARH - 1 do
 
    91             with LandTextures[x, y] do
 
    99             with LandTextures[x, y] do
 
    92                 begin
 
   100                 begin
 
    93                 tex:= NewTexture(TEXSIZE, TEXSIZE, Pixels(x, y));
 
   101                 tex:= NewTexture(TEXSIZE, TEXSIZE, Pixels(x, y));
 
    94                 glBindTexture(GL_TEXTURE_2D, tex^.atlas^.id);
 
   102                 glBindTexture(GL_TEXTURE_2D, tex^.atlas^.id);
 
    95                 glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_PRIORITY, tpHigh);
 
   103                 glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_PRIORITY, tpHigh);
 
    96                 end
 
   104                 end
 
    97 else
 
   105 else
 
       
   106 *)
 
    98     for x:= 0 to LANDTEXARW -1 do
 
   107     for x:= 0 to LANDTEXARW -1 do
 
    99         for y:= 0 to LANDTEXARH - 1 do
 
   108         for y:= 0 to LANDTEXARH - 1 do
 
   100             with LandTextures[x, y] do
 
   109             with LandTextures[x, y] do
 
   101                 if shouldUpdate then
 
   110                 if shouldUpdate then
 
   102                     begin
 
   111                     begin
 
   103                     shouldUpdate:= false;
 
   112                     shouldUpdate:= false;
 
   104                     glBindTexture(GL_TEXTURE_2D, tex^.atlas^.id);
 
   113                     isEmpty:= not landAdded;
 
   105                     glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, TEXSIZE, TEXSIZE, 0, GL_RGBA, GL_UNSIGNED_BYTE, Pixels(x,y));
 
   114                     landAdded:= false;
 
       
   115                     ty:= 0;
 
       
   116                     tx:= 1;
 
       
   117                     ly:= y * TEXSIZE;
 
       
   118                     lx:= x * TEXSIZE;
 
       
   119                     // first check edges
 
       
   120                     while isEmpty and (ty < TEXSIZE) do
 
       
   121                         begin
 
       
   122                         isEmpty:= LandPixels[ly + ty, lx] and AMask = 0;
 
       
   123                         if isEmpty then isEmpty:= LandPixels[ly + ty, lx + TEXSIZE-1] and AMask = 0;
 
       
   124                         inc(ty)
 
       
   125                         end;
 
       
   126                     while isEmpty and (tx < TEXSIZE-1) do
 
       
   127                         begin
 
       
   128                         isEmpty:= LandPixels[ly, lx + tx] and AMask = 0;
 
       
   129                         if isEmpty then isEmpty:= LandPixels[ly + TEXSIZE-1, lx + tx] and AMask = 0;
 
       
   130                         inc(tx)
 
       
   131                         end;
 
       
   132                     // then search every other remaining. does this sort of stuff defeat compiler opts?
 
       
   133                     ty:= 2;
 
       
   134                     while isEmpty and (ty < TEXSIZE-1) do
 
       
   135                         begin
 
       
   136                         tx:= 2;
 
       
   137                         while isEmpty and (tx < TEXSIZE-1) do
 
       
   138                             begin
 
       
   139                             isEmpty:= LandPixels[ly + ty, lx + tx] and AMask = 0;
 
       
   140                             inc(tx,2)
 
       
   141                             end;
 
       
   142                         inc(ty,2);
 
       
   143                         end;
 
       
   144                     // and repeat
 
       
   145                     ty:= 1;
 
       
   146                     while isEmpty and (ty < TEXSIZE-1) do
 
       
   147                         begin
 
       
   148                         tx:= 1;
 
       
   149                         while isEmpty and (tx < TEXSIZE-1) do
 
       
   150                             begin
 
       
   151                             isEmpty:= LandPixels[ly + ty, lx + tx] and AMask = 0;
 
       
   152                             inc(tx,2)
 
       
   153                             end;
 
       
   154                         inc(ty,2);
 
       
   155                         end;
 
       
   156                     if not isEmpty then
 
       
   157                         begin
 
       
   158                         if tex = nil then tex:= NewTexture(TEXSIZE, TEXSIZE, Pixels(x, y));
 
       
   159                         glBindTexture(GL_TEXTURE_2D, tex^.atlas^.id);
 
       
   160                         glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, TEXSIZE, TEXSIZE, 0, GL_RGBA, GL_UNSIGNED_BYTE, Pixels(x,y));
 
       
   161                         end
 
       
   162                     else if tex <> nil then
 
       
   163                         begin
 
       
   164                         FreeTexture(tex);
 
       
   165                         tex:= nil
 
       
   166                         end;
 
   106                     end
 
   167                     end
 
   107 end;
 
   168 end;
 
   108 
   169 
   109 procedure DrawLand(dX, dY: LongInt);
 
   170 procedure DrawLand(dX, dY: LongInt);
 
   110 var x, y: LongInt;
 
   171 var x, y: LongInt;
 
   112 RealLandTexUpdate;
 
   173 RealLandTexUpdate;
 
   113 
   174 
   114 for x:= 0 to LANDTEXARW -1 do
 
   175 for x:= 0 to LANDTEXARW -1 do
 
   115     for y:= 0 to LANDTEXARH - 1 do
 
   176     for y:= 0 to LANDTEXARH - 1 do
 
   116         with LandTextures[x, y] do
 
   177         with LandTextures[x, y] do
 
   117             if (cReducedQuality and rqBlurryLand) = 0 then
 
   178             if tex <> nil then
 
   118                 DrawTexture(dX + x * TEXSIZE, dY + y * TEXSIZE, tex)
 
   179                 if (cReducedQuality and rqBlurryLand) = 0 then
 
   119             else
 
   180                     DrawTexture(dX + x * TEXSIZE, dY + y * TEXSIZE, tex)
 
   120                 DrawTexture(dX + x * TEXSIZE * 2, dY + y * TEXSIZE * 2, tex, 2.0)
 
   181                 else
 
       
   182                     DrawTexture(dX + x * TEXSIZE * 2, dY + y * TEXSIZE * 2, tex, 2.0)
 
   121 
   183 
   122 end;
 
   184 end;
 
   123 
   185 
   124 procedure initModule;
 
   186 procedure initModule;
 
   125 begin
 
   187 begin
 
   142 begin
 
   204 begin
 
   143     for x:= 0 to LANDTEXARW - 1 do
 
   205     for x:= 0 to LANDTEXARW - 1 do
 
   144         for y:= 0 to LANDTEXARH - 1 do
 
   206         for y:= 0 to LANDTEXARH - 1 do
 
   145             with LandTextures[x, y] do
 
   207             with LandTextures[x, y] do
 
   146                 begin
 
   208                 begin
 
   147                 FreeTexture(tex);
 
   209                 if tex <> nil then
 
   148                 tex:= nil;
 
   210                     begin
 
       
   211                     FreeTexture(tex);
 
       
   212                     tex:= nil
 
       
   213                     end
 
   149                 end;
 
   214                 end;
 
   150 end;
 
   215 end;
 
   151 
   216 
   152 procedure freeModule;
 
   217 procedure freeModule;
 
   153 begin
 
   218 begin
 
   154     ResetLand;
 
   219     ResetLand;
 
   155     if LandBackSurface <> nil then
 
   220     if LandBackSurface <> nil then
 
   156         SDL_FreeSurface(LandBackSurface);
 
   221         SDL_FreeSurface(LandBackSurface);
 
   157     LandBackSurface:= nil;
 
   222     LandBackSurface:= nil;
 
   158     LandTextures:= nil;
 
   223     SetLength(LandTextures, 0, 0);
 
   159 end;
 
   224 end;
 
   160 end.
 
   225 end.
hedgewars