hedgewars/uTextures.pas
author sheepluva
Sat, 07 Apr 2018 23:38:19 +0200
changeset 13313 93780a3b846a
parent 12843 8599a7d4df54
child 15930 f39f0f614dbf
permissions -rw-r--r--
Quick Game: ignore hidden themes
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
11046
47a8c19ecb60 more copyright fixes
sheepluva
parents: 10647
diff changeset
     3
 * Copyright (c) 2004-2015 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
10108
c68cf030eded update FSF address. note: two sdl include files (by Sam Lantinga) still have the old FSF address in their copyright - but I ain't gonna touch their copyright headers
sheepluva
parents: 10078
diff changeset
    16
 * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
4976
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;
10018
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
    28
procedure PrettifySurfaceAlpha(surf: PSDL_Surface; pixels: PLongwordArray);
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
    29
procedure PrettifyAlpha2D(pixels: TLandArray; height, width: LongWord);
9655
e154ccca4dad Tinted crosshair (without that cool white dot in the middle)
unc0rr
parents: 9080
diff changeset
    30
procedure FreeAndNilTexture(var tex: PTexture);
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    31
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    32
procedure initModule;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    33
procedure freeModule;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    34
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    35
implementation
6394
f0a9042e7387 yay, finally osx (and likely windows) fullscreen switch works like on linux! ALL textures had to be destroyed and recreated only after the new window got created. In other news, the new window must be cleaned with glClear to skip a first frame of garbage and AddProgress is only called the first time.
koda
parents: 6390
diff changeset
    36
uses GLunit, uUtils, uVariables, uConsts, uDebug, uConsole;
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    37
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    38
var TextureList: PTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    39
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    40
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    41
procedure SetTextureParameters(enableClamp: Boolean);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    42
begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    43
    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
    44
        begin
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    45
        glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    46
        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
    47
        end;
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    48
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    49
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR)
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    50
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    51
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    52
procedure ResetVertexArrays(texture: PTexture);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    53
begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    54
with texture^ do
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    55
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    56
    vb[0].X:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    57
    vb[0].Y:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    58
    vb[1].X:= w;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    59
    vb[1].Y:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    60
    vb[2].X:= w;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    61
    vb[2].Y:= h;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    62
    vb[3].X:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    63
    vb[3].Y:= h;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    64
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    65
    tb[0].X:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    66
    tb[0].Y:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    67
    tb[1].X:= rx;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    68
    tb[1].Y:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    69
    tb[2].X:= rx;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    70
    tb[2].Y:= ry;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    71
    tb[3].X:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    72
    tb[3].Y:= ry
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    73
    end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    74
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    75
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    76
function NewTexture(width, height: Longword; buf: Pointer): PTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    77
begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    78
new(NewTexture);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    79
NewTexture^.PrevTexture:= nil;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    80
NewTexture^.NextTexture:= nil;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    81
if TextureList <> nil then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    82
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    83
    TextureList^.PrevTexture:= NewTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    84
    NewTexture^.NextTexture:= TextureList
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    85
    end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    86
TextureList:= NewTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    87
12843
8599a7d4df54 init priority and scale
nemo
parents: 12765
diff changeset
    88
NewTexture^.Scale:= 1;
8599a7d4df54 init priority and scale
nemo
parents: 12765
diff changeset
    89
NewTexture^.Priority:= 0;
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    90
NewTexture^.w:= width;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    91
NewTexture^.h:= height;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    92
NewTexture^.rx:= 1.0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    93
NewTexture^.ry:= 1.0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    94
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    95
ResetVertexArrays(NewTexture);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    96
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    97
glGenTextures(1, @NewTexture^.id);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    98
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
    99
glBindTexture(GL_TEXTURE_2D, NewTexture^.id);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   100
glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, width, height, 0, GL_RGBA, GL_UNSIGNED_BYTE, buf);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   101
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   102
SetTextureParameters(true);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   103
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   104
6303
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   105
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
   106
