applied clearance levels. now for the doors.

src/Interior.hs

@@ -41,7 +41,7 @@ traverseGraph
   -> (StdGen, (Matrix (Maybe ImgId), [ReachPoint]))
 traverseGraph imat acc (GHall sub) =
   foldl (traverseGraph imat) acc sub
-traverseGraph imat (rng, putt) (GRoom _ bnds _ clearance) =
+traverseGraph imat (rng, putt) (GRoom _ bnds clear _) =
   let applicable =
         L.sortBy (\b a -> size (a, (ph, pw), rng) `compare` size (b, (ph, pw), rng)) (
           L.filter
@@ -64,7 +64,9 @@ traverseGraph imat (rng, putt) (GRoom _ bnds _ clearance) =
       (pw, g2) = randomR (1, snd (matmax bnds) - snd (matmin bnds) + 1) g1
   in
     foldl
-      (\(orng, (omat, orp)) -> placeCluster imat orng bnds (ph, pw) 1 omat orp)
+      (\(orng, (omat, orp)) ->
+        placeCluster imat orng bnds (ph, pw) 1 clear omat orp
+        )
       (g2, putt)
       applicable
 
@@ -74,11 +76,12 @@ placeCluster
   -> Boundaries Int
   -> (Int, Int)
   -> Int
+  -> Word
   -> Matrix (Maybe ImgId)
   -> [ReachPoint]
   -> Cluster
   -> (StdGen, (Matrix (Maybe ImgId), [ReachPoint]))
-placeCluster imat rng bnds dim try mat rp appl =
+placeCluster imat rng bnds dim try clearance mat rp appl =
   let (pr, g1) = randomR (fst (matmin bnds) - 1, fst (matmax bnds) - 1) rng
       (pc, g2) = randomR (snd (matmin bnds) - 1, snd (matmax bnds) - 1) g1
       (g2_1, g2_2) = split g2
@@ -103,7 +106,7 @@ placeCluster imat rng bnds dim try mat rp appl =
         []
         rp
       reaches = (map (+ V2 (pr - 1) (pc - 1)) (map pointCoord nrp))
-      newrp = rp ++ map (\(a, b, c) -> ReachPoint a b c)
+      newrp = rp ++ map (\(a, b, c) -> ReachPoint a b c clearance)
         (zip3
           (map pointType nrp)
           reaches
@@ -115,7 +118,7 @@ placeCluster imat rng bnds dim try mat rp appl =
     else
       if pr + nrows cmat - 1 > fst (matmax bnds) ||
         pc + ncols cmat - 1 > snd (matmax bnds)
-      then placeCluster imat g2 bnds dim (try + 1) mat rp appl
+      then placeCluster imat g2 bnds dim (try + 1) clearance mat rp appl
       else if
         any (`notElem` clusterRoom appl)
           (M.toList (M.submatrix
@@ -129,17 +132,17 @@ placeCluster imat rng bnds dim try mat rp appl =
             pc (pc + ncols cmat - 1)
             mat
             ))
-        then placeCluster imat g2_1 bnds dim (try + 1) mat rp appl
+        then placeCluster imat g2_1 bnds dim (try + 1) clearance mat rp appl
         else if
           any (`elem` (oldreaches))
           (V2
             <$> [pr .. pr + nrows cmat - 1]
             <*> [pc .. pc + ncols cmat - 1])
-          then placeCluster imat g2 bnds dim (try + 1) mat rp appl
+          then placeCluster imat g2 bnds dim (try + 1) clearance mat rp appl
           else if
             isReachable newmat [(V2 10 10, Boundaries (0, 1) (0, 1))] (oldreaches ++ reaches) exits
-            then placeCluster imat g2_1 bnds dim (try + 1) newmat newrp appl
+            then placeCluster imat g2_1 bnds dim (try + 1) clearance newmat newrp appl
-            else placeCluster imat g2_1 bnds dim (try + 1) mat rp appl
+            else placeCluster imat g2_1 bnds dim (try + 1) clearance mat rp appl
 
 insertMat
   :: Matrix (Maybe a)

src/MainGame/WorldMap.hs

@@ -119,7 +119,7 @@ loadMapFork ud ad future progress = do
   let !imgmat = convertTileToImg mat
       !exits = Prelude.foldl
         (\acc coord@(r, c) -> if imgmat M.! coord == Just ImgEmpty
-          then ReachPoint RoomExit (V2 r c) NE : acc
+          then ReachPoint RoomExit (V2 r c) NE 0 : acc
           else acc
           )
         []
@@ -129,7 +129,7 @@ loadMapFork ud ad future progress = do
     , "Placing furniture"
     )))
   (!inter, !rawrps) <- placeInteriorIO mat imgmat exits gr
-  let !rps = ReachPoint Elevator (fcElevator fc) SE : rawrps
+  let !rps = ReachPoint Elevator (fcElevator fc) SE 0 : rawrps
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Creating WorldState"
@@ -140,7 +140,7 @@ loadMapFork ud ad future progress = do
       , "Registering copiers into WorldState"
       )))
     let !copiers = Prelude.filter (\a -> pointType a == Copier) rps
