{-|
Module      : Graphics.Autom.NextNearest
Description : 1-D binary cellular automata with next-nearest-neighbor updating
Copyright   : (c) Christopher Howard, 2016
License     : GPL-3
Maintainer  : ch.howard@zoho.com

This module implements the core algorithm for 1-D binary cellular
automata with next-nearest-neighbor updating.
-}

module Graphics.Autom.NextNearest (grid, overlaidGrid) where

import Prelude ((-), (+), mod, Bool, Int, (*), div, undefined, take, map, foldr)
import Data.Vector.Unboxed ((!), Unbox, Vector, length, fromList, generate, concat)
import Data.Word (Word32)
import Data.Bits (testBit, (.|.), shift)

-- |Starting with a single row of binary values, this function
-- generates a vector of rows in which each row (except the first) is
-- based on the values of the previous row, using the next-nearest
-- neighbors calculation based upon the 32 bit rule provided.
grid :: Vector Bool -- ^ the initial row of binary values
        -> Word32 -- ^ the 32-bit rule
        -> Int -- ^ the number of rows returned
        -> Vector Bool -- ^ the rows returned concatenated into a single vector
grid v r h = concat (take h (go v))
    where go a = let n = newRow a r in n : go n

-- |This function overlays each point in a grid with the 32-bit value
-- category it falls into. This is a simple method of categorizing
-- pixels in a generated pattern, so that color and masks can be
-- applied to them in interesting ways.
overlaidGrid :: Vector Bool -- ^ a grid (set of rows) concatenated in a single vector
                -> Int -- ^ the width of a row in the grid
                -> Vector (Bool, Int)
overlaidGrid v w = fromList (map f [ (r, c)
                                           | r <- [0 .. (rows - 1)]
                                           , c <- [0 .. (w - 1)] ])
  where rows = length v `div` w
        f (r, c) = ( indexSeamlessGrid v w (r, c)
                   , fiveBitInt ( indexSeamlessGrid v w (r - 1, c - 2)
                                , indexSeamlessGrid v w (r - 1, c - 1)
                                , indexSeamlessGrid v w (r - 1, c    )
                                , indexSeamlessGrid v w (r - 1, c + 1)
                                , indexSeamlessGrid v w (r - 1, c + 2) ))

newRow :: Vector Bool -> Word32 -> Vector Bool
newRow v r = generate (length v)
                      (\i -> testBit r (nextNearestInt v i))

fiveBitInt :: (Bool, Bool, Bool, Bool, Bool) -> Int
fiveBitInt (a, b, c, d, e) =
  let toi x = if x then 1 else 0 in
      foldr (.|.) 0 [ shift (toi a) 4 :: Int
                    , shift (toi b) 3 :: Int
                    , shift (toi c) 2 :: Int
                    , shift (toi d) 1 :: Int
                    , toi e :: Int ]

indexSeamlessGrid :: Unbox a => Vector a -> Int -> (Int, Int) -> a
indexSeamlessGrid v w (r, c) = v ! i
  where i = wr * w + wc
        wr = mod r (length v `div` w)
        wc = mod c w

wrappedIndex :: Unbox a => Vector a -> Int -> a
wrappedIndex v i = v ! mod i (length v)

nextNearestInt :: Vector Bool -> Int -> Int
nextNearestInt v i = fiveBitInt ( wrappedIndex v (i - 2)
                                , wrappedIndex v (i - 1)
                                , wrappedIndex v i
                                , wrappedIndex v (i + 1)
                                , wrappedIndex v (i + 2))