hedgewars/uGearsUtils.pas
author unc0rr
Wed, 29 Feb 2012 23:44:49 +0400
changeset 6753 e95b1f62d0de
parent 6700 e04da46ee43c
child 6765 8fcd2508c49f
permissions -rw-r--r--
Don't remove client's teams from teams list on "ROUNDFINISHED 0", just send team removal message to others. This should fix problems with ghost teams in frontend. Not tested at all, successfully built on first attempt, which is considered as a bad sign :D Server still thinks game proceeds, so restart isn't possible.

(*
 * Hedgewars, a free turn based strategy game
 * Copyright (c) 2004-2012 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 uGearsUtils;
interface
uses uTypes;

procedure doMakeExplosion(X, Y, Radius: LongInt; AttackingHog: PHedgehog; Mask: Longword; const Tint: LongWord = $FFFFFFFF); 
function  ModifyDamage(dmg: Longword; Gear: PGear): Longword;
procedure ApplyDamage(Gear: PGear; AttackerHog: PHedgehog; Damage: Longword; Source: TDamageSource);
procedure spawnHealthTagForHH(HHGear: PGear; dmg: Longword);
procedure HHHurt(Hedgehog: PHedgehog; Source: TDamageSource);
procedure CheckHHDamage(Gear: PGear);
procedure CalcRotationDirAngle(Gear: PGear);
procedure ResurrectHedgehog(gear: PGear);
procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity: boolean = false);
function  CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear;
function  CheckGearsNear(mX, mY: LongInt; Kind: TGearsType; rX, rY: LongInt): PGear;
function  CheckGearDrowning(Gear: PGear): boolean;

var doStepHandlers: array[TGearType] of TGearStepProcedure;


implementation
uses uFloat, uSound, uCollisions, uUtils, uConsts, uVisualGears, uAIMisc,
    uVariables, uLandGraphics, uScript, uStats, uCaptions, uTeams, uStore,
    uLocale, uTextures, uRenderUtils, uRandom, SDLh, uDebug, uGears,
    uGearsList;

procedure doMakeExplosion(X, Y, Radius: LongInt; AttackingHog: PHedgehog; Mask: Longword; const Tint: LongWord);
var Gear: PGear;
    dmg, dmgRadius, dmgBase: LongInt;
    fX, fY: hwFloat;
    vg: PVisualGear;
    i, cnt: LongInt;
begin
if Radius > 4 then AddFileLog('Explosion: at (' + inttostr(x) + ',' + inttostr(y) + ')');
if Radius > 25 then KickFlakes(Radius, X, Y);

if ((Mask and EXPLNoGfx) = 0) then
    begin
    vg:= nil;
    if Radius > 50 then vg:= AddVisualGear(X, Y, vgtBigExplosion)
    else if Radius > 10 then vg:= AddVisualGear(X, Y, vgtExplosion);
    if vg <> nil then
        vg^.Tint:= Tint;
    end;
if (Mask and EXPLAutoSound) <> 0 then PlaySound(sndExplosion);

if (Mask and EXPLAllDamageInRadius) = 0 then
    dmgRadius:= Radius shl 1
else
    dmgRadius:= Radius;
dmgBase:= dmgRadius + cHHRadius div 2;
fX:= int2hwFloat(X);
fY:= int2hwFloat(Y);
Gear:= GearsList;
while Gear <> nil do
    begin
    dmg:= 0;
    //dmg:= dmgRadius  + cHHRadius div 2 - hwRound(Distance(Gear^.X - int2hwFloat(X), Gear^.Y - int2hwFloat(Y)));
    //if (dmg > 1) and
    if (Gear^.State and gstNoDamage) = 0 then
        begin
        case Gear^.Kind of
            gtHedgehog,
                gtMine,
                gtBall,
                gtMelonPiece,
                gtGrenade,
                gtClusterBomb,
            //    gtCluster, too game breaking I think
                gtSMine,
                gtCase,
                gtTarget,
                gtFlame,
                gtExplosives,
                gtStructure: begin
