(*
 * 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 uLandTexture;
interface
uses SDLh;

procedure initModule;
procedure freeModule;
procedure UpdateLandTexture(X, Width, Y, Height: LongInt; landAdded: boolean);
procedure DrawLand(dX, dY: LongInt);
procedure ResetLand;
procedure SetLandTexture;

implementation
uses uConsts, GLunit, uTypes, uVariables, uTextures, uDebug, uRender, uUtils;

const TEXSIZE = 128;
      // in avoid tile borders stretch the blurry texture by 1 pixel more
      BLURRYLANDOVERLAP: real = 1 / TEXSIZE / 2.0; // 1 pixel divided by texsize and blurry land scale factor

type TLandRecord = record
            shouldUpdate, landAdded: boolean;
            tex: PTexture;
            end;

var LandTextures: array of array of TLandRecord;
    tmpPixels: array [0..TEXSIZE - 1, 0..TEXSIZE - 1] of LongWord;
    LANDTEXARW: LongWord;
    LANDTEXARH: LongWord;

function Pixels(x, y: Longword): Pointer;
var ty: Longword;
begin
for ty:= 0 to TEXSIZE - 1 do
    Move(LandPixels[y * TEXSIZE + ty, x * TEXSIZE], tmpPixels[ty, 0], sizeof(Longword) * TEXSIZE);

Pixels:= @tmpPixels
end;

function Pixels2(x, y: Longword): Pointer;
var tx, ty: Longword;
begin
for ty:= 0 to TEXSIZE - 1 do
    for tx:= 0 to TEXSIZE - 1 do
        tmpPixels[ty, tx]:= Land[y * TEXSIZE + ty, x * TEXSIZE + tx] or AMask;

Pixels2:= @tmpPixels
end;

procedure UpdateLandTexture(X, Width, Y, Height: LongInt; landAdded: boolean);
var tx, ty: Longword;
    tSize : LongInt;
begin
    if cOnlyStats then exit;
    if (Width <= 0) or (Height <= 0) then
        exit;
    TryDo((X >= 0) and (X < LAND_WIDTH), 'UpdateLandTexture: wrong X parameter', true);
    TryDo(X + Width <= LAND_WIDTH, 'UpdateLandTexture: wrong Width parameter', true);
    TryDo((Y >= 0) and (Y < LAND_HEIGHT), 'UpdateLandTexture: wrong Y parameter', true);
    TryDo(Y + Height <= LAND_HEIGHT, 'UpdateLandTexture: wrong Height parameter', true);

    tSize:= TEXSIZE;

    // land textures have half the size/resolution in blurry mode
    if (cReducedQuality and rqBlurryLand) <> 0 then
        tSize:= tSize * 2;

    for ty:= Y div tSize to (Y + Height - 1) div tSize do
        for tx:= X div tSize to (X + Width - 1) div tSize do
            begin
            if not LandTextures[tx, ty].shouldUpdate then
                begin
                LandTextures[tx, ty].shouldUpdate:= true;
                inc(dirtyLandTexCount);
                end;
            LandTextures[tx, ty].landAdded:= landAdded
            end;
end;

procedure RealLandTexUpdate(x1, x2, y1, y2: LongInt);
var x, y, ty, tx, lx, ly : LongWord;
    isEmpty: boolean;
begin
    if cOnlyStats then exit;
(*
if LandTextures[0, 0].tex = nil then
    for x:= 0 to LANDTEXARW -1 do
        for y:= 0 to LANDTEXARH - 1 do
            with LandTextures[x, y] do
                begin
                tex:= NewTexture(TEXSIZE, TEXSIZE, Pixels(x, y));
                glBindTexture(GL_TEXTURE_2D, tex^.id);
                glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_PRIORITY, tpHigh);
                end
else
*)
    for x:= x1 to x2 do
        for y:= y1 to y2 do
            with LandTextures[x, y] do
                if shouldUpdate then
                    begin
                    shouldUpdate:= false;
                    dec(dirtyLandTexCount);
                    isEmpty:= not landAdded;
                    landAdded:= false;
                    ty:= 0;
                    tx:= 1;
                    ly:= y * TEXSIZE;
                    lx:= x * TEXSIZE;
                    // first check edges
                    while isEmpty and (ty < TEXSIZE) do
                        begin
                        isEmpty:= LandPixels[ly + ty, lx] and AMask = 0;
                        if isEmpty then isEmpty:= LandPixels[ly + ty, Pred(lx + TEXSIZE)] and AMask = 0;
                        inc(ty)
                        end;
                    while isEmpty and (tx < TEXSIZE-1) do
                        begin
                        isEmpty:= LandPixels[ly, lx + tx] and AMask = 0;
                        if isEmpty then isEmpty:= LandPixels[Pred(ly + TEXSIZE), lx + tx] and AMask = 0;
                        inc(tx)
                        end;
                    // then search every other remaining. does this sort of stuff defeat compiler opts?
                    ty:= 2;
                    while isEmpty and (ty < TEXSIZE-1) do
                        begin
                        tx:= 2;
                        while isEmpty and (tx < TEXSIZE-1) do
                            begin
                            isEmpty:= LandPixels[ly + ty, lx + tx] and AMask = 0;
                            inc(tx,2)
                            end;
                        inc(ty,2);
                        end;
                    // and repeat
                    ty:= 1;
                    while isEmpty and (ty < TEXSIZE-1) do
                        begin
                        tx:= 1;
                        while isEmpty and (tx < TEXSIZE-1) do
                            begin
                            isEmpty:= LandPixels[ly + ty, lx + tx] and AMask = 0;
                            inc(tx,2)
                            end;
                        inc(ty,2);
                        end;
                    if not isEmpty then
                        begin
                        if tex = nil then tex:= NewTexture(TEXSIZE, TEXSIZE, Pixels(x, y));
                        glBindTexture(GL_TEXTURE_2D, tex^.id);
                        glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, TEXSIZE, TEXSIZE, 0, GL_RGBA, GL_UNSIGNED_BYTE, Pixels(x,y));
                        end
                    else if tex <> nil then
                        FreeAndNilTexture(tex);

                    // nothing else to do
                    if dirtyLandTexCount < 1 then
                        exit;
                    end
