hedgewars/uTextures.pas
author nemo
Wed, 16 Nov 2011 16:36:17 -0500
changeset 6390 3807d4cad077
parent 6380 1ff5ad1d771b
child 6394 f0a9042e7387
permissions -rw-r--r--
This should have been added before. add log spew if this ever happens. We should hopefully identify the various circumstances and make sure it is all cleaned up so the list becomes unnecessary.
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;
6303
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
    26
procedure Surface2GrayScale(surf: PSDL_Surface);
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    27
function  Surface2Tex(surf: PSDL_Surface; enableClamp: boolean): PTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    28
procedure FreeTexture(tex: PTexture);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    29
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    30
procedure initModule;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    31
procedure freeModule;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    32
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    33
implementation
4403
unc0rr
parents: 4381
diff changeset
    34
uses GLunit, uUtils, uVariables, uConsts, uDebug;
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    35
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    36
var TextureList: PTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    37
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    38
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    39
procedure SetTextureParameters(enableClamp: Boolean);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    40
begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    41
    if enableClamp and ((cReducedQuality and rqClampLess) = 0) then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    42
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    43
        glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    44
        glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE)
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    45
    end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    46
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    47
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR)
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    48
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    49
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    50
procedure ResetVertexArrays(texture: PTexture);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    51
begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    52
with texture^ do
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    53
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    54
    vb[0].X:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    55
    vb[0].Y:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    56
    vb[1].X:= w;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    57
    vb[1].Y:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    58
    vb[2].X:= w;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    59
    vb[2].Y:= h;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    60
    vb[3].X:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    61
    vb[3].Y:= h;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    62
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    63
    tb[0].X:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    64
    tb[0].Y:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    65
    tb[1].X:= rx;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    66
    tb[1].Y:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    67
    tb[2].X:= rx;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    68
    tb[2].Y:= ry;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    69
    tb[3].X:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    70
    tb[3].Y:= ry
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    71
    end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    72
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    73
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    74
function NewTexture(width, height: Longword; buf: Pointer): PTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    75
begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    76
new(NewTexture);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    77
NewTexture^.PrevTexture:= nil;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    78
NewTexture^.NextTexture:= nil;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    79
NewTexture^.Scale:= 1;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    80
if TextureList <> nil then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    81
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    82
    TextureList^.PrevTexture:= NewTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    83
    NewTexture^.NextTexture:= TextureList
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    84
    end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    85
TextureList:= NewTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    86
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    87
NewTexture^.w:= width;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    88
NewTexture^.h:= height;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    89
NewTexture^.rx:= 1.0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    90
NewTexture^.ry:= 1.0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    91
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    92
ResetVertexArrays(NewTexture);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    93
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    94
glGenTextures(1, @NewTexture^.id);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    95
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    96
glBindTexture(GL_TEXTURE_2D, NewTexture^.id);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    97
glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, width, height, 0, GL_RGBA, GL_UNSIGNED_BYTE, buf);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    98
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    99
SetTextureParameters(true);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   100
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   101
6303
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   102
procedure Surface2GrayScale(surf: PSDL_Surface);
6305
5f7480c2a08d Set default water colours in greyscale mode in case the theme does not define them, decrement piano weapon on use
nemo
parents: 6303
diff changeset
   103
var tw, x, y: Longword;
6303
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   104
    fromP4: PLongWordArray;
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   105
begin
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   106
fromP4:= Surf^.pixels;
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   107
for y:= 0 to Pred(Surf^.h) do
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   108
    begin
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   109
    for x:= 0 to Pred(Surf^.w) do 
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   110
        begin
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   111
        tw:= fromP4^[x];
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   112
        tw:= round((tw shr RShift and $FF) * RGB_LUMINANCE_RED +  
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   113
              (tw shr GShift and $FF) * RGB_LUMINANCE_GREEN + 
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   114
              (tw shr BShift and $FF) * RGB_LUMINANCE_BLUE);
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   115
        if tw > 255 then tw:= 255;
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   116
        tw:= (tw and $FF shl RShift) or (tw and $FF shl BShift) or (tw and $FF shl GShift) or (fromP4^[x] and AMask);
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   117
        fromP4^[x]:= tw;
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   118
        end;
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   119
    fromP4:= @(fromP4^[Surf^.pitch div 4])
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   120
    end;
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   121
end;
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   122
function Surface2Tex(surf: PSDL_Surface; enableClamp: boolean): PTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   123
var tw, th, x, y: Longword;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   124
    tmpp: pointer;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   125
    fromP4, toP4: PLongWordArray;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   126
begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   127
new(Surface2Tex);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   128
Surface2Tex^.PrevTexture:= nil;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   129
Surface2Tex^.NextTexture:= nil;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   130
if TextureList <> nil then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   131
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   132
    TextureList^.PrevTexture:= Surface2Tex;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   133
    Surface2Tex^.NextTexture:= TextureList
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   134
    end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   135
TextureList:= Surface2Tex;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   136
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   137
Surface2Tex^.w:= surf^.w;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   138
Surface2Tex^.h:= surf^.h;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   139
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   140
if (surf^.format^.BytesPerPixel <> 4) then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   141
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   142
    TryDo(false, 'Surface2Tex failed, expecting 32 bit surface', true);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   143
    Surface2Tex^.id:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   144
    exit
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   145
    end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   146
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   147
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   148
glGenTextures(1, @Surface2Tex^.id);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   149
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   150
glBindTexture(GL_TEXTURE_2D, Surface2Tex^.id);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   151
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   152
if SDL_MustLock(surf) then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   153
    SDLTry(SDL_LockSurface(surf) >= 0, true);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   154
5441
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   155
fromP4:= Surf^.pixels;
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   156
6303
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   157
if cGrayScale then Surface2GrayScale(Surf);
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   158
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   159
if (not SupportNPOTT) and (not (isPowerOf2(Surf^.w) and isPowerOf2(Surf^.h))) then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   160
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   161
    tw:= toPowerOf2(Surf^.w);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   162
    th:= toPowerOf2(Surf^.h);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   163
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   164
    Surface2Tex^.rx:= Surf^.w / tw;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   165
    Surface2Tex^.ry:= Surf^.h / th;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   166
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   167
    GetMem(tmpp, tw * th * surf^.format^.BytesPerPixel);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   168
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   169
    fromP4:= Surf^.pixels;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   170
    toP4:= tmpp;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   171
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   172
    for y:= 0 to Pred(Surf^.h) do
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   173
        begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   174
        for x:= 0 to Pred(Surf^.w) do toP4^[x]:= fromP4^[x];
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   175
        for x:= Surf^.w 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
        fromP4:= @(fromP4^[Surf^.pitch div 4])
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   178
        end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   179
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   180
    for y:= Surf^.h to Pred(th) do
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   181
        begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   182
        for x:= 0 to Pred(tw) do toP4^[x]:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   183
        toP4:= @(toP4^[tw])
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   184
        end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   185
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   186
    glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, tw, th, 0, GL_RGBA, GL_UNSIGNED_BYTE, tmpp);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   187
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   188
    FreeMem(tmpp, tw * th * surf^.format^.BytesPerPixel)
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   189
    end
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   190
else
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   191
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   192
    Surface2Tex^.rx:= 1.0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   193
    Surface2Tex^.ry:= 1.0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   194
    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
   195
    end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   196
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   197
ResetVertexArrays(Surface2Tex);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   198
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   199
if SDL_MustLock(surf) then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   200
    SDL_UnlockSurface(surf);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   201
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   202
SetTextureParameters(enableClamp);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   203
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   204
4901
d1e2d82d9ccc Thou shalt not leak!
sheepluva
parents: 4403
diff changeset
   205
// deletes texture and frees the memory allocated for it.
d1e2d82d9ccc Thou shalt not leak!
sheepluva
parents: 4403
diff changeset
   206
// if nil is passed nothing is done
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   207
procedure FreeTexture(tex: PTexture);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   208
begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   209
    if tex <> nil then
6380
1ff5ad1d771b Remove a bunch of unnecessary nil checks. FreeTexture does its own nil check.
nemo
parents: 6305
diff changeset
   210
        begin
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   211
        if tex^.NextTexture <> nil then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   212
            tex^.NextTexture^.PrevTexture:= tex^.PrevTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   213
        if tex^.PrevTexture <> nil then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   214
            tex^.PrevTexture^.NextTexture:= tex^.NextTexture
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   215
        else
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   216
            TextureList:= tex^.NextTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   217
        glDeleteTextures(1, @tex^.id);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   218
        Dispose(tex);
6380
1ff5ad1d771b Remove a bunch of unnecessary nil checks. FreeTexture does its own nil check.
nemo
parents: 6305
diff changeset
   219
        end
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   220
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   221
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   222
procedure initModule;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   223
begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   224
TextureList:= nil;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   225
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   226
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   227
procedure freeModule;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   228
begin
6390
3807d4cad077 This should have been added before. add log spew if this ever happens. We should hopefully identify the various circumstances and make sure it is all cleaned up so the list becomes unnecessary.
nemo
parents: 6380
diff changeset
   229
    if TextureList <> nil then AddFileLog('FIXME FIXME FIXME. App shutdown without full cleanup of texture list.');
3807d4cad077 This should have been added before. add log spew if this ever happens. We should hopefully identify the various circumstances and make sure it is all cleaned up so the list becomes unnecessary.
nemo
parents: 6380
diff changeset
   230
    while TextureList <> nil do 
3807d4cad077 This should have been added before. add log spew if this ever happens. We should hopefully identify the various circumstances and make sure it is all cleaned up so the list becomes unnecessary.
nemo
parents: 6380
diff changeset
   231
        begin
3807d4cad077 This should have been added before. add log spew if this ever happens. We should hopefully identify the various circumstances and make sure it is all cleaned up so the list becomes unnecessary.
nemo
parents: 6380
diff changeset
   232
        AddFileLog('Texture not freed: width='+inttostr(LongInt(TextureList^.w))+' height='+inttostr(LongInt(TextureList^.h))+' priority='+inttostr(round(TextureList^.priority*1000)));
3807d4cad077 This should have been added before. add log spew if this ever happens. We should hopefully identify the various circumstances and make sure it is all cleaned up so the list becomes unnecessary.
nemo
parents: 6380
diff changeset
   233
        FreeTexture(TextureList);
3807d4cad077 This should have been added before. add log spew if this ever happens. We should hopefully identify the various circumstances and make sure it is all cleaned up so the list becomes unnecessary.
nemo
parents: 6380
diff changeset
   234
        end
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   235
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   236
4901
d1e2d82d9ccc Thou shalt not leak!
sheepluva
parents: 4403
diff changeset
   237
end.