- set svn:eol-style to native
- Fixes for compilation and run on *nix
- Read hedgehogs spawn points from fort's config
(* * Hedgewars, a worms-like game * Copyright (c) 2004, 2005 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;interfaceuses 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 : Real; Y : Real; dX: Real; dY: Real; Kind : TGearType; doStep: TGearStepProcedure; HalfWidth, HalfHeight: integer; Angle, Power : Cardinal; DirAngle: real; Timer : LongWord; Elasticity: Real; Friction : Real; Message : Longword; Hedgehog: pointer; Health, Damage: LongWord; CollIndex: Longword; Tag: Longword; end;function AddGear(X, Y: integer; Kind: TGearType; State: Cardinal; const dX: real=0.0; dY: real=0.0; Timer: LongWord=0): PGear;procedure ProcessGears;procedure SetAllToActive;procedure SetAllHHToActive;procedure DrawGears(Surface: PSDL_Surface);procedure FreeGearsList;procedure InitGears;procedure AssignHHCoords;var CurAmmoGear: PGear = nil;implementationuses uWorld, uMisc, uStore, uConsole, uSound, uTeams, uRandom, uCollisions, uLand;var GearsList: PGear = nil; RopePoints: record Count: Longword; HookAngle: integer; ar: array[0..300] of record X, Y: real; dLen: real; b: boolean; end; end;procedure DeleteGear(Gear: PGear); forward;procedure doMakeExplosion(X, Y, Radius: integer; Mask: LongWord); forward;{$INCLUDE GSHandlers.inc}{$INCLUDE HHHandlers.inc}const doStepHandlers: array[TGearType] of TGearStepProcedure = ( doStepCloud, doStepBomb, doStepHedgehog, doStepGrenade, doStepHealthTag, doStepGrave, doStepUFO, doStepShotgunShot, doStepActionTimer, doStepPickHammer, doStepRope, doStepSmokeTrace );function AddGear(X, Y: integer; Kind: TGearType; State: Cardinal; const dX: real=0.0; dY: real=0.0; Timer: LongWord=0): PGear;begin{$IFDEF DEBUGFILE}AddFileLog('AddGear: ('+inttostr(x)+','+inttostr(y)+')');{$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);if CurrentTeam <> nil then Result.Hedgehog:= @CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog];case Kind of gtAmmo_Bomb: begin Result.HalfWidth:= 4; Result.HalfHeight:= 4; Result.Elasticity:= 0.6; Result.Friction:= 0.995; Result.Timer:= Timer end; gtHedgehog: begin Result.HalfWidth:= 6; Result.HalfHeight:= cHHHalfHeight; Result.Elasticity:= 0.002; Result.Friction:= 0.999; end;gtAmmo_Grenade: begin Result.HalfWidth:= 4; Result.HalfHeight:= 4; end; gtHealthTag: begin Result.Timer:= 1500; end; gtGrave: begin Result.HalfWidth:= 10; Result.HalfHeight:= 10; Result.Elasticity:= 0.6; end; gtUFO: begin Result.HalfWidth:= 5; Result.HalfHeight:= 2; Result.Timer:= 500; Result.Elasticity:= 0.9 end; gtShotgunShot: begin Result.Timer:= 900; Result.HalfWidth:= 2; Result.HalfHeight:= 2 end; gtActionTimer: begin Result.Timer:= Timer end; gtPickHammer: begin Result.HalfWidth:= 10; Result.HalfHeight:= 2; Result.Timer:= 4000 end; gtSmokeTrace: begin Result.Tag:= 8 end; gtRope: begin Result.HalfWidth:= 3; Result.HalfHeight:= 3; Result.Friction:= 500; RopePoints.Count:= 0; end; end;if GearsList = nil then GearsList:= Result else begin GearsList.PrevGear:= Result; Result.NextGear:= GearsList; GearsList:= Result endend;procedure DeleteGear(Gear: PGear);beginif Gear.CollIndex < High(Longword) then DeleteCR(Gear);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 PHedgehog(Gear.Hedgehog).Gear:= nil;if CurAmmoGear = Gear then CurAmmoGear:= nil;if FollowGear = Gear then FollowGear:= nil;{$IFDEF DEBUGFILE}AddFileLog('DeleteGear: handle = '+inttostr(integer(Gear)));{$ENDIF}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 hhsvar Gear: PGear;beginResult:= 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)^); Gear.Damage:= 0 end; Gear:= Gear.NextGear end;end;procedure ProcessGears;const delay: integer = cInactDelay;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 eaxend;{$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 if (delay > 0)and not isInMultiShoot then begin if delay = cInactDelay then SetAllToActive; dec(delay) end else begin delay:= cInactDelay; if CheckNoDamage then if isInMultiShoot then isInMultiShoot:= false else ParseCommand('/nextturn'); 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 eaxend;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;beginAllInactive:= false;t:= GearsList;while t<>nil do begin t.Active:= true; t:= t.NextGear endend;procedure SetAllHHToActive;var t: PGear;beginAllInactive:= false;t:= GearsList;while t<>nil do begin if t.Kind = gtHedgehog then t.Active:= true; t:= t.NextGear endend;procedure DrawGears(Surface: PSDL_Surface);var Gear: PGear; i: Longword; procedure DrawRopeLine(X1, Y1, X2, Y2: integer); var i: integer; t, k: real; r: TSDL_Rect; begin 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); if X1 < 0 then begin t:= Y1 - 2 - k * X1; X1:= 0 end else t:= Y1 - 2; if X2 > cScreenWidth then X2:= cScreenWidth; r.x:= X1; while r.x <= X2 do begin r.y:= round(t); r.w:= 4; r.h:= 4; SDL_FillRect(Surface, @r, cWhiteColor); t:= t + k*3; inc(r.x, 3) 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); if Y1 < 0 then begin t:= X1 - 2 - k * Y1; Y1:= 0 end else t:= X1 - 2; if Y2 > cScreenHeight then Y2:= cScreenHeight; r.y:= Y1; while r.y <= Y2 do begin r.x:= round(t); r.w:= 4; r.h:= 4; SDL_FillRect(Surface, @r, cWhiteColor); t:= t + k*3; inc(r.y, 3) end; end end;beginGear:= GearsList;while Gear<>nil do begin case Gear.Kind of gtCloud: DrawSprite(sprCloud , Round(Gear.X) + WorldDx, Round(Gear.Y) + WorldDy, Gear.State, Surface); gtAmmo_Bomb: DrawSprite(sprBomb , Round(Gear.X) - 8 + WorldDx, Round(Gear.Y) - 8 + WorldDy, trunc(Gear.DirAngle), Surface); gtHedgehog: DrawHedgehog(Round(Gear.X) - 14 + WorldDx, Round(Gear.Y) - 18 + WorldDy, Sign(Gear.dX), 0, PHedgehog(Gear.Hedgehog).visStepPos div 2, Surface); gtAmmo_Grenade: DrawSprite(sprGrenade , Round(Gear.X) - 16 + WorldDx, Round(Gear.Y) - 16 + WorldDy, DxDy2Angle32(Gear.dY, Gear.dX), Surface); gtHealthTag: DrawCaption(Round(Gear.X) + WorldDx, Round(Gear.Y) + WorldDy, PHedgehog(Gear.Hedgehog).HealthTagRect, Surface, true); gtGrave: DrawSpriteFromRect(PHedgehog(Gear.Hedgehog).Team.GraveRect, Round(Gear.X) + WorldDx - 16, Round(Gear.Y) + WorldDy - 16, 32, (GameTicks shr 7) and 7, Surface); gtUFO: DrawSprite(sprUFO, Round(Gear.X) - 16 + WorldDx, Round(Gear.Y) - 16 + WorldDy, (GameTicks shr 7) mod 4, Surface); gtSmokeTrace: if Gear.Tag < 8 then DrawSprite(sprSmokeTrace, Round(Gear.X) - 16 + WorldDx, Round(Gear.Y) - 16 + WorldDy, Gear.Tag, Surface); gtRope: begin DrawRopeLine(Round(Gear.X) + WorldDx, Round(Gear.Y) + WorldDy, Round(PHedgehog(Gear.Hedgehog).Gear.X) + WorldDx, Round(PHedgehog(Gear.Hedgehog).Gear.Y) + WorldDy); if RopePoints.Count > 0 then begin i:= 0; while i < Pred(RopePoints.Count) do begin DrawRopeLine(Round(RopePoints.ar[i].X) + WorldDx, Round(RopePoints.ar[i].Y) + WorldDy, Round(RopePoints.ar[Succ(i)].X) + WorldDx, Round(RopePoints.ar[Succ(i)].Y) + WorldDy); inc(i) end; DrawRopeLine(Round(RopePoints.ar[i].X) + WorldDx, Round(RopePoints.ar[i].Y) + WorldDy, Round(Gear.X) + WorldDx, Round(Gear.Y) + WorldDy); DrawSprite(sprRopeHook, Round(RopePoints.ar[0].X) + WorldDx - 16, Round(RopePoints.ar[0].Y) + WorldDy - 16, RopePoints.HookAngle, Surface); end else DrawSprite(sprRopeHook, Round(Gear.X) - 16 + WorldDx, Round(Gear.Y) - 16 + WorldDy, DxDy2Angle32(Gear.dY, Gear.dX), Surface); end; end; Gear:= Gear.NextGear end;end;procedure FreeGearsList;var t, tt: PGear;begintt:= GearsList;GearsList:= nil;while tt<>nil do begin t:= tt; tt:= tt.NextGear; try Dispose(t) except OutError(errmsgDynamicVar) end; end;end;procedure InitGears;var i: integer;beginfor i:= 0 to cCloudsNumber do AddGear( - cScreenWidth + i * ((cScreenWidth * 2 + 2304) div cCloudsNumber), -128, gtCloud, random(4), (0.5-random)*0.01);AddGear(0, 0, gtActionTimer, gtsStartGame, 0, 0, 2000).Health:= 3;end;procedure doMakeExplosion(X, Y, Radius: integer; Mask: LongWord);var Gear: PGear; dmg: integer;beginTargetPoint.X:= NoPointX;{$IFDEF DEBUGFILE}if Radius > 3 then AddFileLog('Explosion: at (' + inttostr(x) + ',' + inttostr(y) + ')');{$ENDIF}DrawExplosion(X, Y, Radius);if (Mask and EXPLAutoSound)<>0 then PlaySound(sndExplosion);if (Mask and EXPLNoDamage)<>0 then exit;if (Mask and EXPLAllDamageInRadius)=0 then Radius:= Radius shl 1;Gear:= GearsList;while Gear <> nil do begin dmg:= Radius - Round(sqrt(sqr(Gear.X - X) + sqr(Gear.Y - Y))); if dmg > 0 then begin dmg:= dmg shr 1; case Gear.Kind of gtHedgehog: begin inc(Gear.Damage, dmg); Gear.dX:= Gear.dX + dmg / 200 * sign(Gear.X - X); Gear.dY:= Gear.dY + dmg / 200 * sign(Gear.Y - Y); FollowGear:= Gear end; gtGrave: Gear.dY:= - dmg / 250; end; end; Gear:= Gear.NextGear endend;procedure AssignHHCoords;var Gear: PGear; pX, pY: integer;beginGear:= GearsList;while Gear <> nil do begin if Gear.Kind = gtHedgehog then begin GetHHPoint(pX, pY); Gear.X:= pX; Gear.Y:= pY end; Gear:= Gear.NextGear endend;initializationfinalizationFreeGearsListend.