a little optimization
This commit is contained in:
nek0
parent
c469761bd8
commit
dc71567a7a
4 changed files with 112 additions and 83 deletions
98
src/Test.hs
98
src/Test.hs
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -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
95
src/Util.hs
Normal 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)
|
||||||
|
]
|
||||||
|
|
@ -24,6 +24,7 @@ executable tracer-game
|
||||||
, Floorplan
|
, Floorplan
|
||||||
, Init
|
, Init
|
||||||
, Test
|
, Test
|
||||||
|
, Util
|
||||||
default-extensions: OverloadedStrings
|
default-extensions: OverloadedStrings
|
||||||
, DeriveGeneric
|
, DeriveGeneric
|
||||||
, DataKinds
|
, DataKinds
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue