edge 0.8.14 → 0.8.16
raw patch · 39 files changed
+630/−630 lines, 39 filesdep ~wraparound
Dependency ranges changed: wraparound
Files
- AfterEffect/SimpleExplosion.hs +1/−1
- Animation.hs +50/−8
- Asteroid.hs +32/−49
- BigAsteroid.hs +34/−50
- Combat.hs +47/−35
- Common.hs +23/−1
- Display.hs +2/−2
- Item.hs +29/−26
- Lance.hs +101/−230
- Math.hs +103/−0
- Moving.hs +86/−69
- Projectile/Blade.hs +3/−3
- Projectile/BulletMI.hs +1/−1
- Projectile/BulletMII.hs +1/−1
- Projectile/BulletMkI.hs +1/−1
- Projectile/BulletSI.hs +1/−1
- Projectile/BulletSII.hs +1/−1
- Projectile/Cannon.hs +1/−1
- Projectile/Interceptor.hs +4/−4
- Projectile/Nuke.hs +1/−1
- Projectile/Pellet.hs +1/−1
- Projectile/SWForward.hs +1/−1
- Projectile/SWSide.hs +1/−1
- ResourceTracker.hs +24/−19
- SpaceJunk.hs +16/−11
- Trigonometry.hs +0/−57
- Unit.hs +15/−4
- Unit/Simple/Turret.hs +6/−6
- Unit/Smart/ATank.hs +5/−5
- Unit/Smart/Death.hs +3/−3
- Unit/Smart/Master.hs +5/−5
- Unit/Smart/Ninja.hs +5/−5
- Unit/Smart/STank.hs +5/−5
- Unit/Smart/Saucer.hs +3/−3
- Unit/Smart/Sniper.hs +5/−5
- Unit/Smart/Tank.hs +5/−5
- Unit/Smart/Zeus.hs +3/−3
- Updating.hs +2/−3
- edge.cabal +3/−3
AfterEffect/SimpleExplosion.hs view
@@ -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
Animation.hs view
@@ -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
Asteroid.hs view
@@ -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
BigAsteroid.hs view
@@ -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+
Combat.hs view
@@ -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
Common.hs view
@@ -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
Display.hs view
@@ -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
Item.hs view
@@ -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
Lance.hs view
@@ -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))
+ Math.hs view
@@ -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)
Moving.hs view
@@ -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)
Projectile/Blade.hs view
@@ -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
Projectile/BulletMI.hs view
@@ -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
Projectile/BulletMII.hs view
@@ -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
Projectile/BulletMkI.hs view
@@ -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
Projectile/BulletSI.hs view
@@ -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
Projectile/BulletSII.hs view
@@ -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
Projectile/Cannon.hs view
@@ -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
Projectile/Interceptor.hs view
@@ -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
Projectile/Nuke.hs view
@@ -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
Projectile/Pellet.hs view
@@ -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
Projectile/SWForward.hs view
@@ -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
Projectile/SWSide.hs view
@@ -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
ResourceTracker.hs view
@@ -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)
SpaceJunk.hs view
@@ -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
− Trigonometry.hs
@@ -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
Unit.hs view
@@ -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
Unit/Simple/Turret.hs view
@@ -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)
Unit/Smart/ATank.hs view
@@ -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)
Unit/Smart/Death.hs view
@@ -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)
Unit/Smart/Master.hs view
@@ -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)
Unit/Smart/Ninja.hs view
@@ -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)
Unit/Smart/STank.hs view
@@ -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)
Unit/Smart/Saucer.hs view
@@ -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)
Unit/Smart/Sniper.hs view
@@ -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)
Unit/Smart/Tank.hs view
@@ -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)
Unit/Smart/Zeus.hs view
@@ -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
Updating.hs view
@@ -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
edge.cabal view
@@ -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