Redo tree composition

2022-06-10 00:08:32 +01:00
parent 3edc7a0a58
commit 5532c25d3c
13 changed files with 114 additions and 52 deletions
@@ -0,0 +1,24 @@
+module Dodge.UseAll where
+import Dodge.Data
+
+import Control.Lens
+import qualified Data.Set as S
+
+toOnward :: String -> Room -> Maybe ([String],Room)
+toOnward s rm
+    | OnwardCluster `elem` rm ^?! rmClusterStatus . csLinks = Just ([s],rm)
+    | otherwise = Nothing
+
+toClusterLabel :: Int -> String ->  Room -> Maybe ([String],Room)
+toClusterLabel i s rm
+    | LabelCluster i `elem` rm ^?! rmClusterStatus . csLinks = Just ([s],rm)
+    | otherwise = Nothing
+
+useAll :: Room -> Room
+useAll = rmClusterStatus . csLinks .~ S.singleton OnwardCluster
+
+useSide :: Room -> Room
+useSide = rmClusterStatus . csLinks .~ S.singleton SideCluster
+
+useLabel :: Int -> Room -> Room
+useLabel i = rmClusterStatus . csLinks .~ S.singleton (LabelCluster i)