// Run the calcs only once we know we have a type that will need damage
                        if hwRound(hwAbs(Gear^.X-fX)+hwAbs(Gear^.Y-fY)) < dmgBase then
                            dmg:= dmgBase - max(hwRound(Distance(Gear^.X - fX, Gear^.Y - fY)),Gear^.Radius);
                        if dmg > 1 then
                            begin
                            dmg:= ModifyDamage(min(dmg div 2, Radius), Gear);
                            //AddFileLog('Damage: ' + inttostr(dmg));
                            if (Mask and EXPLNoDamage) = 0 then
                                begin
                                if not Gear^.Invulnerable then
                                    ApplyDamage(Gear, AttackingHog, dmg, dsExplosion)
                                else
                                    Gear^.State:= Gear^.State or gstWinner;
                                end;
                            if ((Mask and EXPLDoNotTouchAny) = 0) and (((Mask and EXPLDoNotTouchHH) = 0) or (Gear^.Kind <> gtHedgehog)) then
                                begin
                                DeleteCI(Gear);
                                Gear^.dX:= Gear^.dX + SignAs(_0_005 * dmg + cHHKick, Gear^.X - fX)/(Gear^.Density/_3);
                                Gear^.dY:= Gear^.dY + SignAs(_0_005 * dmg + cHHKick, Gear^.Y - fY)/(Gear^.Density/_3);

                                Gear^.State:= (Gear^.State or gstMoving) and (not gstLoser);
                                if not Gear^.Invulnerable then
                                    Gear^.State:= (Gear^.State or gstMoving) and (not gstWinner);
                                Gear^.Active:= true;
                                if Gear^.Kind <> gtFlame then FollowGear:= Gear
                                end;
                            if ((Mask and EXPLPoisoned) <> 0) and (Gear^.Kind = gtHedgehog) and (not Gear^.Invulnerable) then
                                Gear^.Hedgehog^.Effects[hePoisoned] := true;
                            end;

                        end;
                gtGrave: begin
// Run the calcs only once we know we have a type that will need damage
                        if hwRound(hwAbs(Gear^.X-fX)+hwAbs(Gear^.Y-fY)) < dmgBase then
                            dmg:= dmgBase - hwRound(Distance(Gear^.X - fX, Gear^.Y - fY));
                        if dmg > 1 then
                            begin
                            dmg:= ModifyDamage(min(dmg div 2, Radius), Gear);
                            Gear^.dY:= - _0_004 * dmg;
                            Gear^.Active:= true
                            end
                        end;
            end;
        end;
    Gear:= Gear^.NextGear
    end;

if (Mask and EXPLDontDraw) = 0 then
    if (GameFlags and gfSolidLand) = 0 then
        begin
        cnt:= DrawExplosion(X, Y, Radius) div 1608; // approx 2 16x16 circles to erase per chunk
        if (cnt > 0) and (SpritesData[sprChunk].Texture <> nil) then
            for i:= 0 to cnt do
                AddVisualGear(X, Y, vgtChunk)
        end;

uAIMisc.AwareOfExplosion(0, 0, 0)
end;

function ModifyDamage(dmg: Longword; Gear: PGear): Longword;
var i: hwFloat;
begin
(* Invulnerability cannot be placed in here due to still needing kicks
   Not without a new damage machine.
   King check should be in here instead of ApplyDamage since Tiy wants them kicked less
*)
i:= _1;
if (CurrentHedgehog <> nil) and CurrentHedgehog^.King then
    i:= _1_5;
if (Gear^.Hedgehog <> nil) and (Gear^.Hedgehog^.King) then
    ModifyDamage:= hwRound(_0_01 * cDamageModifier * dmg * i * cDamagePercent * _0_5)
else
    ModifyDamage:= hwRound(_0_01 * cDamageModifier * dmg * i * cDamagePercent)
end;

procedure ApplyDamage(Gear: PGear; AttackerHog: PHedgehog; Damage: Longword; Source: TDamageSource);
var s: shortstring;
    vampDmg, tmpDmg, i: Longword;
    vg: PVisualGear;
