---------------------------------------------------------
-- |
-- Copyright   : (c) 2006-2016, alpheccar.org
-- 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
   , toAsciiString
 ) where

import Graphics.PDF.LowLevel.Types
import Graphics.PDF.Draw
import Graphics.PDF.Action
import Graphics.PDF.Pages
import Control.Monad.State(gets)
import qualified Data.Text as T
import Network.URI 

--import Debug.Trace

data TextIcon = Note
              | Paragraph
              | NewParagraph
              | Key
              | Comment
              | Help
              | Insert
              deriving(TextIcon -> TextIcon -> Bool
(TextIcon -> TextIcon -> Bool)
-> (TextIcon -> TextIcon -> Bool) -> Eq TextIcon
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextIcon -> TextIcon -> Bool
== :: TextIcon -> TextIcon -> Bool
$c/= :: TextIcon -> TextIcon -> Bool
/= :: TextIcon -> TextIcon -> Bool
Eq,Int -> TextIcon -> ShowS
[TextIcon] -> ShowS
TextIcon -> String
(Int -> TextIcon -> ShowS)
-> (TextIcon -> String) -> ([TextIcon] -> ShowS) -> Show TextIcon
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextIcon -> ShowS
showsPrec :: Int -> TextIcon -> ShowS
$cshow :: TextIcon -> String
show :: TextIcon -> String
$cshowList :: [TextIcon] -> ShowS
showList :: [TextIcon] -> ShowS
Show)
    
                  
data TextAnnotation = TextAnnotation 
   T.Text -- Content
   [PDFFloat] -- Rect
   TextIcon
data URLLink = URLLink 
  T.Text -- Content
  [PDFFloat] -- Rect
  URI -- URL
  Bool -- Border
data PDFLink = PDFLink 
  T.Text -- Content
  [PDFFloat] -- Rect
  (PDFReference PDFPage) -- Page
  PDFFloat -- x
  PDFFloat -- y
  Bool -- Border
--data Screen = Screen (PDFReference Rendition) PDFString [PDFFloat] (PDFReference PDFPage) (Maybe (PDFReference ControlMedia)) (Maybe (PDFReference ControlMedia)) 

--det :: Matrix -> PDFFloat
--det (Matrix a b c d _ _) = a*d - b*c
--
--inverse :: Matrix -> Matrix
--inverse m@(Matrix a b c d e f) = (Matrix (d/de) (-b/de) (-c/de) (a/de) 0 0) * (Matrix 1 0 0 1 (-e) (-f))
--      where
--         de = det m

