---------------------------------------------------------
-- |
-- 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 (ByteString -> PDFGlyph)
-> (ByteString -> ByteString) -> ByteString -> PDFGlyph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
S.reverse (ByteString -> PDFGlyph) -> ByteString -> PDFGlyph
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)) [] = [s -> PDFGlyph -> PDFFloat -> HBox s
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) = PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r ((s, PDFGlyph, PDFFloat) -> Maybe (s, PDFGlyph, PDFFloat)
forall a. a -> Maybe a
Just (s
s,ByteString -> PDFGlyph
PDFGlyph (Word8 -> ByteString
S.singleton (GlyphCode -> Word8
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 s -> s -> Bool
forall a. ComparableStyle a => a -> a -> Bool
`isSameStyleAs` s
s' = PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r ((s, PDFGlyph, PDFFloat) -> Maybe (s, PDFGlyph, PDFFloat)
forall a. a -> Maybe a
Just (s
s,ByteString -> PDFGlyph
PDFGlyph (Word8 -> ByteString -> ByteString
S.cons (GlyphCode -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral GlyphCode
t') ByteString
t),PDFFloat
wPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+PDFFloat
w')) [Letter s]
l
                                                            | Bool
otherwise = (s -> PDFGlyph -> PDFFloat -> HBox s
forall s. s -> PDFGlyph -> PDFFloat -> HBox s
createText s
s (PDFGlyph -> PDFGlyph
saveCurrentword (PDFGlyph -> PDFGlyph) -> PDFGlyph -> PDFGlyph
forall a b. (a -> b) -> a -> b
$ (ByteString -> PDFGlyph
PDFGlyph ByteString
t)) PDFFloat
w)HBox s -> [HBox s] -> [HBox s]
forall a. a -> [a] -> [a]
:PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r ((s, PDFGlyph, PDFFloat) -> Maybe (s, PDFGlyph, PDFFloat)
forall a. a -> Maybe a
Just (s
s',ByteString -> PDFGlyph
PDFGlyph (Word8 -> ByteString
S.singleton (GlyphCode -> Word8
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) = (s -> PDFGlyph -> PDFFloat -> HBox s
forall s. s -> PDFGlyph -> PDFFloat -> HBox s
createText s
s (PDFGlyph -> PDFGlyph
saveCurrentword (PDFGlyph -> PDFGlyph) -> PDFGlyph -> PDFGlyph
forall a b. (a -> b) -> a -> b
$ PDFGlyph
t) PDFFloat
w)HBox s -> [HBox s] -> [HBox s]
forall a. a -> [a] -> [a]
:(PDFFloat -> Maybe (PDFFloat, PDFFloat) -> Maybe s -> HBox s
forall s.
PDFFloat -> Maybe (PDFFloat, PDFFloat) -> Maybe s -> HBox s
HGlue PDFFloat
w' ((PDFFloat, PDFFloat) -> Maybe (PDFFloat, PDFFloat)
forall a. a -> Maybe a
Just(PDFFloat
y,PDFFloat
z)) (s -> Maybe s
forall a. a -> Maybe a
Just s
s'))HBox s -> [HBox s] -> [HBox s]
forall a. a -> [a] -> [a]
:PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r  Maybe (s, PDFGlyph, PDFFloat)
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) = PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
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) = PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
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) = (PDFFloat -> Maybe (PDFFloat, PDFFloat) -> Maybe s -> HBox s
forall s.
PDFFloat -> Maybe (PDFFloat, PDFFloat) -> Maybe s -> HBox s
HGlue PDFFloat
w' ((PDFFloat, PDFFloat) -> Maybe (PDFFloat, PDFFloat)
forall a. a -> Maybe a
Just(PDFFloat
y,PDFFloat
z)) Maybe s
s)HBox s -> [HBox s] -> [HBox s]
forall a. a -> [a] -> [a]
:PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r Maybe (s, PDFGlyph, PDFFloat)
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) = (s -> PDFGlyph -> PDFFloat -> HBox s
forall s. s -> PDFGlyph -> PDFFloat -> HBox s
createText s
s (PDFGlyph -> PDFGlyph
saveCurrentword (PDFGlyph -> PDFGlyph) -> PDFGlyph -> PDFGlyph
forall a b. (a -> b) -> a -> b
$ PDFGlyph
t) PDFFloat
w)HBox s -> [HBox s] -> [HBox s]
forall a. a -> [a] -> [a]
:(PDFFloat -> Maybe (PDFFloat, PDFFloat) -> Maybe s -> HBox s
forall s.
PDFFloat -> Maybe (PDFFloat, PDFFloat) -> Maybe s -> HBox s
HGlue PDFFloat
w' ((PDFFloat, PDFFloat) -> Maybe (PDFFloat, PDFFloat)
forall a. a -> Maybe a
Just(PDFFloat
y,PDFFloat
z)) Maybe s
forall a. Maybe a
Nothing)HBox s -> [HBox s] -> [HBox s]
forall a. a -> [a] -> [a]
:PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r Maybe (s, PDFGlyph, PDFFloat)
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) = (PDFFloat -> Maybe (PDFFloat, PDFFloat) -> Maybe s -> HBox s
forall s.
PDFFloat -> Maybe (PDFFloat, PDFFloat) -> Maybe s -> HBox s
HGlue PDFFloat
w' Maybe (PDFFloat, PDFFloat)
forall a. Maybe a
Nothing Maybe s
s)HBox s -> [HBox s] -> [HBox s]
forall a. a -> [a] -> [a]
:PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r Maybe (s, PDFGlyph, PDFFloat)
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) = (s -> PDFGlyph -> PDFFloat -> HBox s
forall s. s -> PDFGlyph -> PDFFloat -> HBox s
createText s
s (PDFGlyph -> PDFGlyph
saveCurrentword (PDFGlyph -> PDFGlyph) -> PDFGlyph -> PDFGlyph
forall a b. (a -> b) -> a -> b
$ PDFGlyph
t) PDFFloat
w)HBox s -> [HBox s] -> [HBox s]
forall a. a -> [a] -> [a]
:(PDFFloat -> Maybe (PDFFloat, PDFFloat) -> Maybe s -> HBox s
forall s.
PDFFloat -> Maybe (PDFFloat, PDFFloat) -> Maybe s -> HBox s
HGlue PDFFloat
w' Maybe (PDFFloat, PDFFloat)
forall a. Maybe a
Nothing Maybe s
s')HBox s -> [HBox s] -> [HBox s]
forall a. a -> [a] -> [a]
:PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r Maybe (s, PDFGlyph, PDFFloat)
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) = (BoxDimension -> AnyBox -> Maybe s -> HBox s
forall s. BoxDimension -> AnyBox -> Maybe s -> HBox s
SomeHBox BoxDimension
d AnyBox
a Maybe s
s)HBox s -> [HBox s] -> [HBox s]
forall a. a -> [a] -> [a]
:PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r Maybe (s, PDFGlyph, PDFFloat)
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) = (s -> PDFGlyph -> PDFFloat -> HBox s
forall s. s -> PDFGlyph -> PDFFloat -> HBox s
createText s
s (PDFGlyph -> PDFGlyph
saveCurrentword (PDFGlyph -> PDFGlyph) -> PDFGlyph -> PDFGlyph
forall a b. (a -> b) -> a -> b
$ PDFGlyph
t) PDFFloat
w)HBox s -> [HBox s] -> [HBox s]
forall a. a -> [a] -> [a]
:(BoxDimension -> AnyBox -> Maybe s -> HBox s
forall s. BoxDimension -> AnyBox -> Maybe s -> HBox s
SomeHBox BoxDimension
d AnyBox
a Maybe s
st)HBox s -> [HBox s] -> [HBox s]
forall a. a -> [a] -> [a]
:PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r Maybe (s, PDFGlyph, PDFFloat)
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'' = PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
forall s.
ComparableStyle s =>
PDFFloat -> Maybe (s, PDFGlyph, PDFFloat) -> [Letter s] -> [HBox s]
createWords PDFFloat
r Maybe (s, PDFGlyph, PDFFloat)
forall a. Maybe a
Nothing ([Letter s] -> [HBox s])
-> ([Letter s] -> [Letter s]) -> [Letter s] -> [HBox s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Letter s] -> [Letter s]
forall s. [Letter s] -> [Letter s]
simplify ([Letter s] -> [HBox s]) -> [Letter s] -> [HBox s]
forall a b. (a -> b) -> a -> b
$ [Letter s]
l' in
  if [HBox s] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HBox s]
