hedgewars/uTextures.pas
author nemo
Mon, 08 Dec 2014 09:35:14 -0500
changeset 10634 35d059bd0932
parent 10155 ac01a2aeff69
child 10647 90062f7a3103
permissions -rw-r--r--
Use FreeAndNil across the board. Even if we are immediately assigning after, probably avoids accidental mistakes. Also free neglected owner tex on shutdown, and delete hog gears using the normal deletion procedure if for any reason they still exist (EndGame call?).

(*
 * Hedgewars, a free turn based strategy game
 * Copyright (c) 2004-2014 Andrey Korotaev <unC0Rr@gmail.com>
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; version 2 of the License
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
 *)

{$INCLUDE "options.inc"}

unit uTextures;
interface
uses SDLh, uTypes;

function  NewTexture(width, height: Longword; buf: Pointer): PTexture;
procedure Surface2GrayScale(surf: PSDL_Surface);
function  Surface2Tex(surf: PSDL_Surface; enableClamp: boolean): PTexture;
procedure PrettifySurfaceAlpha(surf: PSDL_Surface; pixels: PLongwordArray);
procedure PrettifyAlpha2D(pixels: TLandArray; height, width: LongWord);
procedure FreeTexture(tex: PTexture);
procedure FreeAndNilTexture(var tex: PTexture); inline;

procedure initModule;
procedure freeModule;

implementation
uses GLunit, uUtils, uVariables, uConsts, uDebug, uConsole;

var TextureList: PTexture;


procedure SetTextureParameters(enableClamp: Boolean);
begin
    if enableClamp and ((cReducedQuality and rqClampLess) = 0) then
        begin
        glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
        glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE)
        end;
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR)
end;

procedure ResetVertexArrays(texture: PTexture);
begin
with texture^ do
    begin
    vb[0].X:= 0;
    vb[0].Y:= 0;
    vb[1].X:= w;
    vb[1].Y:= 0;
    vb[2].X:= w;
    vb[2].Y:= h;
    vb[3].X:= 0;
    vb[3].Y:= h;

    tb[0].X:= 0;
    tb[0].Y:= 0;
    tb[1].X:= rx;
    tb[1].Y:= 0;
    tb[2].X:= rx;
    tb[2].Y:= ry;
    tb[3].X:= 0;
    tb[3].Y:= ry
    end;
end;

function NewTexture(width, height: Longword; buf: Pointer): PTexture;
begin
new(NewTexture);
NewTexture^.PrevTexture:= nil;
NewTexture^.NextTexture:= nil;
NewTexture^.Scale:= 1;
if TextureList <> nil then
    begin
    TextureList^.PrevTexture:= NewTexture;
    NewTexture^.NextTexture:= TextureList
    end;
TextureList:= NewTexture;

NewTexture^.w:= width;
NewTexture^.h:= height;
NewTexture^.rx:= 1.0;
NewTexture^.ry:= 1.0;

ResetVertexArrays(NewTexture);

glGenTextures(1, @NewTexture^.id);

glBindTexture(GL_TEXTURE_2D, NewTexture^.id);
glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, width, height, 0, GL_RGBA, GL_UNSIGNED_BYTE, buf);

SetTextureParameters(true);
end;

procedure Surface2GrayScale(surf: PSDL_Surface);
var tw, x, y: Longword;
    fromP4: PLongWordArray;
begin
fromP4:= Surf^.pixels;
for y:= 0 to Pred(Surf^.h) do
    begin
    for x:= 0 to Pred(Surf^.w) do
        begin
        tw:= fromP4^[x];
        tw:= round((tw shr RShift and $FF) * RGB_LUMINANCE_RED +
              (tw shr GShift and $FF) * RGB_LUMINANCE_GREEN +
              (tw shr BShift and $FF) * RGB_LUMINANCE_BLUE);
        if tw > 255 then tw:= 255;
        tw:= (tw and $FF shl RShift) or (tw and $FF shl BShift) or (tw and $FF shl GShift) or (fromP4^[x] and AMask);
        fromP4^[x]:= tw;
        end;
    fromP4:= PLongWordArray(@(fromP4^[Surf^.pitch div 4]))
    end;
end;

{ this will make invisible pixels that have a visible neighbor have the
  same color as their visible neighbor, so that bilinear filtering won't
  display a "wrongly" colored border when zoomed in }
procedure PrettifyAlpha(row1, row2: PLongwordArray; firsti, lasti, ioffset: LongWord);
var
    i: Longword;
    lpi, cpi, bpi: boolean; // was last/current/bottom neighbor pixel invisible?
begin
    // suppress incorrect warning
    lpi:= true;
    for i:=firsti to lasti do
        begin
        // use first pixel in row1 as starting point
        if i = firsti then
            cpi:= ((row1^[i] and AMask) = 0)
        else
            begin
            cpi:= ((row1^[i] and AMask) = 0);
            if cpi <> lpi then
                begin
                // invisible pixels get colors from visible neighbors
                if cpi then
                    begin
                    row1^[i]:= row1^[i-1] and (not AMask);
                    // as this pixel is invisible and already colored correctly now, no point in further comparing it
                    lpi:= cpi;
                    continue;
                    end
                else
                    row1^[i-1]:= row1^[i] and (not AMask);
                end;
            end;
        lpi:= cpi;
        // also check bottom neighbor
        if row2 <> nil then
            begin
            bpi:= ((row2^[i+ioffset] and AMask) = 0);
            if cpi <> bpi then
                begin
                if cpi then
                    row1^[i]:= row2^[i+ioffset] and (not AMask)
                else
                    row2^[i+ioffset]:= row1^[i] and (not AMask);
                end;
            end;
        end;
