{-|
The functions in this module allow you to create, transform,
and combine CA patterns.
-}

{-# LANGUAGE BlockArguments, LambdaCase, OverloadedStrings #-}

module Data.CA.Pattern
  ( -- * Cells
    Cell
    -- * Patterns
  , Pattern, lookup, generate, height, width, dimensions, valid
    -- * Vector conversions
  , fromRectVector, fromVector, toVector
    -- * List conversions
  , fromRectList, fromList, toList
    -- * Text and string conversions
  , toText, toString
    -- * Trimming
  , trimTop, trimBottom, trimLeft, trimRight, trim
    -- * Cropping and padding
  , setHeight, setWidth, setDimensions
    -- * Transformations
  , reflectX, reflectY, rotateL, rotateR
    -- * Combining
  , combine
  ) where

import Prelude hiding (lookup)
import qualified Data.Maybe as Maybe
import Data.String (IsString)

import qualified Data.Vector as Vec
import Data.Vector (Vector, (!?))

import qualified Data.Text as Text
import Data.Text (Text)

padEnd :: Int -> a -> Vector a -> Vector a
padEnd :: Int -> a -> Vector a -> Vector a
padEnd Int
n a
val Vector a
row = Vector a
row Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Int -> a -> Vector a
forall a. Int -> a -> Vector a
Vec.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector a
row) a
val

dropWhileEnd :: (a -> Bool) -> Vector a -> Vector a
dropWhileEnd :: (a -> Bool) -> Vector a -> Vector a
dropWhileEnd a -> Bool
f Vector a
row
  | Vector a -> Bool
forall a. Vector a -> Bool
Vec.null Vector a
row = Vector a
forall a. Vector a
Vec.empty
  | a -> Bool
f (Vector a -> a
forall a. Vector a -> a
Vec.last Vector a
row) = (a -> Bool) -> Vector a -> Vector a
forall a. (a -> Bool) -> Vector a -> Vector a
dropWhileEnd a -> Bool
f (Vector a -> Vector a
forall a. Vector a -> Vector a
Vec.init Vector a
row)
  | Bool
otherwise = Vector a
row

dropFirst :: Vector a -> Vector a
dropFirst :: Vector a -> Vector a
dropFirst = Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
Vec.drop Int
1

dropLast :: Vector a -> Vector a
dropLast :: Vector a -> Vector a
dropLast Vector a
row
  | Vector a -> Bool
forall a. Vector a -> Bool
Vec.null Vector a
row = Vector a
forall a. Vector a
Vec.empty
  | Bool
otherwise = Vector a -> Vector a
forall a. Vector a -> Vector a
Vec.init Vector a
row

firstCell :: Vector Cell -> Cell
firstCell :: Vector Bool -> Bool
firstCell Vector Bool
row
  | Vector Bool -> Bool
forall a. Vector a -> Bool
Vec.null Vector Bool
row = Bool
False
  | Bool
otherwise = Vector Bool -> Bool
forall a. Vector a -> a
Vec.head Vector Bool
row

lastCell :: Vector Cell -> Cell
lastCell :: Vector Bool -> Bool
lastCell Vector Bool
row
  | Vector Bool -> Bool
forall a. Vector a -> Bool
Vec.null Vector Bool
row = Bool
False
  | Bool
otherwise = Vector Bool -> Bool
forall a. Vector a -> a
Vec.last Vector Bool
row

{-|
The state of a cell. 'True' represents a live cell and
'False' represents a dead cell.
-}
type Cell = Bool

{-|
A pattern in a 2-dimensional 2-state cellular automaton.
-}
newtype Pattern = Pattern (Vector (Vector Cell))
  deriving (Pattern -> Pattern -> Bool
(Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool) -> Eq Pattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pattern -> Pattern -> Bool
$c/= :: Pattern -> Pattern -> Bool
== :: Pattern -> Pattern -> Bool
$c== :: Pattern -> Pattern -> Bool
Eq)

instance Show Pattern where
  show :: Pattern -> String
show Pattern
pat = String
"fromList " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Bool]] -> String
forall a. Show a => a -> String
show (Pattern -> [[Bool]]
toList Pattern
pat)

