1 (*

     2  * Hedgewars, a worms-like game

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

     4  *

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

     6  *

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

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

     9  * with the Software without restriction, including without limitation the

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

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

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

    13  *

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

    15  *    this list of conditions and the following disclaimer.

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

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

    18  *    and/or other materials provided with the distribution.

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

    20  *    derived from this software without specific prior written permission.

    21  *

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

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

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

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

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

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

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

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

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

    31  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

    32  *)

    33 

    34 unit uGears;

    35 interface

    36 uses SDLh, uConsts;

    37 {$INCLUDE options.inc}

    38 const AllInactive: boolean = false;

    39 

    40 type PGear = ^TGear;

    41      TGearStepProcedure = procedure (Gear: PGear);

    42      TGear = record

    43              NextGear, PrevGear: PGear;

    44              Active: Boolean;

    45              State : Cardinal;

    46              X : Real;

    47              Y : Real;

    48              dX: Real;

    49              dY: Real;

    50              Kind  : TGearType;

    51              doStep: TGearStepProcedure;

    52              HalfWidth, HalfHeight: integer;

    53              Angle, Power : Cardinal;

    54              DirAngle: real;

    55              Timer : LongWord;

    56              Elasticity: Real;

    57              Friction  : Real;

    58              Message : Longword;

    59              Hedgehog: pointer;

    60              Health, Damage: LongWord;

    61              CollIndex: Longword;

    62              Tag: Longword;

    63              end;

    64 

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

    66 procedure ProcessGears;

    67 procedure SetAllToActive;

    68 procedure SetAllHHToActive;

    69 procedure DrawGears(Surface: PSDL_Surface);

    70 procedure FreeGearsList;

    71 procedure InitGears;

    72 procedure AssignHHCoords;

    73 

    74 var CurAmmoGear: PGear = nil;

    75 

    76 implementation

    77 uses uWorld, uMisc, uStore, uConsole, uSound, uTeams, uRandom, uCollisions, uLand;

    78 var GearsList: PGear = nil;

    79     RopePoints: record

    80                 Count: Longword;

    81                 HookAngle: integer;

    82                 ar: array[0..300] of record

    83                                   X, Y: real;

    84                                   dLen: real;

    85                                   b: boolean;

    86                                   end;

    87                  end;

    88 

    89 procedure DeleteGear(Gear: PGear); forward;

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

    91 

    92 {$INCLUDE GSHandlers.inc}

    93 {$INCLUDE HHHandlers.inc}

    94 

    95 const doStepHandlers: array[TGearType] of TGearStepProcedure = (

    96                                                                doStepCloud,

    97                                                                doStepBomb,

    98                                                                doStepHedgehog,

    99                                                                doStepGrenade,

   100                                                                doStepHealthTag,

   101                                                                doStepGrave,

   102                                                                doStepUFO,

   103                                                                doStepShotgunShot,

   104                                                                doStepActionTimer,

   105                                                                doStepPickHammer,

   106                                                                doStepRope,

   107                                                                doStepSmokeTrace

   108                                                                );

   109 

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

   111 begin

   112 {$IFDEF DEBUGFILE}AddFileLog('AddGear: ('+inttostr(x)+','+inttostr(y)+')');{$ENDIF}

   113 New(Result);

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

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

   116 Result.X:= X;

   117 Result.Y:= Y;

   118 Result.Kind := Kind;

   119 Result.State:= State;

   120 Result.Active:= true;

   121 Result.dX:= dX;

   122 Result.dY:= dY;

   123 Result.doStep:= doStepHandlers[Kind];

   124 Result.CollIndex:= High(Longword);

   125 if CurrentTeam <> nil then

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

   127 case Kind of

   128    gtAmmo_Bomb: begin

   129                 Result.HalfWidth:= 4;

   130                 Result.HalfHeight:= 4;

   131                 Result.Elasticity:= 0.6;

   132                 Result.Friction:= 0.995;

   133                 Result.Timer:= Timer

   134                 end;

   135     gtHedgehog: begin

   136                 Result.HalfWidth:= 6;

   137                 Result.HalfHeight:= cHHHalfHeight;

   138                 Result.Elasticity:= 0.002;

   139                 Result.Friction:= 0.999;

   140                 end;

   141 gtAmmo_Grenade: begin

   142                 Result.HalfWidth:= 4;

   143                 Result.HalfHeight:= 4;

   144                 end;

   145    gtHealthTag: begin

   146                 Result.Timer:= 1500;

   147                 end;

   148        gtGrave: begin

   149                 Result.HalfWidth:= 10;

   150                 Result.HalfHeight:= 10;

   151                 Result.Elasticity:= 0.6;

   152                 end;

   153          gtUFO: begin

   154                 Result.HalfWidth:= 5;

   155                 Result.HalfHeight:= 2;

   156                 Result.Timer:= 500;

   157                 Result.Elasticity:= 0.9

   158                 end;

   159  gtShotgunShot: begin

   160                 Result.Timer:= 900;

   161                 Result.HalfWidth:= 2;

   162                 Result.HalfHeight:= 2

   163                 end;

   164  gtActionTimer: begin

   165                 Result.Timer:= Timer

   166                 end;

   167   gtPickHammer: begin

   168                 Result.HalfWidth:= 10;

   169                 Result.HalfHeight:= 2;

   170                 Result.Timer:= 4000

   171                 end;

   172   gtSmokeTrace: begin

   173                 Result.Tag:= 8

   174                 end;

   175         gtRope: begin

   176                 Result.HalfWidth:= 3;

   177                 Result.HalfHeight:= 3;

   178                 Result.Friction:= 500;

   179                 RopePoints.Count:= 0;

   180                 end;

   181      end;

   182 if GearsList = nil then GearsList:= Result

   183                    else begin

   184                    GearsList.PrevGear:= Result;

   185                    Result.NextGear:= GearsList;

   186                    GearsList:= Result

   187                    end

   188 end;

   189 

   190 procedure DeleteGear(Gear: PGear);

   191 begin

   192 if Gear.CollIndex < High(Longword) then DeleteCR(Gear);

   193 if Gear.Kind = gtHedgehog then

   194    if CurAmmoGear <> nil then

   195       begin

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

   197       Gear.Message:= gm_Destroy;

   198       CurAmmoGear.Message:= gm_Destroy;

   199       exit

   200       end else PHedgehog(Gear.Hedgehog).Gear:= nil;

   201 if CurAmmoGear = Gear then

   202    CurAmmoGear:= nil;

   203 if FollowGear = Gear then FollowGear:= nil;

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

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

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

   207                         else begin

   208                         GearsList:= Gear^.NextGear;

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

   210                         end;

   211 Dispose(Gear)

   212 end;

   213 

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

   215 var Gear: PGear;

   216 begin

   217 Result:= true;

   218 Gear:= GearsList;

   219 while Gear <> nil do

   220       begin

   221       if Gear.Kind = gtHedgehog then

   222          if Gear.Damage <> 0 then

   223             begin

   224             Result:= false;

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

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

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

   228             RenderHealth(PHedgehog(Gear.Hedgehog)^);

   229             

   230             Gear.Damage:= 0

   231             end;

   232       Gear:= Gear.NextGear

   233       end;

   234 end;

   235 

   236 procedure ProcessGears;

   237 const delay: integer = cInactDelay;

   238 var Gear, t: PGear;

   239 {$IFDEF COUNTTICKS}

   240     tickcntA, tickcntB: LongWord;

   241 const cntSecTicks: LongWord = 0;

   242 {$ENDIF}

   243 begin

   244 {$IFDEF COUNTTICKS}

   245 asm

   246         push    eax

   247         push    edx

   248         rdtsc

   249         mov     tickcntA, eax

   250         mov     tickcntB, edx

   251         pop     edx

   252         pop     eax

   253 end;

   254 {$ENDIF}

   255 AllInactive:= true;

   256 t:= GearsList;

   257 while t<>nil do

   258       begin

   259       Gear:= t;

   260       t:= Gear.NextGear;

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

   262       end;

   263 if AllInactive then

   264    if (delay > 0)and not isInMultiShoot then

   265       begin

   266       if delay = cInactDelay then SetAllToActive;

   267       dec(delay)

   268       end

   269    else begin

   270    delay:= cInactDelay;

   271    if CheckNoDamage then

   272       if isInMultiShoot then isInMultiShoot:= false

   273                         else ParseCommand('/nextturn');

   274    end;

   275 if TurnTimeLeft > 0 then

   276    if CurrentTeam <> nil then

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

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

   279             and not isInMultiShoot then dec(TurnTimeLeft);

   280 inc(GameTicks);

   281 {$IFDEF COUNTTICKS}

   282 asm

   283         push    eax

   284         push    edx

   285         rdtsc

   286         sub     eax, [tickcntA]

   287         sbb     edx, [tickcntB]

   288         add     [cntSecTicks], eax

   289         pop     edx

   290         pop     eax

   291 end;

   292 if (GameTicks and 1023) = 0 then

   293    begin

   294    cntTicks:= cntSecTicks shr 10;

   295    {$IFDEF DEBUGFILE}

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

   297    {$ENDIF}

   298    cntSecTicks:= 0

   299    end;

   300 {$ENDIF}

   301 end;

   302 

   303 procedure SetAllToActive;

   304 var t: PGear;

   305 begin

   306 AllInactive:= false;

   307 t:= GearsList;

   308 while t<>nil do

   309       begin

   310       t.Active:= true;

   311       t:= t.NextGear

   312       end

   313 end;

   314 

   315 procedure SetAllHHToActive;

   316 var t: PGear;

   317 begin

   318 AllInactive:= false;

   319 t:= GearsList;

   320 while t<>nil do

   321       begin

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

   323       t:= t.NextGear

   324       end

   325 end;

   326 

   327 procedure DrawGears(Surface: PSDL_Surface);

   328 var Gear: PGear;

   329     i: Longword;

   330 

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

   332     var i: integer;

   333         t, k: real;

   334         r: TSDL_Rect;

   335     begin

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

   337        begin

   338        if X1 > X2 then

   339           begin

   340           i:= X1;

   341           X1:= X2;

   342           X2:= i;

   343           i:= Y1;

   344           Y1:= Y2;

   345           Y2:= i

   346           end;

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

   348        if X1 < 0 then

   349           begin

   350           t:= Y1 - 2 - k * X1;

   351           X1:= 0

   352           end else t:= Y1 - 2;

   353        if X2 > cScreenWidth then X2:= cScreenWidth;

   354        r.x:= X1;

   355        while r.x <= X2 do

   356              begin

   357              r.y:= round(t);

   358              r.w:= 4;

   359              r.h:= 4;

   360              SDL_FillRect(Surface, @r, cWhiteColor);

   361              t:= t + k*3;

   362              inc(r.x, 3)

   363              end;

   364        end else

   365        begin

   366        if Y1 > Y2 then

   367           begin

   368           i:= X1;

   369           X1:= X2;

   370           X2:= i;

   371           i:= Y1;

   372           Y1:= Y2;

   373           Y2:= i

   374           end;

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

   376        if Y1 < 0 then

   377           begin

   378           t:= X1 - 2 - k * Y1;

   379           Y1:= 0

   380           end else t:= X1 - 2;

   381        if Y2 > cScreenHeight then Y2:= cScreenHeight;

   382        r.y:= Y1;

   383        while r.y <= Y2 do

   384              begin

   385              r.x:= round(t);

   386              r.w:= 4;

   387              r.h:= 4;

   388              SDL_FillRect(Surface, @r, cWhiteColor);

   389              t:= t + k*3;

   390              inc(r.y, 3)

   391              end;

   392        end

   393     end;

   394 

   395 begin

   396 Gear:= GearsList;

   397 while Gear<>nil do

   398       begin

   399       case Gear.Kind of

   400            gtCloud: DrawSprite(sprCloud   , Round(Gear.X) + WorldDx, Round(Gear.Y) + WorldDy, Gear.State, Surface);

   401        gtAmmo_Bomb: DrawSprite(sprBomb , Round(Gear.X) - 8 + WorldDx, Round(Gear.Y) - 8 + WorldDy, trunc(Gear.DirAngle), Surface);

   402         gtHedgehog: DrawHedgehog(Round(Gear.X) - 14 + WorldDx, Round(Gear.Y) - 18 + WorldDy, Sign(Gear.dX),

   403                                  0, PHedgehog(Gear.Hedgehog).visStepPos div 2,

   404                                  Surface);

   405     gtAmmo_Grenade: DrawSprite(sprGrenade , Round(Gear.X) - 16 + WorldDx, Round(Gear.Y) - 16 + WorldDy, DxDy2Angle32(Gear.dY, Gear.dX), Surface);

   406        gtHealthTag: DrawCaption(Round(Gear.X) + WorldDx, Round(Gear.Y) + WorldDy, PHedgehog(Gear.Hedgehog).HealthTagRect, Surface, true);

   407            gtGrave: DrawSpriteFromRect(PHedgehog(Gear.Hedgehog).Team.GraveRect, Round(Gear.X) + WorldDx - 16, Round(Gear.Y) + WorldDy - 16, 32, (GameTicks shr 7) and 7, Surface);

   408              gtUFO: DrawSprite(sprUFO, Round(Gear.X) - 16 + WorldDx, Round(Gear.Y) - 16 + WorldDy, (GameTicks shr 7) mod 4, Surface);

   409       gtSmokeTrace: if Gear.Tag < 8 then DrawSprite(sprSmokeTrace, Round(Gear.X) - 16 + WorldDx, Round(Gear.Y) - 16 + WorldDy, Gear.Tag, Surface);

   410             gtRope: begin

   411                     DrawRopeLine(Round(Gear.X) + WorldDx, Round(Gear.Y) + WorldDy,

   412                                  Round(PHedgehog(Gear.Hedgehog).Gear.X) + WorldDx, Round(PHedgehog(Gear.Hedgehog).Gear.Y) + WorldDy);

   413                     if RopePoints.Count > 0 then

   414                        begin

   415                        i:= 0;

   416                        while i < Pred(RopePoints.Count) do

   417                              begin

   418                              DrawRopeLine(Round(RopePoints.ar[i].X) + WorldDx, Round(RopePoints.ar[i].Y) + WorldDy,

   419                                           Round(RopePoints.ar[Succ(i)].X) + WorldDx, Round(RopePoints.ar[Succ(i)].Y) + WorldDy);

   420                              inc(i)

   421                              end;

   422                        DrawRopeLine(Round(RopePoints.ar[i].X) + WorldDx, Round(RopePoints.ar[i].Y) + WorldDy,

   423                                     Round(Gear.X) + WorldDx, Round(Gear.Y) + WorldDy);

   424                        DrawSprite(sprRopeHook, Round(RopePoints.ar[0].X) + WorldDx - 16, Round(RopePoints.ar[0].Y) + WorldDy - 16, RopePoints.HookAngle, Surface);

   425                        end else

   426                        DrawSprite(sprRopeHook, Round(Gear.X) - 16 + WorldDx, Round(Gear.Y) - 16 + WorldDy, DxDy2Angle32(Gear.dY, Gear.dX), Surface);

   427                     end;

   428               end;

   429       Gear:= Gear.NextGear

   430       end;

   431 end;

   432 

   433 procedure FreeGearsList;

   434 var t, tt: PGear;

   435 begin

   436 tt:= GearsList;

   437 GearsList:= nil;

   438 while tt<>nil do

   439       begin

   440       t:= tt;

   441       tt:= tt.NextGear;

   442       try

   443       Dispose(t)

   444       except OutError(errmsgDynamicVar) end;

   445       end;

   446 end;

   447 

   448 procedure InitGears;

   449 var i: integer;

   450 begin

   451 for i:= 0 to cCloudsNumber do AddGear( - cScreenWidth + i * ((cScreenWidth * 2 + 2304) div cCloudsNumber), -128, gtCloud, random(4), (0.5-random)*0.01);

   452 AddGear(0, 0, gtActionTimer, gtsStartGame, 0, 0, 2000).Health:= 3;

   453 end;

   454 

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

   456 var Gear: PGear;

   457     dmg: integer;

   458 begin

   459 TargetPoint.X:= NoPointX;

   460 {$IFDEF DEBUGFILE}if Radius > 3 then AddFileLog('Explosion: at (' + inttostr(x) + ',' + inttostr(y) + ')');{$ENDIF}

   461 DrawExplosion(X, Y, Radius);

   462 if (Mask and EXPLAutoSound)<>0 then PlaySound(sndExplosion);

   463 if (Mask and EXPLNoDamage)<>0 then exit;

   464 if (Mask and EXPLAllDamageInRadius)=0 then Radius:= Radius shl 1;

   465 Gear:= GearsList;

   466 while Gear <> nil do

   467       begin

   468       dmg:= Radius - Round(sqrt(sqr(Gear.X - X) + sqr(Gear.Y - Y)));

   469       if dmg > 0 then

   470          begin

   471          dmg:= dmg shr 1;

   472          case Gear.Kind of

   473               gtHedgehog: begin

   474                           inc(Gear.Damage, dmg);

   475                           Gear.dX:= Gear.dX + dmg / 200 * sign(Gear.X - X);

   476                           Gear.dY:= Gear.dY + dmg / 200 * sign(Gear.Y - Y);

   477                           FollowGear:= Gear

   478                           end;

   479                  gtGrave: Gear.dY:= - dmg / 250;

   480               end;

   481          end;

   482       Gear:= Gear.NextGear

   483       end

   484 end;

   485 

   486 procedure AssignHHCoords;

   487 var Gear: PGear;

   488     pX, pY: integer;

   489 begin

   490 Gear:= GearsList;

   491 while Gear <> nil do

   492       begin

   493       if Gear.Kind = gtHedgehog then

   494          begin

   495          GetHHPoint(pX, pY);

   496          Gear.X:= pX;

   497          Gear.Y:= pY

   498          end;

   499       Gear:= Gear.NextGear

   500       end

   501 end;

   502 

   503 initialization

   504 

   505 finalization

   506 FreeGearsList

   507 

   508 end.