{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveFunctor #-}
---------------------------------------------------------
-- |
-- Copyright   : (c) 2006-2016, alpheccar.org
-- License     : BSD-style
--
-- Maintainer  : misc@NOSPAMalpheccar.org
-- Stability   : experimental
-- Portability : portable
--
-- Experimental typesetting. It is a work in progress
---------------------------------------------------------

module Graphics.PDF.Typesetting(
  -- * Types
  -- ** Boxes
    Box(..)
  , DisplayableBox(..)
  , Letter(..)
  , BoxDimension
  -- ** Styles
  , Style(..)
  , TextStyle(..)
  , StyleFunction(..)
  , ParagraphStyle(..)
  , MonadStyle(..)
  , ComparableStyle(..)
  -- ** Typesetting monads
  , Para
  , TM
  -- ** Containers
  , VBox
  , VerState(..)
  , Container
  , Justification(..)
  , Orientation(..)
  -- * Functions
  -- ** Text display
  , displayFormattedText
  , styleFont
  -- ** Text construction operators
  , txt
  , kern
  , addPenalty
  , mkLetter
  , mkDrawBox
  -- ** Paragraph construction operators
  , forceNewLine
  , paragraph
  , endPara
  , startPara
  -- ** Functions useful to change the paragraph style
  , getParaStyle
  , setParaStyle
  , getWritingSystem 
  , setWritingSystem
  -- ** Container
  , mkContainer
  , fillContainer
  , defaultVerState
  , getBoxes
  , containerX
  , containerY
  , containerWidth
  , containerHeight
  , containerContentHeight
  , containerContentRightBorder
  , containerContentLeftBorder
  , containerCurrentHeight
  , containerContentRectangle
  , drawTextBox
  -- * Settings (similar to TeX ones)
  -- ** Line breaking settings
  , setFirstPassTolerance 
  , setSecondPassTolerance
  , setHyphenPenaltyValue 
  , setFitnessDemerit
  , setHyphenDemerit
  , setLinePenalty
  , getFirstPassTolerance 
  , getSecondPassTolerance
  , getHyphenPenaltyValue 
  , getFitnessDemerit
  , getHyphenDemerit
  , getLinePenalty
  , setJustification
  -- ** Vertical mode settings
  , setBaseLineSkip
  , setLineSkipLimit
  , setLineSkip
  , getBaseLineSkip
  , getLineSkipLimit
  , getLineSkip
  , module Graphics.PDF.Typesetting.StandardStyle
  ) where
  
import Graphics.PDF.LowLevel.Types
import Graphics.PDF.Draw
import Graphics.PDF.Shapes
import Graphics.PDF.Coordinates
import Control.Monad.RWS
import Graphics.PDF.Typesetting.Breaking
import Graphics.PDF.Typesetting.Vertical
import Graphics.PDF.Typesetting.Layout
import Graphics.PDF.Typesetting.Box
import Graphics.PDF.Typesetting.StandardStyle
import Graphics.PDF.Typesetting.WritingSystem
import qualified Data.Text as T

-- | Display a formatted text in a given bounding rectangle with a given default paragraph style, a given default text style. No clipping
-- is taking place. Drawing stop when the last line is crossing the bounding rectangle in vertical direction
displayFormattedText :: (ParagraphStyle ps s) => Rectangle -- ^ Text area
                     -> ps -- ^ default vertical style
                     -> s -- ^ Default horizontal style
                     -> TM ps s a -- ^ Typesetting monad
                     -> Draw a -- ^ Draw monad
displayFormattedText :: forall ps s a.
ParagraphStyle ps s =>
Rectangle -> ps -> s -> TM ps s a -> Draw a
displayFormattedText (Rectangle (PDFFloat
xa :+ PDFFloat
ya) (PDFFloat
xb :+ PDFFloat
yb)) ps
defaultVStyle s
defaultHStyle TM ps s a
t  = 
    do
    --withNewContext $ do
    --    addShape $ Rectangle (xa-1) y' (xb+1) y''
    --    closePath
    --    setAsClipPath
        let (a
a, TMState ps s
s', [VBox ps s]
boxes) = (RWS () [VBox ps s] (TMState ps s) a
-> () -> TMState ps s -> (a, TMState ps s, [VBox ps s])
forall r w s a. RWS r w s a -> r -> s -> (a, s, w)
runRWS (RWS () [VBox ps s] (TMState ps s) a
 -> () -> TMState ps s -> (a, TMState ps s, [VBox ps s]))
-> (TM ps s a -> RWS () [VBox ps s] (TMState ps s) a)
-> TM ps s a
-> ()
-> TMState ps s
-> (a, TMState ps s, [VBox ps s])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TM ps s a -> RWS () [VBox ps s] (TMState ps s) a
forall ps s a. TM ps s a -> RWS () [VBox ps s] (TMState ps s) a
unTM (TM ps s a -> () -> TMState ps s -> (a, TMState ps s, [VBox ps s]))
-> TM ps s a
-> ()
-> TMState ps s
-> (a, TMState ps s, [VBox ps s])
forall a b. (a -> b) -> a -> b
$ TM ps s a
t TM ps s a -> (a -> TM ps s a) -> TM ps s a
forall a b. TM ps s a -> (a -> TM ps s b) -> TM ps s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x' -> do {a -> TM ps s a
forall a. a -> TM ps s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x'} ) () (ps -> s -> TMState ps s
forall ps s. ParagraphStyle ps s => ps -> s -> TMState ps s
defaultTmState ps
defaultVStyle s
defaultHStyle)
            c :: Container ps s
c = PDFFloat
-> PDFFloat -> PDFFloat -> PDFFloat -> PDFFloat -> Container ps s
forall ps s.
PDFFloat
-> PDFFloat -> PDFFloat -> PDFFloat -> PDFFloat -> Container ps s
mkContainer PDFFloat
xa PDFFloat
yb (PDFFloat
xbPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
-PDFFloat
xa) (PDFFloat
ybPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
-PDFFloat
ya) PDFFloat
0
            (Draw ()
d,Container ps s
_,[VBox ps s]
_) = VerState ps
-> Container ps s
-> [VBox ps s]
-> (Draw (), Container ps s, [VBox ps s])
forall ps s.
(ParagraphStyle ps s, ComparableStyle ps) =>
VerState ps
-> Container ps s
-> [VBox ps s]
-> (Draw (), Container ps s, [VBox ps s])
fillContainer (TMState ps s -> VerState ps
forall ps s. TMState ps s -> VerState ps
pageSettings TMState ps s
s') Container ps s
forall {ps} {s}. Container ps s
c [VBox ps s]
boxes
        Draw ()
d
        a -> Draw a
forall a. a -> Draw a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
 
-- | Return the list of Vboxes for a text
getBoxes :: (ParagraphStyle ps s) => ps -- ^ default vertical style
         -> s -- ^ Default horizontal style
         -> TM ps s a -- ^ Typesetting monad
         -> [VBox ps s] -- ^ List of boxes
getBoxes :: forall ps s a.
ParagraphStyle ps s =>
ps -> s -> TM ps s a -> [VBox ps s]
getBoxes ps
defaultVStyle s
defaultHStyle TM ps s a
t  =
    let (a
_, TMState ps s
_ , [VBox ps s]
boxes) = (RWS () [VBox ps s] (TMState ps s) a
-> () -> TMState ps s -> (a, TMState ps s, [VBox ps s])
forall r w s a. RWS r w s a -> r -> s -> (a, s, w)
runRWS (RWS () [VBox ps s] (TMState ps s) a
 -> () -> TMState ps s -> (a, TMState ps s, [VBox ps s]))
-> (TM ps s a -> RWS () [VBox ps s] (TMState ps s) a)
-> TM ps s a
-> ()
-> TMState ps s
-> (a, TMState ps s, [VBox ps s])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TM ps s a -> RWS () [VBox ps s] (TMState ps s) a
forall ps s a. TM ps s a -> RWS () [VBox ps s] (TMState ps s) a
unTM (TM ps s a -> () -> TMState ps s -> (a, TMState ps s, [VBox ps s]))
-> TM ps s a
-> ()
-> TMState ps s
-> (a, TMState ps s, [VBox ps s])
forall a b. (a -> b) -> a -> b
$ TM ps s a
t TM ps s a -> (a -> TM ps s a) -> TM ps s a
forall a b. TM ps s a -> (a -> TM ps s b) -> TM ps s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x' -> do {a -> TM ps s a
forall a. a -> TM ps s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x'} ) () (ps -> s -> TMState ps s
forall ps s. ParagraphStyle ps s => ps -> s -> TMState ps s
defaultTmState ps
defaultVStyle s
defaultHStyle)
    in [VBox ps s]
boxes

-- | Add a penalty
addPenalty :: Int -> Para s ()
addPenalty :: forall s. Int -> Para s ()
addPenalty Int
f = [Letter s] -> Para s ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([Letter s] -> Para s ()) -> [Letter s] -> Para s ()
forall a b. (a -> b) -> a -> b
$ [Int -> Letter s
forall s. Int -> Letter s
penalty Int
f]
    
defaultTmState :: (ParagraphStyle ps s) => ps -> s -> TMState ps s
defaultTmState :: forall ps s. ParagraphStyle ps s => ps -> s -> TMState ps s
defaultTmState ps
s' s
s = TMState { tmStyle :: s
tmStyle = s
s
                              , paraSettings :: BRState
paraSettings = BRState
defaultBreakingSettings
                              , pageSettings :: VerState ps
pageSettings = ps -> VerState ps
forall s. s -> VerState s
defaultVerState ps
s'
                              }
    
data TMState ps s = TMState { forall ps s. TMState ps s -> s
tmStyle :: !s
                            , forall ps s. TMState ps s -> BRState
paraSettings :: !BRState
                            , forall ps s. TMState ps s -> VerState ps
pageSettings :: !(VerState ps)
                            }
                       
newtype TM ps s a = TM { forall ps s a. TM ps s a -> RWS () [VBox ps s] (TMState ps s) a
unTM :: RWS () [VBox ps s] (TMState ps s) a} 
#ifndef __HADDOCK__
  deriving(Applicative (TM ps s)
Applicative (TM ps s) =>
(forall a b. TM ps s a -> (a -> TM ps s b) -> TM ps s b)
-> (forall a b. TM ps s a -> TM ps s b -> TM ps s b)
-> (forall a. a -> TM ps s a)
-> Monad (TM ps s)
forall a. a -> TM ps s a
forall ps s. Applicative (TM ps s)
forall a b. TM ps s a -> TM ps s b -> TM ps s b
forall a b. TM ps s a -> (a -> TM ps s b) -> TM ps s b
forall ps s a. a -> TM ps s a
forall ps s a b. TM ps s a -> TM ps s b -> TM ps s b
forall ps s a b. TM ps s a -> (a -> TM ps s b) -> TM ps s b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall ps s a b. TM ps s a -> (a -> TM ps s b) -> TM ps s b
>>= :: forall a b. TM ps s a -> (a -> TM ps s b) -> TM ps s b
$c>> :: forall ps s a b. TM ps s a -> TM ps s b -> TM ps s b
>> :: forall a b. TM ps s a -> TM ps s b -> TM ps s b
$creturn :: forall ps s a. a -> TM ps s a
return :: forall a. a -> TM ps s a
Monad,Functor (TM ps s)
Functor (TM ps s) =>
(forall a. a -> TM ps s a)
-> (forall a b. TM ps s (a -> b) -> TM ps s a -> TM ps s b)
-> (forall a b c.
    (a -> b -> c) -> TM ps s a -> TM ps s b -> TM ps s c)
-> (forall a b. TM ps s a -> TM ps s b -> TM ps s b)
-> (forall a b. TM ps s a -> TM ps s b -> TM ps s a)
-> Applicative (TM ps s)
forall a. a -> TM ps s a
forall ps s. Functor (TM ps s)
forall a b. TM ps s a -> TM ps s b -> TM ps s a
forall a b. TM ps s a -> TM ps s b -> TM ps s b
forall a b. TM ps s (a -> b) -> TM ps s a -> TM ps s b
forall ps s a. a -> TM ps s a
forall a b c. (a -> b -> c) -> TM ps s a -> TM ps s b -> TM ps s c
forall ps s a b. TM ps s a -> TM ps s b -> TM ps s a
forall ps s a b. TM ps s a -> TM ps s b -> TM ps s b
forall ps s a b. TM ps s (a -> b) -> TM ps s a -> TM ps s b
forall ps s a b c.
(a -> b -> c) -> TM ps s a -> TM ps s b -> TM ps s c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall ps s a. a -> TM ps s a
pure :: forall a. a -> TM ps s a
$c<*> :: forall ps s a b. TM ps s (a -> b) -> TM ps s a -> TM ps s b
<*> :: forall a b. TM ps s (a -> b) -> TM ps s a -> TM ps s b
$cliftA2 :: forall ps s a b c.
(a -> b -> c) -> TM ps s a -> TM ps s b -> TM ps s c
liftA2 :: forall a b c. (a -> b -> c) -> TM ps s a -> TM ps s b -> TM ps s c
$c*> :: forall ps s a b. TM ps s a -> TM ps s b -> TM ps s b
*> :: forall a b. TM ps s a -> TM ps s b -> TM ps s b
$c<* :: forall ps s a b. TM ps s a -> TM ps s b -> TM ps s a
<* :: forall a b. TM ps s a -> TM ps s b -> TM ps s a
Applicative,MonadWriter [VBox ps s], MonadState (TMState ps s), (forall a b. (a -> b) -> TM ps s a -> TM ps s b)
-> (forall a b. a -> TM ps s b -> TM ps s a) -> Functor (TM ps s)
forall a b. a -> TM ps s b -> TM ps s a
forall a b. (a -> b) -> TM ps s a -> TM ps s b
forall ps s a b. a -> TM ps s b -> TM ps s a
forall ps s a b. (a -> b) -> TM ps s a -> TM ps s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall ps s a b. (a -> b) -> TM ps s a -> TM ps s b
fmap :: forall a b. (a -> b) -> TM ps s a -> TM ps s b
$c<$ :: forall ps s a b. a -> TM ps s b -> TM ps s a
<$ :: forall a b. a -> TM ps s b -> TM ps s a
Functor)
#else
instance Monad TM
instance MonadWriter [VBox ps s] TM
instance MonadState (TMState ps s) TM
instance Functor TM
#endif

newtype Para s a = Para { forall s a. Para s a -> RWS BRState [Letter s] s a
unPara :: RWS BRState [Letter s] s a} 
#ifndef __HADDOCK__
  deriving(Applicative (Para s)
Applicative (Para s) =>
(forall a b. Para s a -> (a -> Para s b) -> Para s b)
-> (forall a b. Para s a -> Para s b -> Para s b)
-> (forall a. a -> Para s a)
-> Monad (Para s)
forall s. Applicative (Para s)
forall a. a -> Para s a
forall s a. a -> Para s a
forall a b. Para s a -> Para s b -> Para s b
forall a b. Para s a -> (a -> Para s b) -> Para s b
forall s a b. Para s a -> Para s b -> Para s b
forall s a b. Para s a -> (a -> Para s b) -> Para s b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall s a b. Para s a -> (a -> Para s b) -> Para s b
>>= :: forall a b. Para s a -> (a -> Para s b) -> Para s b
$c>> :: forall s a b. Para s a -> Para s b -> Para s b
>> :: forall a b. Para s a -> Para s b -> Para s b
$creturn :: forall s a. a -> Para s a
return :: forall a. a -> Para s a
Monad,Functor (Para s)
Functor (Para s) =>
(forall a. a -> Para s a)
-> (forall a b. Para s (a -> b) -> Para s a -> Para s b)
-> (forall a b c.
    (a -> b -> c) -> Para s a -> Para s b -> Para s c)
-> (forall a b. Para s a -> Para s b -> Para s b)
-> (forall a b. Para s a -> Para s b -> Para s a)
-> Applicative (Para s)
forall s. Functor (Para s)
forall a. a -> Para s a
forall s a. a -> Para s a
forall a b. Para s a -> Para s b -> Para s a
forall a b. Para s a -> Para s b -> Para s b
forall a b. Para s (a -> b) -> Para s a -> Para s b
forall s a b. Para s a -> Para s b -> Para s a
forall s a b. Para s a -> Para s b -> Para s b
forall s a b. Para s (a -> b) -> Para s a -> Para s b
forall a b c. (a -> b -> c) -> Para s a -> Para s b -> Para s c
forall s a b c. (a -> b -> c) -> Para s a -> Para s b -> Para s c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall s a. a -> Para s a
pure :: forall a. a -> Para s a
$c<*> :: forall s a b. Para s (a -> b) -> Para s a -> Para s b
<*> :: forall a b. Para s (a -> b) -> Para s a -> Para s b
$cliftA2 :: forall s a b c. (a -> b -> c) -> Para s a -> Para s b -> Para s c
liftA2 :: forall a b c. (a -> b -> c) -> Para s a -> Para s b -> Para s c
$c*> :: forall s a b. Para s a -> Para s b -> Para s b
*> :: forall a b. Para s a -> Para s b -> Para s b
$c<* :: forall s a b. Para s a -> Para s b -> Para s a
<* :: forall a b. Para s a -> Para s b -> Para s a
Applicative,MonadWriter [Letter s], MonadReader BRState, MonadState s, (forall a b. (a -> b) -> Para s a -> Para s b)
-> (forall a b. a -> Para s b -> Para s a) -> Functor (Para s)
forall a b. a -> Para s b -> Para s a
forall a b. (a -> b) -> Para s a -> Para s b
forall s a b. a -> Para s b -> Para s a
forall s a b. (a -> b) -> Para s a -> Para s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall s a b. (a -> b) -> Para s a -> Para s b
fmap :: forall a b. (a -> b) -> Para s a -> Para s b
$c<$ :: forall s a b. a -> Para s b -> Para s a
<$ :: forall a b. a -> Para s b -> Para s a
Functor)
#else
instance Monad Para
instance MonadWriter [Letter s] Para
instance MonadState s Para
instance Functor Para
instance MonadReader BRState Para
#endif

-- | A MonadStyle where some typesetting operators can be used
class (Style s, Monad m) => MonadStyle s m | m -> s where
    -- | Set the current text style
    setStyle :: s -> m ()
    
    -- | Get the current text style
    currentStyle :: m s
    
    -- | Add a box using the current mode (horizontal or vertical. The current style is always applied to the added box)
    addBox :: (Show a, DisplayableBox a, Box a) => a 
           -> PDFFloat -- ^ Width
           -> PDFFloat -- ^ Height
           -> PDFFloat -- ^ Descent
           -> m ()
    
    -- | Add a glue using the current style
    glue :: PDFFloat -- ^ Size of glue (width or height depending on the mode)
         -> PDFFloat -- ^ Dilatation factor
         -> PDFFloat -- ^ Compression factor
         -> m ()
    
    -- | Add a glue with no style (it is just a translation)
    unstyledGlue :: PDFFloat -- ^ Size of glue (width or height depending on the mode) 
                 -> PDFFloat -- ^ Dilatation factor 
                 -> PDFFloat -- ^ Compression factor 
                 -> m ()
    
    
instance Style s => MonadStyle s (TM ps s) where
    --  Set style of text
    setStyle :: s -> TM ps s ()
setStyle s
f = (TMState ps s -> TMState ps s) -> TM ps s ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((TMState ps s -> TMState ps s) -> TM ps s ())
-> (TMState ps s -> TMState ps s) -> TM ps s ()
forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {tmStyle = f}

    --  Get current text style
    currentStyle :: TM ps s s
currentStyle = (TMState ps s -> s) -> TM ps s s
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TMState ps s -> s
forall ps s. TMState ps s -> s
tmStyle
    
    --  Add a box to the stream in vertical mode
    addBox :: forall a.
(Show a, DisplayableBox a, Box a) =>
a -> PDFFloat -> PDFFloat -> PDFFloat -> TM ps s ()
addBox a
a PDFFloat
w PDFFloat
h PDFFloat
d = do
        ps
style <- TM ps s ps
forall ps s. TM ps s ps
getParaStyle
        [VBox ps s] -> TM ps s ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([VBox ps s] -> TM ps s ()) -> [VBox ps s] -> TM ps s ()
forall a b. (a -> b) -> a -> b
$ ([PDFFloat -> BoxDimension -> AnyBox -> Maybe ps -> VBox ps s
forall ps s.
PDFFloat -> BoxDimension -> AnyBox -> Maybe ps -> VBox ps s
SomeVBox PDFFloat
0 (PDFFloat
w,PDFFloat
h,PDFFloat
d) (a -> AnyBox
forall a. (Show a, Box a, DisplayableBox a) => a -> AnyBox
AnyBox a
a) (ps -> Maybe ps
forall a. a -> Maybe a
Just ps
style)])
    
    --  Add a glue
    glue :: PDFFloat -> PDFFloat -> PDFFloat -> TM ps s ()
glue PDFFloat
h PDFFloat
y PDFFloat
z = do
        ps
style <- TM ps s ps
forall ps s. TM ps s ps
getParaStyle
        [VBox ps s] -> TM ps s ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([VBox ps s] -> TM ps s ()) -> [VBox ps s] -> TM ps s ()
forall a b. (a -> b) -> a -> b
$ [Maybe ps
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> VBox ps s
forall ps s.
Maybe ps
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> VBox ps s
vglue (ps -> Maybe ps
forall a. a -> Maybe a
Just ps
style) PDFFloat
h PDFFloat
y PDFFloat
z PDFFloat
0 PDFFloat
0]
        
    --  Add a glue
    unstyledGlue :: PDFFloat -> PDFFloat -> PDFFloat -> TM ps s ()
unstyledGlue PDFFloat
h PDFFloat
y PDFFloat
z = do
        [VBox ps s] -> TM ps s ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([VBox ps s] -> TM ps s ()) -> [VBox ps s] -> TM ps s ()
forall a b. (a -> b) -> a -> b
$ [Maybe ps
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> VBox ps s
forall ps s.
Maybe ps
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> VBox ps s
vglue Maybe ps
forall a. Maybe a
Nothing PDFFloat
h PDFFloat
y PDFFloat
z PDFFloat
0 PDFFloat
0]
    
instance Style s => MonadStyle s (Para s) where
    --  Set style of text
    setStyle :: s -> Para s ()
setStyle s
f = s -> Para s ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (s -> Para s ()) -> s -> Para s ()
forall a b. (a -> b) -> a -> b
$! s
f

    --  Get current text style
    currentStyle :: Para s s
currentStyle = Para s s
forall s (m :: * -> *). MonadState s m => m s
get
        
    --  Add a box to the stream in horizontal mode
    addBox :: forall a.
(Show a, DisplayableBox a, Box a) =>
a -> PDFFloat -> PDFFloat -> PDFFloat -> Para s ()
addBox a
a PDFFloat
w PDFFloat
h PDFFloat
d = do
        s
f <- Para s s
forall s (m :: * -> *). MonadStyle s m => m s
currentStyle
        Letter s -> Para s ()
forall s. Letter s -> Para s ()
addLetter (Letter s -> Para s ()) -> (a -> Letter s) -> a -> Para s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoxDimension -> Maybe s -> a -> Letter s
forall a s.
(Show a, Box a, DisplayableBox a) =>
BoxDimension -> Maybe s -> a -> Letter s
mkLetter (PDFFloat
w,PDFFloat
h,PDFFloat
d) (s -> Maybe s
forall a. a -> Maybe a
Just s
f) (a -> Para s ()) -> a -> Para s ()
forall a b. (a -> b) -> a -> b
$ a
a
    
    --  Add a glue
    glue :: PDFFloat -> PDFFloat -> PDFFloat -> Para s ()
glue PDFFloat
w PDFFloat
y PDFFloat
z = do
        s
f <- Para s s
forall s (m :: * -> *). MonadStyle s m => m s
currentStyle
        [Letter s] -> Para s ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([Letter s] -> Para s ()) -> [Letter s] -> Para s ()
forall a b. (a -> b) -> a -> b
$ [Maybe s -> PDFFloat -> PDFFloat -> PDFFloat -> Letter s
forall s. Maybe s -> PDFFloat -> PDFFloat -> PDFFloat -> Letter s
glueBox (s -> Maybe s
forall a. a -> Maybe a
Just s
f) PDFFloat
w PDFFloat
y PDFFloat
z]
        
    --  Add a glue
    unstyledGlue :: PDFFloat -> PDFFloat -> PDFFloat -> Para s ()
unstyledGlue PDFFloat
w PDFFloat
y PDFFloat
z = do
        [Letter s] -> Para s ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([Letter s] -> Para s ()) -> [Letter s] -> Para s ()
forall a b. (a -> b) -> a -> b
$ [Maybe s -> PDFFloat -> PDFFloat -> PDFFloat -> Letter s
forall s. Maybe s -> PDFFloat -> PDFFloat -> PDFFloat -> Letter s
glueBox Maybe s
forall a. Maybe a
Nothing PDFFloat
w PDFFloat
y PDFFloat
z]
        
-- | For a newline and end the current paragraph
forceNewLine :: Style s => Para s ()
forceNewLine :: forall s. Style s => Para s ()
forceNewLine = do
    Para s ()
forall s. Style s => Para s ()
endPara
    Para s ()
forall s. Style s => Para s ()
startPara
    
-- | End the current paragraph with or without using the same style
endFullyJustified :: Style s => Bool -- ^ True if we use the same style to end a paragraph. false for an invisible style
             -> Para s ()
endFullyJustified :: forall s. Style s => Bool -> Para s ()
endFullyJustified Bool
r = do
    if Bool
r
        then
            PDFFloat -> PDFFloat -> PDFFloat -> Para s ()
forall s (m :: * -> *).
MonadStyle s m =>
PDFFloat -> PDFFloat -> PDFFloat -> m ()
glue PDFFloat
0 PDFFloat
10000.0 PDFFloat
0
        else
            [Letter s] -> Para s ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([Letter s] -> Para s ()) -> [Letter s] -> Para s ()
forall a b. (a -> b) -> a -> b
$ [Maybe s -> PDFFloat -> PDFFloat -> PDFFloat -> Letter s
forall s. Maybe s -> PDFFloat -> PDFFloat -> PDFFloat -> Letter s
glueBox Maybe s
forall a. Maybe a
Nothing PDFFloat
0 PDFFloat
10000.0 PDFFloat
0]
    Int -> Para s ()
forall s. Int -> Para s ()
addPenalty (-Int
infinity)
     
endPara :: Style s => Para s ()
endPara :: forall s. Style s => Para s ()
endPara = do
    BRState
style <- Para s BRState
forall r (m :: * -> *). MonadReader r m => m r
ask
    s
theStyle <- Para s s
forall s (m :: * -> *). MonadStyle s m => m s
currentStyle
    let w :: PDFFloat
w = s -> PDFFloat
forall s. Style s => s -> PDFFloat
spaceWidth s
theStyle
    case BRState -> Justification
centered BRState
style of
      Justification
Centered -> do
        Letter s -> Para s ()
forall s. Letter s -> Para s ()
addLetter (Maybe s -> PDFFloat -> PDFFloat -> PDFFloat -> Letter s
forall s. Maybe s -> PDFFloat -> PDFFloat -> PDFFloat -> Letter s
glueBox (s -> Maybe s
forall a. a -> Maybe a
Just s
theStyle) PDFFloat
0 (PDFFloat
centeredDilatationFactorPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
*PDFFloat
w) PDFFloat
0)
        Letter s -> Para s ()
forall s. Letter s -> Para s ()
addLetter (Int -> Letter s
forall s. Int -> Letter s
penalty (-Int
infinity))
      Justification
RightJustification -> Int -> Para s ()
forall s. Int -> Para s ()
addPenalty (-Int
infinity) 
      Justification
_ -> Bool -> Para s ()
forall s. Style s => Bool -> Para s ()
endFullyJustified Bool
False
      
startPara :: Style s => Para s ()
startPara :: forall s. Style s => Para s ()
startPara = do
    BRState
style <- Para s BRState
forall r (m :: * -> *). MonadReader r m => m r
ask
    s
theStyle <- Para s s
forall s (m :: * -> *). MonadStyle s m => m s
currentStyle
    let w :: PDFFloat
w = s -> PDFFloat
forall s. Style s => s -> PDFFloat
spaceWidth s
theStyle
    case (BRState -> Justification
centered BRState
style) of
      Justification
Centered -> do
        Letter s -> Para s ()
forall s. Letter s -> Para s ()
addLetter (s -> PDFFloat -> Letter s
forall s. s -> PDFFloat -> Letter s
kernBox (s
theStyle) PDFFloat
0)
        Letter s -> Para s ()
forall s. Letter s -> Para s ()
addLetter (Letter s -> Para s ()) -> Letter s -> Para s ()
forall a b. (a -> b) -> a -> b
$ Int -> Letter s
forall s. Int -> Letter s
penalty Int
infinity
        Letter s -> Para s ()
forall s. Letter s -> Para s ()
addLetter (Maybe s -> PDFFloat -> PDFFloat -> PDFFloat -> Letter s
forall s. Maybe s -> PDFFloat -> PDFFloat -> PDFFloat -> Letter s
glueBox (s -> Maybe s
forall a. a -> Maybe a
Just s
theStyle) PDFFloat
0 (PDFFloat
centeredDilatationFactorPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
*PDFFloat
w) PDFFloat
0)
      Justification
RightJustification -> do
        Letter s -> Para s ()
forall s. Letter s -> Para s ()
addLetter (s -> PDFFloat -> Letter s
forall s. s -> PDFFloat -> Letter s
kernBox (s
theStyle) PDFFloat
0)
        Letter s -> Para s ()
forall s. Letter s -> Para s ()
addLetter (Letter s -> Para s ()) -> Letter s -> Para s ()
forall a b. (a -> b) -> a -> b
$ Int -> Letter s
forall s. Int -> Letter s
penalty Int
infinity
        Letter s -> Para s ()
forall s. Letter s -> Para s ()
addLetter (Maybe s -> PDFFloat -> PDFFloat -> PDFFloat -> Letter s
forall s. Maybe s -> PDFFloat -> PDFFloat -> PDFFloat -> Letter s
glueBox (s -> Maybe s
forall a. a -> Maybe a
Just s
theStyle) PDFFloat
0 (PDFFloat
rightDilatationFactorPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
*PDFFloat
w) PDFFloat
0)
      Justification
_ -> () -> Para s ()
forall a. a -> Para s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      
-- | Run a paragraph. Style changes are local to the paragraph
runPara :: Style s => Para s a -> TM ps s a
runPara :: forall s a ps. Style s => Para s a -> TM ps s a
runPara Para s a
m = do
    TMState s
f BRState
settings VerState ps
pagesettings <- TM ps s (TMState ps s)
forall s (m :: * -> *). MonadState s m => m s
get
    let (a
a, s
s', [Letter s]
boxes) = (RWS BRState [Letter s] s a -> BRState -> s -> (a, s, [Letter s])
forall r w s a. RWS r w s a -> r -> s -> (a, s, w)
runRWS (RWS BRState [Letter s] s a -> BRState -> s -> (a, s, [Letter s]))
-> (Para s a -> RWS BRState [Letter s] s a)
-> Para s a
-> BRState
-> s
-> (a, s, [Letter s])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Para s a -> RWS BRState [Letter s] s a
forall s a. Para s a -> RWS BRState [Letter s] s a
unPara (Para s a -> BRState -> s -> (a, s, [Letter s]))
-> Para s a -> BRState -> s -> (a, s, [Letter s])
forall a b. (a -> b) -> a -> b
$ Para s a
closedPara) BRState
settings s
f
    TMState ps s -> TM ps s ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (TMState ps s -> TM ps s ()) -> TMState ps s -> TM ps s ()
forall a b. (a -> b) -> a -> b
$! s -> BRState -> VerState ps -> TMState ps s
forall ps s. s -> BRState -> VerState ps -> TMState ps s
TMState s
s' BRState
settings VerState ps
pagesettings
    ps
style <- TM ps s ps
forall ps s. TM ps s ps
getParaStyle
    [VBox ps s] -> TM ps s ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([VBox ps s] -> TM ps s ()) -> [VBox ps s] -> TM ps s ()
forall a b. (a -> b) -> a -> b
$ [Int -> [Letter s] -> Maybe ps -> BRState -> VBox ps s
forall ps s. Int -> [Letter s] -> Maybe ps -> BRState -> VBox ps s
Paragraph Int
0 [Letter s]
boxes (ps -> Maybe ps
forall a. a -> Maybe a
Just ps
style) BRState
settings]
    a -> TM ps s a
forall a. a -> TM ps s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
 where
    closedPara :: Para s a
closedPara = do
        Para s ()
forall s. Style s => Para s ()
startPara
        a
x <- Para s a
m
        Para s ()
forall s. Style s => Para s ()
endPara
        a -> Para s a
forall a. a -> Para s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
    
-- | Get the current writing system for the paragraph 
getWritingSystem :: TM ps s WritingSystem 
getWritingSystem :: forall ps s. TM ps s WritingSystem
getWritingSystem = do 
  BRState
s <- (TMState ps s -> BRState) -> TM ps s BRState
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TMState ps s -> BRState
forall ps s. TMState ps s -> BRState
paraSettings 
  WritingSystem -> TM ps s WritingSystem
forall a. a -> TM ps s a
forall (m :: * -> *) a. Monad m => a -> m a
return (BRState -> WritingSystem
writingSystem BRState
s)

setWritingSystem :: WritingSystem -> TM ps s () 
setWritingSystem :: forall ps s. WritingSystem -> TM ps s ()
setWritingSystem WritingSystem
w = do 
  (TMState ps s -> TMState ps s) -> TM ps s ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((TMState ps s -> TMState ps s) -> TM ps s ())
-> (TMState ps s -> TMState ps s) -> TM ps s ()
forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {paraSettings = (paraSettings s){writingSystem = w}}

-- | Get the current paragraph style
getParaStyle :: TM ps s ps
getParaStyle :: forall ps s. TM ps s ps
getParaStyle = (TMState ps s -> VerState ps) -> TM ps s (VerState ps)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TMState ps s -> VerState ps
forall ps s. TMState ps s -> VerState ps
pageSettings TM ps s (VerState ps) -> (VerState ps -> TM ps s ps) -> TM ps s ps
forall a b. TM ps s a -> (a -> TM ps s b) -> TM ps s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RWS () [VBox ps s] (TMState ps s) ps -> TM ps s ps
forall ps s a. RWS () [VBox ps s] (TMState ps s) a -> TM ps s a
TM (RWS () [VBox ps s] (TMState ps s) ps -> TM ps s ps)
-> (VerState ps -> RWS () [VBox ps s] (TMState ps s) ps)
-> VerState ps
-> TM ps s ps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ps -> RWS () [VBox ps s] (TMState ps s) ps
forall a. a -> RWST () [VBox ps s] (TMState ps s) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ps -> RWS () [VBox ps s] (TMState ps s) ps)
-> (VerState ps -> ps)
-> VerState ps
-> RWS () [VBox ps s] (TMState ps s) ps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerState ps -> ps
forall s. VerState s -> s
currentParagraphStyle

-- | Change the current paragraph style
setParaStyle :: ParagraphStyle ps s => ps -> TM ps s ()
setParaStyle :: forall ps s. ParagraphStyle ps s => ps -> TM ps s ()
setParaStyle ps
style = do
    (TMState ps s -> TMState ps s) -> TM ps s ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((TMState ps s -> TMState ps s) -> TM ps s ())
-> (TMState ps s -> TMState ps s) -> TM ps s ()
forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {pageSettings = (pageSettings s){currentParagraphStyle = style}}

-- | Add a letter to the paragraph
addLetter :: Letter s -> Para s ()
addLetter :: forall s. Letter s -> Para s ()
addLetter Letter s
l = RWS BRState [Letter s] s () -> Para s ()
forall s a. RWS BRState [Letter s] s a -> Para s a
Para (RWS BRState [Letter s] s () -> Para s ())
-> ([Letter s] -> RWS BRState [Letter s] s ())
-> [Letter s]
-> Para s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Letter s] -> RWS BRState [Letter s] s ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([Letter s] -> Para s ()) -> [Letter s] -> Para s ()
forall a b. (a -> b) -> a -> b
$ [Letter s
l]

