hedgewars/uTextures.pas
author nemo
Fri, 30 Sep 2011 22:33:28 -0400
changeset 6077 d8fa5a85d24f
parent 5441 39962b855540
child 6303 3edb3c857995
permissions -rw-r--r--
This prevents girders from erasing landbacktex (square windows in tunnels and such), at the cost of requiring lfBasic and lfObject to be treated the same apart from graphically
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
4976
088d40d8aba2 Happy 2011 :)
koda
parents: 4901
diff changeset
     1
(*
088d40d8aba2 Happy 2011 :)
koda
parents: 4901
diff changeset
     2
 * Hedgewars, a free turn based strategy game
088d40d8aba2 Happy 2011 :)
koda
parents: 4901
diff changeset
     3
 * Copyright (c) 2004-2011 Andrey Korotaev <unC0Rr@gmail.com>
088d40d8aba2 Happy 2011 :)
koda
parents: 4901
diff changeset
     4
 *
088d40d8aba2 Happy 2011 :)
koda
parents: 4901
diff changeset
     5
 * This program is free software; you can redistribute it and/or modify
088d40d8aba2 Happy 2011 :)
koda
parents: 4901
diff changeset
     6
 * it under the terms of the GNU General Public License as published by
088d40d8aba2 Happy 2011 :)
koda
parents: 4901
diff changeset
     7
 * the Free Software Foundation; version 2 of the License
088d40d8aba2 Happy 2011 :)
koda
parents: 4901
diff changeset
     8
 *
088d40d8aba2 Happy 2011 :)
koda
parents: 4901
diff changeset
     9
 * This program is distributed in the hope that it will be useful,
088d40d8aba2 Happy 2011 :)
koda
parents: 4901
diff changeset
    10
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
088d40d8aba2 Happy 2011 :)
koda
parents: 4901
diff changeset
    11
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
088d40d8aba2 Happy 2011 :)
koda
parents: 4901
diff changeset
    12
 * GNU General Public License for more details.
088d40d8aba2 Happy 2011 :)
koda
parents: 4901
diff changeset
    13
 *
088d40d8aba2 Happy 2011 :)
koda
parents: 4901
diff changeset
    14
 * You should have received a copy of the GNU General Public License
088d40d8aba2 Happy 2011 :)
koda
parents: 4901
diff changeset
    15
 * along with this program; if not, write to the Free Software
088d40d8aba2 Happy 2011 :)
koda
parents: 4901
diff changeset
    16
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
088d40d8aba2 Happy 2011 :)
koda
parents: 4901
diff changeset
    17
 *)
088d40d8aba2 Happy 2011 :)
koda
parents: 4901
diff changeset
    18
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    19
{$INCLUDE "options.inc"}
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    20
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    21
unit uTextures;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    22
interface
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    23
uses SDLh, uTypes;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    24
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    25
function  NewTexture(width, height: Longword; buf: Pointer): PTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    26
function  Surface2Tex(surf: PSDL_Surface; enableClamp: boolean): PTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    27
procedure FreeTexture(tex: PTexture);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    28
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    29
procedure initModule;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    30
procedure freeModule;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    31
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    32
implementation
4403
unc0rr
parents: 4381
diff changeset
    33
uses GLunit, uUtils, uVariables, uConsts, uDebug;
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    34
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    35
var TextureList: PTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    36
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    37
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    38
procedure SetTextureParameters(enableClamp: Boolean);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    39
begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    40
    if enableClamp and ((cReducedQuality and rqClampLess) = 0) then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    41
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    42
        glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    43
        glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE)
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    44
    end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    45
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    46
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR)
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    47
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    48
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    49
procedure ResetVertexArrays(texture: PTexture);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    50
begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    51
with texture^ do
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    52
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    53
    vb[0].X:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    54
    vb[0].Y:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    55
    vb[1].X:= w;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    56
    vb[1].Y:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    57
    vb[2].X:= w;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    58
    vb[2].Y:= h;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    59
    vb[3].X:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    60
    vb[3].Y:= h;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    61
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    62
    tb[0].X:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    63
    tb[0].Y:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    64
    tb[1].X:= rx;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    65
    tb[1].Y:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    66
    tb[2].X:= rx;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    67
    tb[2].Y:= ry;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    68
    tb[3].X:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    69
    tb[3].Y:= ry
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    70
    end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    71
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    72
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    73
function NewTexture(width, height: Longword; buf: Pointer): PTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    74
begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    75
new(NewTexture);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    76
NewTexture^.PrevTexture:= nil;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    77
NewTexture^.NextTexture:= nil;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    78
NewTexture^.Scale:= 1;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    79
if TextureList <> nil then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    80
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    81
    TextureList^.PrevTexture:= NewTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    82
    NewTexture^.NextTexture:= TextureList
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    83
    end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    84
TextureList:= NewTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    85
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    86
NewTexture^.w:= width;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    87
NewTexture^.h:= height;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    88
NewTexture^.rx:= 1.0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    89
NewTexture^.ry:= 1.0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    90
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    91
ResetVertexArrays(NewTexture);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    92
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    93
glGenTextures(1, @NewTexture^.id);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    94
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    95
glBindTexture(GL_TEXTURE_2D, NewTexture^.id);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    96
glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, width, height, 0, GL_RGBA, GL_UNSIGNED_BYTE, buf);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    97
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    98
SetTextureParameters(true);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    99
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   100
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   101
function Surface2Tex(surf: PSDL_Surface; enableClamp: boolean): PTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   102
var tw, th, x, y: Longword;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   103
    tmpp: pointer;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   104
    fromP4, toP4: PLongWordArray;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   105
begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   106
new(Surface2Tex);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   107
Surface2Tex^.PrevTexture:= nil;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   108
Surface2Tex^.NextTexture:= nil;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   109
if TextureList <> nil then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   110
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   111
    TextureList^.PrevTexture:= Surface2Tex;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   112
    Surface2Tex^.NextTexture:= TextureList
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   113
    end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   114
TextureList:= Surface2Tex;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   115
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   116
Surface2Tex^.w:= surf^.w;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   117
Surface2Tex^.h:= surf^.h;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   118
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   119
if (surf^.format^.BytesPerPixel <> 4) then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   120
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   121
    TryDo(false, 'Surface2Tex failed, expecting 32 bit surface', true);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   122
    Surface2Tex^.id:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   123
    exit
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   124
    end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   125
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   126
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   127
glGenTextures(1, @Surface2Tex^.id);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   128
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   129
glBindTexture(GL_TEXTURE_2D, Surface2Tex^.id);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   130
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   131
if SDL_MustLock(surf) then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   132
    SDLTry(SDL_LockSurface(surf) >= 0, true);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   133
5441
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   134
fromP4:= Surf^.pixels;
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   135
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   136
if cGrayScale then
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   137
    for y:= 0 to Pred(Surf^.h) do
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   138
        begin
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   139
        for x:= 0 to Pred(Surf^.w) do 
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   140
            begin
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   141
            tw:= fromP4^[x];
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   142
            tw:= round((tw shr RShift and $FF) * RGB_LUMINANCE_RED +  
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   143
                  (tw shr GShift and $FF) * RGB_LUMINANCE_GREEN + 
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   144
                  (tw shr BShift and $FF) * RGB_LUMINANCE_BLUE);
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   145
            if tw > 255 then tw:= 255;
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   146
            tw:= (tw and $FF shl RShift) or (tw and $FF shl BShift) or (tw and $FF shl GShift) or (fromP4^[x] and AMask);
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   147
            fromP4^[x]:= tw;
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   148
            end;
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   149
        fromP4:= @(fromP4^[Surf^.pitch div 4])
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   150
        end;
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   151
        
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   152
if (not SupportNPOTT) and (not (isPowerOf2(Surf^.w) and isPowerOf2(Surf^.h))) then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   153
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   154
    tw:= toPowerOf2(Surf^.w);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   155
    th:= toPowerOf2(Surf^.h);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   156
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   157
    Surface2Tex^.rx:= Surf^.w / tw;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   158
    Surface2Tex^.ry:= Surf^.h / th;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   159
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   160
    GetMem(tmpp, tw * th * surf^.format^.BytesPerPixel);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   161
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   162
    fromP4:= Surf^.pixels;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   163
    toP4:= tmpp;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   164
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   165
    for y:= 0 to Pred(Surf^.h) do
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   166
        begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   167
        for x:= 0 to Pred(Surf^.w) do toP4^[x]:= fromP4^[x];
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   168
        for x:= Surf^.w to Pred(tw) do toP4^[x]:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   169
        toP4:= @(toP4^[tw]);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   170
        fromP4:= @(fromP4^[Surf^.pitch div 4])
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   171
        end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   172
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   173
    for y:= Surf^.h to Pred(th) do
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   174
        begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   175
        for x:= 0 to Pred(tw) do toP4^[x]:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   176
        toP4:= @(toP4^[tw])
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   177
        end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   178
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   179
    glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, tw, th, 0, GL_RGBA, GL_UNSIGNED_BYTE, tmpp);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   180
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   181
    FreeMem(tmpp, tw * th * surf^.format^.BytesPerPixel)
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   182
    end
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   183
else
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   184
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   185
    Surface2Tex^.rx:= 1.0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   186
    Surface2Tex^.ry:= 1.0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   187
    glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, surf^.w, surf^.h, 0, GL_RGBA, GL_UNSIGNED_BYTE, surf^.pixels);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   188
    end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   189
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   190
ResetVertexArrays(Surface2Tex);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   191
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   192
if SDL_MustLock(surf) then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   193
    SDL_UnlockSurface(surf);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   194
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   195
SetTextureParameters(enableClamp);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   196
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   197
4901
d1e2d82d9ccc Thou shalt not leak!
sheepluva
parents: 4403
diff changeset
   198
// deletes texture and frees the memory allocated for it.
d1e2d82d9ccc Thou shalt not leak!
sheepluva
parents: 4403
diff changeset
   199
// if nil is passed nothing is done
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   200
procedure FreeTexture(tex: PTexture);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   201
begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   202
    if tex <> nil then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   203
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   204
        if tex^.NextTexture <> nil then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   205
            tex^.NextTexture^.PrevTexture:= tex^.PrevTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   206
        if tex^.PrevTexture <> nil then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   207
            tex^.PrevTexture^.NextTexture:= tex^.NextTexture
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   208
        else
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   209
            TextureList:= tex^.NextTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   210
        glDeleteTextures(1, @tex^.id);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   211
        Dispose(tex);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   212
    end
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   213
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   214
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   215
procedure initModule;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   216
begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   217
TextureList:= nil;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   218
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   219
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   220
procedure freeModule;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   221
begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   222
    while TextureList <> nil do FreeTexture(TextureList);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   223
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   224
4901
d1e2d82d9ccc Thou shalt not leak!
sheepluva
parents: 4403
diff changeset
   225
end.