Tweak item dropping, add item radius

src/Dodge/Creature/Action.hs

@@ -10,7 +10,7 @@ module Dodge.Creature.Action
     , blinkAction
     , maybeSizeSelf
     , crAutoReload
-    , copyItemToFloor
+    , copyInvItemToFloor
     , youDropItem
     , pickUpItem
     )
@@ -206,50 +206,73 @@ stripNoItems :: Creature -> World -> World
 stripNoItems cr = creatures . ix (_crID cr) . crInv %~ IM.mapMaybe f
   where
     f NoItem = Nothing
-    f x = Just x
+    f x      = Just x
 
 dropUnselected :: Creature -> World -> World
-dropUnselected cr w = foldr (dropItem cr) w . IM.keys $ unselectedItems
-  where
-    unselectedItems = _crInvSel cr `IM.delete` _crInv cr 
+dropUnselected cr w = foldr (dropItem cr) w . IM.keys 
+    $ _crInvSel cr `IM.delete` _crInv cr 
 
 dropItem :: Creature -> Int -> World -> World
-dropItem cr invid = rmInvItem cid invid . copyItemToFloor cr invid
-  where
-    cid = _crID cr
+dropItem cr invid = rmInvItem (_crID cr) invid . copyInvItemToFloor cr invid
 
 {- | Get your creature to drop the item under the cursor.  -}
 youDropItem :: World -> World
 youDropItem w = case yourItem w ^? itCurseStatus of
-    Just Uncursed -> rmSelectedInvItem (_yourID w) 
-        . copyItemToFloor (you w) (_crInvSel cr)
-        $ soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
-        w
+    Just Uncursed -> w
+        & dropItem cr (_crInvSel cr) 
+        & soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
     _ -> w
   where
     cr = you w
 {- | Copy an inventory item to the floor. -}
-copyItemToFloor 
+copyInvItemToFloor 
     :: Creature
     -> Int      -- ^ Inventory position
     -> World 
     -> World
-copyItemToFloor cr i w = case _crInv cr IM.! i of
+copyInvItemToFloor 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 + 2) *.* unitVectorAtAngle rot
-        updateLocation w' = case it ^? itID of
-            Just (Just i')  -> w' & itemPositions . ix i' .~ OnFloor flid
-            _ -> w'
-        flid = IM.newKey $ _floorItems w
-        theflit = FlIt 
-            {_flIt = it
-            ,_flItPos = offset +.+ _crPos cr
-            ,_flItRot = rot
-            ,_flItID = flid
-            }
+    it      -> copyItemToFloor (_crPos cr) it w
+{- | Copy an item to the floor. -}
+copyItemToFloor 
+    :: Point2
+    -> Item
+    -> World 
+    -> World
+copyItemToFloor pos it w = w'
+    & floorItems %~ IM.insert flid theflit
+    & updateLocation 
+  where
+    (p',w') = findWallFreeDropPoint (_itRad $ _itDimension it) pos w
+    rot = fst . randomR (-pi,pi) $ _randGen w
+    updateLocation = case it ^? itID of
+        Just (Just i')  -> itemPositions . ix i' .~ OnFloor flid
+        _ -> id
+    flid = IM.newKey $ _floorItems w
+    theflit = FlIt 
+        {_flIt = it
+        ,_flItPos = p'
+        ,_flItRot = rot
+        ,_flItID = flid
+        }
+findWallFreeDropPoint :: Float -> Point2 -> World -> (Point2,World)
+findWallFreeDropPoint r p w = (head $ mapMaybe f cardinalVectors ++ [p]
+    , w {_randGen = g})
+  where
+    f q = testOnWall r $ p +.+ rotateV rot (10 *.* q)
+    testOnWall r' q | circOnSomeWall q r' w = Nothing
+        | otherwise = Just q
+    (rot, g) = randomR (0,2*pi) $ _randGen w
+
+cardinalVectors :: [Point2]
+cardinalVectors =
+    [ V2   1    0
+    , V2   0    1
+    , V2 (-1)   0
+    , V2   0  (-1)
+    ]
+    
+
 {- | Pick up a specific item. -}
 pickUpItem 
     :: Int  -- ^ Creature id