(*

 * Hedgewars, a worms-like game

 * Copyright (c) 2004, 2005, 2006 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 uGears;

interface

uses SDLh, uConsts;

{$INCLUDE options.inc}

const AllInactive: boolean = false;

type PGear = ^TGear;

     TGearStepProcedure = procedure (Gear: PGear);

     TGear = record

             NextGear, PrevGear: PGear;

             Active: Boolean;

             State : Longword;

             X : Double;

             Y : Double;

             dX: Double;

             dY: Double;

             Kind: TGearType;

             Pos: Longword;

             doStep: TGearStepProcedure;

             Radius: integer;

             Angle, Power : Longword;

             DirAngle: Double;

             Timer : LongWord;

             Elasticity: Double;

             Friction  : Double;

             Message : Longword;

             Hedgehog: pointer;

             Health, Damage: integer;

             CollIndex: Longword;

             Tag: integer;

             Surf: PSDL_Surface;

             end;

function  AddGear(X, Y: integer; Kind: TGearType; State: Longword; const dX: Double=0.0; dY: Double=0.0; Timer: LongWord=0): PGear;

procedure ProcessGears;

procedure SetAllToActive;

procedure SetAllHHToActive;

procedure DrawGears(Surface: PSDL_Surface);

procedure FreeGearsList;

procedure AddMiscGears;

procedure AssignHHCoords;

var CurAmmoGear: PGear = nil;

    GearsList: PGear = nil;

implementation

uses uWorld, uMisc, uStore, uConsole, uSound, uTeams, uRandom, uCollisions,

     uLand, uIO, uLandGraphics, uAIMisc, uLocale, uAI;

var RopePoints: record

                Count: Longword;

                HookAngle: integer;

                ar: array[0..300] of record

                                  X, Y: Double;

                                  dLen: Double;

                                  b: boolean;

                                  end;

                 end;

procedure DeleteGear(Gear: PGear); forward;

procedure doMakeExplosion(X, Y, Radius: integer; Mask: LongWord); forward;

procedure AmmoShove(Ammo: PGear; Damage, Power: integer); forward;

procedure AmmoFlameWork(Ammo: PGear); forward;

function  CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: integer): PGear; forward;

procedure SpawnBoxOfSmth; forward;

procedure AfterAttack; forward;

procedure FindPlace(Gear: PGear; withFall: boolean; Left, Right: integer); forward;

{$INCLUDE GSHandlers.inc}

{$INCLUDE HHHandlers.inc}

const doStepHandlers: array[TGearType] of TGearStepProcedure = (

                                                               doStepCloud,

                                                               doStepBomb,

                                                               doStepHedgehog,

                                                               doStepGrenade,

                                                               doStepHealthTag,

                                                               doStepGrave,

                                                               doStepUFO,

                                                               doStepShotgunShot,

                                                               doStepPickHammer,

                                                               doStepRope,

                                                               doStepSmokeTrace,

                                                               doStepExplosion,

                                                               doStepMine,

                                                               doStepCase,

                                                               doStepDEagleShot,

                                                               doStepDynamite,

                                                               doStepTeamHealthSorter,

                                                               doStepBomb,

                                                               doStepCluster,

                                                               doStepShover,

                                                               doStepFlame,

                                                               doStepFirePunch,

                                                               doStepActionTimer,

                                                               doStepActionTimer,

                                                               doStepActionTimer,

                                                               doStepParachute,

                                                               doStepAirAttack,

                                                               doStepAirBomb

                                                               );

function AddGear(X, Y: integer; Kind: TGearType; State: Longword; const dX: Double=0.0; dY: Double=0.0; Timer: LongWord=0): PGear;

const Counter: Longword = 0;

begin

inc(Counter);

{$IFDEF DEBUGFILE}AddFileLog('AddGear: ('+inttostr(x)+','+inttostr(y)+'), d('+floattostr(dX)+','+floattostr(dY)+')');{$ENDIF}

New(Result);

FillChar(Result^, sizeof(TGear), 0);

Result.X:= X;

Result.Y:= Y;

Result.Kind := Kind;

Result.State:= State;

Result.Active:= true;

Result.dX:= dX;

Result.dY:= dY;

Result.doStep:= doStepHandlers[Kind];

Result.CollIndex:= High(Longword);

Result.Timer:= Timer;

if CurrentTeam <> nil then

   Result.Hedgehog:= @CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog];

case Kind of

   gtAmmo_Bomb: begin

                Result.Radius:= 4;

                Result.Elasticity:= 0.6;

                Result.Friction:= 0.995;

                end;

    gtHedgehog: begin

                Result.Radius:= cHHRadius;

                Result.Elasticity:= 0.35;

                Result.Friction:= 0.999;

                Result.Angle:= cMaxAngle div 2;

                end;

gtAmmo_Grenade: begin

                Result.Radius:= 4;

                end;

   gtHealthTag: begin

                Result.Timer:= 1500;

                end;

       gtGrave: begin

                Result.Radius:= 10;

                Result.Elasticity:= 0.6;

                end;

         gtUFO: begin

                Result.Radius:= 5;

                Result.Timer:= 500;

                Result.Elasticity:= 0.9

                end;

 gtShotgunShot: begin

                Result.Timer:= 900;

                Result.Radius:= 2

                end;

  gtPickHammer: begin

                Result.Radius:= 10;

                Result.Timer:= 4000

                end;

  gtSmokeTrace: begin

                Result.X:= Result.X - 16;

                Result.Y:= Result.Y - 16;

                Result.State:= 8

                end;

        gtRope: begin

                Result.Radius:= 3;

                Result.Friction:= 500;

                RopePoints.Count:= 0;

                end;

   gtExplosion: begin

                Result.X:= Result.X - 25;

                Result.Y:= Result.Y - 25;

                end;

        gtMine: begin

                Result.Radius:= 3;

                Result.Elasticity:= 0.55;

                Result.Friction:= 0.995;

                Result.Timer:= 3000;

                end;

        gtCase: begin

                Result.Radius:= 16;

                Result.Elasticity:= 0.4

                end;

  gtDEagleShot: begin

                Result.Radius:= 1;

                Result.Radius:= 1;

                Result.Health:= 50

                end;

    gtDynamite: begin

                Result.Radius:= 3;

                Result.Elasticity:= 0.55;

                Result.Friction:= 0.03;

                Result.Timer:= 5000;

                end;

 gtClusterBomb: begin

                Result.Radius:= 4;

                Result.Elasticity:= 0.6;

                Result.Friction:= 0.995;

                end;

       gtFlame: begin

                Result.Angle:= Counter mod 64;

                Result.Radius:= 1;

                Result.Health:= 2;

                Result.dY:= (getrandom - 0.8) * 0.03;

                Result.dX:= (getrandom - 0.5) * 0.4

                end;

   gtFirePunch: begin

                Result.Radius:= 15;

                Result.Tag:= Y

                end;

    gtAirBomb: begin

               end;

     end;

if GearsList = nil then GearsList:= Result

                   else begin

                   end

end;

procedure DeleteGear(Gear: PGear);

var team: PTeam;

begin

if Gear.CollIndex < High(Longword) then DeleteCI(Gear);

if Gear.Surf <> nil then SDL_FreeSurface(Gear.Surf);

