Implemented optics in some data

This commit is contained in:
Ivy 2021-02-13 01:06:26 +01:00
parent e8cd28a2c3
commit 6a4edb5ace
3 changed files with 31 additions and 11 deletions

View File

@ -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

View File

@ -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

View File

@ -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