(*

 * Hedgewars, a free turn based strategy game

 * Copyright (c) 2004-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 uStore;

interface

uses uConsts, uTeams, SDLh, uFloat, GL;

{$INCLUDE options.inc}

procedure StoreInit;

procedure StoreLoad;

procedure StoreRelease;

procedure DrawSpriteFromRect(Sprite: TSprite; r: TSDL_Rect; X, Y, Height, Position: LongInt);

procedure DrawSprite (Sprite: TSprite; X, Y, Frame: LongInt);

procedure DrawSprite2(Sprite: TSprite; X, Y, FrameX, FrameY: LongInt);

procedure DrawSurfSprite(X, Y, Height, Frame: LongInt; Source: PTexture);

procedure DrawTexture(X, Y: LongInt; Texture: PTexture);

procedure DrawTextureF(Texture: PTexture; Scale: GLfloat; X, Y, Frame, Dir, Frames: LongInt);

procedure DrawRotated(Sprite: TSprite; X, Y, Dir: LongInt; Angle: real);

procedure DrawRotatedF(Sprite: TSprite; X, Y, Frame, Dir: LongInt; Angle: real);

procedure DrawRotatedTex(Tex: PTexture; hw, hh, X, Y, Dir: LongInt; Angle: real);

procedure DrawCentered(X, Top: LongInt; Source: PTexture);

procedure DrawFromRect(X, Y: LongInt; r: PSDL_Rect; SourceTexture: PTexture);

procedure DrawHedgehog(X, Y: LongInt; Dir: LongInt; Pos, Step: LongWord; Angle: real);

procedure DrawFillRect(r: TSDL_Rect);

function  RenderStringTex(s: string; Color: Longword; font: THWFont): PTexture;

procedure RenderHealth(var Hedgehog: THedgehog);

procedure AddProgress;

procedure FinishProgress;

function  LoadImage(const filename: string; hasAlpha, critical, setTransparent: boolean): PSDL_Surface;

procedure SetupOpenGL;

var PixelFormat: PSDL_PixelFormat = nil;

 SDLPrimSurface: PSDL_Surface = nil;

   PauseTexture,

   ConfirmTexture: PTexture;

implementation

uses uMisc, uConsole, uLand, uLocale, GLU;

var

    HHTexture: PTexture;

procedure StoreInit;

begin

end;

procedure DrawRoundRect(rect: PSDL_Rect; BorderColor, FillColor: Longword; Surface: PSDL_Surface; Clear: boolean);

var r: TSDL_Rect;

begin

r:= rect^;

if Clear then SDL_FillRect(Surface, @r, 0);

BorderColor:= SDL_MapRGB(Surface^.format, BorderColor shr 16, BorderColor shr 8, BorderColor and $FF);

FillColor:= SDL_MapRGB(Surface^.format, FillColor shr 16, FillColor shr 8, FillColor and $FF);

r.y:= rect^.y + 1;

r.h:= rect^.h - 2;

SDL_FillRect(Surface, @r, BorderColor);

r.x:= rect^.x + 1;

r.w:= rect^.w - 2;

r.y:= rect^.y;

r.h:= rect^.h;

SDL_FillRect(Surface, @r, BorderColor);

r.x:= rect^.x + 2;

r.y:= rect^.y + 1;

r.w:= rect^.w - 4;

r.h:= rect^.h - 2;

SDL_FillRect(Surface, @r, FillColor);

r.x:= rect^.x + 1;

r.y:= rect^.y + 2;

r.w:= rect^.w - 2;

r.h:= rect^.h - 4;

SDL_FillRect(Surface, @r, FillColor)

end;

function WriteInRoundRect(Surface: PSDL_Surface; X, Y: LongInt; Color: LongWord; Font: THWFont; s: string): TSDL_Rect;

var w, h: LongInt;

    tmpsurf: PSDL_Surface;

    clr: TSDL_Color;

    Result: TSDL_Rect;

begin

TTF_SizeUTF8(Fontz[Font].Handle, Str2PChar(s), w, h);

Result.x:= X;

Result.y:= Y;

Result.w:= w + FontBorder * 2 + 4;

Result.h:= h + FontBorder * 2;

DrawRoundRect(@Result, cWhiteColor, cColorNearBlack, Surface, true);

clr.r:= Color shr 16;

clr.g:= (Color shr 8) and $FF;

clr.b:= Color and $FF;

tmpsurf:= TTF_RenderUTF8_Blended(Fontz[Font].Handle, Str2PChar(s), clr.value);

Result.x:= X + FontBorder + 2;

Result.y:= Y + FontBorder;

SDLTry(tmpsurf <> nil, true);

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

SDL_FreeSurface(tmpsurf);

Result.x:= X;

Result.y:= Y;

Result.w:= w + FontBorder * 2 + 4;

Result.h:= h + FontBorder * 2;

WriteInRoundRect:= Result

end;

procedure StoreLoad;

var s: string;

	procedure WriteNames(Font: THWFont);

	var t: LongInt;

		i: LongInt;

		r, rr: TSDL_Rect;

		drY: LongInt;

		texsurf: PSDL_Surface;

	begin

	r.x:= 0;

	r.y:= 0;

	drY:= - 4;

	for t:= 0 to Pred(TeamsCount) do

		with TeamsArray[t]^ do

		begin

		NameTagTex:= RenderStringTex(TeamName, Clan^.Color, Font);

		r.w:= cTeamHealthWidth + 5;

		r.h:= NameTagTex^.h;

		texsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, r.w, r.h, 32, RMask, GMask, BMask, AMask);

		TryDo(texsurf <> nil, errmsgCreateSurface, true);

		TryDo(SDL_SetColorKey(texsurf, SDL_SRCCOLORKEY, 0) = 0, errmsgTransparentSet, true);

		DrawRoundRect(@r, cWhiteColor, cColorNearBlack, texsurf, true);

		rr:= r;

		inc(rr.x, 2); dec(rr.w, 4); inc(rr.y, 2); dec(rr.h, 4);

		DrawRoundRect(@rr, Clan^.Color, Clan^.Color, texsurf, false);

		HealthTex:= Surface2Tex(texsurf);

		SDL_FreeSurface(texsurf);

		dec(drY, r.h + 2);

		DrawHealthY:= drY;

		for i:= 0 to 7 do

			with Hedgehogs[i] do

				if Gear <> nil then

					begin

					NameTagTex:= RenderStringTex(Name, Clan^.Color, fnt16);

					if Hat <> 'NoHat' then

						begin

						texsurf:= LoadImage(Pathz[ptHats] + '/' + Hat, false, false, false);

						if texsurf <> nil then

							begin

							HatTex:= Surface2Tex(texsurf);

							SDL_FreeSurface(texsurf)

							end

						end

					end;

		end;

	end;

	procedure MakeCrossHairs;

	var t: LongInt;

		tmpsurf, texsurf: PSDL_Surface;

		Color, i: Longword;

	begin

	s:= Pathz[ptGraphics] + '/' + cCHFileName;

	tmpsurf:= LoadImage(s, true, true, false);

	for t:= 0 to Pred(TeamsCount) do

		with TeamsArray[t]^ do

		begin

		texsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, tmpsurf^.w, tmpsurf^.h, 32, RMask, GMask, BMask, AMask);

		TryDo(texsurf <> nil, errmsgCreateSurface, true);

		Color:= Clan^.Color;

		Color:= SDL_MapRGB(texsurf^.format, Color shr 16, Color shr 8, Color and $FF);

		SDL_FillRect(texsurf, nil, Color);

		SDL_UpperBlit(tmpsurf, nil, texsurf, nil);

		TryDo(tmpsurf^.format^.BytesPerPixel = 4, 'Ooops', true);

		if SDL_MustLock(texsurf) then

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

		// make black pixel be alpha-transparent

		for i:= 0 to texsurf^.w * texsurf^.h - 1 do

			if PLongwordArray(texsurf^.pixels)^[i] = $FF000000 then PLongwordArray(texsurf^.pixels)^[i]:= 0;

		if SDL_MustLock(texsurf) then

			SDL_UnlockSurface(texsurf);

		CrosshairTex:= Surface2Tex(texsurf);

		SDL_FreeSurface(texsurf)

		end;

	SDL_FreeSurface(tmpsurf)

	end;

	procedure InitHealth;

	var i, t: LongInt;

	begin

	for t:= 0 to Pred(TeamsCount) do

		if TeamsArray[t] <> nil then

			with TeamsArray[t]^ do

				begin

				for i:= 0 to cMaxHHIndex do

					if Hedgehogs[i].Gear <> nil then

						RenderHealth(Hedgehogs[i]);

				end

	end;

	procedure LoadGraves;

	var t: LongInt;

		texsurf: PSDL_Surface;

	begin

	for t:= 0 to Pred(TeamsCount) do

	if TeamsArray[t] <> nil then

		with TeamsArray[t]^ do

			begin

			if GraveName = '' then GraveName:= 'Simple';

			texsurf:= LoadImage(Pathz[ptGraves] + '/' + GraveName, false, true, true);

			GraveTex:= Surface2Tex(texsurf);

			SDL_FreeSurface(texsurf)

			end

	end;

