module Field where
import Util
data Cell = Empty | Gray | Red | Yellow | Purple | Green | Blue | Orange | Cyan deriving Eq
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)
data BlockType = BlockI | BlockO | BlockS | BlockZ | BlockJ | BlockL | BlockT
blockTypes = [BlockI, BlockO, BlockS, BlockZ, BlockJ, BlockL, BlockT]
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 blktype rot = rotate rot $ blockPattern blktype
blockCell BlockI = Red blockCell BlockO = Yellow blockCell BlockS = Purple blockCell BlockZ = Green blockCell BlockJ = Blue blockCell BlockL = Orange blockCell BlockT = Cyan
randBlockType = randN (length blockTypes) >>= return . (blockTypes !!)
type Field = [[Cell]]
fieldWidth = 10 + 2 fieldHeight = 20 + 4
emptyLine = [Gray] ++ (replicate (fieldWidth - 2) Empty) ++ [Gray]
emptyField :: Field emptyField = replicate (fieldHeight-1) emptyLine ++ [bottom] where bottom = (replicate fieldWidth Gray)
inField x y = 0 <= x && x < fieldWidth && 0 <= y && y < fieldHeight
fieldRef field x y = if inField x y then field !! y !! x else Empty
fieldSet field x y c = if inField x y then replace field y (replace (field !! y) x c) else field
canMove :: Field -> BlockType -> Int -> Int -> Int -> Bool canMove field blktype x y rot = not $ or $ concat $ idxmap2 isHit pat where pat = blockRotPattern blktype rot isHit (dx,dy) 0 = False isHit (dx,dy) 1 = inField (x+dx) (y+dy) && fieldRef field (x+dx) (y+dy) /= Empty
storeBlock :: Field -> BlockType -> Int -> Int -> Int -> Field storeBlock field blktype x y rot = field' where pat = blockRotPattern blktype rot patWithIdx = concat $ idxmap2 pair pat field' = foldl store field $ map fst $ filter ((== 1) . snd) patWithIdx
store field (dx,dy) = fieldSet field (x+dx) (y+dy) (blockCell blktype)
getFilledLines field = map fst $ filter (isFilled . snd) $ zip [0..] $ init field where isFilled = all (/= Empty) . init . tail
eraseLines :: Field -> [Int] -> Field eraseLines field = foldl (\rs y -> replace rs y emptyLine) field
fallLines :: Field -> [Int] -> Field fallLines field = foldl (\rs y -> emptyLine : remove y rs) field
landingY field blktype x y rot = loop y where loop y | canMove field blktype x (y+1) rot = loop (y+1) | otherwise = y
graynize field y = replace field y $ map (\x -> if x == Empty then Empty else Gray) $ field !! y
|