Reorganise weapons, start work on drones

2021-11-22 00:37:27 +00:00
parent 1aa797ddef
commit 213f573011
19 changed files with 559 additions and 403 deletions
@@ -0,0 +1,45 @@
+module Dodge.FloorItem 
+    (copyItemToFloor
+    ) 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 w = w'
+    & floorItems %~ IM.insert flid theflit
+    & updateLocation 
+  where
+    (p',w') = findWallFreeDropPoint (_itRad $ _itDimension it) pos w
+    rot = fst . randomR (-pi,pi) $ _randGen w
+    updateLocation = case it ^? itID of
+        Just (Just i')  -> itemPositions . ix i' .~ OnFloor flid
+        _ -> id
+    flid = IM.newKey $ _floorItems w
+    theflit = FlIt 
+        {_flIt = it
+        ,_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