edge 0.8.16 → 0.8.18
raw patch · 42 files changed
+1783/−2468 lines, 42 filesbinary-added
Files
- AfterEffect.hs +7/−8
- AfterEffect/MineExplosion.hs +29/−55
- AfterEffect/SimpleExplosion.hs +42/−76
- Animation.hs +49/−5
- Combat.hs +1/−1
- Display.hs +162/−269
- Lance.hs +101/−180
- Math.hs +17/−2
- Projectile/Blade.hs +64/−76
- Projectile/BulletMI.hs +51/−65
- Projectile/BulletMII.hs +51/−65
- Projectile/BulletMkI.hs +50/−67
- Projectile/BulletSI.hs +48/−65
- Projectile/BulletSII.hs +44/−61
- Projectile/Cannon.hs +51/−67
- Projectile/Interceptor.hs +66/−94
- Projectile/Mine.hs +41/−79
- Projectile/Nuke.hs +62/−93
- Projectile/Pellet.hs +37/−54
- Projectile/SWForward.hs +60/−66
- Projectile/SWSide.hs +53/−59
- Resources.hs +147/−112
- Star.hs +6/−7
- Unit.hs +19/−0
- Unit/Simple/Turret.hs +68/−138
- Unit/Smart/ATank.hs +90/−169
- Unit/Smart/Death.hs +111/−164
- Unit/Smart/Master.hs +5/−5
- Unit/Smart/Ninja.hs +5/−5
- Unit/Smart/STank.hs +88/−181
- Unit/Smart/Saucer.hs +5/−5
- Unit/Smart/Sniper.hs +5/−5
- Unit/Smart/Tank.hs +84/−163
- Unit/Smart/Zeus.hs +4/−4
- UnitUtil.hs +55/−0
- Universe.hs +2/−2
- edge.cabal +3/−1
- image/deflector-1.bmp binary
- image/deflector-2.bmp binary
- image/interceptor-1.bmp binary
- image/interceptor-2.bmp binary
- image/interceptor-3.bmp binary
AfterEffect.hs view
@@ -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)
AfterEffect/MineExplosion.hs view
@@ -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 }
AfterEffect/SimpleExplosion.hs view
@@ -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
Animation.hs view
@@ -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))
Combat.hs view
@@ -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,
Display.hs view
@@ -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)
Lance.hs view
@@ -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))
Math.hs view
@@ -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
Projectile/Blade.hs view
@@ -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))+
Projectile/BulletMI.hs view
@@ -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))+
Projectile/BulletMII.hs view
@@ -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))+
Projectile/BulletMkI.hs view
@@ -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))+
Projectile/BulletSI.hs view
@@ -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))+
Projectile/BulletSII.hs view
@@ -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))+
Projectile/Cannon.hs view
@@ -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))+
Projectile/Interceptor.hs view
@@ -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))+
Projectile/Mine.hs view
@@ -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 }
Projectile/Nuke.hs view
@@ -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
Projectile/Pellet.hs view
@@ -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
Projectile/SWForward.hs view
@@ -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))+
Projectile/SWSide.hs view
@@ -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))+
Resources.hs view
@@ -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
Star.hs view
@@ -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 }
Unit.hs view
@@ -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
Unit/Simple/Turret.hs view
@@ -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
Unit/Smart/ATank.hs view
@@ -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
Unit/Smart/Death.hs view
@@ -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
Unit/Smart/Master.hs view
@@ -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
Unit/Smart/Ninja.hs view
@@ -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' =
Unit/Smart/STank.hs view
@@ -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
Unit/Smart/Saucer.hs view
@@ -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' =
Unit/Smart/Sniper.hs view
@@ -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' =
Unit/Smart/Tank.hs view
@@ -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
Unit/Smart/Zeus.hs view
@@ -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
+ UnitUtil.hs view
@@ -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))
Universe.hs view
@@ -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]
edge.cabal view
@@ -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:
+ image/deflector-1.bmp view
binary file changed (absent → 17022 bytes)
+ image/deflector-2.bmp view
binary file changed (absent → 17022 bytes)
image/interceptor-1.bmp view
binary file changed (4730 → 2706 bytes)
image/interceptor-2.bmp view
binary file changed (4730 → 2706 bytes)
image/interceptor-3.bmp view
binary file changed (4730 → 2706 bytes)