aadit/tetris-cli
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Disallow shifting after hard drop

Browse source
This commit is contained in:
Sam Tay 2017-06-27 23:56:19 -04:00
parent 963dec6f9a
commit a51da284f1
1 changed files with 15 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
src/Tetris.hs
View file

@ -46,13 +46,14 @@ type Board = Map Coord Tetrimino
-- | Game state -- | Game state
data Game = Game data Game = Game
{ _level :: Int { _level :: Int
, _block :: Block , _block :: Block
, _nextShape :: Tetrimino , _nextShape :: Tetrimino
, _nextShapeBag :: Seq.Seq Tetrimino , _nextShapeBag :: Seq.Seq Tetrimino
, _rowClears :: Seq.Seq Int , _rowClears :: Seq.Seq Int
, _score :: Int , _score :: Int
, _board :: Board , _board :: Board
, _frozen :: Bool
} deriving (Eq, Show) } deriving (Eq, Show)
makeLenses ''Game makeLenses ''Game
@ -142,17 +143,17 @@ initGame lvl = do
, _nextShapeBag = bag2 , _nextShapeBag = bag2
, _score = 0 , _score = 0
, _rowClears = mempty , _rowClears = mempty
, _frozen = False
, _board = mempty } , _board = mempty }
isGameOver :: Game -> Bool isGameOver :: Game -> Bool
isGameOver g = blockStopped g && g ^. block ^. origin == startOrigin isGameOver g = blockStopped g && g ^. block ^. origin == startOrigin
timeStep :: Game -> IO Game timeStep :: Game -> IO Game
timeStep = timeStep g = (& frozen .~ False)
bool <$> if blockStopped g
<$> (pure . gravitate) -- if not stopped then nextBlock . updateScore . clearFullRows . freezeBlock $ g
<*> nextBlock . updateScore . clearFullRows . freezeBlock -- if stopped else pure . gravitate $ g
<*> blockStopped -- predicate
-- TODO check if mapKeysMonotonic works -- TODO check if mapKeysMonotonic works
clearFullRows :: Game -> Game clearFullRows :: Game -> Game
@ -217,7 +218,8 @@ isStopped brd = any cStopped . coords
inRow1 (_,y) = y == 1 inRow1 (_,y) = y == 1
hardDrop :: Game -> Game hardDrop :: Game -> Game
hardDrop g = g & block .~ hardDroppedBlock g hardDrop g = g & block .~ hardDroppedBlock g
& frozen .~ True
hardDroppedBlock :: Game -> Block hardDroppedBlock :: Game -> Block
hardDroppedBlock g = translateBy n Down $ g ^. block hardDroppedBlock g = translateBy n Down $ g ^. block
@ -245,7 +247,7 @@ nextBlock g = do
-- | Try to shift current block; if shifting not possible, leave block where it is -- | Try to shift current block; if shifting not possible, leave block where it is
shift :: Direction -> Game -> Game shift :: Direction -> Game -> Game
shift d g = g & block %~ shiftBlock shift d g = g & block %~ shiftBlock
where shiftBlock b = if isValidBlockPosition (g ^. board) (translate d b) where shiftBlock b = if not (g ^. frozen) && isValidBlockPosition (g ^. board) (translate d b)
then translate d b then translate d b
else b else b