l''
      then
          [(PDFFloat, [Letter s], [Letter s])] -> [(HBox s, [Letter s])]
forall s.
Style s =>
[(PDFFloat, [Letter s], [Letter s])] -> [(HBox s, [Letter s])]
horizontalPostProcess [(PDFFloat, [Letter s], [Letter s])]
l
      else
          ((PDFFloat -> [HBox s] -> HBox s
forall s. Style s => PDFFloat -> [HBox s] -> HBox s
mkHboxWithRatio PDFFloat
r [HBox s]
l''),[Letter s]
r')(HBox s, [Letter s])
-> [(HBox s, [Letter s])] -> [(HBox s, [Letter s])]
forall a. a -> [a] -> [a]
:[(PDFFloat, [Letter s], [Letter s])] -> [(HBox s, [Letter s])]
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
_) = PDFFloat -> Maybe (PDFFloat, PDFFloat) -> Maybe s -> HBox s
forall s.
PDFFloat -> Maybe (PDFFloat, PDFFloat) -> Maybe s -> HBox s
HGlue PDFFloat
a Maybe (PDFFloat, PDFFloat)
b (s -> Maybe s
forall a. a -> Maybe a
Just s
s)
withNewStyle s
s (Text s
_ PDFGlyph
a PDFFloat
b) = s -> PDFGlyph -> PDFFloat -> HBox s
forall s. s -> PDFGlyph -> PDFFloat -> HBox s
Text s
s PDFGlyph
a PDFFloat
b
withNewStyle s
s (SomeHBox BoxDimension
d AnyBox
a Maybe s
_) = BoxDimension -> AnyBox -> Maybe s -> HBox s
forall s. BoxDimension -> AnyBox -> Maybe s -> HBox s
SomeHBox BoxDimension
d AnyBox
a (s -> Maybe s
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
_ [] = [Char] -> HBox s
forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot create an empty horizontal box"
mkHboxWithRatio PDFFloat
r [HBox s]
l = 
    let w :: PDFFloat
w = (PDFFloat -> HBox s -> PDFFloat)
-> PDFFloat -> [HBox s] -> PDFFloat
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\PDFFloat
x HBox s
y -> PDFFloat
x PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+ HBox s -> PDFFloat -> PDFFloat
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 = [PDFFloat] -> PDFFloat
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([PDFFloat] -> PDFFloat)
-> ([HBox s] -> [PDFFloat]) -> [HBox s] -> PDFFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HBox s -> PDFFloat) -> [HBox s] -> [PDFFloat]
forall a b. (a -> b) -> [a] -> [b]
map HBox s -> PDFFloat
forall a. Box a => a -> PDFFloat
boxAscent ([HBox s] -> PDFFloat) -> [HBox s] -> PDFFloat
forall a b. (a -> b) -> a -> b
$ [HBox s]
l
        d :: PDFFloat
