42 lines
1.3 KiB
Haskell
42 lines
1.3 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 qualified IntMapHelp as IM
|
|
import NewInt
|
|
import System.Random
|
|
|
|
-- | Copy an item to the floor
|
|
copyItemToFloor :: Point2 -> Item -> World -> World
|
|
copyItemToFloor pos it w =
|
|
w'
|
|
& cWorld . lWorld . floorItems . at (_unNInt $ _itID it) ?~ theflit
|
|
& cWorld . lWorld . items . at (_unNInt $ _itID it) ?~ (it & itLocation .~ OnFloor)
|
|
& hud . closeItems .:~ _itID it
|
|
where
|
|
-- & hud . hudElement . diSections . ix 3 . ssOffset .~ 0
|
|
-- ensures dropped item is at the top of the close item selection list
|
|
(p', w') = findWallFreeDropPoint (_dimRad $ itDim it) pos w
|
|
rot = fst . randomR (- pi, pi) $ _randGen w
|
|
theflit = FlIt{_flItPos = p', _flItRot = rot}
|
|
|
|
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
|