begin
    if Damage = 0 then
        exit; // nothing to apply

    if (Gear^.Kind = gtHedgehog) then
        begin
        Gear^.LastDamage := AttackerHog;

        Gear^.Hedgehog^.Team^.Clan^.Flawless:= false;
        HHHurt(Gear^.Hedgehog, Source);
        AddDamageTag(hwRound(Gear^.X), hwRound(Gear^.Y), Damage, Gear^.Hedgehog^.Team^.Clan^.Color);
        tmpDmg:= min(Damage, max(0,Gear^.Health-Gear^.Damage));
        if (Gear <> CurrentHedgehog^.Gear) and (CurrentHedgehog^.Gear <> nil) and (tmpDmg >= 1) then
            begin
            if cVampiric then
                begin
                vampDmg:= hwRound(int2hwFloat(tmpDmg)*_0_8);
                if vampDmg >= 1 then
                    begin
                    // was considering pulsing on attack, Tiy thinks it should be permanent while in play
                    //CurrentHedgehog^.Gear^.State:= CurrentHedgehog^.Gear^.State or gstVampiric;
                    inc(CurrentHedgehog^.Gear^.Health,vampDmg);
                    str(vampDmg, s);
                    s:= '+' + s;
                    AddCaption(s, CurrentHedgehog^.Team^.Clan^.Color, capgrpAmmoinfo);
                    RenderHealth(CurrentHedgehog^);
                    RecountTeamHealth(CurrentHedgehog^.Team);
                    i:= 0;
                    while i < vampDmg do
                        begin
                        vg:= AddVisualGear(hwRound(CurrentHedgehog^.Gear^.X), hwRound(CurrentHedgehog^.Gear^.Y), vgtStraightShot);
                        if vg <> nil then
                            with vg^ do
                                begin
                                Tint:= $FF0000FF;
                                State:= ord(sprHealth)
                                end;
                        inc(i, 5);
                        end;
                    end
                end;
        if ((GameFlags and gfKarma) <> 0) and 
        ((GameFlags and gfInvulnerable) = 0)
        and (not CurrentHedgehog^.Gear^.Invulnerable) then
            begin // this cannot just use Damage or it interrupts shotgun and gets you called stupid
            inc(CurrentHedgehog^.Gear^.Karma, tmpDmg);
            CurrentHedgehog^.Gear^.LastDamage := CurrentHedgehog;
            spawnHealthTagForHH(CurrentHedgehog^.Gear, tmpDmg);
            end;
        uStats.HedgehogDamaged(Gear, AttackerHog, Damage, false);    
        end;
    end
    else if Gear^.Kind <> gtStructure then // not gtHedgehog nor gtStructure
        begin
        Gear^.Hedgehog:= AttackerHog;
        end;
    inc(Gear^.Damage, Damage);
    
    ScriptCall('onGearDamage', Gear^.UID, Damage);
end;

procedure spawnHealthTagForHH(HHGear: PGear; dmg: Longword);
var tag: PVisualGear;
begin
tag:= AddVisualGear(hwRound(HHGear^.X), hwRound(HHGear^.Y), vgtHealthTag, dmg);
if (tag <> nil) then
    tag^.Hedgehog:= HHGear^.Hedgehog; // the tag needs the tag to determine the text color
AllInactive:= false;
HHGear^.Active:= true;
end;
    
procedure HHHurt(Hedgehog: PHedgehog; Source: TDamageSource);
begin
if (Source = dsFall) or (Source = dsExplosion) then
    case random(3) of
        0: PlaySound(sndOoff1, Hedgehog^.Team^.voicepack);
        1: PlaySound(sndOoff2, Hedgehog^.Team^.voicepack);
        2: PlaySound(sndOoff3, Hedgehog^.Team^.voicepack);
    end
else if (Source = dsPoison) then
    case random(2) of
        0: PlaySound(sndPoisonCough, Hedgehog^.Team^.voicepack);
        1: PlaySound(sndPoisonMoan, Hedgehog^.Team^.voicepack);
    end