var tw, x, y: Longword;
6303
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   107
    fromP4: PLongWordArray;
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   108
begin
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   109
fromP4:= Surf^.pixels;
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   110
for y:= 0 to Pred(Surf^.h) do
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   111
    begin
10017
de822cd3df3a fixwhitespace and dos2unix
koda
parents: 9998
diff changeset
   112
    for x:= 0 to Pred(Surf^.w) do
6303
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   113
        begin
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   114
        tw:= fromP4^[x];
10017
de822cd3df3a fixwhitespace and dos2unix
koda
parents: 9998
diff changeset
   115
        tw:= round((tw shr RShift and $FF) * RGB_LUMINANCE_RED +
de822cd3df3a fixwhitespace and dos2unix
koda
parents: 9998
diff changeset
   116
              (tw shr GShift and $FF) * RGB_LUMINANCE_GREEN +
6303
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   117
              (tw shr BShift and $FF) * RGB_LUMINANCE_BLUE);
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   118
        if tw > 255 then tw:= 255;
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   119
        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
   120
        fromP4^[x]:= tw;
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   121
        end;
10131
4b4a043111f4 - pas2c recognizes typecasts in initialization expressions
unc0rr
parents: 10108
diff changeset
   122
    fromP4:= PLongWordArray(@(fromP4^[Surf^.pitch div 4]))
6303
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   123
    end;
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   124
end;
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6394
diff changeset
   125
10016
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   126
{ this will make invisible pixels that have a visible neighbor have the
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   127
  same color as their visible neighbor, so that bilinear filtering won't
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   128
  display a "wrongly" colored border when zoomed in }
10021
7f36194af01c no idea how I ended up forgetting about the offset I need for same position in different rows (in 1d array); also remove obsolete comment
sheepluva
parents: 10018
diff changeset
   129
procedure PrettifyAlpha(row1, row2: PLongwordArray; firsti, lasti, ioffset: LongWord);
7304
8b3575750cd2 Added auto cropping to atlasing
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7297
diff changeset
   130
var
10018
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   131
    i: Longword;
10016
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   132
    lpi, cpi, bpi: boolean; // was last/current/bottom neighbor pixel invisible?
7304
8b3575750cd2 Added auto cropping to atlasing
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7297
diff changeset
   133
begin
10021
7f36194af01c no idea how I ended up forgetting about the offset I need for same position in different rows (in 1d array); also remove obsolete comment
sheepluva
parents: 10018
diff changeset
   134
    // suppress incorrect warning
7f36194af01c no idea how I ended up forgetting about the offset I need for same position in different rows (in 1d array); also remove obsolete comment
sheepluva
parents: 10018
diff changeset
   135
    lpi:= true;
10018
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   136
    for i:=firsti to lasti do
7304
8b3575750cd2 Added auto cropping to atlasing
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7297
diff changeset
   137
        begin
10018
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   138
        // use first pixel in row1 as starting point
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   139
        if i = firsti then
10021
7f36194af01c no idea how I ended up forgetting about the offset I need for same position in different rows (in 1d array); also remove obsolete comment
sheepluva
parents: 10018
diff changeset
   140
            cpi:= ((row1^[i] and AMask) = 0)
10016
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   141
        else
7304
8b3575750cd2 Added auto cropping to atlasing
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7297
diff changeset
   142
            begin
10018
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   143
            cpi:= ((row1^[i] and AMask) = 0);
10016
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   144
            if cpi <> lpi then
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   145
                begin
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   146
                // invisible pixels get colors from visible neighbors
10021
7f36194af01c no idea how I ended up forgetting about the offset I need for same position in different rows (in 1d array); also remove obsolete comment
sheepluva
parents: 10018
diff changeset
   147
                if cpi then
10016
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   148
                    begin
10078
8572d1f8b2f0 Some love to pas2c
unc0rr
parents: 10040
diff changeset
   149
                    row1^[i]:= row1^[i-1] and (not AMask);
