HPDF 1.3 → 1.4
raw patch · 21 files changed
+545/−315 lines, 21 files
Files
- Graphics/PDF.hs +4/−3
- Graphics/PDF/Coordinates.hs +86/−41
- Graphics/PDF/Document.hs +3/−2
- Graphics/PDF/Draw.hs +136/−73
- Graphics/PDF/Image.hs +0/−1
- Graphics/PDF/LowLevel/Serializer.hs +14/−4
- Graphics/PDF/LowLevel/Types.hs +22/−17
- Graphics/PDF/Pages.hs +1/−1
- Graphics/PDF/Resources.hs +2/−2
- Graphics/PDF/Shapes.hs +91/−89
- Graphics/PDF/Text.hs +19/−4
- Graphics/PDF/Typesetting.hs +47/−1
- Graphics/PDF/Typesetting/Box.hs +1/−1
- Graphics/PDF/Typesetting/Breaking.hs +8/−2
- Graphics/PDF/Typesetting/Horizontal.hs +4/−3
- Graphics/PDF/Typesetting/Layout.hs +4/−3
- HPDF.cabal +3/−2
- NEWS.txt +13/−5
- Test/Makefile +1/−1
- Test/Penrose.hs +12/−11
- Test/test.hs +74/−49
Graphics/PDF.hs view
@@ -17,7 +17,7 @@ , runPdf -- ** PDF Common Types , PDFRect(..)- , PDFFloat(..)+ , PDFFloat , PDFReference , PDFString , PDFPage@@ -30,6 +30,7 @@ , module Graphics.PDF.Colors -- ** Geometry , module Graphics.PDF.Coordinates+ , applyMatrix -- ** Text , module Graphics.PDF.Text -- ** Navigation@@ -161,8 +162,8 @@ -- | The PDFTrailer #ifndef __HADDOCK__ data PDFTrailer = PDFTrailer - !Int -- ^ Number of PDF objects in the document- !(PDFReference PDFCatalog) -- ^ Reference to the PDf catalog+ !Int -- Number of PDF objects in the document+ !(PDFReference PDFCatalog) -- Reference to the PDf catalog !(PDFDocumentInfo) #else data PDFTrailer
Graphics/PDF/Coordinates.hs view
@@ -10,68 +10,113 @@ -- Coordinates for a PDF document --------------------------------------------------------- -module Graphics.PDF.Coordinates(+module Graphics.PDF.Coordinates+ ( module Data.Complex -- * Geometry -- ** Types- Angle(..)+ , Angle(..)+ , Point , Matrix(..) -- ** Transformations- , rotate, translate, scale, identity- -- ** Frame of reference operators- , applyMatrix+ , toRadian+ , dot, scalePt+ , project, projectX, projectY+ , pointMatrix+ , transform+ , identity, rotate, translate, scale, spiral ) where -import Graphics.PDF.LowLevel.Types-import Graphics.PDF.Draw-import Control.Monad.Writer--import Graphics.PDF.LowLevel.Serializer-import Data.Monoid+import Data.Complex+import Graphics.PDF.LowLevel.Types(PDFFloat) -- | Angle -data Angle = Degree PDFFloat -- ^ Angle in degrees- | Radian PDFFloat -- ^ Angle in radians+data Angle = Degree !PDFFloat -- ^ Angle in degrees+ | Radian !PDFFloat -- ^ Angle in radians +toRadian :: Angle -> PDFFloat+toRadian (Degree x) = (pi / 180) * x+toRadian (Radian x) = x +type Point = Complex PDFFloat +-- | Dot product of two points+-- 'dot (x :+ y) (a :+ b) == x * a + y * b'+-- 'dot z w == magnitude z * magnitude w * cos (phase z - phase w)'+dot :: (RealFloat t) => Complex t -> Complex t -> t+dot (x0 :+ y0) (x1 :+ y1) = x0 * x1 + y0 * y1 +scalePt :: (RealFloat t) => t -> Complex t -> Complex t+scalePt a (x :+ y) = a*x :+ a*y +-- | projects the first point onto the second+project :: (RealFloat t) => Complex t -> Complex t -> Complex t+project z w = scalePt (dot z w / dot w w) w --- | Apply a transformation matrix to the current coordinate frame-applyMatrix :: Matrix -> Draw ()-applyMatrix m@(Matrix a b c d e f) = do- multiplyCurrentMatrixWith m- tell . mconcat $[ serialize '\n'- , toPDF a- , serialize ' '- , toPDF b- , serialize ' '- , toPDF c- , serialize ' '- , toPDF d- , serialize ' '- , toPDF e- , serialize ' '- , toPDF f- , serialize " cm"- ]+-- | projects a point onto the x-axis+projectX :: (RealFloat t) => Complex t -> Complex t+projectX (x :+ _) = (x :+ 0)++-- | projects a point onto the y-axis+projectY :: (RealFloat t) => Complex t -> Complex t+projectY (_ :+ y) = (0 :+ y)++-- | A transformation matrix. An affine transformation a b c d e f+--+-- @+-- a b 0+-- c d 0+-- e f 1+-- @+ +data Matrix = Matrix !PDFFloat !PDFFloat !PDFFloat !PDFFloat !PDFFloat !PDFFloat deriving (Eq, Show)+ +instance Num Matrix where+ -- Matrix addition+ (+) (Matrix ma mb mc md me mf ) (Matrix na nb nc nd ne nf) = + Matrix (ma+na) (mb+nb) (mc+nc) (md+nd) (me+ne) (mf+nf)+ (*) (Matrix ma mb mc md me mf) (Matrix na nb nc nd ne nf) = + Matrix (ma*na+mb*nc) (ma*nb+mb*nd) (mc*na+md*nc) (mc*nb +md*nd) (me*na+mf*nc+ne) (me*nb+mf*nd+nf)+ negate (Matrix ma mb mc md me mf ) =+ Matrix (-ma) (-mb) (-mc) (-md) (-me) (-mf)+ abs m = m+ signum _ = identity+ fromInteger i = Matrix r 0 0 r 0 0+ where+ r = fromInteger i++-- | Identity matrix+identity :: Matrix+identity = Matrix 1 0 0 1 0 0++-- | Specifies a matrix as three points+pointMatrix :: Point -- ^ X component+ -> Point -- ^ Y component+ -> Point -- ^ translation component+ -> Matrix+pointMatrix (x0 :+ y0) (x1 :+ y1) (x2 :+ y2) = Matrix x0 y0 x1 y1 x2 y2++-- | Applies a matrix to a point+transform :: Matrix -> Point -> Point+transform (Matrix x0 y0 x1 y1 x2 y2) (x :+ y) = (x*x0 + y*x1 + x2) :+ (x*y0 + y*y1 + y2)+ -- | Rotation matrix rotate :: Angle -- ^ Rotation angle -> Matrix-rotate r = Matrix ( (cos radian)) ( (sin radian)) (- ( (sin radian))) ( (cos radian)) 0 0- where- radian = case r of- Degree angle -> angle / 180 * pi- Radian angle -> angle-+rotate r = spiral (cis (toRadian r)) --- | Translation matrix -translate :: PDFFloat -- ^ Horizontal translation- -> PDFFloat -- ^ Vertical translation+-- | Translation matrix+-- 'transform (translate z) w == z + w' +translate :: Point -> Matrix-translate tx ty = Matrix 1 0 0 1 tx ty+translate (tx :+ ty) = Matrix 1 0 0 1 tx ty++-- | 'Spiral z' rotates by 'phase z' and scales by 'magnitude z'+-- 'transform (spiral z) w == z * w'+spiral :: Point + -> Matrix+spiral (x :+ y) = Matrix x y (-y) x 0 0 -- | Scaling matrix
Graphics/PDF/Document.hs view
@@ -35,7 +35,8 @@ -- * Draw monad and drawing functions -- ** Types , Draw- , PDFXObject(drawXObject,bounds)+ , PDFXObject(drawXObject)+ , PDFGlobals(..) -- ** General drawing functions , withNewContext , emptyDrawing@@ -131,6 +132,6 @@ Just (_,(oldState,oldW)) -> do -- Create a new cntent and update the stream myBounds <- gets xobjectBound- let (a,state',w') = runDrawing draw (emptyEnvironment {streamId = streamRef, xobjectb = myBounds}) oldState+ let (a,state',w') = runDrawing draw (emptyEnvironment {streamId = streamRef, xobjectBoundD = myBounds}) oldState modifyStrict $ \s -> s {streams = IM.insert streamRef (Just page,(state',mappend oldW w')) lStreams} return a
Graphics/PDF/Draw.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fglasgow-exts #-} --------------------------------------------------------- -- | -- Copyright : (c) alpha 2006@@ -12,11 +13,16 @@ -- #hide module Graphics.PDF.Draw( -- * Draw monad- Draw(..)+ Draw , PDFStream(..) , withNewContext , DrawState(..) , DrawEnvironment(..)+ , readDrawST + , writeDrawST + , modifyDrawST + , DrawTuple()+ , penPosition , supplyName , emptyDrawing -- , writeCmd@@ -27,7 +33,6 @@ , PDFXObject(..) , AnyPdfXForm , pdfDictMember- , getBound -- PDF types , PDF(..) , PDFPage(..)@@ -65,54 +70,31 @@ , emptyDrawState , Matrix(..) , identity+ , applyMatrix , currentMatrix , multiplyCurrentMatrixWith+ , PDFGlobals(..) ) where -import Graphics.PDF.LowLevel.Types-import Control.Monad.RWS-import Control.Monad.Writer-import Control.Monad.Reader-import Control.Monad.State+import Data.Maybe+import Data.Monoid+ import qualified Data.Map as M-import Graphics.PDF.Resources import qualified Data.IntMap as IM-import Graphics.PDF.Data.PDFTree(PDFTree)-import Data.Maybe import qualified Data.Binary.Builder as BU-import Graphics.PDF.LowLevel.Serializer-import Data.Monoid --- | A transformation matrix. An affine transformation a b c d e f------ @--- a b 0--- c d 0--- e f 1--- @- -data Matrix = Matrix !PDFFloat !PDFFloat !PDFFloat !PDFFloat !PDFFloat !PDFFloat deriving (Eq)- --- | Identity matrix-identity :: Matrix-identity = Matrix 1.0 0 0 1.0 0 0+import Control.Monad.ST+import Data.STRef -instance Show Matrix where- show (Matrix ma mb mc md me mf) = "Matrix " ++ (unwords [(show ma),(show mb),(show mc),(show md),(show me),(show mf)])+import Control.Monad.Writer.Class+import Control.Monad.Reader.Class+import Control.Monad.State -instance Num Matrix where- -- Matrix addition- (+) (Matrix ma mb mc md me mf ) (Matrix na nb nc nd ne nf) = - Matrix (ma+na) (mb+nb) (mc+nc) (md+nd) (me+ne) (mf+nf)- (*) (Matrix ma mb mc md me mf) (Matrix na nb nc nd ne nf) = - Matrix (ma*na+mb*nc) (ma*nb+mb*nd) (mc*na+md*nc) (mc*nb +md*nd) (me*na+mf*nc+ne) (me*nb+mf*nd+nf)- negate (Matrix ma mb mc md me mf ) =- Matrix (-ma) (-mb) (-mc) (-md) (-me) (-mf)- abs m = m- signum _ = identity- fromInteger i = Matrix r 0 0 r 0 0- where- r = fromInteger i+import Graphics.PDF.Coordinates+import Graphics.PDF.LowLevel.Types+import Graphics.PDF.LowLevel.Serializer+import Graphics.PDF.Resources+import Graphics.PDF.Data.PDFTree(PDFTree) data AnnotationStyle = AnnotationStyle !(Maybe Color) @@ -159,28 +141,66 @@ } data DrawEnvironment = DrawEnvironment { streamId :: Int- , xobjectb :: IM.IntMap (PDFFloat,PDFFloat)+ , xobjectBoundD :: IM.IntMap (PDFFloat,PDFFloat) } ++data DrawTuple s+ = DrawTuple { drawEnvironment :: DrawEnvironment+ , drawStateRef :: STRef s DrawState+ , builderRef :: STRef s BU.Builder+ , penPosition :: STRef s Point+ } emptyEnvironment :: DrawEnvironment emptyEnvironment = DrawEnvironment 0 IM.empty++class PDFGlobals m where+ bounds :: PDFXObject a => PDFReference a -> m (PDFFloat,PDFFloat) +-- | The drawing monad+newtype Draw a = Draw {unDraw :: forall s. DrawTuple s -> ST s a } +instance Monad Draw where+ m >>= f = Draw $ \env -> do+ a <- unDraw m env+ unDraw (f a) env+ return x = Draw $ \_env -> return x --- | The drawing monad-newtype Draw a = Draw {unDraw :: RWS DrawEnvironment BU.Builder DrawState a} -#ifndef __HADDOCK__- deriving(Monad,MonadWriter BU.Builder, MonadReader DrawEnvironment, MonadState DrawState, Functor)-#else-instance Monad Draw-instance MonadWriter BU.Builder Draw-instance MonadReader DrawEnvironment Draw-instance MonadState DrawState Draw-instance Functor Draw-#endif+instance MonadReader DrawEnvironment Draw where+ ask = Draw $ \env -> return (drawEnvironment env)+ local f m = Draw $ \env -> let drawenv' = f (drawEnvironment env)+ env' = env { drawEnvironment = drawenv' }+ in unDraw m env' +instance MonadState DrawState Draw where+ get = Draw $ \env -> readSTRef (drawStateRef env)+ put st = Draw $ \env -> writeSTRef (drawStateRef env) st++instance MonadWriter BU.Builder Draw where+ tell bu = Draw $ \env -> modifySTRef (builderRef env) (`mappend` bu)+ listen m = Draw $ \env -> do+ a <- unDraw m env+ w <- readSTRef (builderRef env)+ return (a,w)+ pass m = Draw $ \env -> do+ (a, f) <- unDraw m env+ modifySTRef (builderRef env) f+ return a++instance Functor Draw where+ fmap f = \m -> do { a <- m; return (f a) }+ instance MonadPath Draw +readDrawST :: (forall s. DrawTuple s -> STRef s a) -> Draw a+readDrawST f = Draw $ \env -> readSTRef (f env) ++writeDrawST :: (forall s. DrawTuple s -> STRef s a) -> a -> Draw ()+writeDrawST f x = Draw $ \env -> writeSTRef (f env) x ++modifyDrawST :: (forall s. DrawTuple s -> STRef s a) -> (a -> a) -> Draw ()+modifyDrawST f g = Draw $ \env -> modifySTRef (f env) g+ -- | A PDF stream object data PDFStream = PDFStream !BU.Builder !Bool !(PDFReference PDFLength) !PDFDictionary @@ -220,7 +240,20 @@ -- | Execute the drawing commands to get a new state and an uncompressed PDF stream runDrawing :: Draw a -> DrawEnvironment -> DrawState -> (a,DrawState,BU.Builder)-runDrawing drawing environment state = (runRWS . unDraw $ drawing) environment state +runDrawing drawing environment state + = runST $ do+ dRef <- newSTRef state+ bRef <- newSTRef mempty+ posRef <- newSTRef 0+ let tuple = DrawTuple { drawEnvironment = environment+ , drawStateRef = dRef+ , builderRef = bRef+ , penPosition = posRef+ } + a <- unDraw drawing tuple+ drawSt <- readSTRef (drawStateRef tuple)+ builder <- readSTRef (builderRef tuple)+ return (a, drawSt, builder) pushMatrixStack :: Matrix -> Draw () pushMatrixStack m = do@@ -262,10 +295,15 @@ return (newName,M.insert values newName oldCache) Just n -> return (n,oldCache) +instance PDFGlobals Draw where+ bounds (PDFReference r) = getBoundInDraw r+ +instance PDFGlobals PDF where+ bounds (PDFReference r) = getBoundInPDF r+ -- | A PDF Xobject which can be drawn class PDFXObject a where drawXObject :: PDFReference a -> Draw ()- bounds :: PDFReference a -> Draw (PDFFloat,PDFFloat) privateDrawXObject :: PDFReference a -> Draw () privateDrawXObject (PDFReference r) = do@@ -278,8 +316,6 @@ ] drawXObject = privateDrawXObject - bounds (PDFReference r) = getBound r- -- | An XObject data AnyPdfXForm = forall a. (PDFXObject a,PdfObject a) => AnyPdfXForm a instance PdfObject AnyPdfXForm where@@ -299,12 +335,19 @@ -- | Get the bounds for an xobject-getBound :: Int -- ^ Reference+getBoundInDraw :: Int -- ^ Reference -> Draw (PDFFloat,PDFFloat) -getBound ref = do- theBounds <- asks xobjectb+getBoundInDraw ref = do+ theBounds <- asks xobjectBoundD return $ IM.findWithDefault (0.0,0.0) ref theBounds- + +-- | Get the bounds for an xobject+getBoundInPDF :: Int -- ^ Reference+ -> PDF (PDFFloat,PDFFloat) +getBoundInPDF ref = do+ theBounds <- gets xobjectBound+ return $ IM.findWithDefault (0.0,0.0) ref theBounds+ ----------- -- -- PDF types@@ -336,13 +379,13 @@ -- | A PDF Page object #ifndef __HADDOCK__ data PDFPage = PDFPage - !(Maybe (PDFReference PDFPages)) -- ^ Reference to parent- !PDFRect -- ^ Media box- !(PDFReference PDFStream) -- ^ Reference to content- !(Maybe (PDFReference PDFResource)) -- ^ Reference to resources- !(Maybe PDFFloat) -- ^ Optional duration- !(Maybe PDFTransition) -- ^ Optional transition- ![AnyPdfObject] -- ^ Annotation array+ !(Maybe (PDFReference PDFPages)) -- Reference to parent+ !(PDFRect) -- Media box+ !(PDFReference PDFStream) -- Reference to content+ !(Maybe (PDFReference PDFResource)) -- Reference to resources+ !(Maybe PDFFloat) -- Optional duration+ !(Maybe PDFTransition) -- Optional transition+ ![AnyPdfObject] -- Annotation array #else data PDFPage #endif@@ -357,7 +400,7 @@ #ifndef __HADDOCK__ data PDFPages = PDFPages !Int- !(Maybe (PDFReference PDFPages)) -- ^ Reference to parent + !(Maybe (PDFReference PDFPages)) -- Reference to parent [Either (PDFReference PDFPages) (PDFReference PDFPage)] #else data PDFPages@@ -606,9 +649,9 @@ ] instance PdfObject Color where- toPDF (Rgb r g b) = toPDF . map (AnyPdfObject . PDFFloat) $ [r,g,b] + toPDF (Rgb r g b) = toPDF . map AnyPdfObject $ [r,g,b] toPDF (Hsv h s v) = let (r,g,b) = hsvToRgb (h,s,v)- in toPDF . map (AnyPdfObject . PDFFloat) $ [r,g,b]+ in toPDF . map AnyPdfObject $ [r,g,b] -- Degree for a transition direction floatDirection :: PDFTransDirection2 -> PDFFloat@@ -636,14 +679,14 @@ _ -> error "Hue value incorrect" getRgbColor :: Color -> (PDFFloat,PDFFloat,PDFFloat) -getRgbColor (Rgb r g b) = (PDFFloat r,PDFFloat g,PDFFloat b) -getRgbColor (Hsv h s v) = let (r,g,b) = hsvToRgb (h,s,v) in (PDFFloat r,PDFFloat g,PDFFloat b) +getRgbColor (Rgb r g b) = (r, g, b) +getRgbColor (Hsv h s v) = let (r,g,b) = hsvToRgb (h,s,v) in (r, g, b) -- | Interpolation function interpole :: Int -> PDFFloat -> PDFFloat -> AnyPdfObject interpole n x y = AnyPdfObject . PDFDictionary . M.fromList $ [ (PDFName "FunctionType", AnyPdfObject . PDFInteger $ 2)- , (PDFName "Domain", AnyPdfObject . map AnyPdfObject $ [PDFFloat 0,PDFFloat 1])+ , (PDFName "Domain", AnyPdfObject . map AnyPdfObject $ ([0,1] :: [PDFFloat])) , (PDFName "C0", AnyPdfObject . map AnyPdfObject $ [x]) , (PDFName "C1", AnyPdfObject . map AnyPdfObject $ [y]) , (PDFName "N", AnyPdfObject . PDFInteger $ n)@@ -673,3 +716,23 @@ where (ra,ga,ba) = getRgbColor ca (rb,gb,bb) = getRgbColor cb+++-- | Apply a transformation matrix to the current coordinate frame+applyMatrix :: Matrix -> Draw ()+applyMatrix m@(Matrix a b c d e f) = do+ multiplyCurrentMatrixWith m+ tell . mconcat $[ serialize '\n'+ , toPDF a+ , serialize ' '+ , toPDF b+ , serialize ' '+ , toPDF c+ , serialize ' '+ , toPDF d+ , serialize ' '+ , toPDF e+ , serialize ' '+ , toPDF f+ , serialize " cm"+ ]
Graphics/PDF/Image.hs view
@@ -306,7 +306,6 @@ drawXObject a = withNewContext $ do (width,height) <- bounds a applyMatrix (scale width height)- applyMatrix (translate 0 0) privateDrawXObject a instance PdfObject PDFJpeg where
Graphics/PDF/LowLevel/Serializer.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-cse #-} --------------------------------------------------------- -- | -- Copyright : (c) alpha 2006@@ -27,6 +28,7 @@ import Data.ByteString.Base import qualified Data.ByteString.Base as L(LazyByteString(..)) #endif+import System.IO.Unsafe foreign import ccall "conversion.h c_floatToString" cfloatToString :: Double -> Ptr Word8 -> IO Int foreign import ccall "conversion.h c_shortToString" cshortToString :: Int -> Ptr Word8 -> IO Int@@ -52,18 +54,26 @@ instance SerializeValue B.ByteString B.ByteString where serialize = id +convertShort :: Int -> ByteString +convertShort a = unsafePerformIO (createAndTrim 12 (cshortToString a))+{-# NOINLINE convertShort #-}++convertFloat :: Double -> ByteString +convertFloat a = unsafePerformIO (createAndTrim 12 (cfloatToString a))+{-# NOINLINE convertFloat #-}+ #if __GLASGOW_HASKELL__ >= 608 instance SerializeValue B.ByteString Int where- serialize a = L.Chunk (inlinePerformIO (createAndTrim 12 (cshortToString a))) L.Empty+ serialize a = L.Chunk (convertShort a) L.Empty instance SerializeValue B.ByteString Double where- serialize a = L.Chunk (inlinePerformIO (createAndTrim 12 (cfloatToString a))) L.Empty+ serialize a = L.Chunk (convertFloat a) L.Empty #else instance SerializeValue L.LazyByteString Int where- serialize a = L.LPS [inlinePerformIO (createAndTrim 12 (cshortToString a))]+ serialize a = L.LPS [convertShort a] instance SerializeValue L.LazyByteString Double where- serialize a = L.LPS [inlinePerformIO (createAndTrim 12 (cfloatToString a))] + serialize a = L.LPS [convertFloat a] #endif instance SerializeValue BU.Builder Word8 where
Graphics/PDF/LowLevel/Types.hs view
@@ -15,14 +15,13 @@ import qualified Data.Map as M import Data.List(intersperse) import Data.Int-import Text.Printf import Control.Monad.State import Control.Monad.Writer import Data.Word-import System.Random import Data.Binary.Builder(Builder,fromByteString) import Graphics.PDF.LowLevel.Serializer import Data.Monoid+import Data.Complex import qualified Data.ByteString as S #if __GLASGOW_HASKELL__ >= 608 import qualified Data.ByteString.Lazy.Internal as L(ByteString(..))@@ -55,10 +54,7 @@ fromInteger a = PDFLength (fromInteger a) -- | A real number in a PDF document-newtype PDFFloat = PDFFloat Double deriving(Eq,Ord,Num,Fractional,Floating,RealFrac,Real,Random)--instance Show PDFFloat where- show (PDFFloat x) = printf "%.5f" x+type PDFFloat = Double instance PdfObject PDFInteger where toPDF (PDFInteger a) = serialize a@@ -70,10 +66,13 @@ toPDF (PDFLength a) = serialize (show a) instance PdfObject PDFFloat where- toPDF (PDFFloat a) = serialize a- -instance PdfObject Double where toPDF a = serialize a++instance PdfObject (Complex PDFFloat) where+ toPDF (x :+ y) = mconcat [ serialize x+ , serialize ' '+ , serialize y+ ] instance PdfObject Bool where toPDF (True) = serialize "true"@@ -84,7 +83,7 @@ -- | Create a PDF string from an Haskell one toPDFString :: String -> PDFString-toPDFString = PDFString . S.pack . map encodeISO88591 . escapeString+toPDFString = PDFString . S.pack . map encodeISO88591 -- . escapeString encodeISO88591 :: Char -> Word8 encodeISO88591 a = @@ -103,13 +102,19 @@ serialize (PDFString t) = fromByteString t -- | Escape PDF characters which have a special meaning-escapeString :: String -> String-escapeString [] = []-escapeString ('(':l) = '\\':'(':escapeString l-escapeString (')':l) = '\\':')':escapeString l-escapeString ('\\':l) = '\\':'\\':escapeString l-escapeString (a:l) = a:escapeString l+escapeString :: PDFString -> PDFString+escapeString (PDFString t) = PDFString . S.pack . escapeOnWords8 . S.unpack $ t +pc2w :: Char -> Word8+pc2w = fromIntegral . fromEnum++escapeOnWords8 :: [Word8] -> [Word8]+escapeOnWords8 [] = []+escapeOnWords8 (a:l) | a == pc2w '(' = (pc2w '\\'):(pc2w '('):escapeOnWords8 l+ | a == pc2w ')' = (pc2w '\\'):(pc2w ')'):escapeOnWords8 l+ | a == pc2w '\\' = (pc2w '\\'):(pc2w '\\'):escapeOnWords8 l+ | otherwise = a:escapeOnWords8 l+ -- Misc strings useful to build bytestrings lparen :: SerializeValue s Char => s@@ -141,7 +146,7 @@ instance PdfObject PDFString where toPDF a = mconcat [ lparen- , serialize a+ , serialize . escapeString $ a , rparen ]
Graphics/PDF/Pages.hs view
@@ -79,7 +79,7 @@ -- Create a new stream referenbce streamref <- supply myBounds <- gets xobjectBound- let (_,state',w') = runDrawing d (emptyEnvironment {streamId = streamref, xobjectb = myBounds}) (emptyDrawState streamref)+ let (_,state',w') = runDrawing d (emptyEnvironment {streamId = streamref, xobjectBoundD = myBounds}) (emptyDrawState streamref) modifyStrict $ \s -> s {streams = IM.insert streamref (page,(state',w')) (streams s)} return (PDFReference streamref)
Graphics/PDF/Resources.hs view
@@ -78,11 +78,11 @@ newtype StrokeAlpha = StrokeAlpha Double deriving(Eq,Ord) instance PdfResourceObject StrokeAlpha where- toRsrc (StrokeAlpha a) = AnyPdfObject . PDFDictionary . M.fromList $ [(PDFName "CA",AnyPdfObject . PDFFloat $ a)]+ toRsrc (StrokeAlpha a) = AnyPdfObject . PDFDictionary . M.fromList $ [(PDFName "CA",AnyPdfObject a)] newtype FillAlpha = FillAlpha Double deriving(Eq,Ord) instance PdfResourceObject FillAlpha where- toRsrc (FillAlpha a) = AnyPdfObject . PDFDictionary . M.fromList $ [(PDFName "ca",AnyPdfObject . PDFFloat $ a)]+ toRsrc (FillAlpha a) = AnyPdfObject . PDFDictionary . M.fromList $ [(PDFName "ca",AnyPdfObject a)] class PdfResourceObject a where toRsrc :: a -> AnyPdfObject
Graphics/PDF/Shapes.hs view
@@ -12,12 +12,11 @@ module Graphics.PDF.Shapes( -- * Shapes- -- ** Types- Point- -- ** Lines- , moveto- , lineto -- ** Paths+ moveto+ , lineto+ , arcto+ , curveto , beginPath , closePath , addBezierCubic@@ -52,6 +51,7 @@ ) where import Graphics.PDF.LowLevel.Types+import Graphics.PDF.Coordinates import Graphics.PDF.Draw import Control.Monad.Writer import Graphics.PDF.LowLevel.Serializer@@ -83,19 +83,21 @@ data Line = Line PDFFloat PDFFloat PDFFloat PDFFloat deriving(Eq) instance Shape Line where addShape (Line x0 y0 x1 y1)= do- moveto x0 y0- lineto x1 y1+ moveto (x0 :+ y0)+ lineto (x1 :+ y1) fill _ = error "Can't fill a line !" fillAndStroke _ = error "Can't fill a line !" fillEO _ = error "Can't fill a line !" fillAndStrokeEO _ = error "Can't fill a line !" -data Rectangle = Rectangle PDFFloat PDFFloat PDFFloat PDFFloat deriving(Eq)+data Rectangle = Rectangle !Point !Point deriving (Eq) instance Shape Rectangle where- addShape (Rectangle x0 y0 x1 y1) = do- let poly = [(x0,y0),(x1,y0),(x1,y1),(x0,y1)]- addPolygonToPath poly- closePath+ addShape (Rectangle a b) + = tell . mconcat $ [ serialize '\n'+ , toPDF a+ , serialize ' '+ , toPDF (b - a)+ , serialize " re" ] data Arc = Arc PDFFloat PDFFloat PDFFloat PDFFloat deriving(Eq) instance Shape Arc where@@ -103,8 +105,8 @@ let height = y1 - y0 width = x1 - x0 kappa = 0.5522847498- beginPath x0 y0- addBezierCubic (x0+width*kappa) y0 x1 (y1-height*kappa) x1 y1+ beginPath (x0 :+ y0)+ addBezierCubic ((x0+width*kappa) :+ y0) (x1 :+ (y1-height*kappa)) (x1 :+ y1) data Ellipse = Ellipse PDFFloat PDFFloat PDFFloat PDFFloat deriving(Eq) instance Shape Ellipse where@@ -115,11 +117,11 @@ h = k*(abs (y1 - y0)/2.0) w = k*(abs (x1 - x0)/2.0) - beginPath xm y0- addBezierCubic (xm + w) y0 x1 (ym - h) x1 ym- addBezierCubic x1 (ym + h) (xm + w) y1 xm y1- addBezierCubic (xm - w) y1 x0 (ym + h) x0 ym- addBezierCubic x0 (ym - h) (xm - w) y0 xm y0+ beginPath (xm :+ y0)+ addBezierCubic ((xm + w) :+ y0) (x1 :+ (ym - h)) (x1 :+ ym)+ addBezierCubic (x1 :+ (ym + h)) ((xm + w) :+ y1) (xm :+ y1)+ addBezierCubic ((xm - w) :+ y1) (x0 :+ (ym + h)) (x0 :+ ym)+ addBezierCubic (x0 :+ (ym - h)) ((xm - w) :+ y0) (xm :+ y0) data RoundRectangle = RoundRectangle PDFFloat PDFFloat PDFFloat PDFFloat PDFFloat PDFFloat deriving(Eq) instance Shape RoundRectangle where@@ -128,16 +130,16 @@ h = k*rw w = k*rh - beginPath (x0+rw) y0- addLineToPath (x1-rw) y0- addBezierCubic ((x1-rw) + w) y0 x1 (y0+rh - h) x1 (y0+rh)- addLineToPath x1 (y1-rh)- addBezierCubic x1 ((y1-rh) + h) (x1-rw + w) y1 (x1-rw) y1- addLineToPath (x0+rw) y1- addBezierCubic (x0 + rw - w) y1 x0 (y1-rh + h) x0 (y1-rh)- addLineToPath x0 (y0+rh)- addBezierCubic x0 (y0 + rh - h) (x0 + rw - w) y0 (x0 + rw) y0- addLineToPath (x1-rw) y0+ beginPath ((x0+rw) :+ y0)+ addLineToPath ((x1-rw) :+ y0)+ addBezierCubic ((x1-rw + w) :+ y0) (x1 :+ (y0+rh - h)) (x1 :+ (y0+rh))+ addLineToPath (x1 :+ (y1-rh))+ addBezierCubic (x1 :+ (y1-rh + h)) ((x1-rw + w) :+ y1) ((x1-rw) :+ y1)+ addLineToPath ((x0+rw) :+ y1)+ addBezierCubic ((x0+rw - w) :+ y1) (x0 :+ (y1-rh + h)) (x0 :+ (y1-rh))+ addLineToPath (x0 :+ (y0+rh))+ addBezierCubic (x0 :+ (y0+rh - h)) ((x0+rw - w) :+ y0) ((x0+rw) :+ y0)+ addLineToPath ((x1-rw) :+ y0) data Circle = Circle PDFFloat PDFFloat PDFFloat deriving(Eq) instance Shape Circle where@@ -169,7 +171,7 @@ deriving(Eq,Enum) -- | Line join styles-data JoinStyle = MilterJoin+data JoinStyle = MiterJoin | RoundJoin | BevelJoin deriving(Eq,Enum)@@ -204,9 +206,8 @@ setNoDash :: MonadPath m => m () setNoDash = setDash (DashPattern [] 0) --- | Begin a new path at position x y-beginPath :: PDFFloat -- ^ Horizontal coordinate- -> PDFFloat -- ^ Vertical coordinate+-- | Begin a new path at a position+beginPath :: Point -> Draw () beginPath = moveto @@ -216,77 +217,78 @@ -- | Append a cubic Bezier curve to the current path. The curve extends --- from the current point to the point (x3 , y3 ), using (x1 , y1 ) and +-- from the current point to the point (x3 , y3), using (x1 , y1 ) and -- (x2, y2) as the Bezier control points-addBezierCubic :: PDFFloat -- ^ x1- -> PDFFloat -- ^ y1- -> PDFFloat -- ^ x2 - -> PDFFloat -- ^ y2 - -> PDFFloat -- ^ x3 - -> PDFFloat -- ^ y3+addBezierCubic :: Point+ -> Point+ -> Point -> Draw ()-addBezierCubic x1 y1 x2 y2 x3 y3 = - tell . mconcat $[ serialize "\n" - , toPDF x1- , serialize ' '- , toPDF y1- , serialize ' '- , toPDF x2- , serialize ' '- , toPDF y2- , serialize ' '- , toPDF x3- , serialize ' '- , toPDF y3- , serialize " c"- ]+addBezierCubic b c d = do+ tell . mconcat $ [ serialize "\n" + , toPDF b+ , serialize ' '+ , toPDF c+ , serialize ' '+ , toPDF d+ , serialize " c"+ ]+ writeDrawST penPosition d -- | Move pen to a given point without drawing anything-moveto :: PDFFloat -- ^ Horizontal coordinate- -> PDFFloat -- ^ Vertical coordinate+moveto :: Point -> Draw ()-moveto x y = - tell . mconcat $[ serialize "\n" - , toPDF x- , serialize ' '- , toPDF y- , serialize " m"- ]+moveto a = do + tell . mconcat $ [ serialize "\n" + , toPDF a+ , serialize " m"+ ]+ writeDrawST penPosition a -- | Draw a line from current point to the one specified by lineto-lineto :: PDFFloat -- ^ Horizontal coordinate - -> PDFFloat -- ^ Vertical coordinate- -> Draw ()-lineto x y = - tell . mconcat $[ serialize "\n" - , toPDF x- , serialize ' '- , toPDF y- , serialize " l s"- ]- --- | Add a line from current point to the one specified by lineto-addLineToPath :: PDFFloat -- ^ Horizontal coordinate - -> PDFFloat -- ^ Vertical coordinate- -> Draw ()-addLineToPath x y = +lineto :: Point + -> Draw () +lineto a = do tell . mconcat $[ serialize "\n" - , toPDF x- , serialize ' '- , toPDF y+ , toPDF a , serialize " l" ]- + writeDrawST penPosition a --- | A point-type Point = (PDFFloat,PDFFloat)+curveto :: Point -> Point -> Point -> Draw ()+curveto = addBezierCubic +-- | Approximate a circular arc by one cubic bezier curve.+-- larger arc angles mean larger distortions+arcto :: Angle -- ^ Extent of arc+ -> Point -- ^ Center of arc+ -> Draw ()+arcto extent + = let theta = toRadian extent+ kappa = 4 / 3 * tan (theta / 4)+ cis_theta = cis theta+ rot90 (x :+ y) = ((-y) :+ x)+ in if theta == 0+ then \_center -> return ()+ else \center -> do+ a <- readDrawST penPosition+ let delta = a - center+ delta' = scalePt kappa (rot90 delta)+ d = center + delta * cis_theta+ c = d - delta' * cis_theta+ b = a + delta'+ curveto b c d++addLineToPath :: Point + -> Draw ()+addLineToPath = lineto+ -- | Add a polygon to current path addPolygonToPath :: [Point] -> Draw ()-addPolygonToPath l = do- (uncurry moveto) . head $ l- mapM_ (\(x,y) -> addLineToPath x y) (tail l) +addPolygonToPath [] = return ()+addPolygonToPath (l : ls) = do+ moveto l+ mapM_ addLineToPath ls -- | Draw current path strokePath :: Draw ()
Graphics/PDF/Text.hs view
@@ -126,19 +126,21 @@ , tl :: !PDFFloat , ts :: !PDFFloat , fontState :: FontState+ , currentFont :: PDFFont } defaultParameters :: TextParameter-defaultParameters = TextParameter 0 0 100 0 0 (Set.empty)+defaultParameters = TextParameter 0 0 100 0 0 (Set.empty) (PDFFont Times_Roman 12) -- | The text monad newtype PDFText a = PDFText {unText :: WriterT Builder (State TextParameter) a} #ifndef __HADDOCK__ - deriving(Monad,Functor,MonadWriter Builder)+ deriving(Monad,Functor,MonadWriter Builder,MonadState TextParameter) #else instance Monad PDFText instance Functor PDFText instance MonadWriter Builder PDFText+instance MonadState TextParameter PDFText #endif instance MonadPath PDFText@@ -159,8 +161,8 @@ -- | Select a font to use setFont :: PDFFont -> PDFText ()-setFont (PDFFont n size) = PDFText $ do- lift (modifyStrict $ \s -> s {fontState = Set.insert n (fontState s)})+setFont f@(PDFFont n size) = PDFText $ do+ lift (modifyStrict $ \s -> s {fontState = Set.insert n (fontState s), currentFont = f}) tell . mconcat$ [ serialize "\n/" , serialize (show n) , serialize ' '@@ -200,6 +202,19 @@ displayText t = do tell . toPDF $ t tell . serialize $ " Tj"+-- f <- gets currentFont+-- let rt = ripText f t+-- tell . serialize $ '\n'+-- tell lbracket+-- mapM_ displayGlyphs rt+-- tell rbracket+-- tell $ serialize " TJ"+-- where+-- displayGlyphs (w,c) = do+-- tell $ toPDF (toPDFString $ c:[])+-- tell bspace+-- tell . toPDF $ w+-- tell bspace -- | Start a new line (leading value must have been set)
Graphics/PDF/Typesetting.hs view
@@ -32,6 +32,7 @@ , VerState(..) , Container , Justification(..)+ , Orientation(..) -- * Functions -- ** Text display , displayFormattedText@@ -63,6 +64,7 @@ , containerContentLeftBorder , containerCurrentHeight , containerContentRectangle+ , drawTextBox -- * Settings (similar to TeX ones) -- ** Line breaking settings , setFirstPassTolerance @@ -92,6 +94,7 @@ import Graphics.PDF.Text import Graphics.PDF.Draw import Graphics.PDF.Shapes+import Graphics.PDF.Coordinates import Control.Monad.RWS import Graphics.PDF.Typesetting.Breaking import Graphics.PDF.Typesetting.Vertical@@ -109,7 +112,7 @@ -> s -- ^ Default horizontal style -> TM ps s a -- ^ Typesetting monad -> Draw a -- ^ Draw monad-displayFormattedText (Rectangle xa ya xb yb) defaultVStyle defaultHStyle t = +displayFormattedText (Rectangle (xa :+ ya) (xb :+ yb)) defaultVStyle defaultHStyle t = do --withNewContext $ do -- addShape $ Rectangle (xa-1) y' (xb+1) y''@@ -411,3 +414,46 @@ setJustification :: Justification -- ^ Centered, left or fully justified -> TM ps s () setJustification j = modifyStrict $ \s -> s {paraSettings = (paraSettings s){centered = j}}++-------------------------------+--+-- Tools to ease tech drawings+--+-------------------------------++data Orientation = E | W | N | S | NE | NW | SE | SW deriving(Eq,Show)++-- | Draw a text box with relative position. Useful for labels+drawTextBox :: (ParagraphStyle ps s, Style s) + => PDFFloat -- ^ x+ -> PDFFloat -- ^ y+ -> PDFFloat -- ^ width limit+ -> PDFFloat -- ^ height limit+ -> Orientation+ -> ps -- ^ default vertical style+ -> s -- ^ Default horizontal style+ -> TM ps s a -- ^ Typesetting monad+ -> (Rectangle,Draw ())+drawTextBox x y w h ori ps p t = + let b = getBoxes ps p t+ sh = styleHeight p+ c = mkContainer 0 0 w h sh+ (d,c',_) = fillContainer (defaultVerState ps) c b+ Rectangle (xa :+ ya) (xb :+ yb) = containerContentRectangle c'+ wc = xb - xa+ hc = yb - ya+ (dx,dy) = case ori of+ NE -> (x,y)+ NW -> (x - wc,y)+ SE -> (x,y + hc)+ SW -> (x - wc,y + hc)+ E -> (x,y + hc / 2.0)+ W -> (x - wc,y + hc / 2.0)+ N -> (x - wc/2.0,y)+ S -> (x - wc/2.0,y + hc)+ box = withNewContext $ do+ applyMatrix $ translate (dx :+ dy)+ d+ r = Rectangle ((xa + dx) :+ (ya + dy)) ((xb + dx) :+ (yb + dy))+ in+ (r,box)
Graphics/PDF/Typesetting/Box.hs view
@@ -44,7 +44,7 @@ instance DisplayableBox DrawBox where strokeBox (DrawBox a) x y = do withNewContext $ do- applyMatrix $ translate x y+ applyMatrix $ translate (x :+ y) a instance Show DrawBox where
Graphics/PDF/Typesetting/Breaking.hs view
@@ -558,10 +558,10 @@ normalW = ws * h in case (centered settings) of- FullJustification -> [Glue normalW (normalW*sy/2.0*f) (normalW*sz/3.0) (Just s)]+ FullJustification -> [Glue (normalW) (normalW*sy/2.0*f) (normalW*sz/3.0) (Just s)] Centered -> [ Glue 0 (centeredDilatationFactor*normalW) 0 (Just s) , Penalty 0- , Glue normalW (-2*centeredDilatationFactor*normalW) 0 (Just s)+ , Glue (normalW) (-2*centeredDilatationFactor*normalW) 0 (Just s) , Kern 0 (Just s) , Penalty infinity , Glue 0 (centeredDilatationFactor*normalW) 0 (Just s)@@ -618,6 +618,12 @@ -> [Letter s] -- ^ Boxes createLetterBoxes _ _ [] = [] createLetterBoxes settings s ((_,'/'):(w,'-'):l) = hyphenPenalty settings s w : createLetterBoxes settings s l+createLetterBoxes settings s ((w',','):(_,' '):l) = (createChar s w' ',') : ((spaceGlueBox settings s 2.0) ++ createLetterBoxes settings s l)+createLetterBoxes settings s ((w',';'):(_,' '):l) = (createChar s w' ';') : ((spaceGlueBox settings s 2.0) ++ createLetterBoxes settings s l)+createLetterBoxes settings s ((w','.'):(_,' '):l) = (createChar s w' '.') : ((spaceGlueBox settings s 2.0) ++ createLetterBoxes settings s l)+createLetterBoxes settings s ((w',':'):(_,' '):l) = (createChar s w' ':') : ((spaceGlueBox settings s 2.0) ++ createLetterBoxes settings s l)+createLetterBoxes settings s ((w','!'):(_,' '):l) = (createChar s w' '!') : ((spaceGlueBox settings s 2.0) ++ createLetterBoxes settings s l)+createLetterBoxes settings s ((w','?'):(_,' '):l) = (createChar s w' '?') : ((spaceGlueBox settings s 2.0) ++ createLetterBoxes settings s l) createLetterBoxes settings s ((_,' '):l) = (spaceGlueBox settings s 1.0) ++ createLetterBoxes settings s l createLetterBoxes settings s ((w,t):l) = (createChar s w t) : createLetterBoxes settings s l
Graphics/PDF/Typesetting/Horizontal.hs view
@@ -20,6 +20,7 @@ import Graphics.PDF.Typesetting.Breaking import Graphics.PDF.Shapes import Graphics.PDF.Draw+import Graphics.PDF.Coordinates import qualified Data.ByteString.Char8 as S(pack) import Data.Maybe(isJust,fromJust) import Data.List(foldl')@@ -209,7 +210,7 @@ w' = foldl' (\x' ny -> x' + boxWidth ny) 0.0 l' if (isJust . sentenceStyle $ style) then do- (fromJust . sentenceStyle $ style) (Rectangle x (y - hl) (x+w') (y)) (drawTextLine style l' x y')+ (fromJust . sentenceStyle $ style) (Rectangle (x :+ (y - hl)) ((x+w') :+ y)) (drawTextLine style l' x y') else do drawTextLine style l' x y' drawLineOfHboxes hl dl l'' (x + w') y@@ -311,7 +312,7 @@ -- otherwise we apply a different function to the sentence if (isJust . wordStyle $ style) then- (fromJust . wordStyle $ style) (Rectangle x (y' - de) (x+w) (y' - de + he)) DrawGlue (return ())+ (fromJust . wordStyle $ style) (Rectangle (x :+ (y' - de)) ((x+w) :+ (y' - de + he))) DrawGlue (return ()) else return () @@ -323,7 +324,7 @@ -- otherwise we apply a different function to the sentence if (isJust . wordStyle $ style) then- (fromJust . wordStyle $ style) (Rectangle x (y' - de) (x+w) (y' - de + he)) DrawWord (drawText $ drawTheTextBox OneBlock style x y' (Just t))+ (fromJust . wordStyle $ style) (Rectangle (x :+ (y' - de)) ((x+w) :+ (y' - de + he))) DrawWord (drawText $ drawTheTextBox OneBlock style x y' (Just t)) else drawText $ drawTheTextBox OneBlock style x y' (Just t)
Graphics/PDF/Typesetting/Layout.hs view
@@ -38,6 +38,7 @@ import Graphics.PDF.LowLevel.Types import Graphics.PDF.Typesetting.Breaking import Graphics.PDF.Draw+import Graphics.PDF.Coordinates import Graphics.PDF.Shapes(Rectangle(..)) import Graphics.PDF.Typesetting.Box import Data.List(foldl')@@ -108,7 +109,7 @@ 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+ (fromJust . interline $ style) $ Rectangle ((x+delta) :+ (y-h)) ((x+w+delta) :+ y) else return() strokeBox (VGlue _ _ _ _ _) _ _ = return ()@@ -176,7 +177,7 @@ -- | Return the rectangle containing the text after formatting and glue dilatation containerContentRectangle :: Container ps s -> Rectangle-containerContentRectangle c = Rectangle (x+l) (y-th) (x+r) y +containerContentRectangle c = Rectangle ((x+l) :+ (y-th)) ((x+r) :+ y) where x = containerX c y = containerY c@@ -319,7 +320,7 @@ 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')+ (fromJust . paragraphStyle $ style) (Rectangle (xleft :+ (y'- h')) (xright :+ y')) (recurseStrokeVBoxes 1 l' xa y') else recurseStrokeVBoxes 1 l' xa y' strokeVBoxes l'' xa (y' - h')
HPDF.cabal view
@@ -1,12 +1,13 @@ Name: HPDF-Version: 1.3+Version: 1.4 cabal-version: >=1.2 License: LGPL License-file:LICENSE-Copyright: Copyright (c) 2007, alpheccar+Copyright: Copyright (c) 2007-2008, alpheccar category: Graphics synopsis: Generation of PDF documents maintainer: misc@NOSPAMalpheccar.org+build-type: Simple tested-with: GHC==6.8.1 homepage: http://www.alpheccar.org description: A PDF library with support for several pages, page transitions, outlines, annotations, compression, colors, shapes, patterns, jpegs, fonts, typesetting ...
NEWS.txt view
@@ -1,6 +1,14 @@-WHAT'S NEW IN HPDF 1.3+WHAT'S NEW IN HPDF 1.4 ======================-1 - Can be built with ghc 6.8.1 and ghc 6.6 if you have the most recent Cabal and update a few libraries ;-2 - Bug corrections in the line breaking algorithm ;-3 - Automatic hyphenation algorithm (default Language is English). To add new language you have to use hyphenation patterns like in TeX.-Look at Graphics/PDF/Hyphenate.hs and Graphics/PDF/Hyphenate/English.hs+Lot's of contributions from Leon Smith ! Thank you. Here is a summary:++A - Changes by Leon+===================+1 - Huge speed improvement of the draw monad ;+2 - New implementation of shapes (Rectangle, curveto, arcto, point datatype) ;+3 - Cleaning of the API (coordinates, shapes) ;++B - Changes by alpheccar+=========================+1 - Lots of bug corrections for typesetting ;+2 - An API to draw text boxes
Test/Makefile view
@@ -5,7 +5,7 @@ ghc -o test -prof -auto-all -ffi -cpp -Wall -funbox-strict-fields -fglasgow-exts -O2 -hidir interfaces -odir bin -optc-I../c -i.. ../c/metrics.c ../c/conversion.c --make test.hs runprof:- ./test +RTS -p+ ./test +RTS -p -hc demo: ghc -o test -fglasgow-exts -O2 --make test.hs
Test/Penrose.hs view
@@ -23,7 +23,7 @@ tilea :: PDFFloat -> Tile -> Int -> Draw () tilea angle k n = withNewContext $ do- applyMatrix (translate width 0)+ applyMatrix (translate (width :+ 0)) applyMatrix (rotate . Degree $ angle) applyMatrix (scale (1/golden) (1/golden)) divide (n-1) k @@ -31,7 +31,7 @@ tileb :: PDFFloat -> Tile -> Int -> Draw () tileb angle k n = withNewContext $ do- applyMatrix (translate (width*golden) 0)+ applyMatrix (translate ((width*golden) :+ 0)) applyMatrix (rotate . Degree $ angle) applyMatrix (scale (1/golden) (1/golden)) divide (n-1) k@@ -66,9 +66,9 @@ setFillAlpha 0.8 fillColor myBlue strokeColor myBlue- let pol = [ (0,0)- , ((s*cos(phi)),(s*sin(phi)))- , ((s*golden),0)+ let pol = [ 0+ , mkPolar s phi + , ((s*golden) :+ 0) ] fillAndStroke (Polygon pol) strokeColor black @@ -86,9 +86,9 @@ setFillAlpha 0.8 fillColor myGreen strokeColor myGreen- let pol = [ (0,0)- , ((s*cos(phi)),(s*sin(phi)))- , (s,0)+ let pol = [ 0+ , mkPolar s phi+ , (s :+ 0) ] fillAndStroke (Polygon pol) strokeColor black @@ -104,10 +104,11 @@ page <- addPage (Just (PDFRect 0 0 (round (1.5*width)) (round width))) newSection (toPDFString "Penrose") Nothing Nothing $ do drawWithPage page $ do- applyMatrix (translate 20 5)+ applyMatrix (translate (20 :+ 5)) applyMatrix (rotate . Degree $ 36) - divide 4 B - divide 4 B'+ let r = 4+ divide r B + divide r B'
Test/test.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fglasgow-exts #-} --------------------------------------------------------- -- | -- Copyright : (c) alpha 2007@@ -31,13 +32,13 @@ strokeColor $ Rgb 1 0 0 stroke $ Line 10 200 612 200 fill $ Circle 10 200 10- stroke $ Rectangle 10 (200.0 - (getDescent f)) (10.0 + textWidth f t) (200.0 - getDescent f + getHeight f) + stroke $ Rectangle (10 :+ (200.0 - (getDescent f))) ((10.0 + textWidth f t) :+ (200.0 - getDescent f + getHeight f)) geometryTest :: Draw () geometryTest = do strokeColor red- stroke $ Rectangle 0 0 200 100+ stroke $ Rectangle 0 (200 :+ 100) fillColor blue fill $ Ellipse 100 100 300 200 fillAndStroke $ RoundRectangle 32 32 200 200 600 400@@ -52,7 +53,7 @@ shadingTest :: Draw () shadingTest = do- paintWithShading (RadialShading 0 0 50 0 0 600 (Rgb 1 0 0) (Rgb 0 0 1)) (addShape $ Rectangle 0 0 300 300)+ paintWithShading (RadialShading 0 0 50 0 0 600 (Rgb 1 0 0) (Rgb 0 0 1)) (addShape $ Rectangle 0 (300 :+ 300)) paintWithShading (AxialShading 300 300 600 400 (Rgb 1 0 0) (Rgb 0 0 1)) (addShape $ Ellipse 300 300 600 400) @@ -82,20 +83,20 @@ p1 <- addPage Nothing drawWithPage p1 $ do withNewContext $ do- applyMatrix $ translate 50 0+ applyMatrix $ translate (50 :+ 0) r p2 <- addPage Nothing drawWithPage p2 $ do strokeColor red stroke $ Line 0 0 100 0- applyMatrix $ translate 100 0+ applyMatrix $ translate (100 :+ 0) strokeColor green stroke $ Line 0 0 100 0 withNewContext $ do applyMatrix $ rotate (Degree (-20)) strokeColor $ Rgb 1 1 0 stroke $ Line 0 0 100 0- applyMatrix $ translate 50 50+ applyMatrix $ translate (50 :+ 50) strokeColor blue stroke $ Line 0 0 100 0 withNewContext $ do@@ -112,14 +113,14 @@ strokeColor red newAnnotation (URLLink (toPDFString "Go to my blog") [0,0,200,100] "http://www.alpheccar.org" True) drawText $ text (PDFFont Times_Roman 12) 10 30 (toPDFString "Go to my blog")- stroke $ Rectangle 0 0 200 100+ stroke $ Rectangle 0 (200 :+ 100) newAnnotation (TextAnnotation (toPDFString "Key annotation") [100,100,130,130] Key) textTest :: Draw () textTest = do strokeColor red fillColor blue- fontDebug (PDFFont Times_Roman 48) (toPDFString "This is a test (éèçàù)!")+ fontDebug (PDFFont Times_Roman 48) (toPDFString "This is a \\test (éèçàù)!") testImage :: JpegFile -> PDFReference PDFPage -> PDF ()@@ -131,7 +132,7 @@ drawXObject jpg withNewContext $ do applyMatrix $ rotate (Degree 20)- applyMatrix $ translate 200 200+ applyMatrix $ translate (200 :+ 200) applyMatrix $ scale 2 2 drawXObject jpg @@ -190,14 +191,14 @@ wordStyle (SuperCrazy l _) = Just ws where ws _ DrawGlue _ = return ()- ws (Rectangle xa ya xb yb) DrawWord drawWord = do+ ws (Rectangle (xa :+ ya) (xb :+ yb)) DrawWord drawWord = do let [a,b,c,d,e,f,g,h] :: [PDFFloat] = map (\x -> x / 16.0) . map fromIntegral . take 8 $ l --angle = head angl- p = Polygon [ (xa-a,ya+b)- , (xb+c,ya+d)- , (xb+e,yb-f)- , (xa-g,yb-h)- , (xa-a,ya+b)+ p = Polygon [ (xa-a) :+ (ya+b)+ , (xb+c) :+ (ya+d)+ , (xb+e) :+ (yb-f)+ , (xa-g) :+ (yb-h)+ , (xa-a) :+ (ya+b) ] strokeColor red stroke p@@ -222,14 +223,14 @@ crazyWord :: Rectangle -> StyleFunction -> Draw a -> Draw ()-crazyWord r@(Rectangle xa ya xb yb) DrawWord d = do+crazyWord r@(Rectangle (xa :+ ya) (xb :+ yb)) DrawWord d = do fillColor $ Rgb 0.6 1 0.6 fill r d strokeColor $ Rgb 0 0 1 let m = (ya+yb)/2.0 stroke $ Line xa m xb m -crazyWord (Rectangle xa ya xb yb) DrawGlue _ = do+crazyWord (Rectangle (xa :+ ya) (xb :+ yb)) DrawGlue _ = do fillColor $ Rgb 0 0 1 fill (Circle ((xa+xb)/2.0) ((ya+yb)/2.0) ((xb-xa)/2.0)) @@ -273,10 +274,10 @@ paragraphChange (BluePara _) _ (AChar st c _:l) = let f = PDFFont Helvetica_Bold 45 w' = charWidth f c - charRect = Rectangle 0 (- getDescent f) w' (getHeight f - getDescent f)+ charRect = Rectangle (0 :+ (- getDescent f)) (w' :+ (getHeight f - getDescent f)) c' = mkLetter (0,0,0) Nothing . mkDrawBox $ do withNewContext $ do- applyMatrix $ translate (-w') (getDescent f - getHeight f + styleHeight st - styleDescent st)+ applyMatrix $ translate ((-w') :+ (getDescent f - getHeight f + styleHeight st - styleDescent st)) fillColor $ Rgb 0.6 0.6 1 strokeColor $ Rgb 0.6 0.6 1 fillAndStroke $ charRect@@ -292,8 +293,8 @@ paragraphChange s _ l = (s,l) - paragraphStyle (BluePara _) = Just $ \(Rectangle xa ya xb yb) b -> do- let f = Rectangle (xa-3) (ya-3) (xb+3) (yb+3)+ paragraphStyle (BluePara _) = Just $ \(Rectangle (xa :+ ya) (xb :+ yb)) b -> do+ let f = Rectangle ((xa-3) :+ (ya-3)) ((xb+3) :+ (yb+3)) fillColor $ Rgb 0.6 0.6 1 fill f b@@ -304,7 +305,7 @@ containerTest :: PDFReference PDFPage -> Rectangle ->( TM StandardParagraphStyle StandardStyle ()) -> PDF ()-containerTest p (Rectangle xa ya xb yb) theText = +containerTest p (Rectangle (xa :+ ya) (xb :+ yb)) theText = let c = mkContainer xa ya xb yb 0 (d,c',r) = fillContainer (defaultVerState NormalParagraph) c . getBoxes NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do theText@@ -318,7 +319,7 @@ w = containerWidth c' --h = containerHeight c' strokeColor red- stroke $ Rectangle x y (x+w) (ya-100-yb)+ stroke $ Rectangle (x :+ y) ((x+w) :+ (ya-100-yb)) strokeColor blue stroke $ containerContentRectangle c' stroke $ containerContentRectangle c''@@ -445,18 +446,18 @@ 0 -> do strokeColor red stroke $ Line 10 300 (10+100) 300- displayFormattedText (Rectangle 10 0 (10+100) 300) NormalPara Normal simpleText+ displayFormattedText (Rectangle (10 :+ 0) ((10+100) :+ 300)) NormalPara Normal simpleText 1 -> do strokeColor red stroke $ Line 10 400 (10+maxw) 400- displayFormattedText (Rectangle 10 0 (10+maxw) 400) NormalPara Normal myText+ displayFormattedText (Rectangle (10 :+ 0) ((10+maxw) :+ 400)) NormalPara Normal myText 2 -> do strokeColor red stroke $ Line 10 300 (10+maxw) 300- displayFormattedText (Rectangle 10 0 (10+maxw) 300) NormalPara Normal debugText+ displayFormattedText (Rectangle (10 :+ 0) ((10+maxw) :+ 300)) NormalPara Normal debugText 3 -> do- let r = (Rectangle 10 200 (10+maxw) 300)+ let r = (Rectangle (10 :+ 200) ((10+maxw) :+ 300)) displayFormattedText r CirclePara Normal $ do setStyle Normal setFirstPassTolerance 5000@@ -470,62 +471,83 @@ txt $ "Ut enim ad minim" strokeColor red stroke r- 4 -> displayFormattedText ((Rectangle 10 0 (10+maxw) 300)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) standardStyleTest+ 4 -> displayFormattedText (Rectangle (10 :+ 0) ((10+maxw) :+ 300)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) standardStyleTest 5 -> do strokeColor red- stroke $ Rectangle 10 300 (10+maxw) 400- displayFormattedText ((Rectangle 10 300 (10+maxw) 400)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do+ stroke $ Rectangle (10 :+ 300) ((10+maxw) :+ 400)+ displayFormattedText (Rectangle (10 :+ 300) ((10+maxw) :+ 400)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do setJustification Centered testText strokeColor red- stroke $ Rectangle 10 200 (10+maxw) 300- displayFormattedText ((Rectangle 10 200 (10+maxw) 300)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do+ stroke $ Rectangle (10 :+ 200) ((10+maxw) :+ 300)+ displayFormattedText (Rectangle (10 :+ 200) ((10+maxw) :+ 300)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do setJustification LeftJustification testText strokeColor red- stroke $ Rectangle 10 100 (10+maxw) 200- displayFormattedText ((Rectangle 10 100 (10+maxw) 200)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do+ stroke $ Rectangle (10 :+ 100) ((10+maxw) :+ 200)+ displayFormattedText (Rectangle (10 :+ 100) ((10+maxw) :+ 200)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do setJustification RightJustification testText strokeColor red fillColor blue- stroke $ Rectangle 10 0 (10+maxw) 100+ stroke $ Rectangle (10 :+ 0) ((10+maxw) :+ 100) drawText $ text (PDFFont Helvetica_Bold 24) 10 100 (toPDFString "Lorem ipsum") stroke $ Line 10 120 (10 + textWidth (PDFFont Helvetica_Bold 24) (toPDFString "Lorem ipsum") ) 120 - displayFormattedText ((Rectangle 10 0 (10+maxw) 100)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do+ displayFormattedText (Rectangle (10 :+ 0) ((10+maxw) :+ 100)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do setJustification LeftJustification paragraph $ do setStyle (Font (PDFFont Helvetica_Bold 24) black black) txt $ "Lorem ipsum" 6 -> do strokeColor red- stroke $ Rectangle 10 300 (10+maxw) 400- displayFormattedText ((Rectangle 10 300 (10+maxw) 400)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do+ stroke $ Rectangle (10 :+ 300) ((10+maxw) :+ 400)+ displayFormattedText (Rectangle (10 :+ 300) ((10+maxw) :+ 400)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do setJustification Centered testBreakText strokeColor red- stroke $ Rectangle 10 200 (10+maxw) 300- displayFormattedText ((Rectangle 10 200 (10+maxw) 300)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do+ stroke $ Rectangle (10 :+ 200) ((10+maxw) :+ 300)+ displayFormattedText (Rectangle (10 :+ 200) ((10+maxw) :+ 300)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do setJustification LeftJustification testBreakText strokeColor red- stroke $ Rectangle 10 100 (10+maxw) 200- displayFormattedText ((Rectangle 10 100 (10+maxw) 200)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do+ stroke $ Rectangle (10 :+ 100) ((10+maxw) :+ 200)+ displayFormattedText (Rectangle (10 :+ 100) ((10+maxw) :+ 200)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do setJustification RightJustification testBreakText strokeColor red- stroke $ Rectangle 10 0 (10+maxw) 100- displayFormattedText ((Rectangle 10 0 (10+maxw) 100)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do+ stroke $ Rectangle (10 :+ 0) ((10+maxw) :+ 100)+ displayFormattedText (Rectangle (10 :+ 0) ((10+maxw) :+ 100)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do setJustification FullJustification testBreakText- _ -> displayFormattedText ((Rectangle 0 300 (10+maxw) 300)) NormalPara Normal myText+ _ -> displayFormattedText (Rectangle (0 :+ 300) ((10+maxw) :+ 300)) NormalPara Normal myText - +textBoxes :: Draw ()+textBoxes = do+ let x = 230+ y = 200+ w = 220+ h = 200+ fillColor blue+ fill $ Circle x y 5+ let (r,b) = drawTextBox x y w h S NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do+ setJustification FullJustification+ paragraph $ do+ txt $ "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor "+ txt $ "incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud "+ txt $ "exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute "+ txt $ "irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla "+ txt $ "pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia "+ txt $ "deserunt mollit anim id est laborum."+ b+ strokeColor red+ stroke r+ return ()+ testAll :: JpegFile -> PDF () testAll jpg = do page1 <- addPage Nothing@@ -555,8 +577,8 @@ page3c <- addPage Nothing newSection (toPDFString "Container") Nothing Nothing $ do- containerTest page3c (Rectangle 10 300 100 100) testText- containerTest page3c (Rectangle 210 300 200 100) $ do+ containerTest page3c (Rectangle (10 :+ 300) (100 :+ 100)) testText+ containerTest page3c (Rectangle (210 :+ 300) (200 :+ 100)) $ do setJustification Centered testText @@ -603,7 +625,10 @@ textTest newSection (toPDFString "Fun") Nothing Nothing $ do penrose- + page12 <- addPage Nothing+ newSection (toPDFString "Text box") Nothing Nothing $ do+ drawWithPage page12 $ do+ textBoxes main :: IO()