justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup, fix tank opacity

Browse Source
This commit is contained in:
justin
2022-03-08 10:26:51 +00:00
parent 8179a2aa4f
commit 2e1c7f2687
5 changed files with 23 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Tree/Shift.hs
+15 -13
View File
@@ -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