{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Codec.QRCode.JuicyPixels
(
toImage
, toPngDataUrlBS
, toPngDataUrlS
, toPngDataUrlT
) where
import Codec.Picture (Image (..), Pixel8, encodePng)
import Data.Bool (bool)
import qualified Data.ByteString.Base64.Lazy as B64L
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BLC8
import qualified Data.Text.Lazy as TL
import qualified Data.Vector.Storable as SV
import qualified Data.Vector.Unboxed as UV
import Data.Word (Word8)
import Codec.QRCode (QRImage (..))
toImage
:: Int
-> Int
-> QRImage
-> Image Pixel8
toImage :: Int -> Int -> QRImage -> Image Pixel8
toImage Int
border Int
scale QRImage{Int
ErrorLevel
Vector Bool
qrVersion :: QRImage -> Int
qrErrorLevel :: QRImage -> ErrorLevel
qrImageSize :: QRImage -> Int
qrImageData :: QRImage -> Vector Bool
qrImageData :: Vector Bool
qrImageSize :: Int
qrErrorLevel :: ErrorLevel
qrVersion :: Int
..}
| Int
border forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
&& Int
scale forall a. Ord a => a -> a -> Bool
<= Int
1 =
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image Int
qrImageSize Int
qrImageSize (forall a. Storable a => [a] -> Vector a
SV.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> a -> Bool -> a
bool Pixel8
0xff Pixel8
0x00) (forall a. Unbox a => Vector a -> [a]
UV.toList Vector Bool
qrImageData))
toImage Int
border' Int
scale' QRImage{Int
ErrorLevel
Vector Bool
qrImageData :: Vector Bool
qrImageSize :: Int
qrErrorLevel :: ErrorLevel
qrVersion :: Int
qrVersion :: QRImage -> Int
qrErrorLevel :: QRImage -> ErrorLevel
qrImageSize :: QRImage -> Int
qrImageData :: QRImage -> Vector Bool
..} =
let
border :: Int
border = Int
border' forall a. Ord a => a -> a -> a
`max` Int
0
scale :: Int
scale = Int
scale' forall a. Ord a => a -> a -> a
`max` Int
1
size :: Int
size = (Int
qrImageSize forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
* Int
border) forall a. Num a => a -> a -> a
* Int
scale
in
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image Int
size Int
size (forall a. Storable a => [a] -> Vector a
SV.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ Int -> [[Pixel8]] -> [[Pixel8]]
doScale Int
scale forall a b. (a -> b) -> a -> b
$ Int -> [[Pixel8]] -> [[Pixel8]]
addBorder Int
border forall a b. (a -> b) -> a -> b
$ Vector Bool -> [[Pixel8]]
toMatrix Vector Bool
qrImageData)
where
toMatrix :: UV.Vector Bool -> [[Word8]]
toMatrix :: Vector Bool -> [[Pixel8]]
toMatrix Vector Bool
img
| forall a. Unbox a => Vector a -> Bool
UV.null Vector Bool
img = []
| Bool
otherwise =
let
(Vector Bool
h, Vector Bool
t) = forall a. Unbox a => Int -> Vector a -> (Vector a, Vector a)
UV.splitAt Int
qrImageSize Vector Bool
img
in
forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> a -> Bool -> a
bool Pixel8
0xff Pixel8
0x00) (forall a. Unbox a => Vector a -> [a]
UV.toList Vector Bool
h) forall a. a -> [a] -> [a]
: Vector Bool -> [[Pixel8]]
toMatrix Vector Bool
t
addBorder :: Int -> [[Word8]] -> [[Word8]]
addBorder :: Int -> [[Pixel8]] -> [[Pixel8]]
addBorder Int
0 [[Pixel8]]
img = [[Pixel8]]
img
addBorder Int
n [[Pixel8]]
img = [[Pixel8]]
topBottom forall a. [a] -> [a] -> [a]
++ [[Pixel8]] -> [[Pixel8]]
addLeftRight [[Pixel8]]
img forall a. [a] -> [a] -> [a]
++ [[Pixel8]]
topBottom
where
topBottom :: [[Pixel8]]
topBottom = [forall a. Int -> a -> [a]
replicate ((Int
qrImageSize forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
* Int
n) forall a. Num a => a -> a -> a
* Int
n) Pixel8
0xff]
leftRight :: [Pixel8]
leftRight = forall a. Int -> a -> [a]
replicate Int
n Pixel8
0xff
addLeftRight :: [[Pixel8]] -> [[Pixel8]]
addLeftRight = forall a b. (a -> b) -> [a] -> [b]
map (\ [Pixel8]
x -> [Pixel8]
leftRight forall a. [a] -> [a] -> [a]
++ [Pixel8]
x forall a. [a] -> [a] -> [a]
++ [Pixel8]
leftRight)
doScale :: Int -> [[Word8]] -> [[Word8]]
doScale :: Int -> [[Pixel8]] -> [[Pixel8]]
doScale Int
1 [[Pixel8]]
img = [[Pixel8]]
img
doScale Int
n [[Pixel8]]
img = [[Pixel8]] -> [[Pixel8]]
scaleV [[Pixel8]]
img
where
scaleV :: [[Word8]] -> [[Word8]]
scaleV :: [[Pixel8]] -> [[Pixel8]]
scaleV = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Int -> a -> [a]
replicate Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pixel8] -> [Pixel8]
scaleH)
scaleH :: [Word8] -> [Word8]
scaleH :: [Pixel8] -> [Pixel8]
scaleH = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Int -> a -> [a]
replicate Int
n)
toPngDataUrlBS :: Int -> Int -> QRImage -> BL.ByteString
toPngDataUrlBS :: Int -> Int -> QRImage -> ByteString
toPngDataUrlBS Int
border Int
scale QRImage
img = ByteString
"data:image/png;base64," ByteString -> ByteString -> ByteString
`BL.append` ByteString -> ByteString
B64L.encode (forall a. PngSavable a => Image a -> ByteString
encodePng forall a b. (a -> b) -> a -> b
$ Int -> Int -> QRImage -> Image Pixel8
toImage Int
border Int
scale QRImage
img)
toPngDataUrlS :: Int -> Int -> QRImage -> String
{-# INLINE toPngDataUrlS #-}
toPngDataUrlS :: Int -> Int -> QRImage -> String
toPngDataUrlS Int
border Int
scale = ByteString -> String
BLC8.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> QRImage -> ByteString
toPngDataUrlBS Int
border Int
scale
toPngDataUrlT :: Int -> Int -> QRImage -> TL.Text
{-# INLINE toPngDataUrlT #-}
toPngDataUrlT :: Int -> Int -> QRImage -> Text
toPngDataUrlT Int
border Int
scale = String -> Text
TL.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> QRImage -> String
toPngDataUrlS Int
border Int
scale