61 lines
1.8 KiB
Haskell
61 lines
1.8 KiB
Haskell
module Dodge.FloorItem (
|
|
copyItemToFloor,
|
|
copyItemToFloorID,
|
|
) where
|
|
|
|
import NewInt
|
|
import Control.Lens
|
|
import Data.Maybe
|
|
import Data.Monoid
|
|
import Dodge.Base
|
|
import Dodge.Data.World
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
import System.Random
|
|
|
|
-- | Copy an item to the floor.
|
|
copyItemToFloor :: Point2 -> Item -> World -> World
|
|
copyItemToFloor pos it = snd . copyItemToFloorID pos it
|
|
|
|
-- | Copy an item to the floor, returns the floor item's id.
|
|
copyItemToFloorID :: Point2 -> Item -> World -> (NewInt FloorInt, World)
|
|
copyItemToFloorID pos it w =
|
|
(,) (NInt flid) $
|
|
w'
|
|
& cWorld . lWorld . floorItems . unNIntMap %~ IM.insert flid theflit
|
|
& cWorld . lWorld . itemLocations %~ IM.insert (_unNInt $ _itID it) (OnFloor $ NInt flid)
|
|
& hud . closeItems %~ (NInt flid:)
|
|
-- & hud . hudElement . diSections . ix 3 . ssOffset .~ 0
|
|
-- ensures dropped item is at the top of the close item selection list
|
|
where
|
|
(p', w') = findWallFreeDropPoint (_dimRad $ _itDimension it) pos w
|
|
rot = fst . randomR (- pi, pi) $ _randGen w
|
|
flid = IM.newKey . _unNIntMap . _floorItems . _lWorld $ _cWorld w
|
|
theflit =
|
|
FlIt
|
|
{ _flIt = it & itLocation .~ OnFloor (NInt flid)
|
|
, _flItPos = p'
|
|
, _flItRot = rot
|
|
, _flItID = NInt flid
|
|
}
|
|
|
|
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
|