Partial fix to jetPack

src/Dodge/Creature.hs

@@ -3,10 +3,8 @@ module Dodge.Creature
     , module Dodge.Creature.Inanimate
     )
   where
--- imports {{{
 import Dodge.Data
 import Dodge.AIs
-import Dodge.CreatureState
 import Dodge.Default
 import Dodge.Base
 import Dodge.Item.Weapon
@@ -14,6 +12,7 @@ import Dodge.Item.Consumable
 import Dodge.WorldEvent.Cloud
 import Dodge.Creature.YourControl
 import Dodge.Creature.Inanimate
+import Dodge.Creature.State
 import Dodge.Item
 
 import Picture
@@ -257,6 +256,7 @@ startCr = defaultCreature
 
 startInventory = IM.fromList (zip [0..20] 
     (
+    [ --jetPack
     --[pistol
     --,blinkGun
     --,spawnGun lamp
@@ -273,8 +273,8 @@ startInventory = IM.fromList (zip [0..20]
     --,miniGun
     --,medkit 50
     --,bezierGun
-    --] 
+    ] 
-    --  ++ 
+      ++ 
     repeat NoItem))
 
 smokeGenGun = effectGun "smoke" $ \_ -> spawnSmokeAtCursor

src/Dodge/Creature/Inanimate.hs

@@ -1,16 +1,16 @@
+{-
+Inanimate objects such as lamps, barrels, etc
+-}
 module Dodge.Creature.Inanimate
   where
 import Dodge.Data
 import Dodge.Base
 import Dodge.Default
-import Dodge.CreatureState
+import Dodge.Creature.State
 import Dodge.LightSources
 import Dodge.WorldEvent.Flash
-
 import Dodge.WorldEvent.Sound
-
 import Dodge.Creature.Update hiding (CRUpdate)
-
 import Picture
 
 import qualified Data.IntMap.Strict as IM

src/Dodge/Creature/YourControl.hs

@@ -4,8 +4,8 @@ module Dodge.Creature.YourControl
 import Dodge.Data
 import Dodge.Base
 import Dodge.CreatureAction
+import Dodge.Creature.State
 import Dodge.Update.UsingInput
-import Dodge.CreatureState
 import Dodge.Config.KeyConfig
 
 import Geometry
@@ -23,7 +23,8 @@ yourControl :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,
 yourControl w (f,g) cr = ( (updateUsingInput . f, g)
                          , Just . crAutoReload . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed strafeSpeed 0 cr
                          )
-    where strafeSpeed = _varMovementSpeedModifier w * equipFactor * (fromMaybe 1 $ yourItem w ^? itAimingSpeed)
+  where 
+    strafeSpeed = _varMovementSpeedModifier w * equipFactor * (fromMaybe 1 $ yourItem w ^? itAimingSpeed)
     speed = _varMovementSpeedModifier w * equipFactor
     equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! 0
 

src/Dodge/CreatureState.hs

@@ -1,245 +0,0 @@
-module Dodge.CreatureState where
--- imports {{{
-import Dodge.Data
-import Dodge.Base
-import Dodge.SoundLogic
-import Dodge.RandomHelp
-import Dodge.WorldEvent
-import Dodge.WallCreatureCollisions
-import Dodge.CreatureAction
-
-import Geometry
-import Picture
-
-import Data.List
-import Data.Char
-import Data.Maybe
-import Data.Function
-import Data.Graph.Inductive.Graph
-import Data.Graph.Inductive.PatriciaTree
-import Data.Graph.Inductive.Query.SP
-import Codec.BMP
-import qualified Data.ByteString as B
-import Control.Lens
-import Control.Applicative
-import Control.Monad.State
-import Control.Monad
-import qualified SDL as SDL
-import qualified SDL.Mixer as Mix
-import System.Random
-import qualified Data.Set as S
-import qualified Data.IntMap.Strict as IM
-import qualified Data.Map as M
-
-import Foreign.ForeignPtr
-import Control.Concurrent
----}
-  
-type CRUpdate = World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
-
--- the movement is updated before the ai in order to correctly set the oldpos
--- the whole of this update cycle could do with a rethink, it is becoming
--- convoluted
-stateUpdate :: CRUpdate -> CRUpdate
-stateUpdate u w (f,g) cr = case u w (f,g) (updateMovement g cr) of
-        ((f',g') , maybeCr) -> ( (invSideEff cr . movementSideEff cr . dropifdead . f'
-                                 , g')
-                               , fmap (updateReloadCounter . reducePastDamage . doDamage) 
-                                      $ crOrCorpse =<< maybeCr
-                               )
-    where   
-        crOrCorpse cr | cr ^. crHP > 0 = Just cr
-                      | otherwise      = Nothing
-        dropifdead | cr ^.crHP > 0 = id
-                   | otherwise = stopSoundFrom (CrWeaponSound (_crID cr)) 
-                                    . over decorations addCorpse 
-                                    . insertIt
-        crBeforeDeath = colCrWall w $ cr
-        addCorpse = insertNewKey $ uncurry translate (_crOldPos cr) 
-                                 $ rotate (_crDir cr)
-                                 (_crCorpse cr)
-        maybeIt = evalState (maybeTakeOne $ IM.elems (_crInv cr)) (_randGen w)
-        insertIt = case maybeIt of 
---                      Just it -> createItemAt (offset +.+ _crPos crBeforeDeath) 
-                      Just it -> createItemAt (offset +.+ _crOldPos cr) 
-                                              (FlIt {_flIt=it,_flItPos=(0,0),_flItRot=rot,_flItID=0})
-                      Nothing -> id
-        offset = _crRad cr *.* unitVectorAtAngle rot
-        (rot,_) = randomR (-pi,pi) g
-
-
-setOldPos :: Creature -> Creature
-setOldPos cr = set crOldPos (_crPos cr) cr
-
-doDamage :: Creature -> Creature
-doDamage cr = set (crState . crDamage) [] $ over (crState . crPastDamage) (+ hpLost) 
-                                            damagedCr
-    where dams = _crDamage $ _crState cr
-          startHP = _crHP cr
-          damagedCr = snd $ (_crApplyDamage (_crState cr)) dams cr
-          afterHP = _crHP damagedCr
-          hpLost = startHP - afterHP  -- note this can be negative 
-
-sumDamage :: Creature -> DamageType -> Int -> Int
-sumDamage cr dm x = x + _dmAmount dm
-
-reducePastDamage :: Creature -> Creature
-reducePastDamage = over (crState . crPastDamage) rdpdam
-    where rdpdam x  | x > 500 = x - 55
-                    | x > 200 = x - 25
-                    | x > 20  = x - 5
-                    | x > 0   = x - 1
-                    | otherwise = 0
-
-movementSideEff :: Creature -> World -> World
-movementSideEff cr w
-    | hasJetPack 
-        = case cr ^? crState . stance . carriage of
-            Just (Boosting v) 
-                -> makeFlameletTimed 
-                            (oldPos +.+ (_crRad cr + 3) *.* (unitVectorAtAngle $ _crDir cr + pi))
-                            (momentum +.+ 1 *.* rotateV randDir (vInverse v)) 
-                            Nothing
-                            1
-                            20
-                    $ set randGen g
-                        w
-            _   -> w
-    | otherwise = case cr ^? crState . stance . carriage of
-                    Just (Walking x y) -> takeStep x y w
-                    _ -> w
-        where hasJetPack = any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr
-              oldPos = _crOldPos cr
-              momentum' = 0.97 *.* (_crPos cr -.- _crOldPos cr)
-              momentum'' | magV momentum' > 3 = 3 *.* normalizeV momentum'
-                         | otherwise          = momentum'
-              momentum = momentum'' +.+ 0.01 *.* unitVectorAtAngle randAng
-              (randDir,g) = randomR (-0.5,0.5) $ _randGen w
-              (randAng,_) = randomR (0,2*pi) $ _randGen w
-
-              (v1:v2:v3:_) = fst $ runState ((sequence . repeat . randInCirc) 0.1) $ _randGen w
-              (r1:r2:r3:_) = map ((*.*) 100) (v2:v3:v1:[])
-
-              crHasMoved = dist (_crPos cr) (_crOldPos cr) > 0.5
-              takeStep x y | crHasMoved && x < 20 && x + y >= 20 = soundMultiFrom footor 22 3 0
-                           | crHasMoved && x < 80 && x + y >= 80 = soundMultiFrom footor 23 3 0  
-                           | otherwise = id
-              footor = [FootstepSound 0,FootstepSound 1]
-
-invSideEff :: Creature -> World -> World
-invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr)
-    where f i it w' = case it ^? itEffect . itInvEffect of
-                            Nothing -> w'
-                            Just g  -> g cr i w'
-
-weaponReloadSounds :: Creature -> World -> World
-weaponReloadSounds cr w = case _crInv cr IM.!? _crInvSel cr of
-                              Just (Weapon {_wpReloadState = 0})
-                                 -> w
-                              Just (Weapon {_wpReloadState = 1})
-                                 -> stopSoundFrom (CrReloadSound cid) w
-                              Just (Weapon {})
-                                 -> soundFrom (CrReloadSound cid) reloadSound (1) 0 w
-                              _
-                                 -> w
-      where cid = _crID cr
-
-updateMovement :: StdGen -> Creature -> Creature
-updateMovement g cr 
-            | isFrictionless cr = over crPos (+.+ momentum) 
-                              $ setOldPos
-                              cr
-            | otherwise 
-              = case cr ^? crState . stance . carriage of
-                  Just (Walking x y) 
-                      -> set (crState . stance . carriage) (Walking ((x+y)`mod`120) 0)
-                          $ setOldPos
-                          cr
-                  _  -> set (crState . stance . carriage) (Walking 0 0)
-                          $ setOldPos
-                          cr
-    where
-        momentum' = 0.97 *.* (_crPos cr -.- _crOldPos cr)
-        momentum'' | magV momentum' > 3 = 3 *.* normalizeV momentum'
-                   | otherwise          = momentum'
-        momentum = momentum'' +.+ 0.01 *.* unitVectorAtAngle randAng
-        (randAng,_) = randomR (0,2*pi) g
-
-isFrictionless :: Creature -> Bool
-isFrictionless cr = case cr ^? crState . stance . carriage of
-    Just (Boosting _) -> True
-    Just (Floating)   -> True
-    _                 -> False
-
-updateReloadCounter :: Creature -> Creature
-updateReloadCounter cr = over (crInv . ix iSel . wpFireState) decreaseToZero
-                            . over (crInv . ix iSel . wpReloadState) decreaseToZero
-                            $ cr
-     where iSel = _crInvSel cr 
-
-decreaseToZero :: Int -> Int
-decreaseToZero x | x > 0     = x - 1
-                 | otherwise = 0
-
-
---comb :: (StdGen -> Creature -> World -> World) -> (StdGen -> Creature -> Maybe Creature)
---            -> CRUpdate
---comb 
-
-onDeath :: (Creature -> World -> World) -> CRUpdate -> CRUpdate
-onDeath h u w (f,g) cr 
-    | _crHP cr > 0 = u w (f,g) cr
-    | otherwise    = ( ( h cr . f, g ) , Nothing )
-
-updateBarrel :: 
-    World -> (World -> World,StdGen) -> Creature -> ((World -> World , StdGen), Maybe Creature)
-updateBarrel w (f,g) cr | _crHP cr > 0 = ((f, g), newCr)
-                        | otherwise   = ((f, g), Nothing)
-    where damages = _crDamage $ _crState cr
-          newCr = Just $ doDamage cr
-
--- it is easy to leave off the "f" here 
--- should find some better way of doing all this that is less prone to error
-updateExpBarrel :: 
-    World -> (World -> World,StdGen) -> Creature -> ((World -> World , StdGen), Maybe Creature)
-updateExpBarrel w (f,g) cr 
-    | _crHP cr > 0 = ((f . foldr (.) id pierceSparks . hiss, g'), newCr)
-    | otherwise   = ((f . makeExplosionAt (_crPos cr) . stopSounds , g'), Nothing)
-    where damages = _crDamage $ _crState cr
-          pierceSparks :: [World -> World]
-          pierceSparks 
-            = zipWith4 (\p a colid time-> (createBarrelSpark time colid (_crPos cr +.+ p) (a + argV p)) 
-                                                (Just $ _crID cr))
-                                  poss as colids times
-          as =  randomRs (-0.7,0.7) $ g
-          colids = randomRs (0,11) $ g
-          times = randomRs (2,5) $ g
-          (g',_) = split g
-          poss = _piercedPoints $ _crSpState $ _crState cr
-          --newCr = Just $ doDamage $ applyFuseDamage cr -- $ foldr perforate cr damages
-          newCr = Just $ applyFuseDamage $ set (crState . crDamage) [] $ damToExpBarrel damages cr
-          perforate :: DamageType -> Creature -> Creature
-          perforate (Piercing amount sp int ep) cr = over (crState . crSpState . piercedPoints)
-                                                            ((:) $ int -.- _crPos cr) cr
-          perforate _ cr = cr
-          applyFuseDamage cr = over crHP (\hp -> hp - length (_piercedPoints 
-                                                             $ _crSpState $ _crState cr)) 
-                                         cr
-          hiss | poss == [] = id
-               | otherwise  = soundMultiFrom [BarrelHiss 0,BarrelHiss 1] 41 50 1
-          stopSounds = stopSoundFrom (BarrelHiss 0) . stopSoundFrom (BarrelHiss 1)
-
-damToExpBarrel :: [DamageType] -> Creature -> Creature
-damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam
-    where (pierceDam,otherDam) = partition isPierce ds
-          isPierce (Piercing {}) = True
-          isPierce _             = False
-
-damToExpBarrel' :: DamageType -> Creature -> Creature
-damToExpBarrel' (Piercing amount sp int ep) cr 
-    = over (crState . crSpState . piercedPoints) ((:) $ int -.- _crPos cr) 
-        $ over crHP (\hp -> hp - div amount 200) cr
-damToExpBarrel' (PoisonDam {}) cr = cr
-damToExpBarrel' (SparkDam {})  cr = cr
-damToExpBarrel' (PushDam {_dmPushBack = v})   cr = cr Control.Lens.& crPos %~ (+.+) (1 / _crMass cr *.* v)
-damToExpBarrel' dt             cr = cr Control.Lens.& crHP -~ _dmAmount dt

src/Dodge/Item/Weapon.hs

@@ -1755,7 +1755,8 @@ mvBlip :: Point2 -> Color -> Int -> Int -> World -> Particle' -> (World, Maybe P
 mvBlip p col maxt 0 w pt = (w, Nothing)
 mvBlip p col maxt t w pt 
     = (w, Just $ pt & ptUpdate' .~ mvBlip p col maxt (t-1)
-                    & ptDraw   .~ (const $ onLayerL [levLayer ShadowLayer, 2]
+                    & ptDraw   .~ (const . setDepth (-0.5)
+                                    . setLayer 1
                                     $ uncurry translate p 
                                     $ color (withAlpha (fromIntegral t / fromIntegral maxt) col)
                                     $ circleSolid 2)
@@ -1773,7 +1774,7 @@ mvSonar x p w pt = (w, Just $ pt {_ptDraw = const pic
                               ,_ptUpdate' = mvSonar (x-1) p
                               }
                    )
-    where pic = onLayerL [levLayer ShadowLayer, 2] $ pictures 
+    where pic = setDepth (-0.5) . setLayer 1 $ pictures 
            --             $  sweepPics ++ 
                             crBlips -- ++ wallBlips
           crBlips = mapMaybe crBlip $ IM.elems $ _creatures w
@@ -1866,7 +1867,7 @@ autoSonarEffect = ItInvEffect {_itInvEffect = f 50
                            }
     where f 0 cr i w = aSonarPulse (_crID cr)
                        w & creatures . ix (_crID cr) . crInv . ix i 
-                                     . itEffect . itInvEffect     .~ f 40
+                                     . itEffect . itInvEffect     .~ f 140
           f t cr i w = w & creatures . ix (_crID cr) . crInv . ix i 
                                      . itEffect . itInvEffect     .~ f (t-1)
 

src/Dodge/Update.hs

@@ -100,9 +100,8 @@ updateParticles' w =
 updateCreatures :: World -> World
 updateCreatures w = f $ set randGen newG $ set creatures (IM.mapMaybe id crs) w
   where 
-    ((f,newG),crs) = IM.mapAccum (\g' cr -> _crUpdate cr w g' (setOldPos cr)) (id,_randGen w) 
+    ((f,newG),crs) = IM.mapAccum (\g' cr -> _crUpdate cr w g' cr) (id,_randGen w) 
                         $ _creatures w
-    setOldPos cr = cr & crOldPos .~ _crPos cr
 
 
 wallEvents :: World -> World