(*

 * Hedgewars, a free turn based strategy game

 * Copyright (c) 2004-2011 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA

 *)

{$INCLUDE "options.inc"}

unit uLand;

interface

uses SDLh, uLandTemplates, uFloat, uConsts, GLunit, uTypes;

procedure initModule;

procedure freeModule;

procedure DrawBottomBorder;

procedure GenMap;

function  GenPreview: TPreview;

implementation

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

     uVariables, uUtils, uCommands, Adler32, uDebug, uLandPainted, uTextures,

procedure ColorizeLand(Surface: PSDL_Surface);

var tmpsurf: PSDL_Surface;

    r, rr: TSDL_Rect;

    x, yd, yu: LongInt;

begin

    tmpsurf:= LoadImage(UserPathz[ptCurrTheme] + '/LandTex', ifIgnoreCaps);

    if tmpsurf = nil then tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/LandTex', ifCritical or ifIgnoreCaps);

    r.y:= 0;

    while r.y < LAND_HEIGHT do

    begin

        r.x:= 0;

        while r.x < LAND_WIDTH do

        begin

            SDL_UpperBlit(tmpsurf, nil, Surface, @r);

            inc(r.x, tmpsurf^.w)

        end;

        inc(r.y, tmpsurf^.h)

    end;

    SDL_FreeSurface(tmpsurf);

    // freed in freeModule() below

    LandBackSurface:= LoadImage(UserPathz[ptCurrTheme] + '/LandBackTex', ifIgnoreCaps or ifTransparent);

    if LandBackSurface = nil then LandBackSurface:= LoadImage(Pathz[ptCurrTheme] + '/LandBackTex', ifIgnoreCaps or ifTransparent);

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

    tmpsurf:= LoadImage(UserPathz[ptCurrTheme] + '/Border', ifIgnoreCaps or ifTransparent);

    if tmpsurf = nil then tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/Border', ifCritical or ifIgnoreCaps or ifTransparent);

    for x:= 0 to LAND_WIDTH - 1 do

    begin

        yd:= LAND_HEIGHT - 1;

        repeat

            while (yd > 0) and (Land[yd, x] =  0) do dec(yd);

            if (yd < 0) then yd:= 0;

            while (yd < LAND_HEIGHT) and (Land[yd, x] <> 0) do inc(yd);

            dec(yd);

            yu:= yd;

            while (yu > 0  ) and (Land[yu, x] <> 0) do dec(yu);

            while (yu < yd ) and (Land[yu, x] =  0) do inc(yu);

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

            begin

                rr.x:= x;

                rr.y:= yd - 15;

                r.x:= x mod tmpsurf^.w;

                r.y:= 16;

                r.w:= 1;

                r.h:= 16;

                SDL_UpperBlit(tmpsurf, @r, Surface, @rr);

            end;

            if (yu > 0) then

            begin

                rr.x:= x;

                rr.y:= yu;

                r.x:= x mod tmpsurf^.w;

                r.y:= 0;

                r.w:= 1;

                r.h:= Min(16, yd - yu + 1);

                SDL_UpperBlit(tmpsurf, @r, Surface, @rr);

            end;

            yd:= yu - 1;

        until yd < 0;

    end;

    SDL_FreeSurface(tmpsurf);

end;

procedure SetPoints(var Template: TEdgeTemplate; var pa: TPixAr);

var i: LongInt;

begin

with Template do

     begin

     pa.Count:= BasePointsCount;

     for i:= 0 to pred(pa.Count) do

         begin

         pa.ar[i].x:= BasePoints^[i].x + LongInt(GetRandom(BasePoints^[i].w));

         if pa.ar[i].x <> NTPX then

            pa.ar[i].x:= pa.ar[i].x + ((LAND_WIDTH - Template.TemplateWidth) div 2);

         pa.ar[i].y:= BasePoints^[i].y + LongInt(GetRandom(BasePoints^[i].h)) + LAND_HEIGHT - LongInt(Template.TemplateHeight)

         end;

     if canMirror then

        if getrandom(2) = 0 then

           begin

           for i:= 0 to pred(BasePointsCount) do

             if pa.ar[i].x <> NTPX then

               pa.ar[i].x:= LAND_WIDTH - 1 - pa.ar[i].x;

           for i:= 0 to pred(FillPointsCount) do

               FillPoints^[i].x:= LAND_WIDTH - 1 - FillPoints^[i].x;

           end;

