38 lines
1.1 KiB
Haskell
38 lines
1.1 KiB
Haskell
module Dodge.FloorItem (copyItemToFloor) where
|
|
|
|
import Data.Maybe
|
|
import Data.Monoid
|
|
import Dodge.Base
|
|
import Dodge.Data.World
|
|
import Dodge.Item.InvSize
|
|
import Geometry
|
|
import LensHelp
|
|
import NewInt
|
|
import System.Random
|
|
|
|
-- | Copy an item to the floor
|
|
copyItemToFloor :: Point2 -> Item -> World -> World
|
|
copyItemToFloor p it w =
|
|
w'
|
|
& cWorld . lWorld . floorItems . at (it ^. itID . unNInt) ?~ FlIt q r
|
|
& cWorld . lWorld . items . at (it ^. itID . unNInt) ?~ (it & itLocation .~ OnFloor)
|
|
& hud . closeItems .:~ _itID it -- puts item at top of close items
|
|
where
|
|
(q, w') = findWallFreeDropPoint (_dimRad $ itDim it) p w
|
|
r = fst . randomR (- pi, pi) $ _randGen w
|
|
|
|
cardinalVectors :: [Point2]
|
|
cardinalVectors = [ V2 1 0 , V2 0 1 , V2 (-1) 0 , V2 0 (-1) ]
|
|
|
|
findWallFreeDropPoint :: Float -> Point2 -> World -> (Point2, World)
|
|
findWallFreeDropPoint r p w =
|
|
( fromMaybe p . getFirst $ foldMap f cardinalVectors
|
|
, w & randGen .~ g
|
|
)
|
|
where
|
|
f q = testOnWall $ p +.+ rotateV rot (10 *.* q)
|
|
testOnWall q
|
|
| circOnSomeWall q r w = mempty
|
|
| otherwise = pure q
|
|
(rot, g) = randomR (0, 2 * pi) $ _randGen w
|