hedgewars/uVisualGears.pas
author koda
Wed, 30 Jun 2010 23:27:18 +0200
changeset 3599 715a43602da8
parent 3597 978c30ef50fc
child 3611 ed00aa2b339e
permissions -rw-r--r--
sheepluva's inline patch, fix a crash in overlay

(*
 * 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
 *)

{$INCLUDE "options.inc"}

unit uVisualGears;
interface
uses uConsts, uFloat, Math, GLunit;

type PVisualGear = ^TVisualGear;
    TVGearStepProcedure = procedure (Gear: PVisualGear; Steps: Longword);
    TVisualGear = record
        NextGear, PrevGear: PVisualGear;
        Frame,
        FrameTicks: Longword;
        X : float;
        Y : float;
        dX: float;
        dY: float;
        tdX: float;
        tdY: float;
        State : Longword;
        Timer: Longword;
        Angle, dAngle: real;
        Kind: TVisualGearType;
        doStep: TVGearStepProcedure;
        Tex: PTexture;
        alpha, scale: GLfloat;
        Hedgehog: pointer;
        Text: shortstring;
        Tint: Longword;
        end;

procedure initModule;
procedure freeModule;

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

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

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

{$INCLUDE "VGSHandlers.inc"}

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;


// ==================================================================

// ==================================================================
const doStepHandlers: array[TVisualGearType] of TVGearStepProcedure =
        (
            @doStepFlake,
            @doStepCloud,
            @doStepExpl,
            @doStepExpl,
            @doStepFire,
            @doStepSmallDamage,
            @doStepTeamHealthSorter,
            @doStepSpeechBubble,
            @doStepBubble,
            @doStepSteam,
            @doStepAmmo,
            @doStepSmoke,
            @doStepSmoke,
            @doStepHealth,
            @doStepShell,
            @doStepDust,
            @doStepSplash,
            @doStepDroplet,
            @doStepSmokeRing,
            @doStepBeeTrace,
            @doStepEgg,
            @doStepFeather,
            @doStepHealthTag,
            @doStepSmokeTrace,
            @doStepSmokeTrace,
            @doStepExplosion,
            @doStepBigExplosion
        );

function  AddVisualGear(X, Y: LongInt; Kind: TVisualGearType; State: LongWord = 0): PVisualGear;
var gear: PVisualGear;
    t: Longword;
    sp: float;
begin
if (GameType = gmtSave) or (fastUntilLag and (GameType = gmtNet)) then // we are scrolling now
    if Kind <> vgtCloud then
        begin
        AddVisualGear:= nil;
        exit
        end;

if ((cReducedQuality and rqFancyBoom) <> 0) and
   not (Kind in
   [vgtTeamHealthSorter,
    vgtSmallDamageTag,
    vgtSpeechBubble,
    vgtHealthTag,
    vgtExplosion,
    vgtSmokeTrace,
    vgtEvilTrace]) then
    begin
      AddVisualGear:= nil;
      exit
    end;

New(gear);
FillChar(gear^, sizeof(TVisualGear), 0);
gear^.X:= float(X);
gear^.Y:= float(Y);
gear^.Kind := Kind;
gear^.doStep:= doStepHandlers[Kind];
gear^.State:= 0;
gear^.Tint:= $FFFFFFFF;