-- | Add a new paragraph to the text
paragraph :: Style s => Para s a -> TM ps s a
paragraph :: forall s a ps. Style s => Para s a -> TM ps s a
paragraph = Para s a -> TM ps s a
forall s a ps. Style s => Para s a -> TM ps s a
runPara

-- | Add a null char
--nullChar :: Para ()
--nullChar = Para . tell $ [nullLetter]

  

        
-- | Add a text line
txt :: Style s => T.Text -> Para s ()
txt :: forall s. Style s => Text -> Para s ()
txt Text
t = do
    s
f <- Para s s
forall s (m :: * -> *). MonadStyle s m => m s
currentStyle
    BRState
settings <- Para s BRState
forall r (m :: * -> *). MonadReader r m => m r
ask
    [Letter s] -> Para s ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([Letter s] -> Para s ()) -> [Letter s] -> Para s ()
forall a b. (a -> b) -> a -> b
$ BRState -> s -> Text -> [Letter s]
forall s. Style s => BRState -> s -> Text -> [Letter s]
splitText BRState
settings s
f Text
t

-- | add a kern (space that can be dilated or compressed and on which no line breaking can occur)
kern :: Style s => PDFFloat -> Para s ()
kern :: forall s. Style s => PDFFloat -> Para s ()
kern PDFFloat
w  = do
    s
