tetris-0.27177: Board.hs

module Board where

import Util

--------------------------------
-- Cell

data Cell = Empty | Gray | Red | Yellow | Purple | Green | Blue | Orange | Cyan
	deriving Eq

cellColor :: (Num t, Num t1, Num t2) => Cell -> (t, t1, t2)
cellColor cell =
	case cell of
		Gray	-> (128, 128, 128)
		Red	-> (255, 0,   0)
		Yellow	-> (255, 255, 0)
		Purple	-> (255, 0,   255)
		Green	-> (0,   255, 0)
		Blue	-> (0,   0,   255)
		Orange	-> (255, 128, 0)
		Cyan	-> (0,   255, 255)


--------------------------------
-- BlockType

data BlockType = BlockI | BlockO | BlockS | BlockZ | BlockJ | BlockL | BlockT

blockPattern :: BlockType -> [[Int]]
blockPattern BlockI = [[0, 0, 0, 0, 0], [0, 0, 0, 0, 0], [0, 1, 1, 1, 1], [0, 0, 0, 0, 0], [0, 0, 0, 0, 0]]
blockPattern BlockO = [[1, 1], [1, 1]]
blockPattern BlockS = [[0, 1, 1], [1, 1, 0]]
blockPattern BlockZ = [[1, 1, 0], [0, 1, 1]]
blockPattern BlockJ = [[0, 0, 0], [1, 1, 1], [1, 0, 0]]
blockPattern BlockL = [[0, 0, 0], [1, 1, 1], [0, 0, 1]]
blockPattern BlockT = [[0, 0, 0], [1, 1, 1], [0, 1, 0]]

blockRotPattern :: BlockType -> Int -> [[Int]]
blockRotPattern blktype rot = rotate rot $ blockPattern blktype

blockCell :: BlockType -> Cell
blockCell BlockI = Red
blockCell BlockO = Yellow
blockCell BlockS = Purple
blockCell BlockZ = Green
blockCell BlockJ = Blue
blockCell BlockL = Orange
blockCell BlockT = Cyan

-- 乱数でブロックを選ぶ
randBlockType :: IO BlockType
randBlockType = fmap (blockTypes !!) (randN (length blockTypes))

blockTypes :: [BlockType]
blockTypes = [BlockI, BlockO, BlockS, BlockZ, BlockJ, BlockL, BlockT]


--------------------------------
-- Board
type Board = [[Cell]]

boardWidth,boardHeight :: Int
boardWidth = 10 + 2
boardHeight = 20 + 4

emptyLine :: [Cell]
emptyLine = [Gray] ++ replicate (boardWidth - 2) Empty ++ [Gray]

emptyBoard :: Board
emptyBoard = replicate (boardHeight-1) emptyLine ++ [bottom]
	where
		bottom = (replicate boardWidth Gray)

inBoard :: Int -> Int -> Bool
inBoard x y = 0 <= x && x < boardWidth && 0 <= y && y < boardHeight

boardRef :: [[Cell]] -> Int -> Int -> Cell
boardRef board x y =
	if inBoard x y
		then board !! y !! x
		else Empty

boardSet :: [[a]] -> Int -> Int -> a -> [[a]]
boardSet board x y c =
	if inBoard x y
		then replace board y (replace (board !! y) x c)
		else board

canMove :: Board -> BlockType -> Int -> Int -> Int -> Bool
canMove board blktype x y rot = not $ or $ concat $ idxmap2 isHit pat
	where
		pat = blockRotPattern blktype rot
		isHit (_dx,_dy) 0 = False
		isHit (dx,dy) 1 = inBoard (x+dx) (y+dy) && boardRef board (x+dx) (y+dy) /= Empty

storeBlock :: Board -> BlockType -> Int -> Int -> Int -> Board
storeBlock board blktype x y rot = board'
	where
		pat = blockRotPattern blktype rot
		patWithIdx = concat $ idxmap2 pair pat
		board' = foldl store board $ map fst $ filter ((== (1::Int)) . snd) patWithIdx

		store bord (dx,dy) = boardSet bord (x+dx) (y+dy) (blockCell blktype)

getFilledLines :: [[Cell]] -> [Int]
getFilledLines board = map fst $ filter (isFilled . snd) $ zip [0..] $ init board
	where
		isFilled = all (/= Empty) . init . tail

eraseLines :: Board -> [Int] -> Board
eraseLines = foldl (\rs y -> replace rs y emptyLine)

fallLines :: Board -> [Int] -> Board
fallLines = foldl (\rs y -> emptyLine : remove y rs)


landingY :: Board -> BlockType -> Int -> Int -> Int -> Int
landingY board blktype x y rot = loop y
	where
		loop z
			| canMove board blktype x (z+1) rot	= loop (z+1)
			| otherwise							= z


graynize :: [[Cell]] -> Int -> [[Cell]]
graynize board y = replace board y $ map (\x -> if x == Empty then Empty else Gray) $ board !! y