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

module Graphics.PDF.Navigation(
  -- * Navigation
  -- ** Types
    OutlineStyle(..)
  -- ** Functions
  , newSection
  , newSectionWithPage
 ) where
     
import Graphics.PDF.Pages
import Graphics.PDF.Draw
import Graphics.PDF.LowLevel.Types
import Control.Monad.State(gets)
import Control.Monad(when)
import Data.Maybe(isNothing)
import qualified Data.Text as T

-- | True if we are adding the first outline to this level
isFirst :: [Bool] -> Bool
isFirst :: [Bool] -> Bool
isFirst [Bool]
r = [Bool] -> Bool
forall a. [a] -> a
head [Bool]
r
  
-- | Start a new outline level  
startNew :: PDF ()
startNew :: PDF ()
startNew = (PdfState -> PdfState) -> PDF ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((PdfState -> PdfState) -> PDF ())
-> (PdfState -> PdfState) -> PDF ()
forall a b. (a -> b) -> a -> b
$ \PdfState
s -> PdfState
s{firstOutline :: [Bool]
firstOutline = Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:(PdfState -> [Bool]
firstOutline PdfState
s)}

-- | We remember there are outlines at this level
addedOutline :: PDF ()
addedOutline :: PDF ()
addedOutline = (PdfState -> PdfState) -> PDF ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((PdfState -> PdfState) -> PDF ())
-> (PdfState -> PdfState) -> PDF ()
forall a b. (a -> b) -> a -> b
$ \PdfState
s -> PdfState
s{firstOutline :: [Bool]
firstOutline = Bool
FalseBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool] -> [Bool]
forall a. [a] -> [a]
tail (PdfState -> [Bool]
firstOutline PdfState
s)}

-- | Close an outline level
closeNew :: PDF()
closeNew :: PDF ()
closeNew = do
    [Bool]
r <- (PdfState -> [Bool]) -> PDF [Bool]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> [Bool]
firstOutline
    Bool -> PDF () -> PDF ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([Bool] -> Bool
isFirst [Bool]
r)) (PDF () -> PDF ()) -> PDF () -> PDF ()
forall a b. (a -> b) -> a -> b
$ PDF ()
moveToParent
    (PdfState -> PdfState) -> PDF ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((PdfState -> PdfState) -> PDF ())
-> (PdfState -> PdfState) -> PDF ()
forall a b. (a -> b) -> a -> b
$ \PdfState
s -> PdfState
s{firstOutline :: [Bool]
firstOutline = [Bool] -> [Bool]
forall a. [a] -> [a]
tail (PdfState -> [Bool]
firstOutline PdfState
s)}

-- | Create a new outline section pointing to the last created page
newSection :: T.Text -- ^ Outline title
           -> Maybe Color -- ^ Outline color
           -> Maybe OutlineStyle -- ^Outline style
           -> PDF ()
           -> PDF ()
newSection :: Text -> Maybe Color -> Maybe OutlineStyle -> PDF () -> PDF ()
newSection Text
myS Maybe Color
col Maybe OutlineStyle
style PDF ()
p = PDFString
-> Maybe Color
-> Maybe OutlineStyle
-> Maybe (PDFReference PDFPage)
-> PDF ()
-> PDF ()
newSectionPrivate (Text -> PDFString
toPDFString Text
myS) Maybe Color
col Maybe OutlineStyle
style Maybe (PDFReference PDFPage)
forall a. Maybe a
Nothing PDF ()
p

-- | Create a new outline section pointing to a given page
newSectionWithPage :: T.Text -- ^ Outline title
                   -> Maybe Color -- ^ Outline color
                   -> Maybe OutlineStyle -- ^ Outline style
                   -> PDFReference PDFPage -- ^ Page reference
                   -> PDF ()
                   -> PDF ()
newSectionWithPage :: Text
-> Maybe Color
-> Maybe OutlineStyle
-> PDFReference PDFPage
-> PDF ()
-> PDF ()
newSectionWithPage Text
myS Maybe Color
col Maybe OutlineStyle
style PDFReference PDFPage
page PDF ()
p = PDFString
-> Maybe Color
-> Maybe OutlineStyle
-> Maybe (PDFReference PDFPage)
-> PDF ()
-> PDF ()
newSectionPrivate (Text -> PDFString
toPDFString Text
myS) Maybe Color
col Maybe OutlineStyle
style (PDFReference PDFPage -> Maybe (PDFReference PDFPage)
forall a. a -> Maybe a
Just PDFReference PDFPage
page) PDF ()
p
    
newSectionPrivate :: PDFString -- ^ Outline title
                  -> Maybe Color -- ^ Outline color
                  -> Maybe OutlineStyle -- ^Outline style
                  -> Maybe (PDFReference PDFPage)
                  -> PDF ()
                  -> PDF ()
newSectionPrivate :: PDFString
-> Maybe Color
-> Maybe OutlineStyle
-> Maybe (PDFReference PDFPage)
-> PDF ()
-> PDF ()
newSectionPrivate PDFString
myS Maybe Color
col Maybe OutlineStyle
style Maybe (PDFReference PDFPage)
page PDF ()
p = do
       let newlevel :: PDF ()