else
    case random(4) of
        0: PlaySound(sndOw1, Hedgehog^.Team^.voicepack);
        1: PlaySound(sndOw2, Hedgehog^.Team^.voicepack);
        2: PlaySound(sndOw3, Hedgehog^.Team^.voicepack);
        3: PlaySound(sndOw4, Hedgehog^.Team^.voicepack);
    end
end;

procedure CheckHHDamage(Gear: PGear);
var 
    dmg: Longword;
    i: LongInt;
    particle: PVisualGear;
begin
    if _0_4 < Gear^.dY then
        begin
        dmg := ModifyDamage(1 + hwRound((hwAbs(Gear^.dY) - _0_4) * 70), Gear);
        PlaySound(sndBump);
        if dmg < 1 then
            exit;

        for i:= min(12, (3 + dmg div 10)) downto 0 do
            begin
            particle := AddVisualGear(hwRound(Gear^.X) - 5 + Random(10), hwRound(Gear^.Y) + 12, vgtDust);
            if particle <> nil then
                particle^.dX := particle^.dX + (Gear^.dX.QWordValue / 21474836480);
            end;

        if (Gear^.Invulnerable) then
            exit;

        //if _0_6 < Gear^.dY then
        //    PlaySound(sndOw4, Gear^.Hedgehog^.Team^.voicepack)
        //else
        //    PlaySound(sndOw1, Gear^.Hedgehog^.Team^.voicepack);

        if Gear^.LastDamage <> nil then
            ApplyDamage(Gear, Gear^.LastDamage, dmg, dsFall)
        else
            ApplyDamage(Gear, CurrentHedgehog, dmg, dsFall);
    end
end;


procedure CalcRotationDirAngle(Gear: PGear);
var 
    dAngle: real;
begin
    dAngle := (Gear^.dX.QWordValue + Gear^.dY.QWordValue) / $80000000;
    if not Gear^.dX.isNegative then
        Gear^.DirAngle := Gear^.DirAngle + dAngle
    else
        Gear^.DirAngle := Gear^.DirAngle - dAngle;

    if Gear^.DirAngle < 0 then
        Gear^.DirAngle := Gear^.DirAngle + 360
    else if 360 < Gear^.DirAngle then
        Gear^.DirAngle := Gear^.DirAngle - 360
end;

function CheckGearDrowning(Gear: PGear): boolean;
var 
    skipSpeed, skipAngle, skipDecay: hwFloat;
    i, maxDrops, X, Y: LongInt;
    vdX, vdY: real;
    particle: PVisualGear;
    isSubmersible: boolean;
