diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uGears.pas --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/hedgewars/uGears.pas Mon Aug 22 13:35:41 2005 +0000 @@ -0,0 +1,508 @@ +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 : 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; + +implementation +uses 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 + end +end; + +procedure DeleteGear(Gear: PGear); +begin +if 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 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)^); + + 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 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 + 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 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; + + 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; + +begin +Gear:= 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; +begin +tt:= 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; +begin +for 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; +begin +TargetPoint.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 + end +end; + +procedure AssignHHCoords; +var Gear: PGear; + pX, pY: integer; +begin +Gear:= 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 + end +end; + +initialization + +finalization +FreeGearsList + +end.