with gear^ do
    case Kind of
    vgtFlake: begin
                Timer:= 0;
                tdX:= 0;
                tdY:= 0;
                FrameTicks:= random(vobFrameTicks);
                Frame:= random(vobFramesCount);
                Angle:= random * 360;
                dx:= 0.0000038654705 * random(10000);
                dy:= 0.000003506096 * random(7000);
                if random(2) = 0 then dx := -dx;
                dAngle:= (random(2) * 2 - 1) * (1 + random) * vobVelocity / 1000
                end;
    vgtCloud: begin
                Frame:= random(4);
                dx:= 0.000005 * random(10000);
                if random(2) = 0 then dx := -dx;
                timer:= random(4096);
                end;
    vgtExplPart,
    vgtExplPart2: begin
                t:= random(1024);
                sp:= 0.001 * (random(95) + 70);
                dx:= AngleSin(t).QWordValue/4294967296 * sp;
                dy:= AngleCos(t).QWordValue/4294967296 * sp;
                if random(2) = 0 then dx := -dx;
                if random(2) = 0 then dy := -dy;
                Frame:= 7 - random(3);
                FrameTicks:= cExplFrameTicks
                end;
        vgtFire: begin
                t:= random(1024);
                sp:= 0.001 * (random(85) + 95);
                dx:= AngleSin(t).QWordValue/4294967296 * sp;
                dy:= AngleCos(t).QWordValue/4294967296 * sp;
                if random(2) = 0 then dx := -dx;
                if random(2) = 0 then dy := -dy;
                FrameTicks:= 650 + random(250);
                Frame:= random(8)
                end;
         vgtEgg: begin
                t:= random(1024);
                sp:= 0.001 * (random(85) + 95);
                dx:= AngleSin(t).QWordValue/4294967296 * sp;
                dy:= AngleCos(t).QWordValue/4294967296 * sp;
                if random(2) = 0 then dx := -dx;
                if random(2) = 0 then dy := -dy;
                FrameTicks:= 650 + random(250);
                Frame:= 1
                end;
        vgtShell: FrameTicks:= 500;
    vgtSmallDamageTag: begin
                gear^.FrameTicks:= 1100
                end;
    vgtBubble: begin
                dx:= 0.0000038654705 * random(10000);
                dy:= 0.001 * (random(85) + 95);
                if random(2) = 0 then dx := -dx;
                FrameTicks:= 250 + random(1751);
                Frame:= random(5)
                end;
    vgtSteam: begin
                dx:= 0.0000038654705 * random(10000);
                dy:= 0.001 * (random(85) + 95);
                if random(2) = 0 then dx := -dx;
                Frame:= 7 - random(3);
                FrameTicks:= cExplFrameTicks * 2;
                end;
    vgtAmmo: begin
                alpha:= 1.0;
                scale:= 1.0
                end;
  vgtSmokeWhite, 
  vgtSmoke: begin
                dx:= 0.0002 * (random(45) + 10);
                dy:= 0.0002 * (random(45) + 10);
                if random(2) = 0 then dx := -dx;
                Frame:= 7 - random(2);
                FrameTicks:= cExplFrameTicks * 2;
                end;
    vgtHealth: begin
                dx:= 0.001 * random(45);
                dy:= 0.001 * (random(20) + 25);
                if random(2) = 0 then dx := -dx;
                Frame:= 0;
                FrameTicks:= random(750) + 1250;
                end;
  vgtDust: begin
                dx:= 0.005 * (random(15) + 10);
                dy:= 0.001 * (random(40) + 20);
                if random(2) = 0 then dx := -dx;
                Frame:= 7 - random(2);
                FrameTicks:= random(20) + 15;
                end;
  vgtSplash: begin
                dx:= 0;
                dy:= 0;
                FrameTicks:= 740;
                Frame:= 19;
                end;
    vgtDroplet: begin
                dx:= 0.001 * (random(75) + 15);
                dy:= -0.001 * (random(80) + 120);
                if random(2) = 0 then dx := -dx;
                FrameTicks:= 250 + random(1751);
                Frame:= random(3)
                end;
   vgtBeeTrace: begin
                FrameTicks:= 1000;
                Frame:= random(16);
                end;
    vgtSmokeRing: begin
                dx:= 0;
                dy:= 0;
                FrameTicks:= 600;
                Timer:= 0;
                Frame:= 0;
                scale:= 0.6;
                alpha:= 1;
                angle:= random(360);
                end;
     vgtFeather: begin
                t:= random(1024);
                sp:= 0.001 * (random(85) + 95);
                dx:= AngleSin(t).QWordValue/4294967296 * sp;
                dy:= AngleCos(t).QWordValue/4294967296 * sp;
                if random(2) = 0 then dx := -dx;
                if random(2) = 0 then dy := -dy;
                FrameTicks:= 650 + random(250);
                Frame:= 1
                end;
  vgtHealthTag: begin
                gear^.Timer:= 1500;
                //gear^.Z:= 2002;
                end;
  vgtSmokeTrace,
  vgtEvilTrace: begin
                gear^.X:= gear^.X - 16;
                gear^.Y:= gear^.Y - 16;
                gear^.State:= 8;
                //gear^.Z:= cSmokeZ
                end;
vgtBigExplosion: begin
                gear^.Angle:= random(360);
                end;
        end;

if State <> 0 then gear^.State:= State;

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

AddVisualGear:= gear;
end;

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

    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 KickFlakes(Radius, X, Y: LongInt);
var Gear, t: PVisualGear;
    dmg: LongInt;