d = [PDFFloat] -> PDFFloat
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([PDFFloat] -> PDFFloat)
-> ([HBox s] -> [PDFFloat]) -> [HBox s] -> PDFFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HBox s -> PDFFloat) -> [HBox s] -> [PDFFloat]
forall a b. (a -> b) -> [a] -> [b]
map HBox s -> PDFFloat
forall a. Box a => a -> PDFFloat
boxDescent ([HBox s] -> PDFFloat) -> [HBox s] -> PDFFloat
forall a b. (a -> b) -> a -> b
$ [HBox s]
l
        h :: PDFFloat
h = PDFFloat
ascent PDFFloat -> PDFFloat -> PDFFloat
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') = PDFFloat -> PDFFloat -> PDFFloat -> [HBox s] -> HBox s
forall s. PDFFloat -> PDFFloat -> PDFFloat -> [HBox s] -> HBox s
HBox PDFFloat
w' PDFFloat
h' PDFFloat
d' (PDFFloat -> Maybe (PDFFloat, PDFFloat) -> Maybe s -> HBox s
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) Maybe (PDFFloat, PDFFloat)
forall a. Maybe a
Nothing Maybe s
sHBox s -> [HBox s] -> [HBox s]
forall a. a -> [a] -> [a]
:[HBox s]
l')
        addBox HBox s
