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

adjust size

Browse source
This commit is contained in:
nek0 2018-09-16 23:29:02 +02:00
parent 687d5f5b58
commit 99318f8919
1 changed files with 11 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
src/MainGame/WorldMap.hs
View file

@ -86,7 +86,7 @@ loadMapFork ud ad future progress = do
fc = FloorConfig fc = FloorConfig
(V2 10 10) (V2 10 10)
[(V2 5 5), (V2 5 20)] [(V2 5 5), (V2 5 20)]
(50, 40) (75, 50)
modifyMVar_ progress (return . (\(p, _) -> modifyMVar_ progress (return . (\(p, _) ->
( p + increment ( p + increment
, "Building floor" , "Building floor"
@ -96,8 +96,8 @@ loadMapFork ud ad future progress = do
( p + increment ( p + increment
, "Converting to images" , "Converting to images"
))) )))
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 : acc
else acc else acc
@ -109,7 +109,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 : rawrps
modifyMVar_ progress (return . (\(p, _) -> modifyMVar_ progress (return . (\(p, _) ->
( p + increment ( p + increment
, "Creating WorldState" , "Creating WorldState"
@ -119,7 +119,7 @@ loadMapFork ud ad future progress = do
( p + increment ( p + increment
, "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
@ -135,7 +135,7 @@ loadMapFork ud ad future progress = do
( p + increment ( p + increment
, "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
@ -152,7 +152,7 @@ loadMapFork ud ad future progress = do
( p + increment ( p + increment
, "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
@ -174,11 +174,11 @@ loadMapFork ud ad future progress = do
, "Unfolding and Converting MindMap to images" , "Unfolding and Converting MindMap to images"
))) )))
let !mmimgmat = convertTileToImg $ manhattan mmgraph mmintmat let !mmimgmat = convertTileToImg $ manhattan mmgraph mmintmat
pmmpos = (+ 0.5) . (fromIntegral :: Int -> Double) . floor <$> mmPos !pmmpos = (+ 0.5) . (fromIntegral :: Int -> Double) . floor <$> mmPos
(fromJust $ find (\a -> mmId a == 0) (vertexList mmgraph)) (fromJust $ find (\a -> mmId a == 0) (vertexList mmgraph))
delta = (0, 0) : !delta = (0, 0) :
Prelude.filter (/= (0,0)) ((,) <$> [-1 .. 1] <*> [-1 .. 1]) :: [(Int, Int)] Prelude.filter (/= (0,0)) ((,) <$> [-1 .. 1] <*> [-1 .. 1]) :: [(Int, Int)]
mmmpos = Prelude.foldl (\acc (dr, dc) -> !mmmpos = Prelude.foldl (\acc (dr, dc) ->
let (V2 pmr pmc) = floor <$> pmmpos let (V2 pmr pmc) = floor <$> pmmpos
seekpos = (pmr + fromIntegral dr, pmc + fromIntegral dc) seekpos = (pmr + fromIntegral dr, pmc + fromIntegral dc)
in if isNothing (mmimgmat M.! seekpos) && mmintmat M.! seekpos == 0 in if isNothing (mmimgmat M.! seekpos) && mmintmat M.! seekpos == 0
@ -228,7 +228,7 @@ loadMapFork ud ad future progress = do
))) )))
return mmimgmat return mmimgmat
)) ad )) ad
let retMat = M.fromList (nrows inter) (ncols inter) $ let !retMat = M.fromList (nrows inter) (ncols inter) $
Prelude.map Prelude.map
(\a -> if a == Just ImgEmpty || a == Just ImgEmptyNoWalk (\a -> if a == Just ImgEmpty || a == Just ImgEmptyNoWalk
then Nothing then Nothing