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,
unordered-containers,
microlens-th,
microlens
microlens,
random

View File

@ -12,10 +12,14 @@ data Action = Walk Direction
bindings :: [(Event, Action)]
bindings =
[ (EvKey KUp [], Walk N)
, (EvKey KDown [], Walk S)
, (EvKey KLeft [], Walk W)
, (EvKey KRight [], Walk E)
[ (EvKey (KChar 'k') [], Walk N)
, (EvKey (KChar 'j') [], Walk S)
, (EvKey (KChar 'h') [], Walk W)
, (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)
]

View File

@ -1,3 +1,3 @@
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
import Data.Matrix
import System.Random
data Cell = Solid | Empty
@ -13,8 +14,12 @@ newtype Dungeon = Dungeon (Matrix Cell)
instance Show Dungeon where
show (Dungeon m) = unlines . map (concatMap show) $ toLists m
makeDungeon :: Int -> Int -> Dungeon
makeDungeon w h = Dungeon $ matrix h w $ const Empty
makeDungeon :: (RandomGen r) => r -> Int -> Int -> Dungeon
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 m) = toLists m

View File

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

View File

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

View File

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

View File

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