hedgewars/uGearUtils.pas
author blackmetalowiec
Wed, 07 Dec 2011 12:19:36 +0100
changeset 6513 677b96d13e1f
parent 6468 da1e7fe7cff7
permissions -rw-r--r--
Auto refresh room list after leaving room. Fixes issue #320 for voluntarily and involuntarily coming to room list.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
6468
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
     1
unit uGearUtils;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
     2
interface
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
     3
uses uTypes;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
     4
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
     5
procedure doMakeExplosion(X, Y, Radius: LongInt; AttackingHog: PHedgehog; Mask: Longword; const Tint: LongWord = $FFFFFFFF); 
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
     6
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
     7
implementation
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
     8
uses uGearsList;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
     9
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    10
procedure doMakeExplosion(X, Y, Radius: LongInt; AttackingHog: PHedgehog; Mask: Longword; const Tint: LongWord);
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    11
var Gear: PGear;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    12
    dmg, dmgRadius, dmgBase: LongInt;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    13
    fX, fY: hwFloat;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    14
    vg: PVisualGear;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    15
    i, cnt: LongInt;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    16
begin
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    17
    if Radius > 4 then AddFileLog('Explosion: at (' + inttostr(x) + ',' + inttostr(y) + ')');
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    18
    if Radius > 25 then KickFlakes(Radius, X, Y);
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    19
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    20
    if ((Mask and EXPLNoGfx) = 0) then
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    21
        begin
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    22
        vg:= nil;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    23
        if Radius > 50 then vg:= AddVisualGear(X, Y, vgtBigExplosion)
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    24
        else if Radius > 10 then vg:= AddVisualGear(X, Y, vgtExplosion);
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    25
        if vg <> nil then
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    26
            vg^.Tint:= Tint;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    27
        end;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    28
    if (Mask and EXPLAutoSound) <> 0 then PlaySound(sndExplosion);
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    29
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    30
    if (Mask and EXPLAllDamageInRadius) = 0 then
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    31
        dmgRadius:= Radius shl 1
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    32
    else
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    33
        dmgRadius:= Radius;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    34
    dmgBase:= dmgRadius + cHHRadius div 2;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    35
    fX:= int2hwFloat(X);
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    36
    fY:= int2hwFloat(Y);
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    37
    Gear:= GearsList;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    38
    while Gear <> nil do
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    39
        begin
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    40
        dmg:= 0;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    41
        //dmg:= dmgRadius  + cHHRadius div 2 - hwRound(Distance(Gear^.X - int2hwFloat(X), Gear^.Y - int2hwFloat(Y)));
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    42
        //if (dmg > 1) and
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    43
        if (Gear^.State and gstNoDamage) = 0 then
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    44
            begin
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    45
            case Gear^.Kind of
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    46
                gtHedgehog,
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    47
                    gtMine,
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    48
                    gtBall,
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    49
                    gtMelonPiece,
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    50
                    gtGrenade,
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    51
                    gtClusterBomb,
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    52
                //    gtCluster, too game breaking I think
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    53
                    gtSMine,
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    54
                    gtCase,
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    55
                    gtTarget,
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    56
                    gtFlame,
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    57
                    gtExplosives,
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    58
                    gtStructure: begin
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    59
    // Run the calcs only once we know we have a type that will need damage
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    60
                            if hwRound(hwAbs(Gear^.X-fX)+hwAbs(Gear^.Y-fY)) < dmgBase then
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    61
                                dmg:= dmgBase - max(hwRound(Distance(Gear^.X - fX, Gear^.Y - fY)),Gear^.Radius);
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    62
                            if dmg > 1 then
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    63
                                begin
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    64
                                dmg:= ModifyDamage(min(dmg div 2, Radius), Gear);
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    65
                                //AddFileLog('Damage: ' + inttostr(dmg));
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    66
                                if (Mask and EXPLNoDamage) = 0 then
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    67
                                    begin
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    68
                                    if not Gear^.Invulnerable then
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    69
                                        ApplyDamage(Gear, AttackingHog, dmg, dsExplosion)
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    70
                                    else
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    71
                                        Gear^.State:= Gear^.State or gstWinner;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    72
                                    end;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    73
                                if ((Mask and EXPLDoNotTouchAny) = 0) and (((Mask and EXPLDoNotTouchHH) = 0) or (Gear^.Kind <> gtHedgehog)) then
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    74
                                    begin
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    75
                                    DeleteCI(Gear);
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    76
                                    if Gear^.Kind <> gtHedgehog then
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    77
                                        begin
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    78
                                        Gear^.dX:= Gear^.dX + SignAs(_0_005 * dmg + cHHKick, Gear^.X - fX)/Gear^.Density;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    79
                                        Gear^.dY:= Gear^.dY + SignAs(_0_005 * dmg + cHHKick, Gear^.Y - fY)/Gear^.Density;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    80
                                        end
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    81
                                    else
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    82
                                        begin
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    83
                                        Gear^.dX:= Gear^.dX + SignAs(_0_005 * dmg + cHHKick, Gear^.X - fX);
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    84
                                        Gear^.dY:= Gear^.dY + SignAs(_0_005 * dmg + cHHKick, Gear^.Y - fY);
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    85
                                        end;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    86
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    87
                                    Gear^.State:= (Gear^.State or gstMoving) and (not gstLoser);
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    88
                                    if not Gear^.Invulnerable then
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    89
                                        Gear^.State:= (Gear^.State or gstMoving) and (not gstWinner);
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    90
                                    Gear^.Active:= true;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    91
                                    if Gear^.Kind <> gtFlame then FollowGear:= Gear
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    92
                                    end;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    93
                                if ((Mask and EXPLPoisoned) <> 0) and (Gear^.Kind = gtHedgehog) and (not Gear^.Invulnerable) then
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    94
                                    Gear^.Hedgehog^.Effects[hePoisoned] := true;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    95
                                end;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    96
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    97
                            end;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    98
                    gtGrave: begin
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
    99
    // Run the calcs only once we know we have a type that will need damage
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   100
                            if hwRound(hwAbs(Gear^.X-fX)+hwAbs(Gear^.Y-fY)) < dmgBase then
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   101
                                dmg:= dmgBase - hwRound(Distance(Gear^.X - fX, Gear^.Y - fY));
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   102
                            if dmg > 1 then
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   103
                                begin
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   104
                                dmg:= ModifyDamage(min(dmg div 2, Radius), Gear);
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   105
                                Gear^.dY:= - _0_004 * dmg;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   106
                                Gear^.Active:= true
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   107
                                end
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   108
                            end;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   109
                end;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   110
            end;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   111
        Gear:= Gear^.NextGear
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   112
        end;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   113
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   114
    if (Mask and EXPLDontDraw) = 0 then
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   115
        if (GameFlags and gfSolidLand) = 0 then
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   116
            begin
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   117
            cnt:= DrawExplosion(X, Y, Radius) div 1608; // approx 2 16x16 circles to erase per chunk
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   118
            if (cnt > 0) and (SpritesData[sprChunk].Texture <> nil) then
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   119
                for i:= 0 to cnt do
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   120
                    AddVisualGear(X, Y, vgtChunk)
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   121
            end;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   122
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   123
    uAIMisc.AwareOfExplosion(0, 0, 0)
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   124
end;
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   125
da1e7fe7cff7 Start refactoring uGears. Breaks build.
unc0rr
parents:
diff changeset
   126
end.