(*

 * Hedgewars, a free turn based strategy game

 * Copyright (c) 2004-2015 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 uLand;

interface

uses SDLh, uLandTemplates, uConsts, uTypes, uAILandMarks;

procedure initModule;

procedure freeModule;

procedure DrawBottomBorder;

procedure GenMap;

procedure GenPreview(out Preview: TPreview);

procedure GenPreviewAlpha(out Preview: TPreviewAlpha);

implementation

uses uConsole, uStore, uRandom, uLandObjects, uIO, uLandTexture,

     uVariables, uUtils, uCommands, adler32, uDebug, uLandPainted, uTextures,

     uLandGenMaze, uPhysFSLayer, uScript, uLandGenPerlin,

     uLandGenTemplateBased, uLandUtils, uRenderUtils;

var digest: shortstring;

    maskOnly: boolean;

procedure PrettifyLandAlpha();

begin

    if (cReducedQuality and rqBlurryLand) <> 0 then

        PrettifyAlpha2D(LAND_HEIGHT div 2, LAND_WIDTH div 2)

    else

        PrettifyAlpha2D(LAND_HEIGHT, LAND_WIDTH);

end;

procedure DrawBorderFromImage(Surface: PSDL_Surface);

var tmpsurf: PSDL_Surface;

    x, yd, yu: LongInt;

    targetMask: Word;

begin

    tmpsurf:= LoadDataImage(ptCurrTheme, 'Border', ifCritical or ifIgnoreCaps or ifColorKey);

    // if mask only, all land gets filled with landtex and therefore needs borders

    if maskOnly then

        targetMask:= lfLandMask

    else

        targetMask:= lfBasic;

    for x:= 0 to LAND_WIDTH - 1 do

    begin

        yd:= LAND_HEIGHT - 1;

        repeat

            while (yd > 0) and ((LandGet(yd, x) and targetMask) = 0) do dec(yd);

            if (yd < 0) then

                yd:= 0;

            while (yd < LAND_HEIGHT) and ((LandGet(yd, x) and targetMask) <> 0) do

                inc(yd);

            dec(yd);

            yu:= yd;

            while (yu > 0  ) and ((LandGet(yu, x) and targetMask) <> 0) do dec(yu);

            while (yu < yd ) and ((LandGet(yu, x) and targetMask) =  0) do inc(yu);

            if (yd < LAND_HEIGHT - 1) and ((yd - yu) >= 16) then

                copyToXYFromRect(tmpsurf, Surface, x mod tmpsurf^.w, 16, 1, 16, x, yd - 15);

            if (yu > 0) then

                copyToXYFromRect(tmpsurf, Surface, x mod tmpsurf^.w, 0, 1, Min(16, yd - yu + 1), x, yu);

            yd:= yu - 1;

        until yd < 0;

    end;

    SDL_FreeSurface(tmpsurf);

end;

procedure DrawShoppaBorder;

var x, y, s, i: Longword;

    c1, c2, c: Longword;

begin

    c1:= AMask;

    c2:= AMask or RMask or GMask;

    // vertical

    s:= LAND_HEIGHT;

    for x:= 0 to LAND_WIDTH - 1 do

        for y:= 0 to LAND_HEIGHT - 1 do

            if LandGet(y, x) = 0 then

                if s < y then

                    begin

                    for i:= max(s, y - 8) to y - 1 do

                        begin

                        if ((x + i) and 16) = 0 then c:= c1 else c:= c2;

                        if (cReducedQuality and rqBlurryLand) = 0 then

                            LandPixelSet(i, x, c)

                        else

                            LandPixelSet(i div 2, x div 2, c)

                        end;

                    s:= LAND_HEIGHT

                    end

                else

            else

                begin

                if s > y then s:= y;

                if s + 8 > y then

                    begin

                    if ((x + y) and 16) = 0 then c:= c1 else c:= c2;

                    if (cReducedQuality and rqBlurryLand) = 0 then

                        LandPixelSet(y, x, c)

                    else

                        LandPixelSet(y div 2, x div 2, c)

                    end;

                end;

    // horizontal

    s:= LAND_WIDTH;

    for y:= 0 to LAND_HEIGHT - 1 do

        for x:= 0 to LAND_WIDTH - 1 do

            if LandGet(y, x) = 0 then

                if s < x then

                    begin

                    for i:= max(s, x - 8) to x - 1 do

                        begin

                        if ((y + i) and 16) = 0 then c:= c1 else c:= c2;

                        if (cReducedQuality and rqBlurryLand) = 0 then

                            LandPixelSet(y, i, c)

                        else

                            LandPixelSet(y div 2, i div 2, c)

                        end;

                    s:= LAND_WIDTH

                    end

                else

            else

                begin

                if s > x then s:= x;

                if s + 8 > x then

                    begin

                    if ((x + y) and 16) = 0 then c:= c1 else c:= c2;

                    if (cReducedQuality and rqBlurryLand) = 0 then

                        LandPixelSet(y, x, c)

                    else

                        LandPixelSet(y div 2, x div 2, c)

                    end;

                end

end;

procedure ColorizeLandFast(mapsurf: PSDL_Surface);

var ltexsurf: PSDL_Surface;

    i: LongInt;

    ltlnp, srcp, dstp, stopp: Pointer;

    c: SizeInt;

begin

    ltexsurf:= LoadDataImage(ptCurrTheme, 'LandTex', ifCritical or ifIgnoreCaps);

    // pointer to current line of ltexsurf pixels. will be moved from line to line

    ltlnp:= ltexsurf^.pixels;

    // pointer to mapsurf pixels. will jump forward after every move()

    dstp:= mapsurf^.pixels;

    // time to get serious

    SDL_LockSurface(mapsurf);

    SDL_LockSurface(ltexsurf);

    // for now only fill a row with the height of landtex. do vertical copies within mapsurf after

    // do this loop for each line of ltexsurf (unless we run out of map height first)

    for i:= 1 to min(ltexsurf^.h, mapsurf^.h) do

        begin

        // amount of pixels to write in first move()

        c:= ltexsurf^.pitch;

        // protect from odd cases where landtex wider than map

        if c > mapsurf^.pitch then

            c:= mapsurf^.pitch;

        // write line of landtex to mapsurf

        move(ltlnp^, dstp^, c);

        // fill the rest of the line by copying left-to-right until full

        // new src is start of line that we've just written to

        srcp:= dstp;

        // set stop pointer to start of next pixel line of mapsurf

        stopp:= dstp + mapsurf^.pitch;

        // move dst pointer to after what we've just written

        inc(dstp, c);

        // loop until dstp went past end of line

        while dstp < stopp do

            begin

            // copy all from left of dstp to right of it (or just fill the gap if smaller)

            c:= min(dstp-srcp, stopp-dstp);

            move(srcp^, dstp^, c);

            inc(dstp, c);

            end;

        // move to next line in ltexsurf

        inc(ltlnp, ltexsurf^.pitch);

        end;

    // we don't need ltexsurf itself anymore -> cleanup

    ltlnp:= nil;

    SDL_UnlockSurface(ltexsurf);

    SDL_FreeSurface(ltexsurf);

    ltexsurf:= nil;

    // from now on only copy pixels within mapsurf

    // copy all the already written lines at once for that get number of written bytes so far

    // already written pixels are between start and current dstp

    srcp:= mapsurf^.pixels;

    // first byte after end of pixels

    stopp:= srcp + (mapsurf^.pitch * mapsurf^.h);

    while dstp < stopp do

        begin

        // copy all from before dstp to after (or just fill the gap if smaller)

        c:= min(dstp-srcp, stopp-dstp);

        // worried about size of c with humongous maps? don't be:

        //  the OS wouldn't have allowed allocation of object with size > max of SizeInt anyway

        move(srcp^, dstp^, c);

        inc(dstp, c);

        end;

    // cleanup

    srcp:= nil;

    dstp:= nil;

    stopp:= nil;

    SDL_UnlockSurface(mapsurf);

    // freed in freeModule() below

    LandBackSurface:= LoadDataImage(ptCurrTheme, 'LandBackTex', ifIgnoreCaps or ifColorKey);

    if (LandBackSurface <> nil) and GrayScale then Surface2GrayScale(LandBackSurface);

end;

procedure ColorizeLand(Surface: PSDL_Surface);

var tmpsurf: PSDL_Surface;

    r: TSDL_Rect;

    y: LongInt; // stupid SDL 1.2 uses stupid SmallInt for y which limits us to 32767.  But is even worse if LandTex is large, can overflow on 32767 map.

begin

    tmpsurf:= LoadDataImage(ptCurrTheme, 'LandTex', ifCritical or ifIgnoreCaps);

    r.y:= 0;

    y:= 0;

    while y < LAND_HEIGHT do

        begin

        r.x:= 0;

        while r.x < LAND_WIDTH do

            begin

            copyToXY(tmpsurf, Surface, r.x, r.y);

            inc(r.x, tmpsurf^.w)

            end;

        inc(y, tmpsurf^.h);

        r.y:= y

        end;

    SDL_FreeSurface(tmpsurf);

    // freed in freeModule() below

    LandBackSurface:= LoadDataImage(ptCurrTheme, 'LandBackTex', ifIgnoreCaps or ifColorKey);

    if (LandBackSurface <> nil) and GrayScale then Surface2GrayScale(LandBackSurface);

end;

procedure GenDrawnMap;

var lowerX, upperX, lowerY, upperY, lowerFS, upperFS: LongInt;

begin

    if (cFeatureSize <= 6) then

        MaxHedgehogs:= 6 + (cFeatureSize-1) * 2

    else if (cFeatureSize < 11) then

        MaxHedgehogs:= 16 + (cFeatureSize-6) * 4

    else if (cFeatureSize = 11) then

        MaxHedgehogs:= 48

    else if (cFeatureSize = 12) then

        MaxHedgehogs:= 64

    else

        MaxHedgehogs:= cMaxHHs;

    if GameType = gmtLandPreview then

        cFeatureSize:= 1;

    // Calculate map size for drawn map, use cFeatureSize to scale.

    // We have pre-determined map size for cFeatureSize 1, 6, 12 and 25.

    // The other values will be interpolated.

    if cFeatureSize < 6 then

        begin

        // reference size for cFeatureSize 1

        lowerFS:= 1;

        lowerX:= 1024;

        lowerY:= 512;

        upperFS:= 6;

        end

    else if cFeatureSize < 12 then

        begin

        // reference size for cFeatureSize 6

        lowerFS:= 6;

        lowerX:= 2048;

        lowerY:= 1024;

        upperFS:= 12;

        end

    else

        begin

        // reference size for cFeatureSize 12, size of drawn maps in pre-1.0.0 versions

        lowerFS:= 12;

        lowerX:= 4096;

        lowerY:= 2048;

        upperFS:= 25;

        end;

    upperX:= lowerX * 2;

    upperY:= lowerY * 2;

    if cFeatureSize = 25 then

        begin

        // hardcoded size for size level 25

        playWidth:= 8192;

        playHeight:= 4096;

        end

    else

        begin

        // Interpolation formula

        playWidth:= lowerX + ((upperX-lowerX) div (upperFS-lowerFS))*(cFeatureSize-lowerFS);

        playHeight:= lowerY + ((upperY-lowerY) div (upperFS-lowerFS))*(cFeatureSize-lowerFS);

        end;

    if GameType <> gmtLandPreview then

        WriteLnToConsole('Drawn map size: cFeatureSize='+IntToStr(cFeatureSize)+' playWidth='+IntToStr(playWidth)+' playHeight='+IntToStr(playHeight));

    ResizeLand(playWidth, playHeight);

    hasGirders:= true;

    leftX:= ((LAND_WIDTH - playWidth) div 2);

    rightX:= (playWidth + ((LAND_WIDTH - playWidth) div 2)) - 1;

    topY:= LAND_HEIGHT - playHeight;

    uLandPainted.Draw;

end;

function SelectTemplate: shortstring;

var l: LongInt;

begin

    SelectTemplate:= '';

    if (cReducedQuality and rqLowRes) <> 0 then

        SelectTemplate:= 'small'

    else

        begin

        if cTemplateFilter = 0 then

            begin

            l:= getRandom(GroupedTemplatesCount);

            repeat

                inc(cTemplateFilter);

                dec(l, TemplateCounts[cTemplateFilter]);

            until l < 0;

            end

            else getRandom(1);

            case cTemplateFilter of

            0: OutError('Error selecting TemplateFilter. Ask unC0Rr about what you did wrong', true);

            1: SelectTemplate:= 'small';

            2: SelectTemplate:= 'medium';

            3: SelectTemplate:= 'large';

            4: SelectTemplate:= 'cavern';

            5: SelectTemplate:= 'wacky';

    // For lua only!

            6: begin

               SelectTemplate:= 'small';

               GetRandom(2) // burn 1

               end

            end

        end;

    WriteLnToConsole('Using template filter '+SelectTemplate);

end;

procedure LandSurface2LandPixels(Surface: PSDL_Surface);

var x, y: LongInt;

    p: PLongwordArray;

begin

if checkFails(Surface <> nil, 'Assert (LandSurface <> nil) failed', true) then exit;

if SDL_MustLock(Surface) then

    if SDLCheck(SDL_LockSurface(Surface) >= 0, 'SDL_LockSurface', true) then exit;

p:= Surface^.pixels;

for y:= 0 to LAND_HEIGHT - 1 do

    begin

    for x:= 0 to LAND_WIDTH - 1 do

    if LandGet(y, x) <> 0 then

        if (cReducedQuality and rqBlurryLand) = 0 then

            LandPixelSet(y, x, p^[x])// or AMask

        else

            LandPixelSet(y div 2, x div 2, p^[x]);

    p:= PLongwordArray(@(p^[Surface^.pitch div 4]));

    end;

if SDL_MustLock(Surface) then

    SDL_UnlockSurface(Surface);

end;

procedure GenLandSurface;

var tmpsurf: PSDL_Surface;

    x,y: Longword;

begin

    AddProgress();

    tmpsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, LAND_WIDTH, LAND_HEIGHT, 32, RMask, GMask, BMask, AMask);

    if checkFails(tmpsurf <> nil, 'Error creating pre-land surface', true) then exit;

    ColorizeLandFast(tmpsurf);

    if gameFlags and gfShoppaBorder = 0 then DrawBorderFromImage(tmpsurf);

    AddOnLandObjects(tmpsurf);

    LandSurface2LandPixels(tmpsurf);

    SDL_FreeSurface(tmpsurf);

    if gameFlags and gfShoppaBorder <> 0 then DrawShoppaBorder;

    for x:= LongWord(leftX+2) to LongWord(rightX-2) do

        for y:= LongWord(topY+2) to LAND_HEIGHT-3 do

            if (LandGet(y, x) = 0) and

               (((LandGet(y, x-1) = lfBasic) and ((LandGet(y+1,x) = lfBasic)) or (LandGet(y-1,x) = lfBasic)) or

               ((LandGet(y, x+1) = lfBasic) and ((LandGet(y-1,x) = lfBasic) or (LandGet(y+1,x) = lfBasic)))) then

            begin

                if (cReducedQuality and rqBlurryLand) = 0 then

                    begin

                    if (LandGet(y, x-1) = lfBasic) and (LandPixelGet(y, x-1) and AMask <> 0) then

                        LandPixelSet(y, x, LandPixelGet(y, x-1))

                    else if (LandGet(y, x+1) = lfBasic) and (LandPixelGet(y, x+1) and AMask <> 0) then

                        LandPixelSet(y, x, LandPixelGet(y, x+1))

                    else if (LandGet(y-1, x) = lfBasic) and (LandPixelGet(y-1, x) and AMask <> 0) then

                        LandPixelSet(y, x, LandPixelGet(y-1, x))

                    else if (LandGet(y+1, x) = lfBasic) and (LandPixelGet(y+1, x) and AMask <> 0) then

                        LandPixelSet(y, x, LandPixelGet(y+1, x));

                    if (((LandPixelGet(y,x) and AMask) shr AShift) > 10) then

                        LandPixelSet(y, x, (LandPixelGet(y,x) and (not AMask)) or (128 shl AShift))

                    end;

                LandSet(y, x, lfObject)

            end

            else if (LandGet(y, x) = 0) and

                    (((LandGet(y, x-1) = lfBasic) and (LandGet(y+1,x-1) = lfBasic) and (LandGet(y+2,x) = lfBasic)) or

                    ((LandGet(y, x-1) = lfBasic) and (LandGet(y-1,x-1) = lfBasic) and (LandGet(y-2,x) = lfBasic)) or

                    ((LandGet(y, x+1) = lfBasic) and (LandGet(y+1,x+1) = lfBasic) and (LandGet(y+2,x) = lfBasic)) or

                    ((LandGet(y, x+1) = lfBasic) and (LandGet(y-1,x+1) = lfBasic) and (LandGet(y-2,x) = lfBasic)) or

                    ((LandGet(y+1, x) = lfBasic) and (LandGet(y+1,x+1) = lfBasic) and (LandGet(y,x+2) = lfBasic)) or

                    ((LandGet(y-1, x) = lfBasic) and (LandGet(y-1,x+1) = lfBasic) and (LandGet(y,x+2) = lfBasic)) or

                    ((LandGet(y+1, x) = lfBasic) and (LandGet(y+1,x-1) = lfBasic) and (LandGet(y,x-2) = lfBasic)) or

                    ((LandGet(y-1, x) = lfBasic) and (LandGet(y-1,x-1) = lfBasic) and (LandGet(y,x-2) = lfBasic))) then

                begin

                if (cReducedQuality and rqBlurryLand) = 0 then

                    begin

                    if (LandGet(y, x-1) = lfBasic) and (LandPixelGet(y,x-1) and AMask <> 0) then

                        LandPixelSet(y, x, LandPixelGet(y, x-1))