{-# 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 border scale QRImage{..}
| border <= 0 && scale <= 1 =
Image qrImageSize qrImageSize (SV.fromList $ map (bool 0xff 0x00) (UV.toList qrImageData))
toImage border' scale' QRImage{..} =
let
border = border' `max` 0
scale = scale' `max` 1
size = (qrImageSize + 2 * border) * scale
in
Image size size (SV.fromList $ concat $ doScale scale $ addBorder border $ toMatrix qrImageData)
where
toMatrix :: UV.Vector Bool -> [[Word8]]
toMatrix img
| UV.null img = []
| otherwise =
let
(h, t) = UV.splitAt qrImageSize img
in
map (bool 0xff 0x00) (UV.toList h) : toMatrix t
addBorder :: Int -> [[Word8]] -> [[Word8]]
addBorder 0 img = img
addBorder n img = topBottom ++ addLeftRight img ++ topBottom
where
topBottom = [replicate ((qrImageSize + 2 * n) * n) 0xff]
leftRight = replicate n 0xff
addLeftRight = map (\ x -> leftRight ++ x ++ leftRight)
doScale :: Int -> [[Word8]] -> [[Word8]]
doScale 1 img = img
doScale n img = scaleV img
where
scaleV :: [[Word8]] -> [[Word8]]
scaleV = concatMap (replicate n . scaleH)
scaleH :: [Word8] -> [Word8]
scaleH = concatMap (replicate n)
toPngDataUrlBS :: Int -> Int -> QRImage -> BL.ByteString
toPngDataUrlBS border scale img = "data:image/png;base64," `BL.append` B64L.encode (encodePng $ toImage border scale img)
toPngDataUrlS :: Int -> Int -> QRImage -> String
{-# INLINE toPngDataUrlS #-}
toPngDataUrlS border scale = BLC8.unpack . toPngDataUrlBS border scale
toPngDataUrlT :: Int -> Int -> QRImage -> TL.Text
{-# INLINE toPngDataUrlT #-}
toPngDataUrlT border scale = TL.pack . toPngDataUrlS border scale