if Gear.Kind = gtHedgehog then

   if CurAmmoGear <> nil then

      begin

      {$IFDEF DEBUGFILE}AddFileLog('DeleteGear: Sending gm_Destroy, hh handle = '+inttostr(integer(Gear)));{$ENDIF}

      Gear.Message:= gm_Destroy;

      CurAmmoGear.Message:= gm_Destroy;

      exit

      end else

      begin

      if Gear.Y >= cWaterLine then

         AddGear(Round(Gear.X), Round(Gear.Y), gtHealthTag, max(Gear.Damage, Gear.Health)).Hedgehog:= Gear.Hedgehog;

      team:= PHedgehog(Gear.Hedgehog).Team;

      if CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear = Gear then

         FreeActionsList; // to avoid ThinkThread on drawned gear

      PHedgehog(Gear.Hedgehog).Gear:= nil;

      RecountTeamHealth(team);

      end;

{$IFDEF DEBUGFILE}AddFileLog('DeleteGear: handle = '+inttostr(integer(Gear)));{$ENDIF}

if CurAmmoGear = Gear then CurAmmoGear:= nil;

if FollowGear = Gear then FollowGear:= nil;

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

if Gear.PrevGear <> nil then Gear.PrevGear.NextGear:= Gear.NextGear

                        else begin

                        GearsList:= Gear^.NextGear;

                        if GearsList <> nil then GearsList.PrevGear:= nil

                        end;

Dispose(Gear)

end;

function CheckNoDamage: boolean; // returns TRUE in case of no damaged hhs

var Gear: PGear;

begin

Result:= true;

Gear:= GearsList;

while Gear <> nil do

      begin

      if Gear.Kind = gtHedgehog then

         if Gear.Damage <> 0 then

            begin

            Result:= false;

            if Gear.Health < Gear.Damage then Gear.Health:= 0

                                         else dec(Gear.Health, Gear.Damage);

            RenderHealth(PHedgehog(Gear.Hedgehog)^);

            RecountTeamHealth(PHedgehog(Gear.Hedgehog)^.Team);

            Gear.Damage:= 0

            end;

      Gear:= Gear.NextGear

      end;

end;

procedure ProcessGears;

const delay: integer = cInactDelay;

      step: (stDelay, stChDmg, stChWin, stSpawn, stNTurn) = stDelay;

var Gear, t: PGear;

{$IFDEF COUNTTICKS}

    tickcntA, tickcntB: LongWord;

const cntSecTicks: LongWord = 0;

{$ENDIF}

begin

{$IFDEF COUNTTICKS}

asm

        push    eax

        push    edx

        rdtsc

        mov     tickcntA, eax

        mov     tickcntB, edx

        pop     edx

        pop     eax

end;

{$ENDIF}

AllInactive:= true;

t:= GearsList;

while t<>nil do

      begin

      Gear:= t;

      t:= Gear.NextGear;

      if Gear.Active then Gear.doStep(Gear);

      end;

if AllInactive then

   case step of

        stDelay: begin

                 dec(delay);

                 if delay = 0 then

                    begin

                    inc(step);

                    delay:= cInactDelay

                    end

                 end;

        stChDmg: if CheckNoDamage then inc(step) else step:= stDelay;

        stChWin: if not CheckForWin then inc(step) else step:= stDelay; 

        stSpawn: begin

                 if not isInMultiShoot then SpawnBoxOfSmth;

                 inc(step)

                 end;

        stNTurn: begin

                 AwareOfExplosion(0, 0, 0);

                 if isInMultiShoot then isInMultiShoot:= false

                                   else ParseCommand('/nextturn');

                 step:= Low(step)

                 end;

        end;

if TurnTimeLeft > 0 then

   if CurrentTeam <> nil then

      if CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear <> nil then

         if ((CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear.State and gstAttacking) = 0)

            and not isInMultiShoot then dec(TurnTimeLeft);

inc(GameTicks);

{$IFDEF COUNTTICKS}

asm

        push    eax

        push    edx

        rdtsc

        sub     eax, [tickcntA]

        sbb     edx, [tickcntB]

        add     [cntSecTicks], eax

        pop     edx

        pop     eax

end;

if (GameTicks and 1023) = 0 then

   begin

   cntTicks:= cntSecTicks shr 10;

   {$IFDEF DEBUGFILE}

   AddFileLog('<' + inttostr(cntTicks) + '>x1024 ticks');

   {$ENDIF}

   cntSecTicks:= 0

   end;

{$ENDIF}

end;

procedure SetAllToActive;

var t: PGear;

begin

AllInactive:= false;

t:= GearsList;

while t<>nil do

      begin

      t.Active:= true;

      t:= t.NextGear

      end

end;

procedure SetAllHHToActive;

var t: PGear;

begin

AllInactive:= false;

t:= GearsList;

while t<>nil do

      begin

      if t.Kind = gtHedgehog then t.Active:= true;

      t:= t.NextGear

      end

end;

procedure DrawHH(Gear: PGear; Surface: PSDL_Surface);

var t: integer;

begin

DrawHedgehog(Round(Gear.X) - 14 + WorldDx, Round(Gear.Y) - 18 + WorldDy,

             hwSign(Gear.dX), 0,

             PHedgehog(Gear.Hedgehog).visStepPos div 2,

             Surface);

with PHedgehog(Gear.Hedgehog)^ do

     if Gear.State = 0 then

        begin

        t:= round(Gear.Y) - cHHRadius - 10 + WorldDy;

        dec(t, HealthTag.h + 2);

        DrawCentered(round(Gear.X) + WorldDx, t, HealthTag, Surface);

        dec(t, NameTag.h + 2);

        DrawCentered(round(Gear.X) + WorldDx, t, NameTag, Surface);

        dec(t, Team.NameTag.h + 2);

        DrawCentered(round(Gear.X) + WorldDx, t, Team.NameTag, Surface)

        end else // Current hedgehog

        begin

        if bShowFinger and ((Gear.State and gstHHDriven) <> 0) then

           DrawSprite(sprFinger, round(Gear.X) - 16 + WorldDx, round(Gear.Y) - 64 + WorldDy,

                      GameTicks div 32 mod 16, Surface);

        if (Gear.State and (gstMoving or gstDrowning or gstFalling)) = 0 then

           if (Gear.State and gstHHThinking) <> 0 then

              DrawGear(sQuestion, Round(Gear.X) - 10 + WorldDx, Round(Gear.Y) - cHHRadius - 34 + WorldDy, Surface)

              else

              if ShowCrosshair and ((Gear.State and gstAttacked) = 0) then

                 DrawSurfSprite(Round(Gear.X + hwSign(Gear.dX) * Sin(Gear.Angle*pi/cMaxAngle)*60) + WorldDx - 11,

                           Round(Gear.Y - Cos(Gear.Angle*pi/cMaxAngle)*60) + WorldDy - 12,

                           24, (18 + hwSign(Gear.dX) * integer(((Gear.Angle * 72 div cMaxAngle) + 1) div 2) mod 18) mod 18,

                           Team.CrosshairSurf, Surface);

        end;

end;

procedure DrawGears(Surface: PSDL_Surface);

var Gear: PGear;

    i: Longword;

    roplen: Double;

    procedure DrawRopeLine(X1, Y1, X2, Y2: integer);

    const nodlen = 5;

    var i, x, y: integer;

        t, k, ladd: Double;

    begin

    if (X1 = X2) and (Y1 = Y2) then

       begin

       OutError('WARNING: zero length rope line!');

       exit

       end;

    if abs(X1 - X2) > abs(Y1 - Y2) then

       begin

       if X1 > X2 then

          begin

          i:= X1;

          X1:= X2;

          X2:= i;

          i:= Y1;

          Y1:= Y2;

          Y2:= i

          end;

       k:= (Y2 - Y1) / (X2 - X1);

       ladd:= sqrt(1 + sqr(k));

       if X1 < 0 then

          begin

          t:= Y1 - 2 - k * X1;

          X1:= 0

          end else t:= Y1 - 2;

       if X2 > cScreenWidth then X2:= cScreenWidth;

       for x:= X1 to X2 do