hedgewars/uTextures.pas
changeset 4375 ae5507ddb989
child 4377 43945842da0c
equal deleted inserted replaced
4374:bcefeeabaa33 4375:ae5507ddb989
       
     1 {$INCLUDE "options.inc"}
       
     2 
       
     3 unit uTextures;
       
     4 interface
       
     5 uses SDLh, uTypes;
       
     6 
       
     7 function  NewTexture(width, height: Longword; buf: Pointer): PTexture;
       
     8 function  Surface2Tex(surf: PSDL_Surface; enableClamp: boolean): PTexture;
       
     9 procedure FreeTexture(tex: PTexture);
       
    10 
       
    11 procedure initModule;
       
    12 procedure freeModule;
       
    13 
       
    14 implementation
       
    15 uses GLunit, uUtils, uVariables, uConsts, uMisc;
       
    16 
       
    17 var TextureList: PTexture;
       
    18 
       
    19 
       
    20 procedure SetTextureParameters(enableClamp: Boolean);
       
    21 begin
       
    22     if enableClamp and ((cReducedQuality and rqClampLess) = 0) then
       
    23     begin
       
    24         glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
       
    25         glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE)
       
    26     end;
       
    27     glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
       
    28     glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR)
       
    29 end;
       
    30 
       
    31 procedure ResetVertexArrays(texture: PTexture);
       
    32 begin
       
    33 with texture^ do
       
    34     begin
       
    35     vb[0].X:= 0;
       
    36     vb[0].Y:= 0;
       
    37     vb[1].X:= w;
       
    38     vb[1].Y:= 0;
       
    39     vb[2].X:= w;
       
    40     vb[2].Y:= h;
       
    41     vb[3].X:= 0;
       
    42     vb[3].Y:= h;
       
    43 
       
    44     tb[0].X:= 0;
       
    45     tb[0].Y:= 0;
       
    46     tb[1].X:= rx;
       
    47     tb[1].Y:= 0;
       
    48     tb[2].X:= rx;
       
    49     tb[2].Y:= ry;
       
    50     tb[3].X:= 0;
       
    51     tb[3].Y:= ry
       
    52     end;
       
    53 end;
       
    54 
       
    55 function NewTexture(width, height: Longword; buf: Pointer): PTexture;
       
    56 begin
       
    57 new(NewTexture);
       
    58 NewTexture^.PrevTexture:= nil;
       
    59 NewTexture^.NextTexture:= nil;
       
    60 NewTexture^.Scale:= 1;
       
    61 if TextureList <> nil then
       
    62     begin
       
    63     TextureList^.PrevTexture:= NewTexture;
       
    64     NewTexture^.NextTexture:= TextureList
       
    65     end;
       
    66 TextureList:= NewTexture;
       
    67 
       
    68 NewTexture^.w:= width;
       
    69 NewTexture^.h:= height;
       
    70 NewTexture^.rx:= 1.0;
       
    71 NewTexture^.ry:= 1.0;
       
    72 
       
    73 ResetVertexArrays(NewTexture);
       
    74 
       
    75 glGenTextures(1, @NewTexture^.id);
       
    76 
       
    77 glBindTexture(GL_TEXTURE_2D, NewTexture^.id);
       
    78 glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, width, height, 0, GL_RGBA, GL_UNSIGNED_BYTE, buf);
       
    79 
       
    80 SetTextureParameters(true);
       
    81 end;
       
    82 
       
    83 function Surface2Tex(surf: PSDL_Surface; enableClamp: boolean): PTexture;
       
    84 var tw, th, x, y: Longword;
       
    85     tmpp: pointer;
       
    86     fromP4, toP4: PLongWordArray;
       
    87 begin
       
    88 new(Surface2Tex);
       
    89 Surface2Tex^.PrevTexture:= nil;
       
    90 Surface2Tex^.NextTexture:= nil;
       
    91 if TextureList <> nil then
       
    92     begin
       
    93     TextureList^.PrevTexture:= Surface2Tex;
       
    94     Surface2Tex^.NextTexture:= TextureList
       
    95     end;
       
    96 TextureList:= Surface2Tex;
       
    97 
       
    98 Surface2Tex^.w:= surf^.w;
       
    99 Surface2Tex^.h:= surf^.h;
       
   100 
       
   101 if (surf^.format^.BytesPerPixel <> 4) then
       
   102     begin
       
   103     TryDo(false, 'Surface2Tex failed, expecting 32 bit surface', true);
       
   104     Surface2Tex^.id:= 0;
       
   105     exit
       
   106     end;
       
   107 
       
   108 
       
   109 glGenTextures(1, @Surface2Tex^.id);
       
   110 
       
   111 glBindTexture(GL_TEXTURE_2D, Surface2Tex^.id);
       
   112 
       
   113 if SDL_MustLock(surf) then
       
   114     SDLTry(SDL_LockSurface(surf) >= 0, true);
       
   115 
       
   116 if (not SupportNPOTT) and (not (isPowerOf2(Surf^.w) and isPowerOf2(Surf^.h))) then
       
   117     begin
       
   118     tw:= toPowerOf2(Surf^.w);
       
   119     th:= toPowerOf2(Surf^.h);
       
   120 
       
   121     Surface2Tex^.rx:= Surf^.w / tw;
       
   122     Surface2Tex^.ry:= Surf^.h / th;
       
   123 
       
   124     GetMem(tmpp, tw * th * surf^.format^.BytesPerPixel);
       
   125 
       
   126     fromP4:= Surf^.pixels;
       
   127     toP4:= tmpp;
       
   128 
       
   129     for y:= 0 to Pred(Surf^.h) do
       
   130         begin
       
   131         for x:= 0 to Pred(Surf^.w) do toP4^[x]:= fromP4^[x];
       
   132         for x:= Surf^.w to Pred(tw) do toP4^[x]:= 0;
       
   133         toP4:= @(toP4^[tw]);
       
   134         fromP4:= @(fromP4^[Surf^.pitch div 4])
       
   135         end;
       
   136 
       
   137     for y:= Surf^.h to Pred(th) do
       
   138         begin
       
   139         for x:= 0 to Pred(tw) do toP4^[x]:= 0;
       
   140         toP4:= @(toP4^[tw])
       
   141         end;
       
   142 
       
   143     glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, tw, th, 0, GL_RGBA, GL_UNSIGNED_BYTE, tmpp);
       
   144 
       
   145     FreeMem(tmpp, tw * th * surf^.format^.BytesPerPixel)
       
   146     end
       
   147 else
       
   148     begin
       
   149     Surface2Tex^.rx:= 1.0;
       
   150     Surface2Tex^.ry:= 1.0;
       
   151     glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, surf^.w, surf^.h, 0, GL_RGBA, GL_UNSIGNED_BYTE, surf^.pixels);
       
   152     end;
       
   153 
       
   154 ResetVertexArrays(Surface2Tex);
       
   155 
       
   156 if SDL_MustLock(surf) then
       
   157     SDL_UnlockSurface(surf);
       
   158 
       
   159 SetTextureParameters(enableClamp);
       
   160 end;
       
   161 
       
   162 procedure FreeTexture(tex: PTexture);
       
   163 begin
       
   164     if tex <> nil then
       
   165     begin
       
   166         if tex^.NextTexture <> nil then
       
   167             tex^.NextTexture^.PrevTexture:= tex^.PrevTexture;
       
   168         if tex^.PrevTexture <> nil then
       
   169             tex^.PrevTexture^.NextTexture:= tex^.NextTexture
       
   170         else
       
   171             TextureList:= tex^.NextTexture;
       
   172         glDeleteTextures(1, @tex^.id);
       
   173         Dispose(tex);
       
   174     end
       
   175 end;
       
   176 
       
   177 procedure initModule;
       
   178 begin
       
   179 TextureList:= nil;
       
   180 end;
       
   181 
       
   182 procedure freeModule;
       
   183 begin
       
   184     while TextureList <> nil do FreeTexture(TextureList);
       
   185 end;
       
   186 
       
   187 end.