various speed optimizations
This commit is contained in:
parent
3cb28f396b
commit
7c59021aee
8 changed files with 126 additions and 104 deletions
|
|
@ -1,2 +1,2 @@
|
|||
constraints: affection +debug
|
||||
constraints: affection +verbose
|
||||
profiling: True
|
||||
|
|
|
|||
111
src/Floorplan.hs
111
src/Floorplan.hs
|
|
@ -6,6 +6,7 @@ import Data.Matrix (Matrix(..))
|
|||
import qualified Data.Matrix as M
|
||||
import qualified Data.Text as T
|
||||
import Data.Maybe
|
||||
import qualified Data.Vector as V
|
||||
|
||||
import Linear (V2(..))
|
||||
|
||||
|
|
@ -24,7 +25,7 @@ buildHallFloorIO
|
|||
:: FloorConfig
|
||||
-> MVar (Float, T.Text)
|
||||
-> Float
|
||||
-> IO (Matrix TileState, [Graph])
|
||||
-> IO (Matrix TileState, V.Vector Graph)
|
||||
buildHallFloorIO fc progress increment = do
|
||||
rand <- newStdGen
|
||||
modifyMVar_ progress (return . (\(p, _) ->
|
||||
|
|
@ -345,25 +346,30 @@ findNearestOffice mat (V2 rrr ccc) =
|
|||
else acc
|
||||
) (fst $ head inlist) inlist
|
||||
|
||||
buildDoorsGraph :: Matrix TileState -> IO [Graph]
|
||||
buildDoorsGraph :: Matrix TileState -> IO (V.Vector Graph)
|
||||
buildDoorsGraph mat =
|
||||
weedOut $ buildGraph mat mat [GHall []] (2, 2)
|
||||
weedOut (buildGraph mat mat (V.singleton (GHall V.empty)) (2, 2))
|
||||
where
|
||||
weedOut (hall@(GHall _):gs) = (hall :) <$> weedOut gs
|
||||
weedOut (g@(GRoom neighs _ _ _):gs) = do
|
||||
let filtered = filter ((== Offi) . snd) neighs
|
||||
weedOut vect = if V.null vect
|
||||
then
|
||||
return V.empty
|
||||
else
|
||||
case V.head vect of
|
||||
hall@(GHall _) ->
|
||||
(hall `V.cons`) <$> weedOut (V.tail vect)
|
||||
g@(GRoom neighs _ _ _) -> do
|
||||
let filtered = V.filter ((== Offi) . snd) neighs
|
||||
rand <- randomRIO (0, length filtered -1) :: IO Int
|
||||
let nneigh = filtered !! rand : []
|
||||
rest <- weedOut gs
|
||||
return (g { neighbs = nneigh } : rest)
|
||||
weedOut [] = return []
|
||||
let nneigh = filtered V.! rand `V.cons` V.empty
|
||||
rest <- weedOut (V.tail vect)
|
||||
return (g { neighbs = nneigh } `V.cons` rest)
|
||||
|
||||
buildGraph
|
||||
:: Matrix TileState
|
||||
-> Matrix TileState
|
||||
-> [Graph]
|
||||
-> V.Vector Graph
|
||||
-> (Int, Int)
|
||||
-> [Graph]
|
||||
-> V.Vector Graph
|
||||
buildGraph amat mat root coord@(br, bc)
|
||||
| bc > ncols amat - 1 =
|
||||
buildGraph amat mat root (br + 1, 1)
|
||||
|
|
@ -374,29 +380,29 @@ buildGraph amat mat root coord@(br, bc)
|
|||
b = Boundaries
|
||||
(minimum (map fst roomcoords), minimum (map snd roomcoords))
|
||||
(maximum (map fst roomcoords), maximum (map snd roomcoords))
|
||||
neighs = map (\(a, bx) -> (a, fromJust bx)) (filter ((/=Nothing) . snd)
|
||||
neighs = V.map (\(a, bx) -> (a, fromJust bx)) (V.filter ((/=Nothing) . snd)
|
||||
$ V.fromList
|
||||
[ (North, M.safeGet (fst (matmin b) - 2) (snd (matmin b)) amat)
|
||||
, (South, M.safeGet (fst (matmax b) + 2) (snd (matmin b)) amat)
|
||||
, (West, M.safeGet (fst (matmin b)) (snd (matmin b) - 2) amat)
|
||||
, (East, M.safeGet (fst (matmin b)) (snd (matmax b) + 2) amat)
|
||||
])
|
||||
in
|
||||
if Hall `elem` map snd neighs
|
||||
if Hall `V.elem` V.map snd neighs
|
||||
then
|
||||
let nroot =
|
||||
if GRoom neighs b 0 Offi `notElem` connects (head root)
|
||||
if GRoom neighs b 0 Offi `V.notElem` connects (V.head root)
|
||||
then
|
||||
GHall
|
||||
{ connects = connects (head root) ++
|
||||
[GRoom neighs b 0 Offi]
|
||||
} : tail root
|
||||
{ connects = connects (V.head root) `V.snoc`
|
||||
GRoom neighs b 0 Offi
|
||||
} `V.cons` V.tail root
|
||||
else root
|
||||
in buildGraph amat mat nroot (br, 1 + snd (matmax b))
|
||||
else
|
||||
let nroot = root ++
|
||||
if GRoom neighs b 0 Offi `elem` root
|
||||
then []
|
||||
else [GRoom neighs b 0 Offi]
|
||||
let nroot = if GRoom neighs b 0 Offi `V.elem` root
|
||||
then root
|
||||
else root `V.snoc` GRoom neighs b 0 Offi
|
||||
in buildGraph amat mat nroot (br, 1 + snd (matmax b))
|
||||
| otherwise =
|
||||
buildGraph amat mat root (br, maxCol br (bc + 1))
|
||||
|
|
@ -426,32 +432,32 @@ flood amat acc (fr, fc) =
|
|||
else [])
|
||||
in foldl (flood amat) (acc ++ ncoords) ncoords
|
||||
|
||||
assignClearance :: [Graph] -> M.Matrix TileState -> IO [Graph]
|
||||
assignClearance :: V.Vector Graph -> M.Matrix TileState -> IO (V.Vector Graph)
|
||||
assignClearance graph imat =
|
||||
foldM doAssignClearance [] graph
|
||||
V.foldM doAssignClearance V.empty graph
|
||||
where
|
||||
doAssignClearance acc (GHall conns) = do
|
||||
ret <- GHall <$> foldM (\facc a -> do
|
||||
ret <- GHall <$> V.foldM (\facc a -> do
|
||||
res <- reassign True facc a
|
||||
return (facc ++ [res])
|
||||
) [] conns
|
||||
return (ret : acc)
|
||||
return (facc `V.snoc` res)
|
||||
) V.empty conns
|
||||
return (ret `V.cons` acc)
|
||||
doAssignClearance acc room = do
|
||||
ret <- reassign False acc room
|
||||
return (acc ++ [ret])
|
||||
reassign :: Bool -> [Graph] -> Graph -> IO Graph
|
||||
return (acc `V.snoc` ret)
|
||||
reassign :: Bool -> V.Vector Graph -> Graph -> IO Graph
|
||||
reassign p acc room@(GRoom ns b _ _) =
|
||||
if p
|
||||
then do
|
||||
if actualRoomType b imat == Offi
|
||||
then do
|
||||
let neigh = filter (all ((/= Hall) . snd) . neighbs) $
|
||||
catMaybes
|
||||
(map
|
||||
let neigh = V.filter (all ((/= Hall) . snd) . neighbs) $
|
||||
V.fromList $ catMaybes $ V.toList $
|
||||
(V.map
|
||||
(\n -> findNeighbor n b onlyrooms)
|
||||
nonhalls
|
||||
)
|
||||
onlyrooms = tail graph
|
||||
onlyrooms = V.tail graph
|
||||
nonhalls = ns -- filter ((/= Hall) . snd) ns
|
||||
if not (null neigh) && any ((Offi /=) . flip actualRoomType imat . bounds) neigh
|
||||
then
|
||||
|
|
@ -464,16 +470,16 @@ assignClearance graph imat =
|
|||
if actualRoomType b imat == Offi
|
||||
then do
|
||||
let neigh =
|
||||
catMaybes
|
||||
(map
|
||||
V.fromList $ catMaybes $ V.toList $
|
||||
(V.map
|
||||
(\n -> findNeighbor n b onlyrooms)
|
||||
nonhalls
|
||||
)
|
||||
onlyrooms = connects (head acc)
|
||||
onlyrooms = connects (V.head acc)
|
||||
nonhalls = ns -- filter ((/= Hall) . snd) ns
|
||||
ret <- if null neigh
|
||||
then doRandomAssign room
|
||||
else doBoundedAssign room (clearance $ head neigh)
|
||||
else doBoundedAssign room (clearance $ V.head neigh)
|
||||
return ret
|
||||
else
|
||||
return room
|
||||
|
|
@ -501,7 +507,7 @@ doBoundedAssign g b = do
|
|||
findNeighbor
|
||||
:: (GraphDirection, TileState)
|
||||
-> Boundaries Int
|
||||
-> [Graph]
|
||||
-> V.Vector Graph
|
||||
-> Maybe Graph
|
||||
findNeighbor (dir, _) bnds ingraph
|
||||
| dir == North =
|
||||
|
|
@ -522,27 +528,32 @@ findNeighbor (dir, _) bnds ingraph
|
|||
in postprocess row col
|
||||
where
|
||||
postprocess row col =
|
||||
let filtered = filter
|
||||
let filtered = V.filter
|
||||
(inBounds (V2 row col) . bounds)
|
||||
ingraph
|
||||
in
|
||||
case filtered of
|
||||
[a@(GRoom _ _ _ _)] -> Just a
|
||||
[] -> Nothing
|
||||
_ -> error "findNeighbor: Non-singleton filter result"
|
||||
if V.null filtered
|
||||
then Nothing
|
||||
else if V.length filtered == 1
|
||||
then
|
||||
case V.head filtered of
|
||||
a@(GRoom _ _ _ _) -> Just a
|
||||
_ -> error "findNeighbor: Not a GRoom result"
|
||||
else
|
||||
error "findNeighbor: Non-Singleton filter result"
|
||||
|
||||
buildDoors :: Matrix TileState -> [Graph] -> IO (Matrix TileState)
|
||||
buildDoors = foldM placeDoors
|
||||
buildDoors :: Matrix TileState -> V.Vector Graph -> IO (Matrix TileState)
|
||||
buildDoors = V.foldM placeDoors
|
||||
|
||||
placeDoors :: Matrix TileState -> Graph -> IO (Matrix TileState)
|
||||
placeDoors amat (GHall conns) =
|
||||
foldM placeDoors amat conns
|
||||
placeDoors amat (GRoom neighs bs _ _) =
|
||||
if Hall `elem` map snd neighs
|
||||
if Hall `V.elem` V.map snd neighs
|
||||
then do
|
||||
let halls = filter ((== Hall) . snd) neighs
|
||||
let halls = V.filter ((== Hall) . snd) neighs
|
||||
idx <- randomRIO (0, length halls - 1)
|
||||
let (dir, _) = halls !! idx
|
||||
let (dir, _) = halls V.! idx
|
||||
case dir of
|
||||
North ->
|
||||
inRow
|
||||
|
|
@ -566,7 +577,7 @@ placeDoors amat (GRoom neighs bs _ _) =
|
|||
(snd (matmax bs) + 1)
|
||||
else do
|
||||
idx <- randomRIO (0, length neighs - 1)
|
||||
let (dir, _) = neighs !! idx
|
||||
let (dir, _) = neighs V.! idx
|
||||
case dir of
|
||||
North ->
|
||||
inRow
|
||||
|
|
|
|||
|
|
@ -135,10 +135,10 @@ updateMind dt = do
|
|||
(
|
||||
concatMap
|
||||
(\(dr, dc) ->
|
||||
let bs = maybe [] collisionObstacle (fromMaybe Nothing $ M.safeGet
|
||||
let bs = fromMaybe [] $ collisionObstacle <$> M.unsafeGet
|
||||
(fromIntegral $ floor pr + dr)
|
||||
(fromIntegral $ floor pc + dc)
|
||||
(mmImgMat (stateData ud)))
|
||||
(mmImgMat (stateData ud))
|
||||
in Prelude.map (\(Boundaries (minr, minc) (maxr, maxc))->
|
||||
Boundaries
|
||||
(minr + fromIntegral dr, minc + fromIntegral dc)
|
||||
|
|
|
|||
|
|
@ -24,6 +24,7 @@ import Data.Matrix as M
|
|||
import Data.Ecstasy as E
|
||||
import Data.Maybe
|
||||
import Data.List as L
|
||||
import qualified Data.Vector as V
|
||||
|
||||
import System.Random (randomRIO)
|
||||
|
||||
|
|
@ -136,7 +137,7 @@ loadMapFork ud ad future progress = do
|
|||
( p + increment
|
||||
, "Placing furniture"
|
||||
)))
|
||||
(!inter, !rawrps) <- placeInteriorIO mat imgmat exits gr
|
||||
(!inter, !rawrps) <- placeInteriorIO mat imgmat exits (V.toList gr)
|
||||
let !rps = ReachPoint Elevator (fcElevator fc) SE 0 : rawrps
|
||||
modifyMVar_ progress (return . (\(p, _) ->
|
||||
( p + increment
|
||||
|
|
@ -243,10 +244,11 @@ loadMapFork ud ad future progress = do
|
|||
<*> (randomRIO (0, 1))
|
||||
<*> (randomRIO (0, 1))
|
||||
<*> (randomRIO (0, 1))
|
||||
let room = head
|
||||
(Prelude.filter
|
||||
let room = V.head
|
||||
(V.filter
|
||||
((inBounds $ pointCoord cpr) . bounds)
|
||||
(Types.connects (head gr) ++ tail gr)
|
||||
(V.fromList $
|
||||
V.toList (Types.connects (V.head gr)) ++ (V.toList (V.tail gr)))
|
||||
)
|
||||
void $ createEntity $ newEntity
|
||||
{ pos = Just (fmap ((+ 0.5) . fromIntegral) (pointCoord cpr))
|
||||
|
|
@ -266,17 +268,18 @@ loadMapFork ud ad future progress = do
|
|||
, "Registering doors into WorldState"
|
||||
)))
|
||||
mapM_ (\door -> do
|
||||
let rooms = Prelude.foldl
|
||||
let rooms = V.foldl
|
||||
(\acc coord ->
|
||||
let rs = Prelude.filter ((inBounds coord) . bounds) graph
|
||||
let rs = V.filter ((inBounds coord) . bounds) graph
|
||||
in
|
||||
if not (Prelude.null rs)
|
||||
then (coord, head rs) : acc
|
||||
if not (V.null rs)
|
||||
then (coord, V.head rs) `V.cons` acc
|
||||
else acc
|
||||
)
|
||||
[]
|
||||
coords
|
||||
graph = Types.connects (head gr) ++ tail gr
|
||||
V.empty
|
||||
(V.fromList coords)
|
||||
graph = V.fromList $
|
||||
(V.toList $ Types.connects (V.head gr)) ++ (V.toList $ V.tail gr)
|
||||
coords = Prelude.map (door +) deltas
|
||||
deltas =
|
||||
[ V2 0 1
|
||||
|
|
@ -296,7 +299,8 @@ loadMapFork ud ad future progress = do
|
|||
| otherwise = error ("strange wall: " ++ show wall)
|
||||
void $ createEntity $ newEntity
|
||||
{ pos = Just (fmap ((+ 0.5) . fromIntegral) door)
|
||||
, clearanceLvl = Just (maximum $ 0 : Prelude.map clearance (Prelude.map snd rooms))
|
||||
, clearanceLvl = Just (V.maximum $
|
||||
0 `V.cons` V.map clearance (V.map snd rooms))
|
||||
, anim = Just $ AnimState (AnimId AnimDoor0 "shut" orientation) 0 1
|
||||
, obstacle = Just $ case orientation of
|
||||
NW -> Boundaries (4/9, 0) (5/9, 1)
|
||||
|
|
@ -333,7 +337,7 @@ loadMapFork ud ad future progress = do
|
|||
putMVar future (nws, MainData
|
||||
{ mapMat = mat
|
||||
, imgMat = retMat
|
||||
, reachPoints = rps
|
||||
, reachPoints = V.fromList rps
|
||||
, mmImgMat = mmimgmat
|
||||
, roomGraph = gr
|
||||
})
|
||||
|
|
@ -513,8 +517,8 @@ drawMap = do
|
|||
dat
|
||||
V2 pr pc = playerPos
|
||||
MainData _ _ _ _ gr = stateData ud
|
||||
seekGraph = Types.connects (head gr) ++ tail gr
|
||||
room = Prelude.filter (inBounds (fmap floor playerPos) . bounds) seekGraph
|
||||
seekGraph = V.foldl V.snoc (Types.connects (V.head gr)) (V.tail gr)
|
||||
room = V.filter (inBounds (fmap floor playerPos) . bounds) seekGraph
|
||||
mat = imgMat (stateData ud)
|
||||
cols = fromIntegral (ncols mat)
|
||||
rows = fromIntegral (nrows mat)
|
||||
|
|
@ -619,7 +623,9 @@ drawMap = do
|
|||
"FPS: "
|
||||
<> T.pack (Prelude.take 5 $ show (1/dt))
|
||||
<> " Clearance: "
|
||||
<> if not (Prelude.null room) then T.pack (show $ clearance $ head room) else "0"
|
||||
<> if not (Prelude.null room)
|
||||
then T.pack (show $ clearance $ V.head room)
|
||||
else "0"
|
||||
)
|
||||
|
||||
drawTile
|
||||
|
|
@ -761,10 +767,10 @@ updateMap dt = do
|
|||
concatMap
|
||||
(\(dr, dc) ->
|
||||
let bs = (++)
|
||||
(maybe [] collisionObstacle (fromMaybe Nothing $ M.safeGet
|
||||
(fromMaybe [] $ collisionObstacle <$> M.unsafeGet
|
||||
(fromIntegral $ floor pr + dr)
|
||||
(fromIntegral $ floor pc + dc)
|
||||
(imgMat (stateData ud))))
|
||||
(imgMat (stateData ud)))
|
||||
(Prelude.map snd $ Prelude.filter
|
||||
(\((V2 br bc), _) ->
|
||||
floor pr + dr == floor br &&
|
||||
|
|
@ -877,7 +883,7 @@ updateMap dt = do
|
|||
(imgMat $ stateData ud)
|
||||
(mapMat $ stateData ud)
|
||||
nws
|
||||
(Prelude.filter
|
||||
(V.filter
|
||||
(\p -> pointType p /= RoomExit)
|
||||
(reachPoints $ stateData ud)
|
||||
)
|
||||
|
|
|
|||
42
src/NPC.hs
42
src/NPC.hs
|
|
@ -1,5 +1,6 @@
|
|||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module NPC where
|
||||
|
||||
import Affection as A
|
||||
|
|
@ -9,6 +10,7 @@ import Data.Ecstasy as E
|
|||
import Data.Maybe
|
||||
import Data.List (find)
|
||||
import Data.List.Split (splitWhen)
|
||||
import qualified Data.Vector as V
|
||||
|
||||
import Control.Monad.IO.Class (MonadIO(..))
|
||||
import Control.Monad.Trans (lift)
|
||||
|
|
@ -45,7 +47,7 @@ updateNPCs
|
|||
:: M.Matrix (Maybe ImgId)
|
||||
-> M.Matrix TileState
|
||||
-> SystemState Entity (AffectionState (AffectionData UserData) IO)
|
||||
-> [ReachPoint]
|
||||
-> V.Vector ReachPoint
|
||||
-> Double
|
||||
-> SystemT Entity (AffectionState (AffectionData UserData) IO) ()
|
||||
updateNPCs imgmat tsmat ws rrp dt = do
|
||||
|
|
@ -66,7 +68,7 @@ updateNPCs imgmat tsmat ws rrp dt = do
|
|||
lvl <- query clearanceLvl
|
||||
stat <- query anim
|
||||
npcState' <- query npcMoveState
|
||||
let rp = filter ((lvl >=) . pointClearance) rrp
|
||||
let rp = V.filter ((lvl >=) . pointClearance) rrp
|
||||
case npcState' of
|
||||
NPCStanding ttl future -> do
|
||||
let nttl = ttl - dt
|
||||
|
|
@ -119,7 +121,7 @@ updateNPCs imgmat tsmat ws rrp dt = do
|
|||
npcent <- queryEnt
|
||||
let (oent, _, _) = objects !! rind
|
||||
mdir =
|
||||
pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp
|
||||
pointDir <$> V.find (\a -> pointCoord a == fmap floor pos') rp
|
||||
return (Just (oent, npcent, Nothing), unchanged
|
||||
{ rot = Set $ fromMaybe rot' mdir
|
||||
, anim = Set stat
|
||||
|
|
@ -194,7 +196,7 @@ standStill
|
|||
-> Direction
|
||||
-> SystemState Entity m
|
||||
-> [(V2 Double, Boundaries Double)]
|
||||
-> [ReachPoint]
|
||||
-> V.Vector ReachPoint
|
||||
-> QueryT Entity m (Maybe (Ent, Ent, Maybe (MVar [[V2 Int]])), Entity 'SetterOf)
|
||||
standStill imgmat tsmat pos' rot' ws posbounds rp = do
|
||||
future <- liftIO $ newEmptyMVar
|
||||
|
|
@ -202,27 +204,27 @@ standStill imgmat tsmat pos' rot' ws posbounds rp = do
|
|||
as <- query npcActionState
|
||||
targetRPs <- case as of
|
||||
ASWork ->
|
||||
let fltrd = filter (\p -> pointType p == Copier) rp
|
||||
let fltrd = V.filter (\p -> pointType p == Copier) rp
|
||||
in
|
||||
((fltrd ++) . replicate (5 * length fltrd)) <$>
|
||||
(V.foldl V.snoc fltrd . V.replicate (5 * V.length fltrd)) <$>
|
||||
query npcWorkplace
|
||||
ASToilet -> do
|
||||
let seekRP = filter (\p -> pointType p == Toilet) rp
|
||||
if null seekRP
|
||||
then return $ filter (\p -> pointType p == Elevator) rp
|
||||
let seekRP = V.filter (\p -> pointType p == Toilet) rp
|
||||
if V.null seekRP
|
||||
then return $ V.filter (\p -> pointType p == Elevator) rp
|
||||
else return seekRP
|
||||
ASDrink -> do
|
||||
let seekRP = filter (\p -> pointType p == Drink) rp
|
||||
if null seekRP
|
||||
then return $ filter (\p -> pointType p == Elevator) rp
|
||||
let seekRP = V.filter (\p -> pointType p == Drink) rp
|
||||
if V.null seekRP
|
||||
then return $ V.filter (\p -> pointType p == Elevator) rp
|
||||
else return seekRP
|
||||
ASEat -> do
|
||||
let seekRP = filter (\p -> pointType p == Eat) rp
|
||||
if null seekRP
|
||||
then return $ filter (\p -> pointType p == Elevator) rp
|
||||
let seekRP = V.filter (\p -> pointType p == Eat) rp
|
||||
if V.null seekRP
|
||||
then return $ V.filter (\p -> pointType p == Elevator) rp
|
||||
else return seekRP
|
||||
ASRandWalk ->
|
||||
return $ filter (\p -> pointType p /= RoomExit) rp
|
||||
return $ V.filter (\p -> pointType p /= RoomExit) rp
|
||||
_ <- liftIO $ forkIO $
|
||||
getPath (fmap floor pos') future targetRPs imgmat tsmat posbounds
|
||||
let mdir =
|
||||
|
|
@ -318,15 +320,15 @@ getObject npos = do
|
|||
getPath
|
||||
:: V2 Int
|
||||
-> MVar [[V2 Int]]
|
||||
-> [ReachPoint]
|
||||
-> V.Vector ReachPoint
|
||||
-> M.Matrix (Maybe ImgId)
|
||||
-> M.Matrix TileState
|
||||
-> [(V2 Double, Boundaries Double)]
|
||||
-> IO ()
|
||||
getPath pos' mvar rp imgmat tsmat posbounds = do
|
||||
let seekRP = filter (\p -> pointType p /= RoomExit) rp
|
||||
ntargeti <- randomRIO (0, length seekRP - 1)
|
||||
let ntarget = pointCoord (seekRP !! ntargeti)
|
||||
let seekRP = V.filter (\p -> pointType p /= RoomExit) rp
|
||||
ntargeti <- randomRIO (0, V.length seekRP - 1)
|
||||
let ntarget = pointCoord (seekRP V.! ntargeti)
|
||||
path = astarAppl imgmat posbounds ntarget pos'
|
||||
logIO A.Verbose ("seeking path from " ++ show pos' ++ " to " ++ show ntarget)
|
||||
case path of
|
||||
|
|
|
|||
|
|
@ -3,6 +3,8 @@ module Types.Map where
|
|||
|
||||
import Linear (V2)
|
||||
|
||||
import qualified Data.Vector as V
|
||||
|
||||
data TileState
|
||||
= Wall
|
||||
-- | Wind
|
||||
|
|
@ -50,10 +52,10 @@ data GraphDirection = North | South | East | West
|
|||
|
||||
data Graph
|
||||
= GHall
|
||||
{ connects :: [Graph]
|
||||
{ connects :: V.Vector Graph
|
||||
}
|
||||
| GRoom
|
||||
{ neighbs :: [(GraphDirection, TileState)]
|
||||
{ neighbs :: V.Vector (GraphDirection, TileState)
|
||||
, bounds :: Boundaries Int
|
||||
, clearance :: Word
|
||||
, roomType :: TileState
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@ module Types.StateData where
|
|||
|
||||
import Data.Matrix
|
||||
import Data.Map
|
||||
import Data.Vector as V
|
||||
|
||||
import NanoVG hiding (V2)
|
||||
|
||||
|
|
@ -23,9 +24,9 @@ data StateData
|
|||
| MainData
|
||||
{ mapMat :: Matrix TileState
|
||||
, imgMat :: Matrix (Maybe ImgId)
|
||||
, reachPoints :: [ReachPoint]
|
||||
, reachPoints :: V.Vector ReachPoint
|
||||
, mmImgMat :: Matrix (Maybe ImgId)
|
||||
, roomGraph :: [Graph]
|
||||
, roomGraph :: V.Vector Graph
|
||||
}
|
||||
| MenuData
|
||||
{ velocity :: V2 Double
|
||||
|
|
|
|||
|
|
@ -195,14 +195,14 @@ naviGraph imgmat animBounds (V2 r c) =
|
|||
(\acc (rr, cc) ->
|
||||
if null
|
||||
(maybe [] collisionObstacle
|
||||
(join $ M.safeGet (r + rr) (c + cc) imgmat)
|
||||
(M.unsafeGet (r + rr) (c + cc) imgmat)
|
||||
++
|
||||
map snd (filter (\(V2 br bc, _) -> floor br == r + rr && floor bc == c + cc)
|
||||
animBounds))
|
||||
&& all null
|
||||
(map
|
||||
(\(oor, ooc) -> (maybe [] collisionObstacle
|
||||
(join $ M.safeGet (r + oor) (c + ooc) imgmat)) ++
|
||||
(M.unsafeGet (r + oor) (c + ooc) imgmat)) ++
|
||||
map snd (filter
|
||||
(\(V2 br bc, _) -> floor br == r + oor && floor bc == c + ooc)
|
||||
animBounds))
|
||||
|
|
|
|||
Loading…
Reference in a new issue