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

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

module Data.CA.Pattern
  ( -- * Cells
    Cell(..), isDead, isAlive
    -- * 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 Cell -> Cell
firstCell Vector Cell
row
  | Vector Cell -> Bool
forall a. Vector a -> Bool
Vec.null Vector Cell
row = Cell
Dead
  | Bool
otherwise = Vector Cell -> Cell
forall a. Vector a -> a
Vec.head Vector Cell
row

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

{-|
The state of a cell.
-}
data Cell = Dead | Alive
  deriving (Cell -> Cell -> Bool
(Cell -> Cell -> Bool) -> (Cell -> Cell -> Bool) -> Eq Cell
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cell -> Cell -> Bool
$c/= :: Cell -> Cell -> Bool
== :: Cell -> Cell -> Bool
$c== :: Cell -> Cell -> Bool
Eq, Eq Cell
Eq Cell
-> (Cell -> Cell -> Ordering)
-> (Cell -> Cell -> Bool)
-> (Cell -> Cell -> Bool)
-> (Cell -> Cell -> Bool)
-> (Cell -> Cell -> Bool)
-> (Cell -> Cell -> Cell)
-> (Cell -> Cell -> Cell)
-> Ord Cell
Cell -> Cell -> Bool
Cell -> Cell -> Ordering
Cell -> Cell -> Cell
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Cell -> Cell -> Cell
$cmin :: Cell -> Cell -> Cell
max :: Cell -> Cell -> Cell
$cmax :: Cell -> Cell -> Cell
>= :: Cell -> Cell -> Bool
$c>= :: Cell -> Cell -> Bool
> :: Cell -> Cell -> Bool
$c> :: Cell -> Cell -> Bool
<= :: Cell -> Cell -> Bool
$c<= :: Cell -> Cell -> Bool
< :: Cell -> Cell -> Bool
$c< :: Cell -> Cell -> Bool
compare :: Cell -> Cell -> Ordering
$ccompare :: Cell -> Cell -> Ordering
$cp1Ord :: Eq Cell
Ord, Int -> Cell -> ShowS
[Cell] -> ShowS
Cell -> String
(Int -> Cell -> ShowS)
-> (Cell -> String) -> ([Cell] -> ShowS) -> Show Cell
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cell] -> ShowS
$cshowList :: [Cell] -> ShowS
show :: Cell -> String
$cshow :: Cell -> String
showsPrec :: Int -> Cell -> ShowS
$cshowsPrec :: Int -> Cell -> ShowS
Show)

isDead :: Cell -> Bool
isDead :: Cell -> Bool
isDead = \case { Cell
Dead -> Bool
True; Cell
Alive -> Bool
False }

isAlive :: Cell -> Bool
isAlive :: Cell -> Bool
isAlive = \case { Cell
Dead -> Bool
False; Cell
Alive -> Bool
True }

{-|
A pattern in a 2-dimensional 2-state cellular automaton.
-}
newtype Pattern = Pattern (Vector (Vector Cell))

transform :: (Vector (Vector Cell) -> Vector (Vector Cell)) -> Pattern -> Pattern
transform :: (Vector (Vector Cell) -> Vector (Vector Cell))
-> Pattern -> Pattern
transform Vector (Vector Cell) -> Vector (Vector Cell)
f (Pattern Vector (Vector Cell)
rows) = Vector (Vector Cell) -> Pattern
Pattern (Vector (Vector Cell) -> Vector (Vector Cell)
f Vector (Vector Cell)
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 'Dead'.
-}
lookup
  :: Int -- ^ row
  -> Int -- ^ column
  -> Pattern -> Cell
lookup :: Int -> Int -> Pattern -> Cell
lookup Int
r Int
c (Pattern Vector (Vector Cell)
rows) = Cell -> Maybe Cell -> Cell
forall a. a -> Maybe a -> a
Maybe.fromMaybe Cell
Dead (Vector (Vector Cell)
rows Vector (Vector Cell) -> Int -> Maybe (Vector Cell)
forall a. Vector a -> Int -> Maybe a
!? Int
r Maybe (Vector Cell) -> (Vector Cell -> Maybe Cell) -> Maybe Cell
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Vector Cell -> Int -> Maybe Cell
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 -> Cell) -> Pattern
generate Int
h Int
w Int -> Int -> Cell
f = Vector (Vector Cell) -> Pattern
Pattern (Int -> (Int -> Vector Cell) -> Vector (Vector Cell)
forall a. Int -> (Int -> a) -> Vector a
Vec.generate Int
h \Int
r -> Int -> (Int -> Cell) -> Vector Cell
forall a. Int -> (Int -> a) -> Vector a
Vec.generate Int
w \Int
c -> Int -> Int -> Cell
f Int
r Int
c)

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

