workplace defined

This commit is contained in:
nek0 2018-09-07 19:49:16 +02:00
parent 9774f5a9c9
commit f10b5d7d52
3 changed files with 72 additions and 49 deletions

View file

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

View file

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

View file

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