From 4ef1811dd6732fc85c88b13c51d668c7a80c1308 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 19 Nov 2021 14:04:44 +0000 Subject: [PATCH] Tweak item dropping, add item radius --- src/Dodge/Creature/Action.hs | 79 +++++++++++++++++++---------- src/Dodge/Creature/State.hs | 2 +- src/Dodge/Data.hs | 1 + src/Dodge/Default/Weapon.hs | 1 + src/Dodge/WallCreatureCollisions.hs | 3 +- src/Geometry.hs | 2 +- 6 files changed, 56 insertions(+), 32 deletions(-) diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 8ab6a9865..98944e422 100644 --- a/src/Dodge/Creature/Action.hs +++ b/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 diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 7816cc44a..dbe21b47c 100644 --- a/src/Dodge/Creature/State.hs +++ b/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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index b1b78fef5..6efe62127 100644 --- a/src/Dodge/Data.hs +++ b/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 diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs index 04a6cd29d..33aee4869 100644 --- a/src/Dodge/Default/Weapon.hs +++ b/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 diff --git a/src/Dodge/WallCreatureCollisions.hs b/src/Dodge/WallCreatureCollisions.hs index d8fabb532..e6650a66a 100644 --- a/src/Dodge/WallCreatureCollisions.hs +++ b/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 %~ - pushOutFromWalls rad (reverse ls) + c' = c & crPos %~ pushOutFromWalls rad (reverse ls) . pushOutFromWalls rad ls . flip (collidePointWalls p1) wls -- check push throughs rad = _crRad c + wallBuffer diff --git a/src/Geometry.hs b/src/Geometry.hs index d2b32d08e..d8aef4395 100644 --- a/src/Geometry.hs +++ b/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 #-}