{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}

module Main where

import Data.Tape

import Control.Comonad
import Control.Lens
import Data.Colour.Names
import qualified Data.Foldable as Foldable
import Data.Maybe
import Diagrams
import Diagrams.Backend.Rasterific
import GHC.Exts

main = test 120 40

data AliveDead
  = Alive
  | Dead
  deriving (Eq, Show, Ord)

rule30
  :: Tape f
  => f AliveDead -> AliveDead
rule30 t =
  fromMaybe
    (view tapeFocus t)
    (helper <$> (view tapeFocus <$> moveLeft t) <*>
     pure (t ^. tapeFocus) <*>
     (view tapeFocus <$> moveRight t))
  where
    helper Alive Alive Alive = Dead
    helper Alive Alive Dead = Dead
    helper Alive Dead Alive = Dead
    helper Dead Dead Dead = Dead
    helper _ _ _ = Alive

startCondition
  :: (Applicative f, Tape f)
  => f AliveDead
startCondition = set tapeFocus Alive $ pure Dead

sizedConvolution :: Int -> StreamTape (a -> a)
sizedConvolution n = StreamTape (replicate n id) id (replicate n id)

evoledStream :: Int -> [StreamTape AliveDead]
evoledStream n =
  map (sizedConvolution n <*>) $
  iterate (extend rule30) startCondition

display (StreamTape ls c rs) = map helper (reverse ls ++ c : rs)
  where
    helper Dead = '.'
    helper Alive = '#'

oneDimDisplay :: StreamTape AliveDead -> Diagram B
oneDimDisplay (StreamTape ls c rs) =
  Foldable.foldl' (|||) mempty $ map helper (reverse ls ++ c : rs)
  where
    helper Alive = fc black $ lc black $ square 1
    helper Dead = fc white $ lc black $ square 1

test m =
  renderRasterific "output.png" (dims $ pure 1200) .
  Foldable.foldl' (===) mempty .
  take m . map oneDimDisplay . evoledStream
