Implemented optics in some data
This commit is contained in:
parent
e8cd28a2c3
commit
6a4edb5ace
21
src/Game.hs
21
src/Game.hs
|
@ -1,22 +1,29 @@
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
|
||||||
module Game where
|
module Game where
|
||||||
|
|
||||||
|
import Lens.Micro.TH
|
||||||
|
import Lens.Micro
|
||||||
|
|
||||||
import Dungeon
|
import Dungeon
|
||||||
import Player
|
import Player
|
||||||
import Direction
|
import Direction
|
||||||
import Action
|
import Action
|
||||||
|
|
||||||
data Game = Game
|
data Game = Game
|
||||||
{ getDungeon :: Dungeon
|
{ _dungeon :: Dungeon
|
||||||
, getPlayer :: Player
|
, _player :: Player
|
||||||
}
|
}
|
||||||
|
|
||||||
|
makeLenses ''Game
|
||||||
|
|
||||||
newGame :: 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 :: Action -> Game -> Maybe Game
|
||||||
runAction (Walk N) (Game d (Player (x,y))) = Just $ Game d (Player (x,y-1))
|
runAction (Walk N) game = Just $ game & player . y %~ (-)1
|
||||||
runAction (Walk S) (Game d (Player (x,y))) = Just $ Game d (Player (x,y+1))
|
runAction (Walk S) game = Just $ game & player . y %~ (+)1
|
||||||
runAction (Walk W) (Game d (Player (x,y))) = Just $ Game d (Player (x-1,y))
|
runAction (Walk W) game = Just $ game & player . x %~ (-)1
|
||||||
runAction (Walk E) (Game d (Player (x,y))) = Just $ Game d (Player (x+1,y))
|
runAction (Walk E) game = Just $ game & player . x %~ (+)1
|
||||||
runAction None g = Just g
|
runAction None g = Just g
|
||||||
runAction ExitGame _ = Nothing
|
runAction ExitGame _ = Nothing
|
||||||
|
|
|
@ -1,3 +1,12 @@
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
|
||||||
module Player where
|
module Player where
|
||||||
|
|
||||||
newtype Player = Player (Int, Int)
|
import Lens.Micro.TH (makeLenses)
|
||||||
|
|
||||||
|
data Player = Player
|
||||||
|
{ _x :: Int
|
||||||
|
, _y :: Int
|
||||||
|
}
|
||||||
|
|
||||||
|
makeLenses ''Player
|
||||||
|
|
|
@ -1,18 +1,22 @@
|
||||||
module Rendering where
|
module Rendering where
|
||||||
|
|
||||||
|
import Lens.Micro
|
||||||
import Graphics.Vty
|
import Graphics.Vty
|
||||||
|
|
||||||
import Dungeon
|
import Dungeon
|
||||||
import Game
|
import Game
|
||||||
import Player
|
import Player
|
||||||
|
|
||||||
renderGame :: Game -> Picture
|
renderGame :: Game -> Picture
|
||||||
renderGame g = picForLayers
|
renderGame g = picForLayers
|
||||||
[ playerToImg (getPlayer g)
|
[ playerToImg $ g ^. player
|
||||||
, dungeonToImg (getDungeon g)
|
, dungeonToImg $ g ^. dungeon
|
||||||
]
|
]
|
||||||
|
|
||||||
dungeonToImg :: Dungeon -> Image
|
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 (Player (x,y)) = translateX x . translateY y $ char defAttr '@'
|
playerToImg p = translateX px . translateY py $ char defAttr '@'
|
||||||
|
where px = p ^. x
|
||||||
|
py = p ^. y
|
||||||
|
|
Loading…
Reference in New Issue