applyMatrixToRectangle :: Matrix -> [PDFFloat] -> [PDFFloat]
applyMatrixToRectangle :: Matrix -> [PDFFloat] -> [PDFFloat]
applyMatrixToRectangle Matrix
m [PDFFloat
xa,PDFFloat
ya,PDFFloat
xb,PDFFloat
yb] = 
    let (PDFFloat
xa',PDFFloat
ya') = Matrix
m Matrix -> (PDFFloat, PDFFloat) -> (PDFFloat, PDFFloat)
`applyTo` (PDFFloat
xa,PDFFloat
ya)
        (PDFFloat
xa'',PDFFloat
yb') = Matrix
m Matrix -> (PDFFloat, PDFFloat) -> (PDFFloat, PDFFloat)
`applyTo` (PDFFloat
xa,PDFFloat
yb)
        (PDFFloat
xb',PDFFloat
ya'') = Matrix
m Matrix -> (PDFFloat, PDFFloat) -> (PDFFloat, PDFFloat)
`applyTo` (PDFFloat
xb,PDFFloat
ya)
        (PDFFloat
xb'',PDFFloat
yb'') = Matrix
m Matrix -> (PDFFloat, PDFFloat) -> (PDFFloat, PDFFloat)
`applyTo` (PDFFloat
xb,PDFFloat
yb)
        x1 :: PDFFloat
x1 = [PDFFloat] -> PDFFloat
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [PDFFloat
xa',PDFFloat
xa'',PDFFloat
xb',PDFFloat
xb'']
        x2 :: PDFFloat
x2 = [PDFFloat] -> PDFFloat
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [PDFFloat
xa',PDFFloat
xa'',PDFFloat
xb',PDFFloat
xb'']
        y1 :: PDFFloat
y1 = [PDFFloat] -> PDFFloat
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [PDFFloat
ya',PDFFloat
ya'',PDFFloat
yb',PDFFloat
yb'']
        y2 :: PDFFloat
y2 = [PDFFloat] -> PDFFloat
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [PDFFloat
ya',PDFFloat
ya'',PDFFloat
yb',PDFFloat
yb'']
    in
    [PDFFloat
x1,PDFFloat
y1,PDFFloat
x2,PDFFloat
y2]
 where
     applyTo :: Matrix -> (PDFFloat, PDFFloat) -> (PDFFloat, PDFFloat)
applyTo (Matrix PDFFloat
a PDFFloat
b PDFFloat
c PDFFloat
d PDFFloat
e PDFFloat
f) (PDFFloat
x,PDFFloat
y) = (PDFFloat
aPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
*PDFFloat
xPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+PDFFloat
cPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
*PDFFloat
yPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+PDFFloat
e,PDFFloat
bPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
*PDFFloat
xPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+PDFFloat
dPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
*PDFFloat
yPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+PDFFloat
f)
     
applyMatrixToRectangle Matrix
_ [PDFFloat]
a = [PDFFloat]
a

    

-- | Get the border shqpe depending on the style
getBorder :: Bool -> [PDFInteger]
getBorder :: Bool -> [PDFInteger]
getBorder Bool
False = [PDFInteger
0,PDFInteger
0,PDFInteger
0]
getBorder Bool
True = [PDFInteger
0,PDFInteger
0,PDFInteger
1]

standardAnnotationDict :: AnnotationObject a => a -> [(PDFName,AnyPdfObject)]
standardAnnotationDict :: forall a. AnnotationObject a => a -> [(PDFName, AnyPdfObject)]
standardAnnotationDict a
a = [String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Type" (String -> PDFName
PDFName (String -> PDFName) -> String -> PDFName
forall a b. (a -> b) -> a -> b
$ String
"Annot")
                         , String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Subtype" (a -> PDFName
forall a. AnnotationObject a => a -> PDFName
annotationType a
a)
                         , String -> [PDFFloat] -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Rect" (a -> [PDFFloat]
forall a. AnnotationObject a => a -> [PDFFloat]
annotationRect a
a)
                         , String -> AnyPdfObject -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Contents" (a -> AnyPdfObject
forall a. AnnotationObject a => a -> AnyPdfObject
annotationContent a
a)
                         ]

--instance PdfObject Screen where
--   toPDF a@(Screen _ _ _ p play stop) = toPDF . dictFromList $
--        standardAnnotationDict a ++ [entry "P" p]
--                                    ++ (maybe [] (\x -> [entry "A" x]) play)
--                                    ++ (maybe [] (\x -> [entry "AA" (otherActions x)]) stop)
--         where
--             otherActions x = dictFromList $ [entry "D" 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 :: TextAnnotation -> Builder
toPDF a :: TextAnnotation
a@(TextAnnotation Text
_ [PDFFloat]
_ TextIcon
i) = PDFDictionary -> Builder
forall a. PdfObject a => a -> Builder
toPDF (PDFDictionary -> Builder)
-> ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)]
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> Builder)
-> [(PDFName, AnyPdfObject)] -> Builder
forall a b. (a -> b) -> a -> b
$
           TextAnnotation -> [(PDFName, AnyPdfObject)]
forall a. AnnotationObject a => a -> [(PDFName, AnyPdfObject)]
standardAnnotationDict TextAnnotation
a [(PDFName, AnyPdfObject)]
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. [a] -> [a] -> [a]
++ [String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Name" (String -> PDFName
PDFName (String -> PDFName) -> String -> PDFName
forall a b. (a -> b) -> a -> b
$ TextIcon -> String
forall a. Show a => a -> String
show TextIcon
i)]

instance PdfLengthInfo TextAnnotation where

instance AnnotationObject TextAnnotation where
    addAnnotation :: TextAnnotation -> PDF (PDFReference TextAnnotation)
addAnnotation = TextAnnotation -> PDF (PDFReference TextAnnotation)
forall a.
(PdfObject a, PdfLengthInfo a) =>
a -> PDF (PDFReference a)
addObject
    annotationType :: TextAnnotation -> PDFName
annotationType TextAnnotation
_ = String -> PDFName
PDFName String
"Text"
    annotationContent :: TextAnnotation -> AnyPdfObject
annotationContent (TextAnnotation Text
s [PDFFloat]
_ TextIcon
_) = PDFString -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (Text -> PDFString
toPDFString Text
s)
    annotationRect :: TextAnnotation -> [PDFFloat]
