{-# 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 :: 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
  MQRImage1 (PrimState m) -> m ()
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
  [(Int, Int)] -> ((Int, Int) -> m ()) -> m ()
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] (((Int, Int) -> m ()) -> m ()) -> ((Int, Int) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Int
x,Int
y) ->
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxAlignmentPosition Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxAlignmentPosition) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      MQRImage1 (PrimState m) -> Int -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> m ()
drawAlignmentPattern MQRImage1 (PrimState m)
img Int
x Int
y
  MQRImage1 (PrimState m) -> Int -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> m ()
drawFinderPattern MQRImage1 (PrimState m)
img Int
3 Int
3
  MQRImage1 (PrimState m) -> Int -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> m ()
drawFinderPattern MQRImage1 (PrimState m)
img (Int
mqrImage1SizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
4) Int
3
  MQRImage1 (PrimState m) -> Int -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> m ()
drawFinderPattern MQRImage1 (PrimState m)
img Int
3 (Int
mqrImage1SizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
4)
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version -> Int
unVersion Version
mqrImage1Version Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
7) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    MQRImage1 (PrimState m) -> m ()
forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> m ()
drawVersion MQRImage1 (PrimState m)
img
  MQRImage1 (PrimState m) -> m ()
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = ([], Int
0)
      | Bool
otherwise =
        let
          numAlign :: Int
numAlign = Version -> Int
unVersion Version
ver Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
          step :: Int
step
            | Version -> Int
unVersion Version
ver Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 = Int
26
            | Bool
otherwise = (Version -> Int
unVersion Version
ver Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numAlign Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numAlign Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
          pos :: Int -> Int
pos Int
p = Version -> Int
unVersion Version
ver Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
step
        in
          (Int
6 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [ Int -> Int
pos Int
p | Int
p <- [Int
0 .. Int
numAlignInt -> Int -> Int
forall 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 :: 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
..} =
  [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
mqrImage1SizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
    MQRImage1 (PrimState m) -> Int -> Int -> Bool -> m ()
forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> Bool -> m ()
setFunctionModule MQRImage1 (PrimState m)
img Int
6 Int
i (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
    MQRImage1 (PrimState m) -> Int -> Int -> Bool -> m ()
forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> Bool -> m ()
setFunctionModule MQRImage1 (PrimState m)
img Int
i Int
6 (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2 Int -> Int -> Bool
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 :: MQRImage1 (PrimState m) -> Int -> Int -> m ()
drawAlignmentPattern MQRImage1 (PrimState m)
img Int
x Int
y =
  [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [-Int
2 .. Int
2] ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Int
i ->
    [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [-Int
2 .. Int
2] ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Int
j ->
      MQRImage1 (PrimState m) -> Int -> Int -> Bool -> m ()
forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> Bool -> m ()
setFunctionModule MQRImage1 (PrimState m)
img (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j) (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) ((Int -> Int
forall a. Num a => a -> a
abs Int
i Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int -> Int
forall a. Num a => a -> a
abs Int
j) Int -> Int -> Bool
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 :: 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 =
  [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [-Int
4 .. Int
4] ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Int
i ->
    [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [-Int
4 .. Int
4] ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Int
j -> do
      let
        dist :: Int
dist = Int -> Int
forall a. Num a => a -> a
abs Int
i Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int -> Int
forall a. Num a => a -> a
abs Int
j
        x' :: Int
x' = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j
        y' :: Int
y' = Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
x' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
x' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
mqrImage1Size Bool -> Bool -> Bool
&& Int
y' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
y' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
mqrImage1Size) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        MQRImage1 (PrimState m) -> Int -> Int -> Bool -> m ()
forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> Bool -> m ()
setFunctionModule MQRImage1 (PrimState m)
img (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j) (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) (Int
dist Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
2 Bool -> Bool -> Bool
&& Int
dist Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
4)

-- | Draw the version information into the image
drawVersion :: PrimMonad m => MQRImage1 (PrimState m) -> m ()
drawVersion :: 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' = Int -> Int -> (Int -> Int) -> Int
forall a. Int -> a -> (a -> a) -> a
iterateN Int
12 Int
v (\Int
r -> (Int
r Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` ((Int
r Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
11) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
0x1F25))
    da :: Int
da = (Int
v Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
12) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
rem'
  -- Draw two copies
  [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
17] ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
    let
      d :: Bool
d = Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int
da Int
i
      a :: Int
a = Int
mqrImage1Size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
11 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3)
      b :: Int
b = Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
3
    MQRImage1 (PrimState m) -> Int -> Int -> Bool -> m ()
forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> Bool -> m ()
setFunctionModule MQRImage1 (PrimState m)
img Int
a Int
b Bool
d
    MQRImage1 (PrimState m) -> Int -> Int -> Bool -> m ()
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 :: 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 = MVector (PrimState m) Bool -> Int -> Bool -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MUV.write MVector (PrimState m) Bool
mqrImage1Fixed (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
mqrImage1Size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x) Bool
True

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

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

  -- Draw fixed set module
  MQRImage1 (PrimState m) -> Int -> Int -> Bool -> m ()
forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> Int -> Int -> Bool -> m ()
setFunctionModule MQRImage1 (PrimState m)
img Int
8 (Int
mqrImage1Size Int -> Int -> Int
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 :: 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 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
3) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Mask -> Int
forall a. Enum a => a -> Int
fromEnum Mask
m
    rem' :: Int
rem' = Int -> Int -> (Int -> Int) -> Int
forall a. Int -> a -> (a -> a) -> a
iterateN Int
10 Int
daSource (\Int
r -> (Int
r Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` ((Int
r Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
9) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
0x537))
    da :: Int
da = ((Int
daSource Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
10) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
rem') Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` Int
0x5412
    fn :: Int -> Int -> Bool -> m ()
fn Int
x Int
y = MVector (PrimState m) Bool -> Int -> Bool -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MUV.write MVector (PrimState m) Bool
mqrImage3Data (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
mqrImage3Size)

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

  -- Draw second copy
  [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
7] ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Int
i ->
    Int -> Int -> Bool -> m ()
fn (Int
mqrImage3Size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Int
8 (Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int
da Int
i)
  [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
8 .. Int
14] ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Int
i ->
    Int -> Int -> Bool -> m ()
fn Int
8 (Int
mqrImage3Size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
15 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) (Int -> Int -> Bool
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 :: 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
  [Bool] -> [Int] -> ([Bool] -> Int -> m [Bool]) -> m ()
forall (f :: * -> *) (t :: * -> *) a a.
(Foldable t, Monad f) =>
a -> t a -> (a -> a -> f a) -> f ()
ffoldlM_ [Bool]
d ([Int
mqrImage2SizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, Int
mqrImage2SizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
3 .. Int
8] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
5, Int
3, Int
1]) (([Bool] -> Int -> m [Bool]) -> m ())
-> ([Bool] -> Int -> m [Bool]) -> m ()
forall a b. (a -> b) -> a -> b
$ \[Bool]
d' Int
right -> do
    let
      upward :: Bool
upward = ((Int
right Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
2) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    [Bool] -> [Int] -> ([Bool] -> Int -> m [Bool]) -> m [Bool]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
b -> t a -> (b -> a -> m b) -> m b
ffoldlM [Bool]
d' ([Int] -> [Int] -> Bool -> [Int]
forall a. a -> a -> Bool -> a
bool [Int
0 .. Int
mqrImage2SizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] [Int
mqrImage2SizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, Int
mqrImage2SizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2 .. Int
0] Bool
upward) (([Bool] -> Int -> m [Bool]) -> m [Bool])
-> ([Bool] -> Int -> m [Bool]) -> m [Bool]
forall a b. (a -> b) -> a -> b
$ \[Bool]
d'' Int
y ->
      [Bool] -> [Int] -> ([Bool] -> Int -> m [Bool]) -> m [Bool]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
b -> t a -> (b -> a -> m b) -> m b
ffoldlM [Bool]
d'' [Int
right, Int
rightInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] (([Bool] -> Int -> m [Bool]) -> m [Bool])
-> ([Bool] -> Int -> m [Bool]) -> m [Bool]
forall a b. (a -> b) -> a -> b
$ \[Bool]
d''' Int
x -> do
        let
          f :: Bool
f = Vector Bool
mqrImage2Fixed Vector Bool -> Int -> Bool
forall a. Unbox a => Vector a -> Int -> a
UV.! (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
mqrImage2Size)
        case [Bool]
d''' of
          (Bool
isBlack:[Bool]
xs)
            | Bool -> Bool
not Bool
f -> do
              Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isBlack (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                MVector (PrimState m) Bool -> Int -> Bool -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MUV.write MVector (PrimState m) Bool
mqrImage2Data (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
mqrImage2Size) Bool
True -- all unused pixels are already white and do not need to be set
              [Bool] -> m [Bool]
forall (m :: * -> *) a. Monad m => a -> m a
return [Bool]
xs
          [Bool]
xxs -> [Bool] -> m [Bool]
forall (m :: * -> *) a. Monad m => a -> m a
return [Bool]
xxs
  () -> m ()
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 = (b -> a -> m b) -> b -> t a -> m b
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 = f a -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (f a -> f ()) -> f a -> f ()
forall a b. (a -> b) -> a -> b
$ (a -> a -> f a) -> a -> t a -> f a
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 :: 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
  MVector (PrimState m) Bool -> Int -> Bool -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MUV.write MVector (PrimState m) Bool
mqrImage1Data (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
mqrImage1Size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x) Bool
isBlack
  MVector (PrimState m) Bool -> Int -> Bool -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MUV.write MVector (PrimState m) Bool
mqrImage1Fixed (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
mqrImage1Size Int -> Int -> Int
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 :: Int -> a -> (a -> a) -> a
iterateN Int
n0 a
i0 a -> a
f = Int -> a -> a
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 t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = a
i
      | Bool
otherwise = t -> a -> a
go (t
nt -> t -> t
forall 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