Cleanup

src/Dodge/Placement/PlaceSpot.hs

@@ -6,7 +6,6 @@
 -}
 module Dodge.Placement.PlaceSpot (placeSpot) where
 
-import Linear
 import Color
 import Control.Monad.State
 import Data.Bifunctor
@@ -23,6 +22,7 @@ import Dodge.ShiftPoint
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
+import Linear
 import NewInt
 
 --import System.Random
@@ -31,7 +31,6 @@ import NewInt
 -- to the placement. This id should be associated with the type of placement and
 -- match up with the created id for the object (creature id, flitid id, etc)
 placeSpot :: Int -> GenWorld -> Placement -> GenWorld
---placeSpot :: (GenWorld, Room) -> Placement -> (GenWorld, Room)
 placeSpot rid w plmnt = case plmnt of
     Placement{_plSpot = PSRoomRand i f} -> placeSpotRoomRand rid i f plmnt w
     Placement{_plSpot = PSPos extract eff fallback} ->
@@ -58,7 +57,11 @@ placePlainPSSpot w rid plmnt shift = case plmnt ^. plType of
     f x gw = fromMaybe gw $ do
         j <- x ^. plExternalID
         return $ gw & genPmnt . at j ?~ x
-    recrPlace newplmnt w' pl = placeSpot rid (w' & genRooms . ix rid . rmPmnts .:~ newplmnt) pl
+    recrPlace newplmnt w' pl =
+        placeSpot
+            rid
+            (w' & genRooms . ix rid . rmPmnts .:~ newplmnt)
+            pl
 
 -- this should be tidied up
 placeSpotUsingLink ::
@@ -69,15 +72,14 @@ placeSpotUsingLink ::
     (RoomPos -> Room -> Room) ->
     Maybe Placement ->
     GenWorld
-placeSpotUsingLink w rid plmnt extract eff fallback = case searchedPoss (w ^?! genRooms . ix rid . rmPos) of
-    Just (ps, rmposs) ->
-        placeSpot
-            rid
-            (w & genRooms . ix rid %~ eff (head rmposs) . (rmPos .~ rmposs))
-            (plmnt & plSpot .~ ps)
-    Nothing -> case fallback of
-        Nothing -> w
-        Just plmnt' -> placeSpot rid w plmnt'
+placeSpotUsingLink w rid plmnt extract eff fallback =
+    case searchedPoss (w ^?! genRooms . ix rid . rmPos) of
+        Just (ps, rmposs) ->
+            placeSpot
+                rid
+                (w & genRooms . ix rid %~ eff (head rmposs) . (rmPos .~ rmposs))
+                (plmnt & plSpot .~ ps)
+        Nothing -> maybe w (placeSpot rid w) fallback
   where
     searchedPoss [] = Nothing
     searchedPoss (pos : poss) = case extract pos (w ^?! genRooms . ix rid) of
@@ -92,7 +94,10 @@ placeSpotRoomRand ::
     GenWorld ->
     GenWorld
 placeSpotRoomRand rid i f plmnt w =
-    let (ps, g) = runState (_rmRandPSs (w ^?! genRooms . ix rid) !! i) $ w ^. gwWorld . randGen
+    let (ps, g) =
+            runState
+                (_rmRandPSs (w ^?! genRooms . ix rid) !! i)
+                $ w ^. gwWorld . randGen
      in placeSpot rid (w & gwWorld . randGen .~ g) (plmnt & plSpot .~ f ps)
 
 -- the Int here is some id that is assigned when the placement is placed
@@ -127,8 +132,8 @@ placeSpotID rid ps pt w = case pt of
             w
     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
+    PutPPlate pp ->
+        plNewUpID (gwWorld . cWorld . lWorld . pressPlates) ppID (mvPP p rot pp) 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
@@ -145,8 +150,10 @@ placeSpotID rid ps pt w = case pt of
     PutNothing -> (0, w)
     PutID i -> (i, w)
     PutWorldUpdate f -> (0, w & f rid ps)
-    PutChasm ps' -> (0, w & gwWorld . cWorld . chasms .:~ map doShift ps'
-        & genRooms . ix rid . rmPos %~ filter (\rp -> not $ pointInPoly (_rpPos rp) ps')
+    PutChasm ps' ->
+        ( 0
+        , w & gwWorld . cWorld . chasms .:~ map doShift ps'
+            & genRooms . ix rid . rmPos %~ filter (\rp -> not $ pointInPoly (_rpPos rp) ps')
         )
     PutLabel{} -> (0, w)
   where
@@ -182,19 +189,27 @@ mvButton :: Point2 -> Float -> Button -> Button
 mvButton p a = (btRot +~ a) . (btPos %~ ((p +.+) . rotateV a))
 
 mvPP :: Point2 -> Float -> PressPlate -> PressPlate
-mvPP p rot pp = pp{_ppPos = p, _ppRot = rot}
+mvPP p rot pp = pp & ppPos .~ p & ppRot .~ rot
 
 mvCr :: Point2 -> Float -> Creature -> Creature
-mvCr p rot cr = cr
-    & crPos . _xy .~ p
-    & crOldPos . _xy .~ p
-    & crDir .~ rot
+mvCr p rot cr =
+    cr
+        & crPos . _xy .~ p
+        & crOldPos . _xy .~ p
+        & crDir .~ rot
 
 mvFS :: Point2 -> Float -> ForegroundShape -> ForegroundShape
 mvFS p a = (fsDir +~ a) . (fsPos %~ ((p +.+) . rotateV a))
 
 plMachine ::
-    [Point2] -> Machine -> Wall -> Maybe Item -> Point2 -> Float -> GenWorld -> (Int, GenWorld)
+    [Point2] ->
+    Machine ->
+    Wall ->
+    Maybe Item ->
+    Point2 ->
+    Float ->
+    GenWorld ->
+    (Int, GenWorld)
 plMachine wallpoly mc wl = \case
     Nothing -> plMachine' wallpoly mc wl
     Just itm -> plTurret wallpoly mc wl itm