Commit before placement refactor

src/Dodge/LevelGen.hs

@@ -36,38 +36,12 @@ import Data.List.Extra
 --import qualified Data.Map as M
 
 placeSpots :: [Placement] -> World -> World
-placeSpots pss w = foldr (placeSpot . _placementSpot) w' singlePlacements
+placeSpots pss w = foldr (placeSpot . _placementSpot) w simplePlacements
   where
-    (singlePlacements, groupedPlacements) = partition isSPS pss
-    isSPS SinglePlacement{} = True
-    isSPS _ = False
-    gplmnts :: [[Placement]]
-    gplmnts = groupOn _groupPlacementID $ sortOn _groupPlacementID groupedPlacements
-    w' = foldr putGroup w gplmnts
-    putGroup :: [Placement] -> World -> World
-    putGroup gps w'' = (_groupUpdate $ head gps) w'' gps
+    (simplePlacements, idPlacements ) = partition isSimple pss
+    isSimple SimplePlacement{} = True
+    isSimple _ = False
 
-{- | OK, this is perhaps slightly impenetrable.
- - The idea is that for a list of collected group placements, we first update
- - the world for each placement and update the placements into PSTypes.
- - This is the mapAccumR step.
- - After this, for each placement we apply the group placement function to
- - the psType using a zipWith, and taking all the pstypes as a paramenter,
- - then successively update the world using a foldr. -}
---updateGroup :: [Placement] -> World -> World
---updateGroup ps w =
---    let (w', psTypes) = mapAccumR updateSpot w $ map _placementSpot ps
---        fs = zipWith (\gp pst -> _groupPlacementFunc gp psTypes pst) ps psTypes
---    in foldr ($) w' fs
---{- | -}
---updateSpot :: World -> PlacementSpot -> (World, PSType)
---updateSpot w ps = case _psType ps of
---    PutButton bt -> undefined
---    PutCrit cr -> placeUpdateCr cr p rot w
---  where
---    p = _psPos ps
---    rot = _psRot ps
-{- | -}    
 placeSpot :: PlacementSpot -> World -> World
 placeSpot ps w = case _psType ps of
     PutProp prop -> placeProp prop p rot w
@@ -155,6 +129,17 @@ placeProp pr p a = over props addProp
   where 
     addProp prs = IM.insert (IM.newKey prs) (over pjRot (+a) pr {_pjPos = p, _pjID = IM.newKey prs}) prs
 
+placePropID 
+    :: Prop
+    -> Point2
+    -> Float -- ^ Rotation
+    -> World
+    -> (World,Int)
+placePropID pr p a w = (w & props %~ addProp , k)
+  where 
+    k = IM.newKey (_props w)
+    addProp prs = IM.insert (IM.newKey prs) (over pjRot (+a) pr {_pjPos = p, _pjID = IM.newKey prs}) prs
+
 placeBt 
     :: Button
     -> Point2