(*  Experiment in making this option more useful

     if ((not isNegative) and (cTemplateFilter = 4)) or

        (canFlip and (getrandom(2) = 0)) then

           begin

           for i:= 0 to pred(BasePointsCount) do

               begin

               pa.ar[i].y:= LAND_HEIGHT - 1 - pa.ar[i].y + (LAND_HEIGHT - TemplateHeight) * 2;

               if pa.ar[i].y > LAND_HEIGHT - 1 then

                   pa.ar[i].y:= LAND_HEIGHT - 1;

               end;

           for i:= 0 to pred(FillPointsCount) do

               begin

               FillPoints^[i].y:= LAND_HEIGHT - 1 - FillPoints^[i].y + (LAND_HEIGHT - TemplateHeight) * 2;

               if FillPoints^[i].y > LAND_HEIGHT - 1 then

                   FillPoints^[i].y:= LAND_HEIGHT - 1;

               end;

           end;

     end

*)

// template recycling.  Pull these off the floor a bit

     if (not isNegative) and (cTemplateFilter = 4) then

           begin

           for i:= 0 to pred(BasePointsCount) do

               begin

               dec(pa.ar[i].y, 100);

               if pa.ar[i].y < 0 then

                   pa.ar[i].y:= 0;

               end;

           for i:= 0 to pred(FillPointsCount) do

               begin

               dec(FillPoints^[i].y, 100);

               if FillPoints^[i].y < 0 then

                   FillPoints^[i].y:= 0;

               end;

           end;

     if (canFlip and (getrandom(2) = 0)) then

           begin

           for i:= 0 to pred(BasePointsCount) do

               pa.ar[i].y:= LAND_HEIGHT - 1 - pa.ar[i].y;

           for i:= 0 to pred(FillPointsCount) do

               FillPoints^[i].y:= LAND_HEIGHT - 1 - FillPoints^[i].y;

           end;

     end

end;

procedure GenBlank(var Template: TEdgeTemplate);

var pa: TPixAr;

    i: Longword;

    y, x: Longword;

begin

    for y:= 0 to LAND_HEIGHT - 1 do

        for x:= 0 to LAND_WIDTH - 1 do

            Land[y, x]:= lfBasic;

    {$HINTS OFF}

    SetPoints(Template, pa);

    {$HINTS ON}

    for i:= 1 to Template.BezierizeCount do

        begin

        BezierizeEdge(pa, _0_5);

        RandomizePoints(pa);

        RandomizePoints(pa)

        end;

    for i:= 1 to Template.RandPassesCount do RandomizePoints(pa);

    BezierizeEdge(pa, _0_1);

    DrawEdge(pa, 0);

    with Template do

        for i:= 0 to pred(FillPointsCount) do

            with FillPoints^[i] do

                FillLand(x, y);

    DrawEdge(pa, lfBasic);

    MaxHedgehogs:= Template.MaxHedgehogs;

    hasGirders:= Template.hasGirders;

    playHeight:= Template.TemplateHeight;

    playWidth:= Template.TemplateWidth;

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

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

    topY:= LAND_HEIGHT - playHeight;

    // HACK: force to only cavern even if a cavern map is invertable if cTemplateFilter = 4 ?

    if (cTemplateFilter = 4) or

    (Template.canInvert and (getrandom(2) = 0)) or

        (not Template.canInvert and Template.isNegative) then

        begin

        hasBorder:= true;

        for y:= 0 to LAND_HEIGHT - 1 do

            for x:= 0 to LAND_WIDTH - 1 do

                if (y < topY) or (x < leftX) or (x > rightX) then

                    Land[y, x]:= 0

                else

                begin

                if Land[y, x] = 0 then

                    Land[y, x]:= lfBasic

                else if Land[y, x] = lfBasic then

                    Land[y, x]:= 0;

                end;

        end;

end;

procedure GenDrawnMap;

begin

    uLandPainted.Draw;

    MaxHedgehogs:= 48;

    hasGirders:= true;

    playHeight:= 2048;

    playWidth:= 4096;

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

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

    topY:= LAND_HEIGHT - playHeight;

