Add newtype to floor item ids

src/Dodge/FloorItem.hs

@@ -3,8 +3,10 @@ module Dodge.FloorItem (
     copyItemToFloorID,
 ) where
 
+import NewInt
 import Control.Lens
 import Data.Maybe
+import Data.Monoid
 import Dodge.Base
 import Dodge.Data.World
 import Geometry
@@ -16,24 +18,22 @@ 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 :: Point2 -> Item -> World -> (NewInt FloorInt, World)
 copyItemToFloorID pos it w =
-    (,) flid $
+    (,) (NInt flid) $
         w'
-            & cWorld . lWorld . floorItems %~ IM.insert flid theflit
-            & updateLocation
+            & cWorld . lWorld . floorItems . unNIntMap %~ IM.insert flid theflit
+            & cWorld . lWorld . itemLocations . ix (_itID it) .~ OnFloor (NInt flid)
   where
     (p', w') = findWallFreeDropPoint (_dimRad $ _itDimension it) pos w
     rot = fst . randomR (- pi, pi) $ _randGen w
-    updateLocation = cWorld . lWorld . itemLocations . ix (_itID it) .~ OnFloor flid
-    flid = IM.newKey $ _floorItems (_lWorld (_cWorld w))
+    flid = IM.newKey . _unNIntMap . _floorItems . _lWorld $ _cWorld w
     theflit =
         FlIt
-            -- { _flIt = it & itUse . useAmount %~ const 1
             { _flIt = it
             , _flItPos = p'
             , _flItRot = rot
-            , _flItID = flid
+            , _flItID = NInt flid
             }
 
 cardinalVectors :: [Point2]
@@ -46,12 +46,12 @@ cardinalVectors =
 
 findWallFreeDropPoint :: Float -> Point2 -> World -> (Point2, World)
 findWallFreeDropPoint r p w =
-    ( head $ mapMaybe f cardinalVectors ++ [p]
-    , w{_randGen = g}
+    ( fromMaybe p . getFirst $ foldMap f cardinalVectors
+    , w & randGen .~ g
     )
   where
-    f q = testOnWall r $ p +.+ rotateV rot (10 *.* q)
-    testOnWall r' q
-        | circOnSomeWall q r' w = Nothing
-        | otherwise = Just q
+    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