transform :: (Vector (Vector Cell) -> Vector (Vector Cell)) -> Pattern -> Pattern
transform :: (Vector (Vector Bool) -> Vector (Vector Bool))
-> Pattern -> Pattern
transform Vector (Vector Bool) -> Vector (Vector Bool)
f (Pattern Vector (Vector Bool)
rows) = Vector (Vector Bool) -> Pattern
Pattern (Vector (Vector Bool) -> Vector (Vector Bool)
f Vector (Vector Bool)
rows)

{-|
Get the state of one of the cells in a pattern. @lookup 0 0@
returns the cell in the upper-left corner. If the row
or column number is out of range, this function will
return 'False'.
-}
lookup
  :: Int -- ^ row
  -> Int -- ^ column
  -> Pattern -> Cell
lookup :: Int -> Int -> Pattern -> Bool
lookup Int
r Int
c (Pattern Vector (Vector Bool)
rows) = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
Maybe.fromMaybe Bool
False (Vector (Vector Bool)
rows Vector (Vector Bool) -> Int -> Maybe (Vector Bool)
forall a. Vector a -> Int -> Maybe a
!? Int
r Maybe (Vector Bool) -> (Vector Bool -> Maybe Bool) -> Maybe Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Vector Bool -> Int -> Maybe Bool
forall a. Vector a -> Int -> Maybe a
!? Int
c))

{-|
Generate a pattern from a function.
-}
generate
  :: Int -- ^ height
  -> Int -- ^ width
  -> (Int -> Int -> Cell) -- ^ function taking row and column
  -> Pattern
generate :: Int -> Int -> (Int -> Int -> Bool) -> Pattern
generate Int
h Int
w Int -> Int -> Bool
f = Vector (Vector Bool) -> Pattern
Pattern (Int -> (Int -> Vector Bool) -> Vector (Vector Bool)
forall a. Int -> (Int -> a) -> Vector a
Vec.generate Int
h \Int
r -> Int -> (Int -> Bool) -> Vector Bool
forall a. Int -> (Int -> a) -> Vector a
Vec.generate Int
w \Int
c -> Int -> Int -> Bool
f Int
r Int
c)

height :: Pattern -> Int
height :: Pattern -> Int
height (Pattern Vector (Vector Bool)
rows) = Vector (Vector Bool) -> Int
forall a. Vector a -> Int
Vec.length Vector (Vector Bool)
rows

width :: Pattern -> Int
width :: Pattern -> Int
width (Pattern Vector (Vector Bool)
rows)
  | Vector (Vector Bool) -> Bool
forall a. Vector a -> Bool
Vec.null Vector (Vector Bool)
rows = Int
0
  | Bool
otherwise = Vector Bool -> Int
forall a. Vector a -> Int
Vec.length (Vector (Vector Bool) -> Vector Bool
forall a. Vector a -> a
Vec.head Vector (Vector Bool)
rows)

{-|
Get the height and width of a pattern.
-}
dimensions :: Pattern -> (Int, Int)
dimensions :: Pattern -> (Int, Int)
dimensions Pattern
pat = (Pattern -> Int
height Pattern
pat, Pattern -> Int
width Pattern
pat)

{-|
Test if a pattern is valid, i.e. rectangular.
Some of the functions in this module only behave
properly on rectangular patterns.
-}
valid :: Pattern -> Bool
valid :: Pattern -> Bool
valid pat :: Pattern
pat@(Pattern Vector (Vector Bool)
rows) = let
  w :: Int
w = Pattern -> Int
width Pattern
pat
  validRow :: Vector a -> Bool
validRow Vector a
row = Vector a -> Int
forall a. Vector a -> Int
Vec.length Vector a
row Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
w
  in (Vector Bool -> Bool) -> Vector (Vector Bool) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Vector Bool -> Bool
forall a. Vector a -> Bool
validRow Vector (Vector Bool)
rows

{-|
Convert a vector of rows into a pattern, assuming
the rows are all the same length.
-}
fromRectVector :: Vector (Vector Cell) -> Pattern
fromRectVector :: Vector (Vector Bool) -> Pattern
fromRectVector = Vector (Vector Bool) -> Pattern
Pattern

{-|
Convert a vector of rows into a pattern. If
the rows are not all the same length, they will
padded with dead cells until the pattern is
rectangular.
-}
fromVector :: Vector (Vector Cell) -> Pattern
fromVector :: Vector (Vector Bool) -> Pattern
fromVector Vector (Vector Bool)
rows = let
  maxWidth :: Int
maxWidth = (Vector Bool -> Int -> Int) -> Int -> Vector (Vector Bool) -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int -> Int -> Int)
-> (Vector Bool -> Int) -> Vector Bool -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Bool -> Int
forall a. Vector a -> Int
Vec.length) Int
0 Vector (Vector Bool)
rows
  padded :: Vector (Vector Bool)
padded = (Vector Bool -> Vector Bool)
-> Vector (Vector Bool) -> Vector (Vector Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Bool -> Vector Bool -> Vector Bool
forall a. Int -> a -> Vector a -> Vector a
padEnd Int
maxWidth Bool
False) Vector (Vector Bool)
rows
  in Vector (Vector Bool) -> Pattern
Pattern Vector (Vector Bool)
padded

{-|
Convert a pattern into a vector of rows.
-}
toVector :: Pattern -> Vector (Vector Cell)
toVector :: Pattern -> Vector (Vector Bool)
toVector (Pattern Vector (Vector Bool)
rows) = Vector (Vector Bool)
rows

{-|
Convert a list of rows into a pattern, assuming
the rows are all the same length.
-}
fromRectList :: [[Cell]] -> Pattern
fromRectList :: [[Bool]] -> Pattern
fromRectList = Vector (Vector Bool) -> Pattern
fromRectVector (Vector (Vector Bool) -> Pattern)
-> ([[Bool]] -> Vector (Vector Bool)) -> [[Bool]] -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vector Bool] -> Vector (Vector Bool)
forall a. [a] -> Vector a
Vec.fromList ([Vector Bool] -> Vector (Vector Bool))
-> ([[Bool]] -> [Vector Bool]) -> [[Bool]] -> Vector (Vector Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Bool] -> Vector Bool) -> [[Bool]] -> [Vector Bool]
forall a b. (a -> b) -> [a] -> [b]
map [Bool] -> Vector Bool
forall a. [a] -> Vector a
Vec.fromList

{-|
Convert a list of rows into a pattern. If
the rows are not all the same length, they will
padded with dead cells until the pattern is
rectangular.
-}
fromList :: [[Cell]] -> Pattern
fromList :: [[Bool]] -> Pattern
fromList = Vector (Vector Bool) -> Pattern
fromVector (Vector (Vector Bool) -> Pattern)
-> ([[Bool]] -> Vector (Vector Bool)) -> [[Bool]] -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vector Bool] -> Vector (Vector Bool)
forall a. [a] -> Vector a
Vec.fromList ([Vector Bool] -> Vector (Vector Bool))
-> ([[Bool]] -> [Vector Bool]) -> [[Bool]] -> Vector (Vector Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Bool] -> Vector Bool) -> [[Bool]] -> [Vector Bool]
forall a b. (a -> b) -> [a] -> [b]
map [Bool] -> Vector Bool
forall a. [a] -> Vector a
Vec.fromList

{-|
Convert a pattern into a list of rows.
-}
toList :: Pattern -> [[Cell]]
toList :: Pattern -> [[Bool]]
toList (Pattern Vector (Vector Bool)
rows) = (Vector Bool -> [Bool]) -> [Vector Bool] -> [[Bool]]
forall a b. (a -> b) -> [a] -> [b]
map Vector Bool -> [Bool]
forall a. Vector a -> [a]
Vec.toList (Vector (Vector Bool) -> [Vector Bool]
forall a. Vector a -> [a]
Vec.toList Vector (Vector Bool)
rows)

toSomeString :: (Monoid s, IsString s) => (Vector Char -> s) -> Char -> Char -> Pattern -> s
toSomeString :: (Vector Char -> s) -> Char -> Char -> Pattern -> s
toSomeString Vector Char -> s
makeStr Char
dead Char
alive (Pattern Vector (Vector Bool)
rows) = let
  toChar :: Bool -> Char
toChar Bool
cell = if Bool
cell then Char
alive else Char
dead
  makeLine :: Vector Bool -> s
makeLine Vector Bool
row = Vector Char -> s
makeStr ((Bool -> Char) -> Vector Bool -> Vector Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Char
toChar Vector Bool
row) s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
"\n"
  in (Vector Bool -> s) -> Vector (Vector Bool) -> s
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Vector Bool -> s
makeLine Vector (Vector Bool)
rows

{-|
Convert a pattern into text. For example, @toText \'.' \'Z'@
will replace each dead cell with a @.@ and each live cell
with a @Z@.
-}
toText
  :: Char -- ^ dead cell
  -> Char -- ^ live cell
  -> Pattern -> Text
toText :: Char -> Char -> Pattern -> Text
toText = let
  add :: Char -> Text -> Text
add Char
c Text
text = Char -> Text
Text.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text
  in (Vector Char -> Text) -> Char -> Char -> Pattern -> Text
forall s.
(Monoid s, IsString s) =>
(Vector Char -> s) -> Char -> Char -> Pattern -> s
toSomeString ((Char -> Text -> Text) -> Text -> Vector Char -> Text
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> Text -> Text
add Text
"")

{-|
Convert a pattern into a string.
-}
toString
  :: Char -- ^ dead cell
  -> Char -- ^ live cell
  -> Pattern -> String
toString :: Char -> Char -> Pattern -> String
toString = (Vector Char -> String) -> Char -> Char -> Pattern -> String
forall s.
(Monoid s, IsString s) =>
(Vector Char -> s) -> Char -> Char -> Pattern -> s
toSomeString Vector Char -> String
forall a. Vector a -> [a]
Vec.toList

{-|
Remove rows of dead cells from the top of a pattern.
-}
trimTop :: Pattern -> Pattern
trimTop :: Pattern -> Pattern
trimTop = (Vector (Vector Bool) -> Vector (Vector Bool))
-> Pattern -> Pattern
transform ((Vector Bool -> Bool)
-> Vector (Vector Bool) -> Vector (Vector Bool)
forall a. (a -> Bool) -> Vector a -> Vector a
Vec.dropWhile ((Bool -> Bool) -> Vector Bool -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Bool -> Bool
not))

{-|
Remove rows of dead cells from the bottom of a pattern.
-}
trimBottom :: Pattern -> Pattern
trimBottom :: Pattern -> Pattern
trimBottom = (Vector (Vector Bool) -> Vector (Vector Bool))
-> Pattern -> Pattern
transform ((Vector Bool -> Bool)
-> Vector (Vector Bool) -> Vector (Vector Bool)
forall a. (a -> Bool) -> Vector a -> Vector a
dropWhileEnd ((Bool -> Bool) -> Vector Bool -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Bool -> Bool
not))

trimLeftV :: Vector (Vector Cell) -> Vector (Vector Cell)
trimLeftV :: Vector (Vector Bool) -> Vector (Vector Bool)
trimLeftV Vector (Vector Bool)
rows
  | Vector (Vector Bool) -> Bool
forall a. Vector a -> Bool
Vec.null Vector (Vector Bool)
rows Bool -> Bool -> Bool
|| (Vector Bool -> Bool) -> Vector (Vector Bool) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Vector Bool -> Bool
forall a. Vector a -> Bool
Vec.null Vector (Vector Bool)
rows = Vector (Vector Bool)
rows
  | Bool -> Bool
