module Kewar.Layout.Data (dataBits) where

import Kewar.Layout.Types (Module (..), Position)
import Kewar.Types (BitString)

dataBits :: Int -> BitString -> [Position] -> [(Position, Module)]
dataBits :: Int -> BitString -> [Position] -> [(Position, Module)]
dataBits Int
s BitString
bitString [Position]
forbiddenLocations = do
  (Position -> Char -> (Position, Module))
-> [Position] -> BitString -> [(Position, Module)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Position
l Char
b -> (Position
l, if Char
b Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0' then Module
White else Module
Black)) [Position]
allowedLocations BitString
bitString
  where
    n :: Int
n = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
    line :: (a, Bool) -> [(a, Int)]
line (a
x, Bool
r) =
      [ (a, Int)
c | Int
y <- if Bool
r then [Int
n, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 .. Int
0] else [Int
0 .. Int
n], (a, Int)
c <- [(a
x, Int
y), (a
x a -> a -> a
forall a. Num a => a -> a -> a
-a
1, Int
y)]
      ]
    columns :: [(Int, Bool)]
columns =
      [Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip
        ([Int
n, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2 .. Int
8] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
5, Int
3, Int
1])
        ([Bool] -> [Bool]
forall a. [a] -> [a]
cycle [Bool
True, Bool
False])
    cs :: [Position]
cs = [(Int, Bool)]
columns [(Int, Bool)] -> ((Int, Bool) -> [Position]) -> [Position]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int, Bool) -> [Position]
forall a. Num a => (a, Bool) -> [(a, Int)]
line
    allowedLocations :: [Position]
allowedLocations = (Position -> Bool) -> [Position] -> [Position]
forall a. (a -> Bool) -> [a] -> [a]
filter (Position -> [Position] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Position]
forbiddenLocations) [Position]
cs