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
+dropUnselected cr w = foldr (dropItem cr) w . IM.keys 
-  where
+    $ _crInvSel cr `IM.delete` _crInv cr 
-    unselectedItems = _crInvSel cr `IM.delete` _crInv cr 
 
 dropItem :: Creature -> Int -> World -> World
-dropItem cr invid = rmInvItem cid invid . copyItemToFloor cr invid
+dropItem cr invid = rmInvItem (_crID cr) invid . copyInvItemToFloor cr invid
-  where
-    cid = _crID cr
 
 {- | 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) 
+    Just Uncursed -> w
-        . copyItemToFloor (you w) (_crInvSel cr)
+        & dropItem cr (_crInvSel cr) 
-        $ soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
+        & soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
-        w
     _ -> 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
+    it      -> copyItemToFloor (_crPos cr) it w
-      where 
+{- | Copy an item to the floor. -}
-        (rot, g) = randomR (-pi,pi) $ _randGen w
+copyItemToFloor 
-        offset = (_crRad cr + 2) *.* unitVectorAtAngle rot
+    :: Point2
-        updateLocation w' = case it ^? itID of
+    -> Item
-            Just (Just i')  -> w' & itemPositions . ix i' .~ OnFloor flid
+    -> World 
-            _ -> w'
+    -> World
-        flid = IM.newKey $ _floorItems w
+copyItemToFloor pos it w = w'
-        theflit = FlIt 
+    & floorItems %~ IM.insert flid theflit
-            {_flIt = it
+    & updateLocation 
-            ,_flItPos = offset +.+ _crPos cr
+  where
-            ,_flItRot = rot
+    (p',w') = findWallFreeDropPoint (_itRad $ _itDimension it) pos w
-            ,_flItID = flid
+    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

src/Dodge/Creature/State.hs

@@ -60,7 +60,7 @@ stateUpdate u cr w = case u (updateMovement cr) w of
         (_crCorpse cr)
 -- | Drop items according to the creature state.
 dropByState :: Creature -> World -> World
-dropByState cr w = foldr (copyItemToFloor cr) w is
+dropByState cr w = foldr (copyInvItemToFloor cr) w is
   where
     is :: [Int]
     is = case cr ^. crState . crDropsOnDeath of

src/Dodge/Data.hs

@@ -409,6 +409,7 @@ data CurseStatus = Uncursed | UndroppableIdentified | UndroppableUnidentified
 
 data ItemDimension = ItemDimension
     { _itDim    :: Point3 -- length width height
+    , _itRad    :: Float
     , _itHandle :: Point3
     , _itCenter :: Point3
     , _muzzleLength :: Float

src/Dodge/Default/Weapon.hs

@@ -51,6 +51,7 @@ defaultGun = Weapon
 defaultItemDimension :: ItemDimension
 defaultItemDimension = ItemDimension
     { _itDim = V3 4 4 4
+    , _itRad = 10
     , _itHandle = V3 2 2 2
     , _itCenter = V3 2 2 2
     , _muzzleLength = 5 -- how much the item projects out from the cr radius when aiming

src/Dodge/WallCreatureCollisions.hs

@@ -27,8 +27,7 @@ colCrWall w c
     | otherwise = c & crPos .~ _crOldPos c
   where 
     c'' = c & crPos %~ pushOutFromWalls rad ls
-    c' = c & crPos %~ 
+    c'  = c & crPos %~ pushOutFromWalls rad (reverse ls)
-        pushOutFromWalls rad (reverse ls)
         . pushOutFromWalls rad ls 
         . flip (collidePointWalls p1) wls  -- check push throughs
     rad = _crRad c + wallBuffer

src/Geometry.hs

@@ -171,7 +171,7 @@ pHalf :: Point2 -> Point2 -> Point2
 pHalf !a !b = 0.5 *.* (a +.+ b)
 -- | Test whether a circle is on a segment by intersecting a new normal segment through the 
 -- center of the circle with the segment itself.
--- Returns False if the circle center is beyond the enpoints of the
+-- Returns False if the circle center is beyond the endpoints of the
 -- segment.
 circOnSegNoEndpoints :: Point2 -> Point2 -> Point2 -> Float -> Bool
 {-# INLINE circOnSegNoEndpoints #-}