diff --git a/AfterEffect.hs b/AfterEffect.hs --- a/AfterEffect.hs +++ b/AfterEffect.hs @@ -2,9 +2,9 @@ module AfterEffect ( AfterEffect (..) ) where -import Animation -import Updating -import Moving +import Animation (Audible(..), Animation(..)) +import Updating (InternallyUpdating(..), Transient(..)) +import Moving (Locatable(..)) data AfterEffect = forall a. ( Animation a @@ -12,7 +12,6 @@ , Transient a , Audible a ) => AfterEffect a - -- to be expanded algebraically instance InternallyUpdating AfterEffect where preUpdate (AfterEffect a) et = AfterEffect (preUpdate a et) @@ -23,9 +22,9 @@ expired' (AfterEffect a) = expired' a instance Audible AfterEffect where - processAudio (AfterEffect a) wp = do a' <- processAudio a wp - return (AfterEffect a') + processAudio (AfterEffect a) c = do b <- processAudio a c + return (AfterEffect b) - terminateAudio (AfterEffect a) = do a' <- terminateAudio a - return (AfterEffect a') + terminateAudio (AfterEffect a) = do b <- terminateAudio a + return (AfterEffect b) diff --git a/AfterEffect/MineExplosion.hs b/AfterEffect/MineExplosion.hs --- a/AfterEffect/MineExplosion.hs +++ b/AfterEffect/MineExplosion.hs @@ -12,76 +12,50 @@ import GHC.Float import Common -data MineExplosion = - MineExplosion { center :: WrapPoint - , timeRemaining :: Time - , soundSource :: Maybe Source - , wrapMap :: WrapMap - , resourceTracker :: ResourceTracker - , animClock :: Time - } +data MineExplosion = MineExplosion { center :: WP + , timeRemaining :: Time + , sndSrc :: Maybe Source + , wmap :: WM + , rt :: RT + , animClock :: Time + } -new :: ResourceTracker -> WrapMap -> WrapPoint -> MineExplosion -new rt wmap center' = - MineExplosion { center = center' - , timeRemaining = 3.0 - , soundSource = Nothing - , wrapMap = wmap - , resourceTracker = rt - , animClock = 0.0 - } +new a b c = MineExplosion { center = c + , timeRemaining = 3 + , sndSrc = Nothing + , wmap = b + , rt = a + , animClock = 0 + } instance Animation MineExplosion where - image self t = - let dFrame = Color white (Scale 0.10 0.10 (Text "boom!")) in - let rt = resourceTracker self in - let at = animClock self in - if at < 0.1 then fromMaybe dFrame $ getImage rt "mine-explosion.bmp" - else Blank + image s t = + if animClock s < 0.1 + then fromMaybe (Color white (Scale 0.10 0.10 (Text "boom!"))) + (getImage (rt s) "mine-explosion.bmp") + else Blank instance M.Locatable MineExplosion where center = center instance Transient MineExplosion where - expired' self = if timeRemaining self <= 0.0 - then Just [] - else Nothing + expired' s = if timeRemaining s <= 0 then Just [] else Nothing instance InternallyUpdating MineExplosion where - preUpdate self t = self { timeRemaining = timeRemaining self - t } + preUpdate s t = s { timeRemaining = timeRemaining s - t } - postUpdate self t = self { animClock = animClock self + t } + postUpdate s t = s { animClock = animClock s + t } instance Audible MineExplosion where - processAudio self lcenter = - if isNothing (soundSource self) - then do self' <- initializeSoundSource self - let (x, y) = vectorRelation - (wrapMap self') - (lcenter) - (center self') - let s = fromJust $ soundSource self' - sourcePosition s $= (Vertex3 (double2Float x) - (double2Float (-y)) - 0) - play [s] - return self' - else return self + processAudio s a = + procOneTimeSnd + s sndSrc a rt "explosion.wav" 0.5 wmap (\x y -> x { sndSrc = y }) - terminateAudio self = - if isNothing (soundSource self) - then return self - else do stop [fromJust (soundSource self)] - return self + terminateAudio s = if isNothing (sndSrc s) + then return s + else do stop [fromJust (sndSrc s)] + return s -initializeSoundSource self = - do [source] <- genObjectNames 1 - buffer source $= getSound (resourceTracker self) "explosion.wav" - sourceRelative source $= Listener - referenceDistance source $= audioReferenceDistance - rolloffFactor source $= audioRolloffFactor - sourceGain source $= 0.5 - return self { soundSource = Just source } diff --git a/AfterEffect/SimpleExplosion.hs b/AfterEffect/SimpleExplosion.hs --- a/AfterEffect/SimpleExplosion.hs +++ b/AfterEffect/SimpleExplosion.hs @@ -12,97 +12,63 @@ import GHC.Float import Common -data SimpleExplosion = - SimpleExplosion { center :: WrapPoint - , timeRemaining :: Time - , soundSource :: Maybe Source - , wrapMap :: WrapMap - , resourceTracker :: ResourceTracker - , animClock :: Time - , velocity :: Velocity - } +data SimpleExplosion = SimpleExplosion { center :: WP + , timeRemaining :: Time + , sndSrc :: Maybe Source + , wmap :: WM + , rt :: RT + , animClock :: Time + , velocity :: Velocity + } -new :: ResourceTracker -> WrapMap -> WrapPoint -> Velocity -> SimpleExplosion -new rt wmap center' velocity' = - SimpleExplosion { center = center' - , timeRemaining = 3.0 - , soundSource = Nothing - , wrapMap = wmap - , resourceTracker = rt - , animClock = 0.0 - , velocity = velocity' - } +new a b c d = SimpleExplosion { center = c + , timeRemaining = 3.0 + , sndSrc = Nothing + , wmap = b + , rt = a + , animClock = 0.0 + , velocity = d + } instance Animation SimpleExplosion where - image self t = - let dFrame = Color white (Scale 0.10 0.10 (Text "boom!")) in - let rt = resourceTracker self in - let f00 = fromMaybe dFrame $ getImage rt "explosion-00.bmp" in - let f01 = fromMaybe dFrame $ getImage rt "explosion-01.bmp" in - let f02 = fromMaybe dFrame $ getImage rt "explosion-02.bmp" in - let f03 = fromMaybe dFrame $ getImage rt "explosion-03.bmp" in - let f04 = fromMaybe dFrame $ getImage rt "explosion-04.bmp" in - let f05 = fromMaybe dFrame $ getImage rt "explosion-05.bmp" in - let f06 = fromMaybe dFrame $ getImage rt "explosion-06.bmp" in - let at = animClock self in - let fspace = 0.07 in - if at < fspace * 1 then f00 - else if at < fspace * 2 then f01 - else if at < fspace * 3 then f02 - else if at < fspace * 4 then f03 - else if at < fspace * 5 then f04 - else if at < fspace * 6 then f05 - else if at < fspace * 7 then f06 + image s t = + if g 1 then f "explosion-00.bmp" + else if g 2 then f "explosion-01.bmp" + else if g 3 then f "explosion-02.bmp" + else if g 4 then f "explosion-03.bmp" + else if g 5 then f "explosion-04.bmp" + else if g 6 then f "explosion-05.bmp" + else if g 7 then f "explosion-06.bmp" else Blank + where f b = fromMaybe + (Color white (Scale 0.10 0.10 (Text "boom!"))) + (getImage (rt s) b) + g x = (animClock s < 0.07 * x) instance M.Locatable SimpleExplosion where center = center instance Transient SimpleExplosion where - expired' self = if timeRemaining self <= 0.0 - then Just [] - else Nothing + expired' s = if timeRemaining s <= 0 then Just [] else Nothing instance InternallyUpdating SimpleExplosion where - preUpdate self t = self { timeRemaining = timeRemaining self - t - , center = M.newLocation (wrapMap self) - (center self) - (velocity self) - t - } + preUpdate s t = s { timeRemaining = timeRemaining s - t + , center = M.newLocation (wmap s) + (center s) + (velocity s) t + } - postUpdate self t = self { animClock = animClock self + t } + postUpdate s t = s { animClock = animClock s + t } instance Audible SimpleExplosion where - processAudio self lcenter = - if isNothing (soundSource self) - then do self' <- initializeSoundSource self - let (x, y) = vectorRelation - (wrapMap self') - (lcenter) - (center self') - let s = fromJust $ soundSource self' - sourcePosition s $= (Vertex3 (double2Float x) - (double2Float (-y)) - 0) - play [s] - return self' - else return self - - terminateAudio self = - if isNothing (soundSource self) - then return self - else do stop [fromJust (soundSource self)] - return self + processAudio s a = + procOneTimeSnd + s sndSrc a rt "explosion.wav" 0.5 wmap (\x y -> x { sndSrc = y }) -initializeSoundSource self = - do [source] <- genObjectNames 1 - buffer source $= getSound (resourceTracker self) "explosion.wav" - sourceRelative source $= Listener - referenceDistance source $= audioReferenceDistance - rolloffFactor source $= audioRolloffFactor - sourceGain source $= 0.5 - return self { soundSource = Just source } + terminateAudio s = if isNothing (sndSrc s) + then return s + else do stop [fromJust (sndSrc s)] + return s diff --git a/Animation.hs b/Animation.hs --- a/Animation.hs +++ b/Animation.hs @@ -1,7 +1,7 @@ module Animation where -import Graphics.Gloss.Data.Picture ( Picture(..) ) -import Data.WrapAround (WP) +import Graphics.Gloss.Data.Picture (Picture(..)) +import Data.WrapAround (WP, vectorRelation, WM, WP) import Sound.ALUT ( DistanceModel(InverseDistanceClamped) , Source , ($=) @@ -9,11 +9,20 @@ , stop , genObjectNames , buffer + , sourcePosition + , Vertex3(..) + , sourceRelative + , referenceDistance + , rolloffFactor + , sourceGain + , SourceRelative(..) ) -import ResourceTracker +import ResourceTracker (RT, getSound) import Common (Time) import GHC.Float ( double2Float ) import Math ( radToDeg ) +import Moving (center, Locatable(..)) +import Data.Maybe (isNothing, fromJust) class Animation a where image :: a -> Time -> Picture @@ -45,18 +54,25 @@ -> (a -> RT) -- ^ func which gets resource tracker -> String -- ^ name of sound file -> (a -> Source -> a) -- ^ func which sets source in object + -> WP -- ^ listener center point + -> WM -- ^ wrap map shared between listener and object + -> (a -> WP) -- ^ func which receives center point of object -> IO a -- |Abstraction for playing a sound source when queued. -handSndSrc a f h i k e l +handSndSrc a f h i k e l m n q = do if f a then g a else return a where g b = do case h b of - Just x -> do play [x] + Just x -> do sourcePosition x $= (Vertex3 (double2Float u) + (double2Float (-v)) 0) + play [x] return (i b) Nothing -> do j b >>= g j d = do [c] <- genObjectNames 1 buffer c $= getSound (k d) e + referenceDistance c $= audioReferenceDistance return (l d c) + (u, v) = vectorRelation n m (q a) -- |Abstraction for terminating a sound source in an object. termSndSrc @@ -71,3 +87,31 @@ -- |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 + +procOneTimeSnd + :: (Locatable a) + => a -- ^ object + -> (a -> Maybe Source) -- ^ func that retrieves Source from object + -> WP -- ^ listener's center + -> (a -> RT) -- ^ func that retrieves object's resource tracker + -> String -- ^ name of sound file + -> Float -- ^ source gain + -> (a -> WM) -- ^ func that retrieves object's wrap map + -> (a -> Maybe Source -> a) -- ^ func that sets object's source + -> IO a +procOneTimeSnd s f a h d e i j = + if isNothing (f s) + then do c <- g s + let (x, y) = vectorRelation (i c) a (center c) + let b = fromJust $ f c + sourcePosition b $= Vertex3 (double2Float x) (double2Float (-y)) 0 + play [b] + return c + else return s + where g t = do [u] <- genObjectNames 1 + buffer u $= getSound (h t) d + sourceRelative u $= Listener + referenceDistance u $= audioReferenceDistance + rolloffFactor u $= audioRolloffFactor + sourceGain u $= e + return (j t (Just u)) diff --git a/Combat.hs b/Combat.hs --- a/Combat.hs +++ b/Combat.hs @@ -89,7 +89,7 @@ -- , Damaging b -- , Damageable b -- , Colliding b --- ) => WrapMap -> Double -> [a] -> [b] -> ([a], [b]) +-- ) => WM -> Double -> [a] -> [b] -> ([a], [b]) handleCollisionDamage' :: (Colliding t, Colliding a, Damageable a, Damageable t, diff --git a/Display.hs b/Display.hs --- a/Display.hs +++ b/Display.hs @@ -7,6 +7,7 @@ import Lance import Data.Maybe import Moving +import qualified Moving as M import Star import Data.WrapAround import Graphics.Gloss.Interface.IO.Game @@ -22,129 +23,103 @@ data Displayable = forall a. (Locatable a, Animation a) => Displayable a displayUniverse u - = let arena' = arena u in - let wmap = Universe.wrapMap arena' in - let pactiv x y = if panelActivationTimer u < x - then Blank - else y in - let pship = do lance' <- lance arena' - Just (image lance' undefined) in - let pship' = fromMaybe Blank pship in - let viewCenterWp = focus arena' in - let displayables = - do (Displayable displayable) - <- map Displayable stars - ++ map Displayable (asteroids arena') - ++ [ Displayable a - | Projectile a <- lanceProjectiles arena' - ++ unitProjectiles arena' - ] - ++ [ case effect of - AfterEffect a -> Displayable a - | effect <- afterFX arena' ] - ++ [ Displayable a | SimpleUnit a <- simpleUnits arena' ] - ++ [ Displayable a | SmartUnit a <- smartUnits arena' ] - ++ [ Displayable a | a <- items arena' ] - let wp = Moving.center displayable in - let (x, y) = vectorRelation wmap wp viewCenterWp in - let pic = image displayable undefined in - [ Translate (double2Float x) (double2Float y) pic ] in - let sigmaPic = fromMaybe Blank (getImage (resourceTracker u) "item-sigma.bmp") in - let sigmaOverlays = - case lance arena' of - Nothing -> [] - Just l -> if all id (inventory l) - then [ let (x, y) = - vectorRelation - wmap - (Moving.center a) - viewCenterWp in - Translate - (double2Float x) - (double2Float y) - sigmaPic - | a <- items arena' - , case a of - (Item Health _ _) -> False - otherwise -> True - ] - else [] in - let lanceLives x = if isNothing (lance arena') - then Blank else x in - let deflectorBar' = Translate 65.0 370.0 - (case lance arena' of - Just x -> deflectorBar (deflectorCharge x) - Nothing -> deflectorBar 0.8 - ) in - let deflectorText' = Translate (-65.0) 365.0 deflectorText in - let levelText = Translate 140.0 365.0 - (Color white - (Scale 0.14 0.14 - (Text ("level " ++ show (level u + 1))))) in - let livesText = Translate (-140.0) 365.0 - (Color white - (Scale 0.14 0.14 - (Text (show (lives u) ++ " lives")))) in - let godText = case lance arena' of - Nothing -> Blank - Just l -> if not (godMode l) - then Blank - else Translate (-20.0) 335.0 - (Color yellow - (Scale 0.14 0.14 - (Text "god mode"))) in - let integrityText = Translate (-500.0) 365.0 - (Color white - (Scale 0.14 0.14 - (Text "structural integrity"))) in - let integrityAssessment = - case lance arena' of - Nothing -> Blank - Just l -> if integrity l >= 3.0 - then Color green (Text "optimal") - else if integrity l >= 2.0 - then Color yellow (Text "light damage") - else Color red (Text "heavy damage") in - let integrityTextL2 = Translate (-330.0) 365.0 - (Scale 0.14 0.14 - integrityAssessment) in - let sP = Translate 420.0 300.0 - (sensorPanel arena' (150.0, 150.0)) in - let levelMessage = case levelMessageTimer u of - Nothing -> Blank - Just mt -> if mt `remF` 0.5 < 0.25 - then Blank - else Translate (-200.0) 150.0 - (Text - ("level " - ++ show (level u + 1))) in - let sgt x y = if startGameTimer u < x then y else Blank in - return $ Pictures $ displayables - ++ sigmaOverlays - ++ [ pship' - , lanceLives $ pactiv 0.5 deflectorText' - , lanceLives $ pactiv 0.5 deflectorBar' - , lanceLives $ pactiv 0.5 levelText - , lanceLives $ pactiv 0.5 livesText - , lanceLives $ pactiv 1.5 sP - , godText - , lanceLives $ pactiv 1.0 integrityText - , lanceLives $ pactiv 1.0 integrityTextL2 - , lanceLives $ Translate (-400.0) 340.0 - (inventoryDisplay - (lance arena') - (resourceTracker u)) - , lanceLives $ levelMessage - , pactiv 2.0 $ sgt 20.0 $ Translate - (-450.0) - (-230.0) - helpColumn2 - , pactiv 2.0 $ sgt 20.0 $ Translate - (-470.0) - (-320.0) - helpColumn1 - ] + = return $ Pictures $ + [ let (x, y) = k displayable in + let pic = image displayable undefined in + Translate (double2Float x) (double2Float y) pic + | (Displayable displayable) <- map Displayable stars + ++ map Displayable (asteroids r) + ++ [ Displayable a + | Projectile a <- lanceProjectiles r ++ unitProjectiles r + ] + ++ [ case effect of AfterEffect a -> Displayable a + | effect <- afterFX r ] + ++ [ Displayable a | SimpleUnit a <- simpleUnits r ] + ++ [ Displayable a | SmartUnit a <- smartUnits r ] + ++ [ Displayable a | a <- items r ] + , let (x, y) = k displayable in + abs x <= 700 && abs y <= 600 + ] + ++ case lance r of + Nothing -> [] + Just l -> if all id (inventory l) + then [ let (x, y) = vectorRelation w + (M.center a) + (focus r) in + Translate + (double2Float x) + (double2Float y) + s + | a <- items r + , case a of + (Item Health _ _) -> False + otherwise -> True + ] + else [] + ++ [ fromMaybe Blank (do lance' <- lance r + Just (image lance' undefined)) + , f 0.5 (Translate (-65) 365 deflectorText) + , f 0.5 (Translate 65.0 370.0 $ + case lance r of + Just x -> deflectorBar (deflectorCharge x) + Nothing -> deflectorBar 0.8) + , f 0.5 (Translate 140.0 365.0 (levelText (level u))) + , f 0.5 (Translate (-140) 365 (livesText (lives u))) + , f 1.5 (Translate 420 300 + (sensorPanel r (150, 150))) + , case lance r of + Nothing -> Blank + Just l -> if not (godMode l) + then Blank + else Translate (-20) 335 godText + , f 1 (Translate (-500) 365 + (Color white + (Scale 0.14 0.14 (Text "structural integrity")))) + , f 1 (case lance r of + Nothing -> Blank + Just l -> Translate (-330) 365 + (Scale 0.14 0.14 + (integrityAssessment (integrity l)))) + , g (Translate (-400.0) 340.0 + (inventoryDisplay (lance r) (resourceTracker u))) + , g (Translate (-200) 150 (levelMessage (levelMessageTimer u) (level u))) + , h 2 (i 20 (Translate (-450.0) (-230.0) helpColumn2)) + , h 2 (i 20 (Translate (-470.0) (-320.0) helpColumn1)) + ] + where f x = g . h x + g x = if isNothing (lance (arena u)) then Blank else x + h x y = if panelActivationTimer u < x then Blank else y + i x y = if startGameTimer u < x then y else Blank + r = arena u + w = Universe.wrapMap r + s = fromMaybe Blank (getImage (resourceTracker u) "item-sigma.bmp") + k x = vectorRelation w (M.center x) (focus r) + +livesText n = Color white + (Scale 0.14 0.14 + (Text (show n ++ " lives"))) +levelText n = (Color white + (Scale 0.14 0.14 + (Text ("level " ++ show (n + 1))))) + +integrityAssessment n = if n >= 3.0 + then Color green (Text "optimal") + else if n >= 2.0 + then Color yellow (Text "light damage") + else Color red (Text "heavy damage") + +godText = Color yellow (Scale 0.14 0.14 (Text "god mode")) + +deflectorText = (Color white (Scale 0.14 0.14 (Text "deflector"))) + +levelMessage a b = case a of + Nothing -> Blank + Just mt -> if mt `remF` 0.5 < 0.25 + then Blank + else Text ("level " ++ show (b + 1)) + + helpColumn1 = Color cyan $ Rotate 270.0 $ @@ -173,173 +148,91 @@ (Scale 0.14 0.14 (Text y)) : lineFormatting' x (z + 1) ys +box w h = [ (-q, r), (q, r), (q, -r), (-q, -r), (-q, r) ] + where (q, r) = appPair (* 0.5) (w, h) + swBar l = - let width = 150.0 in - let height = 17.0 in - let outline = Line [ ((-width) / 2.0, height / 2.0) - , (width / 2.0, height / 2.0) - , (width / 2.0, (-height) / 2.0) - , ((-width) / 2.0, (-height) / 2.0) - , ((-width) / 2.0, height / 2.0) - ] in + let w = 150.0 in + let h = 17.0 in + let outline = Line (box w h) in let trem = max (swTimeLimit - swClock l) 0.0 in let portion = double2Float (trem / swTimeLimit) in let barColor = if portion < 0.2 then red else white in - let bar = Polygon [ ((-width) / 2.0, height / 2.0) - , ((-width) / 2.0 + portion * width, height / 2.0) - , ((-width) / 2.0 + portion * width, (-height) / 2.0) - , ((-width) / 2.0, (-height) / 2.0) + let bar = Polygon [ ((-w) * 0.5, h * 0.5) + , ((-w) * 0.5 + portion * w, h * 0.5) + , ((-w) * 0.5 + portion * w, (-h) * 0.5) + , ((-w) * 0.5, (-h) * 0.5) ] in Pictures [Color barColor bar , Color white outline ] -inventoryDisplay :: Maybe Lance -> ResourceTracker -> Picture -inventoryDisplay mLance rt = - let spacing = 40.0 in - case mLance of +inventoryDisplay m rt = + case m of Nothing -> Blank Just l -> if swClock l < swTimeLimit && all id (inventory l) - then let sigmaPic = fromMaybe Blank + then let p = fromMaybe Blank (getImage rt "item-sigma.bmp") in - Pictures [ Translate (-80) 0 sigmaPic + Pictures [ Translate (-80) 0 p , Translate 10 0 (swBar l) ] else let i = inventory l in - let pFourWay = - if not (i !! 0) - then Blank - else let p = fromMaybe Blank - (getImage rt "item-fourway.bmp") in - Translate ((-2.0) * spacing) 0.0 p in - let pCannon = - if not (i !! 1) - then Blank - else let p = fromMaybe Blank - (getImage rt "item-cannon.bmp") in - Translate ((-1.0) * spacing) 0.0 p in - let pSpread = - if not (i !! 2) - then Blank - else let p = fromMaybe Blank - (getImage rt "item-spread.bmp") in - p in - let pRapidFire = - if not (i !! 3) - then Blank - else let p = fromMaybe Blank - (getImage rt "item-rapidfire.bmp") in - Translate spacing 0.0 p in - let pNuke = - if not (i !! 4) - then Blank - else let p = fromMaybe Blank - (getImage rt "item-nuke.bmp") in - Translate (2.0 * spacing) 0.0 p in - let c = currentWeapon l in - let pSelected = - if c == 0 + let c = currentWeapon l in + Pictures [ f 0 (-2) "item-fourway.bmp" i + , f 1 (-1) "item-cannon.bmp" i + , f 2 0 "item-spread.bmp" i + , f 3 1 "item-rapidfire.bmp" i + , f 4 2 "item-nuke.bmp" i + , if c == 0 + then Blank + else Translate + ((fromIntegral c - 3) * q) 0 + (Line [ (12, 13), (12, -12) + , (-13, -12), (-13, 13), (12, 13) ]) + ] + where f x y z u = if not (u !! x) then Blank - else Translate - ((fromIntegral c - 3.0) * spacing) 0.0 - (Line [ (12.0, 13.0) - , (12.0, -12.0) - , (-13.0, -12.0) - , (-13.0, 13.0) - , (12.0, 13.0) - ]) in - Pictures [ pFourWay - , pCannon, pSpread, pRapidFire, pNuke, pSelected] + else let p = fromMaybe Blank + (getImage rt z) in + Translate (y * q) 0 p + q = 40 -sensorPanel :: Arena -> (Double, Double) -> Picture -sensorPanel arena (w, h) = - let wmap = wrapmap w h in - let (w', h') = (double2Float w, double2Float h) in - let (w'', h'') = (w' * 0.5, h' * 0.5) in - -- let outline = Color white (Line [ (w' * 0.5, h' * 0.5) - -- , (w' * 0.5, (-h') * 0.5) - -- , ((-w') * 0.5,(-h') * 0.5) - -- , ((-w') * 0.5, h' * 0.5) - -- , (w' * 0.5, h' * 0.5) - -- ]) in - let outline = Color white - (Pictures - [ (Line [ (w'' - 4.0, h'') - , (w'', h'') - , (w'', h'' - 4.0) - ]) - , (Line [ (w'', (-h'') + 4.0) - , (w'', (-h'')) - , (w'' - 4.0, (-h'')) - ]) - , (Line [ ((-w''), (-h'') + 4.0) - , ((-w''), (-h'')) - , ((-w'') + 4.0, (-h'')) - ]) - , (Line [ ((-w''), h'' - 4.0) - , ((-w''), h'') - , ((-w'') + 4.0, h'') - ]) - ]) in - let focalPoint = Color white (Line [ (2.0, 0.0) - , (0.0, 2.0) - , (-2.0, 0.0) - , (0.0, -2.0) - , (2.0, 0.0) - ]) in - let unitDots = - [ let cp = focus arena in - let (x, y) = vectorRelation wmap cp c in - Translate - (double2Float (-x)) - (double2Float (-y)) - (Color white (Polygon [ (2.0, 0.0) - , (0.0, 2.0) - , (-2.0, 0.0) - , (0.0, -2.0) - ])) - | c <- map Moving.center (simpleUnits arena) - ++ map Moving.center (smartUnits arena) - ] in - let itemDots = - [ let cp = focus arena in - let (x, y) = vectorRelation wmap cp c in - Translate - (double2Float (-x)) - (double2Float (-y)) - (Color cyan (Polygon [ (2.0, 0.0) - , (0.0, 2.0) - , (-2.0, 0.0) - , (0.0, -2.0) - ])) - | c <- map Moving.center (items arena) - ] in - Pictures $ [ outline - , focalPoint - ] ++ unitDots ++ itemDots +sensorPanel arena (w, h) = Pictures [ d, e, i, j ] + where a = wrapmap w h + (q, r) = appPair ((* 0.5) . double2Float) (w, h) + d = Color white (Pictures + ([ (Line [ (q - 4, r), (q, r), (q, r - 4.0) ]) + , (Line [ (q, 4 - r), (q, -r), (q - 4.0, -r) ]) + , (Line [ (-q, 4 - r), (-q, -r), (-q + 4, -r) ]) + , (Line [ (-q, r - 4.0), (-q, r), (4 - q, r) ]) + ])) -deflectorText = Color white (Scale 0.14 0.14 (Text "deflector")) + e = Color white (Line [ (2, 0), (0, 2), (-2, 0), (0, -2), (2, 0) ]) + i = Pictures + [ f white [ (2, 0), (0, 2), (-2, 0), (0, -2) ] c + | c <- map M.center (simpleUnits arena) + ++ map M.center (smartUnits arena) + ] + j = Pictures + [ f cyan [ (2, 0), (0, 2), (-2, 0), (0, -2) ] c + | c <- map M.center (items arena) + ] + g m = double2Float (-m) + f m n o = let (x, y) = vectorRelation a (focus arena) o in + Translate (g x) (g y) (Color m (Polygon n)) -deflectorBar charge = - let width = 100.0 in - let height = 20.0 in - let outline = Line [ ((-width) / 2.0, height / 2.0) - , (width / 2.0, height / 2.0) - , (width / 2.0, (-height) / 2.0) - , ((-width) / 2.0, (-height) / 2.0) - , ((-width) / 2.0, height / 2.0) - ] in - let portion = (double2Float charge - 0.8) / (2.0 - 0.8) in - let barColor = if charge < 1.0 then red - else white in - let bar = Polygon [ ((-width) / 2.0, height / 2.0) - , ((-width) / 2.0 + portion * width, height / 2.0) - , ((-width) / 2.0 + portion * width, (-height) / 2.0) - , ((-width) / 2.0, (-height) / 2.0) - ] in - Pictures [Color barColor bar - , Color white outline +deflectorBar c = + + Pictures [Color (if c < 1.0 then red else white) + (Polygon [ (-q, r), (-q + p * w, r), (-q + p * w, -r), (-q, -r) ]) + , Color white (Line [ (-q, r), (q, r), (q, -r), (-q, -r), (-q, r) ]) ] + + where w = 100 + h = 20 + q = w / 2 + r = h / 2 + p = (double2Float c - 0.8) / (2 - 0.8) diff --git a/Lance.hs b/Lance.hs --- a/Lance.hs +++ b/Lance.hs @@ -20,27 +20,35 @@ , swTimeLimit ) where -import Data.WrapAround -import Animation -import Graphics.Gloss.Data.Picture -import Graphics.Gloss.Data.Color -import GHC.Float -import Math -import ResourceTracker -import Data.Maybe -import Updating -import qualified Moving as M -import Combat -import qualified Projectile.BulletMkI as P.BulletMkI -import qualified Projectile.Cannon as P.Cannon -import qualified Projectile.Nuke as P.Nuke -import qualified Projectile.SWSide as P.SWSide -import qualified Projectile.SWForward as P.SWForward -import AfterEffect -import qualified AfterEffect.SimpleExplosion as SimpleExplosion -import Sound.ALUT -import Item -import Common +import Data.WrapAround ( WP, WM ) +import Animation ( Animation(..) + , Audible(..) + , handSndSrc + , termSndSrc + , reorient ) +import Graphics.Gloss.Data.Picture (Picture(..)) +import Graphics.Gloss.Data.Color (white) +import GHC.Float (double2Float) +import Math (isZero, dec, inc, neither, remF) +import ResourceTracker (RT, protectedGetImage, getImage) +import Data.Maybe (fromMaybe) +import Updating (Transient(..), InternallyUpdating(..)) +import qualified Moving as M ( Locatable(..) + , Moving(..) + , Colliding(..) + , newLocation' + , newVelocity ) +import Combat (Damageable(..), Launcher(..), Damaging(..), Projectile(..)) +import qualified Projectile.BulletMkI as P.BulletMkI (new) +import qualified Projectile.Cannon as P.Cannon (new) +import qualified Projectile.Nuke as P.Nuke (new) +import qualified Projectile.SWSide as P.SWSide (new) +import qualified Projectile.SWForward as P.SWForward (new) +import AfterEffect (AfterEffect(..)) +import qualified AfterEffect.SimpleExplosion as SimpleExplosion (new) +import Sound.ALUT (Source(..)) +import Item (Item(..), ItemType(..)) +import Common (Angle, Velocity, Time, replaceAt, allTrue) radialVelocity = pi -- radians per second @@ -78,6 +86,7 @@ , integrity :: Double , deflectorCharge :: Double , shotSoundSource :: Maybe Source + , clock :: Time } new r w c = @@ -100,6 +109,7 @@ , godMode = False , integrity = 3.0 , swClock = 0.0 + , clock = 0 } changeCurrentWeapon s = @@ -126,13 +136,14 @@ instance Audible Lance where - processAudio s _ = handSndSrc s + processAudio s l = handSndSrc s queueShotSound shotSoundSource (\a -> a { queueShotSound = False }) rt "simple-energy-shot.wav" (\a b -> a { shotSoundSource = Just b }) + l (wmap s) center terminateAudio s = termSndSrc s shotSoundSource @@ -144,13 +155,16 @@ where f a = s { angle = a (angle s) (radialVelocity * t) } instance Animation Lance where - image s _ = Pictures [ b, reorient (angle s) a ] + image s _ = Pictures [ reorient (angle s) a, b ] 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) + then if remF (clock s) 0.1 <= 0.05 + then f "deflector-1.bmp" + else f "deflector-2.bmp" else Blank + f x = fromMaybe Blank (getImage (rt s) x) instance M.Locatable Lance where center = Lance.center @@ -169,7 +183,9 @@ postUpdate s t = updateDeflectorCharge t - s { center = M.newLocation' s (wmap s) t } + s { center = M.newLocation' s (wmap s) t + , clock = clock s + t + } updateFiringInformation t s = b { swClock = (swClock b) + t } @@ -184,185 +200,90 @@ 5 -> handleNukeWeapon s a otherwise -> handleDefaultWeapon s a -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 } +handleSuperWeapon s a = firing s a 0.2 (b ++ c ++ [d]) 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 + +projectile u w v = Projectile ( u (wmap w) (angle w + v) (center w) (velocity w) ) +bmki = projectile P.BulletMkI.new -handleDefaultWeapon self ls = - if ls >= 0.4 && fireTrigger self - then self { sinceLastShot = 0.0 - , launchTube = - Projectile ( P.BulletMkI.new - (wmap self) - (angle self) - (center self) - (velocity self) ) : launchTube self - , queueShotSound = True - } - else self { sinceLastShot = ls } +handleDefaultWeapon s a = firing s a 0.4 [bmki s 0] -handleFourWayWeapon self ls = - if ls >= 0.4 && fireTrigger self - then self { sinceLastShot = 0.0 - , launchTube = - [ Projectile ( P.BulletMkI.new - (wmap self) - (angle self) - (center self) - (velocity self) ) ] - ++ [ Projectile ( P.BulletMkI.new - (wmap self) - (angle self + pi / 2) - (center self) - (velocity self) ) ] - ++ [ Projectile ( P.BulletMkI.new - (wmap self) - (angle self + pi) - (center self) - (velocity self) ) ] - ++ [ Projectile ( P.BulletMkI.new - (wmap self) - (angle self + 3 * pi / 2) - (center self) - (velocity self) ) ] - ++ launchTube self - , queueShotSound = True - } - else self { sinceLastShot = ls } +handleFourWayWeapon s a = firing s a 0.4 (map f [ 0, pi / 2, pi, 3 * pi / 2 ]) + where f = bmki s -handleCannonWeapon self ls = - if ls >= 0.7 && fireTrigger self - then self { sinceLastShot = 0.0 - , launchTube = - Projectile ( P.Cannon.new - (wmap self) - (angle self) - (center self) - (velocity self) ) : launchTube self - , queueShotSound = True - } - else self { sinceLastShot = ls } +cann = projectile P.Cannon.new -handleSpreadWeapon self ls = - let spreadAngle = pi / 10 in - if ls >= 0.4 && fireTrigger self - then self { sinceLastShot = 0.0 - , launchTube = - [ Projectile ( P.BulletMkI.new - (wmap self) - (angle self) - (center self) - (velocity self) ) ] - ++ [ Projectile ( P.BulletMkI.new - (wmap self) - (angle self + spreadAngle) - (center self) - (velocity self) ) ] - ++ [ Projectile ( P.BulletMkI.new - (wmap self) - (angle self + spreadAngle * 2) - (center self) - (velocity self) ) ] - ++ [ Projectile ( P.BulletMkI.new - (wmap self) - (angle self - spreadAngle) - (center self) - (velocity self) ) ] - ++ [ Projectile ( P.BulletMkI.new - (wmap self) - (angle self - spreadAngle * 2) - (center self) - (velocity self) ) ] - ++ launchTube self - , queueShotSound = True - } - else self { sinceLastShot = ls } +handleCannonWeapon s a = firing s a 0.7 [cann s 0] -handleRapidFireWeapon self ls = - if ls >= 0.2 && fireTrigger self - then self { sinceLastShot = 0.0 - , launchTube = - Projectile ( P.BulletMkI.new - (wmap self) - (angle self) - (center self) - (velocity self) ) : launchTube self - , queueShotSound = True - } - else self { sinceLastShot = ls } +handleSpreadWeapon s a = firing s a 0.4 (map f [ 0, b, b * 2, (-b), (-b) * 2]) + where f = bmki s + b = pi / 10 -handleNukeWeapon self ls = - if ls >= 3.0 && fireTrigger self - then self { sinceLastShot = 0.0 - , launchTube = - Projectile ( P.Nuke.new - (wmap self) - (rt self) - (angle self) - (center self) - (velocity self) ) : launchTube self - , queueShotSound = True - } - else self { sinceLastShot = ls } +handleRapidFireWeapon s a = firing s a 0.2 [bmki s 0] -updateDeflectorCharge t lance = - let charge = deflectorCharge lance in - let charge' = if deflector lance then max 0.8 (charge - t - * deflectorChargeLossFactor) - else min 2.0 (charge + t * 0.05) in - lance { deflectorCharge = charge' } +firing :: Lance + -> Time -- ^ since last shot + -> Time -- ^ intended firing delay + -> [Projectile] -- ^ the new projectiles + -> Lance +firing a b c d = + if b >= c && fireTrigger a + then a { sinceLastShot = 0.0 + , launchTube = d ++ (launchTube a) + , queueShotSound = True + } + else a { sinceLastShot = b } -updateVelocity :: Time -> Lance -> Lance -updateVelocity t lance - | linearThrusters lance = - lance { velocity = M.newVelocity - (velocity lance) - accelerationRate - (angle lance) - maxVelocity - t - } - | otherwise = lance +handleNukeWeapon s a = firing s a 3.0 [b] + where b = Projectile ( P.Nuke.new + (wmap s) + (rt s) + (angle s) + (center s) + (velocity s) ) +updateDeflectorCharge t s = + s { deflectorCharge = if deflector s + then max 0.8 (c - t * deflectorChargeLossFactor) + else min 2.0 (c + t * 0.05) + } + where c = deflectorCharge s + + +updateVelocity t s + | linearThrusters s = + s { velocity = + M.newVelocity (velocity s) accelerationRate (angle s) maxVelocity t + } + | otherwise = s + instance Launcher Lance where - deployProjectiles self = (launchTube self, self { launchTube = [] - -- , sinceLastShot = 0.0 - }) + deployProjectiles s = (launchTube s, s { launchTube = [] }) instance Damaging Lance where - damageEnergy self = - if not (deflector self) || deflectorCharge self < 1.0 + damageEnergy s = if not (deflector s) || deflectorCharge s < 1.0 then kamikazeDamage - else 0.0 + else 0 instance Damageable Lance where - inflictDamage self d = - let d' = if godMode self then 0 else d in - if d' > 0 && (not (deflector self) || deflectorCharge self < 1.0) - then self { integrity = integrity self - d } - else self + inflictDamage s d = + let e = if godMode s then 0 else d in + if e > 0 && (not (deflector s) || deflectorCharge s < 1.0) + then s { integrity = integrity s - d } + else s instance Transient Lance where - expired' self = if not (integrity self <= 0.0) - then Nothing - else Just [ef] - where ef = AfterEffect (SimpleExplosion.new (rt self) - (wmap self) - (Lance.center self) - (Lance.velocity self)) - --- instance Audible Lance where --- processAudio self = queueShotFX + expired' s = if integrity s <= 0.0 then Just [e] else Nothing + where e = AfterEffect (SimpleExplosion.new (rt s) + (wmap s) + (Lance.center s) + (Lance.velocity s)) diff --git a/Math.hs b/Math.hs --- a/Math.hs +++ b/Math.hs @@ -36,6 +36,8 @@ nan = 0 / 0 +isNan = (== nan) + isPos :: (Num a, Ord a) => a -> Bool isPos = (>= 0) @@ -68,8 +70,6 @@ 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 @@ -101,3 +101,18 @@ appPair f (a, b) = (f a, f b) neither a b = not (a || b) + +zeroOrLess :: (Num a, Ord a) => a -> Bool +zeroOrLess = (<= 0) + +moreThanZero :: (Num a, Ord a) => a -> Bool +moreThanZero = (> 0) + +-- |Transforms vector to coordinate form. +vecCoord :: Floating t + => t -- ^ angle + -> t -- ^ magnitude + -> (t, t) +vecCoord a b = appPair ((* b) . ($ a)) (cos, sin) + +qArc = pi / 2 diff --git a/Projectile/Blade.hs b/Projectile/Blade.hs --- a/Projectile/Blade.hs +++ b/Projectile/Blade.hs @@ -1,115 +1,103 @@ module Projectile.Blade ( Blade(..) - , new - , range - , speed - ) where + , new + -- , prj + , speed + ) where -import Combat -import Animation +import Combat ( Damageable(..), Damaging(..) ) +import Animation ( Animation(..) ) import Updating -import Graphics.Gloss.Data.Picture -import Graphics.Gloss.Data.Color -import Data.WrapAround + ( SimpleTransient(..), Transient(..), InternallyUpdating(..) ) +import Graphics.Gloss.Data.Picture ( Picture(Color, Line, Rotate) ) +import Graphics.Gloss.Data.Color ( white ) +import Data.WrapAround ( WP, WM, distance ) import qualified Moving as M -import Math -import Data.Maybe -import ResourceTracker -import GHC.Float -import Common + ( Colliding(..), Moving(..), Locatable(..), newLocation ) +import Common ( Velocity, Time ) +import Math ( radToDeg, remF, appPair, zeroOrLess ) +import GHC.Float ( double2Float ) +import Data.Maybe ( fromMaybe ) +import ResourceTracker ( getImage, RT ) -velocityC = 250.0 -rangeC = 1500.0 -punch = 4.0 +velocityC = 250 -range = rangeC +rangeC = 1500 + +damE = 4 + speed = velocityC -data Blade = - Blade { velocity :: Velocity - , center :: WrapPoint - , rangeLeft :: Double - , wrapMap :: WrapMap - , idealNewCenter :: Maybe WrapPoint - , clock :: Time - , resourceTracker :: ResourceTracker - } +collisionR = 20 --- angle is radians -new :: WrapMap -> ResourceTracker -> Angle -> WrapPoint -> Velocity -> Blade -new wmap rt angle center' (vpx, vpy) = - let x = cos angle * velocityC in - let y = sin angle * velocityC in - Blade { velocity = (x + vpx, y + vpy) - , center = center' - , rangeLeft = rangeC - , wrapMap = wmap - , idealNewCenter = Nothing - , clock = 0.0 - , resourceTracker = rt - } +data Blade = Blade { velocity :: Velocity + , center :: WP + , rangeLeft :: Double + , wmap :: WM + , idealNewCenter :: Maybe WP + , clock :: Time + , rt :: RT + } +new a b c d (e, f) = Blade { velocity = (x + e, y + e) + , center = d + , rangeLeft = rangeC + , wmap = a + , idealNewCenter = Nothing + , clock = 0.0 + , rt = b + } + where (x, y) = appPair ((* velocityC) . ($ c)) (cos, sin) + instance Animation Blade where - image self t = Rotate (double2Float deg) p - where deg = radToDeg ((clock self * 4 * pi) `remF` (2 * pi)) + image s t = Rotate (double2Float deg) p + where deg = radToDeg ((clock s * 4 * pi) `remF` (2 * pi)) p = fromMaybe (Color white (Line [(-40, 0), (40, 0)])) - (getImage rt "blade.bmp") - rt = resourceTracker self - + (getImage (rt s) "blade.bmp") + instance M.Colliding Blade where - collisionRadius self = 20.0 + collisionRadius _ = collisionR instance M.Moving Blade where - velocity self = Projectile.Blade.velocity self + velocity = velocity instance M.Locatable Blade where - center self = Projectile.Blade.center self + center = center instance SimpleTransient Blade where - expired self = rangeLeft self <= 0.0 + expired = zeroOrLess . rangeLeft instance InternallyUpdating Blade where - preUpdate self t = updateIdealTargetCenter t self - - postUpdate self t = - let center' = case idealNewCenter self of - Nothing -> center self - Just x -> x in - self { center = center' - , idealNewCenter = Nothing - , clock = clock self + t - } + preUpdate s t = s { clock = clock s + t } -updateIdealTargetCenter :: Time -> Blade -> Blade -updateIdealTargetCenter t self = - let newLoc = M.newLocation (wrapMap self) - (center self) - (velocity self) - t in - self { idealNewCenter = Just (newLoc) - , rangeLeft = max 0.0 $ rangeLeft self - - Data.WrapAround.distance (wrapMap self) - (center self) - (newLoc) - } + postUpdate s t = s { center = a, rangeLeft = r } + where a = M.newLocation (wmap s) (center s) (velocity s) t + r = max 0 (rangeLeft s - distance (wmap s) (center s) a) instance Damaging Blade where - damageEnergy b = punch + damageEnergy _ = damE instance Transient Blade where - expired' self = if rangeLeft self <= 0.0 - then Just [] - else Nothing + expired' s = if (zeroOrLess . rangeLeft) s then Just [] else Nothing instance Damageable Blade where - inflictDamage self d = self + inflictDamage s _ = s + +-- -- | Func abstracting construction of 'Blade' projectile +-- prj :: (M.Moving a) +-- => a -- ^ object receiving projectile +-- -> (a -> WM) -- ^ func which retrieves WM from object +-- -> Angle -- ^ firing angle +-- -> Projectile +-- prj a f b = Projectile (new (f a) b (M.center a) (M.velocity a)) + diff --git a/Projectile/BulletMI.hs b/Projectile/BulletMI.hs --- a/Projectile/BulletMI.hs +++ b/Projectile/BulletMI.hs @@ -1,112 +1,98 @@ module Projectile.BulletMI ( BulletMI(..) , new + , prj ) where -import Combat -import Animation +import Combat ( Damageable(..), Damaging(..), Projectile(..) ) +import Animation ( Animation(..) ) import Updating -import Graphics.Gloss.Data.Picture -import Graphics.Gloss.Data.Color -import Data.WrapAround + ( SimpleTransient(..), Transient(..), InternallyUpdating(..) ) +import Graphics.Gloss.Data.Picture ( Picture(Circle, Color) ) +import Graphics.Gloss.Data.Color ( yellow, red ) +import Data.WrapAround ( WP, WM, distance ) import qualified Moving as M -import Common + ( Colliding(..), Moving(..), Locatable(..), newLocation ) +import Common ( Velocity, Angle, Time ) +import Math ( appPair, remF, zeroOrLess, moreThanZero ) +import GHC.Float ( double2Float ) velocityC = 400.0 + rangeC = 500.0 +damE = 2 + +collisionR = 4 + data BulletMI = BulletMI { velocity :: Velocity - , center :: WrapPoint + , center :: WP , rangeLeft :: Double - , wrapMap :: WrapMap - , idealNewCenter :: Maybe WrapPoint + , wrapMap :: WM + , idealNewCenter :: Maybe WP , impacted :: Bool , clock :: Time } --- angle is radians -new :: WrapMap -> Angle -> WrapPoint -> Velocity -> BulletMI -new wmap angle center' (vpx, vpy) = - let x = cos angle * velocityC in - let y = sin angle * velocityC in - BulletMI { velocity = (x + vpx, y + vpy) - , center = center' - , rangeLeft = rangeC - , wrapMap = wmap - , idealNewCenter = Nothing - , impacted = False - , clock = 0.0 - } +new a b c (d, e) = + BulletMI { velocity = (x + d, y + e) + , center = c + , rangeLeft = rangeC + , wrapMap = a + , idealNewCenter = Nothing + , impacted = False + , clock = 0.0 + } + where (x, y) = appPair ((* velocityC) . ($ b)) (cos, sin) instance Animation BulletMI where - image self t = let r = fromInteger (ceiling (clock self)) - clock self in - Color (c r) - (Rotate 45.0 - (Circle 4.0)) + image s t = (Color (c r) . Circle) (double2Float collisionR) where c x | x < 0.10 = red - | x < 0.20 = yellow - | x < 0.30 = red - | x < 0.40 = yellow - | x < 0.50 = red - | x < 0.60 = yellow - | x < 0.70 = red - | x < 0.80 = yellow - | x < 0.90 = red | otherwise = yellow + r = remF (clock s) 0.2 instance M.Colliding BulletMI where - collisionRadius b = 2.0 + collisionRadius _ = collisionR instance M.Moving BulletMI where - velocity b = Projectile.BulletMI.velocity b + velocity = velocity instance M.Locatable BulletMI where - center b = Projectile.BulletMI.center b + center = center instance SimpleTransient BulletMI where - expired b = rangeLeft b <= 0.0 + expired = zeroOrLess . rangeLeft instance InternallyUpdating BulletMI where - preUpdate self t = let s' = updateIdealTargetCenter t self in - s' { clock = clock self + t } - - postUpdate self t = - let center' = case idealNewCenter self of - Nothing -> center self - Just x -> x in - self { center = center' - , idealNewCenter = Nothing - } + preUpdate s t = s { clock = clock s + t } -updateIdealTargetCenter :: Time -> BulletMI -> BulletMI -updateIdealTargetCenter t self = - let newLoc = M.newLocation (wrapMap self) - (center self) - (velocity self) - t in - self { idealNewCenter = Just (newLoc) - , rangeLeft = max 0.0 $ rangeLeft self - distance (wrapMap self) - (center self) - (newLoc) - } + postUpdate s t = s { center = a, rangeLeft = r } + where a = M.newLocation (wrapMap s) (center s) (velocity s) t + r = max 0 (rangeLeft s - distance (wrapMap s) (center s) a) instance Damaging BulletMI where - damageEnergy b = 2.0 + damageEnergy _ = damE instance Transient BulletMI where - expired' self = if impacted self || rangeLeft self <= 0.0 - then Just [] - else Nothing + expired' s = if impacted s || zeroOrLess (rangeLeft s) then Just [] else Nothing instance Damageable BulletMI where - inflictDamage self d = if d > 0 then self { impacted = True } - else self + inflictDamage s d = if moreThanZero d then s { impacted = True } else s + +-- | Func abstracting construction of 'BulletMI' projectile +prj :: (M.Moving a) + => a -- ^ object receiving projectile + -> (a -> WM) -- ^ func which retrieves WM from object + -> Angle -- ^ firing angle + -> Projectile +prj a f b = Projectile (new (f a) b (M.center a) (M.velocity a)) + diff --git a/Projectile/BulletMII.hs b/Projectile/BulletMII.hs --- a/Projectile/BulletMII.hs +++ b/Projectile/BulletMII.hs @@ -1,112 +1,98 @@ module Projectile.BulletMII ( BulletMII(..) , new + , prj ) where -import Combat -import Animation +import Combat ( Damageable(..), Damaging(..), Projectile(..) ) +import Animation ( Animation(..) ) import Updating -import Graphics.Gloss.Data.Picture -import Graphics.Gloss.Data.Color -import Data.WrapAround + ( SimpleTransient(..), Transient(..), InternallyUpdating(..) ) +import Graphics.Gloss.Data.Picture ( Picture(Circle, Color) ) +import Graphics.Gloss.Data.Color ( yellow, red ) +import Data.WrapAround ( WP, WM, distance ) import qualified Moving as M -import Common + ( Colliding(..), Moving(..), Locatable(..), newLocation ) +import Common ( Velocity, Angle, Time ) +import Math ( appPair, remF, zeroOrLess, moreThanZero ) +import GHC.Float ( double2Float ) velocityC = 400.0 + rangeC = 700.0 +damE = 2 + +collisionR = 4 + data BulletMII = BulletMII { velocity :: Velocity - , center :: WrapPoint + , center :: WP , rangeLeft :: Double - , wrapMap :: WrapMap - , idealNewCenter :: Maybe WrapPoint + , wrapMap :: WM + , idealNewCenter :: Maybe WP , impacted :: Bool , clock :: Time } --- angle is radians -new :: WrapMap -> Angle -> WrapPoint -> Velocity -> BulletMII -new wmap angle center' (vpx, vpy) = - let x = cos angle * velocityC in - let y = sin angle * velocityC in - BulletMII { velocity = (x + vpx, y + vpy) - , center = center' - , rangeLeft = rangeC - , wrapMap = wmap - , idealNewCenter = Nothing - , impacted = False - , clock = 0.0 - } +new a b c (d, e) = + BulletMII { velocity = (x + d, y + e) + , center = c + , rangeLeft = rangeC + , wrapMap = a + , idealNewCenter = Nothing + , impacted = False + , clock = 0.0 + } + where (x, y) = appPair ((* velocityC) . ($ b)) (cos, sin) instance Animation BulletMII where - image self t = let r = fromInteger (ceiling (clock self)) - clock self in - Color (c r) - (Rotate 45.0 - (Circle 4.0)) + image s t = (Color (c r) . Circle) (double2Float collisionR) where c x | x < 0.10 = red - | x < 0.20 = yellow - | x < 0.30 = red - | x < 0.40 = yellow - | x < 0.50 = red - | x < 0.60 = yellow - | x < 0.70 = red - | x < 0.80 = yellow - | x < 0.90 = red | otherwise = yellow + r = remF (clock s) 0.2 instance M.Colliding BulletMII where - collisionRadius b = 2.0 + collisionRadius _ = collisionR instance M.Moving BulletMII where - velocity b = Projectile.BulletMII.velocity b + velocity = velocity instance M.Locatable BulletMII where - center b = Projectile.BulletMII.center b + center = center instance SimpleTransient BulletMII where - expired b = rangeLeft b <= 0.0 + expired = zeroOrLess . rangeLeft instance InternallyUpdating BulletMII where - preUpdate self t = let s' = updateIdealTargetCenter t self in - s' { clock = clock self + t } - - postUpdate self t = - let center' = case idealNewCenter self of - Nothing -> center self - Just x -> x in - self { center = center' - , idealNewCenter = Nothing - } + preUpdate s t = s { clock = clock s + t } -updateIdealTargetCenter :: Time -> BulletMII -> BulletMII -updateIdealTargetCenter t self = - let newLoc = M.newLocation (wrapMap self) - (center self) - (velocity self) - t in - self { idealNewCenter = Just (newLoc) - , rangeLeft = max 0.0 $ rangeLeft self - distance (wrapMap self) - (center self) - (newLoc) - } + postUpdate s t = s { center = a, rangeLeft = r } + where a = M.newLocation (wrapMap s) (center s) (velocity s) t + r = max 0 (rangeLeft s - distance (wrapMap s) (center s) a) instance Damaging BulletMII where - damageEnergy b = 2.0 + damageEnergy _ = damE instance Transient BulletMII where - expired' self = if impacted self || rangeLeft self <= 0.0 - then Just [] - else Nothing + expired' s = if impacted s || zeroOrLess (rangeLeft s) then Just [] else Nothing instance Damageable BulletMII where - inflictDamage self d = if d > 0 then self { impacted = True } - else self + inflictDamage s d = if moreThanZero d then s { impacted = True } else s + +-- | Func abstracting construction of 'BulletMII' projectile +prj :: (M.Moving a) + => a -- ^ object receiving projectile + -> (a -> WM) -- ^ func which retrieves WM from object + -> Angle -- ^ firing angle + -> Projectile +prj a f b = Projectile (new (f a) b (M.center a) (M.velocity a)) + diff --git a/Projectile/BulletMkI.hs b/Projectile/BulletMkI.hs --- a/Projectile/BulletMkI.hs +++ b/Projectile/BulletMkI.hs @@ -1,112 +1,95 @@ module Projectile.BulletMkI ( BulletMkI(..) - , new - ) where + , new + , prj + ) where -import Combat -import Animation +import Combat ( Damageable(..), Damaging(..), Projectile(..) ) +import Animation ( Animation(..) ) import Updating -import Graphics.Gloss.Data.Picture -import Graphics.Gloss.Data.Color -import Data.WrapAround + ( SimpleTransient(..), Transient(..), InternallyUpdating(..) ) +import Graphics.Gloss.Data.Picture ( Picture(Circle, Color) ) +import Graphics.Gloss.Data.Color ( cyan, blue ) +import Data.WrapAround ( WP, WM, distance ) import qualified Moving as M -import Common + ( Colliding(..), Moving(..), Locatable(..), newLocation ) +import Common ( Velocity, Angle, Time ) +import Math ( appPair, remF, zeroOrLess, moreThanZero ) velocityC = 700.0 + rangeC = 1000.0 +damE = 1 + data BulletMkI = BulletMkI { velocity :: Velocity - , center :: WrapPoint + , center :: WP , rangeLeft :: Double - , wrapMap :: WrapMap - , idealNewCenter :: Maybe WrapPoint + , wrapMap :: WM + , idealNewCenter :: Maybe WP , impacted :: Bool , clock :: Time } --- angle is radians -new :: WrapMap -> Angle -> WrapPoint -> Velocity -> BulletMkI -new wmap angle center' (vpx, vpy) = - let x = cos angle * velocityC in - let y = sin angle * velocityC in - BulletMkI { velocity = (x + vpx, y + vpy) - , center = center' - , rangeLeft = rangeC - , wrapMap = wmap - , idealNewCenter = Nothing - , impacted = False - , clock = 0.0 - } +new a b c (d, e) = + BulletMkI { velocity = (x + d, y + e) + , center = c + , rangeLeft = rangeC + , wrapMap = a + , idealNewCenter = Nothing + , impacted = False + , clock = 0.0 + } + where (x, y) = appPair ((* velocityC) . ($ b)) (cos, sin) instance Animation BulletMkI where - image self t = let r = fromInteger (ceiling (clock self)) - clock self in - Color (c r) - (Rotate 45.0 - (Circle 2.0)) + image s t = (Color (c r) . Circle) 2.0 where c x | x < 0.10 = blue - | x < 0.20 = cyan - | x < 0.30 = blue - | x < 0.40 = cyan - | x < 0.50 = blue - | x < 0.60 = cyan - | x < 0.70 = blue - | x < 0.80 = cyan - | x < 0.90 = blue | otherwise = cyan + r = remF (clock s) 0.2 instance M.Colliding BulletMkI where - collisionRadius b = 1.0 + collisionRadius _ = 2.0 instance M.Moving BulletMkI where - velocity b = Projectile.BulletMkI.velocity b + velocity = velocity instance M.Locatable BulletMkI where - center b = Projectile.BulletMkI.center b + center = center instance SimpleTransient BulletMkI where - expired b = rangeLeft b <= 0.0 + expired = zeroOrLess . rangeLeft instance InternallyUpdating BulletMkI where - preUpdate self t = let s' = updateIdealTargetCenter t self in - s' { clock = clock self + t } - - postUpdate self t = - let center' = case idealNewCenter self of - Nothing -> center self - Just x -> x in - self { center = center' - , idealNewCenter = Nothing - } + preUpdate s t = s { clock = clock s + t } -updateIdealTargetCenter :: Time -> BulletMkI -> BulletMkI -updateIdealTargetCenter t self = - let newLoc = M.newLocation (wrapMap self) - (center self) - (velocity self) - t in - self { idealNewCenter = Just (newLoc) - , rangeLeft = max 0.0 $ rangeLeft self - distance (wrapMap self) - (center self) - (newLoc) - } + postUpdate s t = s { center = a, rangeLeft = r } + where a = M.newLocation (wrapMap s) (center s) (velocity s) t + r = max 0 (rangeLeft s - distance (wrapMap s) (center s) a) instance Damaging BulletMkI where - damageEnergy b = 1.0 + damageEnergy _ = damE instance Transient BulletMkI where - expired' self = if impacted self || rangeLeft self <= 0.0 - then Just [] - else Nothing + expired' s = if impacted s || zeroOrLess (rangeLeft s) then Just [] else Nothing instance Damageable BulletMkI where - inflictDamage self d = if d > 0 then self { impacted = True } - else self + inflictDamage s d = if moreThanZero d then s { impacted = True } else s + +-- | Func abstracting construction of 'BulletMkI' projectile +prj :: (M.Moving a) + => a -- ^ object receiving projectile + -> (a -> WM) -- ^ func which retrieves WM from object + -> Angle -- ^ firing angle + -> Projectile +prj a f b = Projectile (new (f a) b (M.center a) (M.velocity a)) + diff --git a/Projectile/BulletSI.hs b/Projectile/BulletSI.hs --- a/Projectile/BulletSI.hs +++ b/Projectile/BulletSI.hs @@ -1,112 +1,95 @@ module Projectile.BulletSI ( BulletSI(..) , new + , prj ) where -import Combat -import Animation +import Combat ( Projectile(..), Damaging(..), Damageable(..) ) +import Animation ( Animation(..) ) import Updating -import Graphics.Gloss.Data.Picture -import Graphics.Gloss.Data.Color -import Data.WrapAround + ( Transient(..), SimpleTransient(..), InternallyUpdating(..) ) +import Graphics.Gloss.Data.Picture ( Picture(Circle, Color) ) +import Graphics.Gloss.Data.Color ( yellow, red ) +import Data.WrapAround ( WP, WM, distance ) import qualified Moving as M -import Common + ( Moving(..), Locatable(..), Colliding(..), newLocation ) +import Common ( Velocity, Time, Angle ) +import Math ( appPair, remF, zeroOrLess, moreThanZero ) velocityC = 400.0 + rangeC = 500.0 +damE = 1 + data BulletSI = BulletSI { velocity :: Velocity - , center :: WrapPoint + , center :: WP , rangeLeft :: Double - , wrapMap :: WrapMap - , idealNewCenter :: Maybe WrapPoint + , wrapMap :: WM + , idealNewCenter :: Maybe WP , impacted :: Bool , clock :: Time } --- angle is radians -new :: WrapMap -> Angle -> WrapPoint -> Velocity -> BulletSI -new wmap angle center' (vpx, vpy) = - let x = cos angle * velocityC in - let y = sin angle * velocityC in - BulletSI { velocity = (x + vpx, y + vpy) - , center = center' - , rangeLeft = rangeC - , wrapMap = wmap - , idealNewCenter = Nothing - , impacted = False - , clock = 0.0 - } +new a b c (d, e) = + BulletSI { velocity = (x + d, y + e) + , center = c + , rangeLeft = rangeC + , wrapMap = a + , idealNewCenter = Nothing + , impacted = False + , clock = 0.0 + } + where (x, y) = appPair ((* velocityC) . ($ b)) (cos, sin) instance Animation BulletSI where - image self t = let r = fromInteger (ceiling (clock self)) - clock self in - Color (c r) - (Rotate 45.0 - (Circle 2.0)) + image s t = (Color (c r) . Circle) 2.0 where c x | x < 0.10 = red - | x < 0.20 = yellow - | x < 0.30 = red - | x < 0.40 = yellow - | x < 0.50 = red - | x < 0.60 = yellow - | x < 0.70 = red - | x < 0.80 = yellow - | x < 0.90 = red | otherwise = yellow + r = remF (clock s) 0.2 instance M.Colliding BulletSI where - collisionRadius b = 1.0 + collisionRadius _ = 2.0 instance M.Moving BulletSI where - velocity b = Projectile.BulletSI.velocity b + velocity = velocity instance M.Locatable BulletSI where - center b = Projectile.BulletSI.center b + center = center instance SimpleTransient BulletSI where - expired b = rangeLeft b <= 0.0 + expired = zeroOrLess . rangeLeft instance InternallyUpdating BulletSI where - preUpdate self t = let s' = updateIdealTargetCenter t self in - s' { clock = clock self + t } - - postUpdate self t = - let center' = case idealNewCenter self of - Nothing -> center self - Just x -> x in - self { center = center' - , idealNewCenter = Nothing - } + preUpdate s t = s { clock = clock s + t } -updateIdealTargetCenter :: Time -> BulletSI -> BulletSI -updateIdealTargetCenter t self = - let newLoc = M.newLocation (wrapMap self) - (center self) - (velocity self) - t in - self { idealNewCenter = Just (newLoc) - , rangeLeft = max 0.0 $ rangeLeft self - distance (wrapMap self) - (center self) - (newLoc) - } + postUpdate s t = s { center = a, rangeLeft = r } + where a = M.newLocation (wrapMap s) (center s) (velocity s) t + r = max 0 (rangeLeft s - distance (wrapMap s) (center s) a) instance Damaging BulletSI where - damageEnergy b = 1.0 + damageEnergy _ = damE instance Transient BulletSI where - expired' self = if impacted self || rangeLeft self <= 0.0 - then Just [] - else Nothing + expired' s = if impacted s || zeroOrLess (rangeLeft s) then Just [] else Nothing instance Damageable BulletSI where - inflictDamage self d = if d > 0 then self { impacted = True } - else self + inflictDamage s d = if moreThanZero d then s { impacted = True } else s + +-- | Func abstracting construction of 'BulletSI' projectile +prj :: (M.Moving a) + => a -- ^ object receiving projectile + -> (a -> WM) -- ^ func which retrieves WM from object + -> Angle -- ^ firing angle + -> Projectile +prj a f b = Projectile (new (f a) b (M.center a) (M.velocity a)) + diff --git a/Projectile/BulletSII.hs b/Projectile/BulletSII.hs --- a/Projectile/BulletSII.hs +++ b/Projectile/BulletSII.hs @@ -1,115 +1,98 @@ module Projectile.BulletSII ( BulletSII(..) , new + , prj , speed ) where -import Combat -import Animation +import Combat ( Projectile(..), Damaging(..), Damageable(..) ) +import Animation ( Animation(..) ) import Updating -import Graphics.Gloss.Data.Picture -import Graphics.Gloss.Data.Color -import Data.WrapAround + ( Transient(..), SimpleTransient(..), InternallyUpdating(..) ) +import Graphics.Gloss.Data.Picture ( Picture(Circle, Color) ) +import Graphics.Gloss.Data.Color ( yellow, green ) +import Data.WrapAround ( WP, WM, distance ) import qualified Moving as M -import Common + ( Moving(..), Locatable(..), Colliding(..), newLocation ) +import Common ( Velocity, Time, Angle ) +import Math ( appPair, remF, zeroOrLess, moreThanZero ) +speed = velocityC + velocityC = 600.0 + rangeC = 1000.0 -speed = velocityC +damE = 1 data BulletSII = BulletSII { velocity :: Velocity - , center :: WrapPoint + , center :: WP , rangeLeft :: Double - , wrapMap :: WrapMap - , idealNewCenter :: Maybe WrapPoint + , wrapMap :: WM + , idealNewCenter :: Maybe WP , impacted :: Bool , clock :: Time } --- angle is radians -new :: WrapMap -> Angle -> WrapPoint -> Velocity -> BulletSII -new wmap angle center' (vpx, vpy) = - let x = cos angle * velocityC in - let y = sin angle * velocityC in - BulletSII { velocity = (x + vpx, y + vpy) - , center = center' +new a b c (d, e) = + BulletSII { velocity = (x + d, y + e) + , center = c , rangeLeft = rangeC - , wrapMap = wmap + , wrapMap = a , idealNewCenter = Nothing , impacted = False , clock = 0.0 } + where (x, y) = appPair ((* velocityC) . ($ b)) (cos, sin) instance Animation BulletSII where - image self t = let r = fromInteger (ceiling (clock self)) - clock self in - Color (c r) - (Rotate 45.0 - (Circle 2.0)) + image s t = (Color (c r) . Circle) 2.0 where c x | x < 0.10 = green - | x < 0.20 = yellow - | x < 0.30 = green - | x < 0.40 = yellow - | x < 0.50 = green - | x < 0.60 = yellow - | x < 0.70 = green - | x < 0.80 = yellow - | x < 0.90 = green | otherwise = yellow + r = remF (clock s) 0.2 instance M.Colliding BulletSII where - collisionRadius b = 1.0 + collisionRadius _ = 2.0 instance M.Moving BulletSII where - velocity b = Projectile.BulletSII.velocity b + velocity = velocity instance M.Locatable BulletSII where - center b = Projectile.BulletSII.center b + center = center instance SimpleTransient BulletSII where - expired b = rangeLeft b <= 0.0 + expired = zeroOrLess . rangeLeft instance InternallyUpdating BulletSII where - preUpdate self t = let s' = updateIdealTargetCenter t self in - s' { clock = clock self + t } - - postUpdate self t = - let center' = case idealNewCenter self of - Nothing -> center self - Just x -> x in - self { center = center' - , idealNewCenter = Nothing - } + preUpdate s t = s { clock = clock s + t } -updateIdealTargetCenter :: Time -> BulletSII -> BulletSII -updateIdealTargetCenter t self = - let newLoc = M.newLocation (wrapMap self) - (center self) - (velocity self) - t in - self { idealNewCenter = Just (newLoc) - , rangeLeft = max 0.0 $ rangeLeft self - distance (wrapMap self) - (center self) - (newLoc) - } + postUpdate s t = s { center = a, rangeLeft = r } + where a = M.newLocation (wrapMap s) (center s) (velocity s) t + r = max 0 (rangeLeft s - distance (wrapMap s) (center s) a) instance Damaging BulletSII where - damageEnergy b = 1.0 + damageEnergy _ = damE instance Transient BulletSII where - expired' self = if impacted self || rangeLeft self <= 0.0 - then Just [] - else Nothing + expired' s = if impacted s || zeroOrLess (rangeLeft s) then Just [] else Nothing instance Damageable BulletSII where - inflictDamage self d = if d > 0 then self { impacted = True } - else self + inflictDamage s d = if moreThanZero d then s { impacted = True } else s + +-- | Func abstracting construction of 'BulletSII' projectile +prj :: (M.Moving a) + => a -- ^ object receiving projectile + -> (a -> WM) -- ^ func which retrieves WM from object + -> Angle -- ^ firing angle + -> Projectile +prj a f b = Projectile (new (f a) b (M.center a) (M.velocity a)) + diff --git a/Projectile/Cannon.hs b/Projectile/Cannon.hs --- a/Projectile/Cannon.hs +++ b/Projectile/Cannon.hs @@ -1,118 +1,102 @@ module Projectile.Cannon ( Cannon(..) , new + , prj ) where -import Combat -import Animation +import Combat ( Damageable(..), Damaging(..), Projectile(..) ) +import Animation ( Animation(..) ) import Updating -import Graphics.Gloss.Data.Picture -import Graphics.Gloss.Data.Color -import Data.WrapAround + ( SimpleTransient(..), Transient(..), InternallyUpdating(..) ) +import Graphics.Gloss.Data.Picture ( Picture(Circle, Color) ) +import Graphics.Gloss.Data.Color ( cyan, blue ) +import Data.WrapAround ( WP, WM, distance ) import qualified Moving as M -import GHC.Float -import Common + ( Colliding(..), Moving(..), Locatable(..), newLocation ) +import Common ( Velocity, Angle, Time ) +import Math ( remF, appPair, zeroOrLess ) +import GHC.Float ( double2Float ) velocityC = 500.0 + rangeC = 800.0 integrityMax = 60.0 -punch = 4.0 +damE = 4 radiusC = 12.0 data Cannon = Cannon { velocity :: Velocity - , center :: WrapPoint + , center :: WP , rangeLeft :: Double - , wrapMap :: WrapMap - , idealNewCenter :: Maybe WrapPoint - , integrity :: Double + , wrapMap :: WM + , impacted :: Bool , clock :: Time + , integrity :: Double } --- angle is radians -new :: WrapMap -> Angle -> WrapPoint -> Velocity -> Cannon -new wmap angle center' (vpx, vpy) = - let x = cos angle * velocityC in - let y = sin angle * velocityC in - Cannon { velocity = (x + vpx, y + vpy) - , center = center' - , rangeLeft = rangeC - , wrapMap = wmap - , idealNewCenter = Nothing - , clock = 0.0 - , integrity = integrityMax - } +new a b c (d, e) = + Cannon { velocity = (x + d, y + e) + , center = c + , rangeLeft = rangeC + , wrapMap = a + , impacted = False + , clock = 0.0 + , integrity = integrityMax + } + where (x, y) = appPair ((* velocityC) . ($ b)) (cos, sin) instance Animation Cannon where - image self t = let r = fromInteger (ceiling (clock self)) - clock self in - Color (c r) - (Rotate 45.0 - (Circle (double2Float radiusC))) + image s t = (Color (c r) . Circle) (double2Float radiusC) where c x | x < 0.10 = blue - | x < 0.20 = cyan - | x < 0.30 = blue - | x < 0.40 = cyan - | x < 0.50 = blue - | x < 0.60 = cyan - | x < 0.70 = blue - | x < 0.80 = cyan - | x < 0.90 = blue | otherwise = cyan + r = remF (clock s) 0.2 instance M.Colliding Cannon where - collisionRadius self = radiusC + collisionRadius _ = radiusC instance M.Moving Cannon where - velocity self = Projectile.Cannon.velocity self + velocity = velocity instance M.Locatable Cannon where - center self = Projectile.Cannon.center self + center = center +expirationFormula s = f rangeLeft || f integrity where f g = (zeroOrLess . g) s + instance SimpleTransient Cannon where - expired self = rangeLeft self <= 0.0 || integrity self <= 0.0 + expired = expirationFormula instance InternallyUpdating Cannon where - preUpdate self t = let s' = updateIdealTargetCenter t self in - s' { clock = clock self + t } - - postUpdate self t = - let center' = case idealNewCenter self of - Nothing -> center self - Just x -> x in - self { center = center' - , idealNewCenter = Nothing - } + preUpdate s t = s { clock = clock s + t } -updateIdealTargetCenter :: Time -> Cannon -> Cannon -updateIdealTargetCenter t self = - let newLoc = M.newLocation (wrapMap self) - (center self) - (velocity self) - t in - self { idealNewCenter = Just (newLoc) - , rangeLeft = max 0.0 $ rangeLeft self - distance (wrapMap self) - (center self) - (newLoc) - } + postUpdate s t = s { center = a, rangeLeft = r } + where a = M.newLocation (wrapMap s) (center s) (velocity s) t + r = max 0 (rangeLeft s - distance (wrapMap s) (center s) a) instance Damaging Cannon where - damageEnergy self = punch + damageEnergy _ = damE instance Transient Cannon where - expired' self = if rangeLeft self <= 0.0 || integrity self <= 0.0 - then Just [] - else Nothing + expired' s = if expirationFormula s then Just [] else Nothing instance Damageable Cannon where - inflictDamage self d = self { integrity = integrity self - d } + inflictDamage s d = s { integrity = integrity s - d } + +-- | Func abstracting construction of 'Cannon' projectile +prj :: (M.Moving a) + => a -- ^ object receiving projectile + -> (a -> WM) -- ^ func which retrieves WM from object + -> Angle -- ^ firing angle + -> Projectile +prj a f b = Projectile (new (f a) b (M.center a) (M.velocity a)) + diff --git a/Projectile/Interceptor.hs b/Projectile/Interceptor.hs --- a/Projectile/Interceptor.hs +++ b/Projectile/Interceptor.hs @@ -1,136 +1,108 @@ module Projectile.Interceptor ( Interceptor(..) - , new - , speed - ) where + , new +-- , prj + , speed + ) where -import Combat -import Animation +import Combat ( Damageable(..), Damaging(..) ) +import Animation ( Animation(..), reorient ) import Updating -import Graphics.Gloss.Data.Picture -import Graphics.Gloss.Data.Color -import Data.WrapAround + ( SimpleTransient(..), Transient(..), InternallyUpdating(..) ) +import Graphics.Gloss.Data.Picture ( Picture(Circle, Color) ) +import Graphics.Gloss.Data.Color ( white ) +import Data.WrapAround ( WP, WM, distance ) import qualified Moving as M -import GHC.Float -import Common -import Math ( remF - , radToDeg - ) -import Data.Maybe -import ResourceTracker + ( Colliding(..), Moving(..), Locatable(..), newLocation ) +import Common ( Velocity, Angle, Time ) +import Math ( remF, appPair, zeroOrLess, moreThanZero ) +import GHC.Float ( double2Float ) +import ResourceTracker ( RT, getImage ) +import Data.Maybe ( fromMaybe ) -velocityC = 900.0 -rangeC = 1200.0 +velocityC = 900 -integrityMax = 60.0 +rangeC = 1200 -punch = 4.0 +damE = 4 radiusC = 12.0 speed = velocityC -data Interceptor = - Interceptor { velocity :: Velocity - , center :: WrapPoint - , rangeLeft :: Double - , wrapMap :: WrapMap - , idealNewCenter :: Maybe WrapPoint - , impacted :: Bool - , clock :: Time - , angle :: Angle - , resourceTracker :: ResourceTracker - } +data Interceptor = Interceptor { velocity :: Velocity + , center :: WP + , rangeLeft :: Double + , wrapMap :: WM + , impacted :: Bool + , clock :: Time + , rt :: RT + , angle :: Angle + } --- angle is radians -new :: WrapMap -> ResourceTracker -> Angle -> WrapPoint -> Velocity -> Interceptor -new wmap rt angle' center' (vpx, vpy) = - let x = cos angle' * velocityC in - let y = sin angle' * velocityC in - Interceptor { velocity = (x + vpx, y + vpy) - , center = center' - , rangeLeft = rangeC - , wrapMap = wmap - , idealNewCenter = Nothing - , clock = 0.0 - , impacted = False - , angle = angle' - , resourceTracker = rt - } +new a r b c (d, e) = Interceptor { velocity = (x + d, y + e) + , center = c + , rangeLeft = rangeC + , wrapMap = a + , impacted = False + , clock = 0.0 + , rt = r + , angle = b + } + where (x, y) = appPair ((* velocityC) . ($ b)) (cos, sin) instance Animation Interceptor where - image self t = Rotate a cpic + image s t = reorient (angle s) c - where rt = resourceTracker self - defImage x = fromMaybe - (Color white - (Circle r)) - (getImage rt x) - p1 = defImage "interceptor-1.bmp" - p2 = defImage "interceptor-2.bmp" - p3 = defImage "interceptor-3.bmp" - rem = clock self `remF` 0.3 - cpic = if rem > 0.2 - then p3 - else if rem > 0.1 - then p2 - else p1 - a = double2Float (radToDeg (angle self) * (-1) - 90) + where f x = fromMaybe (Color white (Circle r)) (getImage (rt s) x) + p1 = f "interceptor-1.bmp" + p2 = f "interceptor-2.bmp" + p3 = f "interceptor-3.bmp" + g = ((clock s `remF` 0.3) >) + c = if g 0.2 then p3 else if g 0.1 then p2 else p1 r = double2Float radiusC - + instance M.Colliding Interceptor where - collisionRadius self = radiusC + collisionRadius _ = radiusC instance M.Moving Interceptor where - velocity self = Projectile.Interceptor.velocity self + velocity = velocity instance M.Locatable Interceptor where - center self = Projectile.Interceptor.center self + center = center instance SimpleTransient Interceptor where - expired self = impacted self || rangeLeft self <= 0.0 + expired s = impacted s || (zeroOrLess . rangeLeft) s instance InternallyUpdating Interceptor where - preUpdate self t = let s' = updateIdealTargetCenter t self in - s' { clock = clock self + t } - - postUpdate self t = - let center' = case idealNewCenter self of - Nothing -> center self - Just x -> x in - self { center = center' - , idealNewCenter = Nothing - } + preUpdate s t = s { clock = clock s + t } -updateIdealTargetCenter :: Time -> Interceptor -> Interceptor -updateIdealTargetCenter t self = - let newLoc = M.newLocation (wrapMap self) - (center self) - (velocity self) - t in - self { idealNewCenter = Just (newLoc) - , rangeLeft = max 0.0 $ rangeLeft self - distance (wrapMap self) - (center self) - (newLoc) - } + postUpdate s t = s { center = a, rangeLeft = r } + where a = M.newLocation (wrapMap s) (center s) (velocity s) t + r = max 0 (rangeLeft s - distance (wrapMap s) (center s) a) instance Damaging Interceptor where - damageEnergy self = punch + damageEnergy _ = damE instance Transient Interceptor where - expired' self = if impacted self || rangeLeft self <= 0.0 - then Just [] - else Nothing + expired' s = if impacted s || (zeroOrLess . rangeLeft) s then Just [] else Nothing instance Damageable Interceptor where - inflictDamage self d = if d > 0.0 - then self { impacted = True } - else self + inflictDamage s d = if moreThanZero d then s { impacted = True } else s + +-- -- | Func abstracting construction of 'Interceptor' projectile +-- prj :: (M.Moving a) +-- => a -- ^ object receiving projectile +-- -> (a -> WM) -- ^ func which retrieves WM from object +-- -> Angle -- ^ firing angle +-- -> Projectile +-- prj a f b = Projectile (new (f a) b (M.center a) (M.velocity a)) + diff --git a/Projectile/Mine.hs b/Projectile/Mine.hs --- a/Projectile/Mine.hs +++ b/Projectile/Mine.hs @@ -1,80 +1,47 @@ module Projectile.Mine ( Mine(..) - , new - ) where + , new + ) where -import Combat -import Animation +import Combat ( Damageable(..), Damaging(..) ) +import Animation ( Animation(..) ) import Updating -import Graphics.Gloss.Data.Picture -import Graphics.Gloss.Data.Color -import Data.WrapAround + ( SimpleTransient(..), Transient(..), InternallyUpdating(..) ) +import Graphics.Gloss.Data.Picture () +import Graphics.Gloss.Data.Color () +import Data.WrapAround ( WP, WM ) import qualified Moving as M -import ResourceTracker -import Data.Maybe -import qualified AfterEffect.MineExplosion as MineExplosion -import AfterEffect -import Common + ( Colliding(..), Moving(..), Locatable(..) ) +import ResourceTracker ( RT, ResourceTracker, protectedGetImage ) +import Data.Maybe () +import qualified AfterEffect.MineExplosion as MineExplosion ( new ) +import AfterEffect ( AfterEffect(AfterEffect) ) +import Common ( Time ) +import Math ( remF, appPair, moreThanZero ) -detRadius = 100.0 -punch = 1.0 +detRadius = 100 +punch = 1 -data Mine = - Mine { center :: WrapPoint - , impacted :: Bool - , clock :: Time - , resourceTracker :: ResourceTracker - , wrapMap :: WrapMap - } +data Mine = Mine { center :: WP + , impacted :: Bool + , clock :: Time + , rt :: RT + , wmap :: WM + } -- angle is radians -new :: ResourceTracker -> WrapMap -> WrapPoint -> Mine -new rt wmap center' = - Mine { center = center' - , impacted = False - , clock = 0.0 - , resourceTracker = rt - , wrapMap = wmap - } +new :: ResourceTracker -> WM -> WP -> Mine +new a b c = Mine { center = c + , impacted = False + , clock = 0.0 + , rt = a + , wmap = b + } instance Animation Mine where - image self _ = - -- assumes t >= 0 - let t = clock self in - let adjt = let a = t * 0.1 in - let b = fromIntegral (truncate a) in - let c = a - b in - c * 10.0 in - c adjt - where c x | x <= 0.1 = plit - | x > 5 && x <= 5.1 = plit - | otherwise = p - p = fromMaybe - (Scale 0.20 0.20 - (Color white - (Text "Error! Missing image!"))) - (getImage rt "mine.bmp") - plit = fromMaybe - (Scale 0.20 0.20 - (Color white - (Text "Error! Missing image!"))) - (getImage rt "mine-lit.bmp") - rt = resourceTracker self - - -- image self t = let r = fromInteger (ceiling (clock self)) - clock self in - -- Color (c r) - -- (Rotate 45.0 - -- (Circle 2.0)) - -- where c x | x < 0.10 = red - -- | x < 0.20 = yellow - -- | x < 0.30 = red - -- | x < 0.40 = yellow - -- | x < 0.50 = red - -- | x < 0.60 = yellow - -- | x < 0.70 = red - -- | x < 0.80 = yellow - -- | x < 0.90 = red - -- | otherwise = yellow + image s _ = if m <= 0.1 || (m > 5 && m <= 5.1) then q else p + where (p, q) = appPair (protectedGetImage (rt s)) ("mine.bmp", "mine-lit.bmp") + m = remF (clock s) 10 instance M.Colliding Mine where @@ -82,21 +49,21 @@ instance M.Moving Mine where - velocity _ = (0.0, 0.0) + velocity _ = (0, 0) instance M.Locatable Mine where - center self = Projectile.Mine.center self + center = center instance SimpleTransient Mine where - expired self = impacted self + expired = impacted instance InternallyUpdating Mine where - preUpdate self t = self { clock = clock self + t } + preUpdate s t = s { clock = clock s + t } - postUpdate self _ = self + postUpdate s _ = s instance Damaging Mine where @@ -104,14 +71,9 @@ instance Transient Mine where - expired' self = if impacted self - then Just [mE] - else Nothing - where mE = AfterEffect $ MineExplosion.new rt wmap center' - rt = resourceTracker self - wmap = wrapMap self - center' = center self + expired' s = if impacted s then Just [mE] else Nothing + where mE = AfterEffect $ MineExplosion.new (rt s) (wmap s) (center s) instance Damageable Mine where - inflictDamage self d = self { impacted = d > 0 } + inflictDamage s d = s { impacted = moreThanZero d } diff --git a/Projectile/Nuke.hs b/Projectile/Nuke.hs --- a/Projectile/Nuke.hs +++ b/Projectile/Nuke.hs @@ -1,133 +1,102 @@ module Projectile.Nuke ( Nuke(..) - , new - ) where + , new + ) where -import Combat -import Animation +import Combat ( Damaging(..), Damageable(..) ) +import Animation ( Animation(..) ) import Updating + ( Transient(..), SimpleTransient(..), InternallyUpdating(..) ) import Graphics.Gloss.Data.Picture -import Graphics.Gloss.Data.Color -import Data.WrapAround + ( Picture(Blank, Circle, Color, Scale) ) +import Graphics.Gloss.Data.Color ( white, green ) +import Data.WrapAround ( WP, WM ) import qualified Moving as M -import ResourceTracker -import Data.Maybe -import Common + ( Moving(..), Locatable(..), Colliding(..), newLocation ) +import ResourceTracker ( ResourceTracker, RT, getImage ) +import Data.Maybe ( fromMaybe ) +import Common ( Velocity, Time, Angle ) +import Math ( appPair ) velocityC = 200.0 - punch = 8.0 residualPunch = 0.1 - detTime = 1.5 -data Nuke = - Nuke { velocity :: Velocity - , center :: WrapPoint - , wrapMap :: WrapMap - , idealNewCenter :: Maybe WrapPoint - , clock :: Time - , initialBlastCompleted :: Bool - , resourceTracker :: ResourceTracker - } +data Nuke = Nuke { velocity :: Velocity + , center :: WP + , wmap :: WM + , clock :: Time + , initialBlastCompleted :: Bool + , rt :: RT + } --- angle is radians -new :: WrapMap -> ResourceTracker -> Angle -> WrapPoint -> Velocity -> Nuke -new wmap rt angle center' (vpx, vpy) = - let x = cos angle * velocityC in - let y = sin angle * velocityC in - Nuke { velocity = (x + vpx, y + vpy) - , center = center' - , wrapMap = wmap - , idealNewCenter = Nothing - , clock = 0.0 - , initialBlastCompleted = False - , resourceTracker = rt - } +new :: WM -> ResourceTracker -> Angle -> WP -> Velocity -> Nuke +new a b c d (e, f) = + Nuke { velocity = (x + e, y + f) + , center = d + , wmap = a + , clock = 0.0 + , initialBlastCompleted = False + , rt = b + } + where (x, y) = appPair ((* velocityC) . ($ c)) (cos, sin) instance Animation Nuke where - image self t = - let c = clock self in - if c < detTime - then Color green (Circle 2.0) - else if c < detTime + 0.05 - then p0 - else if c < detTime + 0.1 - then p1 - else if c < detTime + 0.15 - then p2 - else if c < detTime + 0.2 - then p3 - else Blank - where p0 = failImg (getImage rt "nuke-0.bmp") - p1 = failImg (getImage rt "nuke-1.bmp") - p2 = failImg (getImage rt "nuke-2.bmp") - p3 = failImg (getImage rt "nuke-3.bmp") - rt = resourceTracker self - failImg = \x -> Scale 2.0 2.0 (fromMaybe (Color white (Circle 125.0)) x) + image s t = if c < detTime + then Color green (Circle 2.0) + else if c < detTime + 0.05 + then f "nuke-0.bmp" + else if c < detTime + 0.1 + then f "nuke-1.bmp" + else if c < detTime + 0.15 + then f "nuke-2.bmp" + else if c < detTime + 0.2 + then f "nuke-3.bmp" + else Blank + where f = \x -> Scale 2 2 + (fromMaybe (Color white (Circle 125)) (getImage (rt s) x)) + c = clock s instance M.Colliding Nuke where - collisionRadius self = - if clock self < detTime - then 2.0 - else 200 + collisionRadius s = if clock s < detTime then 2 else 200 instance M.Moving Nuke where - velocity b = Projectile.Nuke.velocity b + velocity b = velocity b instance M.Locatable Nuke where - center b = Projectile.Nuke.center b + center b = center b +expFormula a = clock a >= detTime + 0.5 + instance SimpleTransient Nuke where - expired self = clock self >= detTime + 0.5 + expired = expFormula instance InternallyUpdating Nuke where - preUpdate self t = let s' = updateIdealTargetCenter t self in - s' { clock = clock self + t - , velocity = if clock self >= detTime - then (0.0, 0.0) - else velocity self - } - - postUpdate self t = - let center' = case idealNewCenter self of - Nothing -> center self - Just x -> x in - self { center = center' - , idealNewCenter = Nothing - , initialBlastCompleted = clock self >= detTime - } + preUpdate s t = s { clock = clock s + t + , velocity = if clock s >= detTime then (0, 0) else velocity s + } -updateIdealTargetCenter :: Time -> Nuke -> Nuke -updateIdealTargetCenter t self = - let newLoc = M.newLocation (wrapMap self) - (center self) - (velocity self) - t in - self { idealNewCenter = Just (newLoc) - } + postUpdate s t = s { center = M.newLocation (wmap s) (center s) (velocity s) t + , initialBlastCompleted = clock s >= detTime + } instance Damaging Nuke where - damageEnergy self = - let c = clock self in - if c < detTime - then 0.0 - else if initialBlastCompleted self - then residualPunch - else punch + damageEnergy s = + if clock s < detTime + then 0 + else if initialBlastCompleted s then residualPunch else punch instance Transient Nuke where - expired' self = if clock self >= detTime + 0.5 - then Just [] - else Nothing + expired' s = if expFormula s then Just [] else Nothing instance Damageable Nuke where - inflictDamage self _ = self + inflictDamage s _ = s diff --git a/Projectile/Pellet.hs b/Projectile/Pellet.hs --- a/Projectile/Pellet.hs +++ b/Projectile/Pellet.hs @@ -3,86 +3,72 @@ , range ) where -import Combat -import Animation +import Combat ( Damaging(..), Damageable(..) ) +import Animation ( Animation(..) ) import Updating -import Graphics.Gloss.Data.Picture -import Graphics.Gloss.Data.Color -import Data.WrapAround + ( Transient(..), SimpleTransient(..), InternallyUpdating(..) ) +import Graphics.Gloss.Data.Picture ( Picture(Circle, Color) ) +import Graphics.Gloss.Data.Color ( makeColor8 ) +import Data.WrapAround ( WP, WM, distance ) import qualified Moving as M -import Common + ( Moving(..), Locatable(..), Colliding(..), newLocation ) +import Common ( Velocity, Angle ) +import Math ( vecCoord, addV, zeroOrLess, moreThanZero ) -velocityC = 600.0 -rangeC = 300.0 +velocityC = 600 +rangeC = 300 punch = 0.3 - range = rangeC -data Pellet = - Pellet { velocity :: Velocity - , center :: WrapPoint - , rangeLeft :: Double - , wrapMap :: WrapMap - , idealNewCenter :: Maybe WrapPoint - , impacted :: Bool - } +data Pellet = Pellet { velocity :: Velocity + , center :: WP + , rangeLeft :: Double + , wmap :: WM + , impacted :: Bool + } -- angle is radians -new :: WrapMap -> Angle -> WrapPoint -> Velocity -> Pellet -new wmap angle center' (vpx, vpy) = - let x = cos angle * velocityC in - let y = sin angle * velocityC in - Pellet { velocity = (x + vpx, y + vpy) - , center = center' +new :: WM -> Angle -> WP -> Velocity -> Pellet +new a b c d = + Pellet { velocity = addV (vecCoord b velocityC) d + , center = c , rangeLeft = rangeC - , wrapMap = wmap - , idealNewCenter = Nothing + , wmap = a , impacted = False } instance Animation Pellet where - image self t = Color (makeColor8 172 172 172 255) (Circle 1.0) + image _ _ = Color (makeColor8 172 172 172 255) (Circle 1) instance M.Colliding Pellet where - collisionRadius b = 1.0 + collisionRadius _ = 1 instance M.Moving Pellet where - velocity b = Projectile.Pellet.velocity b + velocity = velocity instance M.Locatable Pellet where - center b = Projectile.Pellet.center b + center = center +expFormula s = impacted s || (zeroOrLess . rangeLeft) s + instance SimpleTransient Pellet where - expired b = rangeLeft b <= 0.0 + expired = expFormula instance InternallyUpdating Pellet where - preUpdate self t = updateIdealTargetCenter t self + preUpdate s t = s - postUpdate self t = - let center' = case idealNewCenter self of - Nothing -> center self - Just x -> x in - self { center = center' - , idealNewCenter = Nothing - } + postUpdate s t = + s { center = a + , rangeLeft = max 0 (rangeLeft s - distance (wmap s) (center s) a) + } -updateIdealTargetCenter :: Time -> Pellet -> Pellet -updateIdealTargetCenter t self = - let newLoc = M.newLocation (wrapMap self) - (center self) - (velocity self) - t in - self { idealNewCenter = Just (newLoc) - , rangeLeft = max 0.0 $ rangeLeft self - distance (wrapMap self) - (center self) - (newLoc) - } + where a = M.newLocation (wmap s) (center s) (velocity s) t instance Damaging Pellet where @@ -90,11 +76,8 @@ instance Transient Pellet where - expired' self = if impacted self || rangeLeft self <= 0.0 - then Just [] - else Nothing + expired' s = if expFormula s then Just [] else Nothing instance Damageable Pellet where - inflictDamage self d = if d > 0 then self { impacted = True } - else self + inflictDamage s d = if moreThanZero d then s { impacted = True } else s diff --git a/Projectile/SWForward.hs b/Projectile/SWForward.hs --- a/Projectile/SWForward.hs +++ b/Projectile/SWForward.hs @@ -1,108 +1,102 @@ module Projectile.SWForward ( SWForward(..) , new + , prj ) where -import Combat -import Animation +import Combat ( Damageable(..), Damaging(..), Projectile(..) ) +import Animation ( Animation(..) ) import Updating -import Graphics.Gloss.Data.Picture -import Graphics.Gloss.Data.Color -import Data.WrapAround + ( SimpleTransient(..), Transient(..), InternallyUpdating(..) ) +import Graphics.Gloss.Data.Picture ( Picture(Circle, Color) ) +import Graphics.Gloss.Data.Color ( violet ) +import Data.WrapAround ( WP, WM, distance ) import qualified Moving as M -import GHC.Float -import Common + ( Colliding(..), Moving(..), Locatable(..), newLocation ) +import Common ( Velocity, Angle, Time ) +import Math ( appPair, zeroOrLess ) +import GHC.Float ( double2Float ) -velocityC = 700.0 -rangeC = 1000.0 +velocityC = 700 -integrityMax = 60.0 +rangeC = 1000 -punch = 6.0 +integrityMax = 60 -radiusGrowth = 50.0 +damE = 6 +radiusGrowth = 30 + data SWForward = SWForward { velocity :: Velocity - , center :: WrapPoint - , rangeLeft :: Double - , wrapMap :: WrapMap - , idealNewCenter :: Maybe WrapPoint - , integrity :: Double - , clock :: Time - , radius :: Double - } + , center :: WP + , rangeLeft :: Double + , wrapMap :: WM + , impacted :: Bool + , clock :: Time + , integrity :: Double + , radius :: Double + } --- angle is radians -new :: WrapMap -> Angle -> WrapPoint -> Velocity -> SWForward -new wmap angle center' (vpx, vpy) = - let x = cos angle * velocityC in - let y = sin angle * velocityC in - SWForward { velocity = (x + vpx, y + vpy) - , center = center' - , rangeLeft = rangeC - , wrapMap = wmap - , idealNewCenter = Nothing - , clock = 0.0 - , integrity = integrityMax - , radius = 2.0 - } +new a b c (d, e) = + SWForward { velocity = (x + d, y + e) + , center = c + , rangeLeft = rangeC + , wrapMap = a + , impacted = False + , clock = 0.0 + , integrity = integrityMax + , radius = 2.0 + } + where (x, y) = appPair ((* velocityC) . ($ b)) (cos, sin) instance Animation SWForward where - image self t = Color violet (Circle (double2Float (radius self))) + image s t = Color violet (Circle (double2Float (radius s))) instance M.Colliding SWForward where - collisionRadius self = radius self + collisionRadius = radius instance M.Moving SWForward where - velocity self = Projectile.SWForward.velocity self + velocity = velocity instance M.Locatable SWForward where - center self = Projectile.SWForward.center self + center = center +expirationFormula s = f rangeLeft || f integrity where f g = (zeroOrLess . g) s + instance SimpleTransient SWForward where - expired self = rangeLeft self <= 0.0 || integrity self <= 0.0 + expired = expirationFormula instance InternallyUpdating SWForward where - preUpdate self t = let s' = updateIdealTargetCenter t self in - s' { clock = clock self + t } - - postUpdate self t = - let center' = case idealNewCenter self of - Nothing -> center self - Just x -> x in - self { center = center' - , idealNewCenter = Nothing - , radius = min 128.0 ((radius self) + radiusGrowth * t) - } + preUpdate s t = s { clock = clock s + t } -updateIdealTargetCenter :: Time -> SWForward -> SWForward -updateIdealTargetCenter t self = - let newLoc = M.newLocation (wrapMap self) - (center self) - (velocity self) - t in - self { idealNewCenter = Just (newLoc) - , rangeLeft = max 0.0 $ rangeLeft self - distance (wrapMap self) - (center self) - (newLoc) - } + postUpdate s t = s { center = a, rangeLeft = r, radius = q } + where a = M.newLocation (wrapMap s) (center s) (velocity s) t + r = max 0 (rangeLeft s - distance (wrapMap s) (center s) a) + q = min 128.0 ((radius s) + radiusGrowth * t) instance Damaging SWForward where - damageEnergy self = punch + damageEnergy _ = damE instance Transient SWForward where - expired' self = if rangeLeft self <= 0.0 || integrity self <= 0.0 - then Just [] - else Nothing + expired' s = if expirationFormula s then Just [] else Nothing instance Damageable SWForward where - inflictDamage self d = self { integrity = integrity self - d } + inflictDamage s d = s { integrity = integrity s - d } + +-- | Func abstracting construction of 'SWForward' projectile +prj :: (M.Moving a) + => a -- ^ object receiving projectile + -> (a -> WM) -- ^ func which retrieves WM from object + -> Angle -- ^ firing angle + -> Projectile +prj a f b = Projectile (new (f a) b (M.center a) (M.velocity a)) + diff --git a/Projectile/SWSide.hs b/Projectile/SWSide.hs --- a/Projectile/SWSide.hs +++ b/Projectile/SWSide.hs @@ -1,108 +1,102 @@ module Projectile.SWSide ( SWSide(..) , new + , prj ) where -import Combat -import Animation +import Combat ( Damageable(..), Damaging(..), Projectile(..) ) +import Animation ( Animation(..) ) import Updating -import Graphics.Gloss.Data.Picture -import Graphics.Gloss.Data.Color -import Data.WrapAround + ( SimpleTransient(..), Transient(..), InternallyUpdating(..) ) +import Graphics.Gloss.Data.Picture ( Picture(Circle, Color) ) +import Graphics.Gloss.Data.Color ( cyan ) +import Data.WrapAround ( WP, WM, distance ) import qualified Moving as M -import GHC.Float -import Common + ( Colliding(..), Moving(..), Locatable(..), newLocation ) +import Common ( Velocity, Angle, Time ) +import Math ( appPair, zeroOrLess ) +import GHC.Float ( double2Float ) velocityC = 700.0 + rangeC = 1000.0 integrityMax = 60.0 -punch = 3.0 +damE = 3 -radiusGrowth = 30.0 +radiusGrowth = 30 data SWSide = SWSide { velocity :: Velocity - , center :: WrapPoint + , center :: WP , rangeLeft :: Double - , wrapMap :: WrapMap - , idealNewCenter :: Maybe WrapPoint - , integrity :: Double + , wrapMap :: WM + , impacted :: Bool , clock :: Time + , integrity :: Double , radius :: Double } --- angle is radians -new :: WrapMap -> Angle -> WrapPoint -> Velocity -> SWSide -new wmap angle center' (vpx, vpy) = - let x = cos angle * velocityC in - let y = sin angle * velocityC in - SWSide { velocity = (x + vpx, y + vpy) - , center = center' - , rangeLeft = rangeC - , wrapMap = wmap - , idealNewCenter = Nothing - , clock = 0.0 - , integrity = integrityMax - , radius = 2.0 - } +new a b c (d, e) = + SWSide { velocity = (x + d, y + e) + , center = c + , rangeLeft = rangeC + , wrapMap = a + , impacted = False + , clock = 0.0 + , integrity = integrityMax + , radius = 2.0 + } + where (x, y) = appPair ((* velocityC) . ($ b)) (cos, sin) instance Animation SWSide where - image self t = Color cyan (Circle (double2Float (radius self))) + image s t = Color cyan (Circle (double2Float (radius s))) instance M.Colliding SWSide where - collisionRadius self = radius self + collisionRadius = radius instance M.Moving SWSide where - velocity self = Projectile.SWSide.velocity self + velocity = velocity instance M.Locatable SWSide where - center self = Projectile.SWSide.center self + center = center +expirationFormula s = f rangeLeft || f integrity where f g = (zeroOrLess . g) s + instance SimpleTransient SWSide where - expired self = rangeLeft self <= 0.0 || integrity self <= 0.0 + expired = expirationFormula instance InternallyUpdating SWSide where - preUpdate self t = let s' = updateIdealTargetCenter t self in - s' { clock = clock self + t } - - postUpdate self t = - let center' = case idealNewCenter self of - Nothing -> center self - Just x -> x in - self { center = center' - , idealNewCenter = Nothing - , radius = min 128.0 ((radius self) + radiusGrowth * t) - } + preUpdate s t = s { clock = clock s + t } -updateIdealTargetCenter :: Time -> SWSide -> SWSide -updateIdealTargetCenter t self = - let newLoc = M.newLocation (wrapMap self) - (center self) - (velocity self) - t in - self { idealNewCenter = Just (newLoc) - , rangeLeft = max 0.0 $ rangeLeft self - distance (wrapMap self) - (center self) - (newLoc) - } + postUpdate s t = s { center = a, rangeLeft = r, radius = q } + where a = M.newLocation (wrapMap s) (center s) (velocity s) t + r = max 0 (rangeLeft s - distance (wrapMap s) (center s) a) + q = min 128.0 ((radius s) + radiusGrowth * t) instance Damaging SWSide where - damageEnergy self = punch + damageEnergy _ = damE instance Transient SWSide where - expired' self = if rangeLeft self <= 0.0 || integrity self <= 0.0 - then Just [] - else Nothing + expired' s = if expirationFormula s then Just [] else Nothing instance Damageable SWSide where - inflictDamage self d = self { integrity = integrity self - d } + inflictDamage s d = s { integrity = integrity s - d } + +-- | Func abstracting construction of 'SWSide' projectile +prj :: (M.Moving a) + => a -- ^ object receiving projectile + -> (a -> WM) -- ^ func which retrieves WM from object + -> Angle -- ^ firing angle + -> Projectile +prj a f b = Projectile (new (f a) b (M.center a) (M.velocity a)) + diff --git a/Resources.hs b/Resources.hs --- a/Resources.hs +++ b/Resources.hs @@ -26,12 +26,15 @@ import qualified Projectile.Mine as Mine import Item import System.Random +import Math (qArc) initResources = let imageFiles = [ "asteroid.bmp" , "asteroidbig.bmp" , "atank.bmp" , "blade.bmp" , "death.bmp" + , "deflector-1.bmp" + , "deflector-2.bmp" , "interceptor-1.bmp" , "interceptor-2.bmp" , "interceptor-3.bmp" @@ -104,109 +107,105 @@ ] in map (\(p, v) -> Asteroid.new rt wmap (wrappoint wmap p) v) positionsVelocities -stars = - [ Star { Star.location = wrappoint wmap (40.0, 93.0), Star.color = rose } - , Star { Star.location = wrappoint wmap (54.0, 74.0), Star.color = white } - , Star { Star.location = wrappoint wmap (86.0, 38.0), Star.color = white } - , Star { Star.location = wrappoint wmap (30.0, 52.0), Star.color = white } - , Star { Star.location = wrappoint wmap ( 2.0, 24.0), Star.color = orange } - , Star { Star.location = wrappoint wmap (85.0, 76.0), Star.color = white } - , Star { Star.location = wrappoint wmap (27.0, 32.0), Star.color = white } - , Star { Star.location = wrappoint wmap (53.0, 94.0), Star.color = white } - , Star { Star.location = wrappoint wmap (66.0, 37.0), Star.color = green } - , Star { Star.location = wrappoint wmap (39.0, 73.0), Star.color = white } - , Star { Star.location = wrappoint wmap (88.0, 67.0), Star.color = chartreuse } - , Star { Star.location = wrappoint wmap (50.0, 50.0), Star.color = white } - , Star { Star.location = wrappoint wmap (93.0, 33.0), Star.color = white } - , Star { Star.location = wrappoint wmap (25.0, 57.0), Star.color = white } - , Star { Star.location = wrappoint wmap (36.0, 6.0), Star.color = white } - , Star { Star.location = wrappoint wmap (65.0, 61.0), Star.color = white } - , Star { Star.location = wrappoint wmap (43.0, 24.0), Star.color = blue } - , Star { Star.location = wrappoint wmap (54.0, 52.0), Star.color = white } - , Star { Star.location = wrappoint wmap (66.0, 45.0), Star.color = white } - , Star { Star.location = wrappoint wmap (41.0, 67.0), Star.color = white } - , Star { Star.location = wrappoint wmap (37.0, 25.0), Star.color = white } - , Star { Star.location = wrappoint wmap (62.0, 48.0), Star.color = green } - , Star { Star.location = wrappoint wmap (88.0, 73.0), Star.color = white } - , Star { Star.location = wrappoint wmap ( 4.0, 54.0), Star.color = white } - , Star { Star.location = wrappoint wmap (59.0, 77.0), Star.color = white } - , Star { Star.location = wrappoint wmap (73.0, 83.0), Star.color = yellow } - , Star { Star.location = wrappoint wmap (34.0, 24.0), Star.color = white } - , Star { Star.location = wrappoint wmap (58.0, 48.0), Star.color = white } - , Star { Star.location = wrappoint wmap (03.0, 99.0), Star.color = white } - , Star { Star.location = wrappoint wmap (57.0, 46.0), Star.color = aquamarine } - , Star { Star.location = wrappoint wmap (66.0, 67.0), Star.color = white } - , Star { Star.location = wrappoint wmap (31.0, 2.0), Star.color = white } - , Star { Star.location = wrappoint wmap (85.0, 53.0), Star.color = white } - , Star { Star.location = wrappoint wmap (23.0, 77.0), Star.color = white } - , Star { Star.location = wrappoint wmap (97.0, 16.0), Star.color = white } - , Star { Star.location = wrappoint wmap (16.0, 83.0), Star.color = white } - , Star { Star.location = wrappoint wmap (42.0, 45.0), Star.color = magenta } - , Star { Star.location = wrappoint wmap ( 9.0, 67.0), Star.color = white } - , Star { Star.location = wrappoint wmap (33.0, 33.0), Star.color = azure } - , Star { Star.location = wrappoint wmap (27.0, 75.0), Star.color = violet } - , Star { Star.location = wrappoint wmap (36.0, 64.0), Star.color = white } - , Star { Star.location = wrappoint wmap (74.0, 2.0), Star.color = white } - , Star { Star.location = wrappoint wmap (48.0, 46.0), Star.color = cyan } - , Star { Star.location = wrappoint wmap (20.0, 98.0), Star.color = rose } - , Star { Star.location = wrappoint wmap (52.0, 44.0), Star.color = white } - , Star { Star.location = wrappoint wmap (16.0, 38.0), Star.color = white } - , Star { Star.location = wrappoint wmap (32.0, 72.0), Star.color = white } - , Star { Star.location = wrappoint wmap (21.0, 23.0), Star.color = orange } - , Star { Star.location = wrappoint wmap (75.0, 86.0), Star.color = white } - , Star { Star.location = wrappoint wmap (67.0, 34.0), Star.color = white } - , Star { Star.location = wrappoint wmap (55.0, 64.0), Star.color = white } - , Star { Star.location = wrappoint wmap (46.0, 38.0), Star.color = green } - , Star { Star.location = wrappoint wmap (37.0, 73.0), Star.color = white } - , Star { Star.location = wrappoint wmap (38.0, 69.0), Star.color = chartreuse } - , Star { Star.location = wrappoint wmap (52.0, 90.0), Star.color = white } - , Star { Star.location = wrappoint wmap (43.0, 31.0), Star.color = white } - , Star { Star.location = wrappoint wmap (26.0, 27.0), Star.color = white } - , Star { Star.location = wrappoint wmap (86.0, 8.0), Star.color = white } - , Star { Star.location = wrappoint wmap (69.0, 91.0), Star.color = white } - , Star { Star.location = wrappoint wmap (13.0, 22.0), Star.color = blue } - , Star { Star.location = wrappoint wmap (58.0, 72.0), Star.color = white } - , Star { Star.location = wrappoint wmap (96.0, 48.0), Star.color = white } - , Star { Star.location = wrappoint wmap (42.0, 97.0), Star.color = white } - , Star { Star.location = wrappoint wmap (77.0, 28.0), Star.color = white } - , Star { Star.location = wrappoint wmap (63.0, 78.0), Star.color = green } - , Star { Star.location = wrappoint wmap (68.0, 71.0), Star.color = white } - , Star { Star.location = wrappoint wmap ( 2.0, 84.0), Star.color = white } - , Star { Star.location = wrappoint wmap (49.0, 73.0), Star.color = white } - , Star { Star.location = wrappoint wmap (72.0, 83.0), Star.color = yellow } - , Star { Star.location = wrappoint wmap (94.0, 29.0), Star.color = white } - , Star { Star.location = wrappoint wmap (52.0, 98.0), Star.color = white } - , Star { Star.location = wrappoint wmap (73.0, 92.0), Star.color = white } - , Star { Star.location = wrappoint wmap (52.0, 36.0), Star.color = aquamarine } - , Star { Star.location = wrappoint wmap (46.0, 64.0), Star.color = white } - , Star { Star.location = wrappoint wmap (32.0, 82.0), Star.color = white } - , Star { Star.location = wrappoint wmap (35.0, 53.0), Star.color = white } - , Star { Star.location = wrappoint wmap (24.0, 87.0), Star.color = white } - , Star { Star.location = wrappoint wmap (87.0, 17.0), Star.color = white } - , Star { Star.location = wrappoint wmap (16.0, 93.0), Star.color = white } - , Star { Star.location = wrappoint wmap (72.0, 42.0), Star.color = magenta } - , Star { Star.location = wrappoint wmap ( 4.0, 97.0), Star.color = white } - , Star { Star.location = wrappoint wmap (93.0, 33.0), Star.color = azure } - , Star { Star.location = wrappoint wmap (22.0, 5.0), Star.color = violet } - , Star { Star.location = wrappoint wmap (46.0, 68.0), Star.color = white } - , Star { Star.location = wrappoint wmap (76.0, 92.0), Star.color = white } - , Star { Star.location = wrappoint wmap (78.0, 41.0), Star.color = cyan } +stars = map f + [ ((40, 93), rose ) + , ((54, 74), white ) + , ((86, 38), white ) + , ((30, 52), white ) + , (( 2, 24), orange ) + , ((85, 76), white ) + , ((27, 32), white ) + , ((53, 94), white ) + , ((66, 37), green ) + , ((39, 73), white ) + , ((88, 67), chartreuse ) + , ((50, 50), white ) + , ((93, 33), white ) + , ((25, 57), white ) + , ((36, 6), white ) + , ((65, 61), white ) + , ((43, 24), blue ) + , ((54, 52), white ) + , ((66, 45), white ) + , ((41, 67), white ) + , ((37, 25), white ) + , ((62, 48), green ) + , ((88, 73), white ) + , (( 4, 54), white ) + , ((59, 77), white ) + , ((73, 83), yellow ) + , ((34, 24), white ) + , ((58, 48), white ) + , ((03, 99), white ) + , ((57, 46), aquamarine ) + , ((66, 67), white ) + , ((31, 2), white ) + , ((85, 53), white ) + , ((23, 77), white ) + , ((97, 16), white ) + , ((16, 83), white ) + , ((42, 45), magenta ) + , (( 9, 67), white ) + , ((33, 33), azure ) + , ((27, 75), violet ) + , ((36, 64), white ) + , ((74, 2), white ) + , ((48, 46), cyan ) + , ((20, 98), rose ) + , ((52, 44), white ) + , ((16, 38), white ) + , ((32, 72), white ) + , ((21, 23), orange ) + , ((75, 86), white ) + , ((67, 34), white ) + , ((55, 64), white ) + , ((46, 38), green ) + , ((37, 73), white ) + , ((38, 69), chartreuse ) + , ((52, 90), white ) + , ((43, 31), white ) + , ((26, 27), white ) + , ((86, 8), white ) + , ((69, 91), white ) + , ((13, 22), blue ) + , ((58, 72), white ) + , ((96, 48), white ) + , ((42, 97), white ) + , ((77, 28), white ) + , ((63, 78), green ) + , ((68, 71), white ) + , (( 2, 84), white ) + , ((49, 73), white ) + , ((72, 83), yellow ) + , ((94, 29), white ) + , ((52, 98), white ) + , ((73, 92), white ) + , ((52, 36), aquamarine ) + , ((46, 64), white ) + , ((32, 82), white ) + , ((35, 53), white ) + , ((24, 87), white ) + , ((87, 17), white ) + , ((16, 93), white ) + , ((72, 42), magenta ) + , (( 4, 97), white ) + , ((93, 33), azure ) + , ((22, 5), violet ) + , ((46, 68), white ) + , ((76, 92), white ) + , ((78, 41), cyan ) ] - where wmap = wrapmap 100.0 100.0 + where f (x, y) = Star { Star.location = wrappoint (wm 100 100) x + , Star.color = y } initLevels rt = - do let b = blankArena 3000.0 3000.0 - let a = b + do let a = blankArena 3000 3000 let wmap = Universe.wrapMap a let pL = [ -- 1 a { asteroids = asteroidGen rt wmap [ ((1900, 500), (200, -120)) , (( 100, 2900), ( 90, 10)) - -- , ((2500, 1100), ((-100), 100)) - -- , (( 700, 300), (80, 60)) - -- , ((1300, 1400), ((-30), 240)) - -- , ((1000, 2400), (110, 100)) ] , simpleUnits = turretGen rt wmap [ ((-700.0, 300.0), 0.0, 7 * pi / 4) @@ -237,13 +236,13 @@ , ((200, 500), (-180, 110)) ] , simpleUnits = turretGen rt wmap - [ ((-500.0, 200.0), 0.0, 3 * pi / 2 ) + [ ((-500.0, 200.0), 0.0, 3 * qArc ) ] , smartUnits = tankGen rt wmap [ ((-1000.0, 800.0), 0.0) , ((900.0, 600.0), pi) - , ((700.0, -500.0), pi / 2) + , ((700.0, -500.0), qArc) ] ++ aTankGen rt wmap [ ((-1100.0, -900.0), pi + pi / 3) @@ -258,7 +257,7 @@ ] , smartUnits = tankGen rt wmap [ ((-700.0, 600.0), 0.0) - , ((500.0, -1100.0), pi / 2) + , ((500.0, -1100.0), qArc) ] ++ aTankGen rt wmap [ ((-1000.0, 900.0), pi + pi / 3) @@ -504,27 +503,24 @@ , -- 13 a { smartUnits = sTankGen rt wmap - [ ((0, -500.0), pi / 2) - , ((-200, -700.0), pi / 2) - , ((200, -700.0), pi / 2) - , ((-400, -900.0), pi / 2) - -- , ((0, -900.0), pi / 2) - , ((400, -900.0), pi / 2) - , ((-600, -1100.0), pi / 2) - -- , ((-200, -1100.0), pi / 2) - -- , ((200, -1100.0), pi / 2) - , ((600, -1100.0), pi / 2) - , ((-800, -1300.0), pi / 2) - , ((800, -1300.0), pi / 2) + [ ((0, -500.0), qArc) + , ((-200, -700.0), qArc) + , ((200, -700.0), qArc) + , ((-400, -900.0), qArc) + , ((400, -900.0), qArc) + , ((-600, -1100.0), qArc) + , ((600, -1100.0), qArc) + , ((-800, -1300.0), qArc) + , ((800, -1300.0), qArc) ] -- sniperGen rt wmap -- [ ((-600.0, 1000.0), 0.0) -- , ((600.0, 1000.0), 0.0) -- ] , simpleUnits = turretGen rt wmap - [ ((0.0, 1000.0), 0.0, pi / 2) - , ((-600.0, 1000.0), 0.0, - pi / 2) - , ((600.0, 1000.0), 0.0, - pi / 2) + [ ((0.0, 1000.0), 0.0, qArc) + , ((-600.0, 1000.0), 0.0, - qArc) + , ((600.0, 1000.0), 0.0, - qArc) ] , asteroids = asteroidGen rt wmap [ ((1000, 600), (40, -40)) @@ -534,6 +530,45 @@ [ ((-600, 1300), (60, -30)) , ((1400, -1000), (-20, 70)) ] + } + , + -- 14 + a { smartUnits = sTankGen rt wmap + [ ((0, -500.0), 0) + , ((800, -1300.0), 0) + ] ++ + sniperGen rt wmap + [ ((-650, 1200.0), 0.0) + ] ++ + masterGen rt wmap + [ ((-1400, 800.0), 0.0, 20.0) + , ((1000, 400.0), 0.0, 10.0) + ] ++ + ninjaGen rt wmap + [ ((-350.0, -1300.0), pi) + ] ++ + saucerGen rt wmap + [ ((600.0, 400.0), 0.0) + , ((450.0, -1400.0), 0.0) + ] ++ + zeusGen rt wmap + [ ((-1450, 1450.0), 0, 0) ] + , simpleUnits = turretGen rt wmap + [ ((-600, 1000), 0, - qArc) + , ((600, -1000), 0, qArc) + ] + , asteroids = asteroidGen rt wmap + [ ((1200, 800), (50, -70)) + , ((300, -600), (-20, 20)) + ] ++ + bigAsteroidGen rt wmap + [ ((-900, 1100), (30, 30)) + , ((1500, -1200), (30, -65)) + ] + , unitProjectiles = mineGen rt wmap + [ (850, 450) + , (-280, 770) + ] } ] let addItems a = do (it1, it2) <- randomItemPair diff --git a/Star.hs b/Star.hs --- a/Star.hs +++ b/Star.hs @@ -1,13 +1,12 @@ module Star where -import Data.WrapAround -import Animation -import Graphics.Gloss.Data.Picture -import Graphics.Gloss.Data.Color -import GHC.Float -import Moving +import Data.WrapAround (WP) +import Animation (Animation(..)) +import Graphics.Gloss.Data.Picture (rectangleSolid, Picture(..)) +import Graphics.Gloss.Data.Color (Color) +import Moving (Locatable(..)) -data Star = Star { location :: WrapPoint +data Star = Star { location :: WP , color :: Color } diff --git a/Unit.hs b/Unit.hs --- a/Unit.hs +++ b/Unit.hs @@ -2,6 +2,7 @@ module Unit ( SimpleUnit (..) , SmartUnit (..) + , firing ) where import Animation ( Audible (..) @@ -14,11 +15,14 @@ import Combat ( Damaging (..) , Damageable (..) , Launcher (..) + , Projectile ) import Updating ( Transient (..) , InternallyUpdating (..) , Observant (..) ) +import Common (Time, Angle) +import Data.Maybe (isNothing, fromJust) -- Simple, i.e., no sensory awareness and related A.I. data SimpleUnit = forall a. ( Animation a @@ -112,4 +116,19 @@ terminateAudio (SmartUnit a) = do a' <- terminateAudio a return (SmartUnit a') + +-- | Func abstracting the firing of projectiles +firing :: a -- ^ the object + -> (a -> Time) -- ^ func that retrieves time since last shot + -> Time -- ^ desired shot delay + -> (a -> Time -> a) -- ^ func which sets time since last shot in object + -> (a -> [Projectile] -> a) -- ^ func which sets projectiles in object + -> (a -> Bool -> a) -- ^ func which sets shot sound queued status + -> [Projectile] -- ^ new projectiles + -> Time -- ^ elapsed time + -> (a -> [Projectile]) -- ^ func which retrieves projectiles in object + -> a +firing a f b g h i c d j = + if m >= b then i (h (g a 0) (c ++ j a)) True else g a m + where m = f a + d diff --git a/Unit/Simple/Turret.hs b/Unit/Simple/Turret.hs --- a/Unit/Simple/Turret.hs +++ b/Unit/Simple/Turret.hs @@ -2,120 +2,74 @@ , new ) where -import Data.WrapAround -import Animation -import Graphics.Gloss.Data.Picture -import Graphics.Gloss.Data.Color -import GHC.Float -import Math -import ResourceTracker -import Updating -import qualified Moving as M -import Combat -import qualified Projectile.BulletSI as P.BulletSI -import AfterEffect -import qualified AfterEffect.SimpleExplosion as SimpleExplosion -import Data.Maybe -import Sound.ALUT -import Common +import Data.WrapAround (WP, WM) +import Animation (Audible(..), Animation(..), handSndSrc, termSndSrc, reorient) +import Math (appPair) +import ResourceTracker (RT, protectedGetImage) +import Updating (InternallyUpdating(..), Transient(..)) +import qualified Moving as M (Locatable(..) + , Moving(..) + , Colliding(..) + , newLocation') +import Combat (Launcher(..), Damageable(..), Damaging(..), Projectile(..)) +import qualified Projectile.BulletSI as P.BulletSI (prj) +import AfterEffect (AfterEffect(..)) +import qualified AfterEffect.SimpleExplosion as SimpleExplosion (new) +import Sound.ALUT (Source(..)) +import Common (Angle, Velocity, Time) +import Unit (firing) -radialVelocity = pi/6 -- radians per second +radVelocity = pi/6 -- radians per second -velocityMagnitude = 40 +velMagnitude = 40 -kamikazeDamage = 6.0 +kamikazeDmg = 6.0 -maxIntegrity = 2.0 +maxInteg = 2.0 -data Turret = Turret { turretAngle :: Angle -- radians +cRadius = 16 + +data Turret = Turret { tAngle :: Angle , velocity :: Velocity - , center :: WrapPoint - , idealTargetLocation :: Maybe WrapPoint - , wrapMap :: WrapMap + , center :: WP + , wmap :: WM , launchTube :: [Projectile] , sinceLastShot :: Time , integrity :: Double - , animDefault0 :: Picture - , resourceTracker :: ResourceTracker - - -- Sound - , queueShotSound :: Bool - , shotSoundSource :: Maybe Source + , rt :: RT + , queueShotSnd :: Bool + , shotSndSrc :: Maybe Source } instance Audible Turret where - processAudio self lcenter = - do self' <- if isNothing (shotSoundSource self) - then initializeShotSoundSource self - else return self - if not (queueShotSound self) - then return self' - else do let (x, y) = vectorRelation - (wrapMap self) - (lcenter) - (center self) - let s = fromJust $ shotSoundSource self - sourcePosition s $= (Vertex3 (double2Float x) - (double2Float (-y)) - 0) - play [s] - return self' { queueShotSound = False } - - terminateAudio self = - if isNothing (shotSoundSource self) - then return self - else do stop [fromJust (shotSoundSource self)] - return self - -initializeShotSoundSource self = - do [source] <- genObjectNames 1 - buffer source $= getSound (resourceTracker self) "energy-shot-02.wav" - -- ... - sourceRelative source $= Listener - referenceDistance source $= audioReferenceDistance --- maxDistance source $= audioMaxDistance - rolloffFactor source $= audioRolloffFactor - return self { shotSoundSource = Just source } + processAudio s a = handSndSrc s + queueShotSnd + shotSndSrc + (\a -> a { queueShotSnd = False }) + rt + "energy-shot-02.wav" + (\a b -> a { shotSndSrc = Just b }) + a (wmap s) (M.center) -new :: ResourceTracker - -> WrapMap - -> WrapPoint - -> Angle - -> Angle - -> Turret -new rt wmap center' tAngle mAngle = - let pic = fromMaybe - (Scale 0.20 0.20 - (Color white - (Text "Error! Missing image!"))) - (getImage rt "turret.bmp") in - Turret { center = center' - , turretAngle = tAngle - , idealTargetLocation = Nothing - , velocity = velocity' - , wrapMap = wmap - , launchTube = [] - , sinceLastShot = 0.0 - , integrity = maxIntegrity - , animDefault0 = pic - , resourceTracker = rt + terminateAudio s = termSndSrc s shotSndSrc - , queueShotSound = False - , shotSoundSource = Nothing - } - where velocity' =( sin mAngle * velocityMagnitude - , cos mAngle * velocityMagnitude - ) +new a b c d e = Turret { center = c + , tAngle = d + , velocity = appPair (* velMagnitude) (sin e, cos e) + , wmap = b + , launchTube = [] + , sinceLastShot = 0 + , integrity = maxInteg + , rt = a + , queueShotSnd = False + , shotSndSrc = Nothing + } -updateAngle t self - = self { turretAngle = turretAngle self - radialVelocity * t} +updateAngle t s = s { tAngle = tAngle s - radVelocity * t} instance Animation Turret where - image self _ = Rotate - (double2Float - (radToDeg ((turretAngle self)) * (-1) - 90)) - (animDefault0 self) + image s _ = reorient (tAngle s) (protectedGetImage (rt s) "turret.bmp") instance M.Locatable Turret where center = center @@ -124,62 +78,38 @@ velocity = velocity instance M.Colliding Turret where - collisionRadius _ = 16.0 + collisionRadius _ = cRadius instance InternallyUpdating Turret where - preUpdate self t = (updateFiringInformation t - . updateIdealTargetLocation t - . updateAngle t) self - - postUpdate self t = - let center' = fromMaybe (center self) (idealTargetLocation self) in - self { center = center' - , idealTargetLocation = Nothing - } - -updateFiringInformation t self = - let sinceLastShot' = sinceLastShot self + t in - if sinceLastShot' >= 1.5 - then self { sinceLastShot = 0.0 - , launchTube = launchTube self ++ projectiles - , queueShotSound = True - } - else self { sinceLastShot = sinceLastShot' } - where projectiles = map projectile [ 0.0, pi / 2, pi, 3 * pi / 2 ] - projectile x = Projectile ( P.BulletSI.new - (wrapMap self) - (turretAngle self + x) - (center self) - (velocity self) ) + preUpdate s t = (updateFiringInformation t . updateAngle t) s + postUpdate s t = s { center = M.newLocation' s (wmap s) t } -updateIdealTargetLocation :: Time -> Turret -> Turret -updateIdealTargetLocation t self = - self { idealTargetLocation = Just (M.newLocation (wrapMap self) - (center self) - (velocity self) - t) - } +updateFiringInformation t s = firing s sinceLastShot 1.5 + (\x y -> x { sinceLastShot = y }) + (\x y -> x { launchTube = y }) + (\x y -> x { queueShotSnd = y }) + p t launchTube + where p = map f [ 0.0, pi / 2, pi, 3 * pi / 2 ] + f x = P.BulletSI.prj s wmap (tAngle s + x) instance Launcher Turret where - deployProjectiles self = (launchTube self, self { launchTube = [] }) + deployProjectiles s = (launchTube s, s { launchTube = [] }) instance Transient Turret where - expired' self = if integrity self > 0.0 - then Nothing - else Just [aeffect] - where aeffect = AfterEffect (SimpleExplosion.new (resourceTracker self) - (wrapMap self) - (center self) - (velocity self)) + expired' s = if integrity s > 0 then Nothing else Just [a] + where a = AfterEffect (SimpleExplosion.new (rt s) + (wmap s) + (center s) + (velocity s)) instance Damageable Turret where - inflictDamage self d = self { integrity = max 0.0 (integrity self - d) } + inflictDamage s d = s { integrity = max 0 (integrity s - d) } instance Damaging Turret where - damageEnergy self = kamikazeDamage + damageEnergy s = kamikazeDmg diff --git a/Unit/Smart/ATank.hs b/Unit/Smart/ATank.hs --- a/Unit/Smart/ATank.hs +++ b/Unit/Smart/ATank.hs @@ -2,149 +2,104 @@ , new ) where -import Data.WrapAround +import Data.WrapAround ( WP, WM ) import Animation -import Graphics.Gloss.Data.Picture -import Graphics.Gloss.Data.Color -import GHC.Float -import Math -import ResourceTracker + ( Audible(..), Animation(..), termSndSrc, reorient, handSndSrc ) +import Graphics.Gloss.Data.Picture () +import Graphics.Gloss.Data.Color () +import GHC.Float () +import Math ( moreThanZero ) +import ResourceTracker ( ResourceTracker, protectedGetImage ) import Updating + ( Transient(..), Observant(..), InternallyUpdating(..) ) import qualified Moving as M + ( Moving(..), + Locatable(..), + Colliding(..), + newVelocity, + newLocation ) import Combat -import qualified Projectile.BulletMI as P.BulletMI -import AfterEffect + ( Projectile, Launcher(..), Damaging(..), Damageable(..) ) +import qualified Projectile.BulletMI as P.BulletMI ( prj ) +import AfterEffect ( AfterEffect(AfterEffect) ) import qualified AfterEffect.SimpleExplosion as SimpleExplosion -import Data.Maybe -import Universe hiding (wrapMap, resourceTracker) -import qualified Universe as U -import Sound.ALUT -import Common - -radialVelocity = pi/4 -- radians per second + ( new ) +import Data.Maybe () +import Universe ( Arena ) +import qualified Universe as U () +import Sound.ALUT ( Source ) +import Common ( Velocity, Time, Angle ) +import UnitUtil ( adjAngle, firingAngle ) +import Unit ( firing ) +radialVelocity = pi/4 maxVelocityMag = 60 - -kamikazeDamage = 14.0 - +kamikazeDamage = 14 maxIntegrity = 4 - accelerationRate = 40 +collisionR = 20 data ATank = ATank { angle :: Angle -- radians - , velocity :: Velocity - , center :: WrapPoint - , idealTargetLocation :: Maybe WrapPoint - , wrapMap :: WrapMap - , launchTube :: [Projectile] - , sinceLastShot :: Time - , integrity :: Double - , vision :: Maybe Arena - , resourceTracker :: ResourceTracker - - -- Sound - , queueShotSound :: Bool - , shotSoundSource :: Maybe Source - } + , velocity :: Velocity + , center :: WP + , wmap :: WM + , launchTube :: [Projectile] + , sinceLastShot :: Time + , integrity :: Double + , vision :: Maybe Arena + , rt :: ResourceTracker + , queueShotSnd :: Bool + , shotSndSrc :: Maybe Source + } instance Audible ATank where - processAudio self lcenter = - do self' <- if isNothing (shotSoundSource self) - then initializeShotSoundSource self - else return self - if not (queueShotSound self) - then return self' - else do let (x, y) = vectorRelation - (wrapMap self) - (lcenter) - (center self) - let s = fromJust $ shotSoundSource self - sourcePosition s $= (Vertex3 (double2Float x) - (double2Float (-y)) - 0) - play [s] - return self' { queueShotSound = False } - - terminateAudio self = - if isNothing (shotSoundSource self) - then return self - else do stop [fromJust (shotSoundSource self)] - return self + processAudio s a = handSndSrc s + queueShotSnd + shotSndSrc + (\a -> a { queueShotSnd = False }) + rt + "energy-shot-02.wav" + (\a b -> a { shotSndSrc = Just b }) + a (wmap s) (M.center) -initializeShotSoundSource self = - do [source] <- genObjectNames 1 - buffer source $= getSound (resourceTracker self) "energy-shot-02.wav" - -- ... - sourceRelative source $= Listener - referenceDistance source $= audioReferenceDistance --- maxDistance source $= audioMaxDistance - rolloffFactor source $= audioRolloffFactor - return self { shotSoundSource = Just source } + terminateAudio s = termSndSrc s shotSndSrc new :: ResourceTracker - -> WrapMap - -> WrapPoint + -> WM + -> WP -> Angle -> ATank -new rt wmap center' angle' = - ATank { center = center' - , angle = angle' - , idealTargetLocation = Nothing - , velocity = (0.0, 0.0) - , wrapMap = wmap - , launchTube = [] - , sinceLastShot = 0.0 - , integrity = maxIntegrity - , vision = Nothing - , resourceTracker = rt - - , queueShotSound = False - , shotSoundSource = Nothing - } +new a b c d = + ATank { center = c + , angle = d + , velocity = (0.0, 0.0) + , wmap = b + , launchTube = [] + , sinceLastShot = 0.0 + , integrity = maxIntegrity + , vision = Nothing + , rt = a + , queueShotSnd = False + , shotSndSrc = Nothing + } instance Observant ATank where - updateVision self arena = self { vision = Just arena } + updateVision s a = s { vision = Just a } -updateAngle t self - = case vision self of - Nothing -> self - Just arena -> if isNothing (lance arena) - then self - else let sDir = vectorDirection (velocity self) in - let tDir = vectorDirection - (vectorRelation - (U.wrapMap arena) - (center self) - (M.center (fromJust (lance arena)))) in - let adj - | tDir - sDir > pi / 6 = radialVelocity * t - | tDir -sDir < (-pi) / 6 = (-radialVelocity) * t - | otherwise = 0.0 in - self { angle = angle self + adj } +updateAngle t s = adjAngle s t vision (\x y -> x { angle = y }) angle (pi / 6) radialVelocity -updateVelocity :: Time -> ATank -> ATank -updateVelocity t self = - self { velocity = M.newVelocity - (velocity self) - accelerationRate - (angle self) - maxVelocityMag - t - } +updateVelocity t s = s { velocity = M.newVelocity + (velocity s) + accelerationRate + (angle s) + maxVelocityMag + t + } instance Animation ATank where - image self _ = Rotate (double2Float - (radToDeg - (angle self)) * (-1) - 90) - pic - where pic = fromMaybe - (Scale 0.20 0.20 - (Color white - (Text "Error! Missing image!"))) - (getImage rt "atank.bmp") - rt = resourceTracker self + image s _ = reorient (angle s) (protectedGetImage (rt s) "atank.bmp") instance M.Locatable ATank where center = center @@ -153,72 +108,38 @@ velocity = velocity instance M.Colliding ATank where - collisionRadius _ = 20.0 + collisionRadius _ = collisionR instance InternallyUpdating ATank where - preUpdate self t = (updateFiringInformation t - . updateIdealTargetLocation t - . updateVelocity t - . updateAngle t) self - - postUpdate self t = - let center' = fromMaybe (center self) (idealTargetLocation self) in - self { center = center' - , idealTargetLocation = Nothing - } + preUpdate s t = (updateFiringInformation t + . updateVelocity t + . updateAngle t) s -updateFiringInformation t self = - let sinceLastShot' = sinceLastShot self + t in - if sinceLastShot' >= 2.5 - then self { sinceLastShot = 0.0 - , launchTube = projectile : launchTube self - , queueShotSound = True - } - else self { sinceLastShot = sinceLastShot' } - where projectile = Projectile - (P.BulletMI.new - (wrapMap self) - pAngle - (center self) - (velocity self)) - pAngle = case vision self of - Nothing -> angle self - Just arena -> - case lance arena of - Nothing -> angle self - Just l -> vectorDirection - (vectorRelation - (U.wrapMap arena) - (center self) - (M.center l)) + postUpdate s t = + s { center = M.newLocation (wmap s) (center s) (velocity s) t } -updateIdealTargetLocation :: Time -> ATank -> ATank -updateIdealTargetLocation t self = - self { idealTargetLocation = Just (M.newLocation (wrapMap self) - (center self) - (velocity self) - t) - } +updateFiringInformation t s = firing s sinceLastShot 1.5 + (\x y -> x { sinceLastShot = y }) + (\x y -> x { launchTube = y }) + (\x y -> x { queueShotSnd = y }) + [p] t launchTube + where p = P.BulletMI.prj s wmap (firingAngle s vision angle) instance Launcher ATank where - deployProjectiles self = (launchTube self, self { launchTube = [] }) + deployProjectiles s = (launchTube s, s { launchTube = [] }) instance Transient ATank where - expired' self = if integrity self > 0.0 - then Nothing - else Just [aeffect] - where aeffect = AfterEffect (SimpleExplosion.new (resourceTracker self) - (wrapMap self) - (center self) - (velocity self)) + expired' s = if moreThanZero (integrity s) then Nothing else Just [a] + where a = AfterEffect + (SimpleExplosion.new (rt s)(wmap s) (center s) (velocity s)) instance Damageable ATank where - inflictDamage self d = self { integrity = max 0.0 (integrity self - d) } + inflictDamage s d = s { integrity = max 0 (integrity s - d) } instance Damaging ATank where - damageEnergy self = kamikazeDamage + damageEnergy s = kamikazeDamage diff --git a/Unit/Smart/Death.hs b/Unit/Smart/Death.hs --- a/Unit/Smart/Death.hs +++ b/Unit/Smart/Death.hs @@ -2,171 +2,132 @@ , new ) where -import Data.WrapAround +import Data.WrapAround ( WP, WM, vectorRelation ) import Animation -import Graphics.Gloss.Data.Picture -import Graphics.Gloss.Data.Color -import GHC.Float + ( Audible(..), Animation(..), termSndSrc, handSndSrc ) +import Graphics.Gloss.Data.Picture () +import Graphics.Gloss.Data.Color () +import GHC.Float () import Math -import ResourceTracker + ( vectorDirection, targetingA, subV, moreThanZero, isNan ) +import ResourceTracker ( RT, protectedGetImage ) import Updating + ( Transient(..), Observant(..), InternallyUpdating(..) ) import qualified Moving as M + ( Moving(..), + Locatable(..), + Colliding(..), + newVelocity, + newLocation ) import Combat -import qualified Projectile.BulletSII as P.BulletSII -import qualified Projectile.BulletMII as P.BulletMII -import AfterEffect + ( Projectile(..), Launcher(..), Damaging(..), Damageable(..) ) +import qualified Projectile.BulletSII as P.BulletSII ( speed, new ) +import qualified Projectile.BulletMII as P.BulletMII ( new ) +import AfterEffect ( AfterEffect(AfterEffect) ) import qualified AfterEffect.SimpleExplosion as SimpleExplosion -import Data.Maybe -import Universe hiding (wrapMap, resourceTracker) -import qualified Universe as U -import Sound.ALUT -import Common + ( new ) +import Data.Maybe () +import Universe ( Arena(lance) ) +import qualified Universe as U ( Arena(wrapMap) ) +import Sound.ALUT ( Source ) +import Common ( Velocity, Time, Angle ) -radialVelocity = pi -- radians per second -maxVelocityMag = 200.0 - -kamikazeDamage = 100.0 - +radialVelocity = pi +maxVelocityMag = 200 +kamikazeDamage = 100 maxIntegrity = 12 - -accelerationRate = 200.0 - -adjAngle = pi / 8 - -shotDelay_sniper = 3.0 - -shotDelay_spread = 2.0 +accelerationRate = 200 +adjAngleC = pi / 8 +shotDelay_sniper = 3 +shotDelay_spread = 2 +collisionR = 60 data Death = Death { angle :: Angle -- radians , velocity :: Velocity - , center :: WrapPoint - , idealTargetLocation :: Maybe WrapPoint - , wrapMap :: WrapMap + , center :: WP + , idealTargetLocation :: Maybe WP + , wmap :: WM , launchTube :: [Projectile] , sinceLastShot_sniper :: Time , sinceLastShot_spread :: Time , integrity :: Double , vision :: Maybe Arena - , resourceTracker :: ResourceTracker - - -- Sound - , queueShotSound :: Bool - , shotSoundSource :: Maybe Source + , rt :: RT + , queueShotSnd :: Bool + , shotSndSrc :: Maybe Source } instance Audible Death where - processAudio self lcenter = - do self' <- if isNothing (shotSoundSource self) - then initializeShotSoundSource self - else return self - if not (queueShotSound self) - then return self' - else do let (x, y) = vectorRelation - (wrapMap self) - (lcenter) - (center self) - let s = fromJust $ shotSoundSource self - sourcePosition s $= (Vertex3 (double2Float x) - (double2Float (-y)) - 0) - play [s] - return self' { queueShotSound = False } - - terminateAudio self = - if isNothing (shotSoundSource self) - then return self - else do stop [fromJust (shotSoundSource self)] - return self - -initializeShotSoundSource self = - do [source] <- genObjectNames 1 - buffer source $= getSound (resourceTracker self) "energy-shot-02.wav" - sourceRelative source $= Listener - referenceDistance source $= audioReferenceDistance - rolloffFactor source $= audioRolloffFactor - return self { shotSoundSource = Just source } + processAudio s a = handSndSrc s + queueShotSnd + shotSndSrc + (\a -> a { queueShotSnd = False }) + rt + "energy-shot-02.wav" + (\a b -> a { shotSndSrc = Just b }) + a (wmap s) (M.center) -new :: ResourceTracker - -> WrapMap - -> WrapPoint - -> Angle - -> Death -new rt wmap center' angle' = - Death { center = center' - , angle = angle' - , idealTargetLocation = Nothing - , velocity = (0.0, 0.0) - , wrapMap = wmap - , launchTube = [] - , sinceLastShot_sniper = 0.0 - , sinceLastShot_spread = 0.0 - , integrity = maxIntegrity - , vision = Nothing - , resourceTracker = rt + terminateAudio s = termSndSrc s shotSndSrc - , queueShotSound = False - , shotSoundSource = Nothing - } +new a b c d = Death { center = c + , angle = d + , idealTargetLocation = Nothing + , velocity = (0, 0) + , wmap = b + , launchTube = [] + , sinceLastShot_sniper = 0 + , sinceLastShot_spread = 0 + , integrity = maxIntegrity + , vision = Nothing + , rt = a + , queueShotSnd = False + , shotSndSrc = Nothing + } instance Observant Death where - updateVision self arena = self { vision = Just arena } + updateVision s a = s { vision = Just a } -updateAngle t self - = case vision self of - Nothing -> self +updateAngle t s + = case vision s of + Nothing -> s Just a -> case lance a of - Nothing -> self - Just l -> let sDir = angle self in - let sDir' = if sDir == 0.0 / 0.0 - then 0.1 - else sDir in - let tDir = vectorDirection + Nothing -> s + Just l -> let b = angle s in + let e = if isNan b then 0.1 else b in + let m = vectorDirection (vectorRelation - (wrapMap self) - (center self) + (wmap s) + (center s) (M.center l)) in let adj - | tDir - sDir' > adjAngle = radialVelocity * t - | tDir - sDir' < (-1) * adjAngle = (-radialVelocity) * t - | otherwise = 0.0 in - self { angle = angle self + adj } + | m - e > adjAngleC = radialVelocity * t + | m - e < (-1) * adjAngleC = (-radialVelocity) * t + | otherwise = 0 in + s { angle = angle s + adj } -updateVelocity t self = - let thrustingVelocity = M.newVelocity - (velocity self) - accelerationRate - (angle self) - maxVelocityMag - t in - let velocity' = case vision self of - Nothing -> velocity self - Just a -> - case lance a of - Nothing -> velocity self - Just l -> let sDir = angle self in - let sDir' = if sDir == 0.0 / 0.0 - then 0.1 - else sDir in - let tDir = vectorDirection - (vectorRelation - (wrapMap self) - (center self) - (M.center l)) in - if abs (tDir - sDir') <= adjAngle - then thrustingVelocity - else velocity self in - self { velocity = velocity' } +updateVelocity t s = + s { velocity = b } + where c = M.newVelocity + (velocity s) accelerationRate (angle s) maxVelocityMag t + b = case vision s of + Nothing -> velocity s + Just a -> + case lance a of + Nothing -> velocity s + Just l -> let d = angle s in + let e = if isNan d then 0.1 else d in + let m = vectorDirection + (vectorRelation + (wmap s) + (center s) + (M.center l)) in + if abs (m - e) <= adjAngleC then c else velocity s instance Animation Death where - image self _ = fromMaybe - (Scale 0.20 0.20 - (Color white - (Text "Error! Missing image!"))) - (getImage rt "death.bmp") - where rt = resourceTracker self + image s _ = protectedGetImage (rt s) "death.bmp" instance M.Locatable Death where center = center @@ -175,35 +136,31 @@ velocity = velocity instance M.Colliding Death where - collisionRadius _ = 60.0 + collisionRadius _ = collisionR instance InternallyUpdating Death where - preUpdate self t = (updateFiringInformation t - . updateIdealTargetLocation t - . updateVelocity t - . updateAngle t) self + preUpdate s t = (updateFiringInformation t + . updateVelocity t + . updateAngle t) s - postUpdate self t = - let center' = fromMaybe (center self) (idealTargetLocation self) in - self { center = center' - , idealTargetLocation = Nothing - } + postUpdate s t = + s { center = M.newLocation (wmap s) (center s) (velocity s) t } -updateFiringInformation t self = - fst $ (handleSpreadFiring . handleSniperFiring) (self, t) +updateFiringInformation t s = + fst ((handleSpreadFiring . handleSniperFiring) (s, t)) handleSniperFiring (self, t) = let sinceLastShot_sniper' = sinceLastShot_sniper self + t in if sinceLastShot_sniper' >= shotDelay_sniper then (self { sinceLastShot_sniper = 0.0 , launchTube = projectile : launchTube self - , queueShotSound = True + , queueShotSnd = True }, t) else (self { sinceLastShot_sniper = sinceLastShot_sniper' }, t) where projectile = Projectile (P.BulletSII.new - (wrapMap self) + (wmap self) pAngle (center self) (velocity self)) @@ -228,13 +185,13 @@ if sinceLastShot_spread' >= shotDelay_spread then (self { sinceLastShot_spread = 0.0 , launchTube = projectiles ++ launchTube self - , queueShotSound = True + , queueShotSnd = True }, t) else (self { sinceLastShot_spread = sinceLastShot_spread' }, t) where projectiles = map projectile [ x * pi / 8.0 - pi / 4.0 | x <- [0..7] ] projectile x = Projectile (P.BulletMII.new - (wrapMap self) + (wmap self) (pAngle + x) (center self) (velocity self)) @@ -249,32 +206,22 @@ (center self) (M.center l)) -updateIdealTargetLocation :: Time -> Death -> Death -updateIdealTargetLocation t self = - self { idealTargetLocation = Just (M.newLocation (wrapMap self) - (center self) - (velocity self) - t) - } instance Launcher Death where - deployProjectiles self = (launchTube self, self { launchTube = [] }) + deployProjectiles s = (launchTube s, s { launchTube = [] }) instance Transient Death where - expired' self = if integrity self > 0.0 - then Nothing - else Just [aeffect] - where aeffect = AfterEffect (SimpleExplosion.new (resourceTracker self) - (wrapMap self) - (center self) - (velocity self)) + expired' s = if moreThanZero (integrity s) then Nothing else Just [a] + where a = AfterEffect + (SimpleExplosion.new (rt s) (wmap s) (center s) (velocity s)) + instance Damageable Death where - inflictDamage self d = self { integrity = max 0.0 (integrity self - d) } + inflictDamage s d = s { integrity = max 0 (integrity s - d) } instance Damaging Death where - damageEnergy self = kamikazeDamage + damageEnergy _ = kamikazeDamage diff --git a/Unit/Smart/Master.hs b/Unit/Smart/Master.hs --- a/Unit/Smart/Master.hs +++ b/Unit/Smart/Master.hs @@ -37,9 +37,9 @@ data Master = Master { angle :: Angle -- radians , velocity :: Velocity - , center :: WrapPoint - , idealTargetLocation :: Maybe WrapPoint - , wrapMap :: WrapMap + , center :: WP + , idealTargetLocation :: Maybe WP + , wrapMap :: WM , launchTube :: [Projectile] , sinceLastShot :: Time , integrity :: Double @@ -88,8 +88,8 @@ return self { shotSoundSource = Just source } new :: ResourceTracker - -> WrapMap - -> WrapPoint + -> WM + -> WP -> Angle -> Time -> Master diff --git a/Unit/Smart/Ninja.hs b/Unit/Smart/Ninja.hs --- a/Unit/Smart/Ninja.hs +++ b/Unit/Smart/Ninja.hs @@ -37,9 +37,9 @@ data Ninja = Ninja { angle :: Angle -- radians , velocity :: Velocity - , center :: WrapPoint - , idealTargetLocation :: Maybe WrapPoint - , wrapMap :: WrapMap + , center :: WP + , idealTargetLocation :: Maybe WP + , wrapMap :: WM , launchTube :: [Projectile] , sinceLastShot :: Time , integrity :: Double @@ -86,8 +86,8 @@ return self { shotSoundSource = Just source } new :: ResourceTracker - -> WrapMap - -> WrapPoint + -> WM + -> WP -> Angle -> Ninja new rt wmap center' angle' = diff --git a/Unit/Smart/STank.hs b/Unit/Smart/STank.hs --- a/Unit/Smart/STank.hs +++ b/Unit/Smart/STank.hs @@ -2,151 +2,105 @@ , new ) where -import Data.WrapAround +import Data.WrapAround ( WP, WM ) import Animation -import Graphics.Gloss.Data.Picture -import Graphics.Gloss.Data.Color -import GHC.Float -import Math -import ResourceTracker + ( Audible(..), Animation(..), termSndSrc, reorient, handSndSrc ) +import Graphics.Gloss.Data.Picture () +import Graphics.Gloss.Data.Color () +import GHC.Float () +import Math ( moreThanZero ) +import ResourceTracker ( ResourceTracker, protectedGetImage ) import Updating + ( Transient(..), Observant(..), InternallyUpdating(..) ) import qualified Moving as M + ( Moving(..), + Locatable(..), + Colliding(..), + newVelocity, + newLocation ) import Combat -import qualified Projectile.BulletMII as P.BulletMII -import AfterEffect + ( Projectile, Launcher(..), Damaging(..), Damageable(..) ) +import qualified Projectile.BulletMII as P.BulletMII ( prj ) +import AfterEffect ( AfterEffect(AfterEffect) ) import qualified AfterEffect.SimpleExplosion as SimpleExplosion -import Data.Maybe -import Universe hiding (wrapMap, resourceTracker) -import qualified Universe as U -import Sound.ALUT -import Common - -radialVelocity = pi/4 -- radians per second + ( new ) +import Data.Maybe () +import Universe ( Arena ) +import qualified Universe as U () +import Sound.ALUT ( Source ) +import Common ( Velocity, Time, Angle ) +import UnitUtil ( adjAngle, firingAngle ) +import Unit ( firing ) +radialVelocity = pi/4 maxVelocityMag = 100 - -kamikazeDamage = 20.0 - +kamikazeDamage = 20 maxIntegrity = 6 - accelerationRate = 60 - -collisionRadiusC = 45 - -shotDelay = 2.0 +collisionR = 45 +shotDelay = 2 -data STank = STank { angle :: Angle +data STank = STank { angle :: Angle -- radians , velocity :: Velocity - , center :: WrapPoint - , idealTargetLocation :: Maybe WrapPoint - , wrapMap :: WrapMap + , center :: WP + , wmap :: WM , launchTube :: [Projectile] , sinceLastShot :: Time , integrity :: Double , vision :: Maybe Arena - , resourceTracker :: ResourceTracker - - -- Sound - , queueShotSound :: Bool - , shotSoundSource :: Maybe Source + , rt :: ResourceTracker + , queueShotSnd :: Bool + , shotSndSrc :: Maybe Source } instance Audible STank where - processAudio self lcenter = - do self' <- if isNothing (shotSoundSource self) - then initializeShotSoundSource self - else return self - if not (queueShotSound self) - then return self' - else do let (x, y) = vectorRelation - (wrapMap self) - (lcenter) - (center self) - let s = fromJust $ shotSoundSource self - sourcePosition s $= (Vertex3 (double2Float x) - (double2Float (-y)) - 0) - play [s] - return self' { queueShotSound = False } - - terminateAudio self = - if isNothing (shotSoundSource self) - then return self - else do stop [fromJust (shotSoundSource self)] - return self + processAudio s a = handSndSrc s + queueShotSnd + shotSndSrc + (\a -> a { queueShotSnd = False }) + rt + "energy-shot-02.wav" + (\a b -> a { shotSndSrc = Just b }) + a (wmap s) (M.center) -initializeShotSoundSource self = - do [source] <- genObjectNames 1 - buffer source $= getSound (resourceTracker self) "energy-shot-02.wav" - sourceRelative source $= Listener - referenceDistance source $= audioReferenceDistance - rolloffFactor source $= audioRolloffFactor - return self { shotSoundSource = Just source } + terminateAudio s = termSndSrc s shotSndSrc new :: ResourceTracker - -> WrapMap - -> WrapPoint + -> WM + -> WP -> Angle -> STank -new rt wmap center' angle' = - STank { center = center' - , angle = angle' - , idealTargetLocation = Nothing - , velocity = (0.0, 0.0) - , wrapMap = wmap - , launchTube = [] - , sinceLastShot = 0.0 - , integrity = maxIntegrity - , vision = Nothing - , resourceTracker = rt - - , queueShotSound = False - , shotSoundSource = Nothing - } +new a b c d = + STank { center = c + , angle = d + , velocity = (0.0, 0.0) + , wmap = b + , launchTube = [] + , sinceLastShot = 0.0 + , integrity = maxIntegrity + , vision = Nothing + , rt = a + , queueShotSnd = False + , shotSndSrc = Nothing + } instance Observant STank where - updateVision self arena = self { vision = Just arena } + updateVision s a = s { vision = Just a } -updateAngle t self - = case vision self of - Nothing -> self - Just arena -> if isNothing (lance arena) - then self - else let sDir = vectorDirection (velocity self) in - let tDir = vectorDirection - (vectorRelation - (U.wrapMap arena) - (center self) - (M.center (fromJust (lance arena)))) in - let adj - | tDir - sDir > pi / 6 = radialVelocity * t - | tDir -sDir < (-pi) / 6 = (-radialVelocity) * t - | otherwise = 0.0 in - self { angle = angle self + adj } +updateAngle t s = adjAngle s t vision (\x y -> x { angle = y }) angle (pi / 6) radialVelocity -updateVelocity :: Time -> STank -> STank -updateVelocity t self = - self { velocity = M.newVelocity - (velocity self) - accelerationRate - (angle self) - maxVelocityMag - t - } +updateVelocity t s = s { velocity = M.newVelocity + (velocity s) + accelerationRate + (angle s) + maxVelocityMag + t + } instance Animation STank where - image self _ = Rotate (double2Float - (radToDeg - (angle self)) * (-1) - 90) - pic - where pic = fromMaybe - (Scale 0.20 0.20 - (Color white - (Text "Error! Missing image!"))) - (getImage rt "stank.bmp") - rt = resourceTracker self + image s _ = reorient (angle s) (protectedGetImage (rt s) "stank.bmp") instance M.Locatable STank where center = center @@ -155,87 +109,40 @@ velocity = velocity instance M.Colliding STank where - collisionRadius _ = collisionRadiusC + collisionRadius _ = collisionR instance InternallyUpdating STank where - preUpdate self t = (updateFiringInformation t - . updateIdealTargetLocation t - . updateVelocity t - . updateAngle t) self - - postUpdate self t = - let center' = fromMaybe (center self) (idealTargetLocation self) in - self { center = center' - , idealTargetLocation = Nothing - } + preUpdate s t = (updateFiringInformation t + . updateVelocity t + . updateAngle t) s -updateFiringInformation t self = - let sinceLastShot' = sinceLastShot self + t in - if sinceLastShot' >= shotDelay - then self { sinceLastShot = 0.0 - , launchTube = projectile1 - : (projectile2 - : (projectile3 - : launchTube self)) - , queueShotSound = True - } - else self { sinceLastShot = sinceLastShot' } - where projectile1 = Projectile - (P.BulletMII.new - (wrapMap self) - pAngle - (center self) - (velocity self)) - projectile2 = Projectile - (P.BulletMII.new - (wrapMap self) - (pAngle + pi / 8) - (center self) - (velocity self)) - projectile3 = Projectile - (P.BulletMII.new - (wrapMap self) - (pAngle - pi / 8) - (center self) - (velocity self)) - pAngle = case vision self of - Nothing -> angle self - Just arena -> - case lance arena of - Nothing -> angle self - Just l -> vectorDirection - (vectorRelation - (U.wrapMap arena) - (center self) - (M.center l)) + postUpdate s t = + s { center = M.newLocation (wmap s) (center s) (velocity s) t } -updateIdealTargetLocation :: Time -> STank -> STank -updateIdealTargetLocation t self = - self { idealTargetLocation = Just (M.newLocation (wrapMap self) - (center self) - (velocity self) - t) - } +updateFiringInformation t s = firing s sinceLastShot shotDelay + (\x y -> x { sinceLastShot = y }) + (\x y -> x { launchTube = y }) + (\x y -> x { queueShotSnd = y }) + q t launchTube + where p = P.BulletMII.prj s wmap + q = map p [ r, r + pi / 8, r - pi / 8 ] + r = firingAngle s vision angle instance Launcher STank where - deployProjectiles self = (launchTube self, self { launchTube = [] }) + deployProjectiles s = (launchTube s, s { launchTube = [] }) instance Transient STank where - expired' self = if integrity self > 0.0 - then Nothing - else Just [aeffect] - where aeffect = AfterEffect (SimpleExplosion.new (resourceTracker self) - (wrapMap self) - (center self) - (velocity self)) + expired' s = if moreThanZero (integrity s) then Nothing else Just [a] + where a = AfterEffect + (SimpleExplosion.new (rt s)(wmap s) (center s) (velocity s)) instance Damageable STank where - inflictDamage self d = self { integrity = max 0.0 (integrity self - d) } + inflictDamage s d = s { integrity = max 0 (integrity s - d) } instance Damaging STank where - damageEnergy self = kamikazeDamage + damageEnergy s = kamikazeDamage diff --git a/Unit/Smart/Saucer.hs b/Unit/Smart/Saucer.hs --- a/Unit/Smart/Saucer.hs +++ b/Unit/Smart/Saucer.hs @@ -37,9 +37,9 @@ data Saucer = Saucer { angle :: Angle -- radians , velocity :: Velocity - , center :: WrapPoint - , idealTargetLocation :: Maybe WrapPoint - , wrapMap :: WrapMap + , center :: WP + , idealTargetLocation :: Maybe WP + , wrapMap :: WM , launchTube :: [Projectile] , sinceLastShot :: Time , integrity :: Double @@ -88,8 +88,8 @@ return self { shotSoundSource = Just source } new :: ResourceTracker - -> WrapMap - -> WrapPoint + -> WM + -> WP -> Angle -> Saucer new rt wmap center' angle' = diff --git a/Unit/Smart/Sniper.hs b/Unit/Smart/Sniper.hs --- a/Unit/Smart/Sniper.hs +++ b/Unit/Smart/Sniper.hs @@ -37,9 +37,9 @@ data Sniper = Sniper { angle :: Angle -- radians , velocity :: Velocity - , center :: WrapPoint - , idealTargetLocation :: Maybe WrapPoint - , wrapMap :: WrapMap + , center :: WP + , idealTargetLocation :: Maybe WP + , wrapMap :: WM , launchTube :: [Projectile] , sinceLastShot :: Time , integrity :: Double @@ -87,8 +87,8 @@ return self { shotSoundSource = Just source } new :: ResourceTracker - -> WrapMap - -> WrapPoint + -> WM + -> WP -> Angle -> Sniper new rt wmap center' angle' = diff --git a/Unit/Smart/Tank.hs b/Unit/Smart/Tank.hs --- a/Unit/Smart/Tank.hs +++ b/Unit/Smart/Tank.hs @@ -2,149 +2,104 @@ , new ) where -import Data.WrapAround +import Data.WrapAround ( WP, WM ) import Animation -import Graphics.Gloss.Data.Picture -import Graphics.Gloss.Data.Color -import GHC.Float -import Math -import ResourceTracker + ( Audible(..), Animation(..), termSndSrc, reorient, handSndSrc ) +import Graphics.Gloss.Data.Picture () +import Graphics.Gloss.Data.Color () +import GHC.Float () +import Math ( moreThanZero ) +import ResourceTracker ( ResourceTracker, protectedGetImage ) import Updating + ( Transient(..), Observant(..), InternallyUpdating(..) ) import qualified Moving as M + ( Moving(..), + Locatable(..), + Colliding(..), + newVelocity, + newLocation ) import Combat -import qualified Projectile.BulletSI as P.BulletSI -import AfterEffect + ( Projectile, Launcher(..), Damaging(..), Damageable(..) ) +import qualified Projectile.BulletSI as P.BulletSI ( prj ) +import AfterEffect ( AfterEffect(AfterEffect) ) import qualified AfterEffect.SimpleExplosion as SimpleExplosion -import Data.Maybe -import Universe hiding (wrapMap, resourceTracker) -import qualified Universe as U -import Sound.ALUT -import Common - -radialVelocity = pi/6 -- radians per second + ( new ) +import Data.Maybe () +import Universe ( Arena ) +import qualified Universe as U () +import Sound.ALUT ( Source ) +import Common ( Velocity, Time, Angle ) +import UnitUtil ( adjAngle, firingAngle ) +import Unit ( firing ) +radialVelocity = pi/6 maxVelocityMag = 40 - -kamikazeDamage = 10.0 - +kamikazeDamage = 10 maxIntegrity = 3 - accelerationRate = 30 +collisionR = 20 data Tank = Tank { angle :: Angle -- radians , velocity :: Velocity - , center :: WrapPoint - , idealTargetLocation :: Maybe WrapPoint - , wrapMap :: WrapMap + , center :: WP + , wmap :: WM , launchTube :: [Projectile] , sinceLastShot :: Time , integrity :: Double , vision :: Maybe Arena - , resourceTracker :: ResourceTracker - - -- Sound - , queueShotSound :: Bool - , shotSoundSource :: Maybe Source + , rt :: ResourceTracker + , queueShotSnd :: Bool + , shotSndSrc :: Maybe Source } instance Audible Tank where - processAudio self lcenter = - do self' <- if isNothing (shotSoundSource self) - then initializeShotSoundSource self - else return self - if not (queueShotSound self) - then return self' - else do let (x, y) = vectorRelation - (wrapMap self) - (lcenter) - (center self) - let s = fromJust $ shotSoundSource self - sourcePosition s $= (Vertex3 (double2Float x) - (double2Float (-y)) - 0) - play [s] - return self' { queueShotSound = False } - - terminateAudio self = - if isNothing (shotSoundSource self) - then return self - else do stop [fromJust (shotSoundSource self)] - return self + processAudio s a = handSndSrc s + queueShotSnd + shotSndSrc + (\a -> a { queueShotSnd = False }) + rt + "energy-shot-02.wav" + (\a b -> a { shotSndSrc = Just b }) + a (wmap s) (M.center) -initializeShotSoundSource self = - do [source] <- genObjectNames 1 - buffer source $= getSound (resourceTracker self) "energy-shot-02.wav" - -- ... - sourceRelative source $= Listener - referenceDistance source $= audioReferenceDistance --- maxDistance source $= audioMaxDistance - rolloffFactor source $= audioRolloffFactor - return self { shotSoundSource = Just source } + terminateAudio s = termSndSrc s shotSndSrc new :: ResourceTracker - -> WrapMap - -> WrapPoint + -> WM + -> WP -> Angle -> Tank -new rt wmap center' angle' = - Tank { center = center' - , angle = angle' - , idealTargetLocation = Nothing - , velocity = (0.0, 0.0) - , wrapMap = wmap - , launchTube = [] - , sinceLastShot = 0.0 - , integrity = maxIntegrity - , vision = Nothing - , resourceTracker = rt - - , queueShotSound = False - , shotSoundSource = Nothing - } +new a b c d = + Tank { center = c + , angle = d + , velocity = (0.0, 0.0) + , wmap = b + , launchTube = [] + , sinceLastShot = 0.0 + , integrity = maxIntegrity + , vision = Nothing + , rt = a + , queueShotSnd = False + , shotSndSrc = Nothing + } instance Observant Tank where - updateVision self arena = self { vision = Just arena } + updateVision s a = s { vision = Just a } -updateAngle t self - = case vision self of - Nothing -> self - Just arena -> if isNothing (lance arena) - then self - else let sDir = vectorDirection (velocity self) in - let tDir = vectorDirection - (vectorRelation - (U.wrapMap arena) - (center self) - (M.center (fromJust (lance arena)))) in - let adj - | tDir - sDir > pi / 6 = radialVelocity * t - | tDir -sDir < (-pi) / 6 = (-radialVelocity) * t - | otherwise = 0.0 in - self { angle = angle self + adj } +updateAngle t s = adjAngle s t vision (\x y -> x { angle = y }) angle (pi / 6) radialVelocity -updateVelocity :: Time -> Tank -> Tank -updateVelocity t self = - self { velocity = M.newVelocity - (velocity self) - accelerationRate - (angle self) - maxVelocityMag - t - } +updateVelocity t s = s { velocity = M.newVelocity + (velocity s) + accelerationRate + (angle s) + maxVelocityMag + t + } instance Animation Tank where - image self _ = Rotate (double2Float - (radToDeg - (angle self)) * (-1) - 90) - pic - where pic = fromMaybe - (Scale 0.20 0.20 - (Color white - (Text "Error! Missing image!"))) - (getImage rt "tank.bmp") - rt = resourceTracker self + image s _ = reorient (angle s) (protectedGetImage (rt s) "tank.bmp") instance M.Locatable Tank where center = center @@ -153,72 +108,38 @@ velocity = velocity instance M.Colliding Tank where - collisionRadius _ = 20.0 + collisionRadius _ = collisionR instance InternallyUpdating Tank where - preUpdate self t = (updateFiringInformation t - . updateIdealTargetLocation t - . updateVelocity t - . updateAngle t) self - - postUpdate self t = - let center' = fromMaybe (center self) (idealTargetLocation self) in - self { center = center' - , idealTargetLocation = Nothing - } + preUpdate s t = (updateFiringInformation t + . updateVelocity t + . updateAngle t) s -updateFiringInformation t self = - let sinceLastShot' = sinceLastShot self + t in - if sinceLastShot' >= 3 - then self { sinceLastShot = 0.0 - , launchTube = projectile : launchTube self - , queueShotSound = True - } - else self { sinceLastShot = sinceLastShot' } - where projectile = Projectile - (P.BulletSI.new - (wrapMap self) - pAngle - (center self) - (velocity self)) - pAngle = case vision self of - Nothing -> angle self - Just arena -> - case lance arena of - Nothing -> angle self - Just l -> vectorDirection - (vectorRelation - (U.wrapMap arena) - (center self) - (M.center l)) + postUpdate s t = + s { center = M.newLocation (wmap s) (center s) (velocity s) t } -updateIdealTargetLocation :: Time -> Tank -> Tank -updateIdealTargetLocation t self = - self { idealTargetLocation = Just (M.newLocation (wrapMap self) - (center self) - (velocity self) - t) - } +updateFiringInformation t s = firing s sinceLastShot 1.5 + (\x y -> x { sinceLastShot = y }) + (\x y -> x { launchTube = y }) + (\x y -> x { queueShotSnd = y }) + [p] t launchTube + where p = P.BulletSI.prj s wmap (firingAngle s vision angle) instance Launcher Tank where - deployProjectiles self = (launchTube self, self { launchTube = [] }) + deployProjectiles s = (launchTube s, s { launchTube = [] }) instance Transient Tank where - expired' self = if integrity self > 0.0 - then Nothing - else Just [aeffect] - where aeffect = AfterEffect (SimpleExplosion.new (resourceTracker self) - (wrapMap self) - (center self) - (velocity self)) + expired' s = if moreThanZero (integrity s) then Nothing else Just [a] + where a = AfterEffect + (SimpleExplosion.new (rt s)(wmap s) (center s) (velocity s)) instance Damageable Tank where - inflictDamage self d = self { integrity = max 0.0 (integrity self - d) } + inflictDamage s d = s { integrity = max 0 (integrity s - d) } instance Damaging Tank where - damageEnergy self = kamikazeDamage + damageEnergy s = kamikazeDamage diff --git a/Unit/Smart/Zeus.hs b/Unit/Smart/Zeus.hs --- a/Unit/Smart/Zeus.hs +++ b/Unit/Smart/Zeus.hs @@ -32,8 +32,8 @@ collisionRadiusC = 23.0 data Zeus = Zeus { angle :: Angle -- radians - , center :: WrapPoint - , wrapMap :: WrapMap + , center :: WP + , wrapMap :: WM , launchTube :: [Projectile] , sinceLastShot :: Time , integrity :: Double @@ -80,8 +80,8 @@ return self { shotSoundSource = Just source } new :: ResourceTracker - -> WrapMap - -> WrapPoint + -> WM + -> WP -> Angle -> Time -> Zeus diff --git a/UnitUtil.hs b/UnitUtil.hs new file mode 100644 --- /dev/null +++ b/UnitUtil.hs @@ -0,0 +1,55 @@ +module UnitUtil where + +import Lance (Lance) +import Math +import Data.WrapAround +import Moving +import Data.Maybe +import Common +import Universe + +adjAngle :: (Moving a) + => a -- ^ the object whose angle is adjusted + -> Time -- ^ elapsed time + -> (a -> Maybe Arena) -- ^ func that gets arena vision from object + -> (a -> Angle -> a) -- ^ func that sets angle of object + -> (a -> Angle) -- ^ func that gets angle of object + -> Angle -- ^ adjustment angle + -> Double -- ^ radial velocity + -> a + +-- |Abstraction for adjusting angle in response to location of Lance +adjAngle s t f g h m n = + case f s of + Nothing -> s + Just a -> if isNothing (lance a) + then s + else let c = vectorDirection (velocity s) in + let d = vectorDirection + (vectorRelation + (wrapMap a) + (center s) + (center (fromJust (lance a)))) in + let b + | d - c > m = n * t + | d - c < (-m) = (-n) * t + | otherwise = 0 in + g s (h s + b) + +-- |Abstraction for semi-smart firing angle. +firingAngle :: (Locatable a) + => a -- ^ object looking to lance + -> (a -> Maybe Arena) -- ^ func that retrieves arena vision + -> (a -> Angle) -- ^ fun that retrieves angle direction of object + -> Angle +firingAngle s f g = + case f s of + Nothing -> g s + Just a -> + case lance a of + Nothing -> g s + Just l -> vectorDirection + (vectorRelation + (wrapMap a) + (center s) + (center l)) diff --git a/Universe.hs b/Universe.hs --- a/Universe.hs +++ b/Universe.hs @@ -14,8 +14,8 @@ import Sound.ALUT data Arena = Arena { lance :: Maybe Lance - , focus :: WrapPoint - , wrapMap :: WrapMap + , focus :: WP + , wrapMap :: WM , asteroids :: [SpaceJunk] , lanceProjectiles :: [Projectile] , afterFX :: [AfterEffect] diff --git a/edge.cabal b/edge.cabal --- a/edge.cabal +++ b/edge.cabal @@ -7,8 +7,9 @@ -- 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.16 +Version: 0.8.18 + -- A short (one-line) description of the package. Synopsis: Top view space combat arcade game @@ -115,6 +116,7 @@ , Unit.Smart.Saucer , Unit.Smart.Sniper , Unit.Smart.Zeus + , UnitUtil -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. -- Build-tools: diff --git a/image/deflector-1.bmp b/image/deflector-1.bmp new file mode 100644 Binary files /dev/null and b/image/deflector-1.bmp differ diff --git a/image/deflector-2.bmp b/image/deflector-2.bmp new file mode 100644 Binary files /dev/null and b/image/deflector-2.bmp differ diff --git a/image/interceptor-1.bmp b/image/interceptor-1.bmp Binary files a/image/interceptor-1.bmp and b/image/interceptor-1.bmp differ diff --git a/image/interceptor-2.bmp b/image/interceptor-2.bmp Binary files a/image/interceptor-2.bmp and b/image/interceptor-2.bmp differ diff --git a/image/interceptor-3.bmp b/image/interceptor-3.bmp Binary files a/image/interceptor-3.bmp and b/image/interceptor-3.bmp differ