diff --git a/AfterEffect/SimpleExplosion.hs b/AfterEffect/SimpleExplosion.hs --- a/AfterEffect/SimpleExplosion.hs +++ b/AfterEffect/SimpleExplosion.hs @@ -67,7 +67,7 @@ instance InternallyUpdating SimpleExplosion where preUpdate self t = self { timeRemaining = timeRemaining self - t - , center = M.idealNewLocation (wrapMap self) + , center = M.newLocation (wrapMap self) (center self) (velocity self) t diff --git a/Animation.hs b/Animation.hs --- a/Animation.hs +++ b/Animation.hs @@ -1,16 +1,25 @@ module Animation where -import Graphics.Gloss.Data.Picture -import Moving -import Data.WrapAround -import Sound.ALUT -import Common +import Graphics.Gloss.Data.Picture ( Picture(..) ) +import Data.WrapAround (WP) +import Sound.ALUT ( DistanceModel(InverseDistanceClamped) + , Source + , ($=) + , play + , stop + , genObjectNames + , buffer + ) +import ResourceTracker +import Common (Time) +import GHC.Float ( double2Float ) +import Math ( radToDeg ) class Animation a where image :: a -> Time -> Picture class Audible a where - processAudio :: a -> WrapPoint -> IO a + processAudio :: a -> WP -> IO a terminateAudio :: a -> IO a {- @@ -24,8 +33,41 @@ audioReferenceDistance = 300.0 :: Float --- audioMaxDistance = 800.0 :: Float - audioRolloffFactor = 3.0 :: Float audioDistanceModel = InverseDistanceClamped + +handSndSrc + :: a -- ^ the object + -> (a -> Bool) -- ^ func which checks if sound queued to play + -> (a -> Maybe Source) -- ^ func which retrieves source from object + -> (a -> a) -- ^ func which unqueues shot sound + -> (a -> RT) -- ^ func which gets resource tracker + -> String -- ^ name of sound file + -> (a -> Source -> a) -- ^ func which sets source in object + -> IO a + +-- |Abstraction for playing a sound source when queued. +handSndSrc a f h i k e l + = do if f a then g a else return a + where g b = do case h b of + Just x -> do play [x] + return (i b) + Nothing -> do j b >>= g + j d = do [c] <- genObjectNames 1 + buffer c $= getSound (k d) e + return (l d c) + +-- |Abstraction for terminating a sound source in an object. +termSndSrc + :: a -- ^ the object + -> (a -> Maybe Source) -- ^ func which retrieves source from object + -> IO a +termSndSrc a f = case f a of + Nothing -> return a + Just x -> do stop [x] + return a + +-- |The angle of many images have to be rotated because of differing ideas +-- of angle orientation between my code and the gloss framework +reorient a b = Rotate ((double2Float . negate . radToDeg) a - 90) b diff --git a/Asteroid.hs b/Asteroid.hs --- a/Asteroid.hs +++ b/Asteroid.hs @@ -4,79 +4,62 @@ import Updating import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.Color -import qualified Moving as M +import Moving ( Locatable + , Colliding ( collisionRadius ) + , Moving + , newLocation' + ) +import qualified Moving as M ( Moving (..) + , Locatable (..) + ) import Data.WrapAround import ResourceTracker import GHC.Float import Combat import Data.Maybe import SpaceJunk - -asteroidRadius = 15.0 +import Common ( Velocity ) -damageEnergy' = 100.0 +radius = 15.0 -data Asteroid = - Asteroid { location :: WrapPoint - , idealTargetLocation :: Maybe WrapPoint - , velocity :: (Double, Double) - , wrapMap :: WrapMap - , animDefault0 :: Picture - } +damage = 100.0 -new :: ResourceTracker -> WrapMap -> WrapPoint -> (Double, Double) -> Asteroid -new rt wmap location velocity = - let pic = fromMaybe - (Scale 0.20 0.20 - (Color white - (Text "Error! Missing image!"))) - (getImage rt "asteroid.bmp") in - Asteroid { location = location - , velocity = velocity - , wrapMap = wmap - , idealTargetLocation = Nothing - , animDefault0 = pic - } +data Asteroid = Asteroid { center :: WP + , velocity :: Velocity + , wmap :: WM + , rt :: RT + } +new :: ResourceTracker -> WM -> WP -> Velocity -> Asteroid +new a b c d = Asteroid { center = c + , velocity = d + , wmap = b + , rt = a + } instance Animation Asteroid where - image self _ = animDefault0 self + image self _ = protectedGetImage (rt self) "asteroid.bmp" -instance M.Locatable Asteroid where - center = location +instance Locatable Asteroid where + center = Asteroid.center -instance M.Moving Asteroid where - velocity = velocity +instance Moving Asteroid where + velocity = Asteroid.velocity -instance M.Colliding Asteroid where - collisionRadius _ = asteroidRadius +instance Colliding Asteroid where + collisionRadius _ = radius instance InternallyUpdating Asteroid where - preUpdate asteroid t = updateIdealTargetLocation t asteroid - - postUpdate asteroid t = - let location' = fromMaybe - (location asteroid) - (idealTargetLocation asteroid) in - asteroid { location = location' - , idealTargetLocation = Nothing - } - + preUpdate s _ = s -updateIdealTargetLocation t asteroid = - asteroid { idealTargetLocation = Just (M.idealNewLocation (wrapMap asteroid) - (location asteroid) - (velocity asteroid) - t) - } + postUpdate s t = s { center = newLocation' s (wmap s) t } instance Damageable Asteroid where inflictDamage = const - instance Damaging Asteroid where - damageEnergy _ = damageEnergy' + damageEnergy _ = damage diff --git a/BigAsteroid.hs b/BigAsteroid.hs --- a/BigAsteroid.hs +++ b/BigAsteroid.hs @@ -4,78 +4,62 @@ import Updating import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.Color -import qualified Moving as M +import Moving ( Locatable + , Colliding ( collisionRadius ) + , Moving + , newLocation' + ) +import qualified Moving as M ( Moving (..) + , Locatable (..) + ) import Data.WrapAround import ResourceTracker import GHC.Float import Combat import Data.Maybe -import Common - -asteroidRadius = 30.0 +import SpaceJunk +import Common ( Velocity ) -punch = 100.0 +radius = 30.0 -data BigAsteroid = - BigAsteroid { location :: WrapPoint - , idealTargetLocation :: Maybe WrapPoint - , velocity :: Velocity - , wrapMap :: WrapMap - , animDefault0 :: Picture - } +damage = 100.0 -new :: ResourceTracker -> WrapMap -> WrapPoint -> Velocity -> BigAsteroid -new rt wmap location velocity = - let pic = fromMaybe - (Scale 0.20 0.20 - (Color white - (Text "Error! Missing image!"))) - (getImage rt "asteroidbig.bmp") in - BigAsteroid { location = location - , velocity = velocity - , wrapMap = wmap - , idealTargetLocation = Nothing - , animDefault0 = pic - } +data BigAsteroid = BigAsteroid { center :: WP + , velocity :: Velocity + , wmap :: WM + , rt :: RT + } +new :: ResourceTracker -> WM -> WP -> Velocity -> BigAsteroid +new a b c d = BigAsteroid { center = c + , velocity = d + , wmap = b + , rt = a + } instance Animation BigAsteroid where - image self _ = animDefault0 self + image self _ = protectedGetImage (rt self) "asteroidbig.bmp" -instance M.Locatable BigAsteroid where - center = location +instance Locatable BigAsteroid where + center = BigAsteroid.center -instance M.Moving BigAsteroid where - velocity = velocity +instance Moving BigAsteroid where + velocity = BigAsteroid.velocity -instance M.Colliding BigAsteroid where - collisionRadius _ = asteroidRadius +instance Colliding BigAsteroid where + collisionRadius _ = radius instance InternallyUpdating BigAsteroid where - preUpdate asteroid t = updateIdealTargetLocation t asteroid - - postUpdate asteroid t = - let location' = fromMaybe - (location asteroid) - (idealTargetLocation asteroid) in - asteroid { location = location' - , idealTargetLocation = Nothing - } - + preUpdate s _ = s -updateIdealTargetLocation t asteroid = - asteroid { idealTargetLocation = Just (M.idealNewLocation (wrapMap asteroid) - (location asteroid) - (velocity asteroid) - t) - } + postUpdate s t = s { center = newLocation' s (wmap s) t } instance Damageable BigAsteroid where inflictDamage = const - instance Damaging BigAsteroid where - damageEnergy _ = punch + damageEnergy _ = damage + diff --git a/Combat.hs b/Combat.hs --- a/Combat.hs +++ b/Combat.hs @@ -2,10 +2,20 @@ module Combat where -import Updating -import Animation -import Moving -import Data.WrapAround +import Updating ( Transient (expired') + , InternallyUpdating ( preUpdate + , postUpdate + ) + ) +import Animation ( Animation ) +import Moving ( Locatable ( center ) + , Moving ( velocity ) + , Colliding ( collisionRadius ) + , collision + , collisionWindow + , collisionWindow' + ) +import Data.WrapAround ( WM ) data Projectile = forall a. ( Animation a , Colliding a @@ -53,44 +63,46 @@ deployProjectiles :: a -> ([Projectile], a) -handleCollisionDamage :: ( Damaging a - , Damageable a - , Colliding a - , Damaging b - , Damageable b - , Colliding b - ) => WrapMap -> Double -> a -> [b] -> (a, [b]) - -handleCollisionDamage wmap tw x ys = handleCollisionDamage' x ys [] +handleCollisionDamage + :: (Colliding a, Colliding t, Damageable t, Damageable a, + Damaging a, Damaging t) + => WM + -> Double -- ^ elapsed time window + -> a -> [t] -> (a, [t]) +handleCollisionDamage w t x ys = acc x ys [] - where handleCollisionDamage' x [] nys = (x, nys) - handleCollisionDamage' x (y:ys) nys = - if not $ collisionWindow wmap (max - (maxExpectedVelocity * tw) - (collisionRadius x + collisionRadius y)) x y - then handleCollisionDamage' x ys (nys ++ [y]) - else - case collision wmap tw x y of - Nothing -> handleCollisionDamage' x ys (nys ++ [y]) + where acc x [] a = (x, a) + acc x (y:ys) a = + if collisionWindow' w x y t + then + case collision w t x y of + Nothing -> acc x ys (a ++ [y]) Just _ -> let (nx, ny) = ( inflictDamage' y x , inflictDamage' x y ) in - handleCollisionDamage' nx ys (nys ++ [ny]) + acc nx ys (a ++ [ny]) + else acc x ys (a ++ [y]) -handleCollisionDamage' :: ( Damaging a - , Damageable a - , Colliding a - , Damaging b - , Damageable b - , Colliding b - ) => WrapMap -> Double -> [a] -> [b] -> ([a], [b]) +-- handleCollisionDamage' :: ( Damaging a +-- , Damageable a +-- , Colliding a +-- , Damaging b +-- , Damageable b +-- , Colliding b +-- ) => WrapMap -> Double -> [a] -> [b] -> ([a], [b]) -handleCollisionDamage' wmap tw xs ys = handleCollisionDamage'' xs ys [] +handleCollisionDamage' + :: (Colliding t, Colliding a, Damageable a, Damageable t, + Damaging t, Damaging a) + => WM + -> Double -- ^ elapsed time window + -> [a] -> [t] -> ([a], [t]) +handleCollisionDamage' w t c d = acc c d [] - where handleCollisionDamage'' [] ys nxs = (nxs, ys) - handleCollisionDamage'' (x:xs) ys nxs = - let (rx, rys) = handleCollisionDamage wmap tw x ys in - handleCollisionDamage'' xs rys (nxs ++ [rx]) + where acc [] b a = (a, b) + acc (x:xs) b a = + let (m, n) = handleCollisionDamage w t x b in + acc xs n (a ++ [m]) data Impacting = forall a. (Damaging a, Damageable a, Colliding a) => Impacting a diff --git a/Common.hs b/Common.hs --- a/Common.hs +++ b/Common.hs @@ -1,5 +1,9 @@ module Common where +import Math ( inc + , isNeg + ) + -- seconds type Time = Double @@ -7,4 +11,22 @@ type Angle = Double -- mysterious unit but usually same as pixels -type Velocity = (Double, Double) +type Velocity = Vector + +type Vector = (Double, Double) + +-- replaceAt :: Int -> a -> [a] -> [a] +-- replaceAt i a as +-- | isNeg i || i >= length as = as +-- | otherwise = take i as ++ [a] ++ drop (inc i) as + +replaceAt a b c + | isNeg a = c + | otherwise = acc 0 c + + where acc _ [] = [] + acc u (v:vs) + | u == a = b : vs + | otherwise = v : acc (inc u) vs + +allTrue = all id diff --git a/Display.hs b/Display.hs --- a/Display.hs +++ b/Display.hs @@ -16,7 +16,7 @@ import Unit import Item import ResourceTracker -import Trigonometry +import Math import Resources data Displayable = forall a. (Locatable a, Animation a) => Displayable a @@ -112,7 +112,7 @@ (sensorPanel arena' (150.0, 150.0)) in let levelMessage = case levelMessageTimer u of Nothing -> Blank - Just mt -> if mt `doubleRem` 0.5 < 0.25 + Just mt -> if mt `remF` 0.5 < 0.25 then Blank else Translate (-200.0) 150.0 (Text diff --git a/Item.hs b/Item.hs --- a/Item.hs +++ b/Item.hs @@ -1,13 +1,23 @@ module Item where -import Data.WrapAround -import Moving -import Animation -import Data.Maybe -import Graphics.Gloss.Data.Picture -import Graphics.Gloss.Data.Color -import ResourceTracker -import System.Random +import Data.WrapAround (WP) +import Moving ( Moving (velocity) + , Locatable (center) + , Colliding (collisionRadius) + ) +import Animation ( Animation(..) ) +import Data.Maybe (fromMaybe) +import Graphics.Gloss.Data.Picture ( Picture ( Scale + , Color + , Text + ) + ) +import Graphics.Gloss.Data.Color (white) +import ResourceTracker ( RT + , getImage + , protectedGetImage + ) +import System.Random (randomRIO) data ItemType = Health | FourWay @@ -17,7 +27,7 @@ | Nuke deriving (Show, Eq) -data Item = Item ItemType ResourceTracker WrapPoint +data Item = Item ItemType RT WP deriving (Show) instance Colliding Item where @@ -28,26 +38,19 @@ instance Moving Item where - velocity _ = (0.0, 0.0) + velocity _ = (0, 0) instance Animation Item where - image (Item ty rt _) _ = fromMaybe - (Scale 0.20 0.20 - (Color white - (Text "Error! Missing image!"))) - (getImage rt pic) - where pic = case ty of - Health -> "item-health.bmp" - FourWay -> "item-fourway.bmp" - Cannon -> "item-cannon.bmp" - Spread -> "item-spread.bmp" - RapidFire -> "item-rapidfire.bmp" - Nuke -> "item-nuke.bmp" + image (Item a b _) _ = protectedGetImage b $ + case a of + Health -> "item-health.bmp" + FourWay -> "item-fourway.bmp" + Cannon -> "item-cannon.bmp" + Spread -> "item-spread.bmp" + RapidFire -> "item-rapidfire.bmp" + Nuke -> "item-nuke.bmp" -randomItemType :: IO (ItemType) -randomItemType = do let min = (0 :: Int) - let max = (5 :: Int) - r <- randomRIO (min, max) +randomItemType = do r <- randomRIO (0, 5) :: IO Int return $ case r of 0 -> Health diff --git a/Lance.hs b/Lance.hs --- a/Lance.hs +++ b/Lance.hs @@ -25,7 +25,7 @@ import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.Color import GHC.Float -import Trigonometry +import Math import ResourceTracker import Data.Maybe import Updating @@ -59,47 +59,35 @@ type LanceInventory = [Bool] -data Lance = Lance { angle :: Angle -- radians - , center :: WrapPoint +data Lance = Lance { angle :: Angle + , center :: WP + , wmap :: WM , rotationalThrusters :: RotationDirection - , idealTargetCenter :: Maybe WrapPoint - , velocity :: (Double, Double) + , velocity :: Velocity , linearThrusters :: Bool - , wrapMap :: WrapMap - , resourceTracker :: ResourceTracker - - -- deflector - , deflectorCharge :: Double + , queueShotSound :: Bool + , godMode :: Bool , deflector :: Bool - - -- firing - , launchTube :: [Projectile] - , sinceLastShot :: Time , fireTrigger :: Bool + , rt :: RT + , launchTube :: [Projectile] , currentWeapon :: Int , inventory :: LanceInventory , swClock :: Time - - -- death + , sinceLastShot :: Time , integrity :: Double - - -- Sound - , queueShotSound :: Bool + , deflectorCharge :: Double , shotSoundSource :: Maybe Source - - , godMode :: Bool } -new :: ResourceTracker -> WrapMap -> WrapPoint -> Lance -new rt wmap center = - Lance { center = center +new r w c = + Lance { center = c , angle = 0.0 , rotationalThrusters = Stable - , idealTargetCenter = Nothing - , velocity = (0.0, 0.0) + , velocity = (0, 0) , linearThrusters = False - , wrapMap = wmap - , resourceTracker = rt + , wmap = w + , rt = r , deflector = False , deflectorCharge = 2.0 , launchTube = [] @@ -114,107 +102,55 @@ , swClock = 0.0 } -changeCurrentWeapon self = - let i = inventory self in - let c = currentWeapon self in - let c' = if c + 1 > 5 - then if i !! 0 - then 1 - else 0 - else c + 1 in - if c' /= 0 && not (i !! (c' - 1)) - then changeCurrentWeapon self { currentWeapon = c' } - else self { currentWeapon = c' } - -replaceAt :: Int -> a -> [a] -> [a] -replaceAt i a as - | i < 0 = as - | i >= length as = as - | otherwise = let x = take i as in - let y = drop (i + 1) as in - x ++ [a] ++ y +changeCurrentWeapon s = + if neither (isZero c) (a !! dec c) then changeCurrentWeapon d else d + where a = inventory s + b = currentWeapon s + c = if inc b > 5 + then if a !! 0 then 1 else 0 + else inc b + d = s { currentWeapon = c } -processItem :: Lance -> Item -> Lance -processItem self (Item typ _ _) = - let s' = case typ of - Health -> self { integrity = 3.0 } - FourWay -> self { inventory = replaceAt 0 True (inventory self) - , currentWeapon = 1 - } - Cannon -> self { inventory = replaceAt 1 True (inventory self) - , currentWeapon = 2 - } - Spread -> self { inventory = replaceAt 2 True (inventory self) - , currentWeapon = 3 - } - RapidFire -> self { inventory = replaceAt 3 True (inventory self) - , currentWeapon = 4 - } - Nuke -> self { inventory = replaceAt 4 True (inventory self) - , currentWeapon = 5 - } - in if typ == Health - then s' - else s' { swClock = 0.0 } +processItem s (Item a _ _) = + if a == Health then b else b { swClock = 0 } + where b = case a of + Health -> s { integrity = 3.0 } + FourWay -> f 0 + Cannon -> f 1 + Spread -> f 2 + RapidFire -> f 3 + Nuke -> f 4 + f v = s { inventory = replaceAt v True (inventory s) + , currentWeapon = inc v + } instance Audible Lance 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 play [fromJust $ shotSoundSource self] - return self' { queueShotSound = False } - - terminateAudio self = - if isNothing (shotSoundSource self) - then return self - else do stop [fromJust (shotSoundSource self)] - return self + processAudio s _ = handSndSrc s + queueShotSound + shotSoundSource + (\a -> a { queueShotSound = False }) + rt + "simple-energy-shot.wav" + (\a b -> a { shotSoundSource = Just b }) -initializeShotSoundSource self = - do [source] <- genObjectNames 1 - buffer source $= getSound (resourceTracker self) "simple-energy-shot.wav" - -- ... - return self { shotSoundSource = Just source } + terminateAudio s = termSndSrc s shotSoundSource -shielded :: Lance -> Bool -shielded lance = deflectorCharge lance >= 1.0 && deflector lance +shielded s = deflectorCharge s >= 1.0 && deflector s updateAngle :: Time -> Lance -> Lance -updateAngle t lance - | rotationalThrusters lance == CW - = lance { angle = angle lance - radialVelocity * t} - | rotationalThrusters lance == CCW - = lance { angle = angle lance + radialVelocity * t} - | otherwise = lance +updateAngle t s = + case rotationalThrusters s of CW -> f (-); CCW -> f (+); Stable -> s + where f a = s { angle = a (angle s) (radialVelocity * t) } instance Animation Lance where - image lance _ = let rt = resourceTracker lance in - let lancePic = fromMaybe - (Scale 0.20 0.20 - (Color white - (Text "Error! Missing image!"))) - (getImage rt "lance.bmp") in - let lanceThrustingPic = - fromMaybe - (Scale 0.20 0.20 - (Color white - (Text "Error! Missing image!"))) - (getImage rt "lance-thrusting.bmp") in - let pic = if linearThrusters lance then lanceThrustingPic - else lancePic in - let deflector' = if deflector lance - && deflectorCharge lance >= 1.0 - then Color white (Circle 40.0) - else Blank in - Pictures [ deflector' - , Rotate (radToDeg - (double2Float - (angle lance)) * (-1) - 90) pic - ] + image s _ = Pictures [ b, reorient (angle s) a ] + where a = if linearThrusters s + then protectedGetImage (rt s) "lance-thrusting.bmp" + else protectedGetImage (rt s) "lance.bmp" + b = if deflector s && deflectorCharge s >= 1.0 + then Color white (Circle 40.0) + else Blank instance M.Locatable Lance where center = Lance.center @@ -227,103 +163,46 @@ instance InternallyUpdating Lance where - preUpdate lance t = (updateFiringInformation t . - updateIdealTargetCenter t . - updateVelocity t . - updateAngle t) lance + preUpdate s t = ( updateFiringInformation t + . updateVelocity t + . updateAngle t ) s - postUpdate lance t = - let center' = fromMaybe (center lance) (idealTargetCenter lance) in + postUpdate s t = updateDeflectorCharge t - lance { center = center' - , idealTargetCenter = Nothing - } - -updateFiringInformation t lance = - let sinceLastShot' = sinceLastShot lance + t - in let s' = if all id (inventory lance) && swClock lance < swTimeLimit - then handleSuperWeapon lance sinceLastShot' - else case currentWeapon lance of - 1 -> handleFourWayWeapon lance sinceLastShot' - 2 -> handleCannonWeapon lance sinceLastShot' - 3 -> handleSpreadWeapon lance sinceLastShot' - 4 -> handleRapidFireWeapon lance sinceLastShot' - 5 -> handleNukeWeapon lance sinceLastShot' - otherwise -> handleDefaultWeapon lance sinceLastShot' - in s' { swClock = (swClock s') + t } - -handleSuperWeapon self ls = - if ls >= 0.2 && fireTrigger self - then self { sinceLastShot = 0.0 - , launchTube = - rearProjectiles - ++ sideProjectiles - ++ [frontProjectile] - ++ launchTube self - , queueShotSound = True - } - else self { sinceLastShot = ls } - where rearProjectiles = [ Projectile ( P.BulletMkI.new - (wrapMap self) - (angle self + pi / 2) - (center self) - (velocity self) ) - , Projectile ( P.BulletMkI.new - (wrapMap self) - (angle self + 3 * pi / 4) - (center self) - (velocity self) ) - , Projectile ( P.BulletMkI.new - (wrapMap self) - (angle self + pi) - (center self) - (velocity self) ) - , Projectile ( P.BulletMkI.new - (wrapMap self) - (angle self + 5 * pi / 4) - (center self) - (velocity self) ) - , Projectile ( P.BulletMkI.new - (wrapMap self) - (angle self + 3 * pi / 2) - (center self) - (velocity self) ) - ] + s { center = M.newLocation' s (wmap s) t } - sideProjectiles = [ Projectile ( P.SWSide.new - (wrapMap self) - (angle self + pi / 10) - (center self) - (velocity self) ) - , Projectile ( P.SWSide.new - (wrapMap self) - (angle self + pi / 5) - (center self) - (velocity self) ) - , Projectile ( P.SWSide.new - (wrapMap self) - (angle self - pi / 10) - (center self) - (velocity self) ) - , Projectile ( P.SWSide.new - (wrapMap self) - (angle self - pi / 5) - (center self) - (velocity self) ) - ] +updateFiringInformation t s = + b { swClock = (swClock b) + t } + where a = sinceLastShot s + t + b = if allTrue (inventory s) && swClock s < swTimeLimit + then handleSuperWeapon s a + else case currentWeapon s of + 1 -> handleFourWayWeapon s a + 2 -> handleCannonWeapon s a + 3 -> handleSpreadWeapon s a + 4 -> handleRapidFireWeapon s a + 5 -> handleNukeWeapon s a + otherwise -> handleDefaultWeapon s a - frontProjectile = Projectile ( P.SWForward.new - (wrapMap self) - (angle self) - (center self) - (velocity self) ) +handleSuperWeapon s a = if a >= 0.2 && fireTrigger s + then s { sinceLastShot = 0 + , launchTube = b ++ c ++ [d] ++ launchTube s + , queueShotSound = True + } + else s { sinceLastShot = a } + where f u v = Projectile ( u (wmap s) (angle s + v) (center s) (velocity s) ) + g = f P.BulletMkI.new + h = f P.SWSide.new + b = map g [ pi / 2, 3 * pi / 4, pi, 5 * pi / 4, 3 * pi / 2 ] + c = map h [ pi / 10, pi / 5, (-pi) / 10, (-pi) / 5 ] + d = f P.SWForward.new 0 handleDefaultWeapon self ls = if ls >= 0.4 && fireTrigger self then self { sinceLastShot = 0.0 , launchTube = Projectile ( P.BulletMkI.new - (wrapMap self) + (wmap self) (angle self) (center self) (velocity self) ) : launchTube self @@ -336,22 +215,22 @@ then self { sinceLastShot = 0.0 , launchTube = [ Projectile ( P.BulletMkI.new - (wrapMap self) + (wmap self) (angle self) (center self) (velocity self) ) ] ++ [ Projectile ( P.BulletMkI.new - (wrapMap self) + (wmap self) (angle self + pi / 2) (center self) (velocity self) ) ] ++ [ Projectile ( P.BulletMkI.new - (wrapMap self) + (wmap self) (angle self + pi) (center self) (velocity self) ) ] ++ [ Projectile ( P.BulletMkI.new - (wrapMap self) + (wmap self) (angle self + 3 * pi / 2) (center self) (velocity self) ) ] @@ -365,7 +244,7 @@ then self { sinceLastShot = 0.0 , launchTube = Projectile ( P.Cannon.new - (wrapMap self) + (wmap self) (angle self) (center self) (velocity self) ) : launchTube self @@ -379,27 +258,27 @@ then self { sinceLastShot = 0.0 , launchTube = [ Projectile ( P.BulletMkI.new - (wrapMap self) + (wmap self) (angle self) (center self) (velocity self) ) ] ++ [ Projectile ( P.BulletMkI.new - (wrapMap self) + (wmap self) (angle self + spreadAngle) (center self) (velocity self) ) ] ++ [ Projectile ( P.BulletMkI.new - (wrapMap self) + (wmap self) (angle self + spreadAngle * 2) (center self) (velocity self) ) ] ++ [ Projectile ( P.BulletMkI.new - (wrapMap self) + (wmap self) (angle self - spreadAngle) (center self) (velocity self) ) ] ++ [ Projectile ( P.BulletMkI.new - (wrapMap self) + (wmap self) (angle self - spreadAngle * 2) (center self) (velocity self) ) ] @@ -413,7 +292,7 @@ then self { sinceLastShot = 0.0 , launchTube = Projectile ( P.BulletMkI.new - (wrapMap self) + (wmap self) (angle self) (center self) (velocity self) ) : launchTube self @@ -426,8 +305,8 @@ then self { sinceLastShot = 0.0 , launchTube = Projectile ( P.Nuke.new - (wrapMap self) - (resourceTracker self) + (wmap self) + (rt self) (angle self) (center self) (velocity self) ) : launchTube self @@ -442,18 +321,10 @@ else min 2.0 (charge + t * 0.05) in lance { deflectorCharge = charge' } -updateIdealTargetCenter :: Time -> Lance -> Lance -updateIdealTargetCenter t lance = - lance { idealTargetCenter = Just (M.idealNewLocation (wrapMap lance) - (center lance) - (velocity lance) - t) - } - updateVelocity :: Time -> Lance -> Lance updateVelocity t lance | linearThrusters lance = - lance { velocity = M.calcNewVelocity + lance { velocity = M.newVelocity (velocity lance) accelerationRate (angle lance) @@ -488,8 +359,8 @@ expired' self = if not (integrity self <= 0.0) then Nothing else Just [ef] - where ef = AfterEffect (SimpleExplosion.new (resourceTracker self) - (wrapMap self) + where ef = AfterEffect (SimpleExplosion.new (rt self) + (wmap self) (Lance.center self) (Lance.velocity self)) diff --git a/Math.hs b/Math.hs new file mode 100644 --- /dev/null +++ b/Math.hs @@ -0,0 +1,103 @@ +module Math where + +import Data.Maybe + +divBySum a b c = a / (b + c) + +divideProduct a b c = a * b / c + +ratioRadDeg = 180 / pi + +radToDeg = (ratioRadDeg *) + +mulSV s (x, y) = (s * x, s * y) + +join f a = f a a + +sqr = join (*) + +distrib f g a b = g (f a) (f b) + +sumSquares = distrib sqr (+) + +pairLen f = distrib f (flip (-)) +pairLenFst = pairLen fst +pairLenSnd = pairLen snd + +-- vectMag a = sqrt (sum + +hypotenuse a b = sqrt (sumSquares a b) + +distance a b = hypotenuse (pairLenFst a b) (pairLenSnd a b) + +vectMag (a, b) = hypotenuse a b + +circleRads = 2 * pi + +nan = 0 / 0 + +isPos :: (Num a, Ord a) => a -> Bool +isPos = (>= 0) + +isNeg :: (Num a, Ord a) => a -> Bool +isNeg = not . isPos + +bothPos = distrib isPos (&&) +bothNeg = distrib isNeg (&&) + +-- return unit radians +vectorDirection (0, 0) = nan +vectorDirection (x, y) + | bothPos x y = a + | isNeg x && isPos y = pi - a + | bothNeg x y = pi + a + | otherwise = circleRads - a + where a = atan (distrib abs (/) y x) + + +{- + Assumes source (origin of projectile) is at origin of grid (0, 0) and so + target center is relative to this. Assumes source is stationary and so + velocity of target is relative to source. +-} +targetingA s c v = f c 3 + + where f n i = + if moreThanZero i + then f (g n) (decrem i) + else vectorDirection (g n) + g n = addV c (mulSV (distOrigin n / s) v) + +moreThanZero = (> 0) + +inc, increm :: Num a => a -> a +increm = flip (+) 1 +inc = increm + +dec, decrem :: Num a => a -> a +decrem = flip (-) 1 +dec = decrem + +origin = (0, 0) + +distOrigin = distance origin + +addV (x1, y1) (x2, y2) = (x1 + x2, y1 + y2) + +subV (x1, y1) (x2, y2) = (x1 - x2, y1 - y2) + +remF x y = (a - coerciveTrunc a) * y + where a = x / y +coerciveTrunc = fromIntegral . truncate + +isZero :: (Num a, Eq a) => a -> Bool +isZero = (== 0) + +notZero :: (Num a, Eq a) => a -> Bool +notZero = (/= 0) + +zeroProtect a b = if isZero b then a else b + +appPair f (a, b) = (f a, f b) + +neither a b = not (a || b) diff --git a/Moving.hs b/Moving.hs --- a/Moving.hs +++ b/Moving.hs @@ -1,40 +1,61 @@ module Moving where -import Data.WrapAround -import qualified Data.WrapAround as W -import Trigonometry +import Data.WrapAround ( WM + , WP + , add' + ) +import qualified Data.WrapAround as W (distance) +import Math ( mulSV + , vectMag + , isPos + , divideProduct + , mulSV + , addV + , zeroProtect + ) +import qualified Math as T (distance) import Data.List (find) import Control.Monad (join) -import Common +import Common ( Velocity + , Angle + , Time + ) +import Data.Maybe (isJust) -maxExpectedVelocity = 1000 -- should equal max velocity of fastest object in arena +maxExpectedVelocity = 700 -- should equal max velocity of fastest object in arena -calcNewVelocity - :: Velocity -> Double -> Angle -> Double -> Time -> (Double, Double) -calcNewVelocity oVelocity accelerationRate thrustAngle maxVelocity t = - let (vXo, vYo) = oVelocity in - let acceleration = t * accelerationRate in - let dX = cos thrustAngle * acceleration in - let dY = sin thrustAngle * acceleration in - let vXn = vXo + dX in - let vYn = vYo + dY in - let magVN' = sqrt (vXn ** 2 + vYn ** 2) in - let magVN = if magVN' == 0 then 0.1 -- erm... necessary? - else magVN' in - let aVN = if vXn >= 0 then asin (vYn / magVN) - else pi - asin (vYn / magVN) in - let finalMag = min magVN maxVelocity in - let finalX = cos aVN * finalMag in - let finalY = sin aVN * finalMag in - (finalX, finalY) +coordVector :: Floating t + => t -- ^ angle + -> t -- ^ magnitude + -> (t, t) +coordVector a b = (cos a * b, sin a * b) -idealNewLocation :: WrapMap -> WrapPoint -> Velocity -> Time -> WrapPoint -idealNewLocation wmap oLocation (velX, velY) t = - addPoints' wmap oLocation velocity' - where velocity' = (velX * t, velY * t) +newVelocity + :: Velocity -- ^ original velocity + -> Double -- ^ rate of acceleration + -> Angle -- ^ angle of thrust + -> Double -- ^ maximum speed allowed + -> Time -- ^ time elapsed + -> (Double, Double) +newVelocity v r a l t = + let d = coordVector a (t * r) in + let (x, y) = addV v d in + let m = zeroProtect 0.1 (vectMag (x, y)) in + let n = if isPos x then asin (y / m) + else pi - asin (y / m) in + coordVector n (min m l) +newLocation :: WM + -> WP -- ^ original location + -> Velocity -- ^ velocity + -> Time -- ^ elapsed time + -> WP +newLocation w a b t = add' w a (mulSV t b) + +newLocation' a b c = newLocation b (center a) (velocity a) c + class Locatable a where - center :: a -> WrapPoint + center :: a -> WP class (Locatable a) => Moving a where @@ -46,53 +67,49 @@ data Collision = Collision { time :: Time -- since start of collision detection -- window frame - , center1 :: WrapPoint -- at point of collision - , center2 :: WrapPoint -- likewise + , center1 :: WP -- at point of collision + , center2 :: WP -- likewise } --- Double refers to time window for checking for collision -collision :: (Colliding a, Colliding b) - => WrapMap - -> Time - -> a - -> b - -> Maybe Collision -collision wmap tw obj1 obj2 = - let r1 = collisionRadius obj1 in - let r2 = collisionRadius obj2 in - let v1 = velocity obj1 in - let v2 = velocity obj2 in - let dD = Trigonometry.distance v1 v2 in - let ts = fromIntegral $ ceiling (dD / (r1 + r2)) in - let ti = tw / ts in - let tpoints = [ x * ti | x <- [0..ts] ] in - let o1 = center obj1 in - let o2 = center obj2 in - let points = [ ( addPoints' wmap o1 (mulSV t v1) - , addPoints' wmap o2 (mulSV t v2) - ) | t <- tpoints ] in - let distances = [ W.distance wmap p1 p2 | (p1, p2) <- points ] in - let zipped = zip3 tpoints points distances in - do (t, (p1, p2), _) <- find (\(_, _, d) -> d <= r1 + r2) zipped +collision + :: (Colliding a, Colliding a1) + => WM + -> Double -- ^ time window for checking collision + -> a -> a1 -> Maybe Collision +collision w tw a b = + do (t, (p1, p2), _) <- find (\(_, _, d) -> d <= r) z Just Collision { time = t , center1 = p1 , center2 = p2 } + where (r1, r2) = (collisionRadius a, collisionRadius b) + r = r1 + r2 + dD = T.distance (velocity a) (velocity b) + s = (fromIntegral . ceiling) (dD / r) + m = [ divideProduct x tw s | x <- [0..s] ] + f x y = add' w x (mulSV y (velocity a)) + u = [ (f (center a) t, f (center b) t) | t <- m ] -collisionWindow :: (Colliding a, Colliding b) => WrapMap -> Double -> a -> b -> Bool -collisionWindow wmap range obj1 obj2 = - W.distance wmap (center obj1) (center obj2) <= range + z = zip3 m u [ W.distance w p1 p2 | (p1, p2) <- u ] -collisionScan :: (Colliding a, Colliding b) => WrapMap -> a -> [b] -> Time -> Maybe Collision -collisionScan wmap c cs t = - let relAsteroids = - [ a | a <- cs - , let range = max (maxExpectedVelocity * 2 * t) - (collisionRadius c + collisionRadius a) in - collisionWindow wmap range c a - ] in - let collisions = map (collision wmap t c) relAsteroids in - join (find (\a -> case a of - Nothing -> False - otherwise -> True) collisions) +collisionWindow + :: (Colliding a, Colliding b) + => WM + -> Double -- ^ range + -> a -> b -> Bool +collisionWindow a b c d = + W.distance a (center c) (center d) <= b + +collisionWindow' a b c t + = collisionWindow a + (max (maxExpectedVelocity * 2 * t) + (collisionRadius b + collisionRadius c)) b c + +collisionScan :: (Colliding a, Colliding b) => WM -> a -> [b] -> Time -> Maybe Collision +collisionScan w c cs t = + let collisions = map (collision w t c) + [ a | a <- cs + , collisionWindow' w c a t + ] in + join (find isJust collisions) diff --git a/Projectile/Blade.hs b/Projectile/Blade.hs --- a/Projectile/Blade.hs +++ b/Projectile/Blade.hs @@ -11,7 +11,7 @@ import Graphics.Gloss.Data.Color import Data.WrapAround import qualified Moving as M -import Trigonometry +import Math import Data.Maybe import ResourceTracker import GHC.Float @@ -51,7 +51,7 @@ instance Animation Blade where image self t = Rotate (double2Float deg) p - where deg = radToDeg ((clock self * 4 * pi) `doubleRem` (2 * pi)) + where deg = radToDeg ((clock self * 4 * pi) `remF` (2 * pi)) p = fromMaybe (Color white (Line [(-40, 0), (40, 0)])) @@ -89,7 +89,7 @@ updateIdealTargetCenter :: Time -> Blade -> Blade updateIdealTargetCenter t self = - let newLoc = M.idealNewLocation (wrapMap self) + let newLoc = M.newLocation (wrapMap self) (center self) (velocity self) t in diff --git a/Projectile/BulletMI.hs b/Projectile/BulletMI.hs --- a/Projectile/BulletMI.hs +++ b/Projectile/BulletMI.hs @@ -86,7 +86,7 @@ updateIdealTargetCenter :: Time -> BulletMI -> BulletMI updateIdealTargetCenter t self = - let newLoc = M.idealNewLocation (wrapMap self) + let newLoc = M.newLocation (wrapMap self) (center self) (velocity self) t in diff --git a/Projectile/BulletMII.hs b/Projectile/BulletMII.hs --- a/Projectile/BulletMII.hs +++ b/Projectile/BulletMII.hs @@ -86,7 +86,7 @@ updateIdealTargetCenter :: Time -> BulletMII -> BulletMII updateIdealTargetCenter t self = - let newLoc = M.idealNewLocation (wrapMap self) + let newLoc = M.newLocation (wrapMap self) (center self) (velocity self) t in diff --git a/Projectile/BulletMkI.hs b/Projectile/BulletMkI.hs --- a/Projectile/BulletMkI.hs +++ b/Projectile/BulletMkI.hs @@ -86,7 +86,7 @@ updateIdealTargetCenter :: Time -> BulletMkI -> BulletMkI updateIdealTargetCenter t self = - let newLoc = M.idealNewLocation (wrapMap self) + let newLoc = M.newLocation (wrapMap self) (center self) (velocity self) t in diff --git a/Projectile/BulletSI.hs b/Projectile/BulletSI.hs --- a/Projectile/BulletSI.hs +++ b/Projectile/BulletSI.hs @@ -86,7 +86,7 @@ updateIdealTargetCenter :: Time -> BulletSI -> BulletSI updateIdealTargetCenter t self = - let newLoc = M.idealNewLocation (wrapMap self) + let newLoc = M.newLocation (wrapMap self) (center self) (velocity self) t in diff --git a/Projectile/BulletSII.hs b/Projectile/BulletSII.hs --- a/Projectile/BulletSII.hs +++ b/Projectile/BulletSII.hs @@ -89,7 +89,7 @@ updateIdealTargetCenter :: Time -> BulletSII -> BulletSII updateIdealTargetCenter t self = - let newLoc = M.idealNewLocation (wrapMap self) + let newLoc = M.newLocation (wrapMap self) (center self) (velocity self) t in diff --git a/Projectile/Cannon.hs b/Projectile/Cannon.hs --- a/Projectile/Cannon.hs +++ b/Projectile/Cannon.hs @@ -93,7 +93,7 @@ updateIdealTargetCenter :: Time -> Cannon -> Cannon updateIdealTargetCenter t self = - let newLoc = M.idealNewLocation (wrapMap self) + let newLoc = M.newLocation (wrapMap self) (center self) (velocity self) t in diff --git a/Projectile/Interceptor.hs b/Projectile/Interceptor.hs --- a/Projectile/Interceptor.hs +++ b/Projectile/Interceptor.hs @@ -12,7 +12,7 @@ import qualified Moving as M import GHC.Float import Common -import Trigonometry ( doubleRem +import Math ( remF , radToDeg ) import Data.Maybe @@ -69,13 +69,13 @@ p1 = defImage "interceptor-1.bmp" p2 = defImage "interceptor-2.bmp" p3 = defImage "interceptor-3.bmp" - rem = clock self `doubleRem` 0.3 + rem = clock self `remF` 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 + a = double2Float (radToDeg (angle self) * (-1) - 90) r = double2Float radiusC instance M.Colliding Interceptor where @@ -109,7 +109,7 @@ updateIdealTargetCenter :: Time -> Interceptor -> Interceptor updateIdealTargetCenter t self = - let newLoc = M.idealNewLocation (wrapMap self) + let newLoc = M.newLocation (wrapMap self) (center self) (velocity self) t in diff --git a/Projectile/Nuke.hs b/Projectile/Nuke.hs --- a/Projectile/Nuke.hs +++ b/Projectile/Nuke.hs @@ -105,7 +105,7 @@ updateIdealTargetCenter :: Time -> Nuke -> Nuke updateIdealTargetCenter t self = - let newLoc = M.idealNewLocation (wrapMap self) + let newLoc = M.newLocation (wrapMap self) (center self) (velocity self) t in diff --git a/Projectile/Pellet.hs b/Projectile/Pellet.hs --- a/Projectile/Pellet.hs +++ b/Projectile/Pellet.hs @@ -74,7 +74,7 @@ updateIdealTargetCenter :: Time -> Pellet -> Pellet updateIdealTargetCenter t self = - let newLoc = M.idealNewLocation (wrapMap self) + let newLoc = M.newLocation (wrapMap self) (center self) (velocity self) t in diff --git a/Projectile/SWForward.hs b/Projectile/SWForward.hs --- a/Projectile/SWForward.hs +++ b/Projectile/SWForward.hs @@ -83,7 +83,7 @@ updateIdealTargetCenter :: Time -> SWForward -> SWForward updateIdealTargetCenter t self = - let newLoc = M.idealNewLocation (wrapMap self) + let newLoc = M.newLocation (wrapMap self) (center self) (velocity self) t in diff --git a/Projectile/SWSide.hs b/Projectile/SWSide.hs --- a/Projectile/SWSide.hs +++ b/Projectile/SWSide.hs @@ -83,7 +83,7 @@ updateIdealTargetCenter :: Time -> SWSide -> SWSide updateIdealTargetCenter t self = - let newLoc = M.idealNewLocation (wrapMap self) + let newLoc = M.newLocation (wrapMap self) (center self) (velocity self) t in diff --git a/ResourceTracker.hs b/ResourceTracker.hs --- a/ResourceTracker.hs +++ b/ResourceTracker.hs @@ -1,39 +1,44 @@ module ResourceTracker ( ResourceTracker() + , RT , emptyResourceTracker , getImage , storeImage , getSound , storeSound + , protectedGetImage ) where -import Graphics.Gloss.Data.Picture (Picture) -import qualified Graphics.Gloss.Data.Picture as GP -import Data.Map (Map) -import qualified Data.Map as M --- import Control.Monad.State -import Sound.ALUT +import Graphics.Gloss.Data.Picture ( Picture (..) ) +import Graphics.Gloss.Data.Color ( white ) +import Data.Map ( Map + , empty + , insert + ) +import qualified Data.Map as M (lookup) +import Sound.ALUT (Buffer) +import Data.Maybe (fromMaybe) data ResourceTracker = ResourceTracker { images :: Map String Picture , sounds :: Map String Buffer --- , defaultSound :: Buffer } deriving (Show) -emptyResourceTracker = ResourceTracker { images = M.empty - , sounds = M.empty +type RT = ResourceTracker + +emptyResourceTracker = ResourceTracker { images = empty + , sounds = empty } -getImage :: ResourceTracker -> String -> Maybe Picture -getImage rt filename = M.lookup filename (images rt) +getImage r n = M.lookup n (images r) -storeImage :: ResourceTracker -> String -> Picture -> ResourceTracker -storeImage rt filename pic = let nimages = M.insert filename pic (images rt) in - rt { images = nimages } +storeImage r n p = r { images = insert n p (images r) } -getSound :: ResourceTracker -> String -> Maybe Buffer -getSound rt filename = M.lookup filename (sounds rt) +getSound r n = M.lookup n (sounds r) -storeSound :: ResourceTracker -> String -> Buffer -> ResourceTracker -storeSound rt filename buffer = let buffers' = M.insert filename buffer (sounds rt) in - rt { sounds = buffers' } +storeSound r n b = r { sounds = insert n b (sounds r) } +protectedGetImage a b = fromMaybe + (Scale 0.1 0.1 + (Color white + (Text "missing image"))) + (getImage a b) diff --git a/SpaceJunk.hs b/SpaceJunk.hs --- a/SpaceJunk.hs +++ b/SpaceJunk.hs @@ -2,13 +2,18 @@ module SpaceJunk where -import Animation -import Updating -import qualified Moving as M -import Combat +import Animation ( Animation (..) ) +import Updating ( InternallyUpdating (..) ) +import Moving ( Colliding (..) + , Moving (..) + , Locatable (..) + ) +import Combat ( Damaging (..) + , Damageable (..) + ) data SpaceJunk = forall a. ( InternallyUpdating a - , M.Colliding a + , Colliding a , Damaging a , Damageable a , Animation a @@ -24,16 +29,16 @@ preUpdate (SpaceJunk a) et = SpaceJunk (preUpdate a et) postUpdate (SpaceJunk a) et = SpaceJunk (postUpdate a et) -instance M.Colliding SpaceJunk where +instance Colliding SpaceJunk where - collisionRadius (SpaceJunk a) = M.collisionRadius a + collisionRadius (SpaceJunk a) = collisionRadius a -instance M.Moving SpaceJunk where +instance Moving SpaceJunk where - velocity (SpaceJunk a) = M.velocity a + velocity (SpaceJunk a) = velocity a -instance M.Locatable SpaceJunk where - center (SpaceJunk a) = M.center a +instance Locatable SpaceJunk where + center (SpaceJunk a) = center a instance Animation SpaceJunk where image (SpaceJunk a) = image a diff --git a/Trigonometry.hs b/Trigonometry.hs deleted file mode 100644 --- a/Trigonometry.hs +++ /dev/null @@ -1,57 +0,0 @@ -module Trigonometry where - -import Data.Maybe - -radToDeg :: Floating a => a -> a -radToDeg x = x * 180 / pi - -mulSV :: Double -> (Double, Double) -> (Double, Double) -mulSV s (x, y) = (s * x, s * y) - -distance :: (Double, Double) -> (Double, Double) -> Double -distance (x1, y1) (x2, y2) = sqrt ((x2 - x1)**2 + (y2 - y1)**2) - -normAngle :: Double -> Double -- radians -normAngle x = if x >= 0 then asin (sin x) - else 2 * pi + asin (sin x) - -vectorDirection :: (Double, Double) -- vector - -> Double -- angle in radians -vectorDirection (0, 0) = 0.0 / 0.0 -- NaN -vectorDirection (x, y) - | x >= 0 && y >= 0 = a - | x < 0 && y >= 0 = pi - a - | x < 0 && y < 0 = pi + a - | otherwise = 2 * pi - a - where a = atan (abs y / abs x) - --- let x = 2 * pi + pi / 2 in asin (sin x) --- let x = (- (2*pi)) + (- (pi / 2)) in 2*pi + asin (sin x) - -{- - Assumes source (origin of projectile) is at origin of grid (0, 0) and so - target center is relative to this. Assumes source is stationary and so - velocity of target is relative to source. --} -targetingA :: Double -> (Double, Double) -> (Double, Double) -> Double -targetingA pSpeed tCenter tVelocity = targetingA' - pSpeed tCenter tVelocity Nothing 3 - - where targetingA' pSpeed oCenter tVelocity nCenter iter = - let eCenter = fromMaybe oCenter nCenter in - let d = distance (0, 0) eCenter in - let t = d / pSpeed in - let aCenter = addV oCenter (mulSV t tVelocity) in - if iter > 0 - then targetingA' pSpeed oCenter tVelocity (Just aCenter) (iter - 1) - else vectorDirection aCenter - -addV :: (Double, Double) -> (Double, Double) -> (Double, Double) -addV (x1, y1) (x2, y2) = (x1 + x2, y1 + y2) - -subV :: (Double, Double) -> (Double, Double) -> (Double, Double) -subV (x1, y1) (x2, y2) = (x1 - x2, y1 - y2) - -doubleRem :: Double -> Double -> Double -doubleRem x y = let a = x / y in - (a - (fromIntegral (truncate a))) * y diff --git a/Unit.hs b/Unit.hs --- a/Unit.hs +++ b/Unit.hs @@ -4,10 +4,21 @@ , SmartUnit (..) ) where -import Animation -import Moving -import Combat -import Updating +import Animation ( Audible (..) + , Animation (..) + ) +import Moving ( Locatable (..) + , Colliding (..) + , Moving (..) + ) +import Combat ( Damaging (..) + , Damageable (..) + , Launcher (..) + ) +import Updating ( Transient (..) + , InternallyUpdating (..) + , Observant (..) + ) -- Simple, i.e., no sensory awareness and related A.I. data SimpleUnit = forall a. ( Animation a diff --git a/Unit/Simple/Turret.hs b/Unit/Simple/Turret.hs --- a/Unit/Simple/Turret.hs +++ b/Unit/Simple/Turret.hs @@ -7,7 +7,7 @@ import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.Color import GHC.Float -import Trigonometry +import Math import ResourceTracker import Updating import qualified Moving as M @@ -112,10 +112,10 @@ = self { turretAngle = turretAngle self - radialVelocity * t} instance Animation Turret where - image self _ = Rotate (radToDeg - (double2Float - (turretAngle self)) * (-1) - 90) - (animDefault0 self) + image self _ = Rotate + (double2Float + (radToDeg ((turretAngle self)) * (-1) - 90)) + (animDefault0 self) instance M.Locatable Turret where center = center @@ -156,7 +156,7 @@ updateIdealTargetLocation :: Time -> Turret -> Turret updateIdealTargetLocation t self = - self { idealTargetLocation = Just (M.idealNewLocation (wrapMap self) + self { idealTargetLocation = Just (M.newLocation (wrapMap self) (center self) (velocity self) t) diff --git a/Unit/Smart/ATank.hs b/Unit/Smart/ATank.hs --- a/Unit/Smart/ATank.hs +++ b/Unit/Smart/ATank.hs @@ -7,7 +7,7 @@ import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.Color import GHC.Float -import Trigonometry +import Math import ResourceTracker import Updating import qualified Moving as M @@ -126,7 +126,7 @@ updateVelocity :: Time -> ATank -> ATank updateVelocity t self = - self { velocity = M.calcNewVelocity + self { velocity = M.newVelocity (velocity self) accelerationRate (angle self) @@ -135,8 +135,8 @@ } instance Animation ATank where - image self _ = Rotate (radToDeg - (double2Float + image self _ = Rotate (double2Float + (radToDeg (angle self)) * (-1) - 90) pic where pic = fromMaybe @@ -195,7 +195,7 @@ updateIdealTargetLocation :: Time -> ATank -> ATank updateIdealTargetLocation t self = - self { idealTargetLocation = Just (M.idealNewLocation (wrapMap self) + self { idealTargetLocation = Just (M.newLocation (wrapMap self) (center self) (velocity self) t) diff --git a/Unit/Smart/Death.hs b/Unit/Smart/Death.hs --- a/Unit/Smart/Death.hs +++ b/Unit/Smart/Death.hs @@ -7,7 +7,7 @@ import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.Color import GHC.Float -import Trigonometry +import Math import ResourceTracker import Updating import qualified Moving as M @@ -135,7 +135,7 @@ self { angle = angle self + adj } updateVelocity t self = - let thrustingVelocity = M.calcNewVelocity + let thrustingVelocity = M.newVelocity (velocity self) accelerationRate (angle self) @@ -251,7 +251,7 @@ updateIdealTargetLocation :: Time -> Death -> Death updateIdealTargetLocation t self = - self { idealTargetLocation = Just (M.idealNewLocation (wrapMap self) + self { idealTargetLocation = Just (M.newLocation (wrapMap self) (center self) (velocity self) t) diff --git a/Unit/Smart/Master.hs b/Unit/Smart/Master.hs --- a/Unit/Smart/Master.hs +++ b/Unit/Smart/Master.hs @@ -7,7 +7,7 @@ import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.Color import GHC.Float -import Trigonometry +import Math import ResourceTracker import Updating import qualified Moving as M @@ -141,7 +141,7 @@ updateVelocity :: Time -> Master -> Master updateVelocity t self = - let thrustingVelocity = M.calcNewVelocity + let thrustingVelocity = M.newVelocity (velocity self) accelerationRate (angle self) @@ -167,8 +167,8 @@ self { velocity = velocity' } instance Animation Master where - image self _ = Rotate (radToDeg - (double2Float + image self _ = Rotate (double2Float + (radToDeg (angle self)) * (-1) - 90) currentPic where defaultPic = fromMaybe @@ -247,7 +247,7 @@ updateIdealTargetLocation :: Time -> Master -> Master updateIdealTargetLocation t self = - self { idealTargetLocation = Just (M.idealNewLocation (wrapMap self) + self { idealTargetLocation = Just (M.newLocation (wrapMap self) (center self) (velocity self) t) diff --git a/Unit/Smart/Ninja.hs b/Unit/Smart/Ninja.hs --- a/Unit/Smart/Ninja.hs +++ b/Unit/Smart/Ninja.hs @@ -7,7 +7,7 @@ import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.Color import GHC.Float -import Trigonometry +import Math import ResourceTracker import Updating import qualified Moving as M @@ -132,7 +132,7 @@ updateVelocity :: Time -> Ninja -> Ninja updateVelocity t self = - let thrustingVelocity = M.calcNewVelocity + let thrustingVelocity = M.newVelocity (velocity self) accelerationRate (angle self) @@ -158,8 +158,8 @@ self { velocity = velocity' } instance Animation Ninja where - image self _ = Rotate (radToDeg - (double2Float + image self _ = Rotate (double2Float + (radToDeg (angle self)) * (-1) - 90) pic where pic = fromMaybe @@ -224,7 +224,7 @@ updateIdealTargetLocation :: Time -> Ninja -> Ninja updateIdealTargetLocation t self = - self { idealTargetLocation = Just (M.idealNewLocation (wrapMap self) + self { idealTargetLocation = Just (M.newLocation (wrapMap self) (center self) (velocity self) t) diff --git a/Unit/Smart/STank.hs b/Unit/Smart/STank.hs --- a/Unit/Smart/STank.hs +++ b/Unit/Smart/STank.hs @@ -7,7 +7,7 @@ import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.Color import GHC.Float -import Trigonometry +import Math import ResourceTracker import Updating import qualified Moving as M @@ -128,7 +128,7 @@ updateVelocity :: Time -> STank -> STank updateVelocity t self = - self { velocity = M.calcNewVelocity + self { velocity = M.newVelocity (velocity self) accelerationRate (angle self) @@ -137,8 +137,8 @@ } instance Animation STank where - image self _ = Rotate (radToDeg - (double2Float + image self _ = Rotate (double2Float + (radToDeg (angle self)) * (-1) - 90) pic where pic = fromMaybe @@ -212,7 +212,7 @@ updateIdealTargetLocation :: Time -> STank -> STank updateIdealTargetLocation t self = - self { idealTargetLocation = Just (M.idealNewLocation (wrapMap self) + self { idealTargetLocation = Just (M.newLocation (wrapMap self) (center self) (velocity self) t) diff --git a/Unit/Smart/Saucer.hs b/Unit/Smart/Saucer.hs --- a/Unit/Smart/Saucer.hs +++ b/Unit/Smart/Saucer.hs @@ -7,7 +7,7 @@ import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.Color import GHC.Float -import Trigonometry +import Math import ResourceTracker import Updating import qualified Moving as M @@ -135,7 +135,7 @@ updateVelocity :: Time -> Saucer -> Saucer updateVelocity t self = - let thrustingVelocity = M.calcNewVelocity + let thrustingVelocity = M.newVelocity (velocity self) accelerationRate (angle self) @@ -229,7 +229,7 @@ updateIdealTargetLocation :: Time -> Saucer -> Saucer updateIdealTargetLocation t self = - self { idealTargetLocation = Just (M.idealNewLocation (wrapMap self) + self { idealTargetLocation = Just (M.newLocation (wrapMap self) (center self) (velocity self) t) diff --git a/Unit/Smart/Sniper.hs b/Unit/Smart/Sniper.hs --- a/Unit/Smart/Sniper.hs +++ b/Unit/Smart/Sniper.hs @@ -7,7 +7,7 @@ import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.Color import GHC.Float -import Trigonometry +import Math import ResourceTracker import Updating import qualified Moving as M @@ -130,7 +130,7 @@ updateVelocity :: Time -> Sniper -> Sniper updateVelocity t self = - self { velocity = M.calcNewVelocity + self { velocity = M.newVelocity (velocity self) accelerationRate (angle self) @@ -139,8 +139,8 @@ } instance Animation Sniper where - image self _ = Rotate (radToDeg - (double2Float + image self _ = Rotate (double2Float + (radToDeg (angle self)) * (-1) - 90) pic where pic = fromMaybe @@ -204,7 +204,7 @@ updateIdealTargetLocation :: Time -> Sniper -> Sniper updateIdealTargetLocation t self = - self { idealTargetLocation = Just (M.idealNewLocation (wrapMap self) + self { idealTargetLocation = Just (M.newLocation (wrapMap self) (center self) (velocity self) t) diff --git a/Unit/Smart/Tank.hs b/Unit/Smart/Tank.hs --- a/Unit/Smart/Tank.hs +++ b/Unit/Smart/Tank.hs @@ -7,7 +7,7 @@ import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.Color import GHC.Float -import Trigonometry +import Math import ResourceTracker import Updating import qualified Moving as M @@ -126,7 +126,7 @@ updateVelocity :: Time -> Tank -> Tank updateVelocity t self = - self { velocity = M.calcNewVelocity + self { velocity = M.newVelocity (velocity self) accelerationRate (angle self) @@ -135,8 +135,8 @@ } instance Animation Tank where - image self _ = Rotate (radToDeg - (double2Float + image self _ = Rotate (double2Float + (radToDeg (angle self)) * (-1) - 90) pic where pic = fromMaybe @@ -195,7 +195,7 @@ updateIdealTargetLocation :: Time -> Tank -> Tank updateIdealTargetLocation t self = - self { idealTargetLocation = Just (M.idealNewLocation (wrapMap self) + self { idealTargetLocation = Just (M.newLocation (wrapMap self) (center self) (velocity self) t) diff --git a/Unit/Smart/Zeus.hs b/Unit/Smart/Zeus.hs --- a/Unit/Smart/Zeus.hs +++ b/Unit/Smart/Zeus.hs @@ -7,7 +7,7 @@ import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.Color import GHC.Float -import Trigonometry +import Math import ResourceTracker import Updating import qualified Moving as M @@ -134,8 +134,8 @@ (Color white (Text "Error! Missing image!"))) (getImage rt "zeus-cannon.bmp") - tpic' = Rotate (radToDeg - (double2Float + tpic' = Rotate (double2Float + (radToDeg (angle self)) * (-1) - 90) tpic rt = resourceTracker self diff --git a/Updating.hs b/Updating.hs --- a/Updating.hs +++ b/Updating.hs @@ -3,20 +3,19 @@ import {-# SOURCE #-} AfterEffect ( AfterEffect ) import {-# SOURCE #-} Universe ( Arena ) -import Common +import Common (Time) class InternallyUpdating a where preUpdate :: a -> Time -> a postUpdate :: a -> Time -> a -{- +{-| Objects that exist temporarily or that may die after being wounded a certain amount. Should be used for objects whose continued existence depends on some internal variable, e.g., a lifeforce or countdown that may reach zero. -} class (InternallyUpdating a) => Transient a where - {- Whether or not the object should be removed from existence -} expired' :: a -> Maybe [AfterEffect] class (InternallyUpdating a) => SimpleTransient a where 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.14 +Version: 0.8.16 -- A short (one-line) description of the package. Synopsis: Top view space combat arcade game @@ -62,7 +62,7 @@ Default-language: Haskell2010 -- Packages needed in order to build this package. Build-depends: gloss >= 1.7.4.1 && < 1.8 - , wraparound >= 0.0.1.1 && < 0.1 + , wraparound >= 0.0.2 && < 0.1 , base >= 4 && < 5 , containers >= 0.4.2.1 && < 0.6 , ALUT >= 2.2 && < 2.3 @@ -73,7 +73,7 @@ , Asteroid , BigAsteroid , Common - , Trigonometry + , Math , Animation , Star , Paths_edge