Formatting only

src/Tetris.hs

@@ -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
+  | -- O doesn't need rotation
-  | s == I && V2 xo (yo+1) `elem` cs = rotateWith clockwise -- I only has two orientations
+    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 $
+  pure $ Game
-    Game { _level = lvl
+    { _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 =
+timeStep g = if blockStopped 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
+    let offset = length . filter (< y) $ fullRowIndices in V2 x (y - offset)
-       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 $
+  pure
-    g & block        .~ initBlock (g ^. nextShape)
+    $ 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