a little optimization

This commit is contained in:
nek0 2018-03-02 02:10:35 +01:00
parent c469761bd8
commit dc71567a7a
4 changed files with 112 additions and 83 deletions

View file

@ -6,7 +6,7 @@ import SDL (get, ($=))
import qualified SDL import qualified SDL
import qualified Graphics.Rendering.OpenGL as GL hiding (get) import qualified Graphics.Rendering.OpenGL as GL hiding (get)
import Control.Monad (when, void) import Control.Monad (when, unless, void)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Data.Map.Strict as Map import Data.Map.Strict as Map
@ -14,6 +14,7 @@ import qualified Data.Set as S
import qualified Data.Text as T import qualified Data.Text as T
import Data.Matrix as M (toLists, (!), Matrix, safeGet) import Data.Matrix as M (toLists, (!), Matrix, safeGet)
import Data.Ecstasy as E import Data.Ecstasy as E
import Data.Maybe (fromJust)
import NanoVG hiding (V2(..)) import NanoVG hiding (V2(..))
@ -27,10 +28,14 @@ import Foreign.C.Types (CFloat(..))
import Debug.Trace import Debug.Trace
-- internal imports
import Util
loadMap :: Affection UserData () loadMap :: Affection UserData ()
loadMap = do loadMap = do
ud <- getAffection ud <- getAffection
let fc = FloorConfig (20, 20) [(5,5), (45, 75)] (80,40) let fc = FloorConfig (20, 20) [(5,5), (35, 35)] (40,40)
(Subsystems _ m) = subsystems ud (Subsystems _ m) = subsystems ud
matrix <- liftIO $ buildHallFloorIO fc matrix <- liftIO $ buildHallFloorIO fc
(nws, _) <- yieldSystemT (worldState ud) $ do (nws, _) <- yieldSystemT (worldState ud) $ do
@ -44,6 +49,7 @@ loadMap = do
{ worldState = nws { worldState = nws
, stateData = MenuData , stateData = MenuData
{ mapMat = matrix { mapMat = matrix
, imgMat = convertTileToImg matrix
, initCoords = (0, 500) , initCoords = (0, 500)
} }
, uuid = [uu] , uuid = [uu]
@ -98,7 +104,7 @@ drawMap :: Affection UserData ()
drawMap = do drawMap = do
ud <- getAffection ud <- getAffection
dt <- getDelta dt <- getDelta
let matrix = mapMat (stateData ud) let matrix = imgMat (stateData ud)
mapM_ (\(i, ls) -> mapM_ (uncurry $ drawTile i) (reverse $ zip [1..] ls)) mapM_ (\(i, ls) -> mapM_ (uncurry $ drawTile i) (reverse $ zip [1..] ls))
(zip [1..] (toLists matrix)) (zip [1..] (toLists matrix))
liftIO $ do liftIO $ do
@ -140,23 +146,8 @@ updateMap dt = do
{ worldState = nws { worldState = nws
} }
neighWalls :: Int -> Int -> Matrix TileState -> Int drawTile :: Int -> Int -> Maybe ImgId -> Affection UserData ()
neighWalls row col mat = drawTile row col img = do
Prelude.foldl (\acc (ir, ic) ->
if M.safeGet (row + ir) (col + ic) mat == Just Wall ||
M.safeGet (row + ir) (col + ic) mat == Just Door
then acc + 1
else acc
)
0
[ (0, -1)
, (-1, 0)
, (0, 1)
, (1, 0)
]
drawTile :: Int -> Int -> TileState -> Affection UserData ()
drawTile row col tile = do
ud <- getAffection ud <- getAffection
(_, playerPos) <- yieldSystemT (worldState ud) $ do (_, playerPos) <- yieldSystemT (worldState ud) $ do
efor $ \_ -> do efor $ \_ -> do
@ -165,6 +156,7 @@ drawTile row col tile = do
pure pos' pure pos'
let V2 pr pc = head playerPos let V2 pr pc = head playerPos
ctx = nano ud ctx = nano ud
tile = (mapMat $ stateData ud) M.! (row, col)
(xinit, yinit) = initCoords $ stateData ud (xinit, yinit) = initCoords $ stateData ud
tileWidth = 64 :: Double tileWidth = 64 :: Double
tileHeight = 32 :: Double tileHeight = 32 :: Double
@ -191,75 +183,15 @@ drawTile row col tile = do
lineTo ctx (x + realToFrac tileWidth / 2) y lineTo ctx (x + realToFrac tileWidth / 2) y
closePath ctx closePath ctx
fill ctx fill ctx
when (tile == Wall) $ do unless (img == Nothing) $ do
let img irow icol = case neighWalls irow icol mat of let dist = distance (V2 (fromIntegral row) (fromIntegral col))
4 ->
ImgWallCross
3
| M.safeGet (irow + 1) icol mat /= Just Wall &&
M.safeGet (irow + 1) icol mat /= Just Door ->
ImgWallTNW
| M.safeGet irow (icol + 1) mat /= Just Wall &&
M.safeGet irow (icol + 1) mat /= Just Door ->
ImgWallTSW
| M.safeGet (irow - 1) icol mat /= Just Wall &&
M.safeGet (irow - 1) icol mat /= Just Door ->
ImgWallTSE
| otherwise ->
ImgWallTNE
2
| (M.safeGet (irow + 1) icol mat == Just Wall ||
M.safeGet (irow + 1) icol mat == Just Door) &&
(M.safeGet (irow - 1) icol mat == Just Wall ||
M.safeGet (irow - 1) icol mat == Just Door) ->
ImgWallDesc
| (M.safeGet irow (icol + 1) mat == Just Wall ||
M.safeGet irow (icol + 1) mat == Just Door) &&
(M.safeGet irow (icol - 1) mat == Just Wall ||
M.safeGet irow (icol - 1) mat == Just Door) ->
ImgWallAsc
| (M.safeGet (irow - 1) icol mat == Just Wall ||
M.safeGet (irow - 1) icol mat == Just Door) &&
(M.safeGet irow (icol - 1) mat == Just Wall ||
M.safeGet irow (icol - 1) mat == Just Door) ->
ImgWallCornerW
| (M.safeGet irow (icol - 1) mat == Just Wall ||
M.safeGet irow (icol - 1) mat == Just Door) &&
(M.safeGet (irow + 1) icol mat == Just Wall ||
M.safeGet (irow + 1) icol mat == Just Door) ->
ImgWallCornerS
| (M.safeGet (irow + 1) icol mat == Just Wall ||
M.safeGet (irow + 1) icol mat == Just Door) &&
(M.safeGet irow (icol + 1) mat == Just Wall ||
M.safeGet irow (icol + 1) mat == Just Door) ->
ImgWallCornerE
| otherwise ->
ImgWallCornerN
1
| M.safeGet (irow - 1) icol mat == Just Wall ||
M.safeGet (irow - 1) icol mat == Just Door ->
ImgWallDesc
| M.safeGet (irow + 1) icol mat == Just Wall ||
M.safeGet (irow + 1) icol mat == Just Door ->
ImgWallDesc
| M.safeGet irow (icol + 1) mat == Just Wall ||
M.safeGet irow (icol + 1) mat == Just Door ->
ImgWallAsc
| otherwise ->
ImgWallAsc
0 ->
ImgWallCross
_ ->
error "unexpected number if neighbouring walls"
mat = mapMat (stateData ud)
dist = distance (V2 (fromIntegral row) (fromIntegral col))
(V2 (realToFrac pr - 0.5) (realToFrac pc + 0.5)) / 4 (V2 (realToFrac pr - 0.5) (realToFrac pc + 0.5)) / 4
fact = if floor pr <= row && floor pc >= col fact = if floor pr <= row && floor pc >= col
then min 1 dist then min 1 dist
else 1 else 1
paint <- imagePattern paint <- imagePattern
ctx x (y - (74 * fact - realToFrac tileHeight)) 64 74 0 ctx x (y - (74 * fact - realToFrac tileHeight)) 64 74 0
(assetImages ud Map.! img row col) (assetImages ud Map.! fromJust img)
fact fact
beginPath ctx beginPath ctx
rect ctx x (y - (74 * fact - realToFrac tileHeight)) 64 74 rect ctx x (y - (74 * fact - realToFrac tileHeight)) 64 74

View file

@ -36,6 +36,7 @@ data StateData
| MenuData | MenuData
{ mapMat :: Matrix TileState { mapMat :: Matrix TileState
, initCoords :: (Int, Int) , initCoords :: (Int, Int)
, imgMat :: Matrix (Maybe ImgId)
} }
data ImgId data ImgId

95
src/Util.hs Normal file
View file

@ -0,0 +1,95 @@
module Util where
import Affection as A
import Data.Matrix as M
-- internal imports
import Types
convertTileToImg :: Matrix TileState -> Matrix (Maybe ImgId)
convertTileToImg mat = fromLists conversion
where
conversion =
map (\(i, ls) -> map (uncurry $ convertTile i) (zip [1..] ls))
(zip [1..] (toLists mat))
convertTile irow icol tile =
case tile of
Wall -> Just (case neighWalls irow icol mat of
4 ->
ImgWallCross
3
| M.safeGet (irow + 1) icol mat /= Just Wall &&
M.safeGet (irow + 1) icol mat /= Just Door ->
ImgWallTNW
| M.safeGet irow (icol + 1) mat /= Just Wall &&
M.safeGet irow (icol + 1) mat /= Just Door ->
ImgWallTSW
| M.safeGet (irow - 1) icol mat /= Just Wall &&
M.safeGet (irow - 1) icol mat /= Just Door ->
ImgWallTSE
| otherwise ->
ImgWallTNE
2
| (M.safeGet (irow + 1) icol mat == Just Wall ||
M.safeGet (irow + 1) icol mat == Just Door) &&
(M.safeGet (irow - 1) icol mat == Just Wall ||
M.safeGet (irow - 1) icol mat == Just Door) ->
ImgWallDesc
| (M.safeGet irow (icol + 1) mat == Just Wall ||
M.safeGet irow (icol + 1) mat == Just Door) &&
(M.safeGet irow (icol - 1) mat == Just Wall ||
M.safeGet irow (icol - 1) mat == Just Door) ->
ImgWallAsc
| (M.safeGet (irow - 1) icol mat == Just Wall ||
M.safeGet (irow - 1) icol mat == Just Door) &&
(M.safeGet irow (icol - 1) mat == Just Wall ||
M.safeGet irow (icol - 1) mat == Just Door) ->
ImgWallCornerW
| (M.safeGet irow (icol - 1) mat == Just Wall ||
M.safeGet irow (icol - 1) mat == Just Door) &&
(M.safeGet (irow + 1) icol mat == Just Wall ||
M.safeGet (irow + 1) icol mat == Just Door) ->
ImgWallCornerS
| (M.safeGet (irow + 1) icol mat == Just Wall ||
M.safeGet (irow + 1) icol mat == Just Door) &&
(M.safeGet irow (icol + 1) mat == Just Wall ||
M.safeGet irow (icol + 1) mat == Just Door) ->
ImgWallCornerE
| otherwise ->
ImgWallCornerN
1
| M.safeGet (irow - 1) icol mat == Just Wall ||
M.safeGet (irow - 1) icol mat == Just Door ->
ImgWallDesc
| M.safeGet (irow + 1) icol mat == Just Wall ||
M.safeGet (irow + 1) icol mat == Just Door ->
ImgWallDesc
| M.safeGet irow (icol + 1) mat == Just Wall ||
M.safeGet irow (icol + 1) mat == Just Door ->
ImgWallAsc
| otherwise ->
ImgWallAsc
0 ->
ImgWallCross
_ ->
error "unexpected number if neighbouring walls"
)
_ ->
Nothing
neighWalls :: Int -> Int -> Matrix TileState -> Int
neighWalls row col mat =
Prelude.foldl (\acc (ir, ic) ->
if M.safeGet (row + ir) (col + ic) mat == Just Wall ||
M.safeGet (row + ir) (col + ic) mat == Just Door
then acc + 1
else acc
)
0
[ (0, -1)
, (-1, 0)
, (0, 1)
, (1, 0)
]

View file

@ -24,6 +24,7 @@ executable tracer-game
, Floorplan , Floorplan
, Init , Init
, Test , Test
, Util
default-extensions: OverloadedStrings default-extensions: OverloadedStrings
, DeriveGeneric , DeriveGeneric
, DataKinds , DataKinds