width :: Pattern -> Int
width :: Pattern -> Int
width (Pattern Vector (Vector Cell)
rows)
  | Vector (Vector Cell) -> Bool
forall a. Vector a -> Bool
Vec.null Vector (Vector Cell)
rows = Int
0
  | Bool
otherwise = Vector Cell -> Int
forall a. Vector a -> Int
Vec.length (Vector (Vector Cell) -> Vector Cell
forall a. Vector a -> a
Vec.head Vector (Vector Cell)
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 Cell)
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 Cell -> Bool) -> Vector (Vector Cell) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Vector Cell -> Bool
forall a. Vector a -> Bool
validRow Vector (Vector Cell)
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 Cell) -> Pattern
fromRectVector = Vector (Vector Cell) -> 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 Cell) -> Pattern
fromVector Vector (Vector Cell)
rows = let
  maxWidth :: Int
maxWidth = (Vector Cell -> Int -> Int) -> Int -> Vector (Vector Cell) -> 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 Cell -> Int) -> Vector Cell -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Cell -> Int
forall a. Vector a -> Int
Vec.length) Int
0 Vector (Vector Cell)
rows
  padded :: Vector (Vector Cell)
padded = (Vector Cell -> Vector Cell)
-> Vector (Vector Cell) -> Vector (Vector Cell)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Cell -> Vector Cell -> Vector Cell
forall a. Int -> a -> Vector a -> Vector a
padEnd Int
maxWidth Cell
Dead) Vector (Vector Cell)
rows
  in Vector (Vector Cell) -> Pattern
Pattern Vector (Vector Cell)
padded

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

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

{-|
Convert a pattern into a list of rows.
-}
toList :: Pattern -> [[Cell]]
toList :: Pattern -> [[Cell]]
toList (Pattern Vector (Vector Cell)
rows) = (Vector Cell -> [Cell]) -> [Vector Cell] -> [[Cell]]
forall a b. (a -> b) -> [a] -> [b]
map Vector Cell -> [Cell]
forall a. Vector a -> [a]
Vec.toList (Vector (Vector Cell) -> [Vector Cell]
forall a. Vector a -> [a]
Vec.toList Vector (Vector Cell)
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 Cell)
rows) = let
  toChar :: Cell -> Char
toChar = \case { Cell
Dead -> Char
dead; Cell
Alive -> Char
alive }
  makeLine :: Vector Cell -> s
makeLine Vector Cell
row = Vector Char -> s
makeStr ((Cell -> Char) -> Vector Cell -> Vector Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cell -> Char
toChar Vector Cell
row) s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
"\n"
  in (Vector Cell -> s) -> Vector (Vector Cell) -> s
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Vector Cell -> s
makeLine Vector (Vector Cell)
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 Cell) -> Vector (Vector Cell))
-> Pattern -> Pattern
transform ((Vector Cell -> Bool)
-> Vector (Vector Cell) -> Vector (Vector Cell)
forall a. (a -> Bool) -> Vector a -> Vector a
Vec.dropWhile ((Cell -> Bool) -> Vector Cell -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Cell -> Bool
isDead))

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

trimLeftV :: Vector (Vector Cell) -> Vector (Vector Cell)
trimLeftV :: Vector (Vector Cell) -> Vector (Vector Cell)
trimLeftV Vector (Vector Cell)
rows
  | (Vector Cell -> Bool) -> Vector (Vector Cell) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Cell -> Bool
isDead (Cell -> Bool) -> (Vector Cell -> Cell) -> Vector Cell -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Cell -> Cell
firstCell) Vector (Vector Cell)
rows = Vector (Vector Cell) -> Vector (Vector Cell)
trimLeftV ((Vector Cell -> Vector Cell)
-> Vector (Vector Cell) -> Vector (Vector Cell)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector Cell -> Vector Cell
forall a. Vector a -> Vector a
dropFirst Vector (Vector Cell)
rows)
  | Bool
