(*

 * Hedgewars, a free turn based strategy game

 * Copyright (c) 2005-2008 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

 *)

unit uLandObjects;

interface

uses SDLh;

{$include options.inc}

procedure AddObjects();

procedure LoadThemeConfig;

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

procedure AddOnLandObjects(Surface: PSDL_Surface);

implementation

uses uLand, uStore, uConsts, uMisc, uConsole, uRandom, uVisualGears, uFloat, 

{$IFDEF IPHONE}

	gles11,

{$ELSE}

	GL,

{$ENDIF}

	uSound, uWorld;

const MaxRects = 512;

      MAXOBJECTRECTS = 16;

      MAXTHEMEOBJECTS = 32;

type PRectArray = ^TRectsArray;

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

     TThemeObject = record

                    Surf: PSDL_Surface;

                    inland: TSDL_Rect;

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

                    rectcnt: Longword;

                    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 BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface);

var p: PLongwordArray;

    x, y: Longword;

    bpp: LongInt;

begin

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

if SDL_MustLock(Image) then

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

bpp:= Image^.format^.BytesPerPixel;

TryDo(bpp = 4, 'Land object should be 32bit', true);

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

		if LandPixels[cpY + y, cpX + x] = 0 then

			begin

			LandPixels[cpY + y, cpX + x]:= p^[x];

			if (p^[x] and $FF000000) <> 0 then Land[cpY + y, cpX + x]:= COLOR_LAND;

			end;

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

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

