---------------------------------------------------------
-- |
-- Copyright   : (c) 2006-2016, alpheccar.org
-- License     : BSD-style
--
-- Maintainer  : misc@NOSPAMalpheccar.org
-- Stability   : experimental
-- Portability : portable
--
-- Horizontal mode
---------------------------------------------------------
-- #hide
{-# LANGUAGE CPP #-}
module Graphics.PDF.Typesetting.Horizontal (
   HBox(..)
 , mkHboxWithRatio
 , horizontalPostProcess
 ) where

#if !MIN_VERSION_base(4,8,0)
import Data.Monoid
#endif

import Graphics.PDF.LowLevel.Types
import Graphics.PDF.Typesetting.Breaking
import Graphics.PDF.Shapes
import Graphics.PDF.Draw
import Graphics.PDF.Coordinates
import qualified Data.ByteString as S(reverse,cons,singleton)
import Data.Maybe(isJust,fromJust)
import Data.List(foldl')
import Graphics.PDF.Colors
import Graphics.PDF.Text
import Graphics.PDF.Typesetting.Box
import Control.Monad.Writer(tell)
import Control.Monad(when)
import Graphics.PDF.LowLevel.Serializer

-- | Current word (created from letter) is converted to a PDFString
saveCurrentword :: PDFGlyph -> PDFGlyph
saveCurrentword :: PDFGlyph -> PDFGlyph
saveCurrentword (PDFGlyph ByteString
g) = ByteString -> PDFGlyph
PDFGlyph forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
S.reverse forall a b. (a -> b) -> a -> b
$ ByteString
g

-- WARNING
-- According to splitText, PDFText to concatenate ARE letters so we can optimize the code
-- Sentences are created when no word style is present, otherwise we just create words
createWords :: ComparableStyle s => PDFFloat -- ^ Adjustement ratio
            -> Maybe (s,PDFGlyph, PDFFloat) -- ^ Current word
            -> [Letter s] -- ^ List of letters
            -> [HBox s] -- ^ List of words or sentences

createWords :: forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
_ Maybe (s, PDFGlyph, PDFFloat)
Nothing [] = []
-- Empty list, current word or sentence is added
createWords PDFFloat
_ (Just (s
s,PDFGlyph
t,PDFFloat
w)) [] = [forall s. s -> PDFGlyph -> PDFFloat -> HBox s
createText s
s (PDFGlyph -> PDFGlyph
saveCurrentword PDFGlyph
t) PDFFloat
w]

-- Start of a new word
createWords PDFFloat
r Maybe (s, PDFGlyph, PDFFloat)
Nothing ((AGlyph s
s GlyphCode
t PDFFloat
w):[Letter s]
l) = forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r (forall a. a -> Maybe a
Just (s
s,ByteString -> PDFGlyph
PDFGlyph (Word8 -> ByteString
S.singleton (forall a b. (Integral a, Num b) => a -> b
fromIntegral GlyphCode
t)),PDFFloat
w)) [Letter s]
l
-- New letter. Same style added to the word. Otherwise we start a new word
createWords PDFFloat
r (Just (s
s,PDFGlyph ByteString
t,PDFFloat
w)) ((AGlyph s
s' GlyphCode
t' PDFFloat
w'):[Letter s]
l) | s
s forall a. ComparableStyle a => a -> a -> Bool
`isSameStyleAs` s
s' = forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r (forall a. a -> Maybe a
Just (s
s,ByteString -> PDFGlyph
PDFGlyph (Word8 -> ByteString -> ByteString
S.cons (forall a b. (Integral a, Num b) => a -> b
fromIntegral GlyphCode
t') ByteString
t),PDFFloat
wforall a. Num a => a -> a -> a
+PDFFloat
w')) [Letter s]
l
                                                            | Bool
otherwise = (forall s. s -> PDFGlyph -> PDFFloat -> HBox s
createText s
s (PDFGlyph -> PDFGlyph
saveCurrentword forall a b. (a -> b) -> a -> b
$ (ByteString -> PDFGlyph
PDFGlyph ByteString
t)) PDFFloat
w)forall a. a -> [a] -> [a]
:forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r (forall a. a -> Maybe a
Just (s
s',ByteString -> PDFGlyph
PDFGlyph (Word8 -> ByteString
S.singleton (forall a b. (Integral a, Num b) => a -> b
fromIntegral GlyphCode
t')),PDFFloat
w')) [Letter s]
l 
                                                             
-- Glue close the word and start a new one because we want glues of different widths in the PDF
createWords PDFFloat
r (Just (s
s,PDFGlyph
t,PDFFloat
w)) ((Glue PDFFloat
w' PDFFloat
y PDFFloat
z (Just s
s')):[Letter s]
l) = (forall s. s -> PDFGlyph -> PDFFloat -> HBox s
createText s
s (PDFGlyph -> PDFGlyph
saveCurrentword forall a b. (a -> b) -> a -> b
$ PDFGlyph
t) PDFFloat
w)forall a. a -> [a] -> [a]
:(forall s.
PDFFloat -> Maybe (PDFFloat, PDFFloat) -> Maybe s -> HBox s
HGlue PDFFloat
w' (forall a. a -> Maybe a
Just(PDFFloat
y,PDFFloat
z)) (forall a. a -> Maybe a
Just s
s'))forall a. a -> [a] -> [a]
:forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r  forall a. Maybe a
Nothing [Letter s]
l

-- Penalties are invisible. The are needed just to compute breaks
createWords PDFFloat
r Maybe (s, PDFGlyph, PDFFloat)
c (Penalty Int
_:[Letter s]
l) = forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r  Maybe (s, PDFGlyph, PDFFloat)
c [Letter s]
l
createWords PDFFloat
r Maybe (s, PDFGlyph, PDFFloat)
c (FlaggedPenalty PDFFloat
_ Int
_ s
_:[Letter s]
l) = forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r  Maybe (s, PDFGlyph, PDFFloat)
c [Letter s]
l

-- We just add the box
createWords PDFFloat
r Maybe (s, PDFGlyph, PDFFloat)
Nothing ((Glue PDFFloat
w' PDFFloat
y PDFFloat
z Maybe s
s):[Letter s]
l) = (forall s.
PDFFloat -> Maybe (PDFFloat, PDFFloat) -> Maybe s -> HBox s
HGlue PDFFloat
w' (forall a. a -> Maybe a
Just(PDFFloat
y,PDFFloat
z)) Maybe s
s)forall a. a -> [a] -> [a]
:forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r forall a. Maybe a
Nothing [Letter s]
l
createWords PDFFloat
r (Just (s
s,PDFGlyph
t,PDFFloat
w)) ((Glue PDFFloat
w' PDFFloat
y PDFFloat
z Maybe s
Nothing):[Letter s]
l) = (forall s. s -> PDFGlyph -> PDFFloat -> HBox s
createText s
s (PDFGlyph -> PDFGlyph
saveCurrentword forall a b. (a -> b) -> a -> b
$ PDFGlyph
t) PDFFloat
w)forall a. a -> [a] -> [a]
:(forall s.
PDFFloat -> Maybe (PDFFloat, PDFFloat) -> Maybe s -> HBox s
HGlue PDFFloat
w' (forall a. a -> Maybe a
Just(PDFFloat
y,PDFFloat
z)) forall a. Maybe a
Nothing)forall a. a -> [a] -> [a]
:forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r forall a. Maybe a
Nothing [Letter s]
l
  
createWords PDFFloat
r Maybe (s, PDFGlyph, PDFFloat)
Nothing ((Kern PDFFloat
w' Maybe s
s):[Letter s]
l) = (forall s.
PDFFloat -> Maybe (PDFFloat, PDFFloat) -> Maybe s -> HBox s
HGlue PDFFloat
w' forall a. Maybe a
Nothing Maybe s
s)forall a. a -> [a] -> [a]
:forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r forall a. Maybe a
Nothing [Letter s]
l
createWords PDFFloat
r (Just (s
s,PDFGlyph
t,PDFFloat
w)) ((Kern PDFFloat
w' Maybe s
s'):[Letter s]
l) = (forall s. s -> PDFGlyph -> PDFFloat -> HBox s
createText s
s (PDFGlyph -> PDFGlyph
saveCurrentword forall a b. (a -> b) -> a -> b
$ PDFGlyph
t) PDFFloat
w)forall a. a -> [a] -> [a]
:(forall s.
PDFFloat -> Maybe (PDFFloat, PDFFloat) -> Maybe s -> HBox s
HGlue PDFFloat
w' forall a. Maybe a
Nothing Maybe s
s')forall a. a -> [a] -> [a]
:forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r forall a. Maybe a
Nothing [Letter s]
l

createWords PDFFloat
r Maybe (s, PDFGlyph, PDFFloat)
Nothing ((Letter BoxDimension
d AnyBox
a Maybe s
s):[Letter s]
l) = (forall s. BoxDimension -> AnyBox -> Maybe s -> HBox s
SomeHBox BoxDimension
d AnyBox
a Maybe s
s)forall a. a -> [a] -> [a]
:forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r forall a. Maybe a
Nothing [Letter s]
l
createWords PDFFloat
r (Just (s
s,PDFGlyph
t,PDFFloat
w)) ((Letter BoxDimension
d AnyBox
a Maybe s
st):[Letter s]
l) = (forall s. s -> PDFGlyph -> PDFFloat -> HBox s
createText s
s (PDFGlyph -> PDFGlyph
saveCurrentword forall a b. (a -> b) -> a -> b
$ PDFGlyph
t) PDFFloat
w)forall a. a -> [a] -> [a]
:(forall s. BoxDimension -> AnyBox -> Maybe s -> HBox s
SomeHBox BoxDimension
d AnyBox
a Maybe s
st)forall a. a -> [a] -> [a]
:forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r forall a. Maybe a
Nothing [Letter s]
l
 

-- | horizontalPostProcess
horizontalPostProcess :: (Style s) 
                      => [(PDFFloat,[Letter s],[Letter s])] -- ^ adjust ratio, hyphen style, list of letters or boxes
                      -> [(HBox s,[Letter s])] -- ^ List of lines
horizontalPostProcess :: forall s.
Style s =>
[(PDFFloat, [Letter s], [Letter s])] -> [(HBox s, [Letter s])]
horizontalPostProcess [] = []
horizontalPostProcess ((PDFFloat
r,[Letter s]
l',[Letter s]
r'):[(PDFFloat, [Letter s], [Letter s])]
l) = let l'' :: [HBox s]
l'' = forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. [Letter s] -> [Letter s]
simplify forall a b. (a -> b) -> a -> b
$ [Letter s]
l' in
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HBox s]
l''
      then
          forall s.
Style s =>
[(PDFFloat, [Letter s], [Letter s])] -> [(HBox s, [Letter s])]
horizontalPostProcess [(PDFFloat, [Letter s], [Letter s])]
l
      else
          ((forall s. Style s => PDFFloat -> [HBox s] -> HBox s
mkHboxWithRatio PDFFloat
r [HBox s]
l''),[Letter s]
r')forall a. a -> [a] -> [a]
:forall s.
Style s =>
[(PDFFloat, [Letter s], [Letter s])] -> [(HBox s, [Letter s])]
horizontalPostProcess [(PDFFloat, [Letter s], [Letter s])]
l 


-- | An horizontal Hbox (sentence or word)
-- The width of the glue was computed with the adjustement ratio of the HLine containing the glue
-- The width of the text is already taking into account the adjustement ratio of the HLine containing the Text
-- Otherwise, HBox cannot dilate or compress. 
data HBox s = HBox !PDFFloat !PDFFloat !PDFFloat ![HBox s]
            | HGlue !PDFFloat !(Maybe (PDFFloat,PDFFloat)) !(Maybe s)
            | Text !s !PDFGlyph !PDFFloat
            | SomeHBox !BoxDimension !AnyBox !(Maybe s)
     
-- | Change the style of the box      
withNewStyle :: s -> HBox s -> HBox s
withNewStyle :: forall s. s -> HBox s -> HBox s
withNewStyle s
_ a :: HBox s
a@(HBox PDFFloat
_ PDFFloat
_ PDFFloat
_ [HBox s]
_) = HBox s
a
withNewStyle s
s (HGlue PDFFloat
a Maybe (PDFFloat, PDFFloat)
b Maybe s
_) = forall s.
PDFFloat -> Maybe (PDFFloat, PDFFloat) -> Maybe s -> HBox s
HGlue PDFFloat
a Maybe (PDFFloat, PDFFloat)
b (forall a. a -> Maybe a
Just s
s)
withNewStyle s
s (Text s
_ PDFGlyph
a PDFFloat
b) = forall s. s -> PDFGlyph -> PDFFloat -> HBox s
Text s
s PDFGlyph
a PDFFloat
b
withNewStyle s
s (SomeHBox BoxDimension
d AnyBox
a Maybe s
_) = forall s. BoxDimension -> AnyBox -> Maybe s -> HBox s
SomeHBox BoxDimension
d AnyBox
a (forall a. a -> Maybe a
Just s
s) 
    
-- | A line of hboxes with an adjustement ratio required to display the text (generate the PDF command to increase space size)       
--data HLine = HLine !PDFFloat ![HBox] deriving(Show)

mkHboxWithRatio :: Style s => PDFFloat -- ^ Adjustement ratio
                -> [HBox s]
                -> HBox s
mkHboxWithRatio :: forall s. Style s => PDFFloat -> [HBox s] -> HBox s
mkHboxWithRatio PDFFloat
_ [] = forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot create an empty horizontal box"
mkHboxWithRatio PDFFloat
r [HBox s]
l = 
    let w :: PDFFloat
w = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\PDFFloat
x HBox s
y -> PDFFloat
x forall a. Num a => a -> a -> a
+ forall a. MaybeGlue a => a -> PDFFloat -> PDFFloat
glueSizeWithRatio HBox s
y PDFFloat
r) PDFFloat
0.0 [HBox s]
l
        --h = maximum . map boxHeight $ l
        ascent :: PDFFloat
ascent = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Box a => a -> PDFFloat
boxAscent forall a b. (a -> b) -> a -> b
$ [HBox s]
l
        d :: PDFFloat
d = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Box a => a -> PDFFloat
boxDescent forall a b. (a -> b) -> a -> b
$ [HBox s]
l
        h :: PDFFloat
h = PDFFloat
ascent forall a. Num a => a -> a -> a
+ PDFFloat
d
        addBox :: HBox s -> HBox s -> HBox s
addBox (HGlue PDFFloat
gw (Just(PDFFloat
y,PDFFloat
z)) Maybe s
s) (HBox PDFFloat
w' PDFFloat
h' PDFFloat
d' [HBox s]
l') = forall s. PDFFloat -> PDFFloat -> PDFFloat -> [HBox s] -> HBox s
HBox PDFFloat
w' PDFFloat
h' PDFFloat
d' (forall s.
PDFFloat -> Maybe (PDFFloat, PDFFloat) -> Maybe s -> HBox s
HGlue (PDFFloat -> PDFFloat -> PDFFloat -> PDFFloat -> PDFFloat
glueSize PDFFloat
gw PDFFloat
y PDFFloat
z PDFFloat
r) forall a. Maybe a
Nothing Maybe s
sforall a. a -> [a] -> [a]
:[HBox s]
l')
        addBox HBox s
a (HBox PDFFloat
w' PDFFloat
h' PDFFloat
d' [HBox s]
l') = forall s. PDFFloat -> PDFFloat -> PDFFloat -> [HBox s] -> HBox s
HBox PDFFloat
w' PDFFloat
h' PDFFloat
d' (HBox s
aforall a. a -> [a] -> [a]
:[HBox s]
l')
        addBox HBox s
_ HBox s
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"We can add boxes only to an horizontal list"
    in
    -- Add boxes and dilate glues when needing fixing their dimensions after dilatation
    forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {s}. HBox s -> HBox s -> HBox s
addBox (forall s. PDFFloat -> PDFFloat -> PDFFloat -> [HBox s] -> HBox s
HBox PDFFloat
w PDFFloat
h PDFFloat
d []) [HBox s]
l
    
instance Style s => MaybeGlue (HBox s) where
    glueSizeWithRatio :: HBox s -> PDFFloat -> PDFFloat
glueSizeWithRatio (HGlue PDFFloat
w (Just(PDFFloat
y,PDFFloat
z)) Maybe s
_) PDFFloat
r = PDFFloat -> PDFFloat -> PDFFloat -> PDFFloat -> PDFFloat
glueSize PDFFloat
w PDFFloat
y PDFFloat
z PDFFloat
r
    glueSizeWithRatio HBox s
a PDFFloat
_ = forall a. Box a => a -> PDFFloat
boxWidth HBox s
a
    glueY :: HBox s -> PDFFloat
glueY (HGlue PDFFloat
_ (Just(PDFFloat
y,PDFFloat
_)) Maybe s
_)  = PDFFloat
y
    glueY HBox s
_ = PDFFloat
0
    glueZ :: HBox s -> PDFFloat
glueZ (HGlue PDFFloat
_ (Just(PDFFloat
_,PDFFloat
z)) Maybe s
_)  = PDFFloat
z
    glueZ HBox s
_ = PDFFloat
0
    
-- | Create an HBox           
createText :: s -- ^ Style
           -> PDFGlyph -- ^ List of glyphs
           -> PDFFloat -- ^ Width
           -> HBox s
createText :: forall s. s -> PDFGlyph -> PDFFloat -> HBox s
createText s
s PDFGlyph
t PDFFloat
w = forall s. s -> PDFGlyph -> PDFFloat -> HBox s
Text s
s PDFGlyph
t PDFFloat
w


instance Show (HBox s) where
   show :: HBox s -> [Char]
show (HBox PDFFloat
_ PDFFloat
_ PDFFloat
_ [HBox s]
a) = [Char]
"(HBox " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [HBox s]
a forall a. [a] -> [a] -> [a]
++ [Char]
")"
   show (HGlue PDFFloat
a Maybe (PDFFloat, PDFFloat)
_ Maybe s
_) = [Char]
"(HGlue " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show PDFFloat
a forall a. [a] -> [a] -> [a]
++ [Char]
")"
   show (Text s
_ PDFGlyph
t PDFFloat
_) = [Char]
"(Text " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show PDFGlyph
t forall a. [a] -> [a] -> [a]
++ [Char]
")"
   show (SomeHBox BoxDimension
_ AnyBox
t Maybe s
_) = [Char]
"(SomeHBox " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show AnyBox
t forall a. [a] -> [a] -> [a]
++ [Char]
")"


-- | Draw a line of words and glue using the word style
drawTextLine :: (Style s) => s -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
drawTextLine :: forall s.
Style s =>
s -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
drawTextLine  s
_ [] PDFFloat
_ PDFFloat
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
drawTextLine  s
style l :: [HBox s]
l@(HBox s
a:[HBox s]
l') PDFFloat
x PDFFloat
y | (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
Style a =>
a -> Maybe (Rectangle -> StyleFunction -> Draw b -> Draw ())
wordStyle forall a b. (a -> b) -> a -> b
$ s
style) =  do
    let  h :: PDFFloat
h = forall a. Box a => a -> PDFFloat
boxHeight HBox s
a
         d :: PDFFloat
d = forall a. Box a => a -> PDFFloat
boxDescent HBox s
a
         y' :: PDFFloat
y' = PDFFloat
y forall a. Num a => a -> a -> a
+ PDFFloat
h forall a. Num a => a -> a -> a
- PDFFloat
d
    forall a. DisplayableBox a => a -> PDFFloat -> PDFFloat -> Draw ()
strokeBox (forall s. s -> HBox s -> HBox s
withNewStyle s
style HBox s
a) PDFFloat
x PDFFloat
y'
    forall s.
Style s =>
s -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
drawTextLine (forall a. Style a => a -> a
updateStyle s
style) [HBox s]
l' (PDFFloat
x forall a. Num a => a -> a -> a
+ forall a. Box a => a -> PDFFloat
boxWidth HBox s
a) PDFFloat
y
                                 | Bool
otherwise = forall s.
Style s =>
s -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
drawWords s
style [HBox s]
l PDFFloat
x PDFFloat
y
    
-- | Draw a line of words, glue, or any box without word style
drawWords :: (Style s) => s -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
drawWords :: forall s.
Style s =>
s -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
drawWords s
_ [] PDFFloat
_ PDFFloat
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

drawWords s
s ((Text s
_ PDFGlyph
t PDFFloat
w):[HBox s]
l) PDFFloat
x PDFFloat
y = do
    ([HBox s]
l',PDFFloat
x') <- forall a. PDFText a -> Draw a
drawText forall a b. (a -> b) -> a -> b
$ do
       forall style.
Style style =>
TextDrawingState
-> style -> PDFFloat -> PDFFloat -> Maybe PDFGlyph -> PDFText ()
drawTheTextBox TextDrawingState
StartText s
s PDFFloat
x PDFFloat
y (forall a. a -> Maybe a
Just PDFGlyph
t)
       forall s.
Style s =>
s
-> [HBox s] -> PDFFloat -> PDFFloat -> PDFText ([HBox s], PDFFloat)
drawPureWords s
s [HBox s]
l (PDFFloat
x forall a. Num a => a -> a -> a
+ PDFFloat
w) PDFFloat
y
    forall s.
Style s =>
s -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
drawWords s
s [HBox s]
l' PDFFloat
x' PDFFloat
y
    
drawWords s
s l :: [HBox s]
l@((HGlue PDFFloat
_ Maybe (PDFFloat, PDFFloat)
_ Maybe s
_ ):[HBox s]
_) PDFFloat
x PDFFloat
y = do
    ([HBox s]
l',PDFFloat
x') <- forall a. PDFText a -> Draw a
drawText forall a b. (a -> b) -> a -> b
$ do
       forall style.
Style style =>
TextDrawingState
-> style -> PDFFloat -> PDFFloat -> Maybe PDFGlyph -> PDFText ()
drawTheTextBox TextDrawingState
StartText s
s PDFFloat
x PDFFloat
y forall a. Maybe a
Nothing
       forall s.
Style s =>
s
-> [HBox s] -> PDFFloat -> PDFFloat -> PDFText ([HBox s], PDFFloat)
drawPureWords s
s [HBox s]
l PDFFloat
x PDFFloat
y
    forall s.
Style s =>
s -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
drawWords s
s [HBox s]
l' PDFFloat
x' PDFFloat
y
    
drawWords s
s (a :: HBox s
a@(SomeHBox BoxDimension
_ AnyBox
_ Maybe s
_):[HBox s]
l) PDFFloat
x PDFFloat
y =  do
    let h :: PDFFloat
h = forall a. Box a => a -> PDFFloat
boxHeight HBox s
a
        d :: PDFFloat
d = forall a. Box a => a -> PDFFloat
boxDescent HBox s
a
        w :: PDFFloat
w = forall a. Box a => a -> PDFFloat
boxWidth HBox s
a
        y' :: PDFFloat
y' = PDFFloat
y forall a. Num a => a -> a -> a
- PDFFloat
d forall a. Num a => a -> a -> a
+ PDFFloat
h
    forall a. DisplayableBox a => a -> PDFFloat -> PDFFloat -> Draw ()
strokeBox HBox s
a PDFFloat
x PDFFloat
y'
    forall s.
Style s =>
s -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
drawWords s
s [HBox s]
l (PDFFloat
x forall a. Num a => a -> a -> a
+ PDFFloat
w) PDFFloat
y

drawWords s
_ [HBox s]
_ PDFFloat
_ PDFFloat
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Draw only words and glues using PDF text commands
drawPureWords :: Style s => s -> [HBox s] -> PDFFloat -> PDFFloat -> PDFText ([HBox s],PDFFloat)  

drawPureWords :: forall s.
Style s =>
s
-> [HBox s] -> PDFFloat -> PDFFloat -> PDFText ([HBox s], PDFFloat)
drawPureWords s
s [] PDFFloat
x PDFFloat
y = do
    forall style.
Style style =>
TextDrawingState
-> style -> PDFFloat -> PDFFloat -> Maybe PDFGlyph -> PDFText ()
drawTheTextBox TextDrawingState
StopText s
s PDFFloat
x PDFFloat
y forall a. Maybe a
Nothing
    forall (m :: * -> *) a. Monad m => a -> m a
return ([],PDFFloat
x)
          
drawPureWords s
s ((Text s
_ PDFGlyph
t PDFFloat
w):[HBox s]
l) PDFFloat
x PDFFloat
y = do
    forall style.
Style style =>
TextDrawingState
-> style -> PDFFloat -> PDFFloat -> Maybe PDFGlyph -> PDFText ()
drawTheTextBox TextDrawingState
ContinueText s
s PDFFloat
x PDFFloat
y (forall a. a -> Maybe a
Just PDFGlyph
t)
    forall s.
Style s =>
s
-> [HBox s] -> PDFFloat -> PDFFloat -> PDFText ([HBox s], PDFFloat)
drawPureWords s
s [HBox s]
l (PDFFloat
x forall a. Num a => a -> a -> a
+ PDFFloat
w) PDFFloat
y
    
drawPureWords s
s ((HGlue PDFFloat
w Maybe (PDFFloat, PDFFloat)
_ Maybe s
_):[HBox s]
l) PDFFloat
x PDFFloat
y = do
    forall style. Style style => style -> PDFFloat -> PDFText ()
drawTextGlue s
s PDFFloat
w
    forall s.
Style s =>
s
-> [HBox s] -> PDFFloat -> PDFFloat -> PDFText ([HBox s], PDFFloat)
drawPureWords s
s [HBox s]
l (PDFFloat
x forall a. Num a => a -> a -> a
+ PDFFloat
w) PDFFloat
y  
    
drawPureWords s
s l :: [HBox s]
l@((SomeHBox BoxDimension
_ AnyBox
_ Maybe s
_):[HBox s]
_) PDFFloat
x PDFFloat
y = do
    forall style.
Style style =>
TextDrawingState
-> style -> PDFFloat -> PDFFloat -> Maybe PDFGlyph -> PDFText ()
drawTheTextBox TextDrawingState
StopText s
s PDFFloat
x PDFFloat
y forall a. Maybe a
Nothing
    forall (m :: * -> *) a. Monad m => a -> m a
return ([HBox s]
l,PDFFloat
x)
    
drawPureWords s
s (HBox s
_:[HBox s]
l) PDFFloat
x PDFFloat
y = forall s.
Style s =>
s
-> [HBox s] -> PDFFloat -> PDFFloat -> PDFText ([HBox s], PDFFloat)
drawPureWords s
s [HBox s]
l PDFFloat
x PDFFloat
y  
 
-- When a start of line is detected by drawLineOfHBoxes, we start the drawing
startDrawingNewLineOfText :: (Style s) => PDFFloat -> PDFFloat -> [HBox s] -> PDFFloat -> PDFFloat -> s -> Draw ()
startDrawingNewLineOfText :: forall s.
Style s =>
PDFFloat
-> PDFFloat -> [HBox s] -> PDFFloat -> PDFFloat -> s -> Draw ()
startDrawingNewLineOfText PDFFloat
hl PDFFloat
dl [HBox s]
l PDFFloat
x PDFFloat
y s
style = 
    do
           -- Position of draw line based upon the whole line and not just this word
       let y' :: PDFFloat
y' = PDFFloat
y forall a. Num a => a -> a -> a
- PDFFloat
hl forall a. Num a => a -> a -> a
+ PDFFloat
dl
           ([HBox s]
l',[HBox s]
l'') = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall s. Style s => s -> HBox s -> Bool
isSameStyle s
style) [HBox s]
l
           w' :: PDFFloat
w' = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\PDFFloat
x' HBox s
ny -> PDFFloat
x' forall a. Num a => a -> a -> a
+ forall a. Box a => a -> PDFFloat
boxWidth HBox s
ny) PDFFloat
0.0 [HBox s]
l'
       if (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Style a => a -> Maybe (Rectangle -> Draw b -> Draw ())
sentenceStyle forall a b. (a -> b) -> a -> b
$ s
style)
             then do
                 (forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Style a => a -> Maybe (Rectangle -> Draw b -> Draw ())
sentenceStyle forall a b. (a -> b) -> a -> b
$ s
style) (Point -> Point -> Rectangle
Rectangle (PDFFloat
x forall a. a -> a -> Complex a
:+ (PDFFloat
y forall a. Num a => a -> a -> a
- PDFFloat
hl)) ((PDFFloat
xforall a. Num a => a -> a -> a
+PDFFloat
w') forall a. a -> a -> Complex a
:+ PDFFloat
y)) (forall s.
Style s =>
s -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
drawTextLine s
style [HBox s]
l' PDFFloat
x PDFFloat
y')
             else do
                 forall s.
Style s =>
s -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
drawTextLine s
style [HBox s]
l' PDFFloat
x PDFFloat
y'
       forall s.
Style s =>
PDFFloat -> PDFFloat -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
drawLineOfHboxes PDFFloat
hl PDFFloat
dl [HBox s]
l'' (PDFFloat
x forall a. Num a => a -> a -> a
+ PDFFloat
w') PDFFloat
y
    

drawLineOfHboxes :: (Style s) => PDFFloat -- ^ Height of the total line first time this function is called
                 -> PDFFloat -- ^ Descent of the total line first time this function is called
                 -> [HBox s] -- ^ Remaining box to display
                 -> PDFFloat -- ^ x for the remaining boxes
                 -> PDFFloat -- ^ y for the whole line
                 -> Draw ()
drawLineOfHboxes :: forall s.
Style s =>
PDFFloat -> PDFFloat -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
drawLineOfHboxes PDFFloat
_ PDFFloat
_ [] PDFFloat
_ PDFFloat
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
-- | Start a new text
drawLineOfHboxes PDFFloat
hl PDFFloat
dl l :: [HBox s]
l@((Text s
style PDFGlyph
_ PDFFloat
_):[HBox s]
_) PDFFloat
x PDFFloat
y = forall s.
Style s =>
PDFFloat
-> PDFFloat -> [HBox s] -> PDFFloat -> PDFFloat -> s -> Draw ()
startDrawingNewLineOfText PDFFloat
hl PDFFloat
dl [HBox s]
l PDFFloat
x PDFFloat
y s
style
drawLineOfHboxes PDFFloat
hl PDFFloat
dl l :: [HBox s]
l@((HGlue PDFFloat
_ Maybe (PDFFloat, PDFFloat)
_ (Just s
style)):[HBox s]
_) PDFFloat
x PDFFloat
y = forall s.
Style s =>
PDFFloat
-> PDFFloat -> [HBox s] -> PDFFloat -> PDFFloat -> s -> Draw ()
startDrawingNewLineOfText PDFFloat
hl PDFFloat
dl [HBox s]
l PDFFloat
x PDFFloat
y s
style

drawLineOfHboxes PDFFloat
hl PDFFloat
dl (HBox s
a:[HBox s]
l) PDFFloat
x PDFFloat
y = do
      let  h :: PDFFloat
h = forall a. Box a => a -> PDFFloat
boxHeight HBox s
a
           d :: PDFFloat
d = forall a. Box a => a -> PDFFloat
boxDescent HBox s
a
           -- Compute top of box a
           y' :: PDFFloat
y' = PDFFloat
y  forall a. Num a => a -> a -> a
- PDFFloat
hl forall a. Num a => a -> a -> a
+ PDFFloat
dl forall a. Num a => a -> a -> a
- PDFFloat
d forall a. Num a => a -> a -> a
+ PDFFloat
h
      forall a. DisplayableBox a => a -> PDFFloat -> PDFFloat -> Draw ()
strokeBox HBox s
a PDFFloat
x PDFFloat
y'
      forall s.
Style s =>
PDFFloat -> PDFFloat -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
drawLineOfHboxes PDFFloat
hl PDFFloat
dl [HBox s]
l (PDFFloat
x forall a. Num a => a -> a -> a
+ forall a. Box a => a -> PDFFloat
boxWidth HBox s
a) PDFFloat
y

instance Style s => Box (HBox s) where
     boxWidth :: HBox s -> PDFFloat
boxWidth (Text s
_ PDFGlyph
_ PDFFloat
w) = PDFFloat
w
     boxWidth (HBox PDFFloat
w PDFFloat
_ PDFFloat
_ [HBox s]
_) = PDFFloat
w
     boxWidth (SomeHBox BoxDimension
d AnyBox
_ Maybe s
_)  = forall a. Box a => a -> PDFFloat
boxWidth BoxDimension
d
     boxWidth (HGlue PDFFloat
w Maybe (PDFFloat, PDFFloat)
_ Maybe s
_)  = PDFFloat
w 
                  
     boxHeight :: HBox s -> PDFFloat
boxHeight (Text s
style PDFGlyph
_ PDFFloat
_) = forall a. Style a => a -> PDFFloat
styleHeight s
style
     boxHeight (HBox PDFFloat
_ PDFFloat
h PDFFloat
_ [HBox s]
_) = PDFFloat
h
     boxHeight (SomeHBox BoxDimension
d AnyBox
_ Maybe s
_) = forall a. Box a => a -> PDFFloat
boxHeight BoxDimension
d
     boxHeight (HGlue PDFFloat
_ Maybe (PDFFloat, PDFFloat)
_ (Just s
s)) = forall a. Style a => a -> PDFFloat
styleHeight s
s
     boxHeight (HGlue PDFFloat
_ Maybe (PDFFloat, PDFFloat)
_ Maybe s
_) = PDFFloat
0
    
     boxDescent :: HBox s -> PDFFloat
boxDescent (Text s
style PDFGlyph
_ PDFFloat
_) = forall a. Style a => a -> PDFFloat
styleDescent s
style
     boxDescent (HBox PDFFloat
_ PDFFloat
_ PDFFloat
d [HBox s]
_) = PDFFloat
d
     boxDescent (SomeHBox BoxDimension
d AnyBox
_ Maybe s
_) = forall a. Box a => a -> PDFFloat
boxDescent BoxDimension
d
     boxDescent (HGlue PDFFloat
_ Maybe (PDFFloat, PDFFloat)
_ (Just s
s)) = forall a. Style a => a -> PDFFloat
styleDescent s
s
     boxDescent (HGlue PDFFloat
_ Maybe (PDFFloat, PDFFloat)
_ Maybe s
_) = PDFFloat
0
     
               
-- Draw a text box
drawTheTextBox :: Style style => TextDrawingState
               -> style
               -> PDFFloat
               -> PDFFloat
               -> Maybe PDFGlyph
               -> PDFText ()
drawTheTextBox :: forall style.
Style style =>
TextDrawingState
-> style -> PDFFloat -> PDFFloat -> Maybe PDFGlyph -> PDFText ()
drawTheTextBox TextDrawingState
state style
style PDFFloat
x PDFFloat
y Maybe PDFGlyph
t = do
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TextDrawingState
state forall a. Eq a => a -> a -> Bool
== TextDrawingState
StartText Bool -> Bool -> Bool
|| TextDrawingState
state forall a. Eq a => a -> a -> Bool
== TextDrawingState
OneBlock) forall a b. (a -> b) -> a -> b
$ (do
     PDFFont -> PDFText ()
setFont (TextStyle -> PDFFont
textFont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Style a => a -> TextStyle
textStyle forall a b. (a -> b) -> a -> b
$ style
style)
     forall (m :: * -> *). MonadPath m => Color -> m ()
strokeColor (TextStyle -> Color
textStrokeColor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Style a => a -> TextStyle
textStyle forall a b. (a -> b) -> a -> b
$ style
style)
     forall (m :: * -> *). MonadPath m => Color -> m ()
fillColor (TextStyle -> Color
textFillColor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Style a => a -> TextStyle
textStyle forall a b. (a -> b) -> a -> b
$ style
style)
     TextMode -> PDFText ()
renderMode (TextStyle -> TextMode
textMode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Style a => a -> TextStyle
textStyle forall a b. (a -> b) -> a -> b
$ style
style)
     forall (m :: * -> *). MonadPath m => PDFFloat -> m ()
setWidth (TextStyle -> PDFFloat
penWidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Style a => a -> TextStyle
textStyle forall a b. (a -> b) -> a -> b
$ style
style)
     PDFFloat -> PDFFloat -> PDFText ()
textStart PDFFloat
x PDFFloat
y
     forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [forall s. SerializeValue s Char => s
newline,forall s. SerializeValue s Char => s
lbracket])
  -- Here we need to dilate the space to take into account r and the font setting
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TextDrawingState
state forall a. Eq a => a -> a -> Bool
== TextDrawingState
StartText Bool -> Bool -> Bool
|| TextDrawingState
state forall a. Eq a => a -> a -> Bool
== TextDrawingState
OneBlock Bool -> Bool -> Bool
|| TextDrawingState
state forall a. Eq a => a -> a -> Bool
== TextDrawingState
ContinueText) forall a b. (a -> b) -> a -> b
$ (do
      case Maybe PDFGlyph
t of
          Maybe PDFGlyph
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just PDFGlyph
myText -> forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ forall a. PdfObject a => a -> Builder
toPDF PDFGlyph
myText
    )
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TextDrawingState
state forall a. Eq a => a -> a -> Bool
== TextDrawingState
StopText Bool -> Bool -> Bool
|| TextDrawingState
state forall a. Eq a => a -> a -> Bool
== TextDrawingState
OneBlock) forall a b. (a -> b) -> a -> b
$ (do
      forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall s. SerializeValue s Char => s
rbracket
      forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall a b. (a -> b) -> a -> b
$ forall s a. SerializeValue s a => a -> s
serialize [Char]
" TJ")
      
-- | Draw the additional displacement required for a space in a text due to the dilaton of the glue
drawTextGlue :: Style style 
             => style
             -> PDFFloat
             -> PDFText ()
drawTextGlue :: forall style. Style style => style -> PDFFloat -> PDFText ()
drawTextGlue style
style PDFFloat
w = do              
    let ws :: PDFFloat
ws = forall a. Style a => a -> PDFFloat
spaceWidth style
style
        PDFFont AnyFont
_ Int
size = TextStyle -> PDFFont
textFont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Style a => a -> TextStyle
textStyle forall a b. (a -> b) -> a -> b
$ style
style
        delta :: PDFFloat
delta = PDFFloat
w forall a. Num a => a -> a -> a
- PDFFloat
ws 
    forall (m :: * -> *) a. Monad m => a -> m a
return ()
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ [ forall s. SerializeValue s Char => s
lparen, forall s. SerializeValue s Char => s
bspace,forall s. SerializeValue s Char => s
rparen,forall s. SerializeValue s Char => s
bspace,forall a. PdfObject a => a -> Builder
toPDF ((-PDFFloat
delta) forall a. Num a => a -> a -> a
* PDFFloat
1000.0 forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) ), forall s. SerializeValue s Char => s
bspace]  
    
  
data TextDrawingState = StartText -- ^ Send PDF commands needed to start a text
                      | ContinueText -- ^ Continue adding text
                      | StopText -- ^ Stop the text
                      | OneBlock -- ^ One block of text
                      deriving(TextDrawingState -> TextDrawingState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextDrawingState -> TextDrawingState -> Bool
$c/= :: TextDrawingState -> TextDrawingState -> Bool
== :: TextDrawingState -> TextDrawingState -> Bool
$c== :: TextDrawingState -> TextDrawingState -> Bool
Eq)
              
instance (Style s) => DisplayableBox (HBox s) where
     strokeBox :: HBox s -> PDFFloat -> PDFFloat -> Draw ()
strokeBox a :: HBox s
a@(HBox PDFFloat
_ PDFFloat
_ PDFFloat
_ [HBox s]
l) PDFFloat
x PDFFloat
y = do
         let he :: PDFFloat
he = forall a. Box a => a -> PDFFloat
boxHeight HBox s
a
             de :: PDFFloat
de = forall a. Box a => a -> PDFFloat
boxDescent HBox s
a
         forall s.
Style s =>
PDFFloat -> PDFFloat -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
drawLineOfHboxes PDFFloat
he PDFFloat
de [HBox s]
l PDFFloat
x PDFFloat
y
        
     strokeBox a :: HBox s
a@(HGlue PDFFloat
w Maybe (PDFFloat, PDFFloat)
_ (Just s
style)) PDFFloat
x PDFFloat
y = do
         let de :: PDFFloat
de = forall a. Box a => a -> PDFFloat
boxDescent HBox s
a
             he :: PDFFloat
he = forall a. Box a => a -> PDFFloat
boxHeight HBox s
a
             y' :: PDFFloat
y' = PDFFloat
y forall a. Num a => a -> a -> a
- PDFFloat
he forall a. Num a => a -> a -> a
+ PDFFloat
de
         -- In word mode we have to apply a special function to the word
         -- otherwise we apply a different function to the sentence
         if (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
Style a =>
a -> Maybe (Rectangle -> StyleFunction -> Draw b -> Draw ())
wordStyle forall a b. (a -> b) -> a -> b
$ s
style)
             then
                 (forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
Style a =>
a -> Maybe (Rectangle -> StyleFunction -> Draw b -> Draw ())
wordStyle forall a b. (a -> b) -> a -> b
$ s
style) (Point -> Point -> Rectangle
Rectangle (PDFFloat
x forall a. a -> a -> Complex a
:+ (PDFFloat
y' forall a. Num a => a -> a -> a
- PDFFloat
de)) ((PDFFloat
xforall a. Num a => a -> a -> a
+PDFFloat
w) forall a. a -> a -> Complex a
:+ (PDFFloat
y' forall a. Num a => a -> a -> a
- PDFFloat
de forall a. Num a => a -> a -> a
+ PDFFloat
he))) StyleFunction
DrawGlue (forall (m :: * -> *) a. Monad m => a -> m a
return ())
             else
                 forall (m :: * -> *) a. Monad m => a -> m a
return ()
                 
     strokeBox a :: HBox s
a@(Text s
style PDFGlyph
t PDFFloat
w) PDFFloat
x PDFFloat
y = do
         let de :: PDFFloat
de = forall a. Box a => a -> PDFFloat
boxDescent HBox s
a
             he :: PDFFloat
he = forall a. Box a => a -> PDFFloat
boxHeight HBox s
a
             y' :: PDFFloat
y' = PDFFloat
y forall a. Num a => a -> a -> a
- PDFFloat
he forall a. Num a => a -> a -> a
+ PDFFloat
de
         -- In word mode we have to apply a special function to the word
         -- otherwise we apply a different function to the sentence
         if (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
Style a =>
a -> Maybe (Rectangle -> StyleFunction -> Draw b -> Draw ())
wordStyle forall a b. (a -> b) -> a -> b
$ s
style)
             then
                 (forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
Style a =>
a -> Maybe (Rectangle -> StyleFunction -> Draw b -> Draw ())
wordStyle forall a b. (a -> b) -> a -> b
$ s
style) (Point -> Point -> Rectangle
Rectangle (PDFFloat
x forall a. a -> a -> Complex a
:+ (PDFFloat
y' forall a. Num a => a -> a -> a
- PDFFloat
de)) ((PDFFloat
xforall a. Num a => a -> a -> a
+PDFFloat
w) forall a. a -> a -> Complex a
:+ (PDFFloat
y' forall a. Num a => a -> a -> a
- PDFFloat
de forall a. Num a => a -> a -> a
+ PDFFloat
he))) StyleFunction
DrawWord (forall a. PDFText a -> Draw a
drawText forall a b. (a -> b) -> a -> b
$ forall style.
Style style =>
TextDrawingState
-> style -> PDFFloat -> PDFFloat -> Maybe PDFGlyph -> PDFText ()
drawTheTextBox TextDrawingState
OneBlock s
style PDFFloat
x PDFFloat
y' (forall a. a -> Maybe a
Just PDFGlyph
t))
             else 
                 forall a. PDFText a -> Draw a
drawText  forall a b. (a -> b) -> a -> b
$ forall style.
Style style =>
TextDrawingState
-> style -> PDFFloat -> PDFFloat -> Maybe PDFGlyph -> PDFText ()
drawTheTextBox TextDrawingState
OneBlock s
style PDFFloat
x PDFFloat
y' (forall a. a -> Maybe a
Just PDFGlyph
t)

     strokeBox (SomeHBox BoxDimension
_ AnyBox
a Maybe s
_) PDFFloat
x PDFFloat
y = forall a. DisplayableBox a => a -> PDFFloat -> PDFFloat -> Draw ()
strokeBox AnyBox
a PDFFloat
x PDFFloat
y
     strokeBox (HGlue PDFFloat
_ Maybe (PDFFloat, PDFFloat)
_ Maybe s
_) PDFFloat
_ PDFFloat
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
     
 -- Test is a box has same style
isSameStyle :: (Style s) => s 
         -> HBox s
         -> Bool
isSameStyle :: forall s. Style s => s -> HBox s -> Bool
isSameStyle s
s (Text s
style PDFGlyph
_ PDFFloat
_) = s
s forall a. ComparableStyle a => a -> a -> Bool
`isSameStyleAs` s
style
isSameStyle s
s (HGlue PDFFloat
_ Maybe (PDFFloat, PDFFloat)
_ (Just s
style)) = s
s forall a. ComparableStyle a => a -> a -> Bool
`isSameStyleAs` s
style
isSameStyle s
s (SomeHBox BoxDimension
_ AnyBox
_ (Just s
style)) = s
s forall a. ComparableStyle a => a -> a -> Bool
`isSameStyleAs` s
style
isSameStyle s
_ HBox s
_ = Bool
False