module Control.Comonad.Sheet.Examples where

import Control.Comonad.Sheet

import Control.Applicative ( (<$>), (<*>) )
import Data.List ( intersperse )
import Data.Bool ( bool )

import Data.Stream ( Stream , repeat , (<:>) )

import qualified Prelude as P
import Prelude hiding ( repeat , take )

pascal :: Sheet2 Integer
pascal = evaluate . sheet 0 $
  repeat 1 <:> repeat (1 <:> pascalRow)
  where pascalRow = repeat $ cell above + cell left

diagonalize :: Sheet2 a -> [[a]]
diagonalize = 
   zipWith P.take [1..]
   . map (map extract . P.iterate (go (above & right)))
   . P.iterate (go below)

fibLike :: Sheet3 Integer
fibLike = evaluate $ sheet 0 $
   fibSheetFrom 1 1 <:> repeat (fibSheetFrom (cell inward + 1) (cell inward))
   where fibSheetFrom a b = (a          <:> b                <:> fibRow) <:>
                     repeat (cell above <:> (1 + cell above) <:> fibRow)
         fibRow = repeat $ cell (leftBy 1) + cell (leftBy 2)

data Cell = X | O deriving ( Eq , Show )
type Universe = Sheet3 Cell
type Ruleset = ([Int],[Int]) -- list of numbers of neighbors to trigger
                             -- being born, and staying alive, respectively

life :: Ruleset -> [[Cell]] -> Universe
life ruleset seed = evaluate $ insert [map (map const) seed] blank
   where blank = sheet (const X) (repeat . tapeOf . tapeOf $ rule)
         rule place  = case (neighbors place `elem`) `onBoth` ruleset of
                            (True,_)  -> O
                            (_,True)  -> cell inward place
                            _         -> X
         neighbors   = length . filter (O ==) . cells bordering
         bordering   = map (inward &) (diagonals ++ verticals ++ horizontals)
         diagonals   = (&) <$> horizontals <*> verticals
         verticals   =        [above, below]
         horizontals = map d2 [right, left]

onBoth :: (a -> b) -> (a,a) -> (b,b)
f `onBoth` (x,y) = (f x,f y)

conway :: [[Cell]] -> Universe
conway = life ([3],[2,3])

printLife :: Int -> Int -> Int -> Universe -> IO ()
printLife c r t = mapM_ putStr
   .            ([separator '┌' '─' '┐'] ++)
   .         (++ [separator '└' '─' '┘']) 
   . intersperse (separator '├' '─' '┤')
   . map (unlines . map (("│ " ++) . (++ " │")) . frame)
   . take (rightBy c & belowBy r & outwardBy t)
   where
      separator x y z = [x] ++ P.replicate (1 + (1 + c) * 2) y ++ [z] ++ "\n"
      frame = map $ intersperse ' ' . map (bool ' ' '●' . (O ==))

glider :: Universe
glider = conway [[X,X,O],
                 [O,X,O],
                 [X,O,O]]

spaceship :: Universe
spaceship = conway [[X,X,X,X,X],
                    [X,O,O,O,O],
                    [O,X,X,X,O],
                    [X,X,X,X,O],
                    [O,X,X,O,X]]