HPDF-1.1: Graphics/PDF/Typesetting/Vertical.hs
---------------------------------------------------------
-- |
-- Copyright : (c) alpha 2006
-- License : BSD-style
--
-- Maintainer : misc@NOSPAMalpheccar.org
-- Stability : experimental
-- Portability : portable
--
-- Vertical mode
---------------------------------------------------------
-- #hide
module Graphics.PDF.Typesetting.Vertical (
VBox(..)
, VerState(..)
, verticalPostProcess
, mkVboxWithRatio
, strokeVBoxes
, vglue
, defaultVerState
, ParagraphStyle(..)
, AnyParagraphStyle(..)
) where
import Graphics.PDF.LowLevel.Types
import Graphics.PDF.Typesetting.Breaking
import Graphics.PDF.Typesetting.Horizontal(horizontalPostProcess,HBox)
import Graphics.PDF.Draw
import Graphics.PDF.Shapes(Rectangle(..))
import Graphics.PDF.Typesetting.Box
import Data.List(foldl')
import Data.Maybe(isJust,fromJust)
data VerState = VerState { baselineskip :: !(PDFFloat,PDFFloat,PDFFloat) -- ^ Default value (12,0.17,0.0)
, lineskip :: !(PDFFloat,PDFFloat,PDFFloat) -- ^ Default value (3.0,0.33,0.0)
, lineskiplimit :: !PDFFloat -- ^ Default value 2
, paraStyle :: !AnyParagraphStyle
}
defaultVerState :: ParagraphStyle s => s -> VerState
defaultVerState s = VerState { baselineskip = (12,0.17,0.0)
, lineskip = (3.0,0.33,0.0)
, lineskiplimit = 2
, paraStyle = AnyParagraphStyle s
}
-- | Pair of functions describing the shape of a text areas : horizontal position of each line, vertical top of the area, width of each line
-- First line is 1
data VBox = Paragraph [Letter] !(Maybe AnyParagraphStyle) !BRState
| VBox !PDFFloat !PDFFloat !PDFFloat ![VBox] !(Maybe AnyParagraphStyle)
| VGlue !PDFFloat !PDFFloat !PDFFloat !(Maybe (PDFFloat,PDFFloat)) !(Maybe AnyParagraphStyle)
| SomeVBox !PDFFloat !BoxDimension !AnyBox !(Maybe AnyParagraphStyle)
vglue :: Maybe AnyParagraphStyle
-> PDFFloat -- ^ Glue height
-> PDFFloat -- ^ Glue dilatation factor
-> PDFFloat -- ^ Glue compression factor
-> PDFFloat -- ^ Glue width
-> PDFFloat -- ^ Glue delta
-> VBox
vglue s h y z width delta = VGlue h width delta (Just(y,z)) s
instance Show VBox where
show (VBox _ _ _ a _) = "(HBox " ++ show a ++ ")"
show (VGlue a _ _ _ _) = "(HGlue " ++ show a ++ ")"
show (Paragraph _ _ _) = "(Paragraph)"
show (SomeVBox _ _ t _) = "(SomeHBox " ++ show t ++ ")"
-- | 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)
mkVboxWithRatio :: PDFFloat -- ^ Adjustement ratio
-> [VBox]
-> VBox
mkVboxWithRatio _ [] = SomeVBox 0.0 (0,0,0) (AnyBox NullChar) Nothing
mkVboxWithRatio r l =
let w = foldl' (\x y -> x + boxWidthWithRatio y r) 0.0 l
h = maximum . map boxHeight $ l
d = maximum . map boxDescent $ l
addBox (VGlue gw gh gdelta (Just(y,z)) s) (VBox w' h' d' l' s') = VBox w' h' d' (VGlue (glueWidth gw y z r) gh gdelta Nothing s:l') s'
addBox a (VBox w' h' d' l' s') = VBox w' h' d' (a:l') s'
addBox _ _ = error "We can add boxes only to an horizontal list"
in
-- Add boxes and dilate glues when needing fixing their dimensions after dilatation
foldr addBox (VBox w h d [] Nothing) l
instance MaybeGlue VBox where
boxWidthWithRatio (VGlue w _ _ (Just(y,z)) _) r = glueWidth w y z r
boxWidthWithRatio a _ = boxWidth a
-- | Convert pure lines to VBoxes
toVBoxes :: Maybe AnyParagraphStyle
-> PDFFloat -- ^ Max width
-> [HBox] -- ^ List of lines
-> [VBox] -- ^ List of VBoxes
toVBoxes Nothing _ l = map createVBox l
where
createVBox a = SomeVBox 0.0 (boxWidth a,boxHeight a,boxDescent a) (AnyBox a) Nothing
toVBoxes s@(Just style) w l = map createVBoxAndAddKern $ zip [1..] (l )
where
createVBoxAndAddKern (nb,a) =
let delta = (linePosition style) w nb
in
SomeVBox delta (boxWidth a,boxHeight a,boxDescent a) (AnyBox a) s
-- | Create VBoxes. Paragraphs are analyzed and cut into VBoxes. The pragraph style is updated and used
-- to transform the list of letters
verticalPostProcess :: VerState
-> Int -- ^ Line offset for the text area
-> Rectangle -- ^ Text area
-> [VBox] -- ^ List of VBox with paragraphs
-> [VBox] -- ^ List of VBox where paragraphs have been line broken
verticalPostProcess _ _ _ [] = []
verticalPostProcess pageSettings o rect@(Rectangle xa _ xb _) ((Paragraph l style paraSettings):l') =
let (fl,newStyle) = case style of
Nothing -> (formatList paraSettings (const $ xb-xa) l,Nothing)
Just aStyle -> let (style',nl) = paraChange aStyle l
in
(formatList paraSettings (\nb -> (lineWidth style') (xb-xa) nb ) nl,Just style')
in
(addInterlineGlue pageSettings . toVBoxes newStyle (xb - xa) . horizontalPostProcess $ fl) ++ verticalPostProcess pageSettings (o + length fl) rect l'
verticalPostProcess pageSettings o rect (a:l') = a:verticalPostProcess pageSettings (o+1) rect l'
notGlue :: VBox -> Bool
notGlue (VGlue _ _ _ _ _) = False
notGlue (Paragraph _ _ _) = False
notGlue _ = True
-- | Get the required style for the interline glue
getInterlineStyle :: VBox -> VBox -> Maybe AnyParagraphStyle
getInterlineStyle (VBox _ _ _ _ (Just s)) (SomeVBox _ _ _ (Just s')) | paraStyleCode s == paraStyleCode s' = Just s
| otherwise = Nothing
getInterlineStyle (VBox _ _ _ _ (Just s)) (VBox _ _ _ _ (Just s')) | paraStyleCode s == paraStyleCode s' = Just s
| otherwise = Nothing
getInterlineStyle (SomeVBox _ _ _ (Just s)) (SomeVBox _ _ _ (Just s')) | paraStyleCode s == paraStyleCode s' = Just s
| otherwise = Nothing
getInterlineStyle (SomeVBox _ _ _ (Just s)) (VBox _ _ _ _ (Just s')) | paraStyleCode s == paraStyleCode s' = Just s
| otherwise = Nothing
getInterlineStyle _ _ = Nothing
-- | Get the delta used to position a box with non rectangular shapes
getBoxDelta :: VBox -> PDFFloat
getBoxDelta (Paragraph _ _ _) = 0.0
getBoxDelta (VBox _ _ _ _ _) = 0.0
getBoxDelta (VGlue _ _ delta _ _) = delta
getBoxDelta (SomeVBox delta _ _ _) = delta
addInterlineGlue :: VerState -> [VBox] -> [VBox]
addInterlineGlue _ [] = []
addInterlineGlue _ [a] = [a]
addInterlineGlue settings (a:b:l) | notGlue a && notGlue b =
let p = boxDescent a
h = boxHeight b - boxDescent b
(ba,by,bz) = baselineskip settings
(lw,ly,lz) = lineskip settings
li = lineskiplimit settings
istyle = getInterlineStyle a b
theWidth = boxWidth a
theDelta = getBoxDelta a
in
if p <= -1000
then
a:addInterlineGlue settings (b:l)
else
if ba - p - h >= li
then
a:(vglue istyle (ba-p-h) by bz theWidth theDelta):addInterlineGlue settings (b:l)
else
a:(vglue istyle lw ly lz theWidth theDelta):addInterlineGlue settings (b:l)
| otherwise = a:addInterlineGlue settings (b:l)
instance Box VBox where
boxWidth (Paragraph _ _ _) = 0
boxWidth (VBox w _ _ _ _) = w
boxWidth (SomeVBox _ d _ _) = boxWidth d
boxWidth (VGlue _ w _ _ _) = w
boxHeight (Paragraph _ _ _) = 0
boxHeight (VBox _ h _ _ _) = h
boxHeight (SomeVBox _ d _ _) = boxHeight d
boxHeight (VGlue h _ _ _ _) = h
boxDescent (Paragraph _ _ _) = 0
boxDescent (VBox _ _ d _ _) = d
boxDescent (SomeVBox _ d _ _) = boxDescent d
boxDescent (VGlue _ _ _ _ _) = 0
instance DisplayableBox VBox where
strokeBox (Paragraph _ _ _) _ _ = return ()
strokeBox b@(VBox _ _ _ l _) x y'' = strokeVBoxes l (x,y',y'')
where
y' = y'' - boxHeight b
strokeBox (VGlue h w delta _ (Just style)) x y =
if (isJust . interline $ style)
then
(fromJust . interline $ style) $ Rectangle (x+delta) (y-h) (x+w+delta) y
else
return()
strokeBox (VGlue _ _ _ _ _) _ _ = return ()
strokeBox (SomeVBox delta _ a _) x y = strokeBox a (x+delta) y
isSameParaStyle :: AnyParagraphStyle -> VBox -> Bool
isSameParaStyle s (Paragraph _ (Just s') _) = paraStyleCode s == paraStyleCode s'
isSameParaStyle s (VBox _ _ _ _ (Just s')) = paraStyleCode s == paraStyleCode s'
isSameParaStyle s (VGlue _ _ _ _ (Just s')) = paraStyleCode s == paraStyleCode s'
isSameParaStyle s (SomeVBox _ _ _ (Just s')) = paraStyleCode s == paraStyleCode s'
isSameParaStyle _ _ = False
recurseStrokeVBoxes :: Int -> [VBox] -> (PDFFloat,PDFFloat,PDFFloat) -> Draw ()
recurseStrokeVBoxes _ [] _ = return ()
recurseStrokeVBoxes _ (Paragraph _ _ _:_) _ = return ()
recurseStrokeVBoxes nb (a@(VGlue _ _ _ _ _):l) (xa,y',y) = do
let h = boxHeight a
strokeBox a xa y
if y - h >= y'
then
recurseStrokeVBoxes nb l (xa,y',(y-h))
else
return ()
recurseStrokeVBoxes nb (a:l) (xa,y',y) = do
let h = boxHeight a
strokeBox a xa y
if y - h >= y'
then
recurseStrokeVBoxes (nb+1) l (xa,y',(y-h))
else
return ()
drawWithParaStyle :: AnyParagraphStyle -> [VBox] -> (PDFFloat,PDFFloat,PDFFloat) -> Draw ()
drawWithParaStyle style b (xa,y',y'') = do
let (l',l'') = span (isSameParaStyle style) b
h' = foldl' (\x' ny -> x' + boxHeight ny) 0.0 l'
if (isJust . paragraphStyle $ style)
then do
let xleft = (minimum $ 100000:map getBoxDelta l' ) + xa
xright = (maximum $ 0:(map (\x -> boxWidth x + getBoxDelta x) l')) + xa
(fromJust . paragraphStyle $ style) (Rectangle xleft (y''- h') xright (y'')) (recurseStrokeVBoxes 1 l' (xa,y',y''))
else
recurseStrokeVBoxes 1 l' (xa,y',y'')
strokeVBoxes l'' (xa,y',y''-h')
-- | Stroke the VBoxes
strokeVBoxes :: [VBox] -- ^ List of boxes
-> (PDFFloat,PDFFloat,PDFFloat)
-> Draw ()
strokeVBoxes [] (_,_,_) = return ()
strokeVBoxes b@((Paragraph _ (Just s') _):_) (xa,y',y'') = drawWithParaStyle s' b (xa,y',y'')
strokeVBoxes b@((VBox _ _ _ _ (Just s')):_) (xa,y',y'') = drawWithParaStyle s' b (xa,y',y'')
strokeVBoxes b@((VGlue _ _ _ _ (Just s')):_) (xa,y',y'') = drawWithParaStyle s' b (xa,y',y'')
strokeVBoxes b@((SomeVBox _ _ _ (Just s')):_) (xa,y',y'') = drawWithParaStyle s' b (xa,y',y'')
strokeVBoxes (a:l) (xa,y',y'') =
do
let h = boxHeight a
strokeBox a xa y''
if y'' - h >= y'
then
strokeVBoxes l (xa,y',(y''-h))
else
return ()
-- | Paragraph style
class ParagraphStyle a where
-- | Width of the line of the paragraph
lineWidth :: a -- ^ The style
-> PDFFloat -- ^ Width of the text area used by the typesetting algorithm
-> Int -- ^ Line number
-> PDFFloat -- ^ Line width
-- | Horizontal shift of the line position relatively to the left egde of the paragraph bounding box
linePosition :: a -- ^ The style
-> PDFFloat -- ^ Width of the text area used by the typesetting algorithm
-> Int -- ^ Line number
-> PDFFloat -- ^ Horizontal offset from the left edge of the text area
-- | All paragraph styles used in a document must have different codes
paraStyleCode :: a -- ^ The style
-> Int -- ^ Code identifying the style
-- | How to style the interline glues added in a paragraph by the line breaking algorithm
interline :: a -- ^ The style
-> Maybe (Rectangle -> Draw ()) -- ^ Function used to style interline glues
interline _ = Nothing
lineWidth _ w _ = w
linePosition _ _ = const 0.0
-- | Change the content of a paragraph before the line breaking algorithm is run. It may also change the style
paraChange :: a -- ^ The style
-> [Letter] -- ^ List of letters in the paragraph
-> (a,[Letter]) -- ^ Update style and list of letters
paraChange a l = (a,l)
-- | Get the paragraph bounding box and the paragraph draw command to apply additional effects
paragraphStyle :: a -- ^ The style
-> Maybe (Rectangle -> Draw b -> Draw ()) -- ^ Function used to style a paragraph
paragraphStyle _ = Nothing
-- | Any paragraph style
data AnyParagraphStyle = forall a . ParagraphStyle a => AnyParagraphStyle a
instance ParagraphStyle AnyParagraphStyle where
lineWidth (AnyParagraphStyle a) = lineWidth a
linePosition (AnyParagraphStyle a) = linePosition a
paraStyleCode (AnyParagraphStyle a) = paraStyleCode a
interline (AnyParagraphStyle a) = interline a
paraChange (AnyParagraphStyle a) l = let (a',l') = paraChange a l in (AnyParagraphStyle a',l')
paragraphStyle (AnyParagraphStyle a) = paragraphStyle a