hedgewars/uTextures.pas
author Wolfgang Steffens <WolfgangSteff@gmail.com>
Mon, 25 Jun 2012 12:01:19 +0200
changeset 7292 18430abfbcd2
parent 7291 ad4b6c2b09e8
child 7295 e70b81854fb9
permissions -rw-r--r--
added missing uBinPacker.pas and uAtlas.pas
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
6700
e04da46ee43c the most important commit of the year
koda
parents: 6580
diff changeset
     3
 * Copyright (c) 2004-2012 Andrey Korotaev <unC0Rr@gmail.com>
4976
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);
7291
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
    27
function  Surface2Atlas(surf: PSDL_Surface; enableClamp: boolean): PTexture;
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    28
procedure FreeTexture(tex: PTexture);
7080
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    29
procedure ComputeTexcoords(texture: PTexture; r: PSDL_Rect; tb: PVertexRect);
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    30
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    31
procedure initModule;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    32
procedure freeModule;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    33
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    34
implementation
7291
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
    35
uses GLunit, uUtils, uVariables, uConsts, uDebug, uConsole, uAtlas;
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    36
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    37
var TextureList: PTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    38
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    39
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    40
procedure SetTextureParameters(enableClamp: Boolean);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    41
begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    42
    if enableClamp and ((cReducedQuality and rqClampLess) = 0) then
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
    43
        begin
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    44
        glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    45
        glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE)
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
    46
        end;
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    47
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    48
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR)
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    49
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    50
7080
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    51
procedure ComputeTexcoords(texture: PTexture; r: PSDL_Rect; tb: PVertexRect);
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    52
var x0, y0, x1, y1: Real;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    53
    w, h, aw, ah: LongInt;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    54
const texelOffset = 0.0;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    55
begin
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    56
aw:=texture^.atlas^.w;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    57
ah:=texture^.atlas^.h;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    58
if texture^.isRotated then
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    59
    begin
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    60
    w:=r^.h;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    61
    h:=r^.w;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    62
    end 
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    63
else
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    64
    begin
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    65
    w:=r^.w;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    66
    h:=r^.h;        
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    67
    end;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    68
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    69
x0:= (r^.x +     texelOffset)/aw;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    70
x1:= (r^.x + w - texelOffset)/aw;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    71
y0:= (r^.y +     texelOffset)/ah;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    72
y1:= (r^.y + h - texelOffset)/ah;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    73
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    74
tb^[0].X:= x0;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    75
tb^[0].Y:= y0;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    76
tb^[1].X:= x1;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    77
tb^[1].Y:= y0;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    78
tb^[2].X:= x1;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    79
tb^[2].Y:= y1;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    80
tb^[3].X:= x0;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    81
tb^[3].Y:= y1
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    82
end;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    83
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    84
procedure ResetVertexArrays(texture: PTexture);
7080
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    85
var r: TSDL_Rect;
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    86
begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    87
with texture^ do
7080
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    88
begin
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    89
    vb[0].X:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    90
    vb[0].Y:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    91
    vb[1].X:= w;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    92
    vb[1].Y:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    93
    vb[2].X:= w;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    94
    vb[2].Y:= h;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    95
    vb[3].X:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    96
    vb[3].Y:= h;
7080
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    97
end;
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    98
7080
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
    99
r.x:= 0;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   100
r.y:= 0;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   101
r.w:= texture^.w;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   102
r.h:= texture^.h;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   103
ComputeTexcoords(texture, @r, @texture^.tb);
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   104
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   105
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   106
function NewTexture(width, height: Longword; buf: Pointer): PTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   107
begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   108
new(NewTexture);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   109
NewTexture^.PrevTexture:= nil;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   110
NewTexture^.NextTexture:= nil;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   111
NewTexture^.Scale:= 1;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   112
if TextureList <> nil then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   113
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   114
    TextureList^.PrevTexture:= NewTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   115
    NewTexture^.NextTexture:= TextureList
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   116
    end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   117