-    mapM_ (\(ReachPoint _ icoord _) -> do
+    mapM_ (\(ReachPoint _ icoord _ _) -> do
       let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord
       void $ createEntity $ newEntity
         { pos       = Just $ reachCoord - V2 1 0
@@ -156,7 +156,7 @@ loadMapFork ud ad future progress = do
       , "Registering computers into WorldState"
       )))
     let !computers = Prelude.filter (\a -> pointType a == Computer) rps
-    mapM_ (\(ReachPoint _ icoord dir) -> do
+    mapM_ (\(ReachPoint _ icoord dir _) -> do
       let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord
       void $ createEntity $ newEntity
         { pos       = Just $ reachCoord - case dir of
@@ -173,7 +173,7 @@ loadMapFork ud ad future progress = do
       , "Registering toilets into WorldState"
       )))
     let !toilets = Prelude.filter (\a -> pointType a == Toilet) rps
-    mapM_ (\(ReachPoint _ icoord dir) -> do
+    mapM_ (\(ReachPoint _ icoord dir _) -> do
       let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord
       void $ createEntity $ newEntity
         { pos       = Just $ reachCoord - V2 0 (-1)
@@ -266,6 +266,7 @@ loadMapFork ud ad future progress = do
       , imgMat = retMat
       , reachPoints = rps
       , mmImgMat = mmimgmat
+      , roomGraph = gr
       })
 
 mouseToPlayer :: V2 Int32 -> Affection UserData ()
@@ -455,6 +456,9 @@ drawMap = do
           return (pos', pa, realToFrac (1 - ttl / maxt))
         return (head pc, posanims, posActions)
       let V2 pr pc = playerPos
+          MainData _ _ _ _ gr = stateData ud
+          seekGraph = Types.connects (head gr) ++ tail gr
+          room = Prelude.filter (inBounds (fmap floor playerPos) . bounds) seekGraph
           mat = imgMat (stateData ud)
           cols = fromIntegral (ncols mat)
           rows = fromIntegral (nrows mat)
@@ -528,7 +532,12 @@ drawMap = do
         fontFace ctx (assetFonts ud Map.! FontBedstead)
         textAlign ctx (S.fromList [AlignCenter,AlignTop])
         fillColor ctx (rgb 255 128 0)
-        textBox ctx 0 0 200 ("FPS: " `T.append` T.pack (Prelude.take 5 $ show (1/dt)))
+        textBox ctx 0 0 200 (
+          "FPS: "
+          <> T.pack (Prelude.take 5 $ show (1/dt))
+          <> " Clearance: "
+          <> if not (Prelude.null room) then T.pack (show $ clearance $ head room) else "0"
+            )
 
 drawTile
   :: UserData

src/NPC.hs

@@ -45,7 +45,7 @@ updateNPCs
   -> [ReachPoint]
   -> Double
   -> SystemT Entity (AffectionState (AffectionData UserData) IO) ()
-updateNPCs imgmat ws rp dt = do
+updateNPCs imgmat ws rrp dt = do
   updateStats dt
   posbounds <- getPosBounds
   moent <- catMaybes <$> eover allEnts (do
@@ -54,12 +54,15 @@ updateNPCs imgmat ws rp dt = do
     with npcActionState
     with npcWorkplace
     with npcStats
+    with npcClearanceLvl
     with vel
     with rot
     with anim
     pos' <- query pos
     rot' <- query rot
+    lvl  <- query npcClearanceLvl
     npcState' <- query npcMoveState
+    let rp = filter ((lvl >=) . pointClearance) rrp
     case npcState' of
       NPCStanding ttl future -> do
         let nttl = ttl - dt

src/Types/Interior.hs

@@ -178,9 +178,9 @@ clusterMatWithRPs ClusterCabinets dim@(h, w) g =
             let (typ, gf2) = randomR (0, length selses - 1) gf1
                 img = selses !! typ
                 rp i
-                  | i == ImgCabinetCoffeeSE = ReachPoint Drink (V2 2 a) NW
+                  | i == ImgCabinetCoffeeSE = ReachPoint Drink (V2 2 a) NW 0
-                  | i == ImgCabinetSinkSE = ReachPoint Drink (V2 2 a) NW
+                  | i == ImgCabinetSinkSE = ReachPoint Drink (V2 2 a) NW 0
-                  | i == ImgCabinetStoveSE = ReachPoint Eat (V2 2 a) NW
+                  | i == ImgCabinetStoveSE = ReachPoint Eat (V2 2 a) NW 0
             in  (gf2, Just img : lsi, rp img : lsr)
           else
             (gf1, Just ImgCabinetSE : lsi, lsr)
@@ -195,9 +195,9 @@ clusterMatWithRPs ClusterCabinets dim@(h, w) g =
             let (typ, gf2) = randomR (0, length selsws - 1) gf1
                 img = selsws !! typ
                 rp i
-                  | i == ImgCabinetCoffeeSW = ReachPoint Drink (V2 a (rw - 1)) NE
+                  | i == ImgCabinetCoffeeSW = ReachPoint Drink (V2 a (rw - 1)) NE 0
-                  | i == ImgCabinetSinkSW = ReachPoint Drink (V2 a (rw - 1)) NE
+                  | i == ImgCabinetSinkSW = ReachPoint Drink (V2 a (rw - 1)) NE 0
-                  | i == ImgCabinetStoveSW = ReachPoint Eat (V2 a (rw - 1)) NE
+                  | i == ImgCabinetStoveSW = ReachPoint Eat (V2 a (rw - 1)) NE 0
             in  (gf2, Just img : lsi, rp img : lsr)
           else
             (gf1, Just ImgCabinetSW : lsi, lsr)
@@ -234,43 +234,43 @@ clusterRoom ClusterCabinets         = [Kitc]
 clusterPoints :: Cluster -> (Int, Int) -> [ReachPoint]
 clusterPoints ClusterBox1 _ = []
 clusterPoints ClusterTableNE (h, _) =
-  [ ReachPoint Table (V2 r 2) SW | r <- [1..h] ]
+  [ ReachPoint Table (V2 r 2) SW 0 | r <- [1..h] ]
 clusterPoints ClusterTableNW (_, w) =
-  [ ReachPoint Table (V2 1 c) SE | c <- [1..w] ]
+  [ ReachPoint Table (V2 1 c) SE 0 | c <- [1..w] ]
 clusterPoints ClusterTableSW (h, _) =
-  [ ReachPoint Table (V2 r 1) NE | r <- [1..h] ]
+  [ ReachPoint Table (V2 r 1) NE 0 | r <- [1..h] ]
 clusterPoints ClusterTableSE (_, w) =
-  [ ReachPoint Table (V2 2 c) NW | c <- [1..w] ]
+  [ ReachPoint Table (V2 2 c) NW 0 | c <- [1..w] ]
 clusterPoints ClusterCornerTable _ =
-  [ ReachPoint Computer (V2 2 1) N
+  [ ReachPoint Computer (V2 2 1) N 0
   ]
 clusterPoints ClusterTableGroup _ =
-  [ ReachPoint Computer (V2 2 2) N
+  [ ReachPoint Computer (V2 2 2) N 0
-  , ReachPoint Computer (V2 2 5) N
+  , ReachPoint Computer (V2 2 5) N 0
-  , ReachPoint Computer (V2 5 5) N
+  , ReachPoint Computer (V2 5 5) N 0
   ]
 clusterPoints ClusterCopier _ =
-  [ ReachPoint Copier (V2 2 1) NW
+  [ ReachPoint Copier (V2 2 1) NW 0
   ]
 clusterPoints ClusterFlipchart _ =
-  [ ReachPoint Table (V2 2 1) NW
+  [ ReachPoint Table (V2 2 1) NW 0
   ]
 clusterPoints ClusterConferenceTable (h, w) =
   let mw = max 4 w
       mh = max 4 h
   in
-    [ ReachPoint Table (V2 1 c)  SE | c <- [2..mw-1] ] ++
+    [ ReachPoint Table (V2 1 c)  SE 0 | c <- [2..mw-1] ] ++
-    [ ReachPoint Table (V2 r 1)  NE | r <- [2..mh-1] ] ++
+    [ ReachPoint Table (V2 r 1)  NE 0 | r <- [2..mh-1] ] ++
-    [ ReachPoint Table (V2 r mw) SW | r <- [2..mh-1] ] ++
+    [ ReachPoint Table (V2 r mw) SW 0 | r <- [2..mh-1] ] ++
-    [ ReachPoint Table (V2 mh c) NW | c <- [2..mw-1] ]
+    [ ReachPoint Table (V2 mh c) NW 0 | c <- [2..mw-1] ]
 clusterPoints ClusterToilet _ =
-  [ ReachPoint Toilet (V2 1 1) NE
+  [ ReachPoint Toilet (V2 1 1) NE 0
   ]
 clusterPoints ClusterWatercooler _ =
-  [ ReachPoint Drink (V2 2 1) NW
+  [ ReachPoint Drink (V2 2 1) NW 0
   ]
 clusterPoints ClusterVending _ =
-  [ ReachPoint Eat (V2 2 1) NW
+  [ ReachPoint Eat (V2 2 1) NW 0
   ]
 clusterPoints _ _ = []
 

src/Types/ReachPoint.hs

@@ -7,6 +7,7 @@ data ReachPoint = ReachPoint
   { pointType      :: PointType
   , pointCoord     :: V2 Int
   , pointDir       :: Direction
+  , pointClearance :: Word
   }
   deriving (Eq, Show)
 

src/Types/StateData.hs

@@ -25,6 +25,7 @@ data StateData
     , imgMat      :: Matrix (Maybe ImgId)
     , reachPoints :: [ReachPoint]
     , mmImgMat    :: Matrix (Maybe ImgId)
+    , roomGraph   :: [Graph]
     }
   | MenuData
     { velocity  :: V2 Double