Cleanup, fix tank opacity

src/Dodge/Placement/Instance/Tank.hs

@@ -53,7 +53,8 @@ tankRect w h col x y = shiftPlacement (V2 x y,0) $ ps0j
         $ upperPrismPoly 31 therect
         <> foldMap f [(w',-w',h',h'),(w',-w',-h',-h'),(w',w',h',-h'),(-w',-w',h',-h')]
     )
-    $ sps0 $ PutWall therect defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
+    $ sps0 $ PutWall therect defaultWall 
+        {_wlDraw = False, _wlColor = col, _wlRotateTo = False, _wlOpacity = SeeAbove}
   where
     therect = rectWH w h
     w' = w - 1.5

src/Dodge/Room/GlassLesson.hs

@@ -59,4 +59,4 @@ glassLesson = do
 glassLessonRunPast :: RandomGen g => State g (SubCompTree Room)
 glassLessonRunPast = f <$> glassLesson
   where
-    f (Node r rs) = Node r $ (return $ UseLabel 0 $ door & rmConnectsTo .~ S.singleton (OnEdge West)) : rs
+    f (Node r rs) = Node r $ return (UseLabel 0 $ door & rmConnectsTo .~ S.singleton (OnEdge West)) : rs

src/Dodge/Room/LasTurret.hs

@@ -36,7 +36,8 @@ cenLasTur = roomNgon 8 200 & rmPmnts .~
 
 lightSensInsideDoor :: Room -> Room
 lightSensInsideDoor rm = rm 
-    & rmPmnts .:~ (psPt atFstLnkOut $ PutShape $ colorSH yellow $
+    & rmPmnts .:~ psPt atFstLnkOut 
+        (PutShape $ colorSH yellow $
         thinHighBar 0 (V2 20 (-1)) (V2 20 (-100))
         <> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100))
         <> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80))
@@ -65,8 +66,8 @@ lightSensByDoor rm = rm
 
 lasSensorTurretTest :: RandomGen g => Int -> State g (SubCompTree Room)
 lasSensorTurretTest n = do
-    cenroom <- shuffleLinks $ lightSensInsideDoor cenLasTur & rmLabel .~ Just n
+    cenroom <- shuffleLinks $ lightSensInsideDoor cenLasTur & rmLabel ?~ n
-    let doorroom = switchDoorRoom & rmTakeFrom .~ Just n
+    let doorroom = switchDoorRoom & rmTakeFrom ?~ n
     return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
 
 lasCenSensEdge :: RandomGen g => Int -> State g (SubCompTree Room)

src/Dodge/Room/LongRoom.hs

@@ -55,6 +55,6 @@ longRoomRunPast = do
             [ singleUseAll door
             --, return (UseLabel 0 $ door & rmConnectsTo .~ S.singleton InLink)
             , treeFromPost [PassDown $ corridor & rmConnectsTo .~ S.singleton InLink, PassDown corridor] 
-                (UseLabel 0 $ door)
+                (UseLabel 0 door)
             ]
         )

src/Dodge/Tree/Shift.hs

@@ -23,8 +23,8 @@ import Data.Bifunctor
 type RoomInt = (Room,Int)
 
 positionRoomsFromTree :: Tree RoomInt -> IO (Maybe [RoomInt])
-positionRoomsFromTree (Node (r,i) ts) = printHeader 
+positionRoomsFromTree (Node (r,i) ts) = printColumnTitles 
-    >> (fmap (fmap (map $ first createUnusedLinkPos))) 
+    >> fmap (fmap (map $ first createUnusedLinkPos))
         (posRms (map pointsToPoly $ _rmBound r') (r',i) (zipCount ts) Empty)
   where
     r' = r & rmMID ?~ 0
@@ -46,15 +46,18 @@ posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do
         . Prelude.filter (not . S.null . S.intersection (_rmConnectsTo child) . _rlType) 
         $ _rmLinks parent
     tryParentLinks [] = putStrLn "no viable link pairs, backtrack" >> return Nothing
-    tryParentLinks ((j,outlnk):ls) = tryChildLinks $ zipCount (rmInLinks $ fst childi)
+    tryParentLinks ((j,outlnk):ls) = tryChildLinks . zipCount . rmInLinks $ fst childi
       where
         tryChildLinks [] = tryParentLinks ls
         tryChildLinks ((numinlink,il):ils) 
             | clipping  = tryChildLinks ils
             | otherwise = do
                 putStrLn $ show j ++ "-" ++ show numinlink
-                mayrs <- posRms (newBounds ++ bounds) 
+                mayrs <- posRms 
-                    (first updateparent parenti) its (tseq |> shiftedt)
+                    (newBounds ++ bounds)
+                    (first updateparent parenti) 
+                    its 
+                    (tseq |> shiftedt)
                 case mayrs of
                     Just rms -> return $ Just rms
                     Nothing -> printInfo parenti numChild childi
@@ -71,11 +74,10 @@ posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do
                 & rmMParent ?~ snd parenti
                 & rmMID     ?~ snd childi
                 & rmLinks   %~ delete il 
-                & rmPos     %~ ( (uncurry (UsedInLink 0) (lnkPosDir il):)
+                & rmPos     .:~ uncurry (UsedInLink 0) (lnkPosDir il)
---                    . (map (uncurry UnusedLink . lnkPosDir) (delete il (_rmLinks rm)) ++) 
-                    )
             shiftedt = applyToRoot
-                (first $ updatechild . shiftRoomShiftToLink (lnkPosDir shiftedoutlink) (lnkPosDir il)) t
+                (first $ updatechild . shiftRoomShiftToLink (lnkPosDir shiftedoutlink) (lnkPosDir il)) 
+                t
 
 createUnusedLinkPos :: Room -> Room
 createUnusedLinkPos rm = rm & rmPos .++~ map (uncurry UnusedLink . lnkPosDir) (_rmLinks rm)
@@ -90,13 +92,13 @@ printColumns _ strs = putStrLn $ concat strs
 theColumns :: [String] -> IO ()
 theColumns = printColumns [20,5,20,20]
 
-printHeader :: IO ()
+printColumnTitles :: IO ()
-printHeader = theColumns ["Parent","Cnum","Child","Link pair"]
+printColumnTitles = theColumns ["Parent","Cnum","Child","Link pair"]
 
 printInfo :: RoomInt -> Int -> RoomInt -> IO ()
 printInfo (parentrm,parenti) childn (childrm,childi) = do
     putStr $ rpns 20 (_rmName parentrm ++ "-" ++ show parenti )
-          ++ rpns 5 (show childn ++ " ")
+          ++ rpns 5  (show childn ++ " ")
           ++ rpns 20 (_rmName childrm ++ "-" ++ show childi )
   where
     rpns x s = rightPadNoSquash x ' ' s