applied clearance levels. now for the doors.

This commit is contained in:
nek0 2019-02-09 01:23:38 +01:00
parent 44d0da34ac
commit 2ecec31de6
6 changed files with 59 additions and 42 deletions

View file

@ -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)

View file

@ -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

View file

@ -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

View file

@ -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 _ _ = []

View file

@ -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)

View file

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