From 98bae7d203b9bc69d9949dd3c3555542a5838724 Mon Sep 17 00:00:00 2001
From: Ivy <suguivy@riseup.net>
Date: Sun, 14 Feb 2021 14:32:24 +0100
Subject: [PATCH] Added and changed bindings and added random and solid tiles

---
 roguelike.cabal  |  3 ++-
 src/Action.hs    | 14 +++++++++-----
 src/Direction.hs |  2 +-
 src/Dungeon.hs   |  9 +++++++--
 src/Game.hs      | 17 +++++++++++------
 src/Main.hs      |  4 +++-
 src/Player.hs    |  3 +--
 src/Rendering.hs |  6 +++---
 8 files changed, 37 insertions(+), 21 deletions(-)

diff --git a/roguelike.cabal b/roguelike.cabal
index 018b758..142a3e1 100644
--- a/roguelike.cabal
+++ b/roguelike.cabal
@@ -29,4 +29,5 @@ executable roguelike
                        matrix,
                        unordered-containers,
                        microlens-th,
-                       microlens
+                       microlens,
+                       random
diff --git a/src/Action.hs b/src/Action.hs
index 646a73a..6c97f95 100644
--- a/src/Action.hs
+++ b/src/Action.hs
@@ -12,11 +12,15 @@ 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 'q') [], ExitGame)
+  [ (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)
   ]
 
 eventToAction :: Event -> Action
diff --git a/src/Direction.hs b/src/Direction.hs
index 47d3501..7445eee 100644
--- a/src/Direction.hs
+++ b/src/Direction.hs
@@ -1,3 +1,3 @@
 module Direction where
 
-data Direction = N | S | W | E
+data Direction = N | S | W | E | NW | NE | SW | SE
diff --git a/src/Dungeon.hs b/src/Dungeon.hs
index 64e7a8a..b333276 100644
--- a/src/Dungeon.hs
+++ b/src/Dungeon.hs
@@ -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
diff --git a/src/Game.hs b/src/Game.hs
index 35ad76d..9e6fc31 100644
--- a/src/Game.hs
+++ b/src/Game.hs
@@ -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
diff --git a/src/Main.hs b/src/Main.hs
index f313fa8..ffd4676 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -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
diff --git a/src/Player.hs b/src/Player.hs
index bcab875..4d6728e 100644
--- a/src/Player.hs
+++ b/src/Player.hs
@@ -5,8 +5,7 @@ module Player where
 import Lens.Micro.TH (makeLenses)
 
 data Player = Player
-  { _x :: Int
-  , _y :: Int
+  { _pos :: (Int, Int)
   }
 
 makeLenses ''Player
diff --git a/src/Rendering.hs b/src/Rendering.hs
index 2819690..d6e3d5f 100644
--- a/src/Rendering.hs
+++ b/src/Rendering.hs
@@ -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