TryDo(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;

    Result: boolean;

begin

Result:= false;

i:= 0;

if RectCount > 0 then

   repeat

   with Rects^[i] do

        Result:= (x < x1 + w1) and (x1 < x + w) and

                 (y < y1 + h1) and (y1 < y + h);

   inc(i)

   until (i = RectCount) or (Result);

CheckIntersect:= Result

end;

function AddGirder(gX: LongInt): boolean;

var tmpsurf: PSDL_Surface;

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

    rr: TSDL_Rect;

    Result: boolean;

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

	var i: LongInt;

		Result: Longword;

	begin

	Result:= 0;

	for i:= y to y + 15 do

		if Land[i, x] <> 0 then inc(Result);

	CountNonZeroz:= Result

	end;

begin

y:= topY+150;

repeat

	inc(y, 24);

	x1:= gX;

	x2:= gX;

	while (x1 > Longint(leftX)+150) and (CountNonZeroz(x1, y) = 0) do dec(x1, 2);

	i:= x1 - 12;

	repeat

		dec(x1, 2);

		k:= CountNonZeroz(x1, y)

	until (x1 < Longint(leftX)+150) or (k = 0) or (k = 16) or (x1 < i);

	inc(x1, 2);

	if k = 16 then

		begin

		while (x2 < (rightX-150)) and (CountNonZeroz(x2, y) = 0) do inc(x2, 2);

		i:= x2 + 12;

		repeat

		inc(x2, 2);

		k:= CountNonZeroz(x2, y)

			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

	Result:= true;

	tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/Girder', false, false, true);

	if tmpsurf = nil then tmpsurf:= LoadImage(Pathz[ptGraphics] + '/Girder', false, true, true);

	rr.x:= x1;

	while rr.x < x2 do

		begin

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

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

		end;

	SDL_FreeSurface(tmpsurf);

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

	end else Result:= false;

AddGirder:= Result

end;

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

var i: Longword;

    Result: boolean;

begin

Result:= true;

inc(rect.x, dX);

inc(rect.y, dY);

i:= 0;

{$WARNINGS OFF}

while (i <= rect.w) and Result do

      begin

      Result:= (Land[rect.y, rect.x + i] = Color) and (Land[rect.y + rect.h, rect.x + i] = Color);

      inc(i)

      end;

i:= 0;

while (i <= rect.h) and Result do

      begin

      Result:= (Land[rect.y + i, rect.x] = Color) and (Land[rect.y + i, rect.x + rect.w] = Color);

      inc(i)

      end;

{$WARNINGS ON}

CheckLand:= Result

end;

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

var i: Longword;

    Result: boolean;

begin

with Obj do

     if CheckLand(inland, x, y, COLOR_LAND) then

        begin

        Result:= true;

        i:= 1;

        while Result and (i <= rectcnt) do

              begin

              Result:= CheckLand(outland[i], x, y, 0);

              inc(i)

              end;

        if Result then

           Result:= not CheckIntersect(x, y, Width, Height)

        end else

        Result:= false;

CheckCanPlace:= Result

end;

function TryPut(var Obj: TThemeObject): boolean; overload;

const MaxPointsIndex = 2047;

var x, y: Longword;

    ar: array[0..MaxPointsIndex] of TPoint;

    cnt, i: Longword;

    Result: boolean;

begin

cnt:= 0;

with Obj do

     begin

     if Maxcnt = 0 then

        exit(false);

     x:= 0;

     repeat

         y:= topY+32; // leave room for a hedgie to teleport in

         repeat

             if CheckCanPlace(x, y, Obj) then

                begin

                ar[cnt].x:= x;

                ar[cnt].y:= y;

                inc(cnt);

                if cnt > MaxPointsIndex then // buffer is full, do not check the rest land

                   begin

                   y:= 5000;

                   x:= 5000;

                   end

                end;

             inc(y, 3);

         until y > LAND_HEIGHT - 1 - Height;

         inc(x, getrandom(6) + 3)

     until x > LAND_WIDTH - 1 - Width;

     Result:= cnt <> 0;

     if Result then

        begin

        i:= getrandom(cnt);

        BlitImageAndGenerateCollisionInfo(ar[i].x, ar[i].y, 0, Obj.Surf);

        AddRect(ar[i].x, ar[i].y, Width, Height);

        dec(Maxcnt)

        end else Maxcnt:= 0

     end;

TryPut:= Result

end;

function TryPut(var Obj: TSprayObject; Surface: PSDL_Surface): boolean; overload;

const MaxPointsIndex = 8095;

var x, y: Longword;

    ar: array[0..MaxPointsIndex] of TPoint;

    cnt, i: Longword;

    r: TSDL_Rect;

    Result: boolean;

begin

cnt:= 0;

with Obj do

	begin

	if Maxcnt = 0 then

		exit(false);

	x:= 0;

	r.x:= 0;

	r.y:= 0;

	r.w:= Width;

	r.h:= Height + 16;

	repeat

		y:= 8;

		repeat

			if CheckLand(r, x, y - 8, COLOR_LAND)

			and not CheckIntersect(x, y, Width, Height) then

			begin

			ar[cnt].x:= x;

			ar[cnt].y:= y;

			inc(cnt);

			if cnt > MaxPointsIndex then // buffer is full, do not check the rest land

				begin

				y:= 5000;

				x:= 5000;

				end

			end;

			inc(y, 12);

		until y > 1023 - Height - 8;

		inc(x, getrandom(12) + 12)

	until x > 2047 - Width;

	Result:= cnt <> 0;

	if Result then

		begin

		i:= getrandom(cnt);

		r.x:= ar[i].X;

		r.y:= ar[i].Y;

		r.w:= Width;

		r.h:= Height;

		SDL_UpperBlit(Obj.Surf, nil, Surface, @r);

		AddRect(ar[i].x - 32, ar[i].y - 32, Width + 64, Height + 64);

		dec(Maxcnt)

		end else Maxcnt:= 0

	end;

TryPut:= Result

end;

procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSprayObjects);

var s: string;

    f: textfile;

    i, ii: LongInt;

    vobcount: Longword;

    c1, c2: TSDL_Color;

	procedure CheckRect(Width, Height, x, y, w, h: LongWord);

	begin

	if (x + w > Width) then OutError('Object''s rectangle exceeds image: x + w (' + inttostr(x) + ' + ' + inttostr(w) + ') > Width (' + inttostr(Width) + ')', true);

	if (y + h > Height) then OutError('Object''s rectangle exceeds image: y + h (' + inttostr(y) + ' + ' + inttostr(h) + ') > Height (' + inttostr(Height) + ')', true);

	end;

begin

s:= Pathz[ptCurrTheme] + '/' + cThemeCFGFilename;

WriteLnToConsole('Reading objects info...');

