workplace defined
This commit is contained in:
nek0
parent
9774f5a9c9
commit
f10b5d7d52
3 changed files with 72 additions and 49 deletions
|
|
@ -111,49 +111,9 @@ loadMapFork ud ad future progress = do
|
|||
(inter, rps) <- placeInteriorIO mat imgmat exits gr
|
||||
modifyMVar_ progress (return . (\(p, _) ->
|
||||
( p + increment
|
||||
, "Placing NPCs"
|
||||
, "Creating WorldState"
|
||||
)))
|
||||
logIO A.Debug ("number of reachpoints: " ++ show (length rps))
|
||||
let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps
|
||||
npcposs <- placeNPCs inter mat rps 40 -- (length $ filter (\a -> pointType a == Table) nnex)
|
||||
modifyMVar_ progress (return . (\(p, _) ->
|
||||
( p + increment
|
||||
, "Preparing MindMap graph"
|
||||
)))
|
||||
A.logIO A.Debug $ "number of placed NPCs: " ++ show (length npcposs)
|
||||
(mmintmat, mmgraph) <- buildFloorMap . springField <$>
|
||||
buildMindMap (length npcposs) 2
|
||||
modifyMVar_ progress (return . (\(p, _) ->
|
||||
( p + increment
|
||||
, "Unfolding and Converting MindMap to images"
|
||||
)))
|
||||
let !mmimgmat = convertTileToImg $ manhattan mmgraph mmintmat
|
||||
modifyMVar_ progress (return . (\(p, _) ->
|
||||
( p + increment
|
||||
, "Creating WorldState and placing player"
|
||||
)))
|
||||
(nws, _) <- evalStateT (runState (yieldSystemT (worldState ud) $ do
|
||||
let pmmpos = (+ 0.5) . (fromIntegral :: Int -> Double) . floor <$> mmPos
|
||||
(fromJust $ find (\a -> mmId a == 0) (vertexList mmgraph))
|
||||
delta = (0, 0) :
|
||||
Prelude.filter (/= (0,0)) ((,) <$> [-1 .. 1] <*> [-1 .. 1]) :: [(Int, Int)]
|
||||
mmmpos = Prelude.foldl (\acc (dr, dc) ->
|
||||
let (V2 pmr pmc) = floor <$> pmmpos
|
||||
seekpos = (pmr + fromIntegral dr, pmc + fromIntegral dc)
|
||||
in if isNothing (mmimgmat M.! seekpos) && mmintmat M.! seekpos == 0
|
||||
&& isNothing acc
|
||||
then Just (pmmpos + (fromIntegral <$> V2 dr dc))
|
||||
else acc
|
||||
) Nothing delta
|
||||
void $ createEntity $ newEntity
|
||||
{ pos = Just (V2 10.5 10.5)
|
||||
, mmpos = mmmpos
|
||||
, vel = Just (V2 0 0)
|
||||
, mmvel = Just (V2 0 0)
|
||||
, player = Just ()
|
||||
, rot = Just SE
|
||||
, anim = Just $ AnimState (AnimId "intruder" "standing" SE) 0 0
|
||||
}
|
||||
(nws, mmimgmat) <- evalStateT (runState (yieldSystemT (worldState ud) $ do
|
||||
liftIO $ modifyMVar_ progress (return . (\(p, _) ->
|
||||
( p + increment
|
||||
, "Registering copiers into WorldState"
|
||||
|
|
@ -175,13 +135,12 @@ loadMapFork ud ad future progress = do
|
|||
, "Registering computers into WorldState"
|
||||
)))
|
||||
let computers = Prelude.filter (\a -> pointType a == Computer) rps
|
||||
mapM_ (\(ReachPoint _ icoord dir) -> do
|
||||
compEnts <- mapM (\(ReachPoint _ icoord dir) -> do
|
||||
let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord
|
||||
void $ createEntity $ newEntity
|
||||
createEntity $ newEntity
|
||||
{ pos = Just $ reachCoord - case dir of
|
||||
N -> V2 1 (-1)
|
||||
_ -> error "not yet defined"
|
||||
-- , obstacle = Just $ Boundaries (10/36, 8/36) (28/36, 30/36)
|
||||
, anim = Just $ AnimState (AnimId "computer" "off" N) 0 0
|
||||
, objAccess = Just (V2 1 (-1), dir)
|
||||
, objType = Just ObjComputer
|
||||
|
|
@ -203,6 +162,46 @@ loadMapFork ud ad future progress = do
|
|||
, objType = Just ObjToilet
|
||||
}
|
||||
) (A.log A.Debug ("number of toilets: " ++ show (length toilets)) toilets)
|
||||
liftIO $ modifyMVar_ progress (return . (\(p, _) ->
|
||||
( p + increment
|
||||
, "Placing NPCs"
|
||||
)))
|
||||
liftIO $ logIO A.Debug ("number of reachpoints: " ++ show (length rps))
|
||||
let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps
|
||||
npcposs <- liftIO $ placeNPCs inter mat rps (length computers)
|
||||
liftIO $ A.logIO A.Debug $ "number of placed NPCs: " ++ show (length npcposs)
|
||||
liftIO $ modifyMVar_ progress (return . (\(p, _) ->
|
||||
( p + increment
|
||||
, "Preparing MindMap graph"
|
||||
)))
|
||||
(mmintmat, mmgraph) <- liftIO $ buildFloorMap . springField <$>
|
||||
buildMindMap (length npcposs) 2
|
||||
liftIO $ modifyMVar_ progress (return . (\(p, _) ->
|
||||
( p + increment
|
||||
, "Unfolding and Converting MindMap to images"
|
||||
)))
|
||||
let !mmimgmat = convertTileToImg $ manhattan mmgraph mmintmat
|
||||
pmmpos = (+ 0.5) . (fromIntegral :: Int -> Double) . floor <$> mmPos
|
||||
(fromJust $ find (\a -> mmId a == 0) (vertexList mmgraph))
|
||||
delta = (0, 0) :
|
||||
Prelude.filter (/= (0,0)) ((,) <$> [-1 .. 1] <*> [-1 .. 1]) :: [(Int, Int)]
|
||||
mmmpos = Prelude.foldl (\acc (dr, dc) ->
|
||||
let (V2 pmr pmc) = floor <$> pmmpos
|
||||
seekpos = (pmr + fromIntegral dr, pmc + fromIntegral dc)
|
||||
in if isNothing (mmimgmat M.! seekpos) && mmintmat M.! seekpos == 0
|
||||
&& isNothing acc
|
||||
then Just (pmmpos + (fromIntegral <$> V2 dr dc))
|
||||
else acc
|
||||
) Nothing delta
|
||||
void $ createEntity $ newEntity
|
||||
{ pos = Just (V2 10.5 10.5)
|
||||
, mmpos = mmmpos
|
||||
, vel = Just (V2 0 0)
|
||||
, mmvel = Just (V2 0 0)
|
||||
, player = Just ()
|
||||
, rot = Just SE
|
||||
, anim = Just $ AnimState (AnimId "intruder" "standing" SE) 0 0
|
||||
}
|
||||
liftIO $ modifyMVar_ progress (return . (\(p, _) ->
|
||||
( p + increment
|
||||
, "Registering NPCs into WorldState"
|
||||
|
|
@ -213,24 +212,31 @@ loadMapFork ud ad future progress = do
|
|||
pos' <- query pos
|
||||
bnds <- query obstacle
|
||||
return (pos', bnds)
|
||||
mapM_ (\npcpos@(V2 nr nc) -> do
|
||||
mapM_ (\(ce, npcpos@(V2 nr nc)) -> do
|
||||
fact <- liftIO $ randomRIO (0.5, 1.5)
|
||||
fut <- liftIO newEmptyMVar
|
||||
[access] <- efor (anEnt ce) $ do
|
||||
with pos
|
||||
pos' <- query pos
|
||||
acc <- queryMaybe objAccess
|
||||
return $ fmap floor pos' + fromMaybe (V2 0 0) (fst <$> acc)
|
||||
_ <- liftIO $ forkIO $
|
||||
getPath (fmap floor npcpos) fut nnex inter posbounds
|
||||
getPathTo (fmap floor npcpos) fut access inter posbounds
|
||||
void $ createEntity $ newEntity
|
||||
{ pos = Just (V2 (nr + 0.5) (nc + 0.5))
|
||||
{ pos = Just (fmap (+ 0.5) npcpos)
|
||||
, vel = Just (V2 0 0)
|
||||
, velFact = Just fact
|
||||
, rot = Just SE
|
||||
, npcMoveState = Just (NPCStanding 0 fut)
|
||||
, npcWorkplace = Just ce
|
||||
, anim = Just $ AnimState (AnimId "jdoem" "standing" SE) 0 0
|
||||
}
|
||||
) npcposs
|
||||
) (zip compEnts npcposs)
|
||||
liftIO $ modifyMVar_ progress (return . (\(p, _) ->
|
||||
( p + increment
|
||||
, "Handing over"
|
||||
)))
|
||||
return mmimgmat
|
||||
)) ad
|
||||
putMVar future (nws, MainData
|
||||
{ mapMat = mat
|
||||
|
|
|
|||
16
src/NPC.hs
16
src/NPC.hs
|
|
@ -216,3 +216,19 @@ getPath pos' mvar rp imgmat posbounds = do
|
|||
case path of
|
||||
Nothing -> getPath pos' mvar rp imgmat posbounds
|
||||
Just p -> putMVar mvar p
|
||||
|
||||
getPathTo
|
||||
:: V2 Int
|
||||
-> MVar [V2 Int]
|
||||
-> V2 Int
|
||||
-> M.Matrix (Maybe ImgId)
|
||||
-> [(V2 Double, Boundaries Double)]
|
||||
-> IO ()
|
||||
getPathTo pos' mvar target imgmat posbounds = do
|
||||
let path = astarAppl imgmat posbounds target pos'
|
||||
logIO A.Verbose ("seeking path from " ++ show pos' ++ " to " ++ show target)
|
||||
case path of
|
||||
Nothing -> do
|
||||
logIO A.Error ("No path from " ++ show pos' ++ " to " ++ show target)
|
||||
putMVar mvar [pos']
|
||||
Just p -> putMVar mvar p
|
||||
|
|
|
|||
|
|
@ -21,6 +21,7 @@ data Entity f = Entity
|
|||
, obstacle :: Component f 'Field (Boundaries Double)
|
||||
, player :: Component f 'Unique ()
|
||||
, npcMoveState :: Component f 'Field NPCMoveState
|
||||
, npcWorkplace :: Component f 'Field Ent
|
||||
, anim :: Component f 'Field AnimState
|
||||
, objAccess :: Component f 'Field ((V2 Int), Direction)
|
||||
, objType :: Component f 'Field ObjType
|
||||
|
|
|
|||
Loading…
Reference in a new issue