---------------------------------------------------------
-- |
-- Copyright   : (c) 2006-2016, alpheccar.org
-- License     : BSD-style
--
-- Maintainer  : misc@NOSPAMalpheccar.org
-- Stability   : experimental
-- Portability : portable
--
-- PDF Actions
---------------------------------------------------------

module Graphics.PDF.Action(
   -- * Actions
   -- ** Types
     Action
   , GoToURL(..)
   -- ** Functions
 ) where
     
import Graphics.PDF.LowLevel.Types
import Network.URI 


--  Media action
--data MediaAction = Play
--                 | Stop
--                 | Pause
--                 | Resume
--                 deriving(Enum)

class PdfObject a => Action a

-- | Action of going to an URL
newtype GoToURL = GoToURL URI

--data Rendition = Rendition
--instance PdfObject Rendition where
--  toPDF a = toPDF . dictFromList $
--                    [ entry "Type" (PDFName $ "Rendition")
--                    , entry "S" (PDFName $ "MR")
--                    , entry "C" movie
--                    ]
--    where
--        movie = dictFromList $
--               [ entry "Type" (PDFName $ "MediaClip")
--               , entry "S" (PDFName $ "MCD")
--               , entry "CT" (toPDFString $ "video/3gpp")
--               , entry "D" (toPDFString "17.3gp")
--               ]

--  Action to control a media
--data ControlMedia = ControlMedia MediaAction Int (PDFReference Rendition)
    
urlToPdfString :: URI -> AsciiString 
urlToPdfString :: URI -> AsciiString
urlToPdfString URI
uri = 
    let s :: String
s = (String -> String) -> URI -> String -> String
uriToString String -> String
forall a. a -> a
id URI
uri String
"" 
    in
    String -> AsciiString
toAsciiString String
s


instance PdfObject GoToURL where
    toPDF :: GoToURL -> Builder
toPDF (GoToURL URI
s) = 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
$
                         [ 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
"Action")
                         , String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"S" (String -> PDFName
PDFName String
"URI")
                         , String -> AsciiString -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"URI" (URI -> AsciiString
urlToPdfString URI
s)
                         ]
instance Action GoToURL

instance PdfLengthInfo GoToURL where


--instance PdfObject ControlMedia where
--    toPDF (ControlMedia operation relatedScreenAnnotation rendition) = toPDF . dictFromList $
--                         [ entry "Type" (PDFName $ "Action")
--                         , entry "S" (PDFName "Rendition")
--                         , entry "R" rendition
--                         , entry "OP" (PDFInteger $ fromEnum operation)
--                         , entry "AN" ((PDFReference relatedScreenAnnotation :: PDFReference AnyPdfObject))
--                         ]
--                         
--instance Action ControlMedia