end;

function SelectTemplate: LongInt;

begin

    if (cReducedQuality and rqLowRes) <> 0 then

        SelectTemplate:= SmallTemplates[getrandom(Succ(High(SmallTemplates)))]

    else

        case cTemplateFilter of

        0: SelectTemplate:= getrandom(Succ(High(EdgeTemplates)));

        1: SelectTemplate:= SmallTemplates[getrandom(Succ(High(SmallTemplates)))];

        2: SelectTemplate:= MediumTemplates[getrandom(Succ(High(MediumTemplates)))];

        3: SelectTemplate:= LargeTemplates[getrandom(Succ(High(LargeTemplates)))];

        4: SelectTemplate:= CavernTemplates[getrandom(Succ(High(CavernTemplates)))];

        5: SelectTemplate:= WackyTemplates[getrandom(Succ(High(WackyTemplates)))];

    end;

    WriteLnToConsole('Selected template #'+inttostr(SelectTemplate)+' using filter #'+inttostr(cTemplateFilter));

end;

procedure LandSurface2LandPixels(Surface: PSDL_Surface);

var x, y: LongInt;

    p: PLongwordArray;

begin

TryDo(Surface <> nil, 'Assert (LandSurface <> nil) failed', true);

if SDL_MustLock(Surface) then

    SDLTry(SDL_LockSurface(Surface) >= 0, true);

p:= Surface^.pixels;

