module Waffle where

import List
import Char
import ANSI


----------
-- A Rubik's waffle is a flat rectangle of colored tiles, black on one side
-- and white on the other, articulated to allow a turning or twisting of 
-- the waffle at any vertical or horizontal "break" between rows or columns
----------


-- we can represent a waffle as a matrix of booleans

type Waffle = [[Bool]]

fresh n m = replicate n (replicate m False)

cols = length


-- flipping a row both reverses its physical orientation
-- and also reveals the opposite colors on the flip side

fliprow = reverse . map not


-- some board printing utilities

showbd = map (map       (\b -> if b then 'x'  else 'o' ))

spread = map (concatMap (\b -> if b then "X " else "· "))     -- mid-line jot character

prtbd  = putStr . ('\n':) . unlines . map ('\t':) . spread


-- user may turn a given number of rows or columns,
-- counting from the left, right, top or bottom

data Move = L Int | R Int | T Int | B Int    deriving (Read,Show)

turn (T i) b = map fliprow (take i b) ++ drop i b
turn (B i) b = take j b ++ map fliprow (drop j b)
               where j = cols b - i

turn (L i) b = transpose (turn (T i) (transpose b))
turn (R i) b = transpose (turn (B i) (transpose b))


-- interactive game play, with prompting

play b = do prtbd b
            putStr "\nMove? > "
            move <- getLine
            if null move then putStrLn "Bye!"
               else play (turn (read (map toUpper move)) b)

waffle n m = play (fresh n m)


-- play a pre-defined list of moves, with unprompted pausing

pause b [] = prtbd b
pause b (m:ms) = do prtbd b
                    getLine
                    print m
                    pause (turn m b) ms

testmid   = pause (fresh 5 5) middle
testchk k = pause (fresh k k) (checker k)


----------
-- Other ideas:

-- * play from a fresh board with a given target board (printed nxt to it)

-- * play starting with given board, targeting fresh board to win

-- * write a program to find a set of moves from one board to another

-- * can you write a function to generate moves to flip ONLY a specified tile?

-- * allow for graceful recovery from bad inputs

-- * given an ANSI-compatible terminal, erase and re-draw for "animated" play
--   (see <http://en.wikipedia.org/wiki/ANSI_escape_code>
--    and <http://www.roysac.com/blog/2008/01/ansi-animation.html>)

----------


-- ANSI animation!

show'   b = map ('\t':) (spread b)

turn' r b = turn (read (map toUpper r)) b

animate b = test' turn' show' b

main = animate (fresh 7 7)


----------
-- extras

-- fin, run and pbp are successive variants which play through a given list of moves
-- fin goes right to the end; run shows intermediates boards; pbp shows moves, too

fin b ms =         prtbd         (foldl (flip turn) b ms)
run b ms =  mapM_  prtbd         (scanl (flip turn) b ms)
pbp b ms =  zipM_  prtbd  print  (scanl (flip turn) b ms) ms

try f = f (fresh 5 5) middle


middle    = [L 2, L 3, T 2, L 2, L 3, T 2, L 2, L 3]
checker n = map L ns ++ map T ns where ns = [1..n-1]


-- utility function zipM_ is to monadic mapM_ as zip is to map

zipM_ :: Monad m => (a -> m ()) -> (c -> m ()) -> [a] -> [c] -> m ()
zipM_ f g [] [] = return ()
zipM_ f g xs [] = mapM_ f xs
zipM_ f g [] ys = mapM_ g ys
zipM_ f g (x:xs) ys = f x >> zipM_ g f ys xs