begin
if (vobCount = 0) or (vobCount > 200) or ((cReducedQuality and rqkillFlakes) <> 0) then exit;
t:= VisualGearsList;
while t <> nil do
      begin
      Gear:= t;
      if Gear^.Kind = vgtFlake then
          begin
          // Damage calc from doMakeExplosion
          dmg:= min(101,Radius  + cHHRadius div 2 - (round(abs(Gear^.X - float(X))+abs(Gear^.Y - float(Y))) div 5));
          if dmg > 1 then
              begin
              Gear^.tdX:= 0.02 * dmg + 0.01;
              if Gear^.X - X < 0 then Gear^.tdX := -Gear^.tdX;
              Gear^.tdY:= 0.02 * dmg + 0.01;
              if Gear^.Y - Y < 0 then Gear^.tdY := -Gear^.tdY;
              Gear^.Timer:= 200
              end
          end;
      t:= Gear^.NextGear
      end
end;

procedure DrawVisualGears(Layer: LongWord);
var Gear: PVisualGear;
begin
Gear:= VisualGearsList;
case Layer of
    0: while Gear <> nil do
        begin
        Tint(Gear^.Tint);
        case Gear^.Kind of
            vgtFlake: if vobVelocity = 0 then
                        DrawSprite(sprFlake, round(Gear^.X) + WorldDx, round(Gear^.Y) + WorldDy + SkyOffset, Gear^.Frame)
                    else
                        DrawRotatedF(sprFlake, round(Gear^.X) + WorldDx, round(Gear^.Y) + WorldDy + SkyOffset, Gear^.Frame, 1, Gear^.Angle);
            vgtCloud: DrawSprite(sprCloud, round(Gear^.X) + WorldDx, round(Gear^.Y) + WorldDy + SkyOffset, Gear^.Frame);
            end;
        Gear:= Gear^.NextGear
        end;
    1: while Gear <> nil do
        begin
        Tint(Gear^.Tint);
        case Gear^.Kind of
            vgtSmokeTrace: if Gear^.State < 8 then DrawSprite(sprSmokeTrace, round(Gear^.X) + WorldDx, round(Gear^.Y) + WorldDy, Gear^.State);
            vgtEvilTrace: if Gear^.State < 8 then DrawSprite(sprEvilTrace, round(Gear^.X) + WorldDx, round(Gear^.Y) + WorldDy, Gear^.State);
        end;
            if (cReducedQuality and rqFancyBoom) = 0 then
                case Gear^.Kind of
                    vgtSmoke: DrawSprite(sprSmoke, round(Gear^.X) + WorldDx - 11, round(Gear^.Y) + WorldDy - 11, 7 - Gear^.Frame);
                    vgtSmokeWhite: DrawSprite(sprSmokeWhite, round(Gear^.X) + WorldDx - 11, round(Gear^.Y) + WorldDy - 11, 7 - Gear^.Frame);
                    vgtDust: DrawSprite(sprDust, round(Gear^.X) + WorldDx - 11, round(Gear^.Y) + WorldDy - 11, 7 - Gear^.Frame);
                    vgtFeather: begin
                            if Gear^.FrameTicks < 255 then
                                Tint($FF, $FF, $FF, Gear^.FrameTicks);
                            DrawRotatedF(sprFeather, round(Gear^.X) + WorldDx, round(Gear^.Y) + WorldDy, Gear^.Frame, 1, Gear^.Angle);
                            end;
                 end;
        Gear:= Gear^.NextGear
        end;
    2: while Gear <> nil do
        begin
        Tint(Gear^.Tint);
        case Gear^.Kind of
            vgtExplosion: DrawSprite(sprExplosion50, round(Gear^.X) - 32 + WorldDx, round(Gear^.Y) - 32 + WorldDy, Gear^.State);
            vgtBigExplosion: begin
                             Tint($FF, $FF, $FF, floor($FF * (1 - power(Gear^.Timer / 250, 4))));
                             DrawRotatedTextureF(SpritesData[sprBigExplosion].Texture, 0.85 * (-power(2, -10 * Int(Gear^.Timer)/250) + 1) + 0.4, 0, 0, round(Gear^.X) + WorldDx, round(Gear^.Y) + WorldDy, 0, 1, 385, 385, Gear^.Angle);
                             end;
            end;
        if (cReducedQuality and rqFancyBoom) = 0 then
            case Gear^.Kind of
                vgtExplPart: DrawSprite(sprExplPart, round(Gear^.X) + WorldDx - 16, round(Gear^.Y) + WorldDy - 16, 7 - Gear^.Frame);
                vgtExplPart2: DrawSprite(sprExplPart2, round(Gear^.X) + WorldDx - 16, round(Gear^.Y) + WorldDy - 16, 7 - Gear^.Frame);
                vgtFire: DrawSprite(sprFlame, round(Gear^.X) + WorldDx - 8, round(Gear^.Y) + WorldDy, (RealTicks div 64 + Gear^.Frame) mod 8);
                vgtBubble: DrawSprite(sprBubbles, round(Gear^.X) + WorldDx - 8, round(Gear^.Y) + WorldDy - 8, Gear^.Frame);//(RealTicks div 64 + Gear^.Frame) mod 8);
                vgtSteam: DrawSprite(sprExplPart, round(Gear^.X) + WorldDx - 16, round(Gear^.Y) + WorldDy - 16, 7 - Gear^.Frame);
                vgtAmmo: begin
                        Tint($FF, $FF, $FF, floor(Gear^.alpha * $FF));
                        DrawTextureF(ropeIconTex, Gear^.scale, round(Gear^.X) + WorldDx, round(Gear^.Y) + WorldDy, 0, 1, 32, 32);
                        DrawTextureF(SpritesData[sprAMAmmos].Texture, Gear^.scale * 0.90, round(Gear^.X) + WorldDx, round(Gear^.Y) + WorldDy, Gear^.Frame - 1, 1, 32, 32);
                        end;
                vgtHealth:  begin
                            case Gear^.Frame div 10 of
                                0:Tint(0, $FF, 0, floor(Gear^.FrameTicks * $FF / 1000));
                                1:Tint($FF, 0, 0, floor(Gear^.FrameTicks * $FF / 1000));
                            end;
                            DrawSprite(sprHealth, round(Gear^.X) + WorldDx - 8, round(Gear^.Y) + WorldDy - 8, 0);
                            end;
                vgtShell: begin
                            if Gear^.FrameTicks < $FF then
                                Tint($FF, $FF, $FF, Gear^.FrameTicks);
                            DrawRotatedF(sprShell, round(Gear^.X) + WorldDx, round(Gear^.Y) + WorldDy, Gear^.Frame, 1, Gear^.Angle);
                            end;
                  vgtEgg: begin
                            if Gear^.FrameTicks < $FF then
                                Tint($FF, $FF, $FF, Gear^.FrameTicks);
                            DrawRotatedF(sprEgg, round(Gear^.X) + WorldDx, round(Gear^.Y) + WorldDy, Gear^.Frame, 1, Gear^.Angle);
                            end;
                vgtSplash: DrawSprite(sprSplash, round(Gear^.X) + WorldDx - 40, round(Gear^.Y) + WorldDy - 58, 19 - (Gear^.FrameTicks div 37));
                vgtDroplet: DrawSprite(sprDroplet, round(Gear^.X) + WorldDx - 8, round(Gear^.Y) + WorldDy - 8, Gear^.Frame);
               vgtBeeTrace: begin
                            if Gear^.FrameTicks < $FF then
                                Tint($FF, $FF, $FF, Gear^.FrameTicks div 2)
                            else
                                Tint($FF, $FF, $FF, $80);
                            DrawRotatedF(sprBeeTrace, round(Gear^.X) + WorldDx, round(Gear^.Y) + WorldDy, Gear^.Frame, 1, (RealTicks shr 4) mod cMaxAngle);
                            end;
                vgtSmokeRing: begin
                            Tint($FF, $FF, $FF, floor(Gear^.alpha * $FF));
                            DrawRotatedTextureF(SpritesData[sprSmokeRing].Texture, Gear^.scale, 0, 0, round(Gear^.X) + WorldDx, round(Gear^.Y) + WorldDy, 0, 1, 200, 200, Gear^.Angle);
                            end;
            end;
        case Gear^.Kind of
            vgtSmallDamageTag: DrawCentered(round(Gear^.X) + WorldDx, round(Gear^.Y) + WorldDy, Gear^.Tex);
            vgtSpeechBubble: if Gear^.Tex <> nil then DrawCentered(round(Gear^.X) + WorldDx, round(Gear^.Y) + WorldDy, Gear^.Tex);
            vgtHealthTag: if Gear^.Tex <> nil then DrawCentered(round(Gear^.X) + WorldDx, round(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;

procedure FreeVisualGears;
begin
    while VisualGearsList <> nil do DeleteVisualGear(VisualGearsList);
end;

procedure initModule;
begin
    VisualGearsList:= nil;
end;

procedure freeModule;
begin
end;

end.