nek0/tracer
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

applied clearance levels. now for the doors.

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

21
src/Interior.hs
View file

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

21
src/MainGame/WorldMap.hs
View file

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

5
src/NPC.hs
View file

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

46
src/Types/Interior.hs
View file

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

7
src/Types/ReachPoint.hs
View file

@ -4,9 +4,10 @@ import Linear (V2(..))
import Types.Direction import Types.Direction
data ReachPoint = ReachPoint data ReachPoint = ReachPoint
{ pointType :: PointType { pointType :: PointType
, pointCoord :: V2 Int , pointCoord :: V2 Int
, pointDir :: Direction , pointDir :: Direction
, pointClearance :: Word
} }
deriving (Eq, Show) deriving (Eq, Show)

1
src/Types/StateData.hs
View file

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