diff --git a/Display.hs b/Display.hs --- a/Display.hs +++ b/Display.hs @@ -49,6 +49,26 @@ 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 @@ -100,6 +120,7 @@ ++ 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' @@ -152,12 +173,41 @@ (Scale 0.14 0.14 (Text y)) : lineFormatting' x (z + 1) ys +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 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) + ] in + Pictures [Color barColor bar + , Color white outline + ] + inventoryDisplay :: Maybe Lance -> ResourceTracker -> Picture inventoryDisplay mLance rt = let spacing = 40.0 in case mLance of Nothing -> Blank - Just l -> let i = inventory l in + Just l -> + if swClock l < swTimeLimit && all id (inventory l) + then let sigmaPic = fromMaybe Blank + (getImage rt "item-sigma.bmp") in + Pictures [ Translate (-80) 0 sigmaPic + , Translate 10 0 (swBar l) + ] + else let i = inventory l in let pFourWay = if not (i !! 0) then Blank diff --git a/Input.hs b/Input.hs --- a/Input.hs +++ b/Input.hs @@ -6,6 +6,23 @@ handleInput :: Event -> Universe -> IO Universe +handleInput (EventKey (Char '<') Down Modifiers { shift = Down + , ctrl = Down + , alt = Down + } _) u + = let a = arena u in + let mL = lance a in + case mL of + Nothing -> return u + Just l -> return u { arena = a + { lance = Just l + { inventory = + map (\_ -> True) (inventory l) + , swClock = 0.0 + } + } + } + handleInput (EventKey (Char ':') Down Modifiers { shift = Down , ctrl = Down , alt = Down diff --git a/Item.hs b/Item.hs --- a/Item.hs +++ b/Item.hs @@ -15,7 +15,7 @@ | Spread | RapidFire | Nuke - deriving (Show) + deriving (Show, Eq) data Item = Item ItemType ResourceTracker WrapPoint deriving (Show) @@ -56,3 +56,4 @@ 3 -> Spread 4 -> RapidFire otherwise -> Nuke + diff --git a/Lance.hs b/Lance.hs --- a/Lance.hs +++ b/Lance.hs @@ -10,12 +10,14 @@ , integrity , inventory , currentWeapon + , swClock ) , new , RotationDirection (..) , shielded , processItem , changeCurrentWeapon + , swTimeLimit ) where import Data.WrapAround @@ -32,6 +34,8 @@ 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 @@ -48,6 +52,8 @@ deflectorChargeLossFactor = 0.8 +swTimeLimit = 10.0 + data RotationDirection = Stable | CW | CCW deriving (Eq) @@ -72,6 +78,7 @@ , fireTrigger :: Bool , currentWeapon :: Int , inventory :: LanceInventory + , swClock :: Time -- death , integrity :: Double @@ -104,6 +111,7 @@ , shotSoundSource = Nothing , godMode = False , integrity = 3.0 + , swClock = 0.0 } changeCurrentWeapon self = @@ -128,23 +136,26 @@ processItem :: Lance -> Item -> Lance processItem self (Item typ _ _) = - case typ of - Health -> self { integrity = 3.0 } - FourWay -> self { inventory = replaceAt 0 True (inventory self) - , currentWeapon = 1 - } - Cannon -> self { inventory = replaceAt 1 True (inventory self) - , currentWeapon = 2 - } - Spread -> self { inventory = replaceAt 2 True (inventory self) - , currentWeapon = 3 - } - RapidFire -> self { inventory = replaceAt 3 True (inventory self) - , currentWeapon = 4 - } - Nuke -> self { inventory = replaceAt 4 True (inventory self) - , currentWeapon = 5 - } + let s' = case typ of + Health -> self { integrity = 3.0 } + FourWay -> self { inventory = replaceAt 0 True (inventory self) + , currentWeapon = 1 + } + Cannon -> self { inventory = replaceAt 1 True (inventory self) + , currentWeapon = 2 + } + Spread -> self { inventory = replaceAt 2 True (inventory self) + , currentWeapon = 3 + } + RapidFire -> self { inventory = replaceAt 3 True (inventory self) + , currentWeapon = 4 + } + Nuke -> self { inventory = replaceAt 4 True (inventory self) + , currentWeapon = 5 + } + in if typ == Health + then s' + else s' { swClock = 0.0 } instance Audible Lance where @@ -229,14 +240,83 @@ } updateFiringInformation t lance = - let sinceLastShot' = sinceLastShot lance + t in - case currentWeapon lance of - 1 -> handleFourWayWeapon lance sinceLastShot' - 2 -> handleCannonWeapon lance sinceLastShot' - 3 -> handleSpreadWeapon lance sinceLastShot' - 4 -> handleRapidFireWeapon lance sinceLastShot' - 5 -> handleNukeWeapon lance sinceLastShot' - otherwise -> handleDefaultWeapon lance sinceLastShot' + let sinceLastShot' = sinceLastShot lance + t + in let s' = if all id (inventory lance) && swClock lance < swTimeLimit + then handleSuperWeapon lance sinceLastShot' + else case currentWeapon lance of + 1 -> handleFourWayWeapon lance sinceLastShot' + 2 -> handleCannonWeapon lance sinceLastShot' + 3 -> handleSpreadWeapon lance sinceLastShot' + 4 -> handleRapidFireWeapon lance sinceLastShot' + 5 -> handleNukeWeapon lance sinceLastShot' + otherwise -> handleDefaultWeapon lance sinceLastShot' + in s' { swClock = (swClock s') + t } + +handleSuperWeapon self ls = + if ls >= 0.2 && fireTrigger self + then self { sinceLastShot = 0.0 + , launchTube = + rearProjectiles + ++ sideProjectiles + ++ [frontProjectile] + ++ launchTube self + , queueShotSound = True + } + else self { sinceLastShot = ls } + where rearProjectiles = [ Projectile ( P.BulletMkI.new + (wrapMap self) + (angle self + pi / 2) + (center self) + (velocity self) ) + , Projectile ( P.BulletMkI.new + (wrapMap self) + (angle self + 3 * pi / 4) + (center self) + (velocity self) ) + , Projectile ( P.BulletMkI.new + (wrapMap self) + (angle self + pi) + (center self) + (velocity self) ) + , Projectile ( P.BulletMkI.new + (wrapMap self) + (angle self + 5 * pi / 4) + (center self) + (velocity self) ) + , Projectile ( P.BulletMkI.new + (wrapMap self) + (angle self + 3 * pi / 2) + (center self) + (velocity self) ) + ] + + sideProjectiles = [ Projectile ( P.SWSide.new + (wrapMap self) + (angle self + pi / 10) + (center self) + (velocity self) ) + , Projectile ( P.SWSide.new + (wrapMap self) + (angle self + pi / 5) + (center self) + (velocity self) ) + , Projectile ( P.SWSide.new + (wrapMap self) + (angle self - pi / 10) + (center self) + (velocity self) ) + , Projectile ( P.SWSide.new + (wrapMap self) + (angle self - pi / 5) + (center self) + (velocity self) ) + ] + + frontProjectile = Projectile ( P.SWForward.new + (wrapMap self) + (angle self) + (center self) + (velocity self) ) handleDefaultWeapon self ls = if ls >= 0.4 && fireTrigger self diff --git a/Projectile/SWForward.hs b/Projectile/SWForward.hs new file mode 100644 --- /dev/null +++ b/Projectile/SWForward.hs @@ -0,0 +1,108 @@ +module Projectile.SWForward ( SWForward(..) + , new + ) where + +import Combat +import Animation +import Updating +import Graphics.Gloss.Data.Picture +import Graphics.Gloss.Data.Color +import Data.WrapAround +import qualified Moving as M +import GHC.Float +import Common + +velocityC = 700.0 +rangeC = 1000.0 + +integrityMax = 60.0 + +punch = 6.0 + +radiusGrowth = 50.0 + +data SWForward = + SWForward { velocity :: Velocity + , center :: WrapPoint + , rangeLeft :: Double + , wrapMap :: WrapMap + , idealNewCenter :: Maybe WrapPoint + , integrity :: Double + , clock :: Time + , 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 + } + +instance Animation SWForward where + + image self t = Color violet (Circle (double2Float (radius self))) + +instance M.Colliding SWForward where + + collisionRadius self = radius self + +instance M.Moving SWForward where + + velocity self = Projectile.SWForward.velocity self + +instance M.Locatable SWForward where + + center self = Projectile.SWForward.center self + +instance SimpleTransient SWForward where + + expired self = rangeLeft self <= 0.0 || integrity self <= 0.0 + +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 = (radius self) + radiusGrowth * t + } + +updateIdealTargetCenter :: Time -> SWForward -> SWForward +updateIdealTargetCenter t self = + let newLoc = M.idealNewLocation (wrapMap self) + (center self) + (velocity self) + t in + self { idealNewCenter = Just (newLoc) + , rangeLeft = max 0.0 $ rangeLeft self - distance (wrapMap self) + (center self) + (newLoc) + } + +instance Damaging SWForward where + + damageEnergy self = punch + +instance Transient SWForward where + + expired' self = if rangeLeft self <= 0.0 || integrity self <= 0.0 + then Just [] + else Nothing + +instance Damageable SWForward where + + inflictDamage self d = self { integrity = integrity self - d } diff --git a/Projectile/SWSide.hs b/Projectile/SWSide.hs new file mode 100644 --- /dev/null +++ b/Projectile/SWSide.hs @@ -0,0 +1,108 @@ +module Projectile.SWSide ( SWSide(..) + , new + ) where + +import Combat +import Animation +import Updating +import Graphics.Gloss.Data.Picture +import Graphics.Gloss.Data.Color +import Data.WrapAround +import qualified Moving as M +import GHC.Float +import Common + +velocityC = 700.0 +rangeC = 1000.0 + +integrityMax = 60.0 + +punch = 3.0 + +radiusGrowth = 30.0 + +data SWSide = + SWSide { velocity :: Velocity + , center :: WrapPoint + , rangeLeft :: Double + , wrapMap :: WrapMap + , idealNewCenter :: Maybe WrapPoint + , integrity :: Double + , clock :: Time + , 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 + } + +instance Animation SWSide where + + image self t = Color cyan (Circle (double2Float (radius self))) + +instance M.Colliding SWSide where + + collisionRadius self = radius self + +instance M.Moving SWSide where + + velocity self = Projectile.SWSide.velocity self + +instance M.Locatable SWSide where + + center self = Projectile.SWSide.center self + +instance SimpleTransient SWSide where + + expired self = rangeLeft self <= 0.0 || integrity self <= 0.0 + +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 = (radius self) + radiusGrowth * t + } + +updateIdealTargetCenter :: Time -> SWSide -> SWSide +updateIdealTargetCenter t self = + let newLoc = M.idealNewLocation (wrapMap self) + (center self) + (velocity self) + t in + self { idealNewCenter = Just (newLoc) + , rangeLeft = max 0.0 $ rangeLeft self - distance (wrapMap self) + (center self) + (newLoc) + } + +instance Damaging SWSide where + + damageEnergy self = punch + +instance Transient SWSide where + + expired' self = if rangeLeft self <= 0.0 || integrity self <= 0.0 + then Just [] + else Nothing + +instance Damageable SWSide where + + inflictDamage self d = self { integrity = integrity self - d } diff --git a/Resources.hs b/Resources.hs --- a/Resources.hs +++ b/Resources.hs @@ -41,6 +41,7 @@ , "item-spread.bmp" , "item-rapidfire.bmp" , "item-nuke.bmp" + , "item-sigma.bmp" , "lance.bmp" , "lance-thrusting.bmp" , "mine.bmp" @@ -476,8 +477,7 @@ ] } ] - let addItems a = do it1 <- randomItemType - it2 <- randomItemType + let addItems a = do (it1, it2) <- randomItemPair x1 <- randomRIO (0, 2999) x2 <- randomRIO (0, 2999) y1 <- randomRIO (0, 2999) @@ -488,6 +488,12 @@ let i2 = Item it2 rt wp2 return a { items = [i1, i2] } mapM addItems pL + +randomItemPair = do it1 <- randomItemType + it2 <- randomItemType + if it1 == it2 + then randomItemPair + else return (it1, it2) asteroidGen rt wmap p = let positionsVelocities = p in diff --git a/edge.cabal b/edge.cabal --- a/edge.cabal +++ b/edge.cabal @@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.8.10 +Version: 0.8.12 -- A short (one-line) description of the package. Synopsis: Top view space combat arcade game @@ -101,6 +101,8 @@ , Projectile.Mine , Projectile.Nuke , Projectile.Pellet + , Projectile.SWForward + , Projectile.SWSide , Combat , Unit , Unit.Simple.Turret diff --git a/image/item-sigma.bmp b/image/item-sigma.bmp new file mode 100644 Binary files /dev/null and b/image/item-sigma.bmp differ diff --git a/sound/simple-energy-shot.wav b/sound/simple-energy-shot.wav Binary files a/sound/simple-energy-shot.wav and b/sound/simple-energy-shot.wav differ