Work on what happens when creatures fall down chasms

src/Dodge/Combine.hs

@@ -1,7 +1,5 @@
 --{-# LANGUAGE TupleSections #-}
-module Dodge.Combine (
-    combineList,
-) where
+module Dodge.Combine (combineList) where
 
 import Dodge.Data.CombAmount
 import Dodge.Item.InvSize

src/Dodge/Creature/State.hs

@@ -119,11 +119,9 @@ scorchSPic = _1 %~ overColSH (mixColors 0.9 0.1 black . normalizeColor)
 poisonSPic :: SPic -> SPic
 poisonSPic = _1 %~ overColSH (mixColors 0.5 0.5 green . normalizeColor)
 
-{- | Drop items according to the creature state.
- TODO make sure this doesn't mess up any ItemPosition
--}
+-- reverse keys, otherwise two or more inv items will cause errors
 dropAll :: Creature -> World -> World
-dropAll cr w = foldl' (flip (dropItem cr)) w $ IM.keys $ _crInv cr
+dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys $ _crInv cr
 
 doDamage :: Creature -> World -> World
 doDamage cr = applyPastDamages cr . applyCreatureDamage (cr ^. crDamage) cr

src/Dodge/Creature/Update.hs

@@ -14,8 +14,19 @@ import Dodge.Humanoid
 import Dodge.Lampoid
 import qualified Data.List as List
 
+-- Should separate out creature movement from other parts here
+
 updateCreature :: Creature -> World -> World
-updateCreature cr = chasmTest cr . case _crType cr of
+updateCreature cr
+    | _crZ cr < negate 100 = id -- can remove creature and all items
+    | _crZ cr < 0 = (tocr . crZVel -~ 0.5)
+            . (tocr . crZ +~ _crZVel cr)
+    | otherwise = updateCreature' cr
+  where
+    tocr = cWorld . lWorld . creatures . ix (_crID cr)
+
+updateCreature' :: Creature -> World -> World
+updateCreature' cr = chasmTest cr . case _crType cr of
     Avatar{} -> (cWorld . lWorld . creatures . ix 0 . crType . avatarPulse %~ updatePulse) 
         . crUpdate yourControl cr
     LampCrit{} -> updateLampoid cr

src/Dodge/EnergyBall.hs

@@ -6,28 +6,27 @@ module Dodge.EnergyBall (
     makeMovingEB,
 ) where
 
-import Dodge.Damage
 import Data.Maybe
 import Dodge.Base.Collide
+import Dodge.Damage
 import Dodge.Data.World
 import Dodge.SoundLogic
 import Dodge.Spark
 import Geometry
 import LensHelp
+import Linear.V3
 import Picture
 import RandomHelp
-import Linear.V3
 
 makeFlamelet :: Point3 -> Point3 -> Float -> Int -> World -> World
-makeFlamelet p v s t w =
-    w
-        & cWorld . lWorld . energyBalls
-            .:~ EnergyBall
-                { _ebVel = v
-                , _ebPos = p
-                , _ebTimer = t
-                , _ebType = FlameletBall s
-                }
+makeFlamelet p v s t =
+    cWorld . lWorld . energyBalls
+        .:~ EnergyBall
+            { _ebVel = v
+            , _ebPos = p
+            , _ebTimer = t
+            , _ebType = FlameletBall s
+            }
 
 updateEnergyBall :: World -> EnergyBall -> (World, Maybe EnergyBall)
 updateEnergyBall w eb

src/Dodge/Event/Test.hs

@@ -2,16 +2,10 @@ module Dodge.Event.Test (
     testEvent,
 ) where
 
-import Dodge.SoundLogic.ExternallyGeneratedSounds
+--import Dodge.Creature.State
 import Dodge.Data.World
-import Control.Lens
-import Geometry
+--import Control.Lens
 
 testEvent :: World -> World
 testEvent w = w
-        & cWorld . lWorld . worldEvents .~ SoundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing :
-        --[MakeStartCloudAt (V3 (cx + x) (cy + y) 5) | x <- [-5, -4 .. 5], y <- [-5, -4 .. 5]]
-        [MakeStartCloudAt (V3 (cx + x) (cy + y) 200) | x <- [0], y <- [0]]
-  where
-    V2 cx cy = w ^?! cWorld . lWorld . creatures . ix 0 . crPos
 

src/Dodge/Inventory.hs

@@ -13,6 +13,7 @@ module Dodge.Inventory (
     swapInvItems,
     scrollAugNextInSection,
     swapItemWith,
+    destroyItem,
 ) where
 
 import Dodge.Equipment
@@ -60,14 +61,18 @@ destroyInvItem cid invid w =
             (cWorld . lWorld . imHotkeys . unNIntMap . at itid .~ Nothing)
                 . (cWorld . lWorld . hotkeys . at hk .~ Nothing)
 
--- | after this the item at the inventory position will no longer exist
-rmInvItem ::
-    -- | Creature id
-    Int ->
-    -- | Inventory position
-    Int ->
-    World ->
-    World
+destroyItem :: Int -> World -> World
+destroyItem itid w = case w ^? cWorld . lWorld . itemLocations . ix itid of
+    Nothing -> error $ "Tried to destroy item that does not exist; item id: "++ show itid
+    Just (InInv {_ilCrID = cid, _ilInvID = invid}) -> destroyInvItem cid invid w
+    Just (OnTurret{}) -> error "need to write code for destroying items on turrets"
+    Just (OnFloor (NInt i)) -> w & cWorld . lWorld . itemLocations . at itid .~ Nothing
+        & cWorld . lWorld . floorItems . unNIntMap . at i .~ Nothing
+    Just InVoid -> w & cWorld . lWorld . itemLocations . at itid .~ Nothing
+    
+-- note rmInvItem does not fully destroy the item, other updates to the item
+-- location are required
+rmInvItem :: Int -> Int -> World -> World
 rmInvItem cid invid w =
     w
         & dounequipfunction --the ordering of these is

src/Dodge/Prop/Gib.hs

@@ -1,15 +1,13 @@
-module Dodge.Prop.Gib (
-    addCrGibs,
-) where
+module Dodge.Prop.Gib (addCrGibs) where
 
-import Dodge.WorldEvent.Cloud
-import Dodge.Creature.Shape
 import Color
 import Control.Monad
 import Data.Foldable
 import Data.List (zip4)
+import Dodge.Creature.Shape
 import Dodge.Damage
 import Dodge.Data.World
+import Dodge.WorldEvent.Cloud
 import Geometry
 import LensHelp
 import qualified Quaternion as Q
@@ -18,16 +16,16 @@ import RandomHelp
 addCrGibs :: Creature -> World -> World
 addCrGibs cr = case damageDirection $ _crDamage cr of
     Nothing ->
-            addGibAt 25 (_skinHead skin) cpos
+        addGibAt 25 (_skinHead skin) cpos
             . addGibsAtDir pi 0 3 7 (_skinLower skin) cpos
             . addGibsAtDir pi 0 13 20 (_skinUpper skin) cpos
             . makeDustAt Flesh 50 (addZ 20 cpos)
             . makeDustAt Flesh 50 (addZ 20 cpos)
             . makeDustAt Flesh 50 (addZ 20 cpos)
             . makeDustAt Flesh 50 (addZ 20 cpos)
-    Just d -> (testFloat +~ 1)
-            . addGibsAtDir (pi/4) d 3 7 (_skinLower skin) cpos
-            . addGibsAtDir (pi/4) d 13 20 (_skinUpper skin) cpos
+    Just d ->
+        addGibsAtDir (pi / 4) d 3 7 (_skinLower skin) cpos
+            . addGibsAtDir (pi / 4) d 13 20 (_skinUpper skin) cpos
             . addGibAtDir d 25 (_skinHead skin) cpos
             . makeDustAt Flesh 50 (addZ 20 cpos)
             . makeDustAt Flesh 50 (addZ 20 cpos)
@@ -48,11 +46,11 @@ addGibsAtDir spread dir minh maxh col p w =
     dirs = unitVectorAtAngle <$> (randsSpread (dir - spread, dir + spread) 4 & evalState $ _randGen w)
     vels = zipWith (*.*) speeds dirs
     zspeeds = replicateM 4 (state (randomR (-8, 8))) & evalState $ _randGen w
-    quats :: [Q.Quaternion Float]
     quats = replicateM 4 (Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere) & evalState $ _randGen w
 
 addGib4 :: Point2 -> Color -> (Point2, Float, QFloat, Float) -> World -> World
-addGib4 p col (v, zs, q, h) = cWorld . lWorld . debris
+addGib4 p col (v, zs, q, h) =
+    cWorld . lWorld . debris
         .:~ DebrisChunk
             { _dbPos = p `v2z` h
             , _dbType = Gib 3 col
@@ -60,7 +58,7 @@ addGib4 p col (v, zs, q, h) = cWorld . lWorld . debris
             , _dbRot = q
             , _dbSpin = Q.axisAngle (vNormal v `v2z` 0) (-0.1)
             }
-            
+
 addGibAt :: Float -> Color -> Point2 -> World -> World
 addGibAt h col p w = addGibAtDir d h col p (w & randGen .~ newg)
   where
@@ -78,10 +76,11 @@ addGibAtDir dir h col p w =
         zs <- state $ randomR (-4, 4)
         q <- Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere
         let v = s *.* unitVectorAtAngle dir
-        return $ DebrisChunk
-            { _dbPos = p `v2z` h
-            , _dbType = Gib 3 col
-            , _dbVel = v `v2z` zs
-            , _dbRot = q
-            , _dbSpin = Q.axisAngle (vNormal v `v2z` 0) (-0.1)
-            }
+        return $
+            DebrisChunk
+                { _dbPos = p `v2z` h
+                , _dbType = Gib 3 col
+                , _dbVel = v `v2z` zs
+                , _dbRot = q
+                , _dbSpin = Q.axisAngle (vNormal v `v2z` 0) (-0.1)
+                }

src/Dodge/Render.hs

@@ -33,7 +33,7 @@ import Shader.Poke.Cloud
 
 doDrawing :: SDL.Window -> Universe -> IO ()
 doDrawing window u
-    | SDL.ScancodeT `M.member` (u ^. uvWorld . input . pressedKeys) = doTestDrawing rdata u
+    | SDL.ScancodeY `M.member` (u ^. uvWorld . input . pressedKeys) = doTestDrawing rdata u
     | otherwise = doDrawing' window rdata u
   where
     rdata = u ^. preloadData . renderData