51 lines
1.5 KiB
Haskell
51 lines
1.5 KiB
Haskell
module Dodge.FloorItem
|
|
( copyItemToFloor
|
|
, copyItemToFloorID
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
|
|
import Control.Lens
|
|
import System.Random
|
|
import Data.Maybe
|
|
|
|
{- | 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 = case it ^? itID of
|
|
Just (Just i') -> cWorld . itemLocations . ix i' .~ OnFloor flid
|
|
_ -> id
|
|
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
|