module Data.CA.List (withDimensions, combinations) where

import qualified Control.Applicative as Ap

import qualified Data.CA.Pattern as Pat
import Data.CA.Pattern (Pattern, Cell)

composeN :: Int -> (a -> a) -> a -> a
composeN :: Int -> (a -> a) -> a -> a
composeN Int
n a -> a
f
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = a -> a
forall a. a -> a
id
  | Bool
otherwise = a -> a
f (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (a -> a) -> a -> a
forall a. Int -> (a -> a) -> a -> a
composeN (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a -> a
f

possible1 :: Int -> [[Cell]]
possible1 :: Int -> [[Bool]]
possible1 Int
n = Int -> ([[Bool]] -> [[Bool]]) -> [[Bool]] -> [[Bool]]
forall a. Int -> (a -> a) -> a -> a
composeN Int
n ((Bool -> [Bool] -> [Bool]) -> [Bool] -> [[Bool]] -> [[Bool]]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Ap.liftA2 (:) [Bool
False, Bool
True]) [[]]

possible2 :: Int -> Int -> [[[Cell]]]
possible2 :: Int -> Int -> [[[Bool]]]
possible2 Int
h Int
w = let
  rows :: [[Bool]]
rows = Int -> [[Bool]]
possible1 Int
w
  in Int -> ([[[Bool]]] -> [[[Bool]]]) -> [[[Bool]]] -> [[[Bool]]]
forall a. Int -> (a -> a) -> a -> a
composeN Int
h (([Bool] -> [[Bool]] -> [[Bool]])
-> [[Bool]] -> [[[Bool]]] -> [[[Bool]]]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Ap.liftA2 (:) [[Bool]]
rows) [[]]

{-|
A list of every possible h by w pattern. This function
is necessarily exponential in both arguments, so it's only
practical if the dimensions are very small.
-}
withDimensions
  :: Int -- ^ h
  -> Int -- ^ w
  -> [Pattern]
withDimensions :: Int -> Int -> [Pattern]
withDimensions Int
h Int
w = ([[Bool]] -> Pattern) -> [[[Bool]]] -> [Pattern]
forall a b. (a -> b) -> [a] -> [b]
map [[Bool]] -> Pattern
Pat.fromRectList (Int -> Int -> [[[Bool]]]
possible2 Int
h Int
w)

{-|
Combine two patterns in multiple ways. Useful for creating
a list of spaceship / still life collisions.

See 'Pat.combine'.
-}
combinations
  :: (Int, Int) -- ^ min and max vertical offset
  -> (Int, Int) -- ^ min and max horizonal offset
  -> Pattern -> Pattern -> [Pattern]
combinations :: (Int, Int) -> (Int, Int) -> Pattern -> Pattern -> [Pattern]
combinations (Int
yMin, Int
yMax) (Int
xMin, Int
xMax) Pattern
pat1 Pattern
pat2 = let
  combine :: Int -> Int -> Pattern
combine Int
y Int
x = Int -> Int -> Pattern -> Pattern -> Pattern
Pat.combine Int
y Int
x Pattern
pat1 Pattern
pat2
  in (Int -> Int -> Pattern) -> [Int] -> [Int] -> [Pattern]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Ap.liftA2 Int -> Int -> Pattern
combine [Int
yMin .. Int
yMax] [Int
xMin .. Int
xMax]