{-# LANGUAGE CPP #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Graphics.PDF.Image(
PDFJpeg
, JpegFile
, RawImage
, PDFFilter(..)
, createPDFJpeg
, readJpegFile
, jpegBounds
, readJpegDataURL
, createPDFRawImageFromARGB
, createPDFRawImageFromByteString
) where
import Graphics.PDF.LowLevel.Types
import qualified Data.Map.Strict as M
import Graphics.PDF.Draw
import Graphics.PDF.Resources
import Graphics.PDF.Pages
import qualified Data.ByteString.Lazy as B
import Control.Monad
import Control.Monad.Writer
#if __GLASGOW_HASKELL__ >= 608
import System.IO hiding(withFile)
#else
import System.IO
#endif
import Data.Char(ord)
import Data.Bits
#if __GLASGOW_HASKELL__ >= 710
import qualified Control.Monad.Except as EXC
#else
import qualified Control.Monad.Error as EXC
#endif
import Graphics.PDF.Coordinates
import Data.Binary.Builder(Builder,fromLazyByteString,fromByteString)
import Control.Exception as E
import qualified Data.Vector.Unboxed as U
import Data.Word
import qualified Data.ByteString.Char8 as C8 (ByteString, pack, index, length)
import Data.ByteString.Base64(decode)
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Control.Error.Util (note)
data JpegFile = JpegFile !Int !Int !Int !Int !Builder
data PDFFilter = ASCIIHexDecode
| ASCII85Decode
| LZWDecode
| FlateDecode
| RunLengthDecode
| CCITTFaxDecode
| DCTDecode
| NoFilter
m_sof0 :: Int
m_sof0 :: Int
m_sof0 = Int
0xc0
m_sof1 :: Int
m_sof1 :: Int
m_sof1 = Int
0xc1
m_sof2 :: Int
m_sof2 :: Int
m_sof2 = Int
0xc2
m_sof3 :: Int
m_sof3 :: Int
m_sof3 = Int
0xc3
m_sof5 :: Int
m_sof5 :: Int
m_sof5 = Int
0xc5
m_sof6 :: Int
m_sof6 :: Int
m_sof6 = Int
0xc6
m_sof7 :: Int
m_sof7 :: Int
m_sof7 = Int
0xc7
m_sof9 :: Int
m_sof9 :: Int
m_sof9 = Int
0xc9
m_sof10 :: Int
m_sof10 :: Int
m_sof10 = Int
0xca
m_sof11 :: Int
m_sof11 :: Int
m_sof11 = Int
0xcb
m_sof13 :: Int
m_sof13 :: Int
m_sof13 = Int
0xcd
m_sof14 :: Int
m_sof14 :: Int
m_sof14 = Int
0xce
m_sof15 :: Int
m_sof15 :: Int
m_sof15 = Int
0xcf
m_rst0 :: Int
m_rst0 :: Int
m_rst0 = Int
0xd0
m_rst1 :: Int
m_rst1 :: Int
m_rst1 = Int
0xd1
m_rst2 :: Int
m_rst2 :: Int
m_rst2 = Int
0xd2
m_rst3 :: Int
m_rst3 :: Int
m_rst3 = Int
0xd3
m_rst4 :: Int
m_rst4 :: Int
m_rst4 = Int
0xd4
m_rst5 :: Int
m_rst5 :: Int
m_rst5 = Int
0xd5
m_rst6 :: Int
m_rst6 :: Int
m_rst6 = Int
0xd6
m_rst7 :: Int
m_rst7 :: Int
m_rst7 = Int
0xd7
m_soi :: Int
m_soi :: Int
m_soi = Int
0xd8
m_eoi :: Int
m_eoi :: Int
m_eoi = Int
0xd9
m_sos :: Int
m_sos :: Int
m_sos = Int
0xda
m_tem :: Int
m_tem :: Int
m_tem = Int
0x01
io :: IO a -> FA a
io :: forall a. IO a -> FA a
io = forall a. ExceptT String IO a -> FA a
FA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
#if __GLASGOW_HASKELL__ >= 710
newtype FA a = FA { forall a. FA a -> ExceptT String IO a
unFA :: EXC.ExceptT String IO a}
#else
newtype FA a = FA { unFA :: EXC.ErrorT String IO a}
#endif
#ifndef __HADDOCK__
deriving(Applicative FA
forall a. a -> FA a
forall a b. FA a -> FA b -> FA b
forall a b. FA a -> (a -> FA b) -> FA b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> FA a
$creturn :: forall a. a -> FA a
>> :: forall a b. FA a -> FA b -> FA b
$c>> :: forall a b. FA a -> FA b -> FA b
>>= :: forall a b. FA a -> (a -> FA b) -> FA b
$c>>= :: forall a b. FA a -> (a -> FA b) -> FA b
Monad,Functor FA
forall a. a -> FA a
forall a b. FA a -> FA b -> FA a
forall a b. FA a -> FA b -> FA b
forall a b. FA (a -> b) -> FA a -> FA b
forall a b c. (a -> b -> c) -> FA a -> FA b -> FA c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. FA a -> FA b -> FA a
$c<* :: forall a b. FA a -> FA b -> FA a
*> :: forall a b. FA a -> FA b -> FA b
$c*> :: forall a b. FA a -> FA b -> FA b
liftA2 :: forall a b c. (a -> b -> c) -> FA a -> FA b -> FA c
$cliftA2 :: forall a b c. (a -> b -> c) -> FA a -> FA b -> FA c
<*> :: forall a b. FA (a -> b) -> FA a -> FA b
$c<*> :: forall a b. FA (a -> b) -> FA a -> FA b
pure :: forall a. a -> FA a
$cpure :: forall a. a -> FA a
Applicative,EXC.MonadError String,forall a b. a -> FA b -> FA a
forall a b. (a -> b) -> FA a -> FA b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> FA b -> FA a
$c<$ :: forall a b. a -> FA b -> FA a
fmap :: forall a b. (a -> b) -> FA a -> FA b
$cfmap :: forall a b. (a -> b) -> FA a -> FA b
Functor)
#else
instance Monad FA
instance MonadError String FA
instance MonadIO FA
instance Functor FA
#endif
runFA :: FA a -> IO (Either String a)
#if __GLASGOW_HASKELL__ >= 710
runFA :: forall a. FA a -> IO (Either String a)
runFA = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
EXC.runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FA a -> ExceptT String IO a
unFA
#else
runFA = EXC.runErrorT . unFA
#endif
readWord16 :: Handle -> FA Int
readWord16 :: Handle -> FA Int
readWord16 Handle
h = forall a. IO a -> FA a
io forall a b. (a -> b) -> a -> b
$ do
Char
hi <- Handle -> IO Char
hGetChar Handle
h
Char
lo <- Handle -> IO Char
hGetChar Handle
h
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ((forall a. Enum a => a -> Int
fromEnum Char
hi) forall a. Bits a => a -> Int -> a
`shiftL` Int
8) forall a. Bits a => a -> a -> a
.|. (forall a. Enum a => a -> Int
fromEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord forall a b. (a -> b) -> a -> b
$ Char
lo)
readWord8 :: Handle -> FA Int
readWord8 :: Handle -> FA Int
readWord8 Handle
h = forall a. IO a -> FA a
io forall a b. (a -> b) -> a -> b
$ do
Char
lo <- Handle -> IO Char
hGetChar Handle
h
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord forall a b. (a -> b) -> a -> b
$ Char
lo
parseJpegContent :: Handle -> FA (Int,Int,Int,Int)
parseJpegContent :: Handle -> FA (Int, Int, Int, Int)
parseJpegContent Handle
h = do
Int
r <- Handle -> FA Int
readWord8 Handle
h
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
r forall a. Eq a => a -> a -> Bool
/= Int
0x0FF) forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadError e m => e -> m a
EXC.throwError String
"No marker found"
Int
sof <- Handle -> FA Int
readWord8 Handle
h
case Int
sof of
Int
a | Int
a forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
m_sof5,Int
m_sof6,Int
m_sof7,Int
m_sof9,Int
m_sof10,Int
m_sof11,Int
m_sof13,Int
m_sof14,Int
m_sof15] ->
forall e (m :: * -> *) a. MonadError e m => e -> m a
EXC.throwError String
"Unuspported compression mode"
| Int
a forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
m_sof0,Int
m_sof1,Int
m_sof2,Int
m_sof3] -> do
Int
_ <- Handle -> FA Int
readWord16 Handle
h
Int
bits_per_component <- Handle -> FA Int
readWord8 Handle
h
Int
height <- Handle -> FA Int
readWord16 Handle
h
Int
width <- Handle -> FA Int
readWord16 Handle
h
Int
color_space <- Handle -> FA Int
readWord8 Handle
h
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
bits_per_component,Int
height,Int
width,Int
color_space)
| Int
a forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
m_soi,Int
m_tem,Int
m_rst0,Int
m_rst1,Int
m_rst2,Int
m_rst3,Int
m_rst4,Int
m_rst5,Int
m_rst6,Int
m_rst7] -> Handle -> FA (Int, Int, Int, Int)
parseJpegContent Handle
h
| Int
a forall a. Eq a => a -> a -> Bool
== Int
m_sos -> let
loop :: FA (Int, Int, Int, Int)
loop = do
Int
x <- Handle -> FA Int
readWord8 Handle
h
if Int
x forall a. Eq a => a -> a -> Bool
/= Int
0xff then FA (Int, Int, Int, Int)
loop else do
Int
y <- Handle -> FA Int
readWord8 Handle
h
if Int
y forall a. Eq a => a -> a -> Bool
== Int
0x00 then FA (Int, Int, Int, Int)
loop else do
forall a. IO a -> FA a
io forall a b. (a -> b) -> a -> b
$ Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
RelativeSeek (-Integer
2)
Handle -> FA (Int, Int, Int, Int)
parseJpegContent Handle
h
in FA (Int, Int, Int, Int)
loop
| Int
a forall a. Eq a => a -> a -> Bool
== Int
m_eoi -> forall e (m :: * -> *) a. MonadError e m => e -> m a
EXC.throwError String
"parseJpegContent: hit end of image (EOI) marker before getting JPEG metadata"
| Bool
otherwise -> do
Int
l <- Handle -> FA Int
readWord16 Handle
h
forall a. IO a -> FA a
io forall a b. (a -> b) -> a -> b
$ Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
RelativeSeek (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
lforall a. Num a => a -> a -> a
-Int
2))
Handle -> FA (Int, Int, Int, Int)
parseJpegContent Handle
h
analyzeJpeg :: Handle -> FA (Int,Int,Int,Int)
analyzeJpeg :: Handle -> FA (Int, Int, Int, Int)
analyzeJpeg Handle
h = do
forall a. IO a -> FA a
io forall a b. (a -> b) -> a -> b
$ Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
SeekFromEnd Integer
0
forall a. IO a -> FA a
io forall a b. (a -> b) -> a -> b
$ Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek Integer
0
Int
header <- Handle -> FA Int
readWord16 Handle
h
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
header forall a. Eq a => a -> a -> Bool
/= Int
0x0FFD8) forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadError e m => e -> m a
EXC.throwError String
"Not a JPEG File"
forall a. IO a -> FA a
io forall a b. (a -> b) -> a -> b
$ Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek Integer
0
(Int
bits_per_component,Int
height,Int
width,Int
color_space) <- Handle -> FA (Int, Int, Int, Int)
parseJpegContent Handle
h
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
color_space forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
1,Int
3,Int
4]) forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadError e m => e -> m a
EXC.throwError String
"Color space not supported"
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
bits_per_component,Int
height,Int
width,Int
color_space)
withFile :: String -> (Handle -> IO c) -> IO c
withFile :: forall c. String -> (Handle -> IO c) -> IO c
withFile String
name = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (String -> IOMode -> IO Handle
openBinaryFile String
name IOMode
ReadMode) Handle -> IO ()
hClose
readJpegFile :: FilePath
-> IO (Either String JpegFile)
readJpegFile :: String -> IO (Either String JpegFile)
readJpegFile String
f = (do
Either String (Int, Int, Int, Int)
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall c. String -> (Handle -> IO c) -> IO c
withFile String
f forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
forall a. FA a -> IO (Either String a)
runFA (Handle -> FA (Int, Int, Int, Int)
analyzeJpeg Handle
h)
case Either String (Int, Int, Int, Int)
r of
Right (Int
bits_per_component,Int
height,Int
width,Int
color_space) -> do
ByteString
img <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall c. String -> (Handle -> IO c) -> IO c
withFile String
f forall a b. (a -> b) -> a -> b
$ \Handle
h' -> do
Integer
nb <- Handle -> IO Integer
hFileSize Handle
h'
Handle -> Int -> IO ByteString
B.hGet Handle
h' (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
nb)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Builder -> JpegFile
JpegFile Int
bits_per_component Int
width Int
height Int
color_space (ByteString -> Builder
fromLazyByteString ByteString
img))
Left String
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
s) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\(IOException
err :: IOException) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall a. Show a => a -> String
show IOException
err))
jpegBounds :: JpegFile -> (Int,Int)
jpegBounds :: JpegFile -> (Int, Int)
jpegBounds (JpegFile Int
_ Int
w Int
h Int
_ Builder
_) = (Int
w,Int
h)
createPDFJpeg :: JpegFile
-> PDF (PDFReference PDFJpeg)
createPDFJpeg :: JpegFile -> PDF (PDFReference PDFJpeg)
createPDFJpeg (JpegFile Int
bits_per_component Int
width Int
height Int
color_space Builder
img) = do
PDFReference Int
s <- forall a.
Draw a
-> Maybe (PDFReference PDFPage) -> PDF (PDFReference PDFStream)
createContent Draw ()
a' forall a. Maybe a
Nothing
Int -> PDFFloat -> PDFFloat -> PDF ()
recordBound Int
s (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Int -> PDFReference s
PDFReference Int
s)
where
color :: a -> [(PDFName, AnyPdfObject)]
color a
c = case a
c of
a
1 -> [(String -> PDFName
PDFName String
"ColorSpace",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall a b. (a -> b) -> a -> b
$ String -> PDFName
PDFName String
"DeviceGray")]
a
3 -> [(String -> PDFName
PDFName String
"ColorSpace",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall a b. (a -> b) -> a -> b
$ String -> PDFName
PDFName String
"DeviceRGB")]
a
4 -> [(String -> PDFName
PDFName String
"ColorSpace",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall a b. (a -> b) -> a -> b
$ String -> PDFName
PDFName String
"DeviceCMYK")
,(String -> PDFName
PDFName String
"Decode",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger) forall a b. (a -> b) -> a -> b
$ [Int
1,Int
0,Int
1,Int
0,Int
1,Int
0,Int
1,Int
0])
]
a
_ -> forall a. HasCallStack => String -> a
error String
"Jpeg color space not supported"
a' :: Draw ()
a' =
do forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s {otherRsrcs :: PDFDictionary
otherRsrcs = Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionaryforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
[ (String -> PDFName
PDFName String
"Type",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"XObject")
, (String -> PDFName
PDFName String
"Subtype",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"Image")
, (String -> PDFName
PDFName String
"Width",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall a b. (a -> b) -> a -> b
$ Int
width)
, (String -> PDFName
PDFName String
"Height",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall a b. (a -> b) -> a -> b
$ Int
height)
, (String -> PDFName
PDFName String
"BitsPerComponent",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall a b. (a -> b) -> a -> b
$ Int
bits_per_component)
, (String -> PDFName
PDFName String
"Interpolate", forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject Bool
True)
, (String -> PDFName
PDFName String
"Filter",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"DCTDecode")
] forall a. [a] -> [a] -> [a]
++ forall {a}. (Eq a, Num a) => a -> [(PDFName, AnyPdfObject)]
color Int
color_space
}
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Builder
img
createPDFRawImageFromByteString :: Int
-> Int
-> Bool
-> PDFFilter
-> B.ByteString
-> PDF (PDFReference RawImage)
createPDFRawImageFromByteString :: Int
-> Int
-> Bool
-> PDFFilter
-> ByteString
-> PDF (PDFReference RawImage)
createPDFRawImageFromByteString Int
width Int
height Bool
interpolate PDFFilter
pdfFilter ByteString
stream = do
PDFReference Int
s <- forall a.
Draw a
-> Maybe (PDFReference PDFPage) -> PDF (PDFReference PDFStream)
createContent Draw ()
a' forall a. Maybe a
Nothing
Int -> PDFFloat -> PDFFloat -> PDF ()
recordBound Int
s (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Int -> PDFReference s
PDFReference Int
s)
where
getFilter :: [(PDFName, AnyPdfObject)]
getFilter = case PDFFilter
pdfFilter of
PDFFilter
NoFilter -> []
PDFFilter
ASCIIHexDecode -> [(String -> PDFName
PDFName String
"Filter",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"ASCIIHexDecode")]
PDFFilter
ASCII85Decode -> [(String -> PDFName
PDFName String
"Filter",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"ASCII85Decode")]
PDFFilter
LZWDecode -> [(String -> PDFName
PDFName String
"Filter",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"LZWDecode")]
PDFFilter
FlateDecode -> [(String -> PDFName
PDFName String
"Filter",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"FlateDecode")]
PDFFilter
RunLengthDecode -> [(String -> PDFName
PDFName String
"Filter",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"RunLengthDecode")]
PDFFilter
CCITTFaxDecode -> [(String -> PDFName
PDFName String
"Filter",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"CCITTFaxDecode")]
PDFFilter
DCTDecode -> [(String -> PDFName
PDFName String
"Filter",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"DCTDecode")]
a' :: Draw ()
a' = do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s {otherRsrcs :: PDFDictionary
otherRsrcs = Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionaryforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
[ (String -> PDFName
PDFName String
"Type",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"XObject")
, (String -> PDFName
PDFName String
"Subtype",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"Image")
, (String -> PDFName
PDFName String
"Width",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall a b. (a -> b) -> a -> b
$ Int
width)
, (String -> PDFName
PDFName String
"Height",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall a b. (a -> b) -> a -> b
$ Int
height)
, (String -> PDFName
PDFName String
"BitsPerComponent",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall a b. (a -> b) -> a -> b
$ Int
8)
, (String -> PDFName
PDFName String
"ColorSpace",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall a b. (a -> b) -> a -> b
$ String -> PDFName
PDFName String
"DeviceRGB")
, (String -> PDFName
PDFName String
"Interpolate", forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject Bool
interpolate)
] forall a. [a] -> [a] -> [a]
++ [(PDFName, AnyPdfObject)]
getFilter
}
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
fromLazyByteString forall a b. (a -> b) -> a -> b
$ ByteString
stream
createPDFRawImageFromARGB :: Int
-> Int
-> Bool
-> U.Vector Word32
-> PDF (PDFReference RawImage)
createPDFRawImageFromARGB :: Int -> Int -> Bool -> Vector Word32 -> PDF (PDFReference RawImage)
createPDFRawImageFromARGB Int
width Int
height Bool
interpolate Vector Word32
stream = do
PDFReference Int
s <- forall a.
Draw a
-> Maybe (PDFReference PDFPage) -> PDF (PDFReference PDFStream)
createContent Draw ()
a' forall a. Maybe a
Nothing
Int -> PDFFloat -> PDFFloat -> PDF ()
recordBound Int
s (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Int -> PDFReference s
PDFReference Int
s)
where
addPixel :: [a] -> [a]
addPixel (a
a:[a]
t) =
let xa :: a
xa = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (a
a forall a. Bits a => a -> Int -> a
`shiftR` Int
16) forall a. Bits a => a -> a -> a
.&. a
0x0FF
xb :: a
xb = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (a
a forall a. Bits a => a -> Int -> a
`shiftR` Int
8) forall a. Bits a => a -> a -> a
.&. a
0x0FF
xc :: a
xc = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (a
a forall a. Bits a => a -> Int -> a
`shiftR` Int
0) forall a. Bits a => a -> a -> a
.&. a
0x0FF
in
a
xaforall a. a -> [a] -> [a]
:a
xbforall a. a -> [a] -> [a]
:a
xcforall a. a -> [a] -> [a]
:[a] -> [a]
addPixel [a]
t
addPixel [] = []
a' :: Draw ()
a' = do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s {otherRsrcs :: PDFDictionary
otherRsrcs = Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionaryforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
[ (String -> PDFName
PDFName String
"Type",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"XObject")
, (String -> PDFName
PDFName String
"Subtype",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"Image")
, (String -> PDFName
PDFName String
"Width",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall a b. (a -> b) -> a -> b
$ Int
width)
, (String -> PDFName
PDFName String
"Height",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall a b. (a -> b) -> a -> b
$ Int
height)
, (String -> PDFName
PDFName String
"BitsPerComponent",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall a b. (a -> b) -> a -> b
$ Int
8)
, (String -> PDFName
PDFName String
"ColorSpace",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall a b. (a -> b) -> a -> b
$ String -> PDFName
PDFName String
"DeviceRGB")
, (String -> PDFName
PDFName String
"Interpolate", forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject Bool
interpolate)
]
}
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
fromLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
B.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {a}. (Integral a, Bits a, Num a) => [a] -> [a]
addPixel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Unbox a => Vector a -> [a]
U.toList forall a b. (a -> b) -> a -> b
$ Vector Word32
stream
sIndex :: C8.ByteString -> Int -> Maybe Char
sIndex :: ByteString -> Int -> Maybe Char
sIndex ByteString
bs Int
idx =
if (Int
idx forall a. Ord a => a -> a -> Bool
< Int
0) Bool -> Bool -> Bool
|| (Int
idx forall a. Ord a => a -> a -> Bool
> ByteString -> Int
C8.length ByteString
bs)
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString
bs ByteString -> Int -> Char
`C8.index` Int
idx
sReadWord8 :: C8.ByteString -> Int -> Maybe Int
sReadWord8 :: ByteString -> Int -> Maybe Int
sReadWord8 ByteString
bs Int
idx = (forall a. Enum a => a -> Int
fromEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString
bs ByteString -> Int -> Maybe Char
`sIndex` Int
idx)
sReadWord16 :: C8.ByteString -> Int -> Maybe Int
sReadWord16 :: ByteString -> Int -> Maybe Int
sReadWord16 ByteString
bs Int
idx = do
Int
hi <- ByteString -> Int -> Maybe Int
sReadWord8 ByteString
bs Int
idx
Int
lo <- ByteString -> Int -> Maybe Int
sReadWord8 ByteString
bs (Int
idx forall a. Num a => a -> a -> a
+ Int
1)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Int
hi forall a. Bits a => a -> Int -> a
`shiftL` Int
8) forall a. Bits a => a -> a -> a
.|. Int
lo
parseJpegDetailData :: C8.ByteString -> Int -> Maybe (Int,Int,Int,Int)
parseJpegDetailData :: ByteString -> Int -> Maybe (Int, Int, Int, Int)
parseJpegDetailData ByteString
bs Int
offset = do
Int
bpc <- ByteString -> Int -> Maybe Int
sReadWord8 ByteString
bs (Int
offset forall a. Num a => a -> a -> a
+ Int
4)
Int
hgt <- ByteString -> Int -> Maybe Int
sReadWord16 ByteString
bs (Int
offset forall a. Num a => a -> a -> a
+ Int
5)
Int
wdt <- ByteString -> Int -> Maybe Int
sReadWord16 ByteString
bs (Int
offset forall a. Num a => a -> a -> a
+ Int
7)
Int
cls <- ByteString -> Int -> Maybe Int
sReadWord8 ByteString
bs (Int
offset forall a. Num a => a -> a -> a
+ Int
9)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
bpc, Int
hgt, Int
wdt, Int
cls)
(?|) :: Maybe b -> a -> Either a b
?| :: forall b a. Maybe b -> a -> Either a b
(?|) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. a -> Maybe b -> Either a b
note
parseJpegContentData :: C8.ByteString -> Int -> Either String (Int,Int,Int,Int)
parseJpegContentData :: ByteString -> Int -> Either String (Int, Int, Int, Int)
parseJpegContentData ByteString
bs Int
offset = do
Int
r <- ByteString -> Int -> Maybe Int
sReadWord8 ByteString
bs Int
offset forall b a. Maybe b -> a -> Either a b
?| String
"Corrupt JPEG data URL - no marker found"
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
r forall a. Eq a => a -> a -> Bool
== Int
0x0FF) forall b a. Maybe b -> a -> Either a b
?| String
"Corrupt JPEG data URL - no marker found"
Int
sof <- (ByteString -> Int -> Maybe Int
sReadWord8 ByteString
bs (Int
offset forall a. Num a => a -> a -> a
+ Int
1)) forall b a. Maybe b -> a -> Either a b
?| String
"Corrupt JPEG data URL - no start of file offset found"
case Int
sof of
Int
a | Int
a forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
m_sof5,Int
m_sof6,Int
m_sof7,Int
m_sof9,Int
m_sof10,Int
m_sof11,Int
m_sof13,Int
m_sof14,Int
m_sof15] -> forall a b. a -> Either a b
Left String
"Unsupported compression mode"
| Int
a forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
m_sof0,Int
m_sof1,Int
m_sof3] -> (ByteString -> Int -> Maybe (Int, Int, Int, Int)
parseJpegDetailData ByteString
bs Int
offset) forall b a. Maybe b -> a -> Either a b
?| String
"Corrupt JPEG data URL - insufficient data in URL"
| Int
a forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
m_soi,Int
m_eoi,Int
m_tem,Int
m_rst0,Int
m_rst1,Int
m_rst2,Int
m_rst3,Int
m_rst4,Int
m_rst5,Int
m_rst6,Int
m_rst7] -> ByteString -> Int -> Either String (Int, Int, Int, Int)
parseJpegContentData ByteString
bs (Int
offset forall a. Num a => a -> a -> a
+ Int
2)
| Bool
otherwise -> do
Int
l <- (ByteString -> Int -> Maybe Int
sReadWord16 ByteString
bs (Int
offset forall a. Num a => a -> a -> a
+ Int
2)) forall b a. Maybe b -> a -> Either a b
?| String
"Corrupt JPEG data URL - insufficient data in URL"
ByteString -> Int -> Either String (Int, Int, Int, Int)
parseJpegContentData ByteString
bs (Int
offset forall a. Num a => a -> a -> a
+ Int
l forall a. Num a => a -> a -> a
+ Int
2)
checkColorSpace :: (Int,Int,Int,Int) -> Either String (Int,Int,Int,Int)
checkColorSpace :: (Int, Int, Int, Int) -> Either String (Int, Int, Int, Int)
checkColorSpace hdrData :: (Int, Int, Int, Int)
hdrData@(Int
_,Int
_,Int
_,Int
color_space) = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
color_space forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
1,Int
3,Int
4]) forall b a. Maybe b -> a -> Either a b
?| (String
"Color space [" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
color_space forall a. [a] -> [a] -> [a]
++ String
"] not supported")
forall (m :: * -> *) a. Monad m => a -> m a
return (Int, Int, Int, Int)
hdrData
analyzeJpegData :: C8.ByteString -> Either String (Int,Int,Int,Int)
analyzeJpegData :: ByteString -> Either String (Int, Int, Int, Int)
analyzeJpegData ByteString
bs = do
Int
header <- ByteString -> Int -> Maybe Int
sReadWord16 ByteString
bs Int
0 forall b a. Maybe b -> a -> Either a b
?| String
"Not a JPEG data URL - no marker found"
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
header forall a. Eq a => a -> a -> Bool
== Int
0x0FFD8) forall b a. Maybe b -> a -> Either a b
?| String
"Not a JPEG data URL - invalid JPEG marker"
(Int, Int, Int, Int)
hdrData <- ByteString -> Int -> Either String (Int, Int, Int, Int)
parseJpegContentData ByteString
bs Int
0
(Int, Int, Int, Int) -> Either String (Int, Int, Int, Int)
checkColorSpace (Int, Int, Int, Int)
hdrData
readJpegData :: String -> Either String JpegFile
readJpegData :: String -> Either String JpegFile
readJpegData String
dataString = do
ByteString
bs <- ByteString -> Either String ByteString
decode forall a b. (a -> b) -> a -> b
$ String -> ByteString
C8.pack String
dataString
(Int
bits_per_component,Int
height,Int
width,Int
color_space) <- ByteString -> Either String (Int, Int, Int, Int)
analyzeJpegData ByteString
bs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Builder -> JpegFile
JpegFile Int
bits_per_component Int
width Int
height Int
color_space (ByteString -> Builder
fromByteString ByteString
bs)
readJpegDataURL :: String -> Either String JpegFile
readJpegDataURL :: String -> Either String JpegFile
readJpegDataURL String
dataurl = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall a. Int -> [a] -> [a]
take Int
23 String
dataurl forall a. Eq a => a -> a -> Bool
== String
"data:image/jpeg;base64,") forall b a. Maybe b -> a -> Either a b
?| String
"Data URL does not start with a valid JPEG header"
String -> Either String JpegFile
readJpegData forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
23 String
dataurl
data PDFJpeg
instance PDFXObject PDFJpeg where
drawXObject :: PDFReference PDFJpeg -> Draw ()
drawXObject PDFReference PDFJpeg
a = forall a. Draw a -> Draw a
withNewContext forall a b. (a -> b) -> a -> b
$ do
(PDFFloat
width,PDFFloat
height) <- forall (m :: * -> *) a.
(PDFGlobals m, PDFXObject a) =>
PDFReference a -> m (PDFFloat, PDFFloat)
bounds PDFReference PDFJpeg
a
Matrix -> Draw ()
applyMatrix (PDFFloat -> PDFFloat -> Matrix
scale PDFFloat
width PDFFloat
height)
forall a. PDFXObject a => PDFReference a -> Draw ()
privateDrawXObject PDFReference PDFJpeg
a
instance PdfObject PDFJpeg where
toPDF :: PDFJpeg -> Builder
toPDF PDFJpeg
_ = forall s. Monoid s => s
noPdfObject
instance PdfLengthInfo PDFJpeg where
instance PdfResourceObject (PDFReference PDFJpeg) where
toRsrc :: PDFReference PDFJpeg -> AnyPdfObject
toRsrc = forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject
data RawImage
instance PDFXObject RawImage where
drawXObject :: PDFReference RawImage -> Draw ()
drawXObject PDFReference RawImage
a = forall a. Draw a -> Draw a
withNewContext forall a b. (a -> b) -> a -> b
$ do
(PDFFloat
width,PDFFloat
height) <- forall (m :: * -> *) a.
(PDFGlobals m, PDFXObject a) =>
PDFReference a -> m (PDFFloat, PDFFloat)
bounds PDFReference RawImage
a
Matrix -> Draw ()
applyMatrix (PDFFloat -> PDFFloat -> Matrix
scale PDFFloat
width PDFFloat
height)
forall a. PDFXObject a => PDFReference a -> Draw ()
privateDrawXObject PDFReference RawImage
a
instance PdfObject RawImage where
toPDF :: RawImage -> Builder
toPDF RawImage
_ = forall s. Monoid s => s
noPdfObject
instance PdfLengthInfo RawImage where
instance PdfResourceObject (PDFReference RawImage) where
toRsrc :: PDFReference RawImage -> AnyPdfObject
toRsrc = forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject