hedgewars/uLand.pas
author Wuzzy <Wuzzy2@mail.ru>
Mon, 16 Sep 2019 17:33:49 +0200
changeset 15410 8504fee3b601
parent 15179 cd38295cac16
child 15900 128ace913837
permissions -rw-r--r--
Racer: Fix weird water splashes after waypoint placement Does not affect official racer, as only waypoint placement is touched. The reason was that the air attack gear sometimes was not deleted fast enough so it might occassionally drop some air bombs (these are deleted now). Also, the airplane position was set to water level, which caused another water splash.

(*
 * 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(LandPixels, LAND_HEIGHT div 2, LAND_WIDTH div 2)
    else
        PrettifyAlpha2D(LandPixels, 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 ((Land[yd, x] and targetMask) = 0) do dec(yd);

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

            while (yd < LAND_HEIGHT) and ((Land[yd, x] and targetMask) <> 0) do
                inc(yd);
            dec(yd);
            yu:= yd;

            while (yu > 0  ) and ((Land[yu, x] and targetMask) <> 0) do dec(yu);
            while (yu < yd ) and ((Land[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 Land[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
                            LandPixels[i, x]:= c
                        else
                            LandPixels[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
                        LandPixels[y, x]:= c
                    else
                        LandPixels[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 Land[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
                            LandPixels[y, i]:= c
                        else
                            LandPixels[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
                        LandPixels[y, x]:= c
                    else
                        LandPixels[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: LongInt;
var l: LongInt;
begin
    SelectTemplate:= 0;
    if (cReducedQuality and rqLowRes) <> 0 then
        SelectTemplate:= SmallTemplates[getrandom(Succ(High(SmallTemplates)))]
    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:= SmallTemplates[getrandom(TemplateCounts[cTemplateFilter])];
            2: SelectTemplate:= MediumTemplates[getrandom(TemplateCounts[cTemplateFilter])];
            3: SelectTemplate:= LargeTemplates[getrandom(TemplateCounts[cTemplateFilter])];
            4: SelectTemplate:= CavernTemplates[getrandom(TemplateCounts[cTemplateFilter])];
            5: SelectTemplate:= WackyTemplates[getrandom(TemplateCounts[cTemplateFilter])];
    // For lua only!
            6: begin
               SelectTemplate:= min(LuaTemplateNumber,High(EdgeTemplates));
               GetRandom(2) // burn 1
               end
            end
        end;

    WriteLnToConsole('Selected template #'+inttostr(SelectTemplate)+' using filter #'+inttostr(cTemplateFilter));
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 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];

    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 (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 MakeFortsPreview;
var gap: LongInt;
    h1, h2, w1, w2, x, y, lastX, wbm, bmref: LongWord;
const fortHeight = 960;
      fortWidth  = 704;
      bmHeight = 53;
      bmWidth = 64;
begin
ResizeLand(4096,2048);

lastX:= LAND_WIDTH-1;

gap:= (1024 - fortWidth) + 60 + 20 * cFeatureSize;

h2:= LAND_HEIGHT-1;
h1:= h2 - fortHeight;
w2:= (LAND_WIDTH - gap) div 2;
w1:= w2 - fortWidth;
wbm:= h1 + bmHeight;

// generate 2 forts in center
for y:= h1 to h2 do
    for x:= w1 to w2 do
        begin
        if x mod 4 <> 0 then
            begin
            if (y <= wbm) and ((x - w1) mod (bmWidth * 2) >= bmWidth) then
                continue;
            Land[y,x]:= lfBasic;
            Land[y,lastX-x]:= lfBasic;
            end;
        end;

w2:= w1 - gap;
w1:= max(0, w2 - fortWidth);
wbm:= h1 + bmHeight;
bmref:= w2 + bmWidth;

for y:= h1 to h2 do
    for x:= w1 to w2 do
        begin
        if ((y - x) mod 2) = 0 then
            begin
            // align battlement on inner edge, because real outer edge could be offscreen
            if (y <= wbm) and ((LAND_WIDTH + x - bmref) mod (bmWidth * 2) >= bmWidth) then
                continue;
            Land[y,x]:= lfBasic;
            Land[y,lastX-x]:= lfBasic;
            end;
        end;
end;

procedure MakeFortsMap;
var tmpsurf: PSDL_Surface;
    sectionWidth, i, t, p: integer;
    mirror: boolean;
    pc: PClan;
begin

// make the gaps between forts adjustable if fort map was selected
if cMapGen = mgForts then
    sectionWidth:= 1024 + 60 + 20 * cFeatureSize
else
    sectionWidth:= 1024 * 300;

// mix up spawn/fort order of clans
for i:= 0 to ClansCount - 1 do
    begin
    t:= GetRandom(ClansCount);
    p:= GetRandom(ClansCount);
    if t <> p then
        begin
        pc:= SpawnClansArray[t];
        SpawnClansArray[t]:= SpawnClansArray[p];
        SpawnClansArray[p]:= pc;
        end;
    end;

// figure out how much space we need
playWidth:= sectionWidth * ClansCount;

// note: LAND_WIDTH might be bigger than specified below (rounded to next power of 2)
ResizeLand(playWidth, 2048);

// 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;

// center playable area in land array
leftX:= ((LAND_WIDTH - playWidth) div 2);
rightX:= ((playWidth + (LAND_WIDTH - playWidth) div 2) - 1);
topY:= LAND_HEIGHT - playHeight;

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

for i := 0 to ClansCount - 1 do
    begin

    // face in random direction
    mirror:= (GetRandom(2) = 0);
    // make first/last fort face inwards
    if (WorldEdge <> weWrap) or (ClansCount = 2) then
        mirror:= (i <> 0) and (mirror or (i = ClansCount - 1));

    if mirror then
        begin
        // not critical because if no R we can fallback to mirrored L
        tmpsurf:= LoadDataImage(ptForts, SpawnClansArray[i]^.Teams[0]^.FortName + 'R', ifAlpha or ifColorKey or ifIgnoreCaps);
        // fallback
        if tmpsurf = nil then
            begin
            tmpsurf:= LoadDataImage(ptForts, SpawnClansArray[i]^.Teams[0]^.FortName + 'L', ifAlpha or ifCritical or ifColorKey or ifIgnoreCaps);
            BlitImageAndGenerateCollisionInfo(leftX + sectionWidth * i + ((sectionWidth - tmpsurf^.w) div 2), LAND_HEIGHT - tmpsurf^.h, tmpsurf^.w, tmpsurf, 0, true);
            end
        else
            BlitImageAndGenerateCollisionInfo(leftX + sectionWidth * i + ((sectionWidth - tmpsurf^.w) div 2), LAND_HEIGHT - tmpsurf^.h, tmpsurf^.w, tmpsurf);
        SDL_FreeSurface(tmpsurf);
        end
    else
        begin
        tmpsurf:= LoadDataImage(ptForts, SpawnClansArray[i]^.Teams[0]^.FortName + 'L', ifAlpha or ifCritical or ifColorKey or ifIgnoreCaps);
        BlitImageAndGenerateCollisionInfo(leftX + sectionWidth * i + ((sectionWidth - tmpsurf^.w) div 2), LAND_HEIGHT - tmpsurf^.h, tmpsurf^.w, tmpsurf);
        SDL_FreeSurface(tmpsurf);
        end;

    end;
end;

procedure LoadMapConfig;
var f: PFSFile;
    s: shortstring;
begin
s:= cPathz[ptMapCurrent] + '/map.cfg';

WriteLnToConsole('Fetching map HH limit');

f:= pfsOpenRead(s);
if f <> nil then
    begin
    pfsReadLn(f, s);
    if not pfsEof(f) then
        begin
        pfsReadLn(f, s);
        val(s, MaxHedgehogs)
        end;

    pfsClose(f)
    end;

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

// Loads Land[] from an image, allowing overriding standard collision
procedure LoadMask;
var tmpsurf: PSDL_Surface;
    p: PLongwordArray;
    x, y, cpX, cpY: Longword;
    mapName: shortstring;
begin
tmpsurf:= LoadDataImage(ptMapCurrent, 'mask', ifAlpha or ifColorKey or ifIgnoreCaps);
if tmpsurf = nil then
    begin
    mapName:= ExtractFileName(cPathz[ptMapCurrent]);
    tmpsurf:= LoadDataImage(ptMissionMaps, mapName + '/mask', ifAlpha or ifColorKey or ifIgnoreCaps);
    end;


if (tmpsurf <> nil) and (tmpsurf^.format^.BytesPerPixel = 4) then
    begin
    if LAND_WIDTH = 0 then
        begin
        LoadMapConfig;
        ResizeLand(tmpsurf^.w, tmpsurf^.h);
        playHeight:= tmpsurf^.h;
        playWidth:= tmpsurf^.w;
        leftX:= (LAND_WIDTH - playWidth) div 2;
        rightX:= (playWidth + ((LAND_WIDTH - playWidth) div 2)) - 1;
        topY:= LAND_HEIGHT - playHeight;
        end;
    disableLandBack:= true;

    cpX:= (LAND_WIDTH - tmpsurf^.w) div 2;
    cpY:= LAND_HEIGHT - tmpsurf^.h;
    if SDL_MustLock(tmpsurf) then
        SDLCheck(SDL_LockSurface(tmpsurf) >= 0, 'SDL_LockSurface', true);

    if allOK then
    begin
        p:= tmpsurf^.pixels;
        for y:= 0 to Pred(tmpsurf^.h) do
            begin
            for x:= 0 to Pred(tmpsurf^.w) do
                SetLand(Land[cpY + y, cpX + x], p^[x]);
            p:= PLongwordArray(@(p^[tmpsurf^.pitch div 4]));
            end;

        if SDL_MustLock(tmpsurf) then
            SDL_UnlockSurface(tmpsurf);
        if not disableLandBack then
            begin
            // freed in freeModule() below
            LandBackSurface:= LoadDataImage(ptCurrTheme, 'LandBackTex', ifIgnoreCaps or ifColorKey);
            if (LandBackSurface <> nil) and GrayScale then
                Surface2GrayScale(LandBackSurface)
            end;
    end;
end;
if (tmpsurf <> nil) then
    SDL_FreeSurface(tmpsurf);
tmpsurf:= nil;
end;

procedure LoadMap;
var tmpsurf: PSDL_Surface;
    mapName: shortstring = '';
begin
WriteLnToConsole('Loading land from file...');
AddProgress;
tmpsurf:= LoadDataImage(ptMapCurrent, 'map', ifAlpha or ifColorKey or ifIgnoreCaps);
if tmpsurf = nil then
    begin
    mapName:= ExtractFileName(cPathz[ptMapCurrent]);
    tmpsurf:= LoadDataImage(ptMissionMaps, mapName + '/map', ifAlpha or ifCritical or ifColorKey or ifIgnoreCaps);
    if not allOK then exit;
    end;
// (bare) Sanity check. Considering possible LongInt comparisons as well as just how much system memoery it would take
if checkFails((tmpsurf^.w < $40000000) and (tmpsurf^.h < $40000000) and (QWord(tmpsurf^.w) * tmpsurf^.h < 6*1024*1024*1024), 'Map dimensions too big!', true)
        then exit;

ResizeLand(tmpsurf^.w, tmpsurf^.h);
LoadMapConfig;

playHeight:= tmpsurf^.h;
playWidth:= tmpsurf^.w;
leftX:= (LAND_WIDTH - playWidth) div 2;
rightX:= (playWidth + ((LAND_WIDTH - playWidth) div 2)) - 1;
topY:= LAND_HEIGHT - playHeight;

if not checkFails(tmpsurf^.format^.BytesPerPixel = 4, 'Map should be 32bit', true) then
    BlitImageAndGenerateCollisionInfo(
        (LAND_WIDTH - tmpsurf^.w) div 2,
        LAND_HEIGHT - tmpsurf^.h,
        tmpsurf^.w,
        tmpsurf);

SDL_FreeSurface(tmpsurf);

if allOK then LoadMask;
end;

procedure DrawBottomBorder; // broken out from other borders for doing a floor-only map, or possibly updating bottom during SD
var x, w, c, y: Longword;
begin
for w:= 0 to 23 do
    for x:= LongWord(leftX) to LongWord(rightX) do
        begin
        y:= Longword(cWaterLine) - 1 - w;
        Land[y, x]:= lfIndestructible;
        if (x + y) mod 32 < 16 then
            c:= AMask
        else
            c:= AMask or RMask or GMask; // FF00FFFF

        if (cReducedQuality and rqBlurryLand) = 0 then
            LandPixels[y, x]:= c
        else
            LandPixels[y div 2, x div 2]:= c
        end
end;

procedure GenMap;
var x, y, w, c, c2: Longword;
    map, mask: shortstring;
begin
    hasBorder:= false;
    maskOnly:= false;

    LoadThemeConfig;

    if cPathz[ptMapCurrent] <> '' then
        begin
        map:= cPathz[ptMapCurrent] + '/map.png';
        mask:= cPathz[ptMapCurrent] + '/mask.png';
        if (not(pfsExists(map)) and pfsExists(mask)) then
            begin
            maskOnly:= true;
            LoadMask;
            GenLandSurface
            end
        else LoadMap;
        end
    else
        begin
        WriteLnToConsole('Generating land...');
        case cMapGen of
            mgRandom: GenTemplated(EdgeTemplates[SelectTemplate]);
            mgMaze  : begin ResizeLand(4096,2048); GenMaze; end;
            mgPerlin: begin ResizeLand(4096,2048); GenPerlin; end;
            mgDrawn : GenDrawnMap;
            mgForts : begin GameFlags:= (GameFlags or gfDivideTeams); MakeFortsMap(); end;
        else
            OutError('Unknown mapgen', true);
        end;
        if cMapGen <> mgForts then
            GenLandSurface
        end;

    AddProgress;

// check for land near top
c:= 0;
if (GameFlags and gfBorder) <> 0 then
    hasBorder:= true
else
    for y:= LongWord(topY) to LongWord(topY + 5) do
        for x:= LongWord(leftX) to LongWord(rightX) do
            if Land[y, x] <> 0 then
                begin
                inc(c);
                if c > LongWord((LAND_WIDTH div 2)) then // avoid accidental triggering
                    begin
                    hasBorder:= true;
                    break;
                    end;
                end;

// Indestructible map border (top, left, right)
if hasBorder then
    begin
    // Make land beyond the border indestructible
    if WorldEdge = weNone then
        begin
        for y:= 0 to LAND_HEIGHT - 1 do
            for x:= 0 to LAND_WIDTH - 1 do
                if (y < LongWord(topY)) or (x < LongWord(leftX)) or (x > LongWord(rightX)) then
                    Land[y, x]:= lfIndestructible;
        end
    else if topY > 0 then
        begin
        for y:= 0 to LongWord(topY - 1) do
            for x:= 0 to LAND_WIDTH - 1 do
                Land[y, x]:= lfIndestructible;
        end;
    // Render map border
    for w:= 0 to (cBorderWidth-1) do
        begin
        // Left and right border
        if (WorldEdge <> weBounce) and (WorldEdge <> weWrap) then
            for y:= LongWord(topY) to LAND_HEIGHT - 1 do
                    begin
                    // set land flags
                    Land[y, leftX + w]:= lfIndestructible;
                    Land[y, rightX - w]:= lfIndestructible;

                    // paint black and yellow stripes
                    if (y + leftX + w) mod 32 < 16 then
                        c:= AMask // black
                    else
                        c:= AMask or RMask or GMask; // yellow
                    if (y + rightX - w) mod 32 < 16 then
                        c2:= AMask // black
                    else
                        c2:= AMask or RMask or GMask; // yellow

                    if (cReducedQuality and rqBlurryLand) = 0 then
                        begin
                        LandPixels[y, leftX + w]:= c;
                        LandPixels[y, rightX - w]:= c2;
                        end
                    else
                        begin
                        LandPixels[y div 2, (leftX + w) div 2]:= c;
                        LandPixels[y div 2, (rightX - w) div 2]:= c2;
                        end;
                    end;

        // Top border
        for x:= LongWord(leftX) to LongWord(rightX) do
            begin
            Land[topY + w, x]:= lfIndestructible;
            if (topY + x + w) mod 32 < 16 then
                c:= AMask // black
            else
                c:= AMask or RMask or GMask; // yellow

            if (cReducedQuality and rqBlurryLand) = 0 then
                LandPixels[topY + w, x]:= c
            else
                LandPixels[(topY + w) div 2, x div 2]:= c;
            end;
        end;
    end;

// Bottom border
if (GameFlags and gfBottomBorder) <> 0 then
    DrawBottomBorder;

if (GameFlags and gfDisableGirders) <> 0 then
    hasGirders:= false;

if (cMapGen <> mgForts) and (maskOnly or (cPathz[ptMapCurrent] = '')) then
    AddObjects

else
    AddProgress();

FreeLandObjects;

if not allOK then exit;

if GrayScale then
    begin
    if (cReducedQuality and rqBlurryLand) = 0 then
        for x:= LongWord(leftX) to LongWord(rightX) do
            for y:= LongWord(topY) to LAND_HEIGHT-1 do
                begin
                w:= LandPixels[y,x];
                w:= round(((w shr RShift and $FF) * RGB_LUMINANCE_RED +
                      (w shr BShift and $FF) * RGB_LUMINANCE_GREEN +
                      (w shr GShift and $FF) * RGB_LUMINANCE_BLUE));
                if w > 255 then
                    w:= 255;
                w:= (w and $FF shl RShift) or (w and $FF shl BShift) or (w and $FF shl GShift) or (LandPixels[y,x] and AMask);
                LandPixels[y,x]:= w or (LandPixels[y, x] and AMask)
                end
    else
        for x:= LongWord(leftX div 2) to LongWord(rightX div 2) do
            for y:= LongWord(topY div 2) to LAND_HEIGHT-1 div 2 do
                begin
                w:= LandPixels[y div 2,x div 2];
                w:= ((w shr RShift and $FF) +  (w shr BShift and $FF) + (w shr GShift and $FF)) div 3;
                w:= (w and $FF shl RShift) or (w and $FF shl BShift) or (w and $FF shl GShift) or (LandPixels[y div 2,x div 2] and AMask);
                LandPixels[y,x]:= w or (LandPixels[y div 2, x div 2] and AMask)
                end
    end;

PrettifyLandAlpha();

// adjust world edges for borderless maps
if (WorldEdge <> weNone) and (not hasBorder) then
    InitWorldEdges();

ScriptSetMapGlobals;
end;

procedure GenPreview(out Preview: TPreview);
var rh, rw, ox, oy, x, y, xx, yy, t, bit, cbit, lh, lw: LongInt;
begin
    WriteLnToConsole('Generating preview...');
    case cMapGen of
        mgRandom: GenTemplated(EdgeTemplates[SelectTemplate]);
        mgMaze: begin ResizeLand(4096,2048); GenMaze; end;
        mgPerlin: begin ResizeLand(4096,2048); GenPerlin; end;
        mgDrawn: begin GenDrawnMap; end;
        mgForts: MakeFortsPreview();
    else
        OutError('Unknown mapgen', true);
    end;

    ScriptSetMapGlobals;

    // strict scaling needed here since preview assumes a rectangle
    if (cMapGen <> mgDrawn) then
        begin
        rh:= max(LAND_HEIGHT, 2048);
        rw:= max(LAND_WIDTH, 4096);
        end
    else
        begin
        rh:= LAND_HEIGHT;
        rw:= LAND_WIDTH
        end;
    ox:= 0;
    if rw < rh*2 then
        begin
        rw:= rh*2;
        end;
    if rh < rw div 2 then rh:= rw * 2;

    ox:= (rw-LAND_WIDTH) div 2;
    oy:= rh-LAND_HEIGHT;

    lh:= rh div 128;
    lw:= rw div 32;
    for y:= 0 to 127 do
        for x:= 0 to 31 do
        begin
            Preview[y, x]:= 0;
            for bit:= 0 to 7 do
            begin
                t:= 0;
                cbit:= bit * 8;
                for yy:= y * lh to y * lh + 7 do
                    for xx:= x * lw + cbit to x * lw + cbit + 7 do
                        if ((yy-oy) and LAND_HEIGHT_MASK = 0) and ((xx-ox) and LAND_WIDTH_MASK = 0)
                           and (Land[yy-oy, xx-ox] <> 0) then
                            inc(t);
                if t > 8 then
                    Preview[y, x]:= Preview[y, x] or ($80 shr bit);
            end;
        end;
end;


procedure GenPreviewAlpha(out Preview: TPreviewAlpha);
var rh, rw, ox, oy, x, y, xx, yy, t, lh, lw: LongInt;
begin
    WriteLnToConsole('Generating preview...');
    case cMapGen of
        mgRandom: GenTemplated(EdgeTemplates[SelectTemplate]);
        mgMaze: begin ResizeLand(4096,2048); GenMaze; end;
        mgPerlin: begin ResizeLand(4096,2048); GenPerlin; end;
        mgDrawn: begin GenDrawnMap; end;
        mgForts: MakeFortsPreview;
    else
        OutError('Unknown mapgen', true);
    end;

    ScriptSetMapGlobals;


    // strict scaling needed here since preview assumes a rectangle
    if (cMapGen <> mgDrawn) then
        begin
        rh:= max(LAND_HEIGHT, 2048);
        rw:= max(LAND_WIDTH, 4096);
        end
    else
        begin
        rh:= LAND_HEIGHT;
        rw:= LAND_WIDTH
        end;

    ox:= 0;
    if rw < rh*2 then
        begin
        rw:= rh*2;
        end;
    if rh < rw div 2 then rh:= rw * 2;

    ox:= (rw-LAND_WIDTH) div 2;
    oy:= rh-LAND_HEIGHT;

    lh:= rh div 128;
    lw:= rw div 256;
    for y:= 0 to 127 do
        for x:= 0 to 255 do
            begin
            t:= 0;

            for yy:= y * lh - oy to y * lh + lh - 1 - oy do
                for xx:= x * lw - ox to x * lw + lw - 1 - ox do
                    if (yy and LAND_HEIGHT_MASK = 0) and (xx and LAND_WIDTH_MASK = 0)
                        and (Land[yy, xx] <> 0) then
                        inc(t);

            Preview[y, x]:= t * 255 div (lh * lw);
            end;
end;

procedure chLandCheck(var s: shortstring);
begin
    AddFileLog('CheckLandDigest: ' + s + ' digest : ' + digest);
    if digest = '' then
        digest:= s
    else
        checkFails(s = digest, 'Loaded map or other critical resource does not match across all players', true);
end;

procedure chSendLandDigest(var s: shortstring);
var i: LongInt;
    landPixelDigest  : LongInt;
begin
    landPixelDigest:= 1;
    for i:= 0 to LAND_HEIGHT-1 do
        landPixelDigest:= Adler32Update(landPixelDigest, @Land[i,0], LAND_WIDTH*2);
    s:= 'M' + IntToStr(syncedPixelDigest)+'|'+IntToStr(landPixelDigest);

    ScriptSetString('LandDigest',IntToStr(landPixelDigest));

    chLandCheck(s);
    if allOK then SendIPCRaw(@s[0], Length(s) + 1)
end;

procedure initModule;
begin
    RegisterVariable('landcheck', @chLandCheck, false);
    RegisterVariable('sendlanddigest', @chSendLandDigest, false);

    LandBackSurface:= nil;
    digest:= '';
    maskOnly:= false;
    LAND_WIDTH:= 0;
    LAND_HEIGHT:= 0;
(*
    if (cReducedQuality and rqBlurryLand) = 0 then
        SetLength(LandPixels, LAND_HEIGHT, LAND_WIDTH)
    else
        SetLength(LandPixels, LAND_HEIGHT div 2, LAND_WIDTH div 2);

    SetLength(Land, LAND_HEIGHT, LAND_WIDTH);
    SetLength(LandDirty, (LAND_HEIGHT div 32), (LAND_WIDTH div 32));
*)
end;

procedure freeModule;
begin
    SetLength(Land, 0, 0);
    SetLength(LandPixels, 0, 0);
    SetLength(LandDirty, 0, 0);
end;

end.