Added static maps

This commit is contained in:
Ivy 2021-02-15 20:57:45 +01:00
parent 190c3a029f
commit e7cd7fb8a5
4 changed files with 31 additions and 9 deletions

7
maps/test.map Normal file
View File

@ -0,0 +1,7 @@
########################
#......................#
#......................#
#......................#
#......................#
#......................#
########################

View File

@ -1,20 +1,32 @@
module Dungeon where module Dungeon where
import Data.Matrix import Data.Matrix hiding ((<|>))
import Data.Tuple
import Data.Maybe
import Control.Applicative ((<|>))
data Cell = Solid | Empty data Cell = Solid
| Empty
deriving (Eq)
instance Show Cell where instance Show Cell where
show Solid = "#" show cell = [fromJust (lookup cell cellChars <|> Just '?')]
show Empty = "."
cellChars :: [(Cell, Char)]
cellChars =
[ (Empty, '.')
, (Solid, '#')
]
newtype Dungeon = Dungeon (Matrix Cell) newtype Dungeon = Dungeon (Matrix Cell)
instance Show Dungeon where instance Show Dungeon where
show (Dungeon m) = unlines . map (concatMap show) $ toLists m show (Dungeon m) = unlines . map (concatMap show) $ toLists m
makeDungeon :: Int -> Int -> Dungeon makeDungeonFromFile :: String -> IO Dungeon
makeDungeon w h = Dungeon $ matrix h w $ const Empty makeDungeonFromFile f = do
contents <- readFile f
return $ Dungeon $ fromLists $ map (fromJust . (`lookup` map swap cellChars)) <$> lines contents
dungeonToLists :: Dungeon -> [[Cell]] dungeonToLists :: Dungeon -> [[Cell]]
dungeonToLists (Dungeon m) = toLists m dungeonToLists (Dungeon m) = toLists m

View File

@ -17,8 +17,10 @@ data Game = Game
makeLenses ''Game makeLenses ''Game
newGame :: Game newGame :: IO Game
newGame = Game (makeDungeon 30 10) (Player (0,0)) newGame = do
dun <- makeDungeonFromFile "maps/test.map"
return $ Game dun (Player (0,0))
runAction :: Action -> Game -> Maybe Game runAction :: Action -> Game -> Maybe Game
runAction (Walk N) game = Just $ game & player . pos . _2 -~ 1 runAction (Walk N) game = Just $ game & player . pos . _2 -~ 1

View File

@ -10,7 +10,8 @@ main :: IO ()
main = do main = do
cfg <- standardIOConfig cfg <- standardIOConfig
vty <- mkVty cfg vty <- mkVty cfg
loop vty newGame game <- newGame
loop vty game
shutdown vty shutdown vty
where loop vty game = do where loop vty game = do
update vty $ renderGame game update vty $ renderGame game