f <- Para s s
forall s (m :: * -> *). MonadStyle s m => m s
currentStyle
    [Letter s] -> Para s ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([Letter s] -> Para s ()) -> [Letter s] -> Para s ()
forall a b. (a -> b) -> a -> b
$ [s -> PDFFloat -> Letter s
forall s. s -> PDFFloat -> Letter s
kernBox s
f PDFFloat
w]

setBaseLineSkip :: PDFFloat -> PDFFloat -> PDFFloat -> TM ps s ()
setBaseLineSkip :: forall ps s. PDFFloat -> PDFFloat -> PDFFloat -> TM ps s ()
setBaseLineSkip PDFFloat
w PDFFloat
y PDFFloat
z = (TMState ps s -> TMState ps s) -> TM ps s ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((TMState ps s -> TMState ps s) -> TM ps s ())
-> (TMState ps s -> TMState ps s) -> TM ps s ()
forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {pageSettings = (pageSettings s){baselineskip = (w,y,z)}}
 
getBaseLineSkip :: TM ps s (PDFFloat,PDFFloat,PDFFloat)
getBaseLineSkip :: forall ps s. TM ps s BoxDimension
getBaseLineSkip = do
    VerState ps
s <- (TMState ps s -> VerState ps) -> TM ps s (VerState ps)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TMState ps s -> VerState ps
forall ps s. TMState ps s -> VerState ps
pageSettings
    BoxDimension -> TM ps s BoxDimension
forall a. a -> TM ps s a
forall (m :: * -> *) a. Monad m => a -> m a
return (VerState ps -> BoxDimension
forall s. VerState s -> BoxDimension
baselineskip VerState ps
s)
    
setLineSkipLimit :: PDFFloat  -> TM ps s ()
setLineSkipLimit :: forall ps s. PDFFloat -> TM ps s ()
setLineSkipLimit PDFFloat
l = (TMState ps s -> TMState ps s) -> TM ps s ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((TMState ps s -> TMState ps s) -> TM ps s ())
-> (TMState ps s -> TMState ps s) -> TM ps s ()
forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {pageSettings = (pageSettings s){lineskiplimit=l}}

getLineSkipLimit :: TM ps s PDFFloat
getLineSkipLimit :: forall ps s. TM ps s PDFFloat
getLineSkipLimit = (TMState ps s -> VerState ps) -> TM ps s (VerState ps)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TMState ps s -> VerState ps
forall ps s. TMState ps s -> VerState ps
pageSettings TM ps s (VerState ps)
-> (VerState ps -> TM ps s PDFFloat) -> TM ps s PDFFloat
forall a b. TM ps s a -> (a -> TM ps s b) -> TM ps s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PDFFloat -> TM ps s PDFFloat
forall a. a -> TM ps s a
forall (m :: * -> *) a. Monad m => a -> m a
return (PDFFloat -> TM ps s PDFFloat)
-> (VerState ps -> PDFFloat) -> VerState ps -> TM ps s PDFFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerState ps -> PDFFloat
forall s. VerState s -> PDFFloat
lineskiplimit

