HPDF-1.1: Graphics/PDF/Typesetting/Box.hs

---------------------------------------------------------
-- |
-- Copyright   : (c) alpha 2006
-- License     : BSD-style
--
-- Maintainer  : misc@NOSPAMalpheccar.org
-- Stability   : experimental
-- Portability : portable
--
-- Box
---------------------------------------------------------
-- #hide
module Graphics.PDF.Typesetting.Box (
    Box(..)
  , DisplayableBox(..)
  , AnyBox(..)
  , NullChar(..)
  , Overfull(..)
  , Style(..)
  , TextStyle(..)
  , StyleFunction(..)
  , AnyStyle(..)
  , BoxDimension
  , DrawBox
   ,mkDrawBox
 ) where
     
import Graphics.PDF.LowLevel.Types
import Graphics.PDF.Draw
import Graphics.PDF.Text
import Graphics.PDF.Shapes
import Graphics.PDF.Coordinates

-- | Make a drawing box. A box object containing a Draw value
mkDrawBox :: Draw () -> DrawBox
mkDrawBox d = DrawBox d

-- | A box containing a Draw value
newtype DrawBox = DrawBox (Draw())

instance Box DrawBox where
    boxWidth _ = 0
    boxHeight _ = 0
    boxDescent _ = 0
    
instance DisplayableBox DrawBox where
    strokeBox (DrawBox a) x y = do
        withNewContext $ do
            applyMatrix $ translate x y
            a
    
instance Show DrawBox where
    show _ = "DrawBox"

-- | Dimension of a box : width, height and descent
type BoxDimension = (PDFFloat,PDFFloat,PDFFloat)

-- | Text style used by PDF operators
data TextStyle = TextStyle { textFont :: !PDFFont
                           , textStrokeColor :: !Color
                           , textFillColor :: !Color
                           , textMode :: !TextMode
                           , penWidth :: !PDFFloat
                           , scaleSpace :: !PDFFloat -- ^ Scaling factor for normal space size (scale also the dilation and compression factors)
                           , scaleDilatation :: !PDFFloat -- ^ Scale the dilation factor of glues
                           , scaleCompression :: !PDFFloat -- ^ Scale the compression factor of glues
                           }
                           deriving(Eq)
             
-- | What kind of style drawing function is required for a word
-- when word styling is enabled              
data StyleFunction = DrawWord -- ^ Must style a word
                   | DrawGlue -- ^ Must style a glue
                   deriving(Eq)                          
                  
-- | Style of text  (sentences and words)       
class Style a where
    -- ^ Modify the look of a sentence (sequence of words using the same style on a line)
    sentenceStyle :: a -- ^ The style
                  -> Maybe (Rectangle -> Draw b -> Draw ()) -- ^ Function receiving the bounding rectangle and the command for drawing the sentence
    sentenceStyle _ = Nothing
    -- ^ Modify the look of a word
    wordStyle :: a -- ^ The style
              -> Maybe (Rectangle -> StyleFunction -> Draw b -> Draw ()) -- ^ Word styling function
    wordStyle _ = Nothing
    textStyle :: a -> TextStyle
    -- | All styles used in a document must have different style codes
    styleCode :: a -> Int
    -- | A style may contain data changed from word to word
    updateStyle :: a -> a
    updateStyle = id
    
    -- | A style may change the height of words
    styleHeight :: a -> PDFFloat
    
    -- | A style may change the descent of lines
    styleDescent :: a -> PDFFloat
    styleHeight = getHeight . textFont . textStyle 
    styleDescent = getDescent . textFont . textStyle 
    
-- | Any sentence style
data AnyStyle = forall a. (Style a) => AnyStyle a

instance Style AnyStyle where
    sentenceStyle (AnyStyle a) = sentenceStyle a
    wordStyle (AnyStyle a) = wordStyle a
    textStyle (AnyStyle a) = textStyle a
    styleCode (AnyStyle a) = styleCode a
    updateStyle (AnyStyle a) = AnyStyle $ updateStyle a
    styleHeight (AnyStyle a) = styleHeight a
    styleDescent (AnyStyle a) = styleDescent a



-- | A box is an object with dimensions and used in the typesetting process
class Box a where
     -- | Box width
     boxWidth :: a -- ^ Box
              -> PDFFloat -- ^ Width of the box
              
     -- | Box height
     boxHeight :: a -> PDFFloat
     -- | Distance between box bottom and box baseline
     boxDescent :: a -> PDFFloat
     -- | Distance between box top and box baseline
     boxAscent :: a -> PDFFloat
     boxAscent a = boxHeight a - boxDescent a
     
instance Box BoxDimension where
    boxWidth (w,_,_) = w
    boxHeight (_,h,_) = h
    boxDescent (_,_,d) = d

-- | A box that can be displayed
class DisplayableBox a where
     -- | Draw a box
     strokeBox :: a -- ^ The box
               -> PDFFloat -- ^ Horizontal position
               -> PDFFloat -- ^ Vertical position (top of the box and NOT baseline)
               -> Draw ()

data NullChar = NullChar deriving(Show)
data Overfull = Overfull AnyStyle

instance Box NullChar where
    boxWidth _  = 0
    boxHeight _ = 0
    boxDescent _ = 0
    
instance DisplayableBox NullChar where
    strokeBox _ _ _ = return ()
    
instance Box Overfull where
    boxWidth _  = 0
    boxHeight (Overfull s) = getHeight (textFont . textStyle $ s)
    boxDescent (Overfull s) = getDescent (textFont . textStyle $ s)
    
instance DisplayableBox Overfull where
    strokeBox a x y  = do
        stroke $ Line (x+2) (y - boxDescent a) (x+2) (y - boxDescent a + boxHeight a)
    
instance Box AnyBox where
    boxWidth (AnyBox a)  = boxWidth a
    boxHeight (AnyBox a) = boxHeight a
    boxDescent (AnyBox a) = boxDescent a

instance DisplayableBox AnyBox where
    strokeBox (AnyBox a)  = strokeBox a
  
instance Show AnyBox where
    show (AnyBox a)  = show a
    
data AnyBox = forall a. (Show a,Box a, DisplayableBox a) => AnyBox a