(*

 * Hedgewars, a worms-like game

 * Copyright (c) 2004, 2005, 2006 Andrey Korotaev <unC0Rr@gmail.com>

 *

 * Distributed under the terms of the BSD-modified licence:

 *

 * Permission is hereby granted, free of charge, to any person obtaining a copy

 * of this software and associated documentation files (the "Software"), to deal

 * with the Software without restriction, including without limitation the

 * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or

 * sell copies of the Software, and to permit persons to whom the Software is

 * furnished to do so, subject to the following conditions:

 *

 * 1. Redistributions of source code must retain the above copyright notice,

 *    this list of conditions and the following disclaimer.

 * 2. Redistributions in binary form must reproduce the above copyright notice,

 *    this list of conditions and the following disclaimer in the documentation

 *    and/or other materials provided with the distribution.

 * 3. The name of the author may not be used to endorse or promote products

 *    derived from this software without specific prior written permission.

 *

 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED

 * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF

 * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO

 * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,

 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;

 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,

 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR

 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF

 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

 *)

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 : Cardinal;

             X : Double;

             Y : Double;

             dX: Double;

             dY: Double;

             Kind: TGearType;

             Pos: Longword;

             doStep: TGearStepProcedure;

             Radius: integer;

             Angle, Power : Cardinal;

             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: Cardinal; 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;

    GearsListMutex: PSDL_mutex;

implementation

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

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

                                                               );

function AddGear(X, Y: integer; Kind: TGearType; State: Cardinal; 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);

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

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.002;

                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;

                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;

     end;

SDL_LockMutex(GearsListMutex);

if GearsList = nil then GearsList:= Result

                   else begin

                   GearsList.PrevGear:= Result;

                   Result.NextGear:= GearsList;

                   GearsList:= Result

                   end;

SDL_UnlockMutex(GearsListMutex)

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

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

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

      RecountTeamHealth(team);

      end;

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

SDL_LockMutex(GearsListMutex);

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;

SDL_UnlockMutex(GearsListMutex);

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);

            AddGear(Round(Gear.X), Round(Gear.Y) - 32, gtHealthTag, Gear.Damage).Hedgehog:= Gear.Hedgehog;

            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 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

           begin

           roplen:= roplen + ladd;

           if roplen > nodlen then

              begin

              DrawGear(sRopeNode, x - 2, round(t) - 2, Surface);

              roplen:= roplen - nodlen;

              end;

           t:= t + k;

           end;

       end else

       begin

       if Y1 > Y2 then

          begin

          i:= X1;

          X1:= X2;

          X2:= i;

          i:= Y1;

          Y1:= Y2;

          Y2:= i

          end;

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

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

       if Y1 < 0 then

          begin

          t:= X1 - 2 - k * Y1;

          Y1:= 0

          end else t:= X1 - 2;

       if Y2 > cScreenHeight then Y2:= cScreenHeight;

       for y:= Y1 to Y2 do

           begin

           roplen:= roplen + ladd;

           if roplen > nodlen then

              begin

              DrawGear(sRopeNode, round(t) - 2, y - 2, Surface);

              roplen:= roplen - nodlen;

              end;

           t:= t + k;

           end;

       end