still working on clearance levels

src/Floorplan.hs

@@ -54,7 +54,7 @@ buildHallFloorIO fc progress increment = do
     ( p + increment
     , "Closed offices"
     )))
-  let doorgraph     = buildDoorsGraph closed
+  doorgraph     <- buildDoorsGraph closed
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Doorgraph"
@@ -69,12 +69,12 @@ buildHallFloorIO fc progress increment = do
     ( p + increment
     , "Built facilities"
     )))
-  accessGraph <- assignClearance doorgraph facils
+  -- accessGraph <- assignClearance doorgraph facils
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Assigned room clearances"
     )))
-  return (facils, accessGraph)
+  return (facils, doorgraph)
 
 emptyFloor :: FloorConfig -> Matrix TileState
 emptyFloor fc =
@@ -341,7 +341,7 @@ findNearestOffice mat (V2 rrr ccc) =
         else acc
         ) (fst $ head inlist) inlist
 
-buildDoorsGraph :: Matrix TileState -> [Graph]
+buildDoorsGraph :: Matrix TileState -> IO [Graph]
 buildDoorsGraph mat =
   let maxCol r c
         | M.safeGet r (c + 1) mat == Just Offi = maxCol r (c + 1)
@@ -402,31 +402,34 @@ buildDoorsGraph mat =
               in  buildGraph amat nroot (br, 1 + snd (matmax b))
         | otherwise =
           buildGraph amat root (br, maxCol br (bc + 1))
-  in  buildGraph mat [GHall []] (2, 2)
+  in  weedOut $ buildGraph mat [GHall []] (2, 2)
+  where
+    weedOut (hall@(GHall _):gs) = (hall :) <$> weedOut gs
+    weedOut (g@(GRoom neighs _ _ _):gs) = do
+      let filtered = filter ((== Offi) . snd) neighs
+      rand <- randomRIO (0, length filtered -1) :: IO Int
+      let nneigh = filtered !! rand : []
+      rest <- weedOut gs
+      return (g { neighbs = nneigh } : rest)
+    weedOut [] = return []
 
 assignClearance :: [Graph] -> M.Matrix TileState -> IO [Graph]
 assignClearance graph imat =
   mapM doAssignClearance graph
   where
-    doAssignClearance (GHall hgs) = do
-      arooms <- mapM doAssignClearance hgs
-      return (GHall arooms)
-    doAssignClearance  s@(GRoom _ _ _ _) = error (show s)
-    doAssignClearance  gr@(GRoom neighs bnds _ _)
-      | all ((/= Offi) . flip actualRoomType imat . bounds) (
-        filter graphIsRoom (catMaybes $ map (\g -> findNeighbor g bnds imat graph) neighs)) &&
-        actualRoomType bnds imat == Offi = do
-          aroom <- doRandomAssign gr
-          return aroom
-      | all ((== Offi) . flip actualRoomType imat . bounds) (
-        filter graphIsRoom (catMaybes $ map (\g -> findNeighbor g bnds imat graph) neighs)) &&
-        actualRoomType bnds imat == Offi = do
-          aroom <- doBoundedAssign gr
-            (minimum $ map
-              (\n -> fromMaybe 0 (clearance <$> (\g -> findNeighbor g bnds imat graph) n))
-              neighs
-              )
-          return aroom
+    doAssignClearance (GHall conns) =
+      GHall <$> mapM (reassign True) conns
+    doAssignClearance room =
+      reassign False room
+    reassign p room@(GRoom ns b c t) =
+      if p
+      then do
+        if actualRoomType b imat == Offi
+        then doRandomAssign room
+        else return room
+      else do
+        let neigh = findNeighbor (head ns) b imat graph
+        
 
 actualRoomType :: Boundaries Int -> M.Matrix TileState -> TileState
 actualRoomType (Boundaries (minrow, mincol) (maxrow, maxcol)) imat =
@@ -438,7 +441,7 @@ doRandomAssign :: Graph -> IO Graph
 doRandomAssign g = do
   c <- randomRIO (0, 4)
   return g
-    { clearance = c
+    { clearance = if actualRoomType c
     }
 
 doBoundedAssign :: Graph -> Word -> IO Graph