Commit before attempting to remove Annotation datatype

This commit is contained in:
2025-09-24 10:05:44 +01:00
parent 87f1444f5c
commit a83186e6dd
3 changed files with 17 additions and 8 deletions
+13 -5
View File
@@ -58,21 +58,29 @@ tutAnoTree =
---- , AnTree $ weaponTut
]
setRoomInt :: Room -> State LayoutVars (Int,Room)
setRoomInt x = do
i <- nextLayoutInt
return (i,x & rmPmnts .:~ sps0 (PutWorldUpdate (f i)))
where
f i rm _ = genInts . at i ?~ (rm ^?! rmMID . _Just)
tutDrop :: State LayoutVars (MetaTree Room String)
tutDrop = do
x <- shuffleLinks =<< roomNgon 6 100
i <- nextLayoutInt
let y = decontamRoom i
--let y = decontamRoom i
(j,y) <- setRoomInt (decontamRoom i)
rm <- roomRectAutoLinks 40 100
return $
tToBTree "TutDrop" $
treePost
[x & rmPmnts .:~ t, y, cleatOnward rm]
[x & rmInPmnt .:~ t j, y, cleatOnward rm]
where
t =
putMessageTerminal
t j = \ gw -> let x = gw ^? genInts . ix j
in putMessageTerminal
terminalColor
(defaultTerminal & tmBootLines .~ ss <> tlSetStatus (TerminalPressTo "QUIT") <> tlDoEffect TmWdWdPowerDownTerminal)
(defaultTerminal & tmBootLines .~ ss <> tlSetStatus (TerminalPressTo $ show x <>"QUIT") <> tlDoEffect TmWdWdPowerDownTerminal)
& plSpot .~ rprBoolShift isUnusedLnk
(\(p, a) -> (p + 10 *.* unitVectorAtAngle (a - pi/2), a))
ss =
+3 -2
View File
@@ -36,7 +36,8 @@ overwriteLabel i t ts =
t
attachTree :: (a -> Maybe a) -> Tree a -> Tree ([Tree a], a) -> Tree ([Tree a], a)
attachTree upf t = safeUpdateSingleNode (isJust . upf . snd) ((root . _2 %~ g) . (root . _1 .:~ t))
attachTree upf t = safeUpdateSingleNode (isJust . upf . snd) ((root . _2 %~ g)
. (root . _1 .:~ t))
where
g x = fromMaybe x (upf x)
@@ -78,7 +79,7 @@ composeNode (NodeTree t) = t
composeNode (NodeMTree mt) = composeTree mt
attachList' :: Tree a -> [MetaBranch a b] -> Tree a
attachList' t xs = shiftChildren $ foldr attachBranch (fmap ([],) t) xs
attachList' t = shiftChildren . foldr attachBranch (fmap ([],) t)
attachBranch :: MetaBranch a b -> Tree ([Tree a], a) -> Tree ([Tree a], a)
attachBranch mb =