annotationRect (TextAnnotation Text
_ [PDFFloat]
r TextIcon
_) = [PDFFloat]
r
    annotationToGlobalCoordinates :: TextAnnotation -> Draw TextAnnotation
annotationToGlobalCoordinates (TextAnnotation Text
a [PDFFloat]
r TextIcon
b) = do
        [PDFFloat]
gr <- [PDFFloat] -> Draw [PDFFloat]
transformAnnotRect [PDFFloat]
r
        TextAnnotation -> Draw TextAnnotation
forall a. a -> Draw a
forall (m :: * -> *) a. Monad m => a -> m a
return (TextAnnotation -> Draw TextAnnotation)
-> TextAnnotation -> Draw TextAnnotation
forall a b. (a -> b) -> a -> b
$ Text -> [PDFFloat] -> TextIcon -> TextAnnotation
TextAnnotation Text
a [PDFFloat]
gr TextIcon
b
    
instance PdfObject URLLink where
    toPDF :: URLLink -> Builder
toPDF a :: URLLink
a@(URLLink Text
_ [PDFFloat]
_ URI
url Bool
border) = PDFDictionary -> Builder
forall a. PdfObject a => a -> Builder
toPDF (PDFDictionary -> Builder)
-> ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)]
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> Builder)
-> [(PDFName, AnyPdfObject)] -> Builder
forall a b. (a -> b) -> a -> b
$
           URLLink -> [(PDFName, AnyPdfObject)]
forall a. AnnotationObject a => a -> [(PDFName, AnyPdfObject)]
standardAnnotationDict URLLink
a [(PDFName, AnyPdfObject)]
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. [a] -> [a] -> [a]
++ 
            [ String -> GoToURL -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"A" (URI -> GoToURL
GoToURL URI
url)
            , String -> [PDFInteger] -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Border" (Bool -> [PDFInteger]
getBorder Bool
border)
            ]

instance PdfLengthInfo URLLink where
           
instance AnnotationObject URLLink where
    addAnnotation :: URLLink -> PDF (PDFReference URLLink)
addAnnotation = URLLink -> PDF (PDFReference URLLink)
forall a.
(PdfObject a, PdfLengthInfo a) =>
a -> PDF (PDFReference a)
addObject
    annotationType :: URLLink -> PDFName
annotationType URLLink
_ = String -> PDFName
PDFName String
"Link"
    annotationContent :: URLLink -> AnyPdfObject
annotationContent (URLLink Text
s [PDFFloat]
_ URI
_ Bool
_) = PDFString -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (Text -> PDFString
toPDFString Text
s)
    annotationRect :: URLLink -> [PDFFloat]
annotationRect (URLLink Text
_ [PDFFloat]
r URI
_ Bool
_) = [PDFFloat]
r
    annotationToGlobalCoordinates :: URLLink -> Draw URLLink
annotationToGlobalCoordinates (URLLink Text
a [PDFFloat]
r URI
b Bool
c) = do
        [PDFFloat]
gr <- [PDFFloat] -> Draw [PDFFloat]
transformAnnotRect [PDFFloat]
r
        URLLink -> Draw URLLink
forall a. a -> Draw a
forall (m :: * -> *) a. Monad m => a -> m a
return (URLLink -> Draw URLLink) -> URLLink -> Draw URLLink
forall a b. (a -> b) -> a -> b
$ Text -> [PDFFloat] -> URI -> Bool -> URLLink
URLLink Text
a [PDFFloat]
gr URI
b Bool
c
        
instance PdfObject PDFLink where
    toPDF :: PDFLink -> Builder
toPDF a :: PDFLink
a@(PDFLink Text
_ [PDFFloat]
_ PDFReference PDFPage
page PDFFloat
x PDFFloat
y Bool
border) = PDFDictionary -> Builder
forall a. PdfObject a => a -> Builder
toPDF (PDFDictionary -> Builder)
-> ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)]
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> Builder)
-> [(PDFName, AnyPdfObject)] -> Builder
forall a b. (a -> b) -> a -> b
$
               PDFLink -> [(PDFName, AnyPdfObject)]
