hedgewars/uLand.pas
author nemo
Fri, 23 Mar 2012 18:20:59 -0400
changeset 6810 5337f554480e
parent 6700 e04da46ee43c
child 6898 344b0dbd9690
permissions -rw-r--r--
This has bugged me for a while. Since we are missing the source SVGs for this theme, removed the leaves crudely in GIMP. Also added some basic roots. Someone more artistic is encouraged to try and improve it.

(*
 * Hedgewars, a free turn based strategy game
 * Copyright (c) 2004-2012 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,
     uLandGenMaze, uLandOutline;


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

BlitImageAndGenerateCollisionInfo(
    (LAND_WIDTH - tmpsurf^.w) div 2,
    LAND_HEIGHT - tmpsurf^.h,
    tmpsurf^.w,
    tmpsurf);
SDL_FreeSurface(tmpsurf);

LoadMask(mapname);
end;

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

        if (cReducedQuality and rqBlurryLand) = 0 then
            LandPixels[Longword(cWaterLine) - 1 - w, x]:= c
        else
            LandPixels[(Longword(cWaterLine) - 1 - w) div 2, x div 2]:= c
        end
end;

procedure GenMap;
var x, y, w, c: Longword;
begin
    hasBorder:= false;

    LoadThemeConfig;
    isMap:= false;

    // is this not needed any more? lets hope setlength sets also 0s
    //if ((GameFlags and gfForts) <> 0) or (Pathz[ptMapCurrent] <> '') then
    //    FillChar(Land,SizeOf(TCollisionArray),0);*)

    if (GameFlags and gfForts) = 0 then
        if Pathz[ptMapCurrent] <> '' then
            LoadMap
        else
            GenLandSurface
    else
        MakeFortsMap;

    AddProgress;

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

if hasBorder then
    begin
    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]:= lfIndestructible;
    // experiment hardcoding cave
    // also try basing cave dimensions on map/template dimensions, if they exist
    for w:= 0 to 5 do // width of 3 allowed hogs to be knocked through with grenade
        begin
        for y:= topY to LAND_HEIGHT - 1 do
                begin
                Land[y, leftX + w]:= lfIndestructible;
                Land[y, rightX - w]:= lfIndestructible;
                if (y + w) mod 32 < 16 then
                    c:= AMask
                else
                    c:= AMask or RMask or GMask; // FF00FFFF

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

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

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

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

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

if ((GameFlags and gfForts) = 0) and (Pathz[ptMapCurrent] = '') then
    AddObjects
    
else
    AddProgress();

FreeLandObjects;

if cGrayScale then
    begin
    if (cReducedQuality and rqBlurryLand) = 0 then
        for x:= leftX to rightX do
            for y:= 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:= leftX div 2 to rightX div 2 do
            for y:= 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;
                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 div 2,x div 2] and AMask);
                LandPixels[y,x]:= w or (LandPixels[y div 2, x div 2] and AMask)
                end
    end;

UpdateLandTexture(0, LAND_WIDTH, 0, LAND_HEIGHT);
end;

function GenPreview: TPreview;
var x, y, xx, yy, t, bit, cbit, lh, lw: LongInt;
    Preview: TPreview;
begin
    WriteLnToConsole('Generating preview...');
    case cMapGen of
        0: GenBlank(EdgeTemplates[SelectTemplate]);
        1: GenMaze;
        2: GenDrawnMap;
    else
        OutError('Unknown mapgen', true);
    end;

    lh:= LAND_HEIGHT div 128;
    lw:= LAND_WIDTH 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 Land[yy, xx] <> 0 then
                            inc(t);
                if t > 8 then
                    Preview[y, x]:= Preview[y, x] or ($80 shr bit);
            end;
        end;

    GenPreview:= Preview
end;


procedure chLandCheck(var s: shortstring);
begin
    AddFileLog('CheckLandDigest: ' + s + ' digest : ' + digest);
    if digest = '' then
        digest:= s
    else
        TryDo(s = digest, 'Different maps generated, sorry', true);
end;

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

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

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

    LandBackSurface:= nil;
    digest:= '';

    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
    Land:= nil;
    LandPixels:= nil;
    LandDirty:= nil;
end;

end.