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 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

View file

@ -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
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
, Init
, Test
, Util
default-extensions: OverloadedStrings
, DeriveGeneric
, DataKinds