HPDF-1.0: Graphics/PDF/Demo.hs
---------------------------------------------------------
-- |
-- Copyright : (c) alpha 2007
-- License : BSD-style
--
-- Maintainer : misc@NOSPAMalpheccar.org
-- Stability : experimental
-- Portability : portable
--
-- PDF demo. Generate a file demo.pdf
---------------------------------------------------------
module Graphics.PDF.Demo(demo) where
import Graphics.PDF
fontDebug :: PDFFont -> PDFString -> Draw ()
fontDebug f t = do
drawText $ do
setFont f
textStart 10 200.0
leading $ getHeight f
renderMode FillText
displayText t
startNewLine
displayText $ toPDFString "Another little test"
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)
geometryTest :: Draw ()
geometryTest = do
strokeColor red
stroke $ Rectangle 0 0 200 100
fillColor blue
fill $ Ellipse 100 100 300 200
fillAndStroke $ RoundRectangle 32 32 200 200 600 400
lineStyle ::Draw ()
lineStyle = do
withNewContext $ do
setWidth 2
setDash $ DashPattern [3] 0
geometryTest
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 (AxialShading 300 300 600 400 (Rgb 1 0 0) (Rgb 0 0 1)) (addShape $ Ellipse 300 300 600 400)
patternTest :: PDFReference PDFPage -> PDF ()
patternTest page = do
p <- createUncoloredTiling 0 0 100 50 100 50 ConstantSpacing pattern
cp <- createColoredTiling 0 0 100 50 100 50 ConstantSpacing cpattern
drawWithPage page $ do
strokeColor green
setUncoloredFillPattern p (Rgb 1 0 0)
fillAndStroke $ Ellipse 0 0 300 300
setColoredFillPattern cp
fillAndStroke $ Ellipse 300 300 600 400
where
myDrawing = do
stroke (Line 0 0 100 100)
fill (Rectangle 100 100 200 200)
pattern = do
stroke (Ellipse 0 0 100 50)
cpattern = do
strokeColor (Rgb 0 0 1)
stroke (Ellipse 0 0 100 50)
testAnnotation :: Draw ()
testAnnotation = do
strokeColor red
newAnnotation (URLLink (toPDFString "Go to my blog") [0,0,100,100] "http://www.alpheccar.org" True)
drawText $ text (PDFFont Times_Roman 12) 10 30 (toPDFString "Go to my blog")
stroke $ Rectangle 0 0 100 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 !")
--testImage :: FilePath -> PDFReference PDFPage -> PDF ()
--testImage logo page = do
-- Right jpg <- createPDFJpeg logo
-- drawWithPage page $ do
-- withNewContext $ do
-- setFillAlpha 0.4
-- drawXObject jpg
-- withNewContext $ do
-- applyMatrix $ rotate (Degree 20)
-- applyMatrix $ translate 200 200
-- applyMatrix $ scale 2 2
-- drawXObject jpg
testAll :: FilePath -> PDF ()
testAll logo = do
page <- addPage Nothing
newSection (toPDFString "Shapes") Nothing Nothing $ do
newSection (toPDFString "Geometry") Nothing Nothing $ do
drawWithPage page $ do
geometryTest
page <- addPage Nothing
newSection (toPDFString "Line style") Nothing Nothing $ do
drawWithPage page $ do
lineStyle
page <- addPage Nothing
newSection (toPDFString "Object reuse") Nothing Nothing $ do
r <- createPDFXForm 0 0 200 200 lineStyle
drawWithPage page $ do
drawXObject r
page <- addPage Nothing
newSectionWithPage (toPDFString "Painting") Nothing Nothing page $ do
newSection (toPDFString "Patterns") Nothing Nothing $ do
patternTest page
page <- addPage Nothing
newSection (toPDFString "Shading") Nothing Nothing $ do
drawWithPage page $ do
shadingTest
page <- addPage Nothing
--newSection (toPDFString "Media") Nothing Nothing $ do
-- newSection (toPDFString "image") Nothing Nothing $ do
-- testImage logo page
page <- addPage Nothing
newSection (toPDFString "Annotations") Nothing Nothing $ do
drawWithPage page $ do
testAnnotation
page <- addPage Nothing
newSection (toPDFString "Text") Nothing Nothing $ do
drawWithPage page $ do
textTest
-- | Run the demo and create a demo.pdf file
demo :: IO()
demo = do
let rect = PDFRect 0 0 600 400
runPdf "demo.pdf" (standardDocInfo { author=toPDFString $ "alpheccar"}) rect $ do
testAll ""