a (HBox PDFFloat
w' PDFFloat
h' PDFFloat
d' [HBox s]
l') = PDFFloat -> PDFFloat -> PDFFloat -> [HBox s] -> HBox s
forall s. PDFFloat -> PDFFloat -> PDFFloat -> [HBox s] -> HBox s
HBox PDFFloat
w' PDFFloat
h' PDFFloat
d' (HBox s
aHBox s -> [HBox s] -> [HBox s]
forall a. a -> [a] -> [a]
:[HBox s]
l')
        addBox HBox s
_ HBox s
_ = [Char] -> 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
    (HBox s -> HBox s -> HBox s) -> HBox s -> [HBox s] -> HBox s
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr HBox s -> HBox s -> HBox s
forall {s}. HBox s -> HBox s -> HBox s
addBox (PDFFloat -> PDFFloat -> PDFFloat -> [HBox s] -> HBox s
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
_ = HBox s -> 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 = s -> PDFGlyph -> PDFFloat -> HBox s
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 " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [HBox s] -> [Char]
forall a. Show a => a -> [Char]
show [HBox s]
a [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
   show (HGlue PDFFloat
a Maybe (PDFFloat, PDFFloat)
_ Maybe s
_) = [Char]
"(HGlue " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PDFFloat -> [Char]
forall a. Show a => a -> [Char]
show PDFFloat
a [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
   show (Text s
_ PDFGlyph
t PDFFloat
_) = [Char]
"(Text " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PDFGlyph -> [Char]
forall a. Show a => a -> [Char]
show PDFGlyph
t [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
   show (SomeHBox BoxDimension
_ AnyBox
t Maybe s
_) = [Char]
"(SomeHBox " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ AnyBox -> [Char]
forall a. Show a => a -> [Char]
show AnyBox
t [Char] -> ShowS
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
_ = () -> Draw ()
forall a. a -> Draw a
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 | (Maybe (Rectangle -> StyleFunction -> Draw Any -> Draw ()) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Rectangle -> StyleFunction -> Draw Any -> Draw ()) -> Bool)
-> (s -> Maybe (Rectangle -> StyleFunction -> Draw Any -> Draw ()))
-> s
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Maybe (Rectangle -> StyleFunction -> Draw Any -> Draw ())
forall b.
s -> Maybe (Rectangle -> StyleFunction -> Draw b -> Draw ())
forall a b.
Style a =>
a -> Maybe (Rectangle -> StyleFunction -> Draw b -> Draw ())
wordStyle (s -> Bool) -> s -> Bool
forall a b. (a -> b) -> a -> b
$ s
style) =  do
    let  h :: PDFFloat
h = HBox s -> PDFFloat
forall a. Box a => a -> PDFFloat
boxHeight HBox s
a
         d :: PDFFloat
d = HBox s -> PDFFloat
forall a. Box a => a -> PDFFloat
boxDescent HBox s
a
         y' :: PDFFloat
y' = PDFFloat
y PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+ PDFFloat
h PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- PDFFloat
d
    HBox s -> PDFFloat -> PDFFloat -> Draw ()
forall a. DisplayableBox a => a -> PDFFloat -> PDFFloat -> Draw ()
strokeBox (s -> HBox s -> HBox s
forall s. s -> HBox s -> HBox s
withNewStyle s
style HBox s
a) PDFFloat
x PDFFloat
y'
    s -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
forall s.
Style s =>
s -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
drawTextLine (s -> s
forall a. Style a => a -> a
updateStyle s
style) [HBox s]
l' (PDFFloat
x PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+ HBox s -> PDFFloat
forall a. Box a => a -> PDFFloat
boxWidth HBox s
a) PDFFloat
y
                                 | Bool
otherwise = s -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
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
_ = () -> Draw ()
forall a. a -> Draw a
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') <- PDFText ([HBox s], PDFFloat) -> Draw ([HBox s], PDFFloat)
forall a. PDFText a -> Draw a
drawText (PDFText ([HBox s], PDFFloat) -> Draw ([HBox s], PDFFloat))
-> PDFText ([HBox s], PDFFloat) -> Draw ([HBox s], PDFFloat)
forall a b. (a -> b) -> a -> b
$ do
       TextDrawingState
-> s -> PDFFloat -> PDFFloat -> Maybe PDFGlyph -> PDFText ()
forall style.
Style style =>
TextDrawingState
-> style -> PDFFloat -> PDFFloat -> Maybe PDFGlyph -> PDFText ()
drawTheTextBox TextDrawingState
StartText s
s PDFFloat
x PDFFloat
y (PDFGlyph -> Maybe PDFGlyph
forall a. a -> Maybe a
Just PDFGlyph
t)
       s
-> [HBox s] -> PDFFloat -> PDFFloat -> PDFText ([HBox s], PDFFloat)
forall s.
Style s =>
s
-> [HBox s] -> PDFFloat -> PDFFloat -> PDFText ([HBox s], PDFFloat)
drawPureWords s
s [HBox s]
l (PDFFloat
x PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+ PDFFloat
w) PDFFloat
y
    s -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
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') <- PDFText ([HBox s], PDFFloat) -> Draw ([HBox s], PDFFloat)
forall a. PDFText a -> Draw a
drawText (PDFText ([HBox s], PDFFloat) -> Draw ([HBox s], PDFFloat))
-> PDFText ([HBox s], PDFFloat) -> Draw ([HBox s], PDFFloat)
forall a b. (a -> b) -> a -> b
$ do
       TextDrawingState
-> s -> PDFFloat -> PDFFloat -> Maybe PDFGlyph -> PDFText ()
forall style.
Style style =>
TextDrawingState
-> style -> PDFFloat -> PDFFloat -> Maybe PDFGlyph -> PDFText ()
drawTheTextBox TextDrawingState
StartText s
s PDFFloat
x PDFFloat
y Maybe PDFGlyph
forall a. Maybe a
Nothing
       s
-> [HBox s] -> PDFFloat -> PDFFloat -> PDFText ([HBox s], PDFFloat)
forall s.
Style s =>
s
-> [HBox s] -> PDFFloat -> PDFFloat -> PDFText ([HBox s], PDFFloat)
drawPureWords s
s [HBox s]
l PDFFloat
x PDFFloat
y
    s -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
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 = HBox s -> PDFFloat
forall a. Box a => a -> PDFFloat
boxHeight HBox s
a
        d :: PDFFloat
d = HBox s -> PDFFloat
forall a. Box a => a -> PDFFloat
boxDescent HBox s
a
        w :: PDFFloat
w = HBox s -> PDFFloat
forall a. Box a => a -> PDFFloat
boxWidth HBox s
a
        y' :: PDFFloat
y' = PDFFloat
y PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- PDFFloat
d PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+ PDFFloat
h
    HBox s -> PDFFloat -> PDFFloat -> Draw ()
forall a. DisplayableBox a => a -> PDFFloat -> PDFFloat -> Draw ()
strokeBox HBox s
a PDFFloat
x PDFFloat
y'
    s -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
forall s.
Style s =>
s -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
drawWords s
s [HBox s]
l (PDFFloat
x PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+ PDFFloat
w) PDFFloat
y

drawWords s
_ [HBox s]
_ PDFFloat
_ PDFFloat
_ = () -> Draw ()
forall a. a -> Draw a
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
    TextDrawingState
-> s -> PDFFloat -> PDFFloat -> Maybe PDFGlyph -> PDFText ()
forall style.
Style style =>
TextDrawingState
-> style -> PDFFloat -> PDFFloat -> Maybe PDFGlyph -> PDFText ()
drawTheTextBox TextDrawingState
StopText s
s PDFFloat
x PDFFloat
y Maybe PDFGlyph
forall a. Maybe a
Nothing
    ([HBox s], PDFFloat) -> PDFText ([HBox s], PDFFloat)
forall a. a -> PDFText a
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
    TextDrawingState
-> s -> PDFFloat -> PDFFloat -> Maybe PDFGlyph -> PDFText ()
forall style.
Style style =>
TextDrawingState
-> style -> PDFFloat -> PDFFloat -> Maybe PDFGlyph -> PDFText ()
drawTheTextBox TextDrawingState
ContinueText s
s PDFFloat
x PDFFloat
y (PDFGlyph -> Maybe PDFGlyph
forall a. a -> Maybe a
Just PDFGlyph
t)
    s
-> [HBox s] -> PDFFloat -> PDFFloat -> PDFText ([HBox s], PDFFloat)
forall s.
Style s =>
s
-> [HBox s] -> PDFFloat -> PDFFloat -> PDFText ([HBox s], PDFFloat)
drawPureWords s
s [HBox s]
l (PDFFloat
x PDFFloat -> PDFFloat -> PDFFloat
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
    s -> PDFFloat -> PDFText ()
forall style. Style style => style -> PDFFloat -> PDFText ()
drawTextGlue s
s PDFFloat
w
    s
-> [HBox s] -> PDFFloat -> PDFFloat -> PDFText ([HBox s], PDFFloat)
forall s.
Style s =>
s
-> [HBox s] -> PDFFloat -> PDFFloat -> PDFText ([HBox s], PDFFloat)
drawPureWords s
s [HBox s]
l (PDFFloat
x PDFFloat -> PDFFloat -> PDFFloat
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
    TextDrawingState
-> s -> PDFFloat -> PDFFloat -> Maybe PDFGlyph -> PDFText ()
forall style.
Style style =>
TextDrawingState
-> style -> PDFFloat -> PDFFloat -> Maybe PDFGlyph -> PDFText ()
drawTheTextBox TextDrawingState
StopText s
s PDFFloat
x PDFFloat
y Maybe PDFGlyph
forall a. Maybe a
Nothing
    ([HBox s], PDFFloat) -> PDFText ([HBox s], PDFFloat)
forall a. a -> PDFText a
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 = s
-> [HBox s] -> PDFFloat -> PDFFloat -> PDFText ([HBox s], PDFFloat)
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 PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- PDFFloat
hl PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+ PDFFloat
dl
           ([HBox s]
l',[HBox s]
l'') = (HBox s -> Bool) -> [HBox s] -> ([HBox s], [HBox s])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (s -> HBox s -> Bool
forall s. Style s => s -> HBox s -> Bool
isSameStyle s
style) [HBox s]
l
           w' :: PDFFloat
w' = (PDFFloat -> HBox s -> PDFFloat)
-> PDFFloat -> [HBox s] -> PDFFloat
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\PDFFloat
x' HBox s
ny -> PDFFloat
x' PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+ HBox s -> PDFFloat
forall a. Box a => a -> PDFFloat
boxWidth HBox s
ny) PDFFloat
0.0 [HBox s]
l'
       if (Maybe (Rectangle -> Draw Any -> Draw ()) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Rectangle -> Draw Any -> Draw ()) -> Bool)
-> (s -> Maybe (Rectangle -> Draw Any -> Draw ())) -> s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Maybe (Rectangle -> Draw Any -> Draw ())
forall b. s -> Maybe (Rectangle -> Draw b -> Draw ())
forall a b. Style a => a -> Maybe (Rectangle -> Draw b -> Draw ())
sentenceStyle (s -> Bool) -> s -> Bool
forall a b. (a -> b) -> a -> b
$ s
style)
             then do
                 (Maybe (Rectangle -> Draw () -> Draw ())
-> Rectangle -> Draw () -> Draw ()
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Rectangle -> Draw () -> Draw ())
 -> Rectangle -> Draw () -> Draw ())
