module Graphics.PDF.Annotation(
TextAnnotation(..)
, URLLink(..)
, PDFLink(..)
, TextIcon(..)
, newAnnotation
) where
import Graphics.PDF.LowLevel.Types
import Graphics.PDF.Draw
import qualified Data.Map as M
import Graphics.PDF.Action
import Graphics.PDF.Pages
import Control.Monad.State(gets)
data TextIcon = Note
| Paragraph
| NewParagraph
| Key
| Comment
| Help
| Insert
deriving(Eq,Show)
data TextAnnotation = TextAnnotation
PDFString
[PDFFloat]
TextIcon
data URLLink = URLLink
PDFString
[PDFFloat]
String
Bool
data PDFLink = PDFLink
PDFString
[PDFFloat]
(PDFReference PDFPage)
PDFFloat
PDFFloat
Bool
applyMatrixToRectangle :: Matrix -> [PDFFloat] -> [PDFFloat]
applyMatrixToRectangle m [xa,ya,xb,yb] =
let (xa',ya') = m `applyTo` (xa,ya)
(xa'',yb') = m `applyTo` (xa,yb)
(xb',ya'') = m `applyTo` (xb,ya)
(xb'',yb'') = m `applyTo` (xb,yb)
x1 = minimum [xa',xa'',xb',xb'']
x2 = maximum [xa',xa'',xb',xb'']
y1 = minimum [ya',ya'',yb',yb'']
y2 = maximum [ya',ya'',yb',yb'']
in
[x1,y1,x2,y2]
where
applyTo (Matrix a b c d e f) (x,y) = (a*x+c*y+e,b*x+d*y+f)
applyMatrixToRectangle _ a = a
getBorder :: Bool -> [PDFInteger]
getBorder False = [0,0,0]
getBorder True = [0,0,1]
standardAnnotationDict :: AnnotationObject a => a -> [(PDFName,AnyPdfObject)]
standardAnnotationDict a = [(PDFName "Type",AnyPdfObject . PDFName $ "Annot")
, (PDFName "Subtype",AnyPdfObject $ annotationType a)
, (PDFName "Rect",AnyPdfObject . map AnyPdfObject $ annotationRect a)
, (PDFName "Contents",AnyPdfObject $ annotationContent a)
]
instance PdfObject TextAnnotation where
toPDF a@(TextAnnotation _ _ i) = toPDF . PDFDictionary . M.fromList $
standardAnnotationDict a ++ [(PDFName "Name",AnyPdfObject . PDFName $ show i)]
instance AnnotationObject TextAnnotation where
addAnnotation = addObject
annotationType _ = PDFName "Text"
annotationContent (TextAnnotation s _ _) = s
annotationRect (TextAnnotation _ r _) = r
annotationToGlobalCoordinates (TextAnnotation a r b) = do
gr <- transformAnnotRect r
return $ TextAnnotation a gr b
instance PdfObject URLLink where
toPDF a@(URLLink _ _ url border) = toPDF . PDFDictionary . M.fromList $
standardAnnotationDict a ++
[ (PDFName "A",AnyPdfObject (GoToURL url))
, (PDFName "Border",AnyPdfObject . map AnyPdfObject $ (getBorder border))
]
instance AnnotationObject URLLink where
addAnnotation = addObject
annotationType _ = PDFName "Link"
annotationContent (URLLink s _ _ _) = s
annotationRect (URLLink _ r _ _) = r
annotationToGlobalCoordinates (URLLink a r b c) = do
gr <- transformAnnotRect r
return $ URLLink a gr b c
instance PdfObject PDFLink where
toPDF a@(PDFLink _ _ page x y border) = toPDF . PDFDictionary . M.fromList $
standardAnnotationDict a ++
[(PDFName "Dest",AnyPdfObject dest)
,(PDFName "Border",AnyPdfObject . map AnyPdfObject $ (getBorder border))]
where
dest = [ AnyPdfObject page
, AnyPdfObject (PDFName "XYZ")
, AnyPdfObject x
, AnyPdfObject y
, AnyPdfObject (PDFInteger 0)]
instance AnnotationObject PDFLink where
addAnnotation = addObject
annotationType _ = PDFName "Link"
annotationContent (PDFLink s _ _ _ _ _) = s
annotationRect (PDFLink _ r _ _ _ _) = r
annotationToGlobalCoordinates (PDFLink a r b c d e) = do
gr <- transformAnnotRect r
return $ PDFLink a gr b c d e
transformAnnotRect :: [PDFFloat] -> Draw [PDFFloat]
transformAnnotRect r = do
l <- gets matrix
let m = foldr (*) identity l
return $ m `applyMatrixToRectangle` r
newAnnotation :: (PdfObject a, AnnotationObject a) => a -> Draw ()
newAnnotation annot = do
annot' <- annotationToGlobalCoordinates annot
modifyStrict $ \s -> s {annots = (AnyAnnotation annot'):(annots s)}
return ()