setLineSkip :: PDFFloat -> PDFFloat -> PDFFloat -> TM ps s ()
setLineSkip :: forall ps s. PDFFloat -> PDFFloat -> PDFFloat -> TM ps s ()
setLineSkip PDFFloat
w PDFFloat
y PDFFloat
z = (TMState ps s -> TMState ps s) -> TM ps s ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((TMState ps s -> TMState ps s) -> TM ps s ())
-> (TMState ps s -> TMState ps s) -> TM ps s ()
forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {pageSettings = (pageSettings s){lineskip = (w,y,z)}}

getLineSkip :: TM ps s (PDFFloat,PDFFloat,PDFFloat)
getLineSkip :: forall ps s. TM ps s BoxDimension
getLineSkip = (TMState ps s -> VerState ps) -> TM ps s (VerState ps)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TMState ps s -> VerState ps
forall ps s. TMState ps s -> VerState ps
pageSettings TM ps s (VerState ps)
-> (VerState ps -> TM ps s BoxDimension) -> TM ps s BoxDimension
forall a b. TM ps s a -> (a -> TM ps s b) -> TM ps s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BoxDimension -> TM ps s BoxDimension
forall a. a -> TM ps s a
forall (m :: * -> *) a. Monad m => a -> m a
return (BoxDimension -> TM ps s BoxDimension)
-> (VerState ps -> BoxDimension)
-> VerState ps
-> TM ps s BoxDimension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerState ps -> BoxDimension
forall s. VerState s -> BoxDimension
lineskip
    
