(*

 * 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 uLandObjects;

interface

uses SDLh;

procedure AddObjects();

procedure FreeLandObjects();

procedure LoadThemeConfig;

procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface);

procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface; LandFlags: Word);

procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface; LandFlags: Word; Flip: boolean);

procedure BlitOverlayAndGenerateCollisionInfo(cpX, cpY: Longword; Image: PSDL_Surface);

procedure BlitImageUsingMask(cpX, cpY: Longword;  Image, Mask: PSDL_Surface);

procedure AddOnLandObjects(Surface: PSDL_Surface);

procedure SetLand(y, x: LongInt; Pixel: LongWord);

implementation

uses uStore, uConsts, uConsole, uRandom, uSound

     , uTypes, uVariables, uDebug, uUtils

     , uPhysFSLayer, uRenderUtils, uLandUtils;

const MaxRects = 512;

      MAXOBJECTRECTS = 16;

      MAXTHEMEOBJECTS = 32;

      cThemeCFGFilename = 'theme.cfg';

type PLongWord = ^LongWord;

     TRectsArray = array[0..MaxRects] of TSDL_Rect;

     PRectArray = ^TRectsArray;

     TThemeObjectOverlay = record

                           Position: TPoint;

                           Surf: PSDL_Surface;

                           Width, Height: LongWord;

                           end;

     TThemeObject = record

                     Name: ShortString;

                     Surf, Mask: PSDL_Surface;

                     inland: array[0..Pred(MAXOBJECTRECTS)] of TSDL_Rect;

                     outland: array[0..Pred(MAXOBJECTRECTS)] of TSDL_Rect;

                     anchors: array[0..Pred(MAXOBJECTRECTS)] of TSDL_Rect;

                     overlays: array[0..Pred(MAXOBJECTRECTS)] of TThemeObjectOverlay;

                     inrectcnt: LongInt;

                     outrectcnt: LongInt;

                     anchorcnt: LongInt;

                     overlaycnt: LongInt;

                     Width, Height: Longword;

                     Maxcnt: Longword;

                     end;

     TThemeObjects = record

                     Count: LongInt;

                     objs: array[0..Pred(MAXTHEMEOBJECTS)] of TThemeObject;

                     end;

     TSprayObject = record

                     Surf: PSDL_Surface;

                     Width, Height: Longword;

                     Maxcnt: Longword;

                     end;

     TSprayObjects = record

                     Count: LongInt;

                     objs: array[0..Pred(MAXTHEMEOBJECTS)] of TSprayObject

                     end;

var Rects: PRectArray;

    RectCount: Longword;

    ThemeObjects: TThemeObjects;

    SprayObjects: TSprayObjects;

procedure SetLand(y, x: LongInt; Pixel: LongWord);

begin

    // this an if instead of masking colours to avoid confusing map creators

    if ((AMask and Pixel) = 0) then

        LandSet(y, x, 0)

    else if (Pixel and AMask > 0) and (Pixel and RMask > 0) and (Pixel and GMask > 0) and (Pixel and BMask > 0) then // whiteish

        LandSet(y, x, lfObject)

    else if (Pixel and AMask > 0) and (Pixel and RMask = 0) and (Pixel and GMask = 0) and (Pixel and BMask = 0) then // blackish

        begin

        LandSet(y, x, lfBasic);

        disableLandBack:= false

        end

    else if (Pixel and AMask > 0) and (Pixel and RMask > 0) and (Pixel and GMask = 0) and (Pixel and BMask = 0) then // reddish

        LandSet(y, x, lfIndestructible)

    else if (Pixel and AMask > 0) and (Pixel and RMask = 0) and (Pixel and GMask = 0) and (Pixel and BMask > 0) then // blueish

        LandSet(y, x, lfObject or lfIce)

    else if (Pixel and AMask > 0) and (Pixel and RMask = 0) and (Pixel and GMask > 0) and (Pixel and BMask = 0) then // greenish

        LandSet(y, x, lfObject or lfBouncy)

end;

procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface);

begin

    BlitImageAndGenerateCollisionInfo(cpX, cpY, Width, Image, 0, false);

end;

procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface; LandFlags: Word);

begin

    BlitImageAndGenerateCollisionInfo(cpX, cpY, Width, Image, LandFlags, false);

end;

function LerpByte(src, dst: Byte; l: LongWord): LongWord;