-> (s -> Maybe (Rectangle -> Draw () -> Draw ()))
-> s
-> Rectangle
-> Draw ()
-> Draw ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Maybe (Rectangle -> Draw () -> Draw ())
forall b. s -> Maybe (Rectangle -> Draw b -> Draw ())
forall a b. Style a => a -> Maybe (Rectangle -> Draw b -> Draw ())
sentenceStyle (s -> Rectangle -> Draw () -> Draw ())
-> s -> Rectangle -> Draw () -> Draw ()
forall a b. (a -> b) -> a -> b
$ s
style) (Point -> Point -> Rectangle
Rectangle (PDFFloat
x PDFFloat -> PDFFloat -> Point
forall a. a -> a -> Complex a
:+ (PDFFloat
y PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- PDFFloat
hl)) ((PDFFloat
xPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+PDFFloat
w') PDFFloat -> PDFFloat -> Point
forall a. a -> a -> Complex a
:+ PDFFloat
y)) (s -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
forall s.
Style s =>
s -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
drawTextLine s
style [HBox s]
l' PDFFloat
x PDFFloat
y')
             else do
                 s -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
forall s.
Style s =>
s -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
drawTextLine s
style [HBox s]
l' PDFFloat
x PDFFloat
y'
       PDFFloat -> PDFFloat -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
forall s.
Style s =>
PDFFloat -> PDFFloat -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
drawLineOfHboxes PDFFloat
hl PDFFloat
dl [HBox s]
l'' (PDFFloat
x PDFFloat -> PDFFloat -> PDFFloat
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
_ = () -> Draw ()
forall a. a -> Draw a
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 = PDFFloat
-> PDFFloat -> [HBox s] -> PDFFloat -> PDFFloat -> s -> Draw ()
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 = PDFFloat
-> PDFFloat -> [HBox s] -> PDFFloat -> PDFFloat -> s -> Draw ()
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 = HBox s -> PDFFloat
forall a. Box a => a -> PDFFloat
boxHeight HBox s
a
           d :: PDFFloat
d = HBox s -> PDFFloat
forall a. Box a => a -> PDFFloat
boxDescent HBox s
a
           -- Compute top of box a
           y' :: PDFFloat
y' = PDFFloat
y  PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- PDFFloat
hl PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+ PDFFloat
dl PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- PDFFloat
d PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+ PDFFloat
h
      HBox s -> PDFFloat -> PDFFloat -> Draw ()
forall a. DisplayableBox a => a -> PDFFloat -> PDFFloat -> Draw ()
strokeBox HBox s
a PDFFloat
x PDFFloat
y'
      PDFFloat -> PDFFloat -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
forall s.
Style s =>
PDFFloat -> PDFFloat -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
drawLineOfHboxes PDFFloat
hl PDFFloat
dl [HBox s]
l (PDFFloat
x PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+ HBox s -> PDFFloat
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
_)  = BoxDimension -> PDFFloat
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
_) = s -> 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
_) = BoxDimension -> PDFFloat
forall a. Box a => a -> PDFFloat
boxHeight BoxDimension
d
     boxHeight (HGlue PDFFloat
_ Maybe (PDFFloat, PDFFloat)
_ (Just s
s)) = s -> PDFFloat
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
_) = s -> 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
_) = BoxDimension -> PDFFloat
forall a. Box a => a -> PDFFloat
boxDescent BoxDimension
d
     boxDescent (HGlue PDFFloat
_ Maybe (PDFFloat, PDFFloat)
_ (Just s
s)) = s -> PDFFloat
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
  Bool -> PDFText () -> PDFText ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TextDrawingState
