hedgewars/uVisualGears.pas
author nemo
Tue, 08 Sep 2009 19:44:49 +0000
changeset 2357 babe1a55e284
parent 2152 a2811690da1b
child 2376 ece7b87f1334
permissions -rw-r--r--
Add an empty weapon to avoid selection of weapons which aren't yet ready. Might all be useful to switch to amNothing in certain situations, like after using up all ropes, instead of bazooka.

(*
 * Hedgewars, a free turn based strategy game
 * Copyright (c) 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 uVisualGears;
interface
uses SDLh, uConsts,
{$IFDEF GLES11}
	gles11,
{$ELSE}
	GL,
{$ENDIF}
	uFloat;
{$INCLUDE options.inc}

type PVisualGear = ^TVisualGear;
	TVGearStepProcedure = procedure (Gear: PVisualGear; Steps: Longword);
	TVisualGear = record
		NextGear, PrevGear: PVisualGear;
		Frame,
		FrameTicks: Longword;
		X : hwFloat;
		Y : hwFloat;
		dX: hwFloat;
		dY: hwFloat;
		mdY: QWord;
		Timer: Longword;
		Angle, dAngle: real;
		Kind: TVisualGearType;
		doStep: TVGearStepProcedure;
		Tex: PTexture;
        Hedgehog: pointer;
        Text: shortstring
		end;

function  AddVisualGear(X, Y: LongInt; Kind: TVisualGearType): PVisualGear;
procedure ProcessVisualGears(Steps: Longword);
procedure DrawVisualGears(Layer: LongWord);
procedure DeleteVisualGear(Gear: PVisualGear);
procedure AddClouds;
procedure AddDamageTag(X, Y, Damage, Color: LongWord);

var VisualGearsList: PVisualGear = nil;
	vobFrameTicks, vobFramesCount: Longword;
	vobVelocity, vobFallSpeed: LongInt;

implementation
uses uWorld, uMisc, uStore, uTeams, uSound;
const cExplFrameTicks = 110;

procedure AddDamageTag(X, Y, Damage, Color: LongWord);
var s: shortstring;
	Gear: PVisualGear;
begin
if cAltDamage then
	begin
	Gear:= AddVisualGear(X, Y, vgtSmallDamageTag);
	if Gear <> nil then
		with Gear^ do
			begin
			str(Damage, s);
			Tex:= RenderStringTex(s, Color, fntSmall);
			end
	end
end;


// ==================================================================
procedure doStepFlake(Gear: PVisualGear; Steps: Longword);
begin
with Gear^ do
	begin
	inc(FrameTicks, Steps);
	if FrameTicks > vobFrameTicks then
		begin
		dec(FrameTicks, vobFrameTicks);
		inc(Frame);
		if Frame = vobFramesCount then Frame:= 0
		end
	end;

Gear^.X:= Gear^.X + (cWindSpeed * 200 + Gear^.dX) * Steps;
Gear^.Y:= Gear^.Y + (Gear^.dY + cGravity * vobFallSpeed) * Steps;
Gear^.Angle:= Gear^.Angle + Gear^.dAngle * Steps;

if hwRound(Gear^.X) < -cScreenWidth - 64 then Gear^.X:= int2hwFloat(cScreenWidth + LAND_WIDTH) else
if hwRound(Gear^.X) > cScreenWidth + LAND_WIDTH then Gear^.X:= int2hwFloat(-cScreenWidth - 64);
// if hwRound(Gear^.Y) < (LAND_HEIGHT - 1024 - 75) then Gear^.Y:= Gear^.Y + int2hwFloat(25); // For if flag is set for flakes rising upwards?
if hwRound(Gear^.Y) > (LAND_HEIGHT + 75) then Gear^.Y:= Gear^.Y - int2hwFloat(1024 + 150) // TODO - configure in theme (jellies for example could use limited range)
end;

procedure doStepCloud(Gear: PVisualGear; Steps: Longword);
var i: Longword;
begin
Gear^.X:= Gear^.X + (cWindSpeed * 200 + Gear^.dX) * Steps;

for i:= 0 to Steps - 1 do
	begin
	if hwRound(Gear^.Y) > LAND_HEIGHT-1184 then // TODO - configure in theme
		Gear^.dY:= Gear^.dY - _1div50000
	else
		Gear^.dY:= Gear^.dY + _1div50000;

	Gear^.Y:= Gear^.Y + Gear^.dY
	end;

if hwRound(Gear^.X) < -cScreenWidth - 256 then Gear^.X:= int2hwFloat(cScreenWidth + LAND_WIDTH) else
if hwRound(Gear^.X) > cScreenWidth + LAND_WIDTH then Gear^.X:= int2hwFloat(-cScreenWidth - 256)
end;

procedure doStepExpl(Gear: PVisualGear; Steps: Longword);
begin
Gear^.X:= Gear^.X + Gear^.dX * Steps;

Gear^.Y:= Gear^.Y + Gear^.dY * Steps;
//Gear^.dY:= Gear^.dY + cGravity;

if Gear^.FrameTicks <= Steps then
	if Gear^.Frame = 0 then DeleteVisualGear(Gear)
	else
		begin
		dec(Gear^.Frame);
		Gear^.FrameTicks:= cExplFrameTicks
		end
	else dec(Gear^.FrameTicks, Steps)
end;

procedure doStepFire(Gear: PVisualGear; Steps: Longword);
begin
Gear^.X:= Gear^.X + Gear^.dX * Steps;

Gear^.Y:= Gear^.Y + Gear^.dY * Steps;// + cGravity * (Steps * Steps);
Gear^.dY:= Gear^.dY + cGravity * Steps;

if Gear^.FrameTicks <= Steps then
       DeleteVisualGear(Gear)
else
	dec(Gear^.FrameTicks, Steps)
end;

procedure doStepSmallDamage(Gear: PVisualGear; Steps: Longword);
begin
Gear^.Y:= Gear^.Y - _0_02 * Steps;

if Gear^.FrameTicks <= Steps then
	DeleteVisualGear(Gear)
else
	dec(Gear^.FrameTicks, Steps)
end;

procedure doStepBubble(Gear: PVisualGear; Steps: Longword);
begin
	Gear^.X:= Gear^.X + (cWindSpeed * 100 + Gear^.dX) * Steps;
	Gear^.Y:= Gear^.Y - cDrownSpeed * Steps;
	
	if (Gear^.FrameTicks <= Steps) or (hwRound(Gear^.Y) < cWaterLine) then
		DeleteVisualGear(Gear)
	else
		dec(Gear^.FrameTicks, Steps)
end;

procedure doStepSteam(Gear: PVisualGear; Steps: Longword);
begin
	Gear^.X:= Gear^.X + (cWindSpeed * 100 + Gear^.dX) * Steps;
	Gear^.Y:= Gear^.Y - cDrownSpeed * Steps;

	if Gear^.FrameTicks <= Steps then
		if Gear^.Frame = 0 then DeleteVisualGear(Gear)
		else
			begin
			if Random(2) = 0 then dec(Gear^.Frame);
			Gear^.FrameTicks:= cExplFrameTicks
			end
		else dec(Gear^.FrameTicks, Steps)
end;

////////////////////////////////////////////////////////////////////////////////
const cSorterWorkTime = 640;
var thexchar: array[0..cMaxTeams] of
			record
			dy, ny, dw: LongInt;
			team: PTeam;
			SortFactor: QWord;
			end;
    currsorter: PVisualGear = nil;

procedure doStepTeamHealthSorterWork(Gear: PVisualGear; Steps: Longword);
var i, t: LongInt;
begin
for t:= 1 to Steps do
	begin
	dec(Gear^.Timer);
	if (Gear^.Timer and 15) = 0 then
		for i:= 0 to Pred(TeamsCount) do
			with thexchar[i] do
				begin
				{$WARNINGS OFF}
				team^.DrawHealthY:= ny + dy * Gear^.Timer div 640;
				team^.TeamHealthBarWidth:= team^.NewTeamHealthBarWidth + dw * Gear^.Timer div cSorterWorkTime;
				{$WARNINGS ON}
				end;

	if (Gear^.Timer = 0) or (currsorter <> Gear) then
		begin
		if currsorter = Gear then currsorter:= nil;
		DeleteVisualGear(Gear);
		exit
		end
	end
end;

procedure doStepTeamHealthSorter(Gear: PVisualGear; Steps: Longword);
var i: Longword;
	b: boolean;
	t: LongInt;
begin
for t:= 0 to Pred(TeamsCount) do
	with thexchar[t] do
		begin
		dy:= TeamsArray[t]^.DrawHealthY;
		dw:= TeamsArray[t]^.TeamHealthBarWidth - TeamsArray[t]^.NewTeamHealthBarWidth;
		team:= TeamsArray[t];
		SortFactor:= TeamsArray[t]^.Clan^.ClanHealth;
		SortFactor:= (SortFactor shl  3) + TeamsArray[t]^.Clan^.ClanIndex;
		SortFactor:= (SortFactor shl 30) + TeamsArray[t]^.TeamHealth;
		end;

if TeamsCount > 1 then
	repeat
	b:= true;
	for t:= 0 to TeamsCount - 2 do
		if (thexchar[t].SortFactor > thexchar[Succ(t)].SortFactor) then
			begin
			thexchar[cMaxTeams]:= thexchar[t];
			thexchar[t]:= thexchar[Succ(t)];
			thexchar[Succ(t)]:= thexchar[cMaxTeams];
			b:= false
			end
	until b;

t:= - 4;
for i:= 0 to Pred(TeamsCount) do
	with thexchar[i] do
		begin
		dec(t, team^.HealthTex^.h + 2);
		ny:= t;
		dy:= dy - ny
		end;

Gear^.Timer:= cSorterWorkTime;
Gear^.doStep:= @doStepTeamHealthSorterWork;
currsorter:= Gear;
//doStepTeamHealthSorterWork(Gear, Steps)
end;

procedure doStepSpeechBubbleWork(Gear: PVisualGear; Steps: Longword);
begin
if Gear^.Timer > Steps then dec(Gear^.Timer, Steps) else Gear^.Timer:= 0;

if (PHedgehog(Gear^.Hedgehog)^.Gear <> nil) then
	begin
	Gear^.X:= PHedgehog(Gear^.Hedgehog)^.Gear^.X + int2hwFloat(Gear^.Tex^.w div 2  - Gear^.FrameTicks);
	Gear^.Y:= PHedgehog(Gear^.Hedgehog)^.Gear^.Y - int2hwFloat(16 + Gear^.Tex^.h);
	end;

if Gear^.Timer = 0 then
	begin
	if PHedgehog(Gear^.Hedgehog)^.SpeechGear = Gear then
		PHedgehog(Gear^.Hedgehog)^.SpeechGear:= nil;
	DeleteVisualGear(Gear)
	end;
end;

procedure doStepSpeechBubble(Gear: PVisualGear; Steps: Longword);
begin
with PHedgehog(Gear^.Hedgehog)^ do
    if SpeechGear <> nil then SpeechGear^.Timer:= 0;

PHedgehog(Gear^.Hedgehog)^.SpeechGear:= Gear;

Gear^.Timer:= max(Length(Gear^.Text) * 150, 3000);

Gear^.Tex:= RenderSpeechBubbleTex(Gear^.Text, Gear^.FrameTicks, fnt16);

case Gear^.FrameTicks of
    1: Gear^.FrameTicks:= SpritesData[sprSpeechTail].Width-28;
    2: Gear^.FrameTicks:= SpritesData[sprThoughtTail].Width-20;
    3: Gear^.FrameTicks:= SpritesData[sprShoutTail].Width-10;
    end;

Gear^.doStep:= @doStepSpeechBubbleWork;

Gear^.Y:= Gear^.Y - int2hwFloat(Gear^.Tex^.h)
end;

// ==================================================================
const doStepHandlers: array[TVisualGearType] of TVGearStepProcedure =
		(
			@doStepFlake,
			@doStepCloud,
			@doStepExpl,
			@doStepExpl,
			@doStepFire,
			@doStepSmallDamage,
			@doStepTeamHealthSorter,
			@doStepSpeechBubble,
			@doStepBubble,
			@doStepSteam
		);

function  AddVisualGear(X, Y: LongInt; Kind: TVisualGearType): PVisualGear;
var Result: PVisualGear;
	t: Longword;
	sp: hwFloat;
begin
if (GameType = gmtSave) or (fastUntilLag and (GameType = gmtNet)) then // we're scrolling now
	if Kind <> vgtCloud then
		begin
		AddVisualGear:= nil;
		exit
		end;

if cReducedQuality and 
   (Kind <> vgtTeamHealthSorter) and 
   (Kind <> vgtSmallDamageTag) and 
   (Kind <> vgtSpeechBubble) then
	begin
	AddVisualGear:= nil;
	exit
	end;

New(Result);
FillChar(Result^, sizeof(TVisualGear), 0);
Result^.X:= int2hwFloat(X);
Result^.Y:= int2hwFloat(Y);
Result^.Kind := Kind;
Result^.doStep:= doStepHandlers[Kind];

with Result^ do
	case Kind of
	vgtFlake: begin
				FrameTicks:= random(vobFrameTicks);
				Frame:= random(vobFramesCount);
				Angle:= random * 360;
				dx.isNegative:= random(2) = 0;
				dx.QWordValue:= random(100000000);
				dy.isNegative:= false;
				dy.QWordValue:= random(70000000);
				dAngle:= (random(2) * 2 - 1) * (1 + random) * vobVelocity / 1000
				end;
	vgtCloud: begin
				Frame:= random(4);
				dx.isNegative:= random(2) = 0;
				dx.QWordValue:= random(214748364);
				dy.isNegative:= random(2) = 0;
				dy.QWordValue:= 21474836 + random(64424509);
				mdY:= dy.QWordValue
				end;
	vgtExplPart,
	vgtExplPart2: begin
				t:= random(1024);
				sp:= _0_001 * (random(95) + 70);
				dx:= AngleSin(t) * sp;
				dx.isNegative:= random(2) = 0;
				dy:= AngleCos(t) * sp;
				dy.isNegative:= random(2) = 0;
				Frame:= 7 - random(3);
				FrameTicks:= cExplFrameTicks
				end;
		vgtFire: begin
				t:= random(1024);
				sp:= _0_001 * (random(85) + 95);
				dx:= AngleSin(t) * sp;
				dx.isNegative:= random(2) = 0;
				dy:= AngleCos(t) * sp;
				dy.isNegative:= random(2) = 0;
				FrameTicks:= 650 + random(250);
				Frame:= random(8)
				end;
	vgtSmallDamageTag: begin
				Result^.FrameTicks:= 1100
				end;
	vgtBubble: begin
				t:= random(1024);
				sp:= _0_001 * (random(85) + 95);
				dx.isNegative:= random(2) = 0;
				dx.QWordValue:= random(100000000);
				dy:= sp;
				dy.isNegative:= false;
				FrameTicks:= 250 + random(1751);
				Frame:= random(5)
				end;
	vgtSteam: begin
				t:= random(1024);
				sp:= _0_001 * (random(95) + 70);
				dx.isNegative:= random(2) = 0;
				dx.QWordValue:= random(100000000);
				dy:= sp;
				dy.isNegative:= false;
				Frame:= 7 - random(3);
				FrameTicks:= cExplFrameTicks * 2;
				end;
		end;

if VisualGearsList <> nil then
	begin
	VisualGearsList^.PrevGear:= Result;
	Result^.NextGear:= VisualGearsList
	end;
VisualGearsList:= Result;

AddVisualGear:= Result
end;

procedure DeleteVisualGear(Gear: PVisualGear);
begin
if Gear^.Tex <> nil then
	FreeTexture(Gear^.Tex);

if Gear^.NextGear <> nil then Gear^.NextGear^.PrevGear:= Gear^.PrevGear;
if Gear^.PrevGear <> nil then Gear^.PrevGear^.NextGear:= Gear^.NextGear
   else VisualGearsList:= Gear^.NextGear;

Dispose(Gear)
end;

procedure ProcessVisualGears(Steps: Longword);
var Gear, t: PVisualGear;
begin
if Steps = 0 then exit;

t:= VisualGearsList;
while t <> nil do
      begin
      Gear:= t;
      t:= Gear^.NextGear;
      Gear^.doStep(Gear, Steps)
      end
end;

procedure DrawVisualGears(Layer: LongWord);
var Gear: PVisualGear;
begin
Gear:= VisualGearsList;
case Layer of
	0: while Gear <> nil do
		begin
		case Gear^.Kind of
			vgtFlake: if vobVelocity = 0 then
						DrawSprite(sprFlake, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, Gear^.Frame)
					else
						DrawRotatedF(sprFlake, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, Gear^.Frame, 1, Gear^.Angle);
			vgtCloud: DrawSprite(sprCloud, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, Gear^.Frame);
			end;
		Gear:= Gear^.NextGear
		end;
	1: while Gear <> nil do
		begin
        if not cReducedQuality then
            case Gear^.Kind of
                vgtExplPart: DrawSprite(sprExplPart, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 7 - Gear^.Frame);
                vgtExplPart2: DrawSprite(sprExplPart2, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 7 - Gear^.Frame);
                vgtFire: DrawSprite(sprFlame, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, (RealTicks div 64 + Gear^.Frame) mod 8);
				vgtBubble: DrawSprite(sprBubbles, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, Gear^.Frame);//(RealTicks div 64 + Gear^.Frame) mod 8);
				vgtSteam: DrawSprite(sprExplPart, hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, 7 - Gear^.Frame);
            end;
        case Gear^.Kind of
            vgtSmallDamageTag: DrawCentered(hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, Gear^.Tex);
            vgtSpeechBubble: if Gear^.Tex <> nil then DrawCentered(hwRound(Gear^.X) + WorldDx, hwRound(Gear^.Y) + WorldDy, Gear^.Tex);
        end;
		Gear:= Gear^.NextGear
		end
	end
end;

procedure AddClouds;
var i: LongInt;
begin
for i:= 0 to cCloudsNumber - 1 do
    AddVisualGear( - cScreenWidth + i * ((cScreenWidth * 2 + (LAND_WIDTH+256)) div (cCloudsNumber + 1)), LAND_HEIGHT-1184, vgtCloud)
end;

initialization

finalization

end.