{-# 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) = (forall r w s a. RWS r w s a -> r -> s -> (a, s, w)
runRWS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ps s a. TM ps s a -> RWS () [VBox ps s] (TMState ps s) a
unTM forall a b. (a -> b) -> a -> b
$ TM ps s a
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x' -> do {forall (m :: * -> *) a. Monad m => a -> m a
return a
x'} ) () (forall ps s. ParagraphStyle ps s => ps -> s -> TMState ps s
defaultTmState ps
defaultVStyle s
defaultHStyle)
            c :: Container ps s
c = forall ps s.
PDFFloat
-> PDFFloat -> PDFFloat -> PDFFloat -> PDFFloat -> Container ps s
mkContainer PDFFloat
xa PDFFloat
yb (PDFFloat
xbforall a. Num a => a -> a -> a
-PDFFloat
xa) (PDFFloat
ybforall a. Num a => a -> a -> a
-PDFFloat
ya) PDFFloat
0
            (Draw ()
d,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 (forall ps s. TMState ps s -> VerState ps
pageSettings TMState ps s
s') forall {ps} {s}. Container ps s
c [VBox ps s]
boxes
        Draw ()
d
        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) = (forall r w s a. RWS r w s a -> r -> s -> (a, s, w)
runRWS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ps s a. TM ps s a -> RWS () [VBox ps s] (TMState ps s) a
unTM forall a b. (a -> b) -> a -> b
$ TM ps s a
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x' -> do {forall (m :: * -> *) a. Monad m => a -> m a
return a
x'} ) () (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 = forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ [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 = 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(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
return :: forall a. a -> TM ps s a
$creturn :: forall ps s a. a -> TM ps s a
>> :: 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 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 -> (a -> TM ps s b) -> TM ps s b
Monad,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
<* :: forall a b. TM ps s a -> TM ps s b -> TM ps s a
$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 b
$c*> :: forall ps s a b. TM ps s a -> TM ps s b -> TM ps s b
liftA2 :: forall a b c. (a -> b -> c) -> TM ps s a -> TM ps s b -> TM ps s c
$cliftA2 :: forall ps s 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 -> b) -> TM ps s a -> TM ps s b
$c<*> :: forall ps s a b. TM ps s (a -> b) -> TM ps s a -> TM ps s b
pure :: forall a. a -> TM ps s a
$cpure :: forall ps s a. a -> TM ps s a
Applicative,MonadWriter [VBox ps s], MonadState (TMState 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
<$ :: forall a b. a -> TM ps s b -> TM ps s a
$c<$ :: forall ps s a b. a -> TM ps s b -> TM ps s a
fmap :: forall a b. (a -> b) -> TM ps s a -> TM ps s b
$cfmap :: forall ps s a b. (a -> b) -> TM ps s a -> TM ps s b
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(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
return :: forall a. a -> Para s a
$creturn :: forall s a. a -> Para s a
>> :: 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 b
>>= :: forall a b. Para s a -> (a -> Para s b) -> Para s b
$c>>= :: forall s a b. Para s a -> (a -> Para s b) -> Para s b
Monad,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
<* :: forall a b. Para s a -> Para s b -> Para s a
$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 b
$c*> :: forall s a b. Para s a -> Para s b -> Para s b
liftA2 :: forall a b c. (a -> b -> c) -> Para s a -> Para s b -> Para s c
$cliftA2 :: forall s a b c. (a -> b -> c) -> Para s a -> Para s b -> Para s c
<*> :: forall a b. Para s (a -> b) -> Para s a -> Para s b
$c<*> :: forall s a b. Para s (a -> b) -> Para s a -> Para s b
pure :: forall a. a -> Para s a
$cpure :: forall s a. a -> Para s a
Applicative,MonadWriter [Letter s], MonadReader BRState, MonadState 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
<$ :: forall a b. a -> Para s b -> Para s a
$c<$ :: forall s a b. a -> Para s b -> Para s a
fmap :: forall a b. (a -> b) -> Para s a -> Para s b
$cfmap :: forall s a b. (a -> b) -> Para s a -> Para s b
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 = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {tmStyle :: s
tmStyle = s
f}

    --  Get current text style
    currentStyle :: TM ps s s
currentStyle = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets 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 <- forall ps s. TM ps s ps
getParaStyle
        forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ ([forall ps s.
PDFFloat -> BoxDimension -> AnyBox -> Maybe ps -> VBox ps s
SomeVBox PDFFloat
0 (PDFFloat
w,PDFFloat
h,PDFFloat
d) (forall a. (Show a, Box a, DisplayableBox a) => a -> AnyBox
AnyBox a
a) (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 <- forall ps s. TM ps s ps
getParaStyle
        forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ [forall ps s.
Maybe ps
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> VBox ps s
vglue (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
        forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ [forall ps s.
Maybe ps
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> VBox ps s
vglue 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 = forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$! s
f

    --  Get current text style
    currentStyle :: Para s s
currentStyle = 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 <- forall s (m :: * -> *). MonadStyle s m => m s
currentStyle
        forall s. Letter s -> Para s ()
addLetter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s.
(Show a, Box a, DisplayableBox a) =>
BoxDimension -> Maybe s -> a -> Letter s
mkLetter (PDFFloat
w,PDFFloat
h,PDFFloat
d) (forall a. a -> Maybe a
Just s
f) 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 <- forall s (m :: * -> *). MonadStyle s m => m s
currentStyle
        forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ [forall s. Maybe s -> PDFFloat -> PDFFloat -> PDFFloat -> Letter s
glueBox (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
        forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ [forall s. Maybe s -> PDFFloat -> PDFFloat -> PDFFloat -> Letter s
glueBox 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
    forall s. Style s => Para s ()
endPara
    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
            forall s (m :: * -> *).
MonadStyle s m =>
PDFFloat -> PDFFloat -> PDFFloat -> m ()
glue PDFFloat
0 PDFFloat
10000.0 PDFFloat
0
        else
            forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ [forall s. Maybe s -> PDFFloat -> PDFFloat -> PDFFloat -> Letter s
glueBox forall a. Maybe a
Nothing PDFFloat
0 PDFFloat
10000.0 PDFFloat
0]
    forall s. Int -> Para s ()
addPenalty (-Int
infinity)
     
endPara :: Style s => Para s ()
endPara :: forall s. Style s => Para s ()
endPara = do
    BRState
style <- forall r (m :: * -> *). MonadReader r m => m r
ask
    s
theStyle <- forall s (m :: * -> *). MonadStyle s m => m s
currentStyle
    let w :: PDFFloat
w = forall s. Style s => s -> PDFFloat
spaceWidth s
theStyle
    case BRState -> Justification
centered BRState
style of
      Justification
Centered -> do
        forall s. Letter s -> Para s ()
addLetter (forall s. Maybe s -> PDFFloat -> PDFFloat -> PDFFloat -> Letter s
glueBox (forall a. a -> Maybe a
Just s
theStyle) PDFFloat
0 (PDFFloat
centeredDilatationFactorforall a. Num a => a -> a -> a
*PDFFloat
w) PDFFloat
0)
        forall s. Letter s -> Para s ()
addLetter (forall s. Int -> Letter s
penalty (-Int
infinity))
      Justification
RightJustification -> forall s. Int -> Para s ()
addPenalty (-Int
infinity) 
      Justification
_ -> 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 <- forall r (m :: * -> *). MonadReader r m => m r
ask
    s
theStyle <- forall s (m :: * -> *). MonadStyle s m => m s
currentStyle
    let w :: PDFFloat
w = forall s. Style s => s -> PDFFloat
spaceWidth s
theStyle
    case (BRState -> Justification
centered BRState
style) of
      Justification
Centered -> do
        forall s. Letter s -> Para s ()
addLetter (forall s. s -> PDFFloat -> Letter s
kernBox (s
theStyle) PDFFloat
0)
        forall s. Letter s -> Para s ()
addLetter forall a b. (a -> b) -> a -> b
$ forall s. Int -> Letter s
penalty Int
infinity
        forall s. Letter s -> Para s ()
addLetter (forall s. Maybe s -> PDFFloat -> PDFFloat -> PDFFloat -> Letter s
glueBox (forall a. a -> Maybe a
Just s
theStyle) PDFFloat
0 (PDFFloat
centeredDilatationFactorforall a. Num a => a -> a -> a
*PDFFloat
w) PDFFloat
0)
      Justification
RightJustification -> do
        forall s. Letter s -> Para s ()
addLetter (forall s. s -> PDFFloat -> Letter s
kernBox (s
theStyle) PDFFloat
0)
        forall s. Letter s -> Para s ()
addLetter forall a b. (a -> b) -> a -> b
$ forall s. Int -> Letter s
penalty Int
infinity
        forall s. Letter s -> Para s ()
addLetter (forall s. Maybe s -> PDFFloat -> PDFFloat -> PDFFloat -> Letter s
glueBox (forall a. a -> Maybe a
Just s
theStyle) PDFFloat
0 (PDFFloat
rightDilatationFactorforall a. Num a => a -> a -> a
*PDFFloat
w) PDFFloat
0)
      Justification
_ -> 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 <- forall s (m :: * -> *). MonadState s m => m s
get
    let (a
a, s
s', [Letter s]
boxes) = (forall r w s a. RWS r w s a -> r -> s -> (a, s, w)
runRWS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. Para s a -> RWS BRState [Letter s] s a
unPara forall a b. (a -> b) -> a -> b
$ Para s a
closedPara) BRState
settings s
f
    forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$! forall ps s. s -> BRState -> VerState ps -> TMState ps s
TMState s
s' BRState
settings VerState ps
pagesettings
    ps
style <- forall ps s. TM ps s ps
getParaStyle
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ [forall ps s. Int -> [Letter s] -> Maybe ps -> BRState -> VBox ps s
Paragraph Int
0 [Letter s]
boxes (forall a. a -> Maybe a
Just ps
style) BRState
settings]
    forall (m :: * -> *) a. Monad m => a -> m a
return a
a
 where
    closedPara :: Para s a
closedPara = do
        forall s. Style s => Para s ()
startPara
        a
x <- Para s a
m
        forall s. Style s => Para s ()
endPara
        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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall ps s. TMState ps s -> BRState
paraSettings 
  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 
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {paraSettings :: BRState
paraSettings = (forall ps s. TMState ps s -> BRState
paraSettings TMState ps s
s){writingSystem :: WritingSystem
writingSystem = WritingSystem
w}}

-- | Get the current paragraph style
getParaStyle :: TM ps s ps
getParaStyle :: forall ps s. TM ps s ps
getParaStyle = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall ps s. TMState ps s -> VerState ps
pageSettings forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall ps s a. RWS () [VBox ps s] (TMState ps s) a -> TM ps s a
TM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {pageSettings :: VerState ps
pageSettings = (forall ps s. TMState ps s -> VerState ps
pageSettings TMState ps s
s){currentParagraphStyle :: ps
currentParagraphStyle = ps
style}}

-- | Add a letter to the paragraph
addLetter :: Letter s -> Para s ()
addLetter :: forall s. Letter s -> Para s ()
addLetter Letter s
l = forall s a. RWS BRState [Letter s] s a -> Para s a
Para forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell 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 = 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 <- forall s (m :: * -> *). MonadStyle s m => m s
currentStyle
    BRState
settings <- forall r (m :: * -> *). MonadReader r m => m r
ask
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ 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 <- forall s (m :: * -> *). MonadStyle s m => m s
currentStyle
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ [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 = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {pageSettings :: VerState ps
pageSettings = (forall ps s. TMState ps s -> VerState ps
pageSettings TMState ps s
s){baselineskip :: BoxDimension
baselineskip = (PDFFloat
w,PDFFloat
y,PDFFloat
z)}}
 
getBaseLineSkip :: TM ps s (PDFFloat,PDFFloat,PDFFloat)
getBaseLineSkip :: forall ps s. TM ps s BoxDimension
getBaseLineSkip = do
    VerState ps
s <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall ps s. TMState ps s -> VerState ps
pageSettings
    forall (m :: * -> *) a. Monad m => a -> m a
return (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 = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {pageSettings :: VerState ps
pageSettings = (forall ps s. TMState ps s -> VerState ps
pageSettings TMState ps s
s){lineskiplimit :: PDFFloat
lineskiplimit=PDFFloat
l}}

getLineSkipLimit :: TM ps s PDFFloat
getLineSkipLimit :: forall ps s. TM ps s PDFFloat
getLineSkipLimit = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall ps s. TMState ps s -> VerState ps
pageSettings forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {pageSettings :: VerState ps
pageSettings = (forall ps s. TMState ps s -> VerState ps
pageSettings TMState ps s
s){lineskip :: BoxDimension
lineskip = (PDFFloat
w,PDFFloat
y,PDFFloat
z)}}

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

getFirstPassTolerance :: TM ps s PDFFloat
getFirstPassTolerance :: forall ps s. TM ps s PDFFloat
getFirstPassTolerance = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall ps s. TMState ps s -> BRState
paraSettings forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {paraSettings :: BRState
paraSettings = (forall ps s. TMState ps s -> BRState
paraSettings TMState ps s
s){secondPassTolerance :: PDFFloat
secondPassTolerance = PDFFloat
x}}

getSecondPassTolerance :: TM ps s PDFFloat
getSecondPassTolerance :: forall ps s. TM ps s PDFFloat
getSecondPassTolerance = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall ps s. TMState ps s -> BRState
paraSettings forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {paraSettings :: BRState
paraSettings = (forall ps s. TMState ps s -> BRState
paraSettings TMState ps s
s){hyphenPenaltyValue :: Int
hyphenPenaltyValue = Int
x}}

getHyphenPenaltyValue :: TM ps s Int
getHyphenPenaltyValue :: forall ps s. TM ps s Int
getHyphenPenaltyValue = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall ps s. TMState ps s -> BRState
paraSettings forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {paraSettings :: BRState
paraSettings = (forall ps s. TMState ps s -> BRState
paraSettings TMState ps s
s){fitness_demerit :: PDFFloat
fitness_demerit = PDFFloat
x}}

getFitnessDemerit :: TM ps s PDFFloat
getFitnessDemerit :: forall ps s. TM ps s PDFFloat
getFitnessDemerit = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall ps s. TMState ps s -> BRState
paraSettings forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {paraSettings :: BRState
paraSettings = (forall ps s. TMState ps s -> BRState
paraSettings TMState ps s
s){flagged_demerit :: PDFFloat
flagged_demerit = PDFFloat
x}}

getHyphenDemerit :: TM ps s PDFFloat
getHyphenDemerit :: forall ps s. TM ps s PDFFloat
getHyphenDemerit = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall ps s. TMState ps s -> BRState
paraSettings forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {paraSettings :: BRState
paraSettings = (forall ps s. TMState ps s -> BRState
paraSettings TMState ps s
s){line_penalty :: PDFFloat
line_penalty = PDFFloat
x}}
                   
getLinePenalty :: TM ps s PDFFloat
getLinePenalty :: forall ps s. TM ps s PDFFloat
getLinePenalty = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall ps s. TMState ps s -> BRState
paraSettings forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \TMState ps s
s -> TMState ps s
s {paraSettings :: BRState
paraSettings = (forall ps s. TMState ps s -> BRState
paraSettings TMState ps s
s){centered :: Justification
centered = Justification
j}}

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

data Orientation = E | W | N | S | NE | NW | SE | SW deriving(Orientation -> Orientation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Orientation -> Orientation -> Bool
$c/= :: Orientation -> Orientation -> Bool
== :: Orientation -> Orientation -> Bool
$c== :: Orientation -> Orientation -> Bool
Eq,Int -> Orientation -> ShowS
[Orientation] -> ShowS
Orientation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Orientation] -> ShowS
$cshowList :: [Orientation] -> ShowS
show :: Orientation -> String
$cshow :: Orientation -> String
showsPrec :: Int -> Orientation -> ShowS
$cshowsPrec :: Int -> 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 = 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 = forall s. Style s => s -> PDFFloat
styleHeight s
p
        c :: Container ps s
c = 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]
_) = forall ps s.
(ParagraphStyle ps s, ComparableStyle ps) =>
VerState ps
-> Container ps s
-> [VBox ps s]
-> (Draw (), Container ps s, [VBox ps s])
fillContainer (forall s. s -> VerState s
defaultVerState ps
ps) forall {ps} {s}. Container ps s
c [VBox ps s]
b
        Rectangle (PDFFloat
xa :+ PDFFloat
ya) (PDFFloat
xb :+ PDFFloat
yb)  = forall ps s. Container ps s -> Rectangle
containerContentRectangle  Container ps s
c'
        wc :: PDFFloat
wc = PDFFloat
xb forall a. Num a => a -> a -> a
- PDFFloat
xa
        hc :: PDFFloat
hc = PDFFloat
yb 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 forall a. Num a => a -> a -> a
- PDFFloat
wc,PDFFloat
y)
          Orientation
SE -> (PDFFloat
x,PDFFloat
y forall a. Num a => a -> a -> a
+ PDFFloat
hc)
          Orientation
SW -> (PDFFloat
x forall a. Num a => a -> a -> a
- PDFFloat
wc,PDFFloat
y forall a. Num a => a -> a -> a
+ PDFFloat
hc)
          Orientation
E -> (PDFFloat
x,PDFFloat
y forall a. Num a => a -> a -> a
+ PDFFloat
hc forall a. Fractional a => a -> a -> a
/ PDFFloat
2.0)
          Orientation
W -> (PDFFloat
x forall a. Num a => a -> a -> a
- PDFFloat
wc,PDFFloat
y forall a. Num a => a -> a -> a
+ PDFFloat
hc forall a. Fractional a => a -> a -> a
/ PDFFloat
2.0)
          Orientation
N -> (PDFFloat
x forall a. Num a => a -> a -> a
- PDFFloat
wcforall a. Fractional a => a -> a -> a
/PDFFloat
2.0,PDFFloat
y)
          Orientation
S -> (PDFFloat
x forall a. Num a => a -> a -> a
- PDFFloat
wcforall a. Fractional a => a -> a -> a
/PDFFloat
2.0,PDFFloat
y forall a. Num a => a -> a -> a
+ PDFFloat
hc)
        box :: Draw ()
box = forall a. Draw a -> Draw a
withNewContext forall a b. (a -> b) -> a -> b
$ do
           Matrix -> Draw ()
applyMatrix forall a b. (a -> b) -> a -> b
$ Complex PDFFloat -> Matrix
translate (PDFFloat
dx forall a. a -> a -> Complex a
:+ PDFFloat
dy)
           Draw ()
d
        r :: Rectangle
r = Complex PDFFloat -> Complex PDFFloat -> Rectangle
Rectangle ((PDFFloat
xa forall a. Num a => a -> a -> a
+ PDFFloat
dx) forall a. a -> a -> Complex a
:+ (PDFFloat
ya forall a. Num a => a -> a -> a
+ PDFFloat
dy)) ((PDFFloat
xb forall a. Num a => a -> a -> a
+ PDFFloat
dx) forall a. a -> a -> Complex a
:+ (PDFFloat
yb forall a. Num a => a -> a -> a
+ PDFFloat
dy))
    in
    (Rectangle
r,Draw ()
box)