Assign(f, s);

{$I-}

Reset(f);

// read sky and explosion border colors

Readln(f, c1.r, c1.g, c1. b);

Readln(f, c2.r, c2.g, c2. b);

// read water gradient colors

Readln(f, WaterColorArray[0].r, WaterColorArray[0].g, WaterColorArray[0]. b);

Readln(f, WaterColorArray[2].r, WaterColorArray[2].g, WaterColorArray[2]. b);

WaterColorArray[1]:= WaterColorArray[0];

WaterColorArray[3]:= WaterColorArray[2];

glClearColor(c1.r / 255, c1.g / 255, c1.b / 255, 0.99); // sky color

cExplosionBorderColor:= c2.value or $FF000000;

ReadLn(f, s);

if MusicFN = '' then MusicFN:= s;

ReadLn(f, cCloudsNumber);

// TODO - adjust all the theme cloud numbers. This should not be a permanent fix

cCloudsNumber:= cCloudsNumber * (LAND_WIDTH div 2048);

Readln(f, ThemeObjects.Count);

for i:= 0 to Pred(ThemeObjects.Count) do

	begin

	Readln(f, s); // filename

	with ThemeObjects.objs[i] do

			begin

			Surf:= LoadImage(Pathz[ptCurrTheme] + '/' + s, false, true, true);

			Width:= Surf^.w;

			Height:= Surf^.h;

			with inland do

				begin

				Read(f, x, y, w, h);

				CheckRect(Width, Height, x, y, w, h)

				end;

			Read(f, rectcnt);

			for ii:= 1 to rectcnt do

				with outland[ii] do

					begin

					Read(f, x, y, w, h);

					CheckRect(Width, Height, x, y, w, h)

					end;

			Maxcnt:= 3;

			ReadLn(f)

			end;

	end;

// sprays

Readln(f, SprayObjects.Count);

for i:= 0 to Pred(SprayObjects.Count) do

    begin

    Readln(f, s); // filename

    with SprayObjects.objs[i] do

         begin

         Surf:= LoadImage(Pathz[ptCurrTheme] + '/' + s, false, true, true);

         Width:= Surf^.w;

         Height:= Surf^.h;

         ReadLn(f, Maxcnt)

         end;

    end;

// snowflakes

Readln(f, vobCount);

if vobCount > 0 then

   Readln(f, vobFramesCount, vobFrameTicks, vobVelocity, vobFallSpeed);

for i:= 0 to Pred(vobCount) do

    AddVisualGear( -cScreenWidth + random(cScreenWidth * 2 + LAND_WIDTH), random(1024+200) - 100 + LAND_HEIGHT, vgtFlake);

Close(f);

{$I+}

TryDo(IOResult = 0, 'Bad data or cannot access file ' + cThemeCFGFilename, true)

end;

procedure AddThemeObjects(var ThemeObjects: TThemeObjects; MaxCount: LongInt);

var i, ii, t: LongInt;

    b: boolean;

begin

if ThemeObjects.Count = 0 then exit;

WriteLnToConsole('Adding theme objects...');

i:= 1;

repeat

    t:= getrandom(ThemeObjects.Count);

    ii:= t;

    repeat

      inc(ii);

      if ii = ThemeObjects.Count then ii:= 0;

      b:= TryPut(ThemeObjects.objs[ii])

    until b or (ii = t);

    inc(i)

until (i > MaxCount) or not b;

end;

procedure AddSprayObjects(Surface: PSDL_Surface; var SprayObjects: TSprayObjects; MaxCount: Longword);

var i: Longword;

    ii, t: LongInt;

    b: boolean;

begin

if SprayObjects.Count = 0 then exit;

WriteLnToConsole('Adding spray objects...');

i:= 1;

repeat

    t:= getrandom(SprayObjects.Count);

    ii:= t;

    repeat

      inc(ii);

      if ii = SprayObjects.Count then ii:= 0;

      b:= TryPut(SprayObjects.objs[ii], Surface)

    until b or (ii = t);

    inc(i)

until (i > MaxCount) or not b;

end;

procedure AddObjects();

var i, int: Longword;

begin

InitRects;

if hasGirders then