namespace Universe
type cell = A | B
type U<'a> = U of LazyList<'a> * 'a * LazyList<'a>

[<AutoOpen>]
module Universe =
    open LazyList
    let U left focus right = U(left,focus,right)
    let initial() = U (repeat A) B (repeat A)
    let shiftRight = fun (U (left,focus,Cons(focus',right))) -> U (cons focus left) focus' right
    let shiftLeft  = fun (U (Cons(focus',left),focus,right)) -> U left focus' (cons focus right)
    let left  (U(l,_,_)) = l
    let focus (U(_,f,_)) = f
    let right (U(_,_,r)) = r
    let fmap f (U(left,focus,right)) = U (map f left) (f focus) (map f right)
    let invert = fmap (function A -> B | B -> A)
    let iterate f (a : 'a U) = unfold (fun a -> Some(a, f a)) a
    let cojoin (a : 'a U) = U (tail <| iterate shiftLeft a) a (tail <| iterate shiftRight a)
    let coreturn = focus
    let inline (=>>) f x = fmap f (cojoin x)


module Rules =
    open Universe
    open LazyList

    let u = initial ()
    let cou = invert u

    let rule_gen_2c1d (n : byte) (U (left,focus,right)) =
        let x =
            new System.Collections.BitArray([|n|])
            |> Seq.cast<bool>
            |> Seq.map (function true -> B | false -> A)
            |> Seq.toArray
        match head left, focus, head right with
        | B,B,B -> x.[7]
        | B,B,A -> x.[6]
        | B,A,B -> x.[5]
        | B,A,A -> x.[4]
        | A,B,B -> x.[3]
        | A,B,A -> x.[2]
        | A,A,B -> x.[1]
        | A,A,A -> x.[0]


module IO =
    open Universe
    open LazyList
    open Rules
    
    module Console =
        open System
        let write (s : string) = System.Console.Write s
        let newline () = System.Console.WriteLine("")

        let printc = function
            | A -> write " "
            | B -> write "#"

        let printu (U(l,f,r)) n =
            newline ()
            List.iter (printc) (List.rev (toList <| take n l))
            printc f
            iter (printc) (take n r)

        let flip f a b = f b a

        let drawu rule_f rule_n length height u =
            newline ()
            iter (flip printu ((length / 2) - 1)) <| (take height <| iterate ((=>>) <| rule_f rule_n) u)
            newline ()


        let multiverse_2c1d length height =
            let rec aux n =
                match n with
                | n when n < 255uy -> newline ()
                                      newline ()
                                      System.Console.WriteLine ("Rule: {0}", n)
                                      drawu rule_gen_2c1d n length height u
                                      aux (n + 1uy)
                | _                -> newline ()
                                      newline ()
                                      System.Console.WriteLine ("Rule: {0}", n)
                                      drawu rule_gen_2c1d n length height u
                                      ()
            aux 0uy