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