begin
    // probably needs tweaking. might need to be in a case statement based upon gear type
    Y:= hwRound(Gear^.Y);
    if cWaterLine < Y + Gear^.Radius then
        begin
        isSubmersible:= (Gear = CurrentHedgehog^.Gear) and (CurAmmoGear <> nil) and (CurAmmoGear^.AmmoType = amJetpack);
        skipSpeed := _0_25;
        skipAngle := _1_9;
        skipDecay := _0_87;
        X:= hwRound(Gear^.X);
        vdX:= hwFloat2Float(Gear^.dX);
        vdY:= hwFloat2Float(Gear^.dY);
        // this could perhaps be a tiny bit higher.
        if  (hwSqr(Gear^.dX) + hwSqr(Gear^.dY) > skipSpeed)
        and (hwAbs(Gear^.dX) > skipAngle * hwAbs(Gear^.dY)) then
            begin
            Gear^.dY.isNegative := true;
            Gear^.dY := Gear^.dY * skipDecay;
            Gear^.dX := Gear^.dX * skipDecay;
            CheckGearDrowning := false;
            PlaySound(sndSkip)
            end
        else
            begin
            if not isSubmersible then
                begin
                CheckGearDrowning := true;
                Gear^.State := gstDrowning;
                Gear^.RenderTimer := false;
                if (Gear^.Kind <> gtSniperRifleShot) and (Gear^.Kind <> gtShotgunShot)
                and (Gear^.Kind <> gtDEagleShot) and (Gear^.Kind <> gtSineGunShot) then
                    if Gear^.Kind = gtHedgehog then
                        begin
                        if Gear^.Hedgehog^.Effects[heResurrectable] then
                            ResurrectHedgehog(Gear)
                        else
                            begin
                            Gear^.doStep := @doStepDrowningGear;
                            Gear^.State := Gear^.State and (not gstHHDriven);
                            AddCaption(Format(GetEventString(eidDrowned), Gear^.Hedgehog^.Name), cWhiteColor, capgrpMessage);
                            end
                        end
                    else
                        Gear^.doStep := @doStepDrowningGear;
                        if Gear^.Kind = gtFlake then
                            exit // skip splashes 
                end;
            if ((not isSubmersible) and (Y < cWaterLine + 64 + Gear^.Radius))
            or (isSubmersible and (Y < cWaterLine + 2 + Gear^.Radius) and ((CurAmmoGear^.Pos = 0)
            and (CurAmmoGear^.dY < _0_01))) then
                // don't play splash if they are already way past the surface
                PlaySound(sndSplash)
            end;

        if ((cReducedQuality and rqPlainSplash) = 0)
        and (((not isSubmersible) and (Y < cWaterLine + 64 + Gear^.Radius))
        or (isSubmersible and (Y < cWaterLine + 2 + Gear^.Radius) and ((CurAmmoGear^.Pos = 0)
        and (CurAmmoGear^.dY < _0_01)))) then
            begin
            AddVisualGear(X, cWaterLine, vgtSplash);

            maxDrops := (Gear^.Radius div 2) + round(vdX * Gear^.Radius * 2) + round(vdY * Gear^.Radius * 2);
            for i:= max(maxDrops div 3, min(32, Random(maxDrops))) downto 0 do
                begin
                particle := AddVisualGear(X - 3 + Random(6), cWaterLine, vgtDroplet);
                if particle <> nil then
                    begin
                    particle^.dX := particle^.dX - vdX / 10;
                    particle^.dY := particle^.dY - vdY / 5;
                    end
                end
            end;
        if isSubmersible and (CurAmmoGear^.Pos = 0) then
            CurAmmoGear^.Pos := 1000
        end
    else
        CheckGearDrowning := false;
end;


procedure ResurrectHedgehog(gear: PGear);
var tempTeam : PTeam;
begin
    AttackBar:= 0;
    gear^.dX := _0;
    gear^.dY := _0;
    gear^.Damage := 0;
    gear^.Health := gear^.Hedgehog^.InitialHealth;
    gear^.Hedgehog^.Effects[hePoisoned] := false;
    if not CurrentHedgehog^.Effects[heResurrectable] then
        with CurrentHedgehog^ do 
            begin
            inc(Team^.stats.AIKills);
            FreeTexture(Team^.AIKillsTex);
            Team^.AIKillsTex := RenderStringTex(inttostr(Team^.stats.AIKills), Team^.Clan^.Color, fnt16);
            end;
    tempTeam := gear^.Hedgehog^.Team;
    DeleteCI(gear);
    FindPlace(gear, false, 0, LAND_WIDTH, true); 
    if gear <> nil then
        begin
        RenderHealth(gear^.Hedgehog^);
        ScriptCall('onGearResurrect', gear^.uid);
        gear^.State := gstWait;
    end;
    RecountTeamHealth(tempTeam);
end;

function CountNonZeroz(x, y, r, c: LongInt): LongInt;
var i: LongInt;
    count: LongInt = 0;
begin
if (y and LAND_HEIGHT_MASK) = 0 then
    for i:= max(x - r, 0) to min(x + r, LAND_WIDTH - 4) do
        if Land[y, i] <> 0 then
            begin
            inc(count);
            if count = c then
                exit(count)
            end;
CountNonZeroz:= count;
end;

procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity: boolean);
var x: LongInt;
    y, sy: LongInt;
    ar: array[0..511] of TPoint;
    ar2: array[0..1023] of TPoint;
    cnt, cnt2: Longword;
    delta: LongInt;
    reallySkip, tryAgain: boolean;
begin
reallySkip:= false; // try not skipping proximity at first
tryAgain:= true;
while tryAgain do
    begin
    delta:= 250;
    cnt2:= 0;
    repeat
        x:= Left + LongInt(GetRandom(Delta));
        repeat
            inc(x, Delta);
            cnt:= 0;
            y:= min(1024, topY) - 2 * Gear^.Radius;
            while y < cWaterLine do
                begin
                repeat
                    inc(y, 2);
                until (y >= cWaterLine) or (CountNonZeroz(x, y, Gear^.Radius - 1, 1) = 0);

                sy:= y;

                repeat
                    inc(y);
                until (y >= cWaterLine) or (CountNonZeroz(x, y, Gear^.Radius - 1, 1) <> 0);

                if (y - sy > Gear^.Radius * 2)
                    and (((Gear^.Kind = gtExplosives)
                    and (y < cWaterLine)
                    and (reallySkip or (CheckGearsNear(x, y - Gear^.Radius, [gtFlame, gtHedgehog, gtMine, gtCase, gtExplosives], 60, 60) = nil))
                    and (CountNonZeroz(x, y+1, Gear^.Radius - 1, Gear^.Radius+1) > Gear^.Radius))
                or
                    ((Gear^.Kind <> gtExplosives)
                    and (y < cWaterLine)
                    and (reallySkip or (CheckGearsNear(x, y - Gear^.Radius, [gtFlame, gtHedgehog, gtMine, gtCase, gtExplosives], 110, 110) = nil)))) then
                 
                          begin
                    ar[cnt].X:= x;
                    if withFall then
                        ar[cnt].Y:= sy + Gear^.Radius
                    else
                        ar[cnt].Y:= y - Gear^.Radius;
                    inc(cnt)
                    end;

                inc(y, 45)
                end;

            if cnt > 0 then
                with ar[GetRandom(cnt)] do
                    begin
                    ar2[cnt2].x:= x;
                    ar2[cnt2].y:= y;
                    inc(cnt2)
                    end
        until (x + Delta > Right);

        dec(Delta, 60)
    until (cnt2 > 0) or (Delta < 70);
    if (cnt2 = 0) and skipProximity and (not reallySkip) then
        tryAgain:= true
    else tryAgain:= false;
    reallySkip:= true;
    end;

if cnt2 > 0 then
    with ar2[GetRandom(cnt2)] do
        begin
        Gear^.X:= int2hwFloat(x);
        Gear^.Y:= int2hwFloat(y);
        AddFileLog('Assigned Gear coordinates (' + inttostr(x) + ',' + inttostr(y) + ')');
        end
    else
    begin
    OutError('Can''t find place for Gear', false);
    if Gear^.Kind = gtHedgehog then
        Gear^.Hedgehog^.Effects[heResurrectable] := false;
    DeleteGear(Gear);
    Gear:= nil
    end
end;

function CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear;
var t: PGear;
begin
t:= GearsList;
rX:= sqr(rX);
rY:= sqr(rY);

while t <> nil do
    begin
    if (t <> Gear) and (t^.Kind = Kind) then
        if not((hwSqr(Gear^.X - t^.X) / rX + hwSqr(Gear^.Y - t^.Y) / rY) > _1) then
        exit(t);
    t:= t^.NextGear
    end;

CheckGearNear:= nil
end;


function CheckGearsNear(mX, mY: LongInt; Kind: TGearsType; rX, rY: LongInt): PGear;
var t: PGear;
begin
t:= GearsList;
rX:= sqr(rX);
rY:= sqr(rY);
while t <> nil do
    begin
    if t^.Kind in Kind then
        if not (hwSqr(int2hwFloat(mX) - t^.X) / rX + hwSqr(int2hwFloat(mY) - t^.Y) / rY > _1) then
            exit(t);
    t:= t^.NextGear
    end;
CheckGearsNear:= nil
end;
end.