diff --git a/src/Game.hs b/src/Game.hs index 564607a..95d7a4c 100644 --- a/src/Game.hs +++ b/src/Game.hs @@ -1,22 +1,29 @@ +{-# LANGUAGE TemplateHaskell #-} + module Game where +import Lens.Micro.TH +import Lens.Micro + import Dungeon import Player import Direction import Action data Game = Game - { getDungeon :: Dungeon - , getPlayer :: Player + { _dungeon :: Dungeon + , _player :: Player } +makeLenses ''Game + newGame :: Game -newGame = Game (makeDungeon 30 10) (Player (1,1)) +newGame = Game (makeDungeon 30 10) (Player 0 0) runAction :: Action -> Game -> Maybe Game -runAction (Walk N) (Game d (Player (x,y))) = Just $ Game d (Player (x,y-1)) -runAction (Walk S) (Game d (Player (x,y))) = Just $ Game d (Player (x,y+1)) -runAction (Walk W) (Game d (Player (x,y))) = Just $ Game d (Player (x-1,y)) -runAction (Walk E) (Game d (Player (x,y))) = Just $ Game d (Player (x+1,y)) +runAction (Walk N) game = Just $ game & player . y %~ (-)1 +runAction (Walk S) game = Just $ game & player . y %~ (+)1 +runAction (Walk W) game = Just $ game & player . x %~ (-)1 +runAction (Walk E) game = Just $ game & player . x %~ (+)1 runAction None g = Just g runAction ExitGame _ = Nothing diff --git a/src/Player.hs b/src/Player.hs index c866e3f..bcab875 100644 --- a/src/Player.hs +++ b/src/Player.hs @@ -1,3 +1,12 @@ +{-# LANGUAGE TemplateHaskell #-} + module Player where -newtype Player = Player (Int, Int) +import Lens.Micro.TH (makeLenses) + +data Player = Player + { _x :: Int + , _y :: Int + } + +makeLenses ''Player diff --git a/src/Rendering.hs b/src/Rendering.hs index c72d878..2819690 100644 --- a/src/Rendering.hs +++ b/src/Rendering.hs @@ -1,18 +1,22 @@ module Rendering where +import Lens.Micro import Graphics.Vty + import Dungeon import Game import Player renderGame :: Game -> Picture renderGame g = picForLayers - [ playerToImg (getPlayer g) - , dungeonToImg (getDungeon g) + [ playerToImg $ g ^. player + , dungeonToImg $ g ^. dungeon ] dungeonToImg :: Dungeon -> Image dungeonToImg = vertCat . map (string defAttr . concatMap show) . dungeonToLists playerToImg :: Player -> Image -playerToImg (Player (x,y)) = translateX x . translateY y $ char defAttr '@' +playerToImg p = translateX px . translateY py $ char defAttr '@' + where px = p ^. x + py = p ^. y