10016
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   150
                    // as this pixel is invisible and already colored correctly now, no point in further comparing it
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   151
                    lpi:= cpi;
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   152
                    continue;
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   153
                    end
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   154
                else
10078
8572d1f8b2f0 Some love to pas2c
unc0rr
parents: 10040
diff changeset
   155
                    row1^[i-1]:= row1^[i] and (not AMask);
10016
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   156
                end;
7304
8b3575750cd2 Added auto cropping to atlasing
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7297
diff changeset
   157
            end;
10021
7f36194af01c no idea how I ended up forgetting about the offset I need for same position in different rows (in 1d array); also remove obsolete comment
sheepluva
parents: 10018
diff changeset
   158
        lpi:= cpi;
7f36194af01c no idea how I ended up forgetting about the offset I need for same position in different rows (in 1d array); also remove obsolete comment
sheepluva
parents: 10018
diff changeset
   159
        // also check bottom neighbor
10018
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   160
        if row2 <> nil then
10016
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   161
            begin
10021
7f36194af01c no idea how I ended up forgetting about the offset I need for same position in different rows (in 1d array); also remove obsolete comment
sheepluva
parents: 10018
diff changeset
   162
            bpi:= ((row2^[i+ioffset] and AMask) = 0);
10016
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   163
            if cpi <> bpi then
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   164
                begin
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   165
                if cpi then
10078
8572d1f8b2f0 Some love to pas2c
unc0rr
parents: 10040
diff changeset
   166
                    row1^[i]:= row2^[i+ioffset] and (not AMask)
10016
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   167
                else
10078
8572d1f8b2f0 Some love to pas2c
unc0rr
parents: 10040
diff changeset
   168
                    row2^[i+ioffset]:= row1^[i] and (not AMask);
10016
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   169
                end;
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   170
            end;
7304
8b3575750cd2 Added auto cropping to atlasing
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7297
diff changeset
   171
        end;
8b3575750cd2 Added auto cropping to atlasing
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7297
diff changeset
   172
end;
8b3575750cd2 Added auto cropping to atlasing
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7297
diff changeset
   173
10018
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   174
procedure PrettifySurfaceAlpha(surf: PSDL_Surface; pixels: PLongwordArray);
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   175
var
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   176
    // current row index, second last row index of array, width and first/last i of row
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   177
    r, slr, w, si, li: LongWord;
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   178
begin
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   179
    w:= surf^.w;
11487
8e221d2a368e don't attempt to prettify alpha of single-pixel textures (segfault with "digital" theme from forums)
sheepluva
parents: 11362
diff changeset
   180
    // just a single pixel, nothing to do here
8e221d2a368e don't attempt to prettify alpha of single-pixel textures (segfault with "digital" theme from forums)
sheepluva
parents: 11362
diff changeset
   181
    if (w < 2) and (surf^.h < 2) then
8e221d2a368e don't attempt to prettify alpha of single-pixel textures (segfault with "digital" theme from forums)
sheepluva
parents: 11362
diff changeset
   182
        exit;
10018
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   183
    slr:= surf^.h - 2;
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   184
    si:= 0;
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   185
    li:= w - 1;
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   186
    for r:= 0 to slr do
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   187
        begin
10021
7f36194af01c no idea how I ended up forgetting about the offset I need for same position in different rows (in 1d array); also remove obsolete comment
sheepluva
parents: 10018
diff changeset
   188
        PrettifyAlpha(pixels, pixels, si, li, w);
10018
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   189
        // move indices to next row
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   190
        si:= si + w;
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   191
        li:= li + w;
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   192
        end;
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   193
    // don't forget last row
10021
7f36194af01c no idea how I ended up forgetting about the offset I need for same position in different rows (in 1d array); also remove obsolete comment
sheepluva
parents: 10018
diff changeset
   194
    PrettifyAlpha(pixels, nil, si, li, w);
