diff --git a/Display.hs b/Display.hs --- a/Display.hs +++ b/Display.hs @@ -116,12 +116,12 @@ (resourceTracker u)) , lanceLives $ levelMessage , pactiv 2.0 $ sgt 20.0 $ Translate - (-100.0) - (-100.0) + (-450.0) + (-230.0) helpColumn2 , pactiv 2.0 $ sgt 20.0 $ Translate - (-120.0) - (-190.0) + (-470.0) + (-320.0) helpColumn1 ] diff --git a/Projectile/Interceptor.hs b/Projectile/Interceptor.hs new file mode 100644 --- /dev/null +++ b/Projectile/Interceptor.hs @@ -0,0 +1,136 @@ +module Projectile.Interceptor ( Interceptor(..) + , new + , speed + ) where + +import Combat +import Animation +import Updating +import Graphics.Gloss.Data.Picture +import Graphics.Gloss.Data.Color +import Data.WrapAround +import qualified Moving as M +import GHC.Float +import Common +import Trigonometry ( doubleRem + , radToDeg + ) +import Data.Maybe +import ResourceTracker + +velocityC = 900.0 +rangeC = 1200.0 + +integrityMax = 60.0 + +punch = 4.0 + +radiusC = 12.0 + +speed = velocityC + +data Interceptor = + Interceptor { velocity :: Velocity + , center :: WrapPoint + , rangeLeft :: Double + , wrapMap :: WrapMap + , idealNewCenter :: Maybe WrapPoint + , impacted :: Bool + , clock :: Time + , angle :: Angle + , resourceTracker :: ResourceTracker + } + +-- angle is radians +new :: WrapMap -> ResourceTracker -> Angle -> WrapPoint -> Velocity -> Interceptor +new wmap rt angle' center' (vpx, vpy) = + let x = cos angle' * velocityC in + let y = sin angle' * velocityC in + Interceptor { velocity = (x + vpx, y + vpy) + , center = center' + , rangeLeft = rangeC + , wrapMap = wmap + , idealNewCenter = Nothing + , clock = 0.0 + , impacted = False + , angle = angle' + , resourceTracker = rt + } + +instance Animation Interceptor where + + image self t = Rotate a cpic + + where rt = resourceTracker self + defImage x = fromMaybe + (Color white + (Circle r)) + (getImage rt x) + p1 = defImage "interceptor-1.bmp" + p2 = defImage "interceptor-2.bmp" + p3 = defImage "interceptor-3.bmp" + rem = clock self `doubleRem` 0.3 + cpic = if rem > 0.2 + then p3 + else if rem > 0.1 + then p2 + else p1 + a = radToDeg (double2Float (angle self)) * (-1) - 90 + r = double2Float radiusC + +instance M.Colliding Interceptor where + + collisionRadius self = radiusC + +instance M.Moving Interceptor where + + velocity self = Projectile.Interceptor.velocity self + +instance M.Locatable Interceptor where + + center self = Projectile.Interceptor.center self + +instance SimpleTransient Interceptor where + + expired self = impacted self || rangeLeft self <= 0.0 + +instance InternallyUpdating Interceptor where + + preUpdate self t = let s' = updateIdealTargetCenter t self in + s' { clock = clock self + t } + + postUpdate self t = + let center' = case idealNewCenter self of + Nothing -> center self + Just x -> x in + self { center = center' + , idealNewCenter = Nothing + } + +updateIdealTargetCenter :: Time -> Interceptor -> Interceptor +updateIdealTargetCenter t self = + let newLoc = M.idealNewLocation (wrapMap self) + (center self) + (velocity self) + t in + self { idealNewCenter = Just (newLoc) + , rangeLeft = max 0.0 $ rangeLeft self - distance (wrapMap self) + (center self) + (newLoc) + } + +instance Damaging Interceptor where + + damageEnergy self = punch + +instance Transient Interceptor where + + expired' self = if impacted self || rangeLeft self <= 0.0 + then Just [] + else Nothing + +instance Damageable Interceptor where + + inflictDamage self d = if d > 0.0 + then self { impacted = True } + else self diff --git a/Resources.hs b/Resources.hs --- a/Resources.hs +++ b/Resources.hs @@ -20,6 +20,7 @@ import qualified Unit.Smart.Ninja as Ninja import qualified Unit.Smart.Saucer as Saucer import qualified Unit.Smart.Sniper as Sniper +import qualified Unit.Smart.Zeus as Zeus import Combat import qualified Projectile.Mine as Mine import Item @@ -30,6 +31,9 @@ , "atank.bmp" , "blade.bmp" , "death.bmp" + , "interceptor-1.bmp" + , "interceptor-2.bmp" + , "interceptor-3.bmp" , "item-default.bmp" , "item-health.bmp" , "item-fourway.bmp" @@ -59,6 +63,8 @@ , "explosion-06.bmp" , "saucer.bmp" , "sniper.bmp" + , "zeus-base.bmp" + , "zeus-cannon.bmp" ] in let imageFiles' = map ("image/" ++) imageFiles in let soundFiles = [ "test.wav" @@ -189,7 +195,7 @@ } let wmap = Universe.wrapMap a let pL = [ - -- 0 + -- 1 a { asteroids = asteroidGen rt wmap [ ((1900, 500), (200, -120)) , (( 100, 2900), ( 90, 10)) @@ -204,7 +210,7 @@ ] } , - -- 1 + -- 2 a { asteroids = asteroidGen rt wmap [ ((1900, 500), (200, -120)) , (( 100, 2900), ( 90, 10)) @@ -220,7 +226,7 @@ ] } , - -- 2 + -- 3 a { asteroids = asteroidGen rt wmap [ ((900, 340), (230, -120)) , ((1200, 1400), (110, 30)) @@ -240,7 +246,7 @@ ] } , - -- 3 + -- 4 a { asteroids = asteroidGen rt wmap [ ((800, -340), (130, 120)) , ((700, 200), (10, -130)) @@ -258,7 +264,7 @@ } , - -- 4 + -- 5 a { asteroids = asteroidGen rt wmap [ ((800, -340), (130, 120)) , ((700, 200), (10, -130)) @@ -279,7 +285,7 @@ } , - -- 5 + -- 6 a { asteroids = asteroidGen rt wmap [ ((800, -340), (-130, 120)) , ((700, 200), (-130, 120)) @@ -344,7 +350,7 @@ ] } , - -- 6 + -- 7 a { asteroids = asteroidGen rt wmap [ ((800, -340), (-30, 20)) , ((-1320, 1290), (200, 100)) @@ -373,7 +379,7 @@ ] } , - -- 7 + -- 8 a { asteroids = asteroidGen rt wmap [ ((840, -440), (-30, 20)) , ((-1320, 1290), (120, -100)) @@ -400,7 +406,7 @@ ] } , - -- 8 + -- 9 a { asteroids = asteroidGen rt wmap [ ((640, -440), (-20, 30)) , ((-1320, 1190), (110, -90)) @@ -415,7 +421,7 @@ ] } , - -- 9 + -- 10 a { asteroids = asteroidGen rt wmap [ ((1000, -300), (-50, 100)) , ((-1020, 1290), (120, 20)) @@ -447,6 +453,28 @@ , (1300.0, -1400.0) ] } + , + -- 11 + a { smartUnits = zeusGen rt wmap + [ ((-1400, 1400.0), 0.0, 0) + ] ++ + sniperGen rt wmap + [ ((-1200.0, 0.0), 0.0) + , ((1200.0, 0.0), 0.0) + ] ++ + saucerGen rt wmap + [ ((1400.0, 1400.0), 0.0) ] + , unitProjectiles = mineGen rt wmap + [ (-1100.0, 1400.0) + , (-1700.0, 1400.0) + , (-1400.0, 1100.0) + , (-1400.0, 1700.0) + , (-1100.0, 1100.0) + , (-1700.0, 1700.0) + , (-1100.0, 1700.0) + , (-1700.0, 1100.0) + ] + } ] let addItems a = do it1 <- randomItemType it2 <- randomItemType @@ -496,6 +524,9 @@ sniperGen rt wmap = map (\(x, y) -> SmartUnit (Sniper.new rt wmap (wrappoint wmap x) y)) + +zeusGen rt wmap = + map (\(x, y, z) -> SmartUnit (Zeus.new rt wmap (wrappoint wmap x) y z)) deathGen rt wmap = map (\(x, y) -> SmartUnit (Death.new rt wmap (wrappoint wmap x) y)) diff --git a/Step.hs b/Step.hs --- a/Step.hs +++ b/Step.hs @@ -63,20 +63,22 @@ , queueBlipSound = True } ) - else return - ( t - , u { arena = - (head (levels u)) - { lance = Just (Lance.new rt wmap - (wrappoint wmap (0, 0))) - } - , level = 0 - , lives = 3 - , delayRemaining = delayOnDeath - , panelActivationTimer = 0.0 - , queueBlipSound = True - } - ) + else do levels' <- initLevels rt + return + ( t + , u { arena = + (head (levels u)) + { lance = Just (Lance.new rt wmap + (wrappoint wmap (0, 0))) + } + , level = 0 + , levels = levels' + , lives = 3 + , delayRemaining = delayOnDeath + , panelActivationTimer = 0.0 + , queueBlipSound = True + } + ) handleNewLevel :: (Time, Universe) -> IO (Time, Universe) handleNewLevel (t, u) diff --git a/Unit/Smart/Zeus.hs b/Unit/Smart/Zeus.hs new file mode 100644 --- /dev/null +++ b/Unit/Smart/Zeus.hs @@ -0,0 +1,193 @@ +module Unit.Smart.Zeus ( Zeus(..) + , new + ) where + +import Data.WrapAround +import Animation +import Graphics.Gloss.Data.Picture +import Graphics.Gloss.Data.Color +import GHC.Float +import Trigonometry +import ResourceTracker +import Updating +import qualified Moving as M +import Combat +import qualified Projectile.Interceptor as P.Interceptor +import AfterEffect +import qualified AfterEffect.SimpleExplosion as SimpleExplosion +import Data.Maybe +import Universe hiding (wrapMap, resourceTracker) +import qualified Universe as U +import Sound.ALUT +import Common + +radialVelocity = pi -- radians per second + +kamikazeDamage = 8.0 + +maxIntegrity = 2 + +shotDelay = 6.0 + +collisionRadiusC = 23.0 + +data Zeus = Zeus { angle :: Angle -- radians + , center :: WrapPoint + , wrapMap :: WrapMap + , launchTube :: [Projectile] + , sinceLastShot :: Time + , integrity :: Double + , vision :: Maybe Arena + , resourceTracker :: ResourceTracker + , shotDelayShift :: Time + + -- Sound + , queueShotSound :: Bool + , shotSoundSource :: Maybe Source + } + +instance Audible Zeus where + + processAudio self lcenter = + do self' <- if isNothing (shotSoundSource self) + then initializeShotSoundSource self + else return self + if not (queueShotSound self) + then return self' + else do let (x, y) = vectorRelation + (wrapMap self) + (lcenter) + (center self) + let s = fromJust $ shotSoundSource self + sourcePosition s $= (Vertex3 (double2Float x) + (double2Float (-y)) + 0) + play [s] + return self' { queueShotSound = False } + + terminateAudio self = + if isNothing (shotSoundSource self) + then return self + else do stop [fromJust (shotSoundSource self)] + return self + +initializeShotSoundSource self = + do [source] <- genObjectNames 1 + buffer source $= getSound (resourceTracker self) "energy-shot-02.wav" + sourceRelative source $= Listener + referenceDistance source $= audioReferenceDistance + rolloffFactor source $= audioRolloffFactor + return self { shotSoundSource = Just source } + +new :: ResourceTracker + -> WrapMap + -> WrapPoint + -> Angle + -> Time + -> Zeus +new rt wmap center' angle' shotDelayShift' = + Zeus { center = center' + , angle = angle' + , wrapMap = wmap + , launchTube = [] + , sinceLastShot = 0.0 + , integrity = maxIntegrity + , vision = Nothing + , resourceTracker = rt + , shotDelayShift = shotDelayShift' + + , queueShotSound = False + , shotSoundSource = Nothing + } + +instance Observant Zeus where + + updateVision self arena = self { vision = Just arena } + +updateAngle t self = + self { angle = case vision self of + Nothing -> angle self + Just arena -> + case lance arena of + Nothing -> angle self + Just l -> targetingA + pSpeed + (vectorRelation + (U.wrapMap arena) + (center self) + (M.center l)) + (subV + (M.velocity l) + (M.velocity self)) + } + where pSpeed = P.Interceptor.speed + +instance Animation Zeus where + image self _ = Pictures [ bpic, tpic' ] + where bpic = fromMaybe + (Scale 0.20 0.20 + (Color white + (Text "Error! Missing image!"))) + (getImage rt "zeus-base.bmp") + tpic = fromMaybe + (Scale 0.20 0.20 + (Color white + (Text "Error! Missing image!"))) + (getImage rt "zeus-cannon.bmp") + tpic' = Rotate (radToDeg + (double2Float + (angle self)) * (-1) - 90) tpic + rt = resourceTracker self + +instance M.Locatable Zeus where + center = center + +instance M.Moving Zeus where + velocity self = (0, 0) + +instance M.Colliding Zeus where + collisionRadius _ = collisionRadiusC + +instance InternallyUpdating Zeus where + + preUpdate self t = (updateFiringInformation t + . updateAngle t) self + + postUpdate self t = self + +updateFiringInformation t self = + let sinceLastShot' = sinceLastShot self + t in + if sinceLastShot' >= shotDelay + shotDelayShift self + then self { sinceLastShot = 0.0 + , launchTube = launchTube self ++ [projectile] + , queueShotSound = True + } + else self { sinceLastShot = sinceLastShot' } + where projectile = Projectile ( P.Interceptor.new + (wrapMap self) + (resourceTracker self) + (angle self) + (center self) + (M.velocity self) ) + +instance Launcher Zeus where + + deployProjectiles self = (launchTube self, self { launchTube = [] }) + +instance Transient Zeus where + + expired' self = if integrity self > 0.0 + then Nothing + else Just [aeffect] + where aeffect = AfterEffect (SimpleExplosion.new (resourceTracker self) + (wrapMap self) + (center self) + (M.velocity self)) + +instance Damageable Zeus where + + inflictDamage self d = self { integrity = max 0.0 (integrity self - d) } + +instance Damaging Zeus where + + damageEnergy self = kamikazeDamage diff --git a/edge.cabal b/edge.cabal --- a/edge.cabal +++ b/edge.cabal @@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.8.6 +Version: 0.8.8 -- A short (one-line) description of the package. Synopsis: Top view space combat arcade game @@ -97,6 +97,7 @@ , Projectile.BulletMI , Projectile.BulletMII , Projectile.Cannon + , Projectile.Interceptor , Projectile.Mine , Projectile.Nuke , Projectile.Pellet @@ -110,6 +111,7 @@ , Unit.Smart.Ninja , Unit.Smart.Saucer , Unit.Smart.Sniper + , Unit.Smart.Zeus -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. -- Build-tools: diff --git a/image/interceptor-1.bmp b/image/interceptor-1.bmp new file mode 100644 Binary files /dev/null and b/image/interceptor-1.bmp differ diff --git a/image/interceptor-2.bmp b/image/interceptor-2.bmp new file mode 100644 Binary files /dev/null and b/image/interceptor-2.bmp differ diff --git a/image/interceptor-3.bmp b/image/interceptor-3.bmp new file mode 100644 Binary files /dev/null and b/image/interceptor-3.bmp differ diff --git a/image/zeus-base.bmp b/image/zeus-base.bmp new file mode 100644 Binary files /dev/null and b/image/zeus-base.bmp differ diff --git a/image/zeus-cannon.bmp b/image/zeus-cannon.bmp new file mode 100644 Binary files /dev/null and b/image/zeus-cannon.bmp differ