applied clearance levels. now for the doors.
This commit is contained in:
parent
44d0da34ac
commit
2ecec31de6
6 changed files with 59 additions and 42 deletions
|
@ -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
|
||||
else placeCluster imat g2_1 bnds dim (try + 1) mat rp appl
|
||||
then placeCluster imat g2_1 bnds dim (try + 1) clearance newmat newrp appl
|
||||
else placeCluster imat g2_1 bnds dim (try + 1) clearance mat rp appl
|
||||
|
||||
insertMat
|
||||
:: Matrix (Maybe a)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 == ImgCabinetSinkSE = ReachPoint Drink (V2 2 a) NW
|
||||
| i == ImgCabinetStoveSE = ReachPoint Eat (V2 2 a) NW
|
||||
| i == ImgCabinetCoffeeSE = ReachPoint Drink (V2 2 a) NW 0
|
||||
| i == ImgCabinetSinkSE = ReachPoint Drink (V2 2 a) NW 0
|
||||
| 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 == ImgCabinetSinkSW = ReachPoint Drink (V2 a (rw - 1)) NE
|
||||
| i == ImgCabinetStoveSW = ReachPoint Eat (V2 a (rw - 1)) NE
|
||||
| i == ImgCabinetCoffeeSW = ReachPoint Drink (V2 a (rw - 1)) NE 0
|
||||
| i == ImgCabinetSinkSW = ReachPoint Drink (V2 a (rw - 1)) NE 0
|
||||
| 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 5) N
|
||||
, ReachPoint Computer (V2 5 5) N
|
||||
[ ReachPoint Computer (V2 2 2) N 0
|
||||
, ReachPoint Computer (V2 2 5) N 0
|
||||
, 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 r 1) NE | r <- [2..mh-1] ] ++
|
||||
[ ReachPoint Table (V2 r mw) SW | r <- [2..mh-1] ] ++
|
||||
[ ReachPoint Table (V2 mh c) NW | c <- [2..mw-1] ]
|
||||
[ ReachPoint Table (V2 1 c) SE 0 | c <- [2..mw-1] ] ++
|
||||
[ ReachPoint Table (V2 r 1) NE 0 | r <- [2..mh-1] ] ++
|
||||
[ ReachPoint Table (V2 r mw) SW 0 | r <- [2..mh-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 _ _ = []
|
||||
|
||||
|
|
|
@ -4,9 +4,10 @@ import Linear (V2(..))
|
|||
import Types.Direction
|
||||
|
||||
data ReachPoint = ReachPoint
|
||||
{ pointType :: PointType
|
||||
, pointCoord :: V2 Int
|
||||
, pointDir :: Direction
|
||||
{ pointType :: PointType
|
||||
, pointCoord :: V2 Int
|
||||
, pointDir :: Direction
|
||||
, pointClearance :: Word
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
|
|
@ -25,6 +25,7 @@ data StateData
|
|||
, imgMat :: Matrix (Maybe ImgId)
|
||||
, reachPoints :: [ReachPoint]
|
||||
, mmImgMat :: Matrix (Maybe ImgId)
|
||||
, roomGraph :: [Graph]
|
||||
}
|
||||
| MenuData
|
||||
{ velocity :: V2 Double
|
||||
|
|
Loading…
Reference in a new issue