diff --git a/src/Dodge/Placement/Instance/Tank.hs b/src/Dodge/Placement/Instance/Tank.hs index d9b1f1cca..5a5414b1c 100644 --- a/src/Dodge/Placement/Instance/Tank.hs +++ b/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 diff --git a/src/Dodge/Room/GlassLesson.hs b/src/Dodge/Room/GlassLesson.hs index fc064c4ed..1478ca23f 100644 --- a/src/Dodge/Room/GlassLesson.hs +++ b/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 diff --git a/src/Dodge/Room/LasTurret.hs b/src/Dodge/Room/LasTurret.hs index d592b8a10..f96e45b93 100644 --- a/src/Dodge/Room/LasTurret.hs +++ b/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 - let doorroom = switchDoorRoom & rmTakeFrom .~ Just n + cenroom <- shuffleLinks $ lightSensInsideDoor cenLasTur & rmLabel ?~ n + let doorroom = switchDoorRoom & rmTakeFrom ?~ n return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door) lasCenSensEdge :: RandomGen g => Int -> State g (SubCompTree Room) diff --git a/src/Dodge/Room/LongRoom.hs b/src/Dodge/Room/LongRoom.hs index b9d01f450..9d8deafbb 100644 --- a/src/Dodge/Room/LongRoom.hs +++ b/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) ] ) diff --git a/src/Dodge/Tree/Shift.hs b/src/Dodge/Tree/Shift.hs index b7f438fbd..dce7808e3 100644 --- a/src/Dodge/Tree/Shift.hs +++ b/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 - >> (fmap (fmap (map $ first createUnusedLinkPos))) +positionRoomsFromTree (Node (r,i) ts) = printColumnTitles + >> 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) - (first updateparent parenti) its (tseq |> shiftedt) + mayrs <- posRms + (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):) --- . (map (uncurry UnusedLink . lnkPosDir) (delete il (_rmLinks rm)) ++) - ) - shiftedt = applyToRoot - (first $ updatechild . shiftRoomShiftToLink (lnkPosDir shiftedoutlink) (lnkPosDir il)) t + & rmPos .:~ uncurry (UsedInLink 0) (lnkPosDir il) + shiftedt = applyToRoot + (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 () -printHeader = theColumns ["Parent","Cnum","Child","Link pair"] +printColumnTitles :: IO () +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