state TextDrawingState -> TextDrawingState -> Bool
forall a. Eq a => a -> a -> Bool
== TextDrawingState
StartText Bool -> Bool -> Bool
|| TextDrawingState
state TextDrawingState -> TextDrawingState -> Bool
forall a. Eq a => a -> a -> Bool
== TextDrawingState
OneBlock) (PDFText () -> PDFText ()) -> PDFText () -> PDFText ()
forall a b. (a -> b) -> a -> b
$ (do
     PDFFont -> PDFText ()
setFont (TextStyle -> PDFFont
textFont (TextStyle -> PDFFont) -> (style -> TextStyle) -> style -> PDFFont
forall b c a. (b -> c) -> (a -> b) -> a -> c
. style -> TextStyle
forall a. Style a => a -> TextStyle
textStyle (style -> PDFFont) -> style -> PDFFont
forall a b. (a -> b) -> a -> b
$ style
style)
     Color -> PDFText ()
forall (m :: * -> *). MonadPath m => Color -> m ()
strokeColor (TextStyle -> Color
textStrokeColor (TextStyle -> Color) -> (style -> TextStyle) -> style -> Color
forall b c a. (b -> c) -> (a -> b) -> a -> c
. style -> TextStyle
forall a. Style a => a -> TextStyle
textStyle (style -> Color) -> style -> Color
forall a b. (a -> b) -> a -> b
$ style
style)
     Color -> PDFText ()
forall (m :: * -> *). MonadPath m => Color -> m ()
fillColor (TextStyle -> Color
textFillColor (TextStyle -> Color) -> (style -> TextStyle) -> style -> Color
forall b c a. (b -> c) -> (a -> b) -> a -> c
. style -> TextStyle
forall a. Style a => a -> TextStyle
textStyle (style -> Color) -> style -> Color
forall a b. (a -> b) -> a -> b
$ style
style)
     TextMode -> PDFText ()
renderMode (TextStyle -> TextMode
textMode (TextStyle -> TextMode)
-> (style -> TextStyle) -> style -> TextMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. style -> TextStyle
forall a. Style a => a -> TextStyle
textStyle (style -> TextMode) -> style -> TextMode
forall a b. (a -> b) -> a -> b
$ style
style)
     PDFFloat -> PDFText ()
forall (m :: * -> *). MonadPath m => PDFFloat -> m ()
setWidth (TextStyle -> PDFFloat
penWidth (TextStyle -> PDFFloat)
-> (style -> TextStyle) -> style -> PDFFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. style -> TextStyle
forall a. Style a => a -> TextStyle
textStyle (style -> PDFFloat) -> style -> PDFFloat
forall a b. (a -> b) -> a -> b
$ style
style)
     PDFFloat -> PDFFloat -> PDFText ()
textStart PDFFloat
x PDFFloat
y
     Builder -> PDFText ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> PDFText ()) -> Builder -> PDFText ()
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
forall s. SerializeValue s Char => s
newline,Builder
forall s. SerializeValue s Char => s
lbracket])
  -- Here we need to dilate the space to take into account r and the font setting
  Bool -> PDFText () -> PDFText ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TextDrawingState
state TextDrawingState -> TextDrawingState -> Bool
forall a. Eq a => a -> a -> Bool
== TextDrawingState
StartText Bool -> Bool -> Bool
|| TextDrawingState
state TextDrawingState -> TextDrawingState -> Bool
forall a. Eq a => a -> a -> Bool
== TextDrawingState
OneBlock Bool -> Bool -> Bool
|| TextDrawingState
state TextDrawingState -> TextDrawingState -> Bool
forall a. Eq a => a -> a -> Bool
== TextDrawingState
ContinueText) (PDFText () -> PDFText ()) -> PDFText () -> PDFText ()
forall a b. (a -> b) -> a -> b
$ (do
      case Maybe PDFGlyph
t of
          Maybe PDFGlyph
Nothing -> () -> PDFText ()
forall a. a -> PDFText a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just PDFGlyph
myText -> Builder -> PDFText ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> PDFText ()) -> Builder -> PDFText ()
forall a b. (a -> b) -> a -> b
$ PDFGlyph -> Builder
forall a. PdfObject a => a -> Builder
toPDF PDFGlyph
myText
    )
  Bool -> PDFText () -> PDFText ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TextDrawingState