10018
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   195
end;
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   196
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   197
procedure PrettifyAlpha2D(pixels: TLandArray; height, width: LongWord);
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   198
var
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   199
    // current y; last x, second last y of array;
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   200
    y, lx, sly: LongWord;
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   201
begin
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   202
    sly:= height - 2;
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   203
    lx:= width - 1;
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   204
    for y:= 0 to sly do
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   205
        begin
10021
7f36194af01c no idea how I ended up forgetting about the offset I need for same position in different rows (in 1d array); also remove obsolete comment
sheepluva
parents: 10018
diff changeset
   206
        PrettifyAlpha(PLongWordArray(pixels[y]), PLongWordArray(pixels[y+1]), 0, lx, 0);
10018
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   207
        end;
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   208
    // don't forget last row
10021
7f36194af01c no idea how I ended up forgetting about the offset I need for same position in different rows (in 1d array); also remove obsolete comment
sheepluva
parents: 10018
diff changeset
   209
    PrettifyAlpha(PLongWordArray(pixels[sly+1]), nil, 0, lx, 0);
10018
bdf75f0350bd (experimental) merging the new procedures for different pixel representations (1D/2D arrays) into a single procedure with the algorithm and two procedures for the different mapping. - because redundant code sucks (at least twice)
sheepluva
parents: 10016
diff changeset
   210
end;
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6394
diff changeset
   211
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   212
function Surface2Tex(surf: PSDL_Surface; enableClamp: boolean): PTexture;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   213
var tw, th, x, y: Longword;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   214
    tmpp: pointer;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   215
    fromP4, toP4: PLongWordArray;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   216
begin
8027
e5ba3dd12531 make stats-only mode work headless. also skip a few things to save time/memory.
nemo
parents: 7151
diff changeset
   217
if cOnlyStats then exit(nil);
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   218
new(Surface2Tex);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   219
Surface2Tex^.PrevTexture:= nil;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   220
Surface2Tex^.NextTexture:= nil;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   221
if TextureList <> nil then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   222
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   223
    TextureList^.PrevTexture:= Surface2Tex;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   224
    Surface2Tex^.NextTexture:= TextureList
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   225
    end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   226
TextureList:= Surface2Tex;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   227
12843
8599a7d4df54 init priority and scale
nemo
parents: 12765
diff changeset
   228
Surface2Tex^.Scale:= 1;
8599a7d4df54 init priority and scale
nemo
parents: 12765
diff changeset
   229
Surface2Tex^.Priority:= 0;
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   230
Surface2Tex^.w:= surf^.w;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   231
Surface2Tex^.h:= surf^.h;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   232
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   233
if (surf^.format^.BytesPerPixel <> 4) then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   234
    begin
11532
bf86c6cb9341 Bye-bye TryDo
unc0rr
parents: 11507
diff changeset
   235
    checkFails(false, 'Surface2Tex failed, expecting 32 bit surface', true);
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   236
    Surface2Tex^.id:= 0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   237
    exit
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
glGenTextures(1, @Surface2Tex^.id);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   241
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   242
glBindTexture(GL_TEXTURE_2D, Surface2Tex^.id);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   243
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   244
if SDL_MustLock(surf) then
11507
bd9a2f1b0080 SDLTry doesn't halt engine no more
unc0rr
parents: 11487
diff changeset
   245
    if SDLCheck(SDL_LockSurface(surf) >= 0, 'Lock surface', true) then
bd9a2f1b0080 SDLTry doesn't halt engine no more
unc0rr
parents: 11487
diff changeset
   246
        exit(nil);
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   247
5441
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   248
fromP4:= Surf^.pixels;
39962b855540 Add grayscale option for 3d, helps with colour clashing
nemo
parents: 4976
diff changeset
   249
12765
d01e9dd5c439 checksum immediately after loading because surface2tex does surface manipulation. also add some FIXMEs
nemo
parents: 11532
diff changeset
   250
