diff --git a/src/Test.hs b/src/Test.hs index ebdae3c..c8a5800 100644 --- a/src/Test.hs +++ b/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 diff --git a/src/Types/UserData.hs b/src/Types/UserData.hs index 8a53156..4e54fa1 100644 --- a/src/Types/UserData.hs +++ b/src/Types/UserData.hs @@ -36,6 +36,7 @@ data StateData | MenuData { mapMat :: Matrix TileState , initCoords :: (Int, Int) + , imgMat :: Matrix (Maybe ImgId) } data ImgId diff --git a/src/Util.hs b/src/Util.hs new file mode 100644 index 0000000..0bc7e84 --- /dev/null +++ b/src/Util.hs @@ -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) + ] diff --git a/tracer-game.cabal b/tracer-game.cabal index 917e5a9..ab63021 100644 --- a/tracer-game.cabal +++ b/tracer-game.cabal @@ -24,6 +24,7 @@ executable tracer-game , Floorplan , Init , Test + , Util default-extensions: OverloadedStrings , DeriveGeneric , DataKinds