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.