state TextDrawingState -> TextDrawingState -> Bool
forall a. Eq a => a -> a -> Bool
== TextDrawingState
StopText Bool -> Bool -> Bool
|| TextDrawingState
state TextDrawingState -> TextDrawingState -> Bool
forall a. Eq a => a -> a -> Bool
== TextDrawingState
OneBlock) (PDFText () -> PDFText ()) -> PDFText () -> PDFText ()
forall a b. (a -> b) -> a -> b
$ (do
      Builder -> PDFText ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Builder
forall s. SerializeValue s Char => s
rbracket
      Builder -> PDFText ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> PDFText ()) -> Builder -> PDFText ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Builder
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 = style -> PDFFloat
forall a. Style a => a -> PDFFloat
spaceWidth style
style
        PDFFont AnyFont
_ Int
size = TextStyle -> PDFFont
textFont (TextStyle -> PDFFont) -> (style -> TextStyle) -> style -> PDFFont
forall b c a. (b -> c) -> (a -> b) -> a -> c
. style -> TextStyle
forall a. Style a => a -> TextStyle
textStyle (style -> PDFFont) -> style -> PDFFont
forall a b. (a -> b) -> a -> b
$ style
style
        delta :: PDFFloat
delta = PDFFloat
w PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- PDFFloat
ws 
    () -> PDFText ()
forall a. a -> PDFText a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Builder -> PDFText ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> PDFText ())
-> ([Builder] -> Builder) -> [Builder] -> PDFText ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> PDFText ()) -> [Builder] -> PDFText ()
forall a b. (a -> b) -> a -> b
$ [ Builder
forall s. SerializeValue s Char => s
lparen, Builder
forall s. SerializeValue s Char => s
bspace,Builder
forall s. SerializeValue s Char => s
rparen,Builder
forall s. SerializeValue s Char => s
bspace,PDFFloat -> Builder
forall a. PdfObject a => a -> Builder
toPDF ((-PDFFloat
delta) PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
* PDFFloat
1000.0 PDFFloat -> PDFFloat -> PDFFloat
forall a. Fractional a => a -> a -> a
/ (Int -> PDFFloat
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) ), Builder
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
(TextDrawingState -> TextDrawingState -> Bool)
-> (TextDrawingState -> TextDrawingState -> Bool)
-> Eq TextDrawingState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextDrawingState -> TextDrawingState -> Bool
== :: TextDrawingState -> TextDrawingState -> Bool
$c/= :: TextDrawingState -> TextDrawingState -> Bool
/= :: 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 = HBox s -> PDFFloat
forall a. Box a => a -> PDFFloat
boxHeight HBox s
a
             de :: PDFFloat
de = HBox s -> PDFFloat
forall a. Box a => a -> PDFFloat
boxDescent HBox s
a
         PDFFloat -> PDFFloat -> [HBox s] -> PDFFloat -> PDFFloat -> Draw ()
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 = HBox s -> PDFFloat
forall a. Box a => a -> PDFFloat
boxDescent HBox s
a
             he :: PDFFloat
he = HBox s -> PDFFloat
forall a. Box a => a -> PDFFloat
boxHeight HBox s
a
             y' :: PDFFloat
y' = PDFFloat
y PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- PDFFloat
he PDFFloat -> PDFFloat -> PDFFloat
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 (Maybe (Rectangle -> StyleFunction -> Draw Any -> Draw ()) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Rectangle -> StyleFunction -> Draw Any -> Draw ()) -> Bool)
-> (s -> Maybe (Rectangle -> StyleFunction -> Draw Any -> Draw ()))
-> s
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Maybe (Rectangle -> StyleFunction -> Draw Any -> Draw ())
forall b.
s -> Maybe (Rectangle -> StyleFunction -> Draw b -> Draw ())
forall a b.
Style a =>
a -> Maybe (Rectangle -> StyleFunction -> Draw b -> Draw ())
wordStyle (s -> Bool) -> s -> Bool
forall a b. (a -> b) -> a -> b
$ s
style)
             then
                 (Maybe (Rectangle -> StyleFunction -> Draw () -> Draw ())
-> Rectangle -> StyleFunction -> Draw () -> Draw ()
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Rectangle -> StyleFunction -> Draw () -> Draw ())
 -> Rectangle -> StyleFunction -> Draw () -> Draw ())
