---------------------------------------------------------
-- |
-- 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 qualified Data.Map.Strict as M
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextIcon -> TextIcon -> Bool
$c/= :: TextIcon -> TextIcon -> Bool
== :: TextIcon -> TextIcon -> Bool
$c== :: TextIcon -> TextIcon -> Bool
Eq,Int -> TextIcon -> ShowS
[TextIcon] -> ShowS
TextIcon -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextIcon] -> ShowS
$cshowList :: [TextIcon] -> ShowS
show :: TextIcon -> String
$cshow :: TextIcon -> String
showsPrec :: Int -> TextIcon -> ShowS
$cshowsPrec :: Int -> 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 = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [PDFFloat
xa',PDFFloat
xa'',PDFFloat
xb',PDFFloat
xb'']
        x2 :: PDFFloat
x2 = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [PDFFloat
xa',PDFFloat
xa'',PDFFloat
xb',PDFFloat
xb'']
        y1 :: PDFFloat
y1 = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [PDFFloat
ya',PDFFloat
ya'',PDFFloat
yb',PDFFloat
yb'']
        y2 :: PDFFloat
y2 = 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
aforall a. Num a => a -> a -> a
*PDFFloat
xforall a. Num a => a -> a -> a
+PDFFloat
cforall a. Num a => a -> a -> a
*PDFFloat
yforall a. Num a => a -> a -> a
+PDFFloat
e,PDFFloat
bforall a. Num a => a -> a -> a
*PDFFloat
xforall a. Num a => a -> a -> a
+PDFFloat
dforall a. Num a => a -> a -> a
*PDFFloat
yforall 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 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
"Annot")
                         , (String -> PDFName
PDFName String
"Subtype",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall a b. (a -> b) -> a -> b
$ forall a. AnnotationObject a => a -> PDFName
annotationType a
a)
                         , (String -> PDFName
PDFName String
"Rect",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 a b. (a -> b) -> a -> b
$ forall a. AnnotationObject a => a -> [PDFFloat]
annotationRect a
a)
                         , (String -> PDFName
PDFName String
"Contents",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall a b. (a -> b) -> a -> b
$ forall a. AnnotationObject a => a -> AnyPdfObject
annotationContent a
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 :: TextAnnotation -> Builder
toPDF a :: TextAnnotation
a@(TextAnnotation Text
_ [PDFFloat]
_ TextIcon
i) = forall a. PdfObject a => a -> Builder
toPDF forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary forall 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
$ 
           forall a. AnnotationObject a => a -> [(PDFName, AnyPdfObject)]
standardAnnotationDict TextAnnotation
a forall a. [a] -> [a] -> [a]
++ [(String -> PDFName
PDFName String
"Name",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
$ forall a. Show a => a -> String
show TextIcon
i)]

instance PdfLengthInfo TextAnnotation where

instance AnnotationObject TextAnnotation where
    addAnnotation :: TextAnnotation -> PDF (PDFReference TextAnnotation)
addAnnotation = 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
_) = 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
        forall (m :: * -> *) a. Monad m => a -> m a
return 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) = forall a. PdfObject a => a -> Builder
toPDF forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary forall 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
$ 
           forall a. AnnotationObject a => a -> [(PDFName, AnyPdfObject)]
standardAnnotationDict URLLink
a forall a. [a] -> [a] -> [a]
++ 
            [ (String -> PDFName
PDFName String
"A",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (URI -> GoToURL
GoToURL URI
url))
            , (String -> PDFName
PDFName String
"Border",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 a b. (a -> b) -> a -> b
$ (Bool -> [PDFInteger]
getBorder Bool
border))
            ]

instance PdfLengthInfo URLLink where
           
instance AnnotationObject URLLink where
    addAnnotation :: URLLink -> PDF (PDFReference URLLink)
addAnnotation = 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
_) = 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
        forall (m :: * -> *) a. Monad m => a -> m a
return 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) = forall a. PdfObject a => a -> Builder
toPDF forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary forall 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
$ 
               forall a. AnnotationObject a => a -> [(PDFName, AnyPdfObject)]
standardAnnotationDict PDFLink
a forall a. [a] -> [a] -> [a]
++ 
                [(String -> PDFName
PDFName String
"Dest",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject [AnyPdfObject]
dest)
                ,(String -> PDFName
PDFName String
"Border",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 a b. (a -> b) -> a -> b
$ (Bool -> [PDFInteger]
getBorder Bool
border))]
     where
         dest :: [AnyPdfObject]
dest =  [ forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference PDFPage
page
                 , forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (String -> PDFName
PDFName String
"XYZ")
                 , forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFFloat
x
                 , forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFFloat
y
                 , 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 = 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
_) = 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
        forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DrawState -> [Matrix]
matrix
    let m :: Matrix
m = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Num a => a -> a -> a
(*) Matrix
identity [Matrix]
l
    forall (m :: * -> *) a. Monad m => a -> m a
return 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' <- forall a. AnnotationObject a => a -> Draw a
annotationToGlobalCoordinates a
annot
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s {annots :: [AnyAnnotation]
annots = (forall a. (PdfObject a, AnnotationObject a) => a -> AnyAnnotation
AnyAnnotation a
annot')forall a. a -> [a] -> [a]
:(DrawState -> [AnyAnnotation]
annots DrawState
s)}
    forall (m :: * -> *) a. Monad m => a -> m a
return ()