TextureList:= NewTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   118
7080
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   119
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   120
// Atlas allocation happens here later on. For now we just allocate one exclusive atlas per sprite
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   121
new(NewTexture^.atlas);
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   122
NewTexture^.atlas^.w:=width;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   123
NewTexture^.atlas^.h:=height;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   124
NewTexture^.x:=0;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   125
NewTexture^.y:=0;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   126
NewTexture^.w:=width;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   127
NewTexture^.h:=height;
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   128
NewTexture^.isRotated:=false;
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   129
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   130
ResetVertexArrays(NewTexture);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   131
7080
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   132
glGenTextures(1, @NewTexture^.atlas^.id);
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   133
7080
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   134
glBindTexture(GL_TEXTURE_2D, NewTexture^.atlas^.id);
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   135
glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, width, height, 0, GL_RGBA, GL_UNSIGNED_BYTE, buf);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   136
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   137
SetTextureParameters(true);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   138
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   139
6303
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   140
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
   141
var tw, x, y: Longword;
6303
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   142
    fromP4: PLongWordArray;
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   143
begin
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   144
fromP4:= Surf^.pixels;
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   145
for y:= 0 to Pred(Surf^.h) do
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   146
    begin
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   147
    for x:= 0 to Pred(Surf^.w) do 
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   148
        begin
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   149
        tw:= fromP4^[x];
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   150
        tw:= round((tw shr RShift and $FF) * RGB_LUMINANCE_RED +  
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   151
              (tw shr GShift and $FF) * RGB_LUMINANCE_GREEN + 
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   152
              (tw shr BShift and $FF) * RGB_LUMINANCE_BLUE);
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   153
        if tw > 255 then tw:= 255;
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   154
        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
   155
        fromP4^[x]:= tw;
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   156
        end;
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   157
    fromP4:= @(fromP4^[Surf^.pitch div 4])
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   158
    end;
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   159
end;
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6394
diff changeset
   160
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6394
diff changeset
   161
7291
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   162
function Surface2Atlas(surf: PSDL_Surface; enableClamp: boolean): PTexture;
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   163
var tw, th, x, y: Longword;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   164
    tmpp: pointer;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   165
    fromP4, toP4: PLongWordArray;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   166
begin
7291
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   167
    if (surf^.w <= 128) and (surf^.h <= 128) then
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   168
        Surface2Tex_(surf, enableClamp); // run the atlas side by side for debugging
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   169
new(Surface2Atlas);
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   170
Surface2Atlas^.PrevTexture:= nil;
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   171
Surface2Atlas^.NextTexture:= nil;
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   172
if TextureList <> nil then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   173
    begin
7291
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   174
    TextureList^.PrevTexture:= Surface2Atlas;
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   175
    Surface2Atlas^.NextTexture:= TextureList
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   176
    end;
7291
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   177
TextureList:= Surface2Atlas;
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   178
7080
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   179
// Atlas allocation happens here later on. For now we just allocate one exclusive atlas per sprite
7291
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   180
new(Surface2Atlas^.atlas);
7080
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   181
7291
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   182
Surface2Atlas^.w:= surf^.w;
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   183
Surface2Atlas^.h:= surf^.h;
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   184
Surface2Atlas^.x:=0;
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   185
Surface2Atlas^.y:=0;
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   186
Surface2Atlas^.isRotated:=false;
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   187
Surface2Atlas^.surface:= surf;
7080
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   188
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   189
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   190
if (surf^.format^.BytesPerPixel <> 4) then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   191
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   192
    TryDo(false, 'Surface2Tex failed, expecting 32 bit surface', true);
7291
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   193
    Surface2Atlas^.atlas^.id:= 0;
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   194
    exit
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
7291
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   198
glGenTextures(1, @Surface2Atlas^.atlas^.id);
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   199
7291
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   200
glBindTexture(GL_TEXTURE_2D, Surface2Atlas^.atlas^.id);
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   201
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   202
if SDL_MustLock(surf) then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   203
    SDLTry(SDL_LockSurface(surf) >= 0, true);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   204
5441
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   205
fromP4:= Surf^.pixels;
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   206
6982
8d41d22a291d breaking news, we don't support typed consts anymore
koda
parents: 6700
diff changeset
   207
if GrayScale then
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
   208
    Surface2GrayScale(Surf);
6303
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   209
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   210
if (not SupportNPOTT) and (not (isPowerOf2(Surf^.w) and isPowerOf2(Surf^.h))) then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   211
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   212
    tw:= toPowerOf2(Surf^.w);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   213
    th:= toPowerOf2(Surf^.h);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   214