end;

procedure DrawLand(dX, dY: LongInt);
var x, y, tX, ty, tSize, fx, lx, fy, ly: LongInt;
    tScale: GLfloat;
    overlap: boolean;
begin
// init values based on quality settings
if (cReducedQuality and rqBlurryLand) <> 0 then
    begin
    tSize:= TEXSIZE * 2;
    tScale:= 2.0;
    overlap:= (cReducedQuality and rqClampLess) <> 0;
    end
else
    begin
    tSize:= TEXSIZE;
    tScale:= 1.0;
    overlap:= false;
    end;

// figure out visible area
// first column
tx:= ViewLeftX - dx;
fx:= tx div tSize;
if tx < 0 then dec(fx);
fx:= max(0, fx);

// last column
tx:= ViewRightX - dx;
lx:= tx div tSize;
if tx < 0 then dec(lx);
lx:= min(LANDTEXARW -1, lx);

// all offscreen
if (fx > lx) then
    exit;

// first row
ty:= ViewTopY - dy;
fy:= ty div tSize;
if ty < 0 then dec(fy);
fy:= max(0, fy);

// last row
ty:= ViewBottomY - dy;
ly:= ty div tSize;
if ty < 0 then dec(ly);
ly:= min(LANDTEXARH -1, ly);

// all offscreen
if (fy > ly) then
    exit;

// update visible areas of landtex before drawing
if dirtyLandTexCount > 0 then
    RealLandTexUpdate(fx, lx, fy, ly);

tX:= dX + tsize * fx;

// loop through columns
for x:= fx to lx do
    begin
    // loop through textures in this column
    for y:= fy to ly do
        with LandTextures[x, y] do
            if tex <> nil then
                begin
                ty:= dY + y * tSize;
                if overlap then
                    DrawTexture2(tX, ty, tex, tScale, BLURRYLANDOVERLAP)
                else
                    DrawTexture(tX, ty, tex, tScale);
                end;

    // increment tX
    inc(tX, tSize);
    end;
end;

procedure SetLandTexture;
begin
    if (cReducedQuality and rqBlurryLand) = 0 then
        begin
        LANDTEXARW:= LAND_WIDTH div TEXSIZE;
        LANDTEXARH:= LAND_HEIGHT div TEXSIZE;
        end
    else
        begin
        LANDTEXARW:= (LAND_WIDTH div TEXSIZE) div 2;
        LANDTEXARH:= (LAND_HEIGHT div TEXSIZE) div 2;
        end;

    SetLength(LandTextures, LANDTEXARW, LANDTEXARH);
end;

procedure initModule;
begin
end;

procedure ResetLand;
var x, y: LongInt;
begin
    for x:= 0 to LANDTEXARW - 1 do
        for y:= 0 to LANDTEXARH - 1 do
            with LandTextures[x, y] do
                if tex <> nil then
                    FreeAndNilTexture(tex)
end;

procedure freeModule;
begin
    ResetLand;
    if LandBackSurface <> nil then
        SDL_FreeSurface(LandBackSurface);
    LandBackSurface:= nil;
    SetLength(LandTextures, 0, 0);
end;
end.