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

Cleanup

Browse Source
This commit is contained in:
justin
2021-11-23 22:33:23 +00:00
parent ddd120dee1
commit 5f6d81bd05
10 changed files with 65 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Tree/Shift.hs
+8 -8
View File
@@ -41,26 +41,26 @@ posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do
where
tryChildLinks [] = tryParentLinks ls
tryChildLinks ((numinlink,il):ils)
| clipping = tryChildLinks ils
| clipping = tryChildLinks ils
| otherwise = do
putStrLn $ show j ++ "-"++show numinlink
mayrs <- posRms (convexBounds ++ bounds)
mayrs <- posRms (newBounds ++ bounds)
(first updateparent parenti) its (tseq |> shiftedt)
case mayrs of
Just rms -> return $ Just rms
Nothing -> printInfo parenti numChild childi
>> tryChildLinks ils
where
convexBounds = map pointsToPoly $ _rmBound r'
clipping = or (convexPolysOverlap <$> convexBounds <*> bounds)
newBounds = map pointsToPoly $ _rmBound r'
clipping = or (convexPolysOverlap <$> newBounds <*> bounds)
updateparent rm = doLnkEff (lnkPosDir outlnk) $ rm
& rmLinks %~ delete outlnk & rmPos %~ (uncurry (UsedOutLink numChild) (lnkPosDir outlnk) :)
l' = shiftLinkBy (_rmShift parent) outlnk
& rmLinks %~ delete outlnk & rmPos %~ (uncurry (UsedOutLink numChild (snd childi)) (lnkPosDir outlnk) :)
shiftedoutlink = shiftLinkBy (_rmShift parent) outlnk
r' = doRoomShift . fst $ rootLabel shiftedt
updatechild rm = rm & rmLinks %~ delete il
& rmPos %~ ( (uncurry (UsedInLink 0) (lnkPosDir il):)
. (map (uncurry UnusedLink . lnkPosDir) (delete il (_rmLinks rm)) ++) )
shiftedt = applyToRoot (first $ updatechild . shiftRoomShiftToLink' (lnkPosDir l') (lnkPosDir il)) t
shiftedt = applyToRoot (first $ updatechild . shiftRoomShiftToLink (lnkPosDir shiftedoutlink) (lnkPosDir il)) t
zipCount :: [a] -> [(Int,a)]
zipCount = Prelude.zip [0..]
@@ -85,7 +85,7 @@ printInfo (parentrm,parenti) childn (childrm,childi) = do
printInfoCheckNum :: RoomInt -> Int -> RoomInt -> IO ()
printInfoCheckNum p 0 c = printInfo p 0 c
printInfoCheckNum _ childn (childrm,childi) = do
putStr $ rpns 20 ("")
putStr $ rpns 20 ""
++ rpns 5 (show childn ++ " ")
++ rpns 20 (_rmName childrm ++ "-" ++ show childi )
where