Fix bug in annotations

2022-06-12 18:23:57 +01:00
parent fa1e3ef2f5
commit deb02d5c1a
4 changed files with 63 additions and 105 deletions
@@ -62,48 +62,7 @@ annoToRoomTree' an = case an of
            (MTree "" lr [MBranch "" (toLabel' i) keyroom])
            []

--annoToRoomTree :: Annotation -> State StdGen (MetaTree Room)
--annoToRoomTree an = case an of
--    OnwardList ans -> do
--        mts <- mapM annoToRoomTree ans
--        return $ foldr1 attachOnward mts
--    SpecificRoom r -> r
--    PadWith r an -> annoToRoomTree an
--    IntAnno i f -> annoToRoomTree $ f i
-
 attachOnward :: MetaTree Room -> MetaTree Room -> MetaTree Room
 attachOnward t1 t2 = case t1 of
    MTree {} -> t1 & mtBranches .:~ MBranch "Onward" toOnward' t2
-    BTree {} -> t2 & btBranches .:~ t2
-
-{- | Create a random room tree structure from a list of annotations.  -}
--anoToRoomTree :: [Annotation] -> State StdGen (Room -> Maybe ([String],Room), Tree Room)
--anoToRoomTree anos = case anos of
--    [AnoApplyInt i f] -> f i
----    [AnoApplyInt' i f str] -> f i <&> (,TreeSubLabelling str Nothing)
--    (SpecificRoom rt:_) -> rt
--    [PassthroughLockKeyLists i ls ks] -> do
--        (functionlockroom,randomitemidentity) <- takeOne ls
--        lr' <- functionlockroom i
--        ii <- randomitemidentity
--        let lr = snd lr'
--        keyroom' <- fromJust $ lookup ii ks
--        let keyroom = snd keyroom'
--        rToOnward ("PassthroughLockKeyLists-"++show ii) $ overwriteLabel i lr [keyroom]
--    _ -> rToOnward "no label" =<< anoToRoomTree' anos
-
-{- | Create a random room tree structure from a list of annotations.  -}
-anoToRoomTree' :: [Annotation] -> State StdGen (Tree Room)
-anoToRoomTree' anos = case anos of
--    [OrAno as] -> do
--        a <- takeOne as
--        anoToRoomTree' a
--    [Corridor] -> pure . cleatOnward <$> shuffleLinks corridor
--    (BossAno cr : _) -> do
--        br <- bossRoom cr
--        branchRectWith . pure $ treeFromPost [corridor,corridor] br
--    (TreasureAno crs loot : _) -> branchRectWith . fmap pure $ lootRoom crs loot
-    _ -> do
-        w <- state $ randomR (100,400)
-        h <- state $ randomR (200,400)
-        fmap (pure . cleatOnward) . shuffleLinks $ roomRectAutoLinks w h
+    BTree {} -> MTree "ConstructedOnward" t1 [MBranch "Onward" toOnward' t2]