// FIXME move out of surface2tex
6982
8d41d22a291d breaking news, we don't support typed consts anymore
koda
parents: 6700
diff changeset
   251
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
   252
    Surface2GrayScale(Surf);
6303
3edb3c857995 Add missing grayscale conversions
nemo
parents: 5441
diff changeset
   253
12765
d01e9dd5c439 checksum immediately after loading because surface2tex does surface manipulation. also add some FIXMEs
nemo
parents: 11532
diff changeset
   254
// FIXME move out of surface2tex
10016
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   255
PrettifySurfaceAlpha(surf, fromP4);
59a6d65fcb60 (experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish
sheepluva
parents: 9998
diff changeset
   256
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   257
if (not SupportNPOTT) and (not (isPowerOf2(Surf^.w) and isPowerOf2(Surf^.h))) then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   258
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   259
    tw:= toPowerOf2(Surf^.w);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   260
    th:= toPowerOf2(Surf^.h);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   261
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   262
    Surface2Tex^.rx:= Surf^.w / tw;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   263
    Surface2Tex^.ry:= Surf^.h / th;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   264
7151
ec15d9e1a7e3 pas2c stuff
unc0rr
parents: 6982
diff changeset
   265
    tmpp:= GetMem(tw * th * surf^.format^.BytesPerPixel);
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   266
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   267
    fromP4:= Surf^.pixels;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   268
    toP4:= tmpp;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   269
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   270
    for y:= 0 to Pred(Surf^.h) do
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   271
        begin
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
   272
        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
   273
            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
   274
        for x:= Surf^.w to Pred(tw) do
10155
ac01a2aeff69 change how textures from non-power-of-2-width textures are filled. this fixes e.g. the vertical lines appearing between Bath theme's horizontL
sheepluva
parents: 10131
diff changeset
   275
            toP4^[x]:= fromP4^[0];
10131
4b4a043111f4 - pas2c recognizes typecasts in initialization expressions
unc0rr
parents: 10108
diff changeset
   276
        toP4:= PLongWordArray(@(toP4^[tw]));
4b4a043111f4 - pas2c recognizes typecasts in initialization expressions
unc0rr
parents: 10108
diff changeset
   277
        fromP4:= PLongWordArray(@(fromP4^[Surf^.pitch div 4]))
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   278
        end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   279
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   280
    for y:= Surf^.h to Pred(th) do
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   281
        begin
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
   282
        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
   283
            toP4^[x]:= 0;
10131
4b4a043111f4 - pas2c recognizes typecasts in initialization expressions
unc0rr
parents: 10108
diff changeset
   284
        toP4:= PLongWordArray(@(toP4^[tw]))
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   285
        end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   286
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   287
    glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, tw, th, 0, GL_RGBA, GL_UNSIGNED_BYTE, tmpp);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   288
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   289
    FreeMem(tmpp, tw * th * surf^.format^.BytesPerPixel)
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   290
    end
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   291
else
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   292
    begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   293
    Surface2Tex^.rx:= 1.0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   294
    Surface2Tex^.ry:= 1.0;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   295
    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
   296
    end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   297
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   298
ResetVertexArrays(Surface2Tex);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   299
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   300
if SDL_MustLock(surf) then
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   301
    SDL_UnlockSurface(surf);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   302
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   303
SetTextureParameters(enableClamp);
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   304
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   305
4901
d1e2d82d9ccc Thou shalt not leak!
sheepluva
parents: 4403
diff changeset
   306
// deletes texture and frees the memory allocated for it.
d1e2d82d9ccc Thou shalt not leak!
sheepluva
parents: 4403
diff changeset
   307
// if nil is passed nothing is done
9655
e154ccca4dad Tinted crosshair (without that cool white dot in the middle)
unc0rr
parents: 9080
diff changeset
   308
procedure FreeAndNilTexture(var tex: PTexture);
e154ccca4dad Tinted crosshair (without that cool white dot in the middle)
unc0rr
parents: 9080
diff changeset
   309
