116 lines
3.1 KiB
Haskell
116 lines
3.1 KiB
Haskell
import Data.List (intersperse)
|
|
|
|
import System.Random (randomRIO)
|
|
|
|
import Data.Array (Array, (!), (//), array, bounds)
|
|
|
|
import Control.Monad (zipWithM_, replicateM, foldM, when)
|
|
|
|
type Board = Array (Char, Char) Int
|
|
|
|
flp :: Int -> Int
|
|
flp 0 = 1
|
|
flp 1 = 0
|
|
|
|
numRows, numCols :: Board -> String
|
|
numRows t =
|
|
let ((a, _), (b, _)) = bounds t
|
|
in [a .. b]
|
|
|
|
numCols t =
|
|
let ((_, a), (_, b)) = bounds t
|
|
in [a .. b]
|
|
|
|
flipRow, flipCol :: Board -> Char -> Board
|
|
flipRow t r =
|
|
let e =
|
|
[ (ix, flp (t ! ix))
|
|
| ix <- zip (repeat r) (numCols t) ]
|
|
in t // e
|
|
|
|
flipCol t c =
|
|
let e =
|
|
[ (ix, flp (t ! ix))
|
|
| ix <- zip (numRows t) (repeat c) ]
|
|
in t // e
|
|
|
|
printBoard :: Board -> IO ()
|
|
printBoard t = do
|
|
let rows = numRows t
|
|
cols = numCols t
|
|
f 0 = '0'
|
|
f 1 = '1'
|
|
p r xs = putStrLn $ [r, ' '] ++ intersperse ' ' (map f xs)
|
|
putStrLn $ " " ++ intersperse ' ' cols
|
|
zipWithM_
|
|
p
|
|
rows
|
|
[ [ t ! (y, x)
|
|
| x <- cols ]
|
|
| y <- rows ]
|
|
|
|
-- create a random goal board, and flip rows and columns randomly
|
|
-- to get a starting board
|
|
setupGame :: Char -> Char -> IO (Board, Board)
|
|
setupGame sizey sizex
|
|
-- random cell value at (row, col)
|
|
= do
|
|
let mk rc = (\v -> (rc, v)) <$> randomRIO (0, 1)
|
|
rows = ['a' .. sizey]
|
|
cols = ['1' .. sizex]
|
|
goal <-
|
|
array (('a', '1'), (sizey, sizex)) <$>
|
|
mapM
|
|
mk
|
|
[ (r, c)
|
|
| r <- rows
|
|
, c <- cols ]
|
|
start <-
|
|
do let change :: Board -> Int -> IO Board
|
|
-- flip random row
|
|
change t 0 = flipRow t <$> randomRIO ('a', sizey)
|
|
-- flip random col
|
|
change t 1 = flipCol t <$> randomRIO ('1', sizex)
|
|
numMoves <- randomRIO (3, 15) -- how many flips (3 - 15)
|
|
-- determine if rows or cols are flipped
|
|
moves <- replicateM numMoves $ randomRIO (0, 1)
|
|
-- make changes and get a starting board
|
|
foldM change goal moves
|
|
if goal /= start -- check if boards are different
|
|
then return (goal, start) -- all ok, return both boards
|
|
else setupGame sizey sizex -- try again
|
|
|
|
main :: IO ()
|
|
main = do
|
|
putStrLn "Select a board size (1 - 9).\nPress any other key to exit."
|
|
sizec <- getChar
|
|
when (sizec `elem` ['1' .. '9']) $
|
|
do let size = read [sizec] - 1
|
|
(g, s) <- setupGame (['a' ..] !! size) (['1' ..] !! size)
|
|
turns g s 0
|
|
where
|
|
turns goal current moves = do
|
|
putStrLn "\nGoal:"
|
|
printBoard goal
|
|
putStrLn "\nBoard:"
|
|
printBoard current
|
|
when (moves > 0) $
|
|
putStrLn $ "\nYou've made " ++ show moves ++ " moves so far."
|
|
putStrLn $
|
|
"\nFlip a row (" ++
|
|
numRows current ++ ") or a column (" ++ numCols current ++ ")"
|
|
v <- getChar
|
|
if v `elem` numRows current
|
|
then check $ flipRow current v
|
|
else if v `elem` numCols current
|
|
then check $ flipCol current v
|
|
else tryAgain
|
|
where
|
|
check t =
|
|
if t == goal
|
|
then putStrLn $ "\nYou've won in " ++ show (moves + 1) ++ " moves!"
|
|
else turns goal t (moves + 1)
|
|
tryAgain = do
|
|
putStrLn ": Invalid row or column."
|
|
turns goal current moves
|