Annotation.hs

---------------------------------------------------------
-- |
-- 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 ()