57 lines
1.5 KiB
Haskell
57 lines
1.5 KiB
Haskell
module Dodge.FloorItem (
|
|
copyItemToFloor,
|
|
copyItemToFloorID,
|
|
) where
|
|
|
|
import Control.Lens
|
|
import Data.Maybe
|
|
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 -> (Int, World)
|
|
copyItemToFloorID pos it w =
|
|
(,) flid $
|
|
w'
|
|
& cWorld . floorItems %~ IM.insert flid theflit
|
|
& updateLocation
|
|
where
|
|
(p', w') = findWallFreeDropPoint (_dimRad $ _itDimension it) pos w
|
|
rot = fst . randomR (- pi, pi) $ _randGen w
|
|
updateLocation = cWorld . itemLocations . ix (_itID it) .~ OnFloor flid
|
|
flid = IM.newKey $ _floorItems (_cWorld w)
|
|
theflit =
|
|
FlIt
|
|
{ _flIt = it & itUse . useAmount %~ const 1
|
|
, _flItPos = p'
|
|
, _flItRot = rot
|
|
, _flItID = 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 =
|
|
( 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
|