Commit before changing logging of placement spots

src/Dodge/Placement/PlaceSpot.hs

@@ -23,7 +23,7 @@ import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
 import NewInt
-import System.Random
+--import System.Random
 
 -- when placing a placement, we update the world and the room and assign an id
 -- to the placement. This id should be associated with the type of placement and
@@ -38,14 +38,17 @@ placeSpot rid w plmnt = case plmnt of
   where
     shift = _rmShift $ w ^?! genRooms . ix rid
 
-placePlainPSSpot 
-    :: GenWorld -> Int -> Placement -> DPoint2 -> GenWorld
-placePlainPSSpot w rid plmnt shift =
-    let (i, w') = placeSpotID rid (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w
-        newplmnt = plmnt & plMID ?~ i
-        gw = maybe (w' & genRooms . ix rid . rmPmnts .:~ newplmnt) 
-            (recrPlace newplmnt w') (_plIDCont plmnt w' newplmnt)
-     in (f newplmnt gw)
+placePlainPSSpot :: GenWorld -> Int -> Placement -> DPoint2 -> GenWorld
+placePlainPSSpot w rid plmnt shift = case plmnt ^. plType of
+    RandPS rgn -> 
+        let (x, g) = runState rgn (w ^. gwWorld . randGen)
+        in placePlainPSSpot (w & gwWorld . randGen .~ g) rid (plmnt & plType .~ x) shift
+    _ ->
+        let (i, w') = placeSpotID rid (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w
+            newplmnt = plmnt & plMID ?~ i
+            gw = maybe (w' & genRooms . ix rid . rmPmnts .:~ newplmnt) 
+                (recrPlace newplmnt w') (_plIDCont plmnt w' newplmnt)
+         in f newplmnt gw
   where
     f x gw = fromMaybe gw $ do
         j <- x ^. plExternalID
@@ -90,7 +93,8 @@ placeSpotID rid ps pt w = case pt of
     PutTrigger cnd -> plNewID (gwWorld . cWorld . lWorld . triggers) cnd w
     PutMod mdi -> plNewUpID (gwWorld . cWorld . lWorld . modifications) mdID mdi w
     PutProp prp -> plNewUpID (gwWorld . cWorld . lWorld . props) prID (mvProp p rot prp) w
-    PutButton bt -> plNewUpID (gwWorld . cWorld . lWorld . buttons) btID (mvButton p rot bt) w
+    PutButton bt -> plNewUpID (gwWorld . cWorld . lWorld . buttons) btID 
+        (mvButton p rot bt) w
     PutTerminal tm -> plNewUpID (gwWorld . cWorld . lWorld . terminals) tmID tm w
     PutFlIt itm ->
         let i = IM.newKey (w ^. gwWorld . cWorld . lWorld . items)
@@ -108,7 +112,7 @@ placeSpotID rid ps pt w = case pt of
     PutMachine pps mc wl mitm -> plMachine (map doShift pps) mc wl mitm p rot w
     PutLS ls -> plNewUpID (gwWorld . cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
     PutPPlate pp -> plNewUpID (gwWorld . cWorld . lWorld . pressPlates) ppID (mvPP p rot pp) w
-    RandPS rgn -> evaluateRandPS rid rgn ps w
+    RandPS _ -> error "RandPS should not be reachable here" --evaluateRandPS rid rgn ps w
     PutDoor col eo f pss -> plDoor col eo f (map (bimap doShift doShift) pss) w
     PutCoord cp -> plNewID (gwWorld . coordinates) (doShift cp) w
     PutSlideDr wl dr eo off a b ->
@@ -131,11 +135,12 @@ placeSpotID rid ps pt w = case pt of
     rot = _psRot ps
     doShift = shiftPointBy (p, rot)
 
-evaluateRandPS 
-    :: Int -> State StdGen PSType -> PlacementSpot -> GenWorld -> (Int, GenWorld)
-evaluateRandPS rid rgen ps w = placeSpotID rid ps evaluatedType (set (gwWorld . randGen) g w)
-  where
-    (evaluatedType, g) = runState rgen (_randGen $ _gwWorld w)
+--evaluateRandPS 
+--    :: Int -> State StdGen PSType -> PlacementSpot -> GenWorld -> (Int, GenWorld)
+--evaluateRandPS rid rgen ps w = placeSpotID rid ps evaluatedType 
+--    $ set (gwWorld . randGen) g w
+--  where
+--    (evaluatedType, g) = runState rgen (_randGen $ _gwWorld w)
 
 -- this function is the reason for the warning suppression
 -- remove the warning suppression if it changes