begin

    LerpByte:= ((255 - l) * src + l * dst) div 255;

end;

procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface; LandFlags: Word; Flip: boolean);

var p: PLongwordArray;

    pLandColor: PLongWord;

    alpha, color, landColor, x, y: LongWord;

    bpp: LongInt;

begin

WriteToConsole('Generating collision info... ');

if SDL_MustLock(Image) then

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

bpp:= Image^.format^.BytesPerPixel;

if checkFails(bpp = 4, 'Land object should be 32bit', true) then

begin

if SDL_MustLock(Image) then

    SDL_UnlockSurface(Image);

end;

if Width = 0 then

    Width:= Image^.w;

p:= Image^.pixels;

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

    begin

    for x:= 0 to Pred(Width) do

        begin

        // map image pixels per line backwards if in flip mode

        if Flip then

            color:= p^[Pred(Image^.w) - x]

        else

            color:= p^[x];

        if (cReducedQuality and rqBlurryLand) = 0 then

            pLandColor:= @(LandPixelRow(cpY + y)^[cpX + x])

        else

            pLandColor:= @(LandPixelRow((cpY + y) div 2)^[(cpX + x) div 2]);

        landColor:= pLandColor^;

        alpha:= (landColor and AMask) shr AShift;

        if ((color and AMask) <> 0) and (alpha <> 255)  then

            begin

            if alpha = 0 then

                pLandColor^:= color

            else

                pLandColor^:=

                   (LerpByte((color and RMask) shr RShift, (landColor and RMask) shr RShift, alpha) shl RShift)

                    or (LerpByte((color and GMask) shr GShift, (landColor and GMask) shr GShift, alpha) shl GShift)

                    or (LerpByte((color and BMask) shr BShift, (landColor and BMask) shr BShift, alpha) shl BShift)

                    or (LerpByte(alpha, 255, (color and AMask) shr AShift) shl AShift);

            end;

        if ((color and AMask) <> 0) and (LandGet(cpY + y, cpX + x) <= lfAllObjMask) then

            LandSet(cpY + y, cpX + x, lfObject or LandFlags)

        end;

    p:= PLongwordArray(@(p^[Image^.pitch shr 2]))

    end;

if SDL_MustLock(Image) then

    SDL_UnlockSurface(Image);

WriteLnToConsole(msgOK)

end;

procedure BlitOverlayAndGenerateCollisionInfo(cpX, cpY: Longword; Image: PSDL_Surface);

var p: PLongwordArray;

    pLandColor: PLongWord;

    x, y, alpha, color, landColor: LongWord;

begin

WriteToConsole('Generating overlay collision info... ');

if SDL_MustLock(Image) then

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

if checkFails(Image^.format^.BytesPerPixel = 4, 'Land object overlay should be 32bit', true)

   and SDL_MustLock(Image) then

    SDL_UnlockSurface(Image);

p:= Image^.pixels;

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

    begin

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

        begin

        color:= p^[x];

        if (color and AMask) <> 0 then

            begin

            if (cReducedQuality and rqBlurryLand) = 0 then

                pLandColor:= @(LandPixelRow(cpY + y)^[cpX + x])

            else

                pLandColor:= @(LandPixelRow((cpY + y) div 2)^[(cpX + x) div 2]);

            alpha:= (color and AMask) shr AShift;

            if ((alpha <> $FF) and ((pLandColor^) <> 0)) then

                begin

                landColor:= pLandColor^;

                color:=

                    (LerpByte((landColor and RMask) shr RShift, (color and RMask) shr RShift, alpha) shl RShift)

                 or (LerpByte((landColor and GMask) shr GShift, (color and GMask) shr GShift, alpha) shl GShift)

                 or (LerpByte((landColor and BMask) shr BShift, (color and BMask) shr BShift, alpha) shl BShift)

                 or (LerpByte(alpha, 255, (landColor and AMask) shr AShift) shl AShift)

                end;

            pLandColor^:= color;

            if LandGet(cpY + y, cpX + x) <= lfAllObjMask then

                LandSet(cpY + y, cpX + x, lfObject)

            end;

        end;

    p:= PLongwordArray(@(p^[Image^.pitch shr 2]))

    end;

if SDL_MustLock(Image) then

    SDL_UnlockSurface(Image);

WriteLnToConsole(msgOK)

end;

procedure BlitImageUsingMask(cpX, cpY: Longword;  Image, Mask: PSDL_Surface);

