Added and changed bindings and added random and solid tiles

This commit is contained in:
Ivy 2021-02-14 14:32:24 +01:00
parent 0f13d5ab1c
commit 98bae7d203
8 changed files with 37 additions and 21 deletions

View File

@ -29,4 +29,5 @@ executable roguelike
matrix, matrix,
unordered-containers, unordered-containers,
microlens-th, microlens-th,
microlens microlens,
random

View File

@ -12,10 +12,14 @@ data Action = Walk Direction
bindings :: [(Event, Action)] bindings :: [(Event, Action)]
bindings = bindings =
[ (EvKey KUp [], Walk N) [ (EvKey (KChar 'k') [], Walk N)
, (EvKey KDown [], Walk S) , (EvKey (KChar 'j') [], Walk S)
, (EvKey KLeft [], Walk W) , (EvKey (KChar 'h') [], Walk W)
, (EvKey KRight [], Walk E) , (EvKey (KChar 'l') [], Walk E)
, (EvKey (KChar 'y') [], Walk NW)
, (EvKey (KChar 'u') [], Walk NE)
, (EvKey (KChar 'b') [], Walk SW)
, (EvKey (KChar 'n') [], Walk SE)
, (EvKey (KChar 'q') [], ExitGame) , (EvKey (KChar 'q') [], ExitGame)
] ]

View File

@ -1,3 +1,3 @@
module Direction where module Direction where
data Direction = N | S | W | E data Direction = N | S | W | E | NW | NE | SW | SE

View File

@ -1,6 +1,7 @@
module Dungeon where module Dungeon where
import Data.Matrix import Data.Matrix
import System.Random
data Cell = Solid | Empty data Cell = Solid | Empty
@ -13,8 +14,12 @@ 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 makeDungeon :: (RandomGen r) => r -> Int -> Int -> Dungeon
makeDungeon w h = Dungeon $ matrix h w $ const Empty makeDungeon gen w h = Dungeon $ Data.Matrix.fromList h w (randomCells gen)
where randomCells g = let (c,nGen) = randomR (0 :: Int,1 :: Int) g
in case c of 0 -> Solid : randomCells nGen
1 -> Empty : randomCells nGen
dungeonToLists :: Dungeon -> [[Cell]] dungeonToLists :: Dungeon -> [[Cell]]
dungeonToLists (Dungeon m) = toLists m dungeonToLists (Dungeon m) = toLists m

View File

@ -2,6 +2,7 @@
module Game where module Game where
import System.Random
import Lens.Micro.TH import Lens.Micro.TH
import Lens.Micro import Lens.Micro
@ -17,13 +18,17 @@ data Game = Game
makeLenses ''Game makeLenses ''Game
newGame :: Game newGame :: (RandomGen r) => r -> Game
newGame = Game (makeDungeon 30 10) (Player 0 0) newGame gen = Game (makeDungeon gen 30 10) (Player (0,0))
runAction :: Action -> Game -> Maybe Game runAction :: Action -> Game -> Maybe Game
runAction (Walk N) game = Just $ game & player . y %~ (1 `subtract`) runAction (Walk N) game = Just $ game & player . pos . _2 -~ 1
runAction (Walk S) game = Just $ game & player . y %~ (+1) runAction (Walk S) game = Just $ game & player . pos . _2 +~ 1
runAction (Walk W) game = Just $ game & player . x %~ (1 `subtract`) runAction (Walk W) game = Just $ game & player . pos . _1 -~ 1
runAction (Walk E) game = Just $ game & player . x %~ (+1) runAction (Walk E) game = Just $ game & player . pos . _1 +~ 1
runAction (Walk NW) game = Just $ game & player . pos . both -~ 1
runAction (Walk NE) game = Just $ game & player . pos %~ (\(x,y) -> (x+1, y-1))
runAction (Walk SW) game = Just $ game & player . pos %~ (\(x,y) -> (x-1, y+1))
runAction (Walk SE) game = Just $ game & player . pos . both +~ 1
runAction None g = Just g runAction None g = Just g
runAction ExitGame _ = Nothing runAction ExitGame _ = Nothing

View File

@ -1,6 +1,7 @@
module Main where module Main where
import Graphics.Vty import Graphics.Vty
import System.Random
import Game import Game
import Rendering import Rendering
@ -10,7 +11,8 @@ main :: IO ()
main = do main = do
cfg <- standardIOConfig cfg <- standardIOConfig
vty <- mkVty cfg vty <- mkVty cfg
loop vty newGame gen <- getStdGen
loop vty $ newGame gen
shutdown vty shutdown vty
where loop vty game = do where loop vty game = do
update vty $ renderGame game update vty $ renderGame game

View File

@ -5,8 +5,7 @@ module Player where
import Lens.Micro.TH (makeLenses) import Lens.Micro.TH (makeLenses)
data Player = Player data Player = Player
{ _x :: Int { _pos :: (Int, Int)
, _y :: Int
} }
makeLenses ''Player makeLenses ''Player

View File

@ -17,6 +17,6 @@ dungeonToImg :: Dungeon -> Image
dungeonToImg = vertCat . map (string defAttr . concatMap show) . dungeonToLists dungeonToImg = vertCat . map (string defAttr . concatMap show) . dungeonToLists
playerToImg :: Player -> Image playerToImg :: Player -> Image
playerToImg p = translateX px . translateY py $ char defAttr '@' playerToImg p = (translateX px . translateY py $ char defAttr '@') <|> string defAttr (" (" ++ show px ++ "," ++ show py ++ ")")
where px = p ^. x where px = p ^. pos . _1
py = p ^. y py = p ^. pos . _2