Allow for different item drops on creature death

src/Dodge/Creature/State.hs

@@ -5,7 +5,7 @@ import Dodge.SoundLogic
 import Dodge.RandomHelp
 import Dodge.WorldEvent
 import Dodge.WallCreatureCollisions
-import Dodge.CreatureAction
+import Dodge.Creature.Action
 import Geometry
 import Picture
 
@@ -13,7 +13,7 @@ import Data.List
 import Data.Char
 import Data.Maybe
 import Data.Function
-import Data.Graph.Inductive.Graph
+--import Data.Graph.Inductive.Graph
 import Data.Graph.Inductive.PatriciaTree
 import Data.Graph.Inductive.Query.SP
 import Codec.BMP
@@ -37,32 +37,73 @@ type CRUpdate = World -> (World -> World,StdGen) -> Creature -> ((World -> World
 -- the whole of this update cycle could do with a rethink, it is becoming
 -- convoluted
 stateUpdate :: CRUpdate -> CRUpdate
-stateUpdate u w (f,g) cr = let (cr', g'') = updateMovement g cr 
-                           in case u w (f,g'') cr' of
-        ((f',g') , maybeCr) -> ( (invSideEff cr . movementSideEff cr . dropifdead . f'
+stateUpdate u w (f,g) cr = 
+    let (cr', g'') = updateMovement g cr 
+    in case u w (f,g'') cr' of
+        ((f',g') , maybeCr) -> ( (invSideEff cr . movementSideEff cr . deathEff . 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
+  where   
+    crOrCorpse cr | cr ^. crHP > 0 = Just cr
+                  | otherwise      = Nothing
+    deathEff | cr ^.crHP > 0 = id
+             | otherwise = stopSoundFrom (CrWeaponSound (_crID cr)) 
+                                . over decorations addCorpse 
+                                . dropByState cr
+    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 +.+ _crOldPos cr) 
+--                                          (FlIt {_flIt=it,_flItPos=(0,0),_flItRot=rot,_flItID=0})
+--                  Nothing -> id
+--    offset = _crRad cr *.* unitVectorAtAngle rot
+--    (rot,_) = randomR (-pi,pi) g
+
+-- | Drop items accoring to the creature state.
+dropByState :: Creature -> World -> World
+dropByState cr w = foldr (copyItemToFloor cr) w is
+  where
+    is :: [Int]
+    is = case cr ^. crState . crDropsOnDeath of
+        DropAll -> IM.keys $ _crInv cr
+        DropSpecific xs -> xs
+        DropAmount n -> take n $ evalState (shuffle $ IM.keys $ _crInv cr) (_randGen w)
+
+{- Copy an inventory item to the floor. -}
+copyItemToFloor 
+    :: Creature
+    -> Int      -- ^ Inventory position
+    -> World 
+    -> World
+copyItemToFloor cr i w = case _crInv cr IM.! i of
+    NoItem -> w
+    it -> over floorItems (IM.insert flid theflit)
+        . updateLocation
+        $ set randGen g w
+      where 
+        (rot, g) = randomR (-pi,pi) $ _randGen w
         offset = _crRad cr *.* unitVectorAtAngle rot
-        (rot,_) = randomR (-pi,pi) g
+        updateLocation w = case it ^? itID of
+            Just (Just i)  -> w & itemPositions . ix i .~ OnFloor flid
+            _ -> w
+        flid = newKey $ _floorItems w
+        theflit = FlIt 
+            {_flIt = set itAmount 1 it
+            ,_flItPos = offset +.+ _crPos cr
+            ,_flItRot = rot
+            ,_flItID = flid
+            }
+
+createItemAt :: Point2 -> FloorItem -> World -> World
+createItemAt p it w = over floorItems (IM.insert i (set flItPos p 
+                                                    $ set flItID i it)) w
+    where i = newKey (_floorItems w)
+
 
 setOldPos :: Creature -> Creature
 setOldPos cr = set crOldPos (_crPos cr) cr
@@ -183,11 +224,6 @@ 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