var p, mp: PLongwordArray;

    pLandColor: PLongWord;

    alpha, color, landColor, x, y: Longword;

    bpp: LongInt;

begin

WriteToConsole('Generating collision info... ');

if SDL_MustLock(Image) then

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

bpp:= Image^.format^.BytesPerPixel;

if checkFails(bpp = 4, 'Land object should be 32bit', true) then

begin

if SDL_MustLock(Image) then

    SDL_UnlockSurface(Image);

end;

p:= Image^.pixels;

mp:= Mask^.pixels;

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

    begin

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

        begin

        color:= p^[x];

        if (cReducedQuality and rqBlurryLand) = 0 then

            pLandColor:= @(LandPixelRow(cpY + y)^[cpX + x])

        else

            pLandColor:= @(LandPixelRow((cpY + y) div 2)^[(cpX + x) div 2]);

        landColor:= pLandColor^;

        alpha:= (landColor and AMask) shr AShift;

        if ((color and AMask) <> 0) and (alpha <> 255)  then

        begin

            if alpha = 0 then

                pLandColor^:= color

            else

                pLandColor^:=

                   (LerpByte((color and RMask) shr RShift, (landColor and RMask) shr RShift, alpha) shl RShift)

                   or (LerpByte((color and GMask) shr GShift, (landColor and GMask) shr GShift, alpha) shl GShift)

                   or (LerpByte((color and BMask) shr BShift, (landColor and BMask) shr BShift, alpha) shl BShift)

                   or (LerpByte(alpha, 255, (color and AMask) shr AShift) shl AShift);

        end;

        if (LandGet(cpY + y, cpX + x) <= lfAllObjMask) or (LandGet(cpY + y, cpX + x) and lfObject <> 0)  then

            SetLand(cpY + y, cpX + x, mp^[x]);

        end;

    p:= PLongwordArray(@(p^[Image^.pitch shr 2]));

    mp:= PLongwordArray(@(mp^[Mask^.pitch shr 2]))

    end;

if SDL_MustLock(Image) then

    SDL_UnlockSurface(Image);

WriteLnToConsole(msgOK)

end;

procedure AddRect(x1, y1, w1, h1: LongInt);

begin

with Rects^[RectCount] do

    begin

    x:= x1;

    y:= y1;

    w:= w1;

    h:= h1

    end;

inc(RectCount);

checkFails(RectCount < MaxRects, 'AddRect: overflow', true)

end;

procedure InitRects;

begin

    RectCount:= 0;

    New(Rects)

end;

procedure FreeRects;

begin

    Dispose(rects)

end;

function CheckIntersect(x1, y1, w1, h1: LongInt): boolean;

var i: Longword;

    res: boolean = false;

begin

i:= 0;

if RectCount > 0 then

    repeat

    with Rects^[i] do

        res:= (x < x1 + w1) and (x1 < x + w) and (y < y1 + h1) and (y1 < y + h);

    inc(i)

    until (i = RectCount) or (res);

CheckIntersect:= res;

end;

function CountNonZeroz(x, y, h: LongInt): Longword;

var i: LongInt;

    lRes: Longword;

begin

    lRes:= 0;

    for i:= y to Pred(y + h) do

        if LandGet(i, x) <> 0 then

            inc(lRes);

    CountNonZeroz:= lRes;

end;

function AddGirder(gX: LongInt; var girSurf: PSDL_Surface): boolean;

var x1, x2, y, k, i, girderHeight: LongInt;

    rr: TSDL_Rect;

    bRes: boolean;

begin

if girSurf = nil then

    girSurf:= LoadDataImageAltPath(ptCurrTheme, ptGraphics, 'Girder', ifCritical or ifColorKey or ifIgnoreCaps or ifDigestAlpha);

girderHeight:= girSurf^.h;

y:= topY+150;

repeat

    inc(y, 24);

    x1:= gX;

    x2:= gX;

    while (x1 > leftX+150) and (CountNonZeroz(x1, y, girderHeight) = 0) do

        dec(x1, 2);

    i:= x1 - 12;

    repeat

        k:= CountNonZeroz(x1, y, girderHeight);

        dec(x1, 2)

    until (x1 < leftX + 100) or (k = 0) or (k = girderHeight) or (x1 < i);

    inc(x1, 2);

    if k = girderHeight then

        begin

        while (x2 < (rightX - 100)) and (CountNonZeroz(x2, y, girderHeight) = 0) do

            inc(x2, 2);

        i:= x2 + 12;

        repeat

        inc(x2, 2);

        k:= CountNonZeroz(x2, y, girderHeight)

        until (x2 >= (rightX-150)) or (k = 0) or (k = girderHeight) or (x2 > i) or (x2 - x1 >= 900);

        if (x2 < (rightX - 100)) and (k = girderHeight) and (x2 - x1 > 200) and (x2 - x1 < 900)

        and (not CheckIntersect(x1 - 32, y - 64, x2 - x1 + 64, 144)) then

                break;

        end;