not ((Vector Bool -> Bool) -> Vector (Vector Bool) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Vector Bool -> Bool
firstCell Vector (Vector Bool)
rows) = Vector (Vector Bool) -> Vector (Vector Bool)
trimLeftV ((Vector Bool -> Vector Bool)
-> Vector (Vector Bool) -> Vector (Vector Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector Bool -> Vector Bool
forall a. Vector a -> Vector a
dropFirst Vector (Vector Bool)
rows)
  | Bool
otherwise = Vector (Vector Bool)
rows

trimRightV :: Vector (Vector Cell) -> Vector (Vector Cell)
trimRightV :: Vector (Vector Bool) -> Vector (Vector Bool)
trimRightV Vector (Vector Bool)
rows
  | Vector (Vector Bool) -> Bool
forall a. Vector a -> Bool
Vec.null Vector (Vector Bool)
rows Bool -> Bool -> Bool
|| (Vector Bool -> Bool) -> Vector (Vector Bool) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Vector Bool -> Bool
forall a. Vector a -> Bool
Vec.null Vector (Vector Bool)
rows = Vector (Vector Bool)
rows
  | Bool -> Bool
not ((Vector Bool -> Bool) -> Vector (Vector Bool) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Vector Bool -> Bool
lastCell Vector (Vector Bool)
rows) = Vector (Vector Bool) -> Vector (Vector Bool)
trimRightV ((Vector Bool -> Vector Bool)
-> Vector (Vector Bool) -> Vector (Vector Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector Bool -> Vector Bool
forall a. Vector a -> Vector a
dropLast Vector (Vector Bool)
rows)
  | Bool
otherwise = Vector (Vector Bool)
rows

{-|
Remove columns of dead cells from the left side of a pattern.
-}
trimLeft :: Pattern -> Pattern
trimLeft :: Pattern -> Pattern
trimLeft = (Vector (Vector Bool) -> Vector (Vector Bool))
-> Pattern -> Pattern
transform Vector (Vector Bool) -> Vector (Vector Bool)
trimLeftV

{-|
Remove columns of dead cells from the right side of a pattern.
-}
trimRight :: Pattern -> Pattern
trimRight :: Pattern -> Pattern
trimRight = (Vector (Vector Bool) -> Vector (Vector Bool))
-> Pattern -> Pattern
transform Vector (Vector Bool) -> Vector (Vector Bool)
trimRightV

{-|
A composition of 'trimTop', 'trimBottom', 'trimLeft', and 'trimRight'.
Removes as many dead cells from the pattern as possible while
keeping it rectangular.
-}
trim :: Pattern -> Pattern
trim :: Pattern -> Pattern
trim = Pattern -> Pattern
trimTop (Pattern -> Pattern) -> (Pattern -> Pattern) -> Pattern -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> Pattern
trimBottom (Pattern -> Pattern) -> (Pattern -> Pattern) -> Pattern -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> Pattern
trimLeft (Pattern -> Pattern) -> (Pattern -> Pattern) -> Pattern -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> Pattern
trimRight

{-|
Force a pattern to have the given height by removing rows
from the bottom or by adding rows of dead cells.
-}
setHeight :: Int -> Pattern -> Pattern
setHeight :: Int -> Pattern -> Pattern
setHeight Int
h Pattern
pat =
  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
h (Pattern -> Int
height Pattern
pat) of
    Ordering
LT -> (Vector (Vector Bool) -> Vector (Vector Bool))
-> Pattern -> Pattern
transform (Int -> Vector (Vector Bool) -> Vector (Vector Bool)
forall a. Int -> Vector a -> Vector a
Vec.take Int
h) Pattern
pat
    Ordering
EQ -> Pattern
pat
    Ordering
GT -> let
      row :: Vector Bool
row = Int -> Bool -> Vector Bool
forall a. Int -> a -> Vector a
Vec.replicate (Pattern -> Int
width Pattern
pat) Bool
False
      in (Vector (Vector Bool) -> Vector (Vector Bool))
-> Pattern -> Pattern
transform (Int -> Vector Bool -> Vector (Vector Bool) -> Vector (Vector Bool)
forall a. Int -> a -> Vector a -> Vector a
padEnd Int
h Vector Bool
row) Pattern
pat

{-|
Force a pattern to have the given width by removing columns
from the right or by adding columns of dead cells.
-}
setWidth :: Int -> Pattern -> Pattern
setWidth :: Int -> Pattern -> Pattern
setWidth Int
w Pattern
pat =
  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
w (Pattern -> Int
width Pattern
pat) of
    Ordering
LT -> (Vector (Vector Bool) -> Vector (Vector Bool))
-> Pattern -> Pattern
transform ((Vector Bool -> Vector Bool)
-> Vector (Vector Bool) -> Vector (Vector Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Vector Bool -> Vector Bool
forall a. Int -> Vector a -> Vector a
Vec.take Int
w)) Pattern
pat
    Ordering
EQ -> Pattern
pat
    Ordering
GT -> (Vector (Vector Bool) -> Vector (Vector Bool))
-> Pattern -> Pattern
transform ((Vector Bool -> Vector Bool)
-> Vector (Vector Bool) -> Vector (Vector Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Bool -> Vector Bool -> Vector Bool
forall a. Int -> a -> Vector a -> Vector a
padEnd Int
w Bool
False)) Pattern
pat

{-|
Set the height and width of a pattern.
-}
setDimensions :: Int -> Int -> Pattern -> Pattern
setDimensions :: Int -> Int -> Pattern -> Pattern
setDimensions Int
h Int
w = Int -> Pattern -> Pattern
setWidth Int
w (Pattern -> Pattern) -> (Pattern -> Pattern) -> Pattern -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Pattern -> Pattern
setHeight Int
h

{-|
Reflect vertically, switching the top and the bottom.
-}
reflectY :: Pattern -> Pattern
reflectY :: Pattern -> Pattern
reflectY = (Vector (Vector Bool) -> Vector (Vector Bool))
-> Pattern -> Pattern
transform Vector (Vector Bool) -> Vector (Vector Bool)
forall a. Vector a -> Vector a
Vec.reverse

{-|
Reflect horizontally, switching the left and the right.
-}
reflectX :: Pattern -> Pattern
reflectX :: Pattern -> Pattern
reflectX = (Vector (Vector Bool) -> Vector (Vector Bool))
-> Pattern -> Pattern
transform ((Vector Bool -> Vector Bool)
-> Vector (Vector Bool) -> Vector (Vector Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector Bool -> Vector Bool
forall a. Vector a -> Vector a
Vec.reverse)

{-|
Rotate counterclockwise by a quarter turn.
-}
rotateL :: Pattern -> Pattern
rotateL :: Pattern -> Pattern
rotateL Pattern
pat = let
  (Int
h, Int
w) = Pattern -> (Int, Int)
dimensions Pattern
pat
  in Int -> Int -> (Int -> Int -> Bool) -> Pattern
generate Int
w Int
h \Int
r Int
c -> Int -> Int -> Pattern -> Bool
lookup Int
c (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Pattern
pat

{-|
Rotate clockwise by a quarter turn.
-}
rotateR :: Pattern -> Pattern
rotateR :: Pattern -> Pattern
rotateR Pattern
pat = let
  (Int
h, Int
w) = Pattern -> (Int, Int)
dimensions Pattern
pat
  in Int -> Int -> (Int -> Int -> Bool) -> Pattern
generate Int
w Int
h \Int
r Int
c -> Int -> Int -> Pattern -> Bool
lookup (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
r Pattern
pat

{-|
Combine two patterns given a vertical and horizontal offset,
which describe the displacement of the second pattern relative
to the first one.
-}
combine
  :: Int -- ^ vertical offset
  -> Int -- ^ horizontal offset
  -> Pattern -> Pattern -> Pattern
combine :: Int -> Int -> Pattern -> Pattern -> Pattern
combine Int
y Int
x Pattern
pat1 Pattern
pat2 = let
  (Int
y1, Int
y2) = if Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then (-Int
y, Int
0) else (Int
0, Int
y)
  (Int
x1, Int
x2) = if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then (-Int
x, Int
0) else (Int
0, Int
x)
  h :: Int
h = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Pattern -> Int
height Pattern
pat1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y1) (Pattern -> Int
height Pattern
pat2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y2)
  w :: Int
w = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Pattern -> Int
width Pattern
pat1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x1) (Pattern -> Int
width Pattern
pat2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x2)
  in Int -> Int -> (Int -> Int -> Bool) -> Pattern
generate Int
h Int
w \Int
r Int
c -> let
    cell1 :: Bool
cell1 = Int -> Int -> Pattern -> Bool
lookup (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y1) (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x1) Pattern
pat1
    cell2 :: Bool
cell2 = Int -> Int -> Pattern -> Bool
lookup (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y2) (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x2) Pattern
pat2
    in Bool -> Bool -> Bool
forall a. Ord a => a -> a -> a
max Bool
cell1 Bool
cell2