edge 0.8.10 → 0.8.12
raw patch · 10 files changed
+402/−30 lines, 10 filesbinary-added
Files
- Display.hs +51/−1
- Input.hs +17/−0
- Item.hs +2/−1
- Lance.hs +105/−25
- Projectile/SWForward.hs +108/−0
- Projectile/SWSide.hs +108/−0
- Resources.hs +8/−2
- edge.cabal +3/−1
- image/item-sigma.bmp binary
- sound/simple-energy-shot.wav binary
Display.hs view
@@ -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
Input.hs view
@@ -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
Item.hs view
@@ -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+
Lance.hs view
@@ -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
+ Projectile/SWForward.hs view
@@ -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 }
+ Projectile/SWSide.hs view
@@ -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 }
Resources.hs view
@@ -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
edge.cabal view
@@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version: 0.8.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
+ image/item-sigma.bmp view
binary file changed (absent → 2058 bytes)
sound/simple-energy-shot.wav view
binary file changed (13440 → 13440 bytes)