7291
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   215
    Surface2Atlas^.atlas^.w:=tw;
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   216
    Surface2Atlas^.atlas^.h:=th;
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   217
7151
ec15d9e1a7e3 pas2c stuff
unc0rr
parents: 6982
diff changeset
   218
    tmpp:= GetMem(tw * th * surf^.format^.BytesPerPixel);
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   219
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   220
    fromP4:= Surf^.pixels;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   221
    toP4:= tmpp;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   222
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   223
    for y:= 0 to Pred(Surf^.h) do
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   224
        begin
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
   225
        for x:= 0 to Pred(Surf^.w) do
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
   226
            toP4^[x]:= fromP4^[x];
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
   227
        for x:= Surf^.w to Pred(tw) do
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
   228
            toP4^[x]:= 0;
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   229
        toP4:= @(toP4^[tw]);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   230
        fromP4:= @(fromP4^[Surf^.pitch div 4])
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   231
        end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   232
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   233
    for y:= Surf^.h to Pred(th) do
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   234
        begin
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
   235
        for x:= 0 to Pred(tw) do
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
   236
            toP4^[x]:= 0;
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   237
        toP4:= @(toP4^[tw])
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   238
        end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   239
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   240
    glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, tw, th, 0, GL_RGBA, GL_UNSIGNED_BYTE, tmpp);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   241
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   242
    FreeMem(tmpp, tw * th * surf^.format^.BytesPerPixel)
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   243
    end
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   244
else
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   245
    begin
7291
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   246
    Surface2Atlas^.atlas^.w:=Surf^.w;
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   247
    Surface2Atlas^.atlas^.h:=Surf^.h;
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   248
    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
   249
    end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   250
7291
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   251
ResetVertexArrays(Surface2Atlas);
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   252
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   253
if SDL_MustLock(surf) then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   254
    SDL_UnlockSurface(surf);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   255
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   256
SetTextureParameters(enableClamp);
7291
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   257
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   258
    {$IFNDEF RETAIN_SURFACES}
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   259
    SDL_FreeSurface(surf);
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   260
    {$ENDIF}
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   261
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   262
4901
d1e2d82d9ccc Thou shalt not leak!
sheepluva
parents: 4403
diff changeset
   263
// deletes texture and frees the memory allocated for it.
d1e2d82d9ccc Thou shalt not leak!
sheepluva
parents: 4403
diff changeset
   264
// if nil is passed nothing is done
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   265
procedure FreeTexture(tex: PTexture);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   266
begin
7291
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   267
    FreeTexture_(tex); // run atlas side by side for debugging
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
   268
if tex <> nil then
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
   269
    begin
7080
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   270
    // Atlas cleanup happens here later on. For now we just free as each sprite has one atlas
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   271
    Dispose(tex^.atlas);
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   272
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
   273
    if tex^.NextTexture <> nil then
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
   274
        tex^.NextTexture^.PrevTexture:= tex^.PrevTexture;
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
   275
    if tex^.PrevTexture <> nil then
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
   276
        tex^.PrevTexture^.NextTexture:= tex^.NextTexture
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
   277
    else
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
   278
        TextureList:= tex^.NextTexture;
7080
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   279
    glDeleteTextures(1, @tex^.atlas^.id);
7291
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   280
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   281
    {$IFDEF RETAIN_SURFACES}
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   282
    SDL_FreeSurface(tex^.surface);
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   283
    {$ENDIF}
ad4b6c2b09e8 retaining SDL surfaces in order to allow recreating atlases from scratch without
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7186
diff changeset
   284
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
   285
    Dispose(tex);
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
   286
    end
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   287
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   288
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   289
procedure initModule;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   290
begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   291
TextureList:= nil;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   292
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   293
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   294
procedure freeModule;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   295
begin
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
   296
if TextureList <> nil then
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
   297
    WriteToConsole('FIXME FIXME FIXME. App shutdown without full cleanup of texture list; read game0.log and please report this problem');
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
   298
    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
   299
        begin
7080
dbf43c07a507 Refactored TTexture to allow encoding sprite(s) at an arbitrary location within
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 6982
diff changeset
   300
        AddFileLog('Sprite not freed: width='+inttostr(LongInt(TextureList^.w))+' height='+inttostr(LongInt(TextureList^.h))+' priority='+inttostr(round(TextureList^.atlas^.priority*1000)));
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
   301
        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
   302
        end
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   303
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   304
4901
d1e2d82d9ccc Thou shalt not leak!
sheepluva
parents: 4403
diff changeset
   305
end.