samegame

適当に、samegame の一部を書いた。Stateモナドの練習。所要時間は15分。昔に比べれば少しは成長したかな。
selectBall は、選んだ点に隣接する同じ色の点のリストを取り出す。インタフェースがダメすぎるけど…。

import Control.Monad.State

data Color = R | G | B | Y deriving (Eq, Show, Read)
type Pt = (Int, Int)
type Board = [[Color]]

sizeX, sizeY :: Int
sizeX = 6
sizeY = 6

newBoard = [[Y,Y,R,G,B,Y]
           ,[G,B,R,B,B,B]
           ,[Y,G,G,G,B,B]
           ,[B,B,G,R,R,B]
           ,[B,R,R,G,G,G]
           ,[B,R,R,G,G,B]
           ]


selectBall :: Board -> Color -> Pt -> [Pt]
selectBall board c pt = execState (selectBall' pt) []
    where
      isSameColor (x,y) = ( x >= 0 && x < sizeX &&
                            y >= 0 && y < sizeY &&
                            board !! y !! x == c
                          )
      selectBall' :: Pt -> State [Pt] [Pt]
      selectBall' (x,y) = do checked <- get
                             if isSameColor (x,y) && notElem (x,y) checked
                               then do modify ((x,y):)
                                       a <- selectBall' (x+1,y)
                                       b <- selectBall' (x-1,y)
                                       c <- selectBall' (x,y+1)
                                       d <- selectBall' (x,y-1)
                                       return $ a++b++c++d
                               else return []

実行結果。

Main> selectBall newBoard (newBoard !! 2 !! 2) (2,2)
[(2,3),(1,2),(3,2),(2,2)]
Main>