--------------------------------------------------------- -- | -- Copyright : (c) alpha 2007 -- License : BSD-style -- -- Maintainer : misc@NOSPAMalpheccar.org -- Stability : experimental -- Portability : portable -- -- PDF Annotations --------------------------------------------------------- module Graphics.PDF.Annotation( -- * Annotations -- ** Types TextAnnotation(..) , URLLink(..) , PDFLink(..) , TextIcon(..) -- ** Functions , 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 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 --data Screen = Screen (PDFReference Rendition) PDFString [PDFFloat] (PDFReference PDFPage) (Maybe (PDFReference ControlMedia)) (Maybe (PDFReference ControlMedia)) -- | Get the border shqpe depending on the style 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 Screen where -- toPDF a@(Screen _ _ _ p play stop) = toPDF . PDFDictionary . M.fromList $ -- standardAnnotationDict a ++ [(PDFName "P",AnyPdfObject p)] -- ++ (maybe [] (\x -> [(PDFName "A",AnyPdfObject x)]) play) -- ++ (maybe [] (\x -> [(PDFName "AA",AnyPdfObject $ otherActions x)]) stop) -- where -- otherActions x = PDFDictionary . M.fromList $ [(PDFName "D",AnyPdfObject x)] -- --instance AnnotationObject Screen where -- addAnnotation (Screen video s rect p _ _) = do -- r <- supply -- playAction <- addObject $ ControlMedia Play r video -- stopAction <- addObject $ ControlMedia Stop r video -- updateObject (PDFReference r) $ Screen video s rect p (Just playAction) (Just playAction) -- return $ PDFReference r -- annotationType _ = PDFName "Screen" -- annotationContent (Screen _ s _ _ _ _) = s -- annotationRect (Screen _ _ r _ _ _) = r 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 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 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 -- | Create a new annotation object newAnnotation :: (PdfObject a, AnnotationObject a) => a -> Draw () newAnnotation annot = do modifyStrict $ \s -> s {annots = (AnyAnnotation annot):(annots s)} return ()