HPDF-1.4: Generation of PDF documentsSource codeContentsIndex
Graphics.PDF.Typesetting
Portabilityportable
Stabilityexperimental
Maintainermisc@NOSPAMalpheccar.org
Contents
Types
Boxes
Styles
Typesetting monads
Containers
Functions
Text display
Text construction operators
Paragraph construction operators
Functions useful to change the paragraph style
Container
Settings (similar to TeX ones)
Line breaking settings
Vertical mode settings
Styles
Description
Experimental typesetting. It is a work in progress
Synopsis
class Box a where
boxWidth :: a -> PDFFloat
boxHeight :: a -> PDFFloat
boxDescent :: a -> PDFFloat
boxAscent :: a -> PDFFloat
class DisplayableBox a where
strokeBox :: a -> PDFFloat -> PDFFloat -> Draw ()
data Letter s
= Letter BoxDimension !AnyBox !(Maybe s)
| Glue !PDFFloat !PDFFloat !PDFFloat !(Maybe s)
| FlaggedPenalty !PDFFloat !Int !s
| Penalty !Int
| AChar !s !Char !PDFFloat
| Kern !PDFFloat !(Maybe s)
type BoxDimension = (PDFFloat, PDFFloat, PDFFloat)
class ComparableStyle a => Style a where
sentenceStyle :: a -> Maybe (Rectangle -> Draw b -> Draw ())
wordStyle :: a -> Maybe (Rectangle -> StyleFunction -> Draw b -> Draw ())
textStyle :: a -> TextStyle
updateStyle :: a -> a
styleHeight :: a -> PDFFloat
styleDescent :: a -> PDFFloat
data TextStyle = TextStyle {
textFont :: !PDFFont
textStrokeColor :: !Color
textFillColor :: !Color
textMode :: !TextMode
penWidth :: !PDFFloat
scaleSpace :: !PDFFloat
scaleDilatation :: !PDFFloat
scaleCompression :: !PDFFloat
}
data StyleFunction
= DrawWord
| DrawGlue
class (ComparableStyle a, Style s) => ParagraphStyle a s | a -> s where
lineWidth :: a -> PDFFloat -> Int -> PDFFloat
linePosition :: a -> PDFFloat -> Int -> PDFFloat
interline :: a -> Maybe (Rectangle -> Draw ())
paragraphChange :: a -> Int -> [Letter s] -> (a, [Letter s])
paragraphStyle :: a -> Maybe (Rectangle -> Draw b -> Draw ())
class (Style s, Monad m) => MonadStyle s m | m -> s where
setStyle :: s -> m ()
currentStyle :: m s
addBox :: (Show a, DisplayableBox a, Box a) => a -> PDFFloat -> PDFFloat -> PDFFloat -> m ()
glue :: PDFFloat -> PDFFloat -> PDFFloat -> m ()
unstyledGlue :: PDFFloat -> PDFFloat -> PDFFloat -> m ()
class ComparableStyle a where
isSameStyleAs :: a -> a -> Bool
data Para s a
data TM ps s a
data VBox ps s
data VerState s = VerState {
baselineskip :: !(PDFFloat, PDFFloat, PDFFloat)
lineskip :: !(PDFFloat, PDFFloat, PDFFloat)
lineskiplimit :: !PDFFloat
currentParagraphStyle :: !s
}
data Container ps s
data Justification
= FullJustification
| Centered
| LeftJustification
| RightJustification
data Orientation
= E
| W
| N
| S
| NE
| NW
| SE
| SW
displayFormattedText :: ParagraphStyle ps s => Rectangle -> ps -> s -> TM ps s a -> Draw a
txt :: Style s => String -> Para s ()
kern :: Style s => PDFFloat -> Para s ()
addPenalty :: Int -> Para s ()
mkLetter :: (Show a, Box a, DisplayableBox a) => BoxDimension -> Maybe s -> a -> Letter s
mkDrawBox :: Draw () -> DrawBox
forceNewLine :: Style s => Para s ()
paragraph :: Style s => Para s a -> TM ps s a
endPara :: Style s => Para s ()
startPara :: Style s => Para s ()
getParaStyle :: TM ps s ps
setParaStyle :: ParagraphStyle ps s => ps -> TM ps s ()
mkContainer :: PDFFloat -> PDFFloat -> PDFFloat -> PDFFloat -> PDFFloat -> Container ps s
fillContainer :: (ParagraphStyle ps s, ComparableStyle ps) => VerState ps -> Container ps s -> [VBox ps s] -> (Draw (), Container ps s, [VBox ps s])
defaultVerState :: s -> VerState s
getBoxes :: ParagraphStyle ps s => ps -> s -> TM ps s a -> [VBox ps s]
containerX :: Container ps s -> PDFFloat
containerY :: Container ps s -> PDFFloat
containerWidth :: Container ps s -> PDFFloat
containerHeight :: Container ps s -> PDFFloat
containerContentHeight :: Container ps s -> PDFFloat
containerContentRightBorder :: Container ps s -> PDFFloat
containerContentLeftBorder :: Container ps s -> PDFFloat
containerCurrentHeight :: Container ps s -> PDFFloat
containerContentRectangle :: Container ps s -> Rectangle
drawTextBox :: (ParagraphStyle ps s, Style s) => PDFFloat -> PDFFloat -> PDFFloat -> PDFFloat -> Orientation -> ps -> s -> TM ps s a -> (Rectangle, Draw ())
setFirstPassTolerance :: PDFFloat -> TM ps s ()
setSecondPassTolerance :: PDFFloat -> TM ps s ()
setHyphenPenaltyValue :: Int -> TM ps s ()
setFitnessDemerit :: PDFFloat -> TM ps s ()
setHyphenDemerit :: PDFFloat -> TM ps s ()
setLinePenalty :: PDFFloat -> TM ps s ()
getFirstPassTolerance :: TM ps s PDFFloat
getSecondPassTolerance :: TM ps s PDFFloat
getHyphenPenaltyValue :: TM ps s Int
getFitnessDemerit :: TM ps s PDFFloat
getHyphenDemerit :: TM ps s PDFFloat
getLinePenalty :: TM ps s PDFFloat
setJustification :: Justification -> TM ps s ()
setBaseLineSkip :: PDFFloat -> PDFFloat -> PDFFloat -> TM ps s ()
setLineSkipLimit :: PDFFloat -> TM ps s ()
setLineSkip :: PDFFloat -> PDFFloat -> PDFFloat -> TM ps s ()
getBaseLineSkip :: TM ps s (PDFFloat, PDFFloat, PDFFloat)
getLineSkipLimit :: TM ps s PDFFloat
getLineSkip :: TM ps s (PDFFloat, PDFFloat, PDFFloat)
data StandardStyle = Font PDFFont Color Color
data StandardParagraphStyle = NormalParagraph
Types
Boxes
class Box a whereSource
A box is an object with dimensions and used in the typesetting process
Methods
boxWidthSource
:: aBox
-> PDFFloatWidth of the box
boxHeight :: a -> PDFFloatSource
boxDescent :: a -> PDFFloatSource
boxAscent :: a -> PDFFloatSource
show/hide Instances
Box AnyBox
Box BoxDimension
Box DrawBox
Style s => Box (HBox s)
Box (VBox ps s)
class DisplayableBox a whereSource
A box that can be displayed
Methods
strokeBoxSource
:: aThe box
-> PDFFloatHorizontal position
-> PDFFloatVertical position (top of the box and NOT baseline)
-> Draw ()
show/hide Instances
data Letter s Source
A letter which can be anything. Sizes are widths and for glue the dilation and compression factors For the generic letter, height and descent are also provided
Constructors
Letter BoxDimension !AnyBox !(Maybe s)Any box as a letter
Glue !PDFFloat !PDFFloat !PDFFloat !(Maybe s)A glue with style to know if it is part of the same sentence
FlaggedPenalty !PDFFloat !Int !sHyphen point
Penalty !IntPenalty
AChar !s !Char !PDFFloatA char
Kern !PDFFloat !(Maybe s)A kern : non dilatable and non breakable glue
show/hide Instances
Show (Letter s)
MaybeGlue (Letter s)
type BoxDimension = (PDFFloat, PDFFloat, PDFFloat)Source
Dimension of a box : width, height and descent
Styles
class ComparableStyle a => Style a whereSource
Style of text (sentences and words). Minimum definition textStyle
Methods
sentenceStyleSource
::
=> aThe style
-> Maybe (Rectangle -> Draw b -> Draw ())Function receiving the bounding rectangle and the command for drawing the sentence
wordStyleSource
::
=> aThe style
-> Maybe (Rectangle -> StyleFunction -> Draw b -> Draw ())Word styling function
textStyle :: a -> TextStyleSource
updateStyle :: a -> aSource
styleHeight :: a -> PDFFloatSource
styleDescent :: a -> PDFFloatSource
show/hide Instances
data TextStyle Source
Text style used by PDF operators
Constructors
TextStyle
textFont :: !PDFFont
textStrokeColor :: !Color
textFillColor :: !Color
textMode :: !TextMode
penWidth :: !PDFFloat
scaleSpace :: !PDFFloatScaling factor for normal space size (scale also the dilation and compression factors)
scaleDilatation :: !PDFFloatScale the dilation factor of glues
scaleCompression :: !PDFFloatScale the compression factor of glues
show/hide Instances
data StyleFunction Source
What kind of style drawing function is required for a word when word styling is enabled
Constructors
DrawWordMust style a word
DrawGlueMust style a glue
show/hide Instances
class (ComparableStyle a, Style s) => ParagraphStyle a s | a -> s whereSource
Paragraph style
Methods
lineWidthSource
:: aThe style
-> PDFFloatWidth of the text area used by the typesetting algorithm
-> IntLine number
-> PDFFloatLine width
linePositionSource
:: aThe style
-> PDFFloatWidth of the text area used by the typesetting algorithm
-> IntLine number
-> PDFFloatHorizontal offset from the left edge of the text area
interlineSource
:: aThe style
-> Maybe (Rectangle -> Draw ())Function used to style interline glues
paragraphChangeSource
:: aThe style
-> IntLine offset different from 0 when a paragraph has been broken
-> [Letter s]List of letters in the paragraph
-> (a, [Letter s])Update style and list of letters
paragraphStyleSource
::
=> aThe style
-> Maybe (Rectangle -> Draw b -> Draw ())Function used to style a paragraph
show/hide Instances
class (Style s, Monad m) => MonadStyle s m | m -> s whereSource
A MonadStyle where some typesetting operators can be used
Methods
setStyle :: s -> m ()Source
Set the current text style
currentStyle :: m sSource
Get the current text style
addBoxSource
:: (Show a, DisplayableBox a, Box a)
=> a
-> PDFFloatWidth
-> PDFFloatHeight
-> PDFFloatDescent
-> m ()
Add a box using the current mode (horizontal or vertical. The current style is always applied to the added box)
glueSource
:: PDFFloatSize of glue (width or height depending on the mode)
-> PDFFloatDilatation factor
-> PDFFloatCompression factor
-> m ()
Add a glue using the current style
unstyledGlueSource
:: PDFFloatSize of glue (width or height depending on the mode)
-> PDFFloatDilatation factor
-> PDFFloatCompression factor
-> m ()
Add a glue with no style (it is just a translation)
show/hide Instances
Style s => MonadStyle s (Para s)
Style s => MonadStyle s (TM ps s)
class ComparableStyle a whereSource
Used to compare two style without taking into account the style state
Methods
isSameStyleAs :: a -> a -> BoolSource
show/hide Instances
Typesetting monads
data Para s a Source
show/hide Instances
data TM ps s a Source
show/hide Instances
Style s => MonadStyle s (TM ps s)
MonadWriter ([] (VBox ps s)) (TM ps s)
Monad (TM ps s)
Functor (TM ps s)
MonadState (TMState ps s) (TM ps s)
Containers
data VBox ps s Source
show/hide Instances
Show (VBox ps s)
ParagraphStyle ps s => DisplayableBox (VBox ps s)
Box (VBox ps s)
MaybeGlue (VBox ps s)
data VerState s Source
Constructors
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 :: !PDFFloatDefault value 2
currentParagraphStyle :: !s
data Container ps s Source
Container for vboxes (x,y,width,maxheight,height,currenty,current z, tolerance para) tolerance para means a paragraph is not started if too close from the bottom edge of the box
data Justification Source
Constructors
FullJustification
Centered
LeftJustification
RightJustification
show/hide Instances
data Orientation Source
Constructors
E
W
N
S
NE
NW
SE
SW
show/hide Instances
Functions
Text display
displayFormattedTextSource
:: ParagraphStyle ps s
=> RectangleText area
-> psdefault vertical style
-> sDefault horizontal style
-> TM ps s aTypesetting monad
-> Draw aDraw monad
Display a formatted text in a given bounding rectangle with a given default paragraph style, a given default text style. No clipping is taking place. Drawing stop when the last line is crossing the bounding rectangle in vertical direction
Text construction operators
txt :: Style s => String -> Para s ()Source
Add a text line
kern :: Style s => PDFFloat -> Para s ()Source
add a kern (space that can be dilated or compressed and on which no line breaking can occur)
addPenalty :: Int -> Para s ()Source
Add a penalty
mkLetterSource
:: (Show a, Box a, DisplayableBox a)
=> BoxDimensionDimension of the box
-> Maybe sText style of the box (can use t)
-> aBox
-> Letter s
Make a letter from any box
mkDrawBox :: Draw () -> DrawBoxSource
Make a drawing box. A box object containing a Draw value
Paragraph construction operators
forceNewLine :: Style s => Para s ()Source
For a newline and end the current paragraph
paragraph :: Style s => Para s a -> TM ps s aSource
Add a new paragraph to the text
endPara :: Style s => Para s ()Source
startPara :: Style s => Para s ()Source
Functions useful to change the paragraph style
getParaStyle :: TM ps s psSource
Get the current paragraph style
setParaStyle :: ParagraphStyle ps s => ps -> TM ps s ()Source
Change the current paragraph style
Container
mkContainerSource
::
=> PDFFloatx
-> PDFFloaty
-> PDFFloatwidth
-> PDFFloatheight
-> PDFFloatPargraph tolerance
-> Container ps sNew container
Create a empty container to constraint the amount of line that can be displayed
fillContainerSource
:: (ParagraphStyle ps s, ComparableStyle ps)
=> VerState psVertical style for interline glues
-> Container ps sContainer
-> [VBox ps s]VBox to add
-> (Draw (), Container ps s, [VBox ps s])Component to draw, new container and remaining VBoxes due to overfull container
Fill a container with lines
defaultVerState :: s -> VerState sSource

Default vertical state

 Default values
 baselineskip = (12,0.17,0.0)
 lineskip = (3.0,0.33,0.0)
 lineskiplimit = 2
getBoxesSource
:: ParagraphStyle ps s
=> psdefault vertical style
-> sDefault horizontal style
-> TM ps s aTypesetting monad
-> [VBox ps s]List of boxes
Return the list of Vboxes for a text
containerX :: Container ps s -> PDFFloatSource
Container horizontal position
containerY :: Container ps s -> PDFFloatSource
Container vertical position
containerWidth :: Container ps s -> PDFFloatSource
Get the width of the container
containerHeight :: Container ps s -> PDFFloatSource
Get the height of the container
containerContentHeight :: Container ps s -> PDFFloatSource
Get the content height of the container with glue dilatation
containerContentRightBorder :: Container ps s -> PDFFloatSource
Get the maximum right border of the container content (maybe bigger than container width due to overfull lines)
containerContentLeftBorder :: Container ps s -> PDFFloatSource
Get the minimum left border of the container content
containerCurrentHeight :: Container ps s -> PDFFloatSource
Get the current height of the container without glue dilatation
containerContentRectangle :: Container ps s -> RectangleSource
Return the rectangle containing the text after formatting and glue dilatation
drawTextBoxSource
:: (ParagraphStyle ps s, Style s)
=> PDFFloatx
-> PDFFloaty
-> PDFFloatwidth limit
-> PDFFloatheight limit
-> Orientation
-> psdefault vertical style
-> sDefault horizontal style
-> TM ps s aTypesetting monad
-> (Rectangle, Draw ())
Draw a text box with relative position. Useful for labels
Settings (similar to TeX ones)
Line breaking settings
setFirstPassTolerance :: PDFFloat -> TM ps s ()Source
setSecondPassTolerance :: PDFFloat -> TM ps s ()Source
setHyphenPenaltyValue :: Int -> TM ps s ()Source
setFitnessDemerit :: PDFFloat -> TM ps s ()Source
setHyphenDemerit :: PDFFloat -> TM ps s ()Source
setLinePenalty :: PDFFloat -> TM ps s ()Source
getFirstPassTolerance :: TM ps s PDFFloatSource
getSecondPassTolerance :: TM ps s PDFFloatSource
getHyphenPenaltyValue :: TM ps s IntSource
getFitnessDemerit :: TM ps s PDFFloatSource
getHyphenDemerit :: TM ps s PDFFloatSource
getLinePenalty :: TM ps s PDFFloatSource
setJustificationSource
::
=> JustificationCentered, left or fully justified
-> TM ps s ()
Vertical mode settings
setBaseLineSkip :: PDFFloat -> PDFFloat -> PDFFloat -> TM ps s ()Source
setLineSkipLimit :: PDFFloat -> TM ps s ()Source
setLineSkip :: PDFFloat -> PDFFloat -> PDFFloat -> TM ps s ()Source
getBaseLineSkip :: TM ps s (PDFFloat, PDFFloat, PDFFloat)Source
getLineSkipLimit :: TM ps s PDFFloatSource
getLineSkip :: TM ps s (PDFFloat, PDFFloat, PDFFloat)Source
Styles
data StandardStyle Source
Standard styles for sentences
Constructors
Font PDFFont Color Color
show/hide Instances
data StandardParagraphStyle Source
Standard styles for paragraphs
Constructors
NormalParagraph
show/hide Instances
Produced by Haddock version 2.3.0