setFirstPassTolerance :: PDFFloat -> TM ps s ()
setFirstPassTolerance :: forall ps s. PDFFloat -> TM ps s ()
setFirstPassTolerance PDFFloat
x = (TMState ps s -> TMState ps s) -> TM ps s ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((TMState ps s -> TMState ps s) -> TM ps s ())
-> (TMState ps s -> TMState ps s) -> TM ps s ()
forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {paraSettings = (paraSettings s){firstPassTolerance = x}}

getFirstPassTolerance :: TM ps s PDFFloat
getFirstPassTolerance :: forall ps s. TM ps s PDFFloat
getFirstPassTolerance = (TMState ps s -> BRState) -> TM ps s BRState
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TMState ps s -> BRState
forall ps s. TMState ps s -> BRState
paraSettings TM ps s BRState
-> (BRState -> TM ps s PDFFloat) -> TM ps s PDFFloat
forall a b. TM ps s a -> (a -> TM ps s b) -> TM ps s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PDFFloat -> TM ps s PDFFloat
forall a. a -> TM ps s a
forall (m :: * -> *) a. Monad m => a -> m a
return (PDFFloat -> TM ps s PDFFloat)
-> (BRState -> PDFFloat) -> BRState -> TM ps s PDFFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BRState -> PDFFloat
firstPassTolerance

