Posted at

# ぷよぷよ in Lens

More than 5 years have passed since last update.

http://okajima.air-nifty.com/b/2011/01/2011-ffac.html

Lenshttp://hackage.haskell.org/package/lensの練習にちょうどいいなあと思って。

30分はかかってない気がします。

```import           Control.Lens
import           Control.Monad
import           Control.Monad.State
import           Data.List
import qualified Data.Map            as M

paint :: M.Map (Int, Int) Char -> (Int, Int) -> Int
paint mm pos = evalState (go pos) mm where
go (i, j) = do
b <- use \$ at (i, j)
if b == M.lookup pos mm then do
at (i, j) ?= 'x'
vs <- forM [(1, 0), (-1, 0), (0, 1), (0, -1)] \$ \(di, dj) ->
go (i + di, j + dj)
return \$ 1 + sum vs
else do
return 0

erase :: [String] -> [String]
erase bd =
[ [ if paint mm (i, j) >= 4 then ' ' else c
| (j, c) <- zip [0..] r
]
| (i, r) <- zip [0..] bd
]
where
mm = M.fromList \$ do
(i, r) <- zip [0..] bd
(j, c) <- zip [0..] r
return \$ ((i, j), c)

drops :: [String] -> [String]
drops = transpose . map (reverse . f . reverse) . transpose where
f = take 13 . (++ repeat ' ') . filter (/= ' ')

next :: [String] -> [String]
next = drops . erase

main :: IO ()
main = do
forM_ (take 20 \$ iterate next input) \$ \b -> do
mapM_ putStrLn b
putStrLn "======"

-----

input :: [String]
input =
[ "  GYRR"
, "RYYGYG"
, "GYGYRR"
, "RYGYRG"
, "YGYRYG"
, "GYRYRG"
, "YGYRYR"
, "YGYRYR"
, "YRRGRG"
, "RYGYGG"
, "GRYGYR"
, "GRYGYR"
, "GRYGYR"
]
```