module Kewar.Layout.FunctionalPatterns (functionalPatterns) where

import Kewar.Constants (alignmentPatternLocations)
import Kewar.Layout.Constants (size)
import Kewar.Layout.Types
  ( Module (..),
    Position,
    moveTo,
    overlapsWith,
    sumP,
  )
import Kewar.Types (Version)

functionalPatterns :: Version -> [(Position, Module)]
functionalPatterns :: Version -> [(Position, Module)]
functionalPatterns Version
v = Version -> [(Position, Module)]
finders Version
v [(Position, Module)]
-> [(Position, Module)] -> [(Position, Module)]
forall a. [a] -> [a] -> [a]
++ Version -> [(Position, Module)]
alignments Version
v [(Position, Module)]
-> [(Position, Module)] -> [(Position, Module)]
forall a. [a] -> [a] -> [a]
++ Version -> [(Position, Module)]
timings Version
v [(Position, Module)]
-> [(Position, Module)] -> [(Position, Module)]
forall a. [a] -> [a] -> [a]
++ Version -> [(Position, Module)]
darkModule Version
v [(Position, Module)]
-> [(Position, Module)] -> [(Position, Module)]
forall a. [a] -> [a] -> [a]
++ Version -> [(Position, Module)]
separators Version
v

finders :: Version -> [(Position, Module)]
finders :: Version -> [(Position, Module)]
finders Version
v = do
  let whitePositions :: [Position]
whitePositions = [(Version
1, Version
1), (Version
2, Version
1), (Version
3, Version
1), (Version
4, Version
1), (Version
5, Version
1), (Version
1, Version
2), (Version
1, Version
3), (Version
1, Version
4), (Version
1, Version
5), (Version
2, Version
5), (Version
3, Version
5), (Version
4, Version
5), (Version
5, Version
5), (Version
5, Version
2), (Version
5, Version
3), (Version
5, Version
4)]
  let whites :: [(Position, Module)]
whites = [Position] -> [Module] -> [(Position, Module)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Position]
whitePositions (Module -> [Module]
forall a. a -> [a]
repeat Module
White)
  let blacks :: [(Position, Module)]
blacks = [Position] -> [Module] -> [(Position, Module)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Version
i, Version
j) | Version
i <- [Version
0 .. Version
6], Version
j <- [Version
0 .. Version
6], (Version
i, Version
j) Position -> [Position] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Position]
whitePositions] (Module -> [Module]
forall a. a -> [a]
repeat Module
Black)
  let finder :: [(Position, Module)]
finder = [(Position, Module)]
blacks [(Position, Module)]
-> [(Position, Module)] -> [(Position, Module)]
forall a. [a] -> [a] -> [a]
++ [(Position, Module)]
whites

  [(Position, Module)]
finder [(Position, Module)]
-> [(Position, Module)] -> [(Position, Module)]
forall a. [a] -> [a] -> [a]
++ Position -> [(Position, Module)] -> [(Position, Module)]
moveTo (Version
s Version -> Version -> Version
forall a. Num a => a -> a -> a
-Version
7, Version
0) [(Position, Module)]
finder [(Position, Module)]
-> [(Position, Module)] -> [(Position, Module)]
forall a. [a] -> [a] -> [a]
++ Position -> [(Position, Module)] -> [(Position, Module)]
moveTo (Version
0, Version
s Version -> Version -> Version
forall a. Num a => a -> a -> a
-Version
7) [(Position, Module)]
finder
  where
    s :: Version
s = Version -> Version
size Version
v

alignments :: Version -> [(Position, Module)]
alignments :: Version -> [(Position, Module)]
alignments Version
1 = []
alignments Version
v = do
  -- Draw blocks
  let whitePositions :: [Position]
whitePositions = [(Version
1, Version
1), (Version
2, Version
1), (Version
3, Version
1), (Version
1, Version
2), (Version
1, Version
3), (Version
2, Version
3), (Version
3, Version
3), (Version
3, Version
2)]
  let whites :: [(Position, Module)]
whites = [Position] -> [Module] -> [(Position, Module)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Position]
whitePositions (Module -> [Module]
forall a. a -> [a]
repeat Module
White)
  let blacks :: [(Position, Module)]
blacks = [Position] -> [Module] -> [(Position, Module)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Version
i, Version
j) | Version
i <- [Version
0 .. Version
4], Version
j <- [Version
0 .. Version
4], (Version
i, Version
j) Position -> [Position] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Position]
whitePositions] (Module -> [Module]
forall a. a -> [a]
repeat Module
Black)
  let alignment :: [(Position, Module)]
alignment = [(Position, Module)]
blacks [(Position, Module)]
-> [(Position, Module)] -> [(Position, Module)]
forall a. [a] -> [a] -> [a]
++ [(Position, Module)]
whites

  -- Filter out location which would yield a block overlapping with finders
  let findersRanges :: [(Position, Position)]
findersRanges = [((Version
0, Version
0), (Version
7, Version
7)), ((Version
s Version -> Version -> Version
forall a. Num a => a -> a -> a
-Version
8, Version
0), (Version
s Version -> Version -> Version
forall a. Num a => a -> a -> a
-Version
1, Version
7)), ((Version
0, Version
s Version -> Version -> Version
forall a. Num a => a -> a -> a
-Version
8), (Version
7, Version
s Version -> Version -> Version
forall a. Num a => a -> a -> a
-Version
1))]
  let locations' :: [Position]