end;

procedure PrettifySurfaceAlpha(surf: PSDL_Surface; pixels: PLongwordArray);
var
    // current row index, second last row index of array, width and first/last i of row
    r, slr, w, si, li: LongWord;
begin
    w:= surf^.w;
    slr:= surf^.h - 2;
    si:= 0;
    li:= w - 1;
    for r:= 0 to slr do
        begin
        PrettifyAlpha(pixels, pixels, si, li, w);
        // move indices to next row
        si:= si + w;
        li:= li + w;
        end;
    // don't forget last row
    PrettifyAlpha(pixels, nil, si, li, w);
end;

procedure PrettifyAlpha2D(pixels: TLandArray; height, width: LongWord);
var
    // current y; last x, second last y of array;
    y, lx, sly: LongWord;
begin
    sly:= height - 2;
    lx:= width - 1;
    for y:= 0 to sly do
        begin
        PrettifyAlpha(PLongWordArray(pixels[y]), PLongWordArray(pixels[y+1]), 0, lx, 0);
        end;
    // don't forget last row
    PrettifyAlpha(PLongWordArray(pixels[sly+1]), nil, 0, lx, 0);
end;

function Surface2Tex(surf: PSDL_Surface; enableClamp: boolean): PTexture;
var tw, th, x, y: Longword;
    tmpp: pointer;
    fromP4, toP4: PLongWordArray;
begin
if cOnlyStats then exit(nil);
new(Surface2Tex);
Surface2Tex^.PrevTexture:= nil;
Surface2Tex^.NextTexture:= nil;
if TextureList <> nil then
    begin
    TextureList^.PrevTexture:= Surface2Tex;
    Surface2Tex^.NextTexture:= TextureList
    end;
TextureList:= Surface2Tex;

Surface2Tex^.w:= surf^.w;
Surface2Tex^.h:= surf^.h;

if (surf^.format^.BytesPerPixel <> 4) then
    begin
    TryDo(false, 'Surface2Tex failed, expecting 32 bit surface', true);
    Surface2Tex^.id:= 0;
    exit
    end;

glGenTextures(1, @Surface2Tex^.id);

glBindTexture(GL_TEXTURE_2D, Surface2Tex^.id);

if SDL_MustLock(surf) then
    SDLTry(SDL_LockSurface(surf) >= 0, true);

fromP4:= Surf^.pixels;

if GrayScale then
    Surface2GrayScale(Surf);

PrettifySurfaceAlpha(surf, fromP4);

if (not SupportNPOTT) and (not (isPowerOf2(Surf^.w) and isPowerOf2(Surf^.h))) then
    begin
    tw:= toPowerOf2(Surf^.w);
    th:= toPowerOf2(Surf^.h);

    Surface2Tex^.rx:= Surf^.w / tw;
    Surface2Tex^.ry:= Surf^.h / th;

    tmpp:= GetMem(tw * th * surf^.format^.BytesPerPixel);

    fromP4:= Surf^.pixels;
    toP4:= tmpp;

    for y:= 0 to Pred(Surf^.h) do
        begin
        for x:= 0 to Pred(Surf^.w) do
            toP4^[x]:= fromP4^[x];
        for x:= Surf^.w to Pred(tw) do
            toP4^[x]:= fromP4^[0];
        toP4:= PLongWordArray(@(toP4^[tw]));
        fromP4:= PLongWordArray(@(fromP4^[Surf^.pitch div 4]))
        end;

    for y:= Surf^.h to Pred(th) do
        begin
        for x:= 0 to Pred(tw) do
            toP4^[x]:= 0;
        toP4:= PLongWordArray(@(toP4^[tw]))
        end;

    glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, tw, th, 0, GL_RGBA, GL_UNSIGNED_BYTE, tmpp);

    FreeMem(tmpp, tw * th * surf^.format^.BytesPerPixel)
    end
else
    begin
    Surface2Tex^.rx:= 1.0;
    Surface2Tex^.ry:= 1.0;
    glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, surf^.w, surf^.h, 0, GL_RGBA, GL_UNSIGNED_BYTE, surf^.pixels);
    end;

ResetVertexArrays(Surface2Tex);

if SDL_MustLock(surf) then
    SDL_UnlockSurface(surf);

SetTextureParameters(enableClamp);
end;

// deletes texture and frees the memory allocated for it.
// if nil is passed nothing is done
procedure FreeTexture(tex: PTexture);
begin
if tex <> nil then
    begin
    if tex^.NextTexture <> nil then
        tex^.NextTexture^.PrevTexture:= tex^.PrevTexture;
    if tex^.PrevTexture <> nil then
        tex^.PrevTexture^.NextTexture:= tex^.NextTexture
    else
        TextureList:= tex^.NextTexture;
    glDeleteTextures(1, @tex^.id);
    Dispose(tex);
    end
end;

procedure FreeAndNilTexture(var tex: PTexture); inline;
begin
    FreeTexture(tex);
    tex:= nil
end;

procedure initModule;
begin
TextureList:= nil;
end;

procedure freeModule;
begin
if TextureList <> nil then
    WriteToConsole('FIXME FIXME FIXME. App shutdown without full cleanup of texture list; read game0.log and please report this problem');
    while TextureList <> nil do
        begin
        AddFileLog('Texture not freed: width='+inttostr(LongInt(TextureList^.w))+' height='+inttostr(LongInt(TextureList^.h))+' priority='+inttostr(round(TextureList^.priority*1000)));
        FreeTexture(TextureList);
        end
end;

end.