for y:= 0 to LAND_HEIGHT - 1 do

    begin

    for x:= 0 to LAND_WIDTH - 1 do

    if Land[y, x] <> 0 then

        if (cReducedQuality and rqBlurryLand) = 0 then

             LandPixels[y, x]:= p^[x] or AMask

        else

             LandPixels[y div 2, x div 2]:= p^[x] or AMask;

    p:= @(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

    WriteLnToConsole('Generating land...');

    case cMapGen of

        0: GenBlank(EdgeTemplates[SelectTemplate]);

        1: GenMaze;

        2: GenDrawnMap;

    else

        OutError('Unknown mapgen', true);

    end;

    AddProgress();

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

    TryDo(tmpsurf <> nil, 'Error creating pre-land surface', true);

    ColorizeLand(tmpsurf);

    AddOnLandObjects(tmpsurf);

    LandSurface2LandPixels(tmpsurf);

    SDL_FreeSurface(tmpsurf);

    for x:= leftX+2 to rightX-2 do

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

            if (Land[y, x] = 0) and 

               (((Land[y, x-1] = lfBasic) and ((Land[y+1,x] = lfBasic)) or (Land[y-1,x] = lfBasic)) or

               ((Land[y, x+1] = lfBasic) and ((Land[y-1,x] = lfBasic) or (Land[y+1,x] = lfBasic)))) then

            begin

                if (cReducedQuality and rqBlurryLand) = 0 then

                    begin

                    if (Land[y, x-1] = lfBasic) and (LandPixels[y, x-1] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y, x-1]

                    else if (Land[y, x+1] = lfBasic) and (LandPixels[y, x+1] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y, x+1]

                    else if (Land[y-1, x] = lfBasic) and (LandPixels[y-1, x] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y-1, x]

                    else if (Land[y+1, x] = lfBasic) and (LandPixels[y+1, x] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y+1, x];

                    if (((LandPixels[y,x] and AMask) shr AShift) > 10) then LandPixels[y,x]:= (LandPixels[y,x] and (not AMask)) or (128 shl AShift)

                    end;

                Land[y,x]:= lfObject

            end

            else if (Land[y, x] = 0) and

                    (((Land[y, x-1] = lfBasic) and (Land[y+1,x-1] = lfBasic) and (Land[y+2,x] = lfBasic)) or

                    ((Land[y, x-1] = lfBasic) and (Land[y-1,x-1] = lfBasic) and (Land[y-2,x] = lfBasic)) or

                    ((Land[y, x+1] = lfBasic) and (Land[y+1,x+1] = lfBasic) and (Land[y+2,x] = lfBasic)) or

                    ((Land[y, x+1] = lfBasic) and (Land[y-1,x+1] = lfBasic) and (Land[y-2,x] = lfBasic)) or

                    ((Land[y+1, x] = lfBasic) and (Land[y+1,x+1] = lfBasic) and (Land[y,x+2] = lfBasic)) or

                    ((Land[y-1, x] = lfBasic) and (Land[y-1,x+1] = lfBasic) and (Land[y,x+2] = lfBasic)) or

                    ((Land[y+1, x] = lfBasic) and (Land[y+1,x-1] = lfBasic) and (Land[y,x-2] = lfBasic)) or

                    ((Land[y-1, x] = lfBasic) and (Land[y-1,x-1] = lfBasic) and (Land[y,x-2] = lfBasic))) then

            begin

                if (cReducedQuality and rqBlurryLand) = 0 then

                    begin

                    if (Land[y, x-1] = lfBasic) and (LandPixels[y,x-1] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y, x-1]

                    else if (Land[y, x+1] = lfBasic) and (LandPixels[y,x+1] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y, x+1]

                    else if (Land[y+1, x] = lfBasic) and (LandPixels[y+1,x] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y+1, x]

                    else if (Land[y-1, x] = lfBasic) and (LandPixels[y-1,x] and AMask <> 0) then LandPixels[y, x]:= LandPixels[y-1, x];

                    if (((LandPixels[y,x] and AMask) shr AShift) > 10) then LandPixels[y,x]:= (LandPixels[y,x] and (not AMask)) or (64 shl AShift)

                    end;

                Land[y,x]:= lfObject

            end;

    AddProgress();

end;

procedure MakeFortsMap;

var tmpsurf: PSDL_Surface;

begin

MaxHedgehogs:= 32;

// For now, defining a fort is playable area as 3072x1200 - there are no tall forts.  The extra height is to avoid triggering border with current code, also if user turns on a border, it will give a bit more maneuvering room.

playHeight:= 1200;

playWidth:= 2560;

leftX:= (LAND_WIDTH - playWidth) div 2;

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

topY:= LAND_HEIGHT - playHeight;

WriteLnToConsole('Generating forts land...');

tmpsurf:= LoadImage(UserPathz[ptForts] + '/' + ClansArray[0]^.Teams[0]^.FortName + 'L', ifAlpha or ifTransparent or ifIgnoreCaps);

if tmpsurf = nil then tmpsurf:= LoadImage(Pathz[ptForts] + '/' + ClansArray[0]^.Teams[0]^.FortName + 'L', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);

BlitImageAndGenerateCollisionInfo(leftX+150, LAND_HEIGHT - tmpsurf^.h, tmpsurf^.w, tmpsurf);

SDL_FreeSurface(tmpsurf);

tmpsurf:= LoadImage(UserPathz[ptForts] + '/' + ClansArray[1]^.Teams[0]^.FortName + 'R', ifAlpha or ifTransparent or ifIgnoreCaps);

if tmpsurf = nil then tmpsurf:= LoadImage(Pathz[ptForts] + '/' + ClansArray[1]^.Teams[0]^.FortName + 'R', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);

BlitImageAndGenerateCollisionInfo(rightX - 150 - tmpsurf^.w, LAND_HEIGHT - tmpsurf^.h, tmpsurf^.w, tmpsurf);

SDL_FreeSurface(tmpsurf);

end;

// Loads Land[] from an image, allowing overriding standard collision

procedure LoadMask(mapName: shortstring);

var tmpsurf: PSDL_Surface;

    p: PLongwordArray;

    x, y, cpX, cpY: Longword;

begin

tmpsurf:= LoadImage(UserPathz[ptMapCurrent] + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps);

if tmpsurf = nil then tmpsurf:= LoadImage(Pathz[ptMapCurrent] + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps);

if tmpsurf = nil then

    begin

    mapName:= ExtractFileName(Pathz[ptMapCurrent]);

    tmpsurf:= LoadImage(UserPathz[ptMissionMaps] + '/' + mapName + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps);

    if tmpsurf = nil then tmpsurf:= LoadImage(Pathz[ptMissionMaps] + '/' + mapName + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps);

    end;

if (tmpsurf <> nil) and (tmpsurf^.w <= LAND_WIDTH) and (tmpsurf^.h <= LAND_HEIGHT) and (tmpsurf^.format^.BytesPerPixel = 4) then

begin

    disableLandBack:= true;

    cpX:= (LAND_WIDTH - tmpsurf^.w) div 2;

    cpY:= LAND_HEIGHT - tmpsurf^.h;

    if SDL_MustLock(tmpsurf) then

        SDLTry(SDL_LockSurface(tmpsurf) >= 0, true);

        p:= tmpsurf^.pixels;

        for y:= 0 to Pred(tmpsurf^.h) do

        begin

            for x:= 0 to Pred(tmpsurf^.w) do

            begin

                if ((AMask and p^[x]) = 0) then

                    Land[cpY + y, cpX + x]:= 0

                else if p^[x] = $FFFFFFFF then

                    Land[cpY + y, cpX + x]:= lfObject

                else if p^[x] = (AMask or RMask) then

                    Land[cpY + y, cpX + x]:= lfIndestructible

                else if p^[x] = AMask then

                    begin

                    Land[cpY + y, cpX + x]:= lfBasic;

                    disableLandBack:= false

                    end

                else if p^[x] = (AMask or BMask) then

                    Land[cpY + y, cpX + x]:= lfObject or lfIce

            end;

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

        end;

    if SDL_MustLock(tmpsurf) then

        SDL_UnlockSurface(tmpsurf);

    if not disableLandBack then

        begin

        // freed in freeModule() below

        LandBackSurface:= LoadImage(UserPathz[ptCurrTheme] + '/LandBackTex', ifIgnoreCaps or ifTransparent);

        if LandBackSurface = nil then LandBackSurface:= LoadImage(Pathz[ptCurrTheme] + '/LandBackTex', ifIgnoreCaps or ifTransparent);

        if (LandBackSurface <> nil) and cGrayScale then Surface2GrayScale(LandBackSurface)

        end;

end;

if (tmpsurf <> nil) then

    SDL_FreeSurface(tmpsurf);

tmpsurf:= nil;

end;

procedure LoadMap;

var tmpsurf: PSDL_Surface;

    s: shortstring;

    f: textfile;

    mapName: shortstring = '';

begin

isMap:= true;

WriteLnToConsole('Loading land from file...');

AddProgress;

tmpsurf:= LoadImage(UserPathz[ptMapCurrent] + '/map', ifAlpha or ifTransparent or ifIgnoreCaps);

if tmpsurf = nil then tmpsurf:= LoadImage(Pathz[ptMapCurrent] + '/map', ifAlpha or ifTransparent or ifIgnoreCaps);

if tmpsurf = nil then

    begin

    mapName:= ExtractFileName(Pathz[ptMapCurrent]);

    tmpsurf:= LoadImage(UserPathz[ptMissionMaps] + '/' + mapName + '/map', ifAlpha or ifTransparent or ifIgnoreCaps);

    if tmpsurf = nil then tmpsurf:= LoadImage(Pathz[ptMissionMaps] + '/' + mapName + '/map', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps);

    end;

TryDo((tmpsurf^.w <= LAND_WIDTH) and (tmpsurf^.h <= LAND_HEIGHT), 'Map dimensions too big!', true);

// unC0Rr - should this be passed from the GUI? I am not sure which layer does what

s:= UserPathz[ptMapCurrent] + '/map.cfg';

if not FileExists(s) then s:= Pathz[ptMapCurrent] + '/map.cfg';

WriteLnToConsole('Fetching map HH limit');

{$I-}

Assign(f, s);

filemode:= 0; // readonly

Reset(f);

if IOResult <> 0 then

begin

    s:= Pathz[ptMissionMaps] + '/' + mapName + '/map.cfg';

    Assign(f, s);

    Reset(f);

end;

Readln(f);

if not eof(f) then Readln(f, MaxHedgehogs);

{$I+}

if (MaxHedgehogs = 0) then MaxHedgehogs:= 18;

playHeight:= tmpsurf^.h;

playWidth:= tmpsurf^.w;

leftX:= (LAND_WIDTH - playWidth) div 2;

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

topY:= LAND_HEIGHT - playHeight;

TryDo(tmpsurf^.format^.BytesPerPixel = 4, 'Map should be 32bit', true);