x1:= 0;

until y > (LAND_HEIGHT-125);

if x1 > 0 then

begin

    bRes:= true;

    rr.x:= x1;

    while rr.x < x2 do

        begin

        if cIce then

            BlitImageAndGenerateCollisionInfo(rr.x, y, min(x2 - rr.x, girSurf^.w), girSurf, lfIce)

        else

            BlitImageAndGenerateCollisionInfo(rr.x, y, min(x2 - rr.x, girSurf^.w), girSurf);

        inc(rr.x, girSurf^.w);

        end;

    AddRect(x1 - 8, y - 32, x2 - x1 + 16, 80);

end

else bRes:= false;

AddGirder:= bRes;

end;

function CheckLand(rect: TSDL_Rect; dX, dY, Color: Longword): boolean;

var tmpx, tmpx2, tmpy, tmpy2, bx, by: LongInt;

    bRes: boolean = true;

begin

inc(rect.x, dX);

inc(rect.y, dY);

bx:= rect.x + rect.w;

by:= rect.y + rect.h;

{$WARNINGS OFF}

tmpx:= rect.x;

tmpx2:= bx;

while (tmpx <= bx - rect.w div 2 - 1) and bRes do

    begin

    bRes:= ((rect.y and LAND_HEIGHT_MASK) = 0) and ((by and LAND_HEIGHT_MASK) = 0)

    and ((tmpx and LAND_WIDTH_MASK) = 0) and ((tmpx2 and LAND_WIDTH_MASK) = 0)

    and (LandGet(rect.y, tmpx) = Color) and (LandGet(by, tmpx) = Color)

    and (LandGet(rect.y, tmpx2) = Color) and (LandGet(by, tmpx2) = Color);

    inc(tmpx);

    dec(tmpx2)

    end;

tmpy:= rect.y+1;

tmpy2:= by-1;

while (tmpy <= by - rect.h div 2 - 1) and bRes do

    begin

    bRes:= ((tmpy and LAND_HEIGHT_MASK) = 0) and ((tmpy2 and LAND_HEIGHT_MASK) = 0)

    and ((rect.x and LAND_WIDTH_MASK) = 0) and ((bx and LAND_WIDTH_MASK) = 0)

    and (LandGet(tmpy, rect.x) = Color) and (LandGet(tmpy, bx) = Color)

    and (LandGet(tmpy2, rect.x) = Color) and (LandGet(tmpy2, bx) = Color);

    inc(tmpy);

    dec(tmpy2)

    end;

{$WARNINGS ON}

CheckLand:= bRes;

end;

function CheckLandAny(rect: TSDL_Rect; dX, dY, LandType: Longword): boolean;

var tmpx, tmpy, bx, by: LongInt;

begin

    inc(rect.x, dX);

    inc(rect.y, dY);

    bx:= rect.x + rect.w - 1;

    by:= rect.y + rect.h - 1;

    CheckLandAny:= false;

    if (((rect.x and LAND_WIDTH_MASK) or (bx and LAND_WIDTH_MASK) or

         (rect.y and LAND_HEIGHT_MASK) or (by and LAND_HEIGHT_MASK)) = 0) then

    begin

        for tmpx := rect.x to bx do

        begin

            if (((LandGet(rect.y, tmpx) and LandType) or (LandGet(by, tmpx) and LandType)) <> 0) then

            begin

                CheckLandAny := true;

                exit;

            end

        end;

        for tmpy := rect.y to by do

        begin

            if (((LandGet(tmpy, rect.x) and LandType) or (LandGet(tmpy, bx) and LandType)) <> 0) then

            begin

                CheckLandAny := true;

                exit;

            end

        end;

    end;

end;

function CheckCanPlace(x, y: Longword; var Obj: TThemeObject): boolean;

var i: Longword;

    bRes, anchored: boolean;