begin
7304
8b3575750cd2 Added auto cropping to atlasing
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7297
diff changeset
   310
    if tex <> nil then
8b3575750cd2 Added auto cropping to atlasing
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7297
diff changeset
   311
        begin
10647
90062f7a3103 merge FreeTexture into FreeAndNilTexture
sheepluva
parents: 10634
diff changeset
   312
        if tex^.NextTexture <> nil then
90062f7a3103 merge FreeTexture into FreeAndNilTexture
sheepluva
parents: 10634
diff changeset
   313
            tex^.NextTexture^.PrevTexture:= tex^.PrevTexture;
90062f7a3103 merge FreeTexture into FreeAndNilTexture
sheepluva
parents: 10634
diff changeset
   314
        if tex^.PrevTexture <> nil then
90062f7a3103 merge FreeTexture into FreeAndNilTexture
sheepluva
parents: 10634
diff changeset
   315
            tex^.PrevTexture^.NextTexture:= tex^.NextTexture
90062f7a3103 merge FreeTexture into FreeAndNilTexture
sheepluva
parents: 10634
diff changeset
   316
        else
90062f7a3103 merge FreeTexture into FreeAndNilTexture
sheepluva
parents: 10634
diff changeset
   317
            TextureList:= tex^.NextTexture;
90062f7a3103 merge FreeTexture into FreeAndNilTexture
sheepluva
parents: 10634
diff changeset
   318
        glDeleteTextures(1, @tex^.id);
90062f7a3103 merge FreeTexture into FreeAndNilTexture
sheepluva
parents: 10634
diff changeset
   319
        Dispose(tex);
90062f7a3103 merge FreeTexture into FreeAndNilTexture
sheepluva
parents: 10634
diff changeset
   320
        tex:= nil;
7304
8b3575750cd2 Added auto cropping to atlasing
Wolfgang Steffens <WolfgangSteff@gmail.com>
parents: 7297
diff changeset
   321
        end;
9655
e154ccca4dad Tinted crosshair (without that cool white dot in the middle)
unc0rr
parents: 9080
diff changeset
   322
end;
e154ccca4dad Tinted crosshair (without that cool white dot in the middle)
unc0rr
parents: 9080
diff changeset
   323
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   324
procedure initModule;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   325
begin
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   326
TextureList:= nil;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   327
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   328
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   329
procedure freeModule;
10647
90062f7a3103 merge FreeTexture into FreeAndNilTexture
sheepluva
parents: 10634
diff changeset
   330
var tex: PTexture;
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   331
begin
6580
6155187bf599 A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents: 6467
diff changeset
   332
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
   333
    WriteToConsole('FIXME FIXME FIXME. App shutdown without full cleanup of texture list; read game0.log and please report this problem');
10017
de822cd3df3a fixwhitespace and dos2unix
koda
parents: 9998
diff changeset
   334
    while TextureList <> nil do
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
   335
        begin
10647
90062f7a3103 merge FreeTexture into FreeAndNilTexture
sheepluva
parents: 10634
diff changeset
   336
        tex:= TextureList;
90062f7a3103 merge FreeTexture into FreeAndNilTexture
sheepluva
parents: 10634
diff changeset
   337
        AddFileLog('Texture not freed: width='+inttostr(LongInt(tex^.w))+' height='+inttostr(LongInt(tex^.h))+' priority='+inttostr(round(tex^.priority*1000)));
90062f7a3103 merge FreeTexture into FreeAndNilTexture
sheepluva
parents: 10634
diff changeset
   338
        FreeAndNilTexture(tex);
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
   339
        end
4375
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   340
end;
ae5507ddb989 Introduce uTextures
unC0Rr
parents:
diff changeset
   341
4901
d1e2d82d9ccc Thou shalt not leak!
sheepluva
parents: 4403
diff changeset
   342
end.