newlevel = do
            PDF ()
startNew
            PDF ()
p
            PDF ()
closeNew
       [Bool]
r <- (PdfState -> [Bool]) -> PDF [Bool]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> [Bool]
firstOutline
       if [Bool] -> Bool
isFirst [Bool]
r
        then do
            if [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 
             then do
                PDFString
-> Maybe Color
-> Maybe OutlineStyle
-> Maybe (PDFReference PDFPage)
-> PDF ()
newChild PDFString
myS Maybe Color
col Maybe OutlineStyle
style Maybe (PDFReference PDFPage)
page
                PDF ()
addedOutline
                PDF ()
newlevel
             else do
                PDFString
-> Maybe Color
-> Maybe OutlineStyle
-> Maybe (PDFReference PDFPage)
-> PDF ()
newSibling PDFString
myS Maybe Color
col Maybe OutlineStyle
style Maybe (PDFReference PDFPage)
page
                PDF ()
newlevel
        else do
           PDFString
-> Maybe Color
-> Maybe OutlineStyle
-> Maybe (PDFReference PDFPage)
-> PDF ()
newSibling PDFString
myS Maybe Color
col Maybe OutlineStyle
style Maybe (PDFReference PDFPage)
page
           PDF ()
newlevel                  
                   
newSibling :: PDFString -- ^ Outline title
           -> Maybe Color -- ^ Outline color
           -> Maybe OutlineStyle -- ^Outline style
           -> Maybe (PDFReference PDFPage)
           -> PDF ()
newSibling :: PDFString
-> Maybe Color
-> Maybe OutlineStyle
-> Maybe (PDFReference PDFPage)
-> PDF ()
newSibling PDFString
myS Maybe Color
col Maybe OutlineStyle
style Maybe (PDFReference PDFPage)
page = do
    Maybe (PDFReference PDFPage)
p <- if Maybe (PDFReference PDFPage) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (PDFReference PDFPage)
page then (PdfState -> Maybe (PDFReference PDFPage))
-> PDF (Maybe (PDFReference PDFPage))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> Maybe (PDFReference PDFPage)
currentPage else Maybe (PDFReference PDFPage) -> PDF (Maybe (PDFReference PDFPage))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (PDFReference PDFPage)
page
    case Maybe (PDFReference PDFPage)
p of
        Maybe (PDFReference PDFPage)
Nothing -> () -> PDF ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just PDFReference PDFPage
aPage -> do
            Maybe Outline
ot <- (PdfState -> Maybe Outline) -> PDF (Maybe Outline)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> Maybe Outline
outline
            let myValue :: (PDFString, Maybe Color, Maybe OutlineStyle, Destination)
myValue = (PDFString
myS,Maybe Color
col,Maybe OutlineStyle
style,PDFReference PDFPage -> Destination
Destination PDFReference PDFPage
aPage)
            case Maybe Outline
ot of
                Maybe Outline
Nothing -> (PdfState -> PdfState) -> PDF ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((PdfState -> PdfState) -> PDF ())
-> (PdfState -> PdfState) -> PDF ()
forall a b. (a -> b) -> a -> b
$ \PdfState
s -> PdfState
s {outline :: Maybe Outline
outline = Outline -> Maybe Outline
forall a. a -> Maybe a
Just (Outline -> Maybe Outline) -> Outline -> Maybe Outline
forall a b. (a -> b) -> a -> b
$ (PDFString, Maybe Color, Maybe OutlineStyle, Destination)
-> Outline -> Outline
forall a. a -> OutlineLoc a -> OutlineLoc a
insertDown (PDFString, Maybe Color, Maybe OutlineStyle, Destination)
myValue (Tree (PDFString, Maybe Color, Maybe OutlineStyle, Destination)
-> OutlineCtx
     (PDFString, Maybe Color, Maybe OutlineStyle, Destination)
-> Outline
forall a. Tree a -> OutlineCtx a -> OutlineLoc a
OutlineLoc ((PDFString, Maybe Color, Maybe OutlineStyle, Destination)
-> [Tree (PDFString, Maybe Color, Maybe OutlineStyle, Destination)]
-> Tree (PDFString, Maybe Color, Maybe OutlineStyle, Destination)
forall a. a -> [Tree a] -> Tree a
Node (PDFString, Maybe Color, Maybe OutlineStyle, Destination)
myValue []) OutlineCtx
  (PDFString, Maybe Color, Maybe OutlineStyle, Destination)
forall a. OutlineCtx a
Top)}
                Just Outline
r -> (PdfState -> PdfState) -> PDF ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((PdfState -> PdfState) -> PDF ())
-> (PdfState -> PdfState) -> PDF ()
forall a b. (a -> b) -> a -> b
$ \PdfState
s -> PdfState
s {outline :: Maybe Outline
outline = Outline -> Maybe Outline
forall a. a -> Maybe a
Just (Outline -> Maybe Outline) -> Outline -> Maybe Outline
forall a b. (a -> b) -> a -> b
$ (PDFString, Maybe Color, Maybe OutlineStyle, Destination)
-> Outline -> Outline
forall a. a -> OutlineLoc a -> OutlineLoc a
insertRight (PDFString, Maybe Color, Maybe OutlineStyle, Destination)
myValue Outline
r}
                
newChild :: PDFString -- ^ Outline title
         -> Maybe Color -- ^ Outline color
         -> Maybe OutlineStyle -- ^Outline style
         -> Maybe (PDFReference PDFPage)
         -> PDF ()
newChild :: PDFString
-> Maybe Color
-> Maybe OutlineStyle
-> Maybe (PDFReference PDFPage)
-> PDF ()
newChild PDFString
myS Maybe Color
col Maybe OutlineStyle
style Maybe (PDFReference PDFPage)
page = do
    Maybe (PDFReference PDFPage)
p <- if Maybe (PDFReference PDFPage) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (PDFReference PDFPage)
page then (PdfState -> Maybe (PDFReference PDFPage))
-> PDF (Maybe (PDFReference PDFPage))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> Maybe (PDFReference PDFPage)
currentPage else Maybe (PDFReference PDFPage) -> PDF (Maybe (PDFReference PDFPage))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (PDFReference PDFPage)
page
    case Maybe (PDFReference PDFPage)
p of
        Maybe (PDFReference PDFPage)
Nothing -> () -> PDF ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just PDFReference PDFPage
aPage -> do
            Maybe Outline
ot <- (PdfState -> Maybe Outline) -> PDF (Maybe Outline)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> Maybe Outline
outline
            let myValue :: (PDFString, Maybe Color, Maybe OutlineStyle, Destination)
myValue = (PDFString
myS,Maybe Color
col,Maybe OutlineStyle
style,PDFReference PDFPage -> Destination
Destination PDFReference PDFPage
aPage)
            case Maybe Outline
ot of
                Maybe Outline
Nothing -> (PdfState -> PdfState) -> PDF ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((PdfState -> PdfState) -> PDF ())
-> (PdfState -> PdfState) -> PDF ()
forall a b. (a -> b) -> a -> b
$ \PdfState
s -> PdfState
s {outline :: Maybe Outline
outline = Outline -> Maybe Outline
forall a. a -> Maybe a
Just (Outline -> Maybe Outline) -> Outline -> Maybe Outline
forall a b. (a -> b) -> a -> b
$ (PDFString, Maybe Color, Maybe OutlineStyle, Destination)
-> Outline -> Outline
forall a. a -> OutlineLoc a -> OutlineLoc a
insertDown (PDFString, Maybe Color, Maybe OutlineStyle, Destination)
myValue (Tree (PDFString, Maybe Color, Maybe OutlineStyle, Destination)
-> OutlineCtx
     (PDFString, Maybe Color, Maybe OutlineStyle, Destination)
-> Outline
forall a. Tree a -> OutlineCtx a -> OutlineLoc a
OutlineLoc ((PDFString, Maybe Color, Maybe OutlineStyle, Destination)
-> [Tree (PDFString, Maybe Color, Maybe OutlineStyle, Destination)]
-> Tree (PDFString, Maybe Color, Maybe OutlineStyle, Destination)
forall a. a -> [Tree a] -> Tree a
Node (PDFString, Maybe Color, Maybe OutlineStyle, Destination)
myValue []) OutlineCtx
  (PDFString, Maybe Color, Maybe OutlineStyle, Destination)
forall a. OutlineCtx a
Top)}
                Just Outline
r -> (PdfState -> PdfState) -> PDF ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((PdfState -> PdfState) -> PDF ())
-> (PdfState -> PdfState) -> PDF ()
forall a b. (a -> b) -> a -> b
$ \PdfState
s -> PdfState
s {outline :: Maybe Outline
outline = Outline -> Maybe Outline
forall a. a -> Maybe a
Just (Outline -> Maybe Outline) -> Outline -> Maybe Outline
forall a b. (a -> b) -> a -> b
$ (PDFString, Maybe Color, Maybe OutlineStyle, Destination)
-> Outline -> Outline
forall a. a -> OutlineLoc a -> OutlineLoc a
insertDown (PDFString, Maybe Color, Maybe OutlineStyle, Destination)
myValue Outline
r}
                
moveToParent :: PDF ()
moveToParent :: PDF ()
moveToParent = do
    Maybe Outline
ot <- (PdfState -> Maybe Outline) -> PDF (Maybe Outline)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PdfState -> Maybe Outline
outline
    case Maybe Outline
ot of
       Maybe Outline
Nothing -> () -> PDF ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just Outline
r -> (PdfState -> PdfState) -> PDF ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((PdfState -> PdfState) -> PDF ())
-> (PdfState -> PdfState) -> PDF ()
forall a b. (a -> b) -> a -> b
$ \PdfState
s -> PdfState
s {outline :: Maybe Outline
outline = Outline -> Maybe Outline
forall a. a -> Maybe a
Just (Outline -> Maybe Outline) -> Outline -> Maybe Outline
forall a b. (a -> b) -> a -> b
$ Outline -> Outline
forall a. OutlineLoc a -> OutlineLoc a
up Outline
r}