locations' = (Position -> Bool) -> [Position] -> [Position]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Position
l -> Bool -> Bool
not (((Position, Position) -> Bool) -> [(Position, Position)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Position -> (Position, Position) -> Bool
overlapsWithRange Position
l) [(Position, Position)]
findersRanges)) ([Position] -> [Position]) -> [Position] -> [Position]
forall a b. (a -> b) -> a -> b
$ Version -> [Position]
alignmentPatternLocations Version
v

  (Position -> [(Position, Module)])
-> [Position] -> [(Position, Module)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Position -> [(Position, Module)] -> [(Position, Module)]
`moveTo` [(Position, Module)]
alignment) [Position]
locations'
  where
    corners :: Position -> [Position]
corners Position
position = [Position
position, Position -> Position -> Position
sumP Position
position (Version
4, Version
4), Position -> Position -> Position
sumP Position
position (Version
0, Version
4), Position -> Position -> Position
sumP Position
position (Version
4, Version
0)]
    overlapsWithRange :: Position -> (Position, Position) -> Bool
overlapsWithRange Position
position (Position, Position)
range = (Position -> Bool) -> [Position] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Position -> (Position, Position) -> Bool
`overlapsWith` (Position, Position)
range) (Position -> [Position]
corners Position
position)
    s :: Version
s = Version -> Version
size Version
v

timings :: Version -> [(Position, Module)]
timings :: Version -> [(Position, Module)]
timings Version
v = do
  let b :: Version
b = Version
s Version -> Version -> Version
forall a. Num a => a -> a -> a
- Version
16
  let vertical :: [(Position, Module)]
vertical = [((Version
i, Version
0), if Version -> Bool
forall a. Integral a => a -> Bool
odd Version
i then Module
Black else Module
White) | Version
i <- [Version
1 .. Version
b]]
  let horizontal :: [(Position, Module)]
horizontal = [((Version
0, Version
i), if Version -> Bool
forall a. Integral a => a -> Bool
odd Version
i then Module
Black else Module
White) | Version
i <- [Version
1 .. Version
b]]

  Position -> [(Position, Module)] -> [(Position, Module)]
moveTo (Version
6, Version
7) [(Position, Module)]
horizontal [(Position, Module)]
-> [(Position, Module)] -> [(Position, Module)]
forall a. [a] -> [a] -> [a]
++ Position -> [(Position, Module)] -> [(Position, Module)]
moveTo (Version
7, Version
6) [(Position, Module)]
vertical
  where
    s :: Version
s = Version -> Version
size Version
v

darkModule :: Version -> [(Position, Module)]
darkModule :: Version -> [(Position, Module)]
darkModule Version
v = [(((Version
4 Version -> Version -> Version
forall a. Num a => a -> a -> a
* Version
v) Version -> Version -> Version
forall a. Num a => a -> a -> a
+ Version
9, Version
8), Module
Black)]

separators :: Version -> [(Position, Module)]
separators :: Version -> [(Position, Module)]
separators Version
v = do
  let topLeft :: [(Position, Module)]
topLeft = [((Version
i, Version
7), Module
White) | Version
i <- [Version
0 .. Version
7]] [(Position, Module)]
-> [(Position, Module)] -> [(Position, Module)]
forall a. [a] -> [a] -> [a]
++ [((Version
7, Version
i), Module
White) | Version
i <- [Version
0 .. Version
6]]
  let topRight :: [(Position, Module)]
topRight = [((Version
i, Version
s Version -> Version -> Version
forall a. Num a => a -> a -> a
- Version
8), Module
White) | Version
i <- [Version
0 .. Version
7]] [(Position, Module)]
-> [(Position, Module)] -> [(Position, Module)]
forall a. [a] -> [a] -> [a]
++ [((Version
7, Version
i), Module
White) | Version
i <- [Version
s Version -> Version -> Version
forall a. Num a => a -> a -> a
-Version
7 .. Version
s Version -> Version -> Version
forall a. Num a => a -> a -> a
-Version
1]]
  let bottomLeft :: [(Position, Module)]
bottomLeft = [((Version
s Version -> Version -> Version
forall a. Num a => a -> a -> a
- Version
8, Version
i), Module
White) | Version
i <- [Version
0 .. Version
7]] [(Position, Module)]
-> [(Position, Module)] -> [(Position, Module)]
forall a. [a] -> [a] -> [a]
++ [((Version
i, Version
7), Module
White) | Version
i <- [Version
s Version -> Version -> Version
forall a. Num a => a -> a -> a
-Version
7 .. Version
s Version -> Version -> Version
forall a. Num a => a -> a -> a
-Version
1]]

  [(Position, Module)]
topLeft [(Position, Module)]
-> [(Position, Module)] -> [(Position, Module)]
forall a. [a] -> [a] -> [a]
++ [(Position, Module)]
topRight [(Position, Module)]
-> [(Position, Module)] -> [(Position, Module)]
forall a. [a] -> [a] -> [a]
++ [(Position, Module)]
bottomLeft
  where
    s :: Version
s = Version -> Version
size Version
v