a little optimization
This commit is contained in:
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 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 Data.Map.Strict as Map
|
||||
|
@ -14,6 +14,7 @@ import qualified Data.Set as S
|
|||
import qualified Data.Text as T
|
||||
import Data.Matrix as M (toLists, (!), Matrix, safeGet)
|
||||
import Data.Ecstasy as E
|
||||
import Data.Maybe (fromJust)
|
||||
|
||||
import NanoVG hiding (V2(..))
|
||||
|
||||
|
@ -27,10 +28,14 @@ import Foreign.C.Types (CFloat(..))
|
|||
|
||||
import Debug.Trace
|
||||
|
||||
-- internal imports
|
||||
|
||||
import Util
|
||||
|
||||
loadMap :: Affection UserData ()
|
||||
loadMap = do
|
||||
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
|
||||
matrix <- liftIO $ buildHallFloorIO fc
|
||||
(nws, _) <- yieldSystemT (worldState ud) $ do
|
||||
|
@ -44,6 +49,7 @@ loadMap = do
|
|||
{ worldState = nws
|
||||
, stateData = MenuData
|
||||
{ mapMat = matrix
|
||||
, imgMat = convertTileToImg matrix
|
||||
, initCoords = (0, 500)
|
||||
}
|
||||
, uuid = [uu]
|
||||
|
@ -98,7 +104,7 @@ drawMap :: Affection UserData ()
|
|||
drawMap = do
|
||||
ud <- getAffection
|
||||
dt <- getDelta
|
||||
let matrix = mapMat (stateData ud)
|
||||
let matrix = imgMat (stateData ud)
|
||||
mapM_ (\(i, ls) -> mapM_ (uncurry $ drawTile i) (reverse $ zip [1..] ls))
|
||||
(zip [1..] (toLists matrix))
|
||||
liftIO $ do
|
||||
|
@ -140,23 +146,8 @@ updateMap dt = do
|
|||
{ worldState = nws
|
||||
}
|
||||
|
||||
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)
|
||||
]
|
||||
|
||||
drawTile :: Int -> Int -> TileState -> Affection UserData ()
|
||||
drawTile row col tile = do
|
||||
drawTile :: Int -> Int -> Maybe ImgId -> Affection UserData ()
|
||||
drawTile row col img = do
|
||||
ud <- getAffection
|
||||
(_, playerPos) <- yieldSystemT (worldState ud) $ do
|
||||
efor $ \_ -> do
|
||||
|
@ -165,6 +156,7 @@ drawTile row col tile = do
|
|||
pure pos'
|
||||
let V2 pr pc = head playerPos
|
||||
ctx = nano ud
|
||||
tile = (mapMat $ stateData ud) M.! (row, col)
|
||||
(xinit, yinit) = initCoords $ stateData ud
|
||||
tileWidth = 64 :: Double
|
||||
tileHeight = 32 :: Double
|
||||
|
@ -191,75 +183,15 @@ drawTile row col tile = do
|
|||
lineTo ctx (x + realToFrac tileWidth / 2) y
|
||||
closePath ctx
|
||||
fill ctx
|
||||
when (tile == Wall) $ do
|
||||
let img irow icol = 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"
|
||||
mat = mapMat (stateData ud)
|
||||
dist = distance (V2 (fromIntegral row) (fromIntegral col))
|
||||
unless (img == Nothing) $ do
|
||||
let dist = distance (V2 (fromIntegral row) (fromIntegral col))
|
||||
(V2 (realToFrac pr - 0.5) (realToFrac pc + 0.5)) / 4
|
||||
fact = if floor pr <= row && floor pc >= col
|
||||
then min 1 dist
|
||||
else 1
|
||||
paint <- imagePattern
|
||||
ctx x (y - (74 * fact - realToFrac tileHeight)) 64 74 0
|
||||
(assetImages ud Map.! img row col)
|
||||
(assetImages ud Map.! fromJust img)
|
||||
fact
|
||||
beginPath ctx
|
||||
rect ctx x (y - (74 * fact - realToFrac tileHeight)) 64 74
|
||||
|
|
|
@ -36,6 +36,7 @@ data StateData
|
|||
| MenuData
|
||||
{ mapMat :: Matrix TileState
|
||||
, initCoords :: (Int, Int)
|
||||
, imgMat :: Matrix (Maybe 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
|
||||
, Init
|
||||
, Test
|
||||
, Util
|
||||
default-extensions: OverloadedStrings
|
||||
, DeriveGeneric
|
||||
, DataKinds
|
||||
|
|
Loading…
Reference in a new issue