var ii: TSprite;

    fi: THWFont;

    ai: TAmmoType;

    tmpsurf: PSDL_Surface;

    i: LongInt;

begin

for fi:= Low(THWFont) to High(THWFont) do

	with Fontz[fi] do

		begin

		s:= Pathz[ptFonts] + '/' + Name;

		WriteToConsole(msgLoading + s + '... ');

		Handle:= TTF_OpenFont(Str2PChar(s), Height);

		SDLTry(Handle <> nil, true);

		TTF_SetFontStyle(Handle, style);

		WriteLnToConsole(msgOK)

		end;

AddProgress;

WriteNames(fnt16);

MakeCrossHairs;

LoadGraves;

AddProgress;

for ii:= Low(TSprite) to High(TSprite) do

	with SpritesData[ii] do

			begin

			if AltPath = ptNone then

				tmpsurf:= LoadImage(Pathz[Path] + '/' + FileName, true, true, true)

			else begin

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

				if tmpsurf = nil then

					tmpsurf:= LoadImage(Pathz[AltPath] + '/' + FileName, true, true, true)

				end;

			if Width = 0 then Width:= tmpsurf^.w;

			if Height = 0 then Height:= tmpsurf^.h;

			Texture:= Surface2Tex(tmpsurf);

			if saveSurf then Surface:= tmpsurf else SDL_FreeSurface(tmpsurf)

			end;

AddProgress;

tmpsurf:= LoadImage(Pathz[ptGraphics] + '/' + cHHFileName, true, true, true);

HHTexture:= Surface2Tex(tmpsurf);

SDL_FreeSurface(tmpsurf);

InitHealth;

PauseTexture:= RenderStringTex(trmsg[sidPaused], $FFFF00, fntBig);

ConfirmTexture:= RenderStringTex(trmsg[sidConfirm], $FFFF00, fntBig);

for ai:= Low(TAmmoType) to High(TAmmoType) do

	with Ammoz[ai] do

		begin

		tmpsurf:= TTF_RenderUTF8_Blended(Fontz[fnt16].Handle, Str2PChar(trAmmo[NameId]), $FFFFFF);

		NameTex:= Surface2Tex(tmpsurf);

		SDL_FreeSurface(tmpsurf)

		end;

for i:= Low(CountTexz) to High(CountTexz) do

	begin

	tmpsurf:= TTF_RenderUTF8_Blended(Fontz[fnt16].Handle, Str2PChar(IntToStr(i) + 'x'), $FFFFFF);

	CountTexz[i]:= Surface2Tex(tmpsurf);

	SDL_FreeSurface(tmpsurf)

	end;

{$IFDEF DUMP}

SDL_SaveBMP_RW(LandSurface, SDL_RWFromFile('LandSurface.bmp', 'wb'), 1);

SDL_SaveBMP_RW(StoreSurface, SDL_RWFromFile('StoreSurface.bmp', 'wb'), 1);

{$ENDIF}

end;

procedure DrawFromRect(X, Y: LongInt; r: PSDL_Rect; SourceTexture: PTexture);

