Formatting only
This commit is contained in:
Sam Tay
parent
f41f8f65bc
commit
a594680852
1 changed files with 93 additions and 84 deletions
|
|
@ -102,14 +102,15 @@ startOrigin = V2 6 22
|
|||
-- Safety can only be assured within Game context
|
||||
rotate' :: Block -> Block
|
||||
rotate' b@(Block s o@(V2 xo yo) cs)
|
||||
| s == O = b -- O doesn't need rotation
|
||||
| s == I && V2 xo (yo+1) `elem` cs = rotateWith clockwise -- I only has two orientations
|
||||
| -- O doesn't need rotation
|
||||
s == O = b
|
||||
| -- I only has two orientations
|
||||
s == I && V2 xo (yo + 1) `elem` cs = rotateWith clockwise
|
||||
| otherwise = rotateWith counterclockwise
|
||||
where
|
||||
rotateWith :: (Coord -> Coord) -> Block
|
||||
rotateWith dir = b & extra %~ fmap dir
|
||||
clockwise = (+ o) . (cwperp) . (subtract o)
|
||||
counterclockwise = (+ o) . LV.perp . (subtract o)
|
||||
rotateWith dir = b & extra %~ fmap dir
|
||||
cwperp (V2 x y) = V2 y (-x)
|
||||
|
||||
-- | Get coordinates of entire block
|
||||
|
|
@ -133,27 +134,28 @@ initGame :: Int -> IO Game
|
|||
initGame lvl = do
|
||||
(s1, bag1) <- bagFourTetriminoEach mempty
|
||||
(s2, bag2) <- bagFourTetriminoEach bag1
|
||||
pure $
|
||||
Game { _level = lvl
|
||||
pure $ Game
|
||||
{ _level = lvl
|
||||
, _block = initBlock s1
|
||||
, _nextShape = s2
|
||||
, _nextShapeBag = bag2
|
||||
, _score = 0
|
||||
, _rowClears = mempty
|
||||
, _board = mempty }
|
||||
, _board = mempty
|
||||
}
|
||||
|
||||
isGameOver :: Game -> Bool
|
||||
isGameOver g = blockStopped g && g ^. block ^. origin == startOrigin
|
||||
|
||||
timeStep :: Game -> IO Game
|
||||
timeStep g =
|
||||
if blockStopped g
|
||||
timeStep g = if blockStopped g
|
||||
then nextBlock . updateScore . clearFullRows . freezeBlock $ g
|
||||
else pure . gravitate $ g
|
||||
|
||||
-- TODO check if mapKeysMonotonic works
|
||||
clearFullRows :: Game -> Game
|
||||
clearFullRows g = g & board %~ clearBoard
|
||||
clearFullRows g =
|
||||
g & board %~ clearBoard
|
||||
& rowClears %~ (addToRowClears rowCount)
|
||||
where
|
||||
clearBoard = M.mapKeys shiftCoordAbove . M.filterWithKey notInFullRow
|
||||
|
|
@ -163,8 +165,7 @@ clearFullRows g = g & board %~ clearBoard
|
|||
isFullRow r = boardWidth == (length . M.filterWithKey (inRow r) $ g ^. board)
|
||||
inRow r (V2 _ y) _ = r == y
|
||||
shiftCoordAbove (V2 x y) =
|
||||
let offset = length . filter (< y) $ fullRowIndices
|
||||
in V2 x (y - offset)
|
||||
let offset = length . filter (< y) $ fullRowIndices in V2 x (y - offset)
|
||||
|
||||
-- | This updates game points with respect to the current
|
||||
-- _rowClears value (thus should only be used ONCE per step)
|
||||
|
|
@ -174,7 +175,8 @@ clearFullRows g = g & board %~ clearBoard
|
|||
updateScore :: Game -> Game
|
||||
updateScore g = g & score %~ (+ newPoints)
|
||||
where
|
||||
newPoints = (1 + g ^. level) * (g ^. rowClears ^. to latestOrZero ^. to points)
|
||||
newPoints =
|
||||
(1 + g ^. level) * (g ^. rowClears ^. to latestOrZero ^. to points)
|
||||
points 0 = 0
|
||||
points 1 = 40
|
||||
points 2 = 100
|
||||
|
|
@ -189,14 +191,16 @@ addToRowClears n rs = rs |> n
|
|||
-- | Get last value of sequence or 0 if empty
|
||||
latestOrZero :: Seq.Seq Int -> Int
|
||||
latestOrZero = go . Seq.viewr
|
||||
where go EmptyR = 0
|
||||
where
|
||||
go EmptyR = 0
|
||||
go (_ :> n) = n
|
||||
|
||||
-- | Handle counterclockwise block rotation (if possible)
|
||||
-- Allows wallkicks: http://tetris.wikia.com/wiki/TGM_rotation
|
||||
rotate :: Game -> Game
|
||||
rotate g = g & block .~ nextB
|
||||
where nextB = fromMaybe blk $ getFirst . mconcat $ First <$> bs
|
||||
where
|
||||
nextB = fromMaybe blk $ getFirst . mconcat $ First <$> bs
|
||||
bs = map ($ blk) safeFuncs
|
||||
safeFuncs = map (mkSafe .) funcs
|
||||
mkSafe = boolMaybe (isValidBlockPosition brd)
|
||||
|
|
@ -210,7 +214,8 @@ blockStopped g = isStopped (g ^. board) (g ^. block)
|
|||
-- | Check if a block on a board is stopped from further gravitation
|
||||
isStopped :: Board -> Block -> Bool
|
||||
isStopped brd = any cStopped . coords
|
||||
where cStopped = (||) <$> inRow1 <*> (`M.member` brd) . (translate Down)
|
||||
where
|
||||
cStopped = (||) <$> inRow1 <*> (`M.member` brd) . (translate Down)
|
||||
inRow1 (V2 _ y) = y == 1
|
||||
|
||||
hardDrop :: Game -> Game
|
||||
|
|
@ -218,7 +223,8 @@ hardDrop g = g & block .~ hardDroppedBlock g
|
|||
|
||||
hardDroppedBlock :: Game -> Block
|
||||
hardDroppedBlock g = translateBy n Down $ g ^. block
|
||||
where n = minimum $ (subtract 1) <$> (minY : diffs)
|
||||
where
|
||||
n = minimum $ (subtract 1) <$> (minY : diffs)
|
||||
diffs = [ y - yo | (V2 xo yo) <- brdCs, (V2 x y) <- blkCs, xo == x, yo < y ]
|
||||
brdCs = g ^. board ^. to M.keys
|
||||
blkCs = g ^. block ^. to coords
|
||||
|
|
@ -227,22 +233,25 @@ hardDroppedBlock g = translateBy n Down $ g ^. block
|
|||
-- | Freeze current block
|
||||
freezeBlock :: Game -> Game
|
||||
freezeBlock g = g & board %~ (M.union blkMap)
|
||||
where blk = g ^. block
|
||||
where
|
||||
blk = g ^. block
|
||||
blkMap = M.fromList $ [ (c, blk ^. shape) | c <- blk ^. to coords ]
|
||||
|
||||
-- | Replace block with next block
|
||||
nextBlock :: Game -> IO Game
|
||||
nextBlock g = do
|
||||
(t, ts) <- bagFourTetriminoEach (g ^. nextShapeBag)
|
||||
pure $
|
||||
g & block .~ initBlock (g ^. nextShape)
|
||||
pure
|
||||
$ g
|
||||
& block .~ initBlock (g ^. nextShape)
|
||||
& nextShape .~ t
|
||||
& nextShapeBag .~ ts
|
||||
|
||||
-- | Try to shift current block; if shifting not possible, leave block where it is
|
||||
shift :: Direction -> Game -> Game
|
||||
shift d g = g & block %~ shiftBlock
|
||||
where shiftBlock b = if isValidBlockPosition (g ^. board) (translate d b)
|
||||
where
|
||||
shiftBlock b = if isValidBlockPosition (g ^. board) (translate d b)
|
||||
then translate d b
|
||||
else b
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue