{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards #-}

module Codec.QRCode.Code.Image
  ( drawFunctionPatterns
  , drawFormatBits
  , drawCodeWords
  ) where

import           Codec.QRCode.Base

import           Control.Monad.Primitive      (PrimMonad, PrimState)
import qualified Data.Vector.Unboxed          as UV
import qualified Data.Vector.Unboxed.Mutable  as MUV

import           Codec.QRCode.Data.ErrorLevel
import           Codec.QRCode.Data.Mask
import           Codec.QRCode.Data.MQRImage
import           Codec.QRCode.Data.Version

--
-- Draw (almost) all function patterns into an image
--

-- | Draw all function patterns
drawFunctionPatterns :: PrimMonad m => MQRImage1 (PrimState m) -> m ()
drawFunctionPatterns :: forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> m ()
drawFunctionPatterns img :: MQRImage1 (PrimState m)
img@MQRImage1{Int
MVector (PrimState m) Bool
ErrorLevel
Version
mqrImage1ErrorLevel :: forall s. MQRImage1 s -> ErrorLevel
mqrImage1Version :: forall s. MQRImage1 s -> Version
mqrImage1Fixed :: forall s. MQRImage1 s -> MVector s Bool
mqrImage1Data :: forall s. MQRImage1 s -> MVector s Bool
mqrImage1Size :: forall s. MQRImage1 s -> Int
mqrImage1ErrorLevel :: ErrorLevel
mqrImage1Version :: Version
mqrImage1Fixed :: MVector (PrimState m) Bool
mqrImage1Data :: MVector (PrimState m) Bool
mqrImage1Size :: Int
..} = do
  forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> m ()
drawTimingPatterns MQRImage1 (PrimState m)
img -- will be overwritten by finder and alignment patterns
  let
    ([Int]
alignmentPatternPositions, Int
maxAlignmentPosition) = Version -> ([Int], Int)
calculateAlignmentPatternPositions Version
mqrImage1Version
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int
x,Int
y) | Int
x <- [Int]
alignmentPatternPositions, Int
y <- [Int]
alignmentPatternPositions] forall a b. (a -> b) -> a -> b
$ \(Int
x,Int
y) ->
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
x forall a. Eq a => a -> a -> Bool
== Int
6 Bool -> Bool -> Bool
&& Int
y forall a. Eq a => a -> a -> Bool
== Int
6 Bool -> Bool -> Bool
|| Int
x forall a. Eq a => a -> a -> Bool
== Int
maxAlignmentPosition Bool -> Bool -> Bool
&& Int
y forall a. Eq a => a -> a -> Bool
== Int
6 Bool -> Bool -> Bool
|| Int
x forall a. Eq a => a -> a -> Bool
== Int
6 Bool -> Bool -> Bool
&& Int
y forall a. Eq a => a -> a -> Bool
== Int
maxAlignmentPosition) forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> m ()
drawAlignmentPattern MQRImage1 (PrimState m)
img Int
x Int
y
  forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> m ()
drawFinderPattern MQRImage1 (PrimState m)
img Int
3 Int
3
  forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> m ()
drawFinderPattern MQRImage1 (PrimState m)
img (Int
mqrImage1Sizeforall a. Num a => a -> a -> a
-Int
4) Int
3
  forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> m ()
drawFinderPattern MQRImage1 (PrimState m)
img Int
3 (Int
mqrImage1Sizeforall a. Num a => a -> a -> a
-Int
4)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version -> Int
unVersion Version
mqrImage1Version forall a. Ord a => a -> a -> Bool
>= Int
7) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> m ()
drawVersion MQRImage1 (PrimState m)
img
  forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> m ()
reserveFormatBits MQRImage1 (PrimState m)
img -- will be overwritten later with drawFormatBits
  where
    -- | Calculate all alignment pattern positions
    calculateAlignmentPatternPositions :: Version -> ([Int], Int)
    calculateAlignmentPatternPositions :: Version -> ([Int], Int)
calculateAlignmentPatternPositions Version
ver
      | Version -> Int
unVersion Version
ver forall a. Eq a => a -> a -> Bool
== Int
1 = ([], Int
0)
      | Bool
otherwise =
        let
          numAlign :: Int
numAlign = Version -> Int
unVersion Version
ver forall a. Integral a => a -> a -> a
`div` Int
7 forall a. Num a => a -> a -> a
+ Int
2
          step :: Int
step
            | Version -> Int
unVersion Version
ver forall a. Eq a => a -> a -> Bool
== Int
32 = Int
26
            | Bool
otherwise = (Version -> Int
unVersion Version
ver forall a. Num a => a -> a -> a
* Int
4 forall a. Num a => a -> a -> a
+ Int
numAlign forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
1) forall a. Integral a => a -> a -> a
`div` (Int
2 forall a. Num a => a -> a -> a
* Int
numAlign forall a. Num a => a -> a -> a
- Int
2) forall a. Num a => a -> a -> a
* Int
2
          pos :: Int -> Int
pos Int
p = Version -> Int
unVersion Version
ver forall a. Num a => a -> a -> a
* Int
4 forall a. Num a => a -> a -> a
+ Int
10 forall a. Num a => a -> a -> a
- Int
p forall a. Num a => a -> a -> a
* Int
step
        in
          (Int
6 forall a. a -> [a] -> [a]
: [ Int -> Int
pos Int
p | Int
p <- [Int
0 .. Int
numAlignforall a. Num a => a -> a -> a
-Int
2]], Int -> Int
pos Int
0)

-- | Draw both timing patterns (alternate black/white modules)
drawTimingPatterns :: PrimMonad m => MQRImage1 (PrimState m) -> m ()
drawTimingPatterns :: forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> m ()
drawTimingPatterns img :: MQRImage1 (PrimState m)
img@MQRImage1{Int
MVector (PrimState m) Bool
ErrorLevel
Version
mqrImage1ErrorLevel :: ErrorLevel
mqrImage1Version :: Version
mqrImage1Fixed :: MVector (PrimState m) Bool
mqrImage1Data :: MVector (PrimState m) Bool
mqrImage1Size :: Int
mqrImage1ErrorLevel :: forall s. MQRImage1 s -> ErrorLevel
mqrImage1Version :: forall s. MQRImage1 s -> Version
mqrImage1Fixed :: forall s. MQRImage1 s -> MVector s Bool
mqrImage1Data :: forall s. MQRImage1 s -> MVector s Bool
mqrImage1Size :: forall s. MQRImage1 s -> Int
..} =
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
mqrImage1Sizeforall a. Num a => a -> a -> a
-Int
1] forall a b. (a -> b) -> a -> b
$ \Int
i -> do
    forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> Bool -> m ()
setFunctionModule MQRImage1 (PrimState m)
img Int
6 Int
i (Int
i forall a. Integral a => a -> a -> a
`mod` Int
2 forall a. Eq a => a -> a -> Bool
== Int
0)
    forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> Bool -> m ()
setFunctionModule MQRImage1 (PrimState m)
img Int
i Int
6 (Int
i forall a. Integral a => a -> a -> a
`mod` Int
2 forall a. Eq a => a -> a -> Bool
== Int
0)

-- | Draws a 5*5 alignment pattern, with the center module at (x, y)
drawAlignmentPattern :: PrimMonad m => MQRImage1 (PrimState m) -> Int -> Int -> m ()
drawAlignmentPattern :: forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> m ()
drawAlignmentPattern MQRImage1 (PrimState m)
img Int
x Int
y =
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [-Int
2 .. Int
2] forall a b. (a -> b) -> a -> b
$ \Int
i ->
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [-Int
2 .. Int
2] forall a b. (a -> b) -> a -> b
$ \Int
j ->
      forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> Bool -> m ()
setFunctionModule MQRImage1 (PrimState m)
img (Int
xforall a. Num a => a -> a -> a
+Int
j) (Int
yforall a. Num a => a -> a -> a
+Int
i) ((forall a. Num a => a -> a
abs Int
i forall a. Ord a => a -> a -> a
`max` forall a. Num a => a -> a
abs Int
j) forall a. Eq a => a -> a -> Bool
/= Int
1)

-- | Draws a 9*9 finder pattern including the border separator, with the center module at (x, y)
drawFinderPattern :: PrimMonad m => MQRImage1 (PrimState m) -> Int -> Int -> m ()
drawFinderPattern :: forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> m ()
drawFinderPattern img :: MQRImage1 (PrimState m)
img@MQRImage1{Int
MVector (PrimState m) Bool
ErrorLevel
Version
mqrImage1ErrorLevel :: ErrorLevel
mqrImage1Version :: Version
mqrImage1Fixed :: MVector (PrimState m) Bool
mqrImage1Data :: MVector (PrimState m) Bool
mqrImage1Size :: Int
mqrImage1ErrorLevel :: forall s. MQRImage1 s -> ErrorLevel
mqrImage1Version :: forall s. MQRImage1 s -> Version
mqrImage1Fixed :: forall s. MQRImage1 s -> MVector s Bool
mqrImage1Data :: forall s. MQRImage1 s -> MVector s Bool
mqrImage1Size :: forall s. MQRImage1 s -> Int
..} Int
x Int
y =
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [-Int
4 .. Int
4] forall a b. (a -> b) -> a -> b
$ \Int
i ->
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [-Int
4 .. Int
4] forall a b. (a -> b) -> a -> b
$ \Int
j -> do
      let
        dist :: Int
dist = forall a. Num a => a -> a
abs Int
i forall a. Ord a => a -> a -> a
`max` forall a. Num a => a -> a
abs Int
j
        x' :: Int
x' = Int
x forall a. Num a => a -> a -> a
+ Int
j
        y' :: Int
y' = Int
y forall a. Num a => a -> a -> a
+ Int
i
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
x' forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
x' forall a. Ord a => a -> a -> Bool
< Int
mqrImage1Size Bool -> Bool -> Bool
&& Int
y' forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
y' forall a. Ord a => a -> a -> Bool
< Int
mqrImage1Size) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> Bool -> m ()
setFunctionModule MQRImage1 (PrimState m)
img (Int
xforall a. Num a => a -> a -> a
+Int
j) (Int
yforall a. Num a => a -> a -> a
+Int
i) (Int
dist forall a. Eq a => a -> a -> Bool
/= Int
2 Bool -> Bool -> Bool
&& Int
dist forall a. Eq a => a -> a -> Bool
/= Int
4)

-- | Draw the version information into the image
drawVersion :: PrimMonad m => MQRImage1 (PrimState m) -> m ()
drawVersion :: forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> m ()
drawVersion img :: MQRImage1 (PrimState m)
img@MQRImage1{Int
MVector (PrimState m) Bool
ErrorLevel
Version
mqrImage1ErrorLevel :: ErrorLevel
mqrImage1Version :: Version
mqrImage1Fixed :: MVector (PrimState m) Bool
mqrImage1Data :: MVector (PrimState m) Bool
mqrImage1Size :: Int
mqrImage1ErrorLevel :: forall s. MQRImage1 s -> ErrorLevel
mqrImage1Version :: forall s. MQRImage1 s -> Version
mqrImage1Fixed :: forall s. MQRImage1 s -> MVector s Bool
mqrImage1Data :: forall s. MQRImage1 s -> MVector s Bool
mqrImage1Size :: forall s. MQRImage1 s -> Int
..} = do
  let
    v :: Int
v = Version -> Int
unVersion Version
mqrImage1Version
  -- Calculate error correction code and pack bits
    rem' :: Int
rem' = forall a. Int -> a -> (a -> a) -> a
iterateN Int
12 Int
v (\Int
r -> (Int
r forall a. Bits a => a -> Int -> a
`shiftL` Int
1) forall a. Bits a => a -> a -> a
`xor` ((Int
r forall a. Bits a => a -> Int -> a
`shiftR` Int
11) forall a. Num a => a -> a -> a
* Int
0x1F25))
    da :: Int
da = (Int
v forall a. Bits a => a -> Int -> a
`shiftL` Int
12) forall a. Bits a => a -> a -> a
.|. Int
rem'
  -- Draw two copies
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
17] forall a b. (a -> b) -> a -> b
$ \Int
i -> do
    let
      d :: Bool
d = forall a. Bits a => a -> Int -> Bool
testBit Int
da Int
i
      a :: Int
a = Int
mqrImage1Size forall a. Num a => a -> a -> a
- Int
11 forall a. Num a => a -> a -> a
+ (Int
i forall a. Integral a => a -> a -> a
`mod` Int
3)
      b :: Int
b = Int
i forall a. Integral a => a -> a -> a
`div` Int
3
    forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> Bool -> m ()
setFunctionModule MQRImage1 (PrimState m)
img Int
a Int
b Bool
d
    forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> Bool -> m ()
setFunctionModule MQRImage1 (PrimState m)
img Int
b Int
a Bool
d

-- | Mark all modules which will be used by the format bits as a function pattern
--   (but don't actually write anything into it yet).
reserveFormatBits :: PrimMonad m => MQRImage1 (PrimState m) -> m ()
reserveFormatBits :: forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> m ()
reserveFormatBits img :: MQRImage1 (PrimState m)
img@MQRImage1{Int
MVector (PrimState m) Bool
ErrorLevel
Version
mqrImage1ErrorLevel :: ErrorLevel
mqrImage1Version :: Version
mqrImage1Fixed :: MVector (PrimState m) Bool
mqrImage1Data :: MVector (PrimState m) Bool
mqrImage1Size :: Int
mqrImage1ErrorLevel :: forall s. MQRImage1 s -> ErrorLevel
mqrImage1Version :: forall s. MQRImage1 s -> Version
mqrImage1Fixed :: forall s. MQRImage1 s -> MVector s Bool
mqrImage1Data :: forall s. MQRImage1 s -> MVector s Bool
mqrImage1Size :: forall s. MQRImage1 s -> Int
..} = do
  let
    fn :: Int -> Int -> m ()
fn Int
x Int
y = forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MUV.write MVector (PrimState m) Bool
mqrImage1Fixed (Int
y forall a. Num a => a -> a -> a
* Int
mqrImage1Size forall a. Num a => a -> a -> a
+ Int
x) Bool
True

  -- Reserve first copy
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
5] forall a b. (a -> b) -> a -> b
$ \Int
i ->
    Int -> Int -> m ()
fn Int
8 Int
i
  Int -> Int -> m ()
fn Int
8 Int
7
  Int -> Int -> m ()
fn Int
8 Int
8
  Int -> Int -> m ()
fn Int
7 Int
8
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
9 .. Int
14] forall a b. (a -> b) -> a -> b
$ \Int
i ->
    Int -> Int -> m ()
fn (Int
14 forall a. Num a => a -> a -> a
- Int
i) Int
8

  -- Reserve second copy
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
7] forall a b. (a -> b) -> a -> b
$ \Int
i ->
    Int -> Int -> m ()
fn (Int
mqrImage1Size forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
- Int
i) Int
8
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
8 .. Int
14] forall a b. (a -> b) -> a -> b
$ \Int
i ->
    Int -> Int -> m ()
fn Int
8 (Int
mqrImage1Size forall a. Num a => a -> a -> a
- Int
15 forall a. Num a => a -> a -> a
+ Int
i)

  -- Draw fixed set module
  forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> Bool -> m ()
setFunctionModule MQRImage1 (PrimState m)
img Int
8 (Int
mqrImage1Size forall a. Num a => a -> a -> a
- Int
8) Bool
True

--
-- Functions to be used later (once the format / data is determined)
--

-- | Draw the actual format bits into the image
drawFormatBits :: PrimMonad m => MQRImage3 (PrimState m) -> Mask -> m ()
drawFormatBits :: forall (m :: * -> *).
PrimMonad m =>
MQRImage3 (PrimState m) -> Mask -> m ()
drawFormatBits MQRImage3{Int
MVector (PrimState m) Bool
Vector Bool
ErrorLevel
Version
mqrImage3ErrorLevel :: forall s. MQRImage3 s -> ErrorLevel
mqrImage3Version :: forall s. MQRImage3 s -> Version
mqrImage3Fixed :: forall s. MQRImage3 s -> Vector Bool
mqrImage3Data :: forall s. MQRImage3 s -> MVector s Bool
mqrImage3Size :: forall s. MQRImage3 s -> Int
mqrImage3ErrorLevel :: ErrorLevel
mqrImage3Version :: Version
mqrImage3Fixed :: Vector Bool
mqrImage3Data :: MVector (PrimState m) Bool
mqrImage3Size :: Int
..} Mask
m = do
  let
    daSource :: Int
daSource = (ErrorLevel -> Int
errorLevelMask ErrorLevel
mqrImage3ErrorLevel forall a. Bits a => a -> Int -> a
`shiftL` Int
3) forall a. Bits a => a -> a -> a
.|. forall a. Enum a => a -> Int
fromEnum Mask
m
    rem' :: Int
rem' = forall a. Int -> a -> (a -> a) -> a
iterateN Int
10 Int
daSource (\Int
r -> (Int
r forall a. Bits a => a -> Int -> a
`shiftL` Int
1) forall a. Bits a => a -> a -> a
`xor` ((Int
r forall a. Bits a => a -> Int -> a
`shiftR` Int
9) forall a. Num a => a -> a -> a
* Int
0x537))
    da :: Int
da = ((Int
daSource forall a. Bits a => a -> Int -> a
`shiftL` Int
10) forall a. Bits a => a -> a -> a
.|. Int
rem') forall a. Bits a => a -> a -> a
`xor` Int
0x5412
    fn :: Int -> Int -> Bool -> m ()
fn Int
x Int
y = forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MUV.write MVector (PrimState m) Bool
mqrImage3Data (Int
x forall a. Num a => a -> a -> a
+ Int
y forall a. Num a => a -> a -> a
* Int
mqrImage3Size)

  -- Draw first copy
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
5] forall a b. (a -> b) -> a -> b
$ \Int
i ->
    Int -> Int -> Bool -> m ()
fn Int
8 Int
i (forall a. Bits a => a -> Int -> Bool
testBit Int
da Int
i)
  Int -> Int -> Bool -> m ()
fn Int
8 Int
7 (forall a. Bits a => a -> Int -> Bool
testBit Int
da Int
6)
  Int -> Int -> Bool -> m ()
fn Int
8 Int
8 (forall a. Bits a => a -> Int -> Bool
testBit Int
da Int
7)
  Int -> Int -> Bool -> m ()
fn Int
7 Int
8 (forall a. Bits a => a -> Int -> Bool
testBit Int
da Int
8)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
9 .. Int
14] forall a b. (a -> b) -> a -> b
$ \Int
i ->
    Int -> Int -> Bool -> m ()
fn (Int
14 forall a. Num a => a -> a -> a
- Int
i) Int
8 (forall a. Bits a => a -> Int -> Bool
testBit Int
da Int
i)

  -- Draw second copy
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
7] forall a b. (a -> b) -> a -> b
$ \Int
i ->
    Int -> Int -> Bool -> m ()
fn (Int
mqrImage3Size forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
- Int
i) Int
8 (forall a. Bits a => a -> Int -> Bool
testBit Int
da Int
i)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
8 .. Int
14] forall a b. (a -> b) -> a -> b
$ \Int
i ->
    Int -> Int -> Bool -> m ()
fn Int
8 (Int
mqrImage3Size forall a. Num a => a -> a -> a
- Int
15 forall a. Num a => a -> a -> a
+ Int
i) (forall a. Bits a => a -> Int -> Bool
testBit Int
da Int
i)

-- | Draw the code words (data and error correction) into the image
drawCodeWords :: PrimMonad m => MQRImage2 (PrimState m) -> [Bool] -> m ()
drawCodeWords :: forall (m :: * -> *).
PrimMonad m =>
MQRImage2 (PrimState m) -> [Bool] -> m ()
drawCodeWords MQRImage2{Int
MVector (PrimState m) Bool
Vector Bool
ErrorLevel
Version
mqrImage2ErrorLevel :: forall s. MQRImage2 s -> ErrorLevel
mqrImage2Version :: forall s. MQRImage2 s -> Version
mqrImage2Fixed :: forall s. MQRImage2 s -> Vector Bool
mqrImage2Data :: forall s. MQRImage2 s -> MVector s Bool
mqrImage2Size :: forall s. MQRImage2 s -> Int
mqrImage2ErrorLevel :: ErrorLevel
mqrImage2Version :: Version
mqrImage2Fixed :: Vector Bool
mqrImage2Data :: MVector (PrimState m) Bool
mqrImage2Size :: Int
..} [Bool]
d = do
  forall {f :: * -> *} {t :: * -> *} {a} {a}.
(Foldable t, Monad f) =>
a -> t a -> (a -> a -> f a) -> f ()
ffoldlM_ [Bool]
d ([Int
mqrImage2Sizeforall a. Num a => a -> a -> a
-Int
1, Int
mqrImage2Sizeforall a. Num a => a -> a -> a
-Int
3 .. Int
8] forall a. [a] -> [a] -> [a]
++ [Int
5, Int
3, Int
1]) forall a b. (a -> b) -> a -> b
$ \[Bool]
d' Int
right -> do
    let
      upward :: Bool
upward = ((Int
right forall a. Num a => a -> a -> a
+ Int
1) forall a. Bits a => a -> a -> a
.&. Int
2) forall a. Eq a => a -> a -> Bool
== Int
0
    forall {t :: * -> *} {m :: * -> *} {b} {a}.
(Foldable t, Monad m) =>
b -> t a -> (b -> a -> m b) -> m b
ffoldlM [Bool]
d' (forall a. a -> a -> Bool -> a
bool [Int
0 .. Int
mqrImage2Sizeforall a. Num a => a -> a -> a
-Int
1] [Int
mqrImage2Sizeforall a. Num a => a -> a -> a
-Int
1, Int
mqrImage2Sizeforall a. Num a => a -> a -> a
-Int
2 .. Int
0] Bool
upward) forall a b. (a -> b) -> a -> b
$ \[Bool]
d'' Int
y ->
      forall {t :: * -> *} {m :: * -> *} {b} {a}.
(Foldable t, Monad m) =>
b -> t a -> (b -> a -> m b) -> m b
ffoldlM [Bool]
d'' [Int
right, Int
rightforall a. Num a => a -> a -> a
-Int
1] forall a b. (a -> b) -> a -> b
$ \[Bool]
d''' Int
x -> do
        let
          f :: Bool
f = Vector Bool
mqrImage2Fixed forall a. Unbox a => Vector a -> Int -> a
UV.! (Int
x forall a. Num a => a -> a -> a
+ Int
y forall a. Num a => a -> a -> a
* Int
mqrImage2Size)
        case [Bool]
d''' of
          (Bool
isBlack:[Bool]
xs)
            | Bool -> Bool
not Bool
f -> do
              forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isBlack forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MUV.write MVector (PrimState m) Bool
mqrImage2Data (Int
x forall a. Num a => a -> a -> a
+ Int
y forall a. Num a => a -> a -> a
* Int
mqrImage2Size) Bool
True -- all unused pixels are already white and do not need to be set
              forall (m :: * -> *) a. Monad m => a -> m a
return [Bool]
xs
          [Bool]
xxs -> forall (m :: * -> *) a. Monad m => a -> m a
return [Bool]
xxs
  forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    ffoldlM :: b -> t a -> (b -> a -> m b) -> m b
ffoldlM b
d' t a
i b -> a -> m b
f = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM b -> a -> m b
f b
d' t a
i
    ffoldlM_ :: a -> t a -> (a -> a -> f a) -> f ()
ffoldlM_ a
d' t a
i a -> a -> f a
f = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM a -> a -> f a
f a
d' t a
i

--
-- Helper
--

-- | Sets the color of a module and marks it as a function module
setFunctionModule :: PrimMonad m => MQRImage1 (PrimState m) -> Int -> Int -> Bool -> m ()
{-# INLINABLE setFunctionModule #-}
setFunctionModule :: forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> Bool -> m ()
setFunctionModule MQRImage1{Int
MVector (PrimState m) Bool
ErrorLevel
Version
mqrImage1ErrorLevel :: ErrorLevel
mqrImage1Version :: Version
mqrImage1Fixed :: MVector (PrimState m) Bool
mqrImage1Data :: MVector (PrimState m) Bool
mqrImage1Size :: Int
mqrImage1ErrorLevel :: forall s. MQRImage1 s -> ErrorLevel
mqrImage1Version :: forall s. MQRImage1 s -> Version
mqrImage1Fixed :: forall s. MQRImage1 s -> MVector s Bool
mqrImage1Data :: forall s. MQRImage1 s -> MVector s Bool
mqrImage1Size :: forall s. MQRImage1 s -> Int
..} Int
x Int
y Bool
isBlack = do
  forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MUV.write MVector (PrimState m) Bool
mqrImage1Data (Int
y forall a. Num a => a -> a -> a
* Int
mqrImage1Size forall a. Num a => a -> a -> a
+ Int
x) Bool
isBlack
  forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MUV.write MVector (PrimState m) Bool
mqrImage1Fixed (Int
y forall a. Num a => a -> a -> a
* Int
mqrImage1Size forall a. Num a => a -> a -> a
+ Int
x) Bool
True

-- | Execute an action n times
iterateN :: Int -> a -> (a -> a) -> a
{-# INLINABLE iterateN #-}
iterateN :: forall a. Int -> a -> (a -> a) -> a
iterateN Int
n0 a
i0 a -> a
f = forall {t}. (Ord t, Num t) => t -> a -> a
go Int
n0 a
i0
  where
    go :: t -> a -> a
go t
n a
i
      | t
n forall a. Ord a => a -> a -> Bool
<= t
0 = a
i
      | Bool
otherwise = t -> a -> a
go (t
nforall a. Num a => a -> a -> a
-t
1) (a -> a
f a
i)

-- | The mask value of an ErrorLevel
errorLevelMask :: ErrorLevel -> Int
errorLevelMask :: ErrorLevel -> Int
errorLevelMask ErrorLevel
L = Int
1
errorLevelMask ErrorLevel
M = Int
0
errorLevelMask ErrorLevel
Q = Int
3
errorLevelMask ErrorLevel
H = Int
2