otherwise = Vector (Vector Cell)
rows

trimRightV :: Vector (Vector Cell) -> Vector (Vector Cell)
trimRightV :: Vector (Vector Cell) -> Vector (Vector Cell)
trimRightV Vector (Vector Cell)
rows
  | (Vector Cell -> Bool) -> Vector (Vector Cell) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Cell -> Bool
isDead (Cell -> Bool) -> (Vector Cell -> Cell) -> Vector Cell -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Cell -> Cell
lastCell) Vector (Vector Cell)
rows = Vector (Vector Cell) -> Vector (Vector Cell)
trimRightV ((Vector Cell -> Vector Cell)
-> Vector (Vector Cell) -> Vector (Vector Cell)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector Cell -> Vector Cell
forall a. Vector a -> Vector a
dropLast Vector (Vector Cell)
rows)
  | Bool
otherwise = Vector (Vector Cell)
rows

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

{-|
You get the idea.
-}
trimRight :: Pattern -> Pattern
trimRight :: Pattern -> Pattern
trimRight = (Vector (Vector Cell) -> Vector (Vector Cell))
-> Pattern -> Pattern
transform Vector (Vector Cell) -> Vector (Vector Cell)
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 Cell) -> Vector (Vector Cell))
-> Pattern -> Pattern
transform (Int -> Vector (Vector Cell) -> Vector (Vector Cell)
forall a. Int -> Vector a -> Vector a
Vec.take Int
h) Pattern
pat
    Ordering
EQ -> Pattern
pat
    Ordering
GT -> let
      row :: Vector Cell
row = Int -> Cell -> Vector Cell
forall a. Int -> a -> Vector a
Vec.replicate (Pattern -> Int
width Pattern
pat) Cell
Dead
      in (Vector (Vector Cell) -> Vector (Vector Cell))
-> Pattern -> Pattern
transform (Int -> Vector Cell -> Vector (Vector Cell) -> Vector (Vector Cell)
forall a. Int -> a -> Vector a -> Vector a
padEnd Int
h Vector Cell
row) Pattern
pat

{-|
Force a pattern to have the given width by remove 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 Cell) -> Vector (Vector Cell))
-> Pattern -> Pattern
transform ((Vector Cell -> Vector Cell)
-> Vector (Vector Cell) -> Vector (Vector Cell)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Vector Cell -> Vector Cell
forall a. Int -> Vector a -> Vector a
Vec.take Int
w)) Pattern
pat
    Ordering
EQ -> Pattern
pat
    Ordering
GT -> (Vector (Vector Cell) -> Vector (Vector Cell))
-> Pattern -> Pattern
transform ((Vector Cell -> Vector Cell)
-> Vector (Vector Cell) -> Vector (Vector Cell)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Cell -> Vector Cell -> Vector Cell
forall a. Int -> a -> Vector a -> Vector a
padEnd Int
w Cell
Dead)) 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
setHeight Int
h (Pattern -> Pattern) -> (Pattern -> Pattern) -> Pattern -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Pattern -> Pattern
setWidth Int
w

{-|
Reflect vertically, switching the top and the bottom.
-}
reflectY :: Pattern -> Pattern
reflectY :: Pattern -> Pattern
reflectY = (Vector (Vector Cell) -> Vector (Vector Cell))
-> Pattern -> Pattern
transform Vector (Vector Cell) -> Vector (Vector Cell)
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 Cell) -> Vector (Vector Cell))
-> Pattern -> Pattern
transform ((Vector Cell -> Vector Cell)
-> Vector (Vector Cell) -> Vector (Vector Cell)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector Cell -> Vector Cell
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 -> Cell) -> Pattern
generate Int
w Int
h \Int
r Int
c -> Int -> Int -> Pattern -> Cell
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 -> Cell) -> Pattern
generate Int
w Int
h \Int
r Int
c -> Int -> Int -> Pattern -> Cell
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 -> Cell) -> Pattern
generate Int
h Int
w \Int
r Int
c -> let
    cell1 :: Cell
cell1 = Int -> Int -> Pattern -> Cell
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 :: Cell
cell2 = Int -> Int -> Pattern -> Cell
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 Cell -> Cell -> Cell
forall a. Ord a => a -> a -> a
max Cell
cell1 Cell
cell2