var rr: TSDL_Rect;

    _l, _r, _t, _b: real;

begin

if SourceTexture^.h = 0 then exit;

rr.x:= X;

rr.y:= Y;

rr.w:= r^.w;

rr.h:= r^.h;

_l:= r^.x / SourceTexture^.w * SourceTexture^.rx;

_r:= (r^.x + r^.w) / SourceTexture^.w * SourceTexture^.rx;

_t:= r^.y / SourceTexture^.h * SourceTexture^.ry;

_b:= (r^.y + r^.h) / SourceTexture^.h * SourceTexture^.ry;

glBindTexture(GL_TEXTURE_2D, SourceTexture^.id);

glBegin(GL_QUADS);

glTexCoord2f(_l, _t);

glVertex2i(X, Y);

glTexCoord2f(_r, _t);

glVertex2i(rr.w + X, Y);

glTexCoord2f(_r, _b);

glVertex2i(rr.w + X, rr.h + Y);

glTexCoord2f(_l, _b);

glVertex2i(X, rr.h + Y);

glEnd()

end;

procedure DrawTexture(X, Y: LongInt; Texture: PTexture);

begin

glBindTexture(GL_TEXTURE_2D, Texture^.id);

end;

procedure DrawTextureF(Texture: PTexture; Scale: GLfloat; X, Y, Frame, Dir, Frames: LongInt);

var ft, fb: GLfloat;

	hw: LongInt;

begin

glPushMatrix;

glTranslatef(X, Y, 0);

glScalef(Scale, Scale, 1.0);

if Dir < 0 then

	hw:= - 16

else

	hw:= 16;

ft:= Frame / Frames * Texture^.ry;

fb:= (Frame + 1) / Frames * Texture^.ry;

glBindTexture(GL_TEXTURE_2D, Texture^.id);

glBegin(GL_QUADS);

glTexCoord2f(0, ft);

glVertex2i(-hw, -16);

glTexCoord2f(Texture^.rx, ft);

glVertex2i(hw, -16);

glTexCoord2f(Texture^.rx, fb);

glVertex2i(hw, 16);

glTexCoord2f(0, fb);

glVertex2i(-hw, 16);

glEnd();

glPopMatrix

end;

procedure DrawRotated(Sprite: TSprite; X, Y, Dir: LongInt; Angle: real);

begin

DrawRotatedTex(SpritesData[Sprite].Texture,

		SpritesData[Sprite].Width,

		SpritesData[Sprite].Height,

		X, Y, Dir, Angle)

end;

procedure DrawRotatedF(Sprite: TSprite; X, Y, Frame, Dir: LongInt; Angle: real);

begin

glPushMatrix;

glTranslatef(X, Y, 0);

glRotatef(Angle, 0, 0, 1);

if Dir < 0 then glScalef(-1.0, 1.0, 1.0);

DrawSprite(Sprite, -SpritesData[Sprite].Width div 2, -SpritesData[Sprite].Height div 2, Frame);

glPopMatrix

end;

procedure DrawRotatedTex(Tex: PTexture; hw, hh, X, Y, Dir: LongInt; Angle: real);

begin

glPushMatrix;

glTranslatef(X, Y, 0);

if Dir < 0 then

   begin

   hw:= - hw;

   glRotatef(Angle, 0, 0, -1);

   end else

   glRotatef(Angle, 0, 0,  1);

glBindTexture(GL_TEXTURE_2D, Tex^.id);

glBegin(GL_QUADS);

glTexCoord2f(0, 0);

glVertex2i(-hw, -hh);

glTexCoord2f(Tex^.rx, 0);

glVertex2i(hw, -hh);

glTexCoord2f(Tex^.rx, Tex^.ry);

glVertex2i(hw, hh);

glTexCoord2f(0, Tex^.ry);

glVertex2i(-hw, hh);

glEnd();

glPopMatrix

end;

procedure DrawSpriteFromRect(Sprite: TSprite; r: TSDL_Rect; X, Y, Height, Position: LongInt);

begin

r.y:= r.y + Height * Position;

r.h:= Height;

DrawFromRect(X, Y, @r, SpritesData[Sprite].Texture)