forall a. AnnotationObject a => a -> [(PDFName, AnyPdfObject)]
standardAnnotationDict PDFLink
a [(PDFName, AnyPdfObject)]
-> [(PDFName, AnyPdfObject)] -> [(PDFName, AnyPdfObject)]
forall a. [a] -> [a] -> [a]
++ 
                [String -> [AnyPdfObject] -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Dest" [AnyPdfObject]
dest
                ,String -> [PDFInteger] -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Border" (Bool -> [PDFInteger]
getBorder Bool
border)]
     where
         dest :: [AnyPdfObject]
dest =  [ PDFReference PDFPage -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFPage
page
                 , PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (String -> PDFName
PDFName String
"XYZ")
                 , PDFFloat -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFFloat
x
                 , PDFFloat -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFFloat
y
                 , PDFInteger -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (Int -> PDFInteger
PDFInteger Int
0)] 
                                                        
instance PdfLengthInfo PDFLink where

instance AnnotationObject PDFLink where
    addAnnotation :: PDFLink -> PDF (PDFReference PDFLink)
addAnnotation = PDFLink -> PDF (PDFReference PDFLink)
forall a.
(PdfObject a, PdfLengthInfo a) =>
a -> PDF (PDFReference a)
addObject
    annotationType :: PDFLink -> PDFName
annotationType PDFLink
_ = String -> PDFName
PDFName String
"Link"
    annotationContent :: PDFLink -> AnyPdfObject
annotationContent (PDFLink Text
s [PDFFloat]
_ PDFReference PDFPage
_ PDFFloat
_ PDFFloat
_ Bool
_) = PDFString -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (Text -> PDFString
toPDFString Text
s)
    annotationRect :: PDFLink -> [PDFFloat]
annotationRect (PDFLink Text
_ [PDFFloat]
r PDFReference PDFPage
_ PDFFloat
_ PDFFloat
_ Bool
_) = [PDFFloat]
r
    annotationToGlobalCoordinates :: PDFLink -> Draw PDFLink
annotationToGlobalCoordinates (PDFLink Text
a [PDFFloat]
r PDFReference PDFPage
b PDFFloat
c PDFFloat
d Bool
e) = do
        [PDFFloat]
gr <- [PDFFloat] -> Draw [PDFFloat]
transformAnnotRect [PDFFloat]
r
        PDFLink -> Draw PDFLink
forall a. a -> Draw a
forall (m :: * -> *) a. Monad m => a -> m a
return (PDFLink -> Draw PDFLink) -> PDFLink -> Draw PDFLink
forall a b. (a -> b) -> a -> b
$ Text
-> [PDFFloat]
-> PDFReference PDFPage
-> PDFFloat
-> PDFFloat
-> Bool
-> PDFLink
PDFLink Text
a [PDFFloat]
gr PDFReference PDFPage
b PDFFloat
c PDFFloat
d Bool
e
        
transformAnnotRect :: [PDFFloat] -> Draw [PDFFloat]
transformAnnotRect :: [PDFFloat] -> Draw [PDFFloat]
transformAnnotRect [PDFFloat]
r = do
    [Matrix]
l <- (DrawState -> [Matrix]) -> Draw [Matrix]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DrawState -> [Matrix]
matrix
    let m :: Matrix
m = (Matrix -> Matrix -> Matrix) -> Matrix -> [Matrix] -> Matrix
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Matrix -> Matrix -> Matrix
forall a. Num a => a -> a -> a
(*) Matrix
identity [Matrix]
l
    [PDFFloat] -> Draw [PDFFloat]
forall a. a -> Draw a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PDFFloat] -> Draw [PDFFloat]) -> [PDFFloat] -> Draw [PDFFloat]
forall a b. (a -> b) -> a -> b
$ Matrix
m Matrix -> [PDFFloat] -> [PDFFloat]
`applyMatrixToRectangle` [PDFFloat]
r
    
-- | Create a new annotation object
newAnnotation :: (PdfObject a, AnnotationObject a) => a -> Draw ()
newAnnotation :: forall a. (PdfObject a, AnnotationObject a) => a -> Draw ()
newAnnotation a
annot = do
    a
annot' <- a -> Draw a
forall a. AnnotationObject a => a -> Draw a
annotationToGlobalCoordinates a
annot
    (DrawState -> DrawState) -> Draw ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((DrawState -> DrawState) -> Draw ())
-> (DrawState -> DrawState) -> Draw ()
forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s {annots = (AnyAnnotation annot'):(annots s)}
    () -> Draw ()
forall a. a -> Draw a
forall (m :: * -> *) a. Monad m => a -> m a
return ()