-> (s -> Maybe (Rectangle -> StyleFunction -> Draw () -> Draw ()))
-> s
-> Rectangle
-> StyleFunction
-> Draw ()
-> Draw ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Maybe (Rectangle -> StyleFunction -> Draw () -> Draw ())
forall b.
s -> Maybe (Rectangle -> StyleFunction -> Draw b -> Draw ())
forall a b.
Style a =>
a -> Maybe (Rectangle -> StyleFunction -> Draw b -> Draw ())
wordStyle (s -> Rectangle -> StyleFunction -> Draw () -> Draw ())
-> s -> Rectangle -> StyleFunction -> Draw () -> Draw ()
forall a b. (a -> b) -> a -> b
$ s
style) (Point -> Point -> Rectangle
Rectangle (PDFFloat
x PDFFloat -> PDFFloat -> Point
forall a. a -> a -> Complex a
:+ (PDFFloat
y' PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- PDFFloat
de)) ((PDFFloat
xPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+PDFFloat
w) PDFFloat -> PDFFloat -> Point
forall a. a -> a -> Complex a
:+ (PDFFloat
y' PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- PDFFloat
de PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+ PDFFloat
he))) StyleFunction
DrawGlue (() -> Draw ()
forall a. a -> Draw a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
             else
                 () -> Draw ()
forall a. a -> Draw a
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 = HBox s -> PDFFloat
forall a. Box a => a -> PDFFloat
boxDescent HBox s
a
             he :: PDFFloat
he = HBox s -> PDFFloat
forall a. Box a => a -> PDFFloat
boxHeight HBox s
a
             y' :: PDFFloat
y' = PDFFloat
y PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- PDFFloat
he PDFFloat -> PDFFloat -> PDFFloat
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 (Maybe (Rectangle -> StyleFunction -> Draw Any -> Draw ()) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Rectangle -> StyleFunction -> Draw Any -> Draw ()) -> Bool)
-> (s -> Maybe (Rectangle -> StyleFunction -> Draw Any -> Draw ()))
-> s
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Maybe (Rectangle -> StyleFunction -> Draw Any -> Draw ())
forall b.
s -> Maybe (Rectangle -> StyleFunction -> Draw b -> Draw ())
forall a b.
Style a =>
a -> Maybe (Rectangle -> StyleFunction -> Draw b -> Draw ())
wordStyle (s -> Bool) -> s -> Bool
forall a b. (a -> b) -> a -> b
$ s
style)
             then
                 (Maybe (Rectangle -> StyleFunction -> Draw () -> Draw ())
-> Rectangle -> StyleFunction -> Draw () -> Draw ()
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Rectangle -> StyleFunction -> Draw () -> Draw ())
 -> Rectangle -> StyleFunction -> Draw () -> Draw ())
-> (s -> Maybe (Rectangle -> StyleFunction -> Draw () -> Draw ()))
-> s
-> Rectangle
-> StyleFunction
-> Draw ()
-> Draw ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Maybe (Rectangle -> StyleFunction -> Draw () -> Draw ())
forall b.
s -> Maybe (Rectangle -> StyleFunction -> Draw b -> Draw ())
forall a b.
Style a =>
a -> Maybe (Rectangle -> StyleFunction -> Draw b -> Draw ())
wordStyle (s -> Rectangle -> StyleFunction -> Draw () -> Draw ())
-> s -> Rectangle -> StyleFunction -> Draw () -> Draw ()
forall a b. (a -> b) -> a -> b
$ s
style) (Point -> Point -> Rectangle
Rectangle (PDFFloat
x PDFFloat -> PDFFloat -> Point
forall a. a -> a -> Complex a
:+ (PDFFloat
y' PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- PDFFloat
de)) ((PDFFloat
xPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+PDFFloat
w) PDFFloat -> PDFFloat -> Point
forall a. a -> a -> Complex a
:+ (PDFFloat
y' PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
- PDFFloat
de PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
+ PDFFloat
he))) StyleFunction
DrawWord (PDFText () -> Draw ()
forall a. PDFText a -> Draw a
drawText (PDFText () -> Draw ()) -> PDFText () -> Draw ()
forall a b. (a -> b) -> a -> b
$ TextDrawingState
-> s -> PDFFloat -> PDFFloat -> Maybe PDFGlyph -> PDFText ()
forall style.
Style style =>
TextDrawingState
-> style -> PDFFloat -> PDFFloat -> Maybe PDFGlyph -> PDFText ()
drawTheTextBox TextDrawingState
OneBlock s
style PDFFloat
x PDFFloat
y' (PDFGlyph -> Maybe PDFGlyph
forall a. a -> Maybe a
Just PDFGlyph
t))
             else 
                 PDFText () -> Draw ()
forall a. PDFText a -> Draw a
drawText  (PDFText () -> Draw ()) -> PDFText () -> Draw ()
forall a b. (a -> b) -> a -> b
$ TextDrawingState
-> s -> PDFFloat -> PDFFloat -> Maybe PDFGlyph -> PDFText ()
forall style.
Style style =>
TextDrawingState
-> style -> PDFFloat -> PDFFloat -> Maybe PDFGlyph -> PDFText ()
drawTheTextBox TextDrawingState
OneBlock s
style PDFFloat
x PDFFloat
y' (PDFGlyph -> Maybe PDFGlyph
forall a. a -> Maybe a
Just PDFGlyph
t)

     strokeBox (SomeHBox BoxDimension
_ AnyBox
a Maybe s
_) PDFFloat
x PDFFloat
y = AnyBox -> PDFFloat -> PDFFloat -> Draw ()
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
_ = () -> Draw ()
forall a. a -> Draw a
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 s -> s -> Bool
forall a. ComparableStyle a => a -> a -> Bool
`isSameStyleAs` s
style
isSameStyle s
s (HGlue PDFFloat
_ Maybe (PDFFloat, PDFFloat)
_ (Just s
style)) = s
s s -> s -> Bool
forall a. ComparableStyle a => a -> a -> Bool
`isSameStyleAs` s
style
isSameStyle s
s (SomeHBox BoxDimension
_ AnyBox
_ (Just s
style)) = s
s s -> s -> Bool
forall a. ComparableStyle a => a -> a -> Bool
`isSameStyleAs` s
style
isSameStyle s
_ HBox s
_ = Bool
False