setSecondPassTolerance :: PDFFloat -> TM ps s ()
setSecondPassTolerance :: forall ps s. PDFFloat -> TM ps s ()
setSecondPassTolerance PDFFloat
x = (TMState ps s -> TMState ps s) -> TM ps s ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((TMState ps s -> TMState ps s) -> TM ps s ())
-> (TMState ps s -> TMState ps s) -> TM ps s ()
forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {paraSettings = (paraSettings s){secondPassTolerance = x}}

getSecondPassTolerance :: TM ps s PDFFloat
getSecondPassTolerance :: forall ps s. TM ps s PDFFloat
getSecondPassTolerance = (TMState ps s -> BRState) -> TM ps s BRState
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TMState ps s -> BRState
forall ps s. TMState ps s -> BRState
paraSettings TM ps s BRState
-> (BRState -> TM ps s PDFFloat) -> TM ps s PDFFloat
forall a b. TM ps s a -> (a -> TM ps s b) -> TM ps s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PDFFloat -> TM ps s PDFFloat
forall a. a -> TM ps s a
forall (m :: * -> *) a. Monad m => a -> m a
return (PDFFloat -> TM ps s PDFFloat)
-> (BRState -> PDFFloat) -> BRState -> TM ps s PDFFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BRState -> PDFFloat
secondPassTolerance

setHyphenPenaltyValue :: Int -> TM ps s ()
setHyphenPenaltyValue :: forall ps s. Int -> TM ps s ()
setHyphenPenaltyValue Int
x = (TMState ps s -> TMState ps s) -> TM ps s ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((TMState ps s -> TMState ps s) -> TM ps s ())
-> (TMState ps s -> TMState ps s) -> TM ps s ()
forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {paraSettings = (paraSettings s){hyphenPenaltyValue = x}}

getHyphenPenaltyValue :: TM ps s Int
getHyphenPenaltyValue :: forall ps s. TM ps s Int
getHyphenPenaltyValue = (TMState ps s -> BRState) -> TM ps s BRState
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TMState ps s -> BRState
forall ps s. TMState ps s -> BRState
paraSettings TM ps s BRState -> (BRState -> TM ps s Int) -> TM ps s Int
forall a b. TM ps s a -> (a -> TM ps s b) -> TM ps s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> TM ps s Int
forall a. a -> TM ps s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> TM ps s Int) -> (BRState -> Int) -> BRState -> TM ps s Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BRState -> Int
hyphenPenaltyValue

setFitnessDemerit :: PDFFloat -> TM ps s ()
setFitnessDemerit :: forall ps s. PDFFloat -> TM ps s ()
setFitnessDemerit PDFFloat
x = (TMState ps s -> TMState ps s) -> TM ps s ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((TMState ps s -> TMState ps s) -> TM ps s ())
-> (TMState ps s -> TMState ps s) -> TM ps s ()
forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {paraSettings = (paraSettings s){fitness_demerit = x}}

getFitnessDemerit :: TM ps s PDFFloat
getFitnessDemerit :: forall ps s. TM ps s PDFFloat
getFitnessDemerit = (TMState ps s -> BRState) -> TM ps s BRState
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TMState ps s -> BRState
forall ps s. TMState ps s -> BRState
paraSettings TM ps s BRState
-> (BRState -> TM ps s PDFFloat) -> TM ps s PDFFloat
forall a b. TM ps s a -> (a -> TM ps s b) -> TM ps s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PDFFloat -> TM ps s PDFFloat
forall a. a -> TM ps s a
forall (m :: * -> *) a. Monad m => a -> m a
return (PDFFloat -> TM ps s PDFFloat)
-> (BRState -> PDFFloat) -> BRState -> TM ps s PDFFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BRState -> PDFFloat
fitness_demerit

setHyphenDemerit :: PDFFloat -> TM ps s ()
setHyphenDemerit :: forall ps s. PDFFloat -> TM ps s ()
setHyphenDemerit PDFFloat
x = (TMState ps s -> TMState ps s) -> TM ps s ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((TMState ps s -> TMState ps s) -> TM ps s ())
-> (TMState ps s -> TMState ps s) -> TM ps s ()
forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {paraSettings = (paraSettings s){flagged_demerit = x}}

getHyphenDemerit :: TM ps s PDFFloat
getHyphenDemerit :: forall ps s. TM ps s PDFFloat
getHyphenDemerit = (TMState ps s -> BRState) -> TM ps s BRState
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TMState ps s -> BRState
forall ps s. TMState ps s -> BRState
paraSettings TM ps s BRState
-> (BRState -> TM ps s PDFFloat) -> TM ps s PDFFloat
forall a b. TM ps s a -> (a -> TM ps s b) -> TM ps s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PDFFloat -> TM ps s PDFFloat
forall a. a -> TM ps s a
forall (m :: * -> *) a. Monad m => a -> m a
return (PDFFloat -> TM ps s PDFFloat)
-> (BRState -> PDFFloat) -> BRState -> TM ps s PDFFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BRState -> PDFFloat
flagged_demerit
  
setLinePenalty :: PDFFloat -> TM ps s ()
setLinePenalty :: forall ps s. PDFFloat -> TM ps s ()
setLinePenalty PDFFloat
x = (TMState ps s -> TMState ps s) -> TM ps s ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((TMState ps s -> TMState ps s) -> TM ps s ())
-> (TMState ps s -> TMState ps s) -> TM ps s ()
forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {paraSettings = (paraSettings s){line_penalty = x}}
                   
getLinePenalty :: TM ps s PDFFloat
getLinePenalty :: forall ps s. TM ps s PDFFloat
getLinePenalty = (TMState ps s -> BRState) -> TM ps s BRState
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TMState ps s -> BRState
forall ps s. TMState ps s -> BRState
paraSettings TM ps s BRState
-> (BRState -> TM ps s PDFFloat) -> TM ps s PDFFloat
forall a b. TM ps s a -> (a -> TM ps s b) -> TM ps s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PDFFloat -> TM ps s PDFFloat
forall a. a -> TM ps s a
forall (m :: * -> *) a. Monad m => a -> m a
return (PDFFloat -> TM ps s PDFFloat)
-> (BRState -> PDFFloat) -> BRState -> TM ps s PDFFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BRState -> PDFFloat
line_penalty

setJustification :: Justification -- ^ Centered, left or fully justified
                 -> TM ps s ()
setJustification :: forall ps s. Justification -> TM ps s ()
setJustification Justification
j = (TMState ps s -> TMState ps s) -> TM ps s ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((TMState ps s -> TMState ps s) -> TM ps s ())
-> (TMState ps s -> TMState ps s) -> TM ps s ()
forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {paraSettings = (paraSettings s){centered = j}}

-------------------------------
--
-- Tools to ease tech drawings
--
-------------------------------

data Orientation = E | W | N | S | NE | NW | SE | SW deriving(Orientation -> Orientation -> Bool
(Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool) -> Eq Orientation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Orientation -> Orientation -> Bool
== :: Orientation -> Orientation -> Bool
$c/= :: Orientation -> Orientation -> Bool
/= :: Orientation -> Orientation -> Bool
Eq,Int -> Orientation -> ShowS
[Orientation] -> ShowS
Orientation -> String
(Int -> Orientation -> ShowS)
-> (Orientation -> String)
-> ([Orientation] -> ShowS)
-> Show Orientation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Orientation -> ShowS
showsPrec :: Int -> Orientation -> ShowS
$cshow :: Orientation -> String
show :: Orientation -> String
$cshowList :: [Orientation] -> ShowS
showList :: [Orientation] -> ShowS
Show)

-- | Draw a text box with relative position. Useful for labels
drawTextBox :: (ParagraphStyle ps s, Style s) 
            => PDFFloat -- ^ x
            -> PDFFloat -- ^ y
            -> PDFFloat -- ^ width limit
            -> PDFFloat -- ^ height limit
            -> Orientation
            -> ps -- ^ default vertical style
            -> s -- ^ Default horizontal style
            -> TM ps s a -- ^ Typesetting monad
            -> (Rectangle,Draw ())
drawTextBox :: forall ps s a.
(ParagraphStyle ps s, Style s) =>
PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> Orientation
-> ps
-> s
-> TM ps s a
-> (Rectangle, Draw ())
drawTextBox PDFFloat
x PDFFloat
y PDFFloat
w PDFFloat
h Orientation
ori ps
ps s
p TM ps s a
t = 
    let b :: [VBox ps s]
b = ps -> s -> TM ps s a -> [VBox ps s]
forall ps s a.
ParagraphStyle ps s =>
ps -> s -> TM ps s a -> [VBox ps s]
getBoxes ps
ps s
p TM ps s a
t
        sh :: PDFFloat
sh = s -> PDFFloat
forall s. Style s => s -> PDFFloat
styleHeight s
p
        c :: Container ps s
c = PDFFloat
-> PDFFloat -> PDFFloat -> PDFFloat -> PDFFloat -> Container ps s
forall ps s.
PDFFloat
-> PDFFloat -> PDFFloat -> PDFFloat -> PDFFloat -> Container ps s
mkContainer PDFFloat
0 PDFFloat
0 PDFFloat
w PDFFloat
h PDFFloat
sh
        (Draw ()
d,Container ps s
c',[VBox ps s]
_) = VerState ps
-> Container ps s
-> [VBox ps s]
-> (Draw (), Container ps s, [VBox ps s])
forall ps s.
(ParagraphStyle ps s, ComparableStyle ps) =>
VerState ps
-> Container ps s
-> [VBox ps s]
-> (Draw (), Container ps s, [VBox ps s])
fillContainer (ps -> VerState ps
forall s. s -> VerState s
defaultVerState ps
ps) Container ps s
forall {ps} {s}. Container ps s
c [VBox ps s]
b
        Rectangle (PDFFloat
xa :+ PDFFloat
ya) (PDFFloat
xb :+ PDFFloat
yb)  = Container ps s -> Rectangle
forall ps s. Container ps s -> Rectangle
containerContentRectangle  Container ps s
c'
        wc :: PDFFloat
wc = PDFFloat
xb PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- PDFFloat
xa
        hc :: PDFFloat
hc = PDFFloat
yb PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- PDFFloat
ya
        (PDFFloat
dx,PDFFloat
dy) = case Orientation
ori of
          Orientation
NE -> (PDFFloat
x,PDFFloat
y)
          Orientation
NW -> (PDFFloat
x PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- PDFFloat
wc,PDFFloat
y)
          Orientation
SE -> (PDFFloat
x,PDFFloat
y PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+ PDFFloat
hc)
          Orientation
SW -> (PDFFloat
x PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- PDFFloat
wc,PDFFloat
y PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+ PDFFloat
hc)
          Orientation
E -> (PDFFloat
x,PDFFloat
y PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+ PDFFloat
hc PDFFloat -> PDFFloat -> PDFFloat
forall a. Fractional a => a -> a -> a
/ PDFFloat
2.0)
          Orientation
W -> (PDFFloat
x PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- PDFFloat
wc,PDFFloat
y PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+ PDFFloat
hc PDFFloat -> PDFFloat -> PDFFloat
forall a. Fractional a => a -> a -> a
/ PDFFloat
2.0)
          Orientation
N -> (PDFFloat
x PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- PDFFloat
wcPDFFloat -> PDFFloat -> PDFFloat
forall a. Fractional a => a -> a -> a
/PDFFloat
2.0,PDFFloat
y)
          Orientation
S -> (PDFFloat
x PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- PDFFloat
wcPDFFloat -> PDFFloat -> PDFFloat
forall a. Fractional a => a -> a -> a
/PDFFloat
2.0,PDFFloat
y PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+ PDFFloat
hc)
        box :: Draw ()
box = Draw () -> Draw ()
forall a. Draw a -> Draw a
withNewContext (Draw () -> Draw ()) -> Draw () -> Draw ()
forall a b. (a -> b) -> a -> b
$ do
           Matrix -> Draw ()
applyMatrix (Matrix -> Draw ()) -> Matrix -> Draw ()
forall a b. (a -> b) -> a -> b
$ Complex PDFFloat -> Matrix
translate (PDFFloat
dx PDFFloat -> PDFFloat -> Complex PDFFloat
forall a. a -> a -> Complex a
:+ PDFFloat
dy)
           Draw ()
d
        r :: Rectangle
r = Complex PDFFloat -> Complex PDFFloat -> Rectangle
Rectangle ((PDFFloat
xa PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+ PDFFloat
dx) PDFFloat -> PDFFloat -> Complex PDFFloat
forall a. a -> a -> Complex a
:+ (PDFFloat
ya PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+ PDFFloat
dy)) ((PDFFloat
xb PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+ PDFFloat
dx) PDFFloat -> PDFFloat -> Complex PDFFloat
forall a. a -> a -> Complex a
:+ (PDFFloat
yb PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+ PDFFloat
dy))
    in
    (Rectangle
r,Draw ()
box)