hcg-minus-cairo 0.15 → 0.16

raw patch · 6 files changed

+187/−95 lines, 6 filesdep +processdep −utf8-stringdep ~basedep ~hcg-minusPVP ok

version bump matches the API change (PVP)

Dependencies added: process

Dependencies removed: utf8-string

Dependency ranges changed: base, hcg-minus

API changes (from Hackage documentation)

Files

• README +1/−1
• Render/CG/Minus.hs +85/−66
• Render/CG/Minus/Arrow.hs +24/−23
• Render/CG/Minus/Picture.hs +51/−0
• Render/CG/Minus/Poppler.hs +19/−0
• hcg-minus-cairo.cabal +7/−5

@@ -6,7 +6,7 @@ [cairo]: http://cairographics.org/ [hcg-minus]: http://rd.slavepianos.org/t/hcg-minus -© [rd][rd], 2009-2014, [gpl][gpl]+© [rd][rd], 2009-2017, [gpl][gpl]  [rd]: http://rd.slavepianos.org/ [gpl]: http://gnu.org/copyleft/

@@ -1,122 +1,141 @@ -- | CG (minus) rendering in terms of 'C.Render'. module Render.CG.Minus where -import qualified Codec.Binary.UTF8.String as U {- utf8-string -}-import Data.CG.Minus {- hcg-minus -}-import Data.CG.Minus.Colour {- hcg-minus -}-import Data.Colour {- colour -}-import qualified Graphics.Rendering.Cairo as C {- cairo -}+import qualified Data.Colour as Colour {- colour -}+import qualified Graphics.Rendering.Cairo as Cairo {- cairo -} import System.FilePath {- filepath -} +import Data.CG.Minus.Types {- hcg-minus -}+import qualified Data.CG.Minus.Colour as CG {- hcg-minus -}+import qualified Data.CG.Minus.Core as CG {- hcg-minus -}+ -- * Paths  -- | Render nothing.-nil :: C.Render ()+nil :: Cairo.Render () nil = return () --- | Render 'Ls' as 'C.moveTo' then sequence of 'C.lineTo'.-line :: Ls R -> C.Render ()-line l =+line2 :: Pt R -> Pt R -> Cairo.Render ()+line2 (Pt x1 y1) (Pt x2 y2) = Cairo.moveTo x1 y1 >> Cairo.lineTo x2 y2++-- | Render 'Ls' as 'Cairo.moveTo' then sequence of 'Cairo.lineTo'.+line :: Ls R -> Cairo.Render ()+line (Ls l) =   case l of     [] -> nil     Pt x0 y0 : pp ->-        do C.moveTo x0 y0-           let f (Pt x y) = C.lineTo x y+        do Cairo.moveTo x0 y0+           let f (Pt x y) = Cairo.lineTo x y            mapM_ f pp --- | Variant of 'line' that runs 'C.closePath'.-polygon :: Ls R -> C.Render ()-polygon l =-    case l of-      [] -> nil-      _ -> line l >> C.closePath+-- | Variant of 'line' that runs 'Cairo.closePath'.+polygon :: Ls R -> Cairo.Render ()+polygon l = if CG.ls_null l then nil else line l >> Cairo.closePath  -- | Render 'Ls' as set of square points with 'R' dimension.--- Runs 'C.fill' on each square.-points :: R -> Ls R -> C.Render ()-points n l = do-  let f (Pt x y) = C.rectangle x y n n >> C.fill+-- Runs 'Cairo.fill' on each square.+points :: R -> Ls R -> Cairo.Render ()+points n (Ls l) = do+  let f (Pt x y) = Cairo.rectangle x y n n >> Cairo.fill   mapM_ f l  -- | Circle centred at 'Pt' with radius 'R'.-circle :: Pt R -> R -> C.Render ()-circle (Pt x y) z = C.arc x y z 0 (2 * pi)+circle :: Pt R -> R -> Cairo.Render ()+circle (Pt x y) z = Cairo.arc x y z 0 (2 * pi)  -- * Context & drawing --- | Greyscale call to 'C.setSourceRGBA'.-grey :: R -> C.Render ()-grey x = C.setSourceRGBA x x x 1+-- | Greyscale call to 'Cairo.setSourceRGBA'.+grey :: R -> Cairo.Render ()+grey x = Cairo.setSourceRGBA x x x 1 --- | 'Ca' call to 'C.setSourceRGBA'.-colour :: Ca -> C.Render ()+-- | 'Ca' call to 'Cairo.setSourceRGBA'.+colour :: Ca -> Cairo.Render () colour c =-  let (r,g,b,a) = unCa c-  in C.setSourceRGBA r g b a+  let (r,g,b,a) = CG.ca_to_rgba c+  in Cairo.setSourceRGBA r g b a  -- | Set line width 'R' and 'Ca'.-pen :: R -> Ca -> C.Render ()-pen lw c = C.setLineWidth lw >> colour c+pen :: R -> Ca -> ([R],R) -> Cairo.Render ()+pen lw c (d,d0) = do+  Cairo.setLineWidth lw+  Cairo.setDash d d0+  colour c  -- * Composite  -- | Run 'polygon' on 'Ls' then 'fill' and 'stroke'.-area :: R -> Ca -> Ca -> Ls R -> C.Render ()+area :: R -> Ca -> Ca -> Ls R -> Cairo.Render () area lw sc fc a = do   polygon a   colour fc-  C.fill-  pen lw sc-  C.stroke+  Cairo.fill+  pen lw sc ([],0)+  Cairo.stroke --- | Variant of 'area' with fixed grey border of width @0.005@ and+-- | Variant of 'area' with default border of width @0.005@ and -- grey @0.15@.-area' :: Ca -> Ls R -> C.Render ()-area' = area 0.005 (opaque (mk_grey 0.15))+area_def :: Ca -> Ls R -> Cairo.Render ()+area_def = area 0.005 (Colour.opaque (CG.mk_grey 0.15)) --- | Run 'polygon' on 'Ls' then 'pen' and 'C.stroke'.-outline :: R -> Ca -> Ls R -> C.Render ()-outline lw c l = polygon l >> pen lw c >> C.stroke+-- | Run 'polygon' on 'Ls' then 'pen' and 'Cairo.stroke'.+outline :: R -> Ca -> Ls R -> Cairo.Render ()+outline lw c l = polygon l >> pen lw c ([],0) >> Cairo.stroke --- | Outline rectangle given colour 'Ca', upper-left 'Pt' and+-- | Outline rectangle given colour line width 'R', 'Ca', upper-left 'Pt' and -- /(width,height)/.-rect :: Ca -> Pt R -> (R,R) -> C.Render ()-rect c (Pt x y) (w,h) = do-  C.rectangle x y w h-  pen 0.05 c-  C.stroke+rect :: R -> Ca -> Pt R -> (R,R) -> Cairo.Render ()+rect lw c (Pt x y) (w,h) = do+  Cairo.rectangle x y w h+  pen lw c ([],0)+  Cairo.stroke  -- | Solid variant of 'rect'.-rect_fill :: Ca -> Pt R -> (R,R) -> C.Render ()+rect_fill :: Ca -> Pt R -> (R,R) -> Cairo.Render () rect_fill c (Pt x y) (w,h) = do-  C.rectangle x y w h+  Cairo.rectangle x y w h   colour c-  C.fill+  Cairo.fill  -- * Text  -- | Render text 'String' in colour 'Ca' at 'Pt' in font size /sz/.-text :: Ca -> Pt R -> R -> String -> C.Render ()+text :: Ca -> Pt R -> R -> String -> Cairo.Render () text c (Pt x y) sz txt = do-  let (r,g,b,_) = unCa c-  C.save-  C.selectFontFace "Times" C.FontSlantNormal C.FontWeightNormal-  C.setFontSize sz-  C.setSourceRGBA r g b 1-  C.moveTo x y-  C.showText (U.utf8Encode txt)-  C.restore+  let (r,g,b,_) = CG.ca_to_rgba c+  Cairo.save+  Cairo.selectFontFace "Times" Cairo.FontSlantNormal Cairo.FontWeightNormal+  Cairo.setFontSize sz+  Cairo.setSourceRGBA r g b 1+  Cairo.moveTo x y+  Cairo.showText txt+  Cairo.restore  -- * Rendering  -- | Enumeration of file types. data File_Type = F_PDF | F_SVG --- | Render to 'File_Type'.  \(w,h)\ give the page size.  The--- appropriate extension is appended to 'FilePath'.-render_to_file :: File_Type -> (R,R) -> FilePath -> C.Render () -> IO ()+-- | If /nm/ does not have /ext/ append it.+--+-- > map (maybe_add_extension ".pdf") ["x.pdf","x.y"] == ["x.pdf","x.y.pdf"]+maybe_add_extension :: String -> FilePath -> FilePath+maybe_add_extension ext nm = if takeExtension nm == ext then nm else nm <.> ext++-- | Render to 'File_Type'.+-- \(w,h)\ gives the page size.+-- The appropriate extension is appended to 'FilePath' if required.+render_to_file :: File_Type -> (R,R) -> FilePath -> Cairo.Render () -> IO () render_to_file ty (w,h) nm f = do   let r_fn = case ty of-               F_PDF -> C.withPDFSurface (nm <.> "pdf")-               F_SVG -> C.withSVGSurface (nm <.> "svg")-  r_fn w h (`C.renderWith` f)+               F_PDF -> Cairo.withPDFSurface (maybe_add_extension ".pdf" nm)+               F_SVG -> Cairo.withSVGSurface (maybe_add_extension ".svg" nm)+  r_fn w h (`Cairo.renderWith` f)++-- | Render to @PDF@ file.+render_to_pdf :: (R,R) -> FilePath -> Cairo.Render () -> IO ()+render_to_pdf = render_to_file F_PDF++-- | Render to @SVG@ file.+render_to_svg :: (R,R) -> FilePath -> Cairo.Render () -> IO ()+render_to_svg = render_to_file F_SVG

@@ -1,45 +1,46 @@ -- | Rendering of "Data.CG.Minus.Arrow". module Render.CG.Minus.Arrow where -import Data.CG.Minus {- hcg-minus -}-import Data.CG.Minus.Arrow {- hcg-minus -}-import Data.CG.Minus.Colour {- hcg-minus -}-import qualified Graphics.Rendering.Cairo as C {- cairo -}+import qualified Graphics.Rendering.Cairo as Cairo {- cairo -} +import Data.CG.Minus.Types {- hcg-minus -}+import qualified Data.CG.Minus.Arrow as CG {- hcg-minus -}+import qualified Data.CG.Minus.Core as CG {- hcg-minus -}+ import Render.CG.Minus -arrow_strk :: Ca -> C.Render ()+arrow_strk :: Ca -> Cairo.Render () arrow_strk c = do-  C.setLineCap C.LineCapRound-  pen 0.01 c-  C.stroke+  Cairo.setLineCap Cairo.LineCapRound+  pen 0.01 c ([],0)+  Cairo.stroke  -- | Render 'Ln' with solid arrow tip at endpoint.  Arrow tip -- co-ordinates are given by 'arrow_coord'.-arrow_ep :: R -> R -> Ca -> Ln R -> C.Render ()+arrow_ep :: R -> R -> Ca -> Ln R -> Cairo.Render () arrow_ep n a c ln = do   let Ln p0 p1 = ln-      (p2,p3) = arrow_coord ln n a-  line [p0,ln_midpoint (Ln p2 p3)]+      (p2,p3) = CG.arrow_coord ln n a+  line (Ls [p0,CG.ln_midpoint (Ln p2 p3)])   arrow_strk c-  polygon [p2,p1,p3]-  C.fill+  polygon (Ls [p2,p1,p3])+  Cairo.fill  -- | Variant of 'arrow_ep' to render 'Ls' as sequence of arrows.-arrows_ep :: R -> R -> Ca -> Ls R -> C.Render ()-arrows_ep n a c xs = mapM_ (arrow_ep n a c) (zipWith Ln xs (tail xs))+arrows_ep :: R -> R -> Ca -> Ls R -> Cairo.Render ()+arrows_ep n a c (Ls xs) = mapM_ (arrow_ep n a c) (zipWith Ln xs (tail xs))  -- | Variant of 'arrow_ep' with draws tip at mid-point of 'Ln'.-arrow_mp :: R -> R -> Ca -> Ln R -> C.Render ()+arrow_mp :: R -> R -> Ca -> Ln R -> Cairo.Render () arrow_mp n a c ln = do   let Ln p0 p1 = ln-      p1' = ln_midpoint (Ln p0 (pt_linear_extension n ln))-      (p2,p3) = arrow_coord (Ln p0 p1') n a-  line [p0,p1]+      p1' = CG.ln_midpoint (Ln p0 (CG.pt_linear_extension n ln))+      (p2,p3) = CG.arrow_coord (Ln p0 p1') n a+  line (Ls [p0,p1])   arrow_strk c-  polygon [p2,p1',p3]-  C.fill+  polygon (Ls [p2,p1',p3])+  Cairo.fill  -- | Variant of 'arrow_mp' to render 'Ls' as sequence of arrows.-arrows_mp :: R -> R -> Ca -> Ls R -> C.Render ()-arrows_mp n a c xs = mapM_ (arrow_mp n a c) (zipWith Ln xs (tail xs))+arrows_mp :: R -> R -> Ca -> Ls R -> Cairo.Render ()+arrows_mp n a c (Ls xs) = mapM_ (arrow_mp n a c) (zipWith Ln xs (tail xs))

@@ -0,0 +1,51 @@+-- | Rendering of "Data.CG.Minus.Picture".+module Render.CG.Minus.Picture where++import qualified Graphics.Rendering.Cairo as C {- cairo -}+import qualified Graphics.Rendering.Cairo.Matrix as C (Matrix(..)) {- cairo -}++import Data.CG.Minus.Types {- hcg-minus -}+import Data.CG.Minus.Picture {- hcg-minus -}++import qualified Render.CG.Minus as Render {- hcg-minus-cairo -}++fill :: Ca -> C.Render ()+fill clr = Render.colour clr >> C.fill++stroke :: Pen -> C.Render ()+stroke (Pen lw clr dash) = Render.pen lw clr dash >> C.stroke++mark :: Either Pen Ca -> C.Render ()+mark = either stroke fill++mark_render :: Mark -> C.Render ()+mark_render m =+    case m of+      Line pen (Ln p1 p2) -> Render.line2 p1 p2 >> stroke pen+      Polygon e pt -> Render.polygon (Ls pt) >> mark e+      Circle e (c,r) -> Render.circle c r >> mark e+      Dot clr (c,r) -> Render.circle c r >> fill clr++-- | m = margin+picture_render :: R -> Wn R -> Picture -> C.Render ()+picture_render m w p = do+  let Wn (Pt x y) (Vc _ dy) = w+  C.translate (m/2 - x) (dy + m/2 + y)+  C.transform (C.Matrix 1 0 0 (-1) 0 0)+  mapM_ mark_render p++-- | 'Render.render_to_file' of 'picture_render'.+picture_to_file_set :: [Render.File_Type] -> R -> FilePath -> Picture -> IO ()+picture_to_file_set ty_set m fn p = do+  let w = picture_wn p+      Wn _ (Vc x y) = w+  mapM_ (\ty -> Render.render_to_file ty (m + x,m + y) fn (picture_render m w p)) ty_set++picture_to_pdf :: R -> FilePath -> Picture -> IO ()+picture_to_pdf = picture_to_file_set [Render.F_PDF]++picture_to_svg :: R -> FilePath -> Picture -> IO ()+picture_to_svg = picture_to_file_set [Render.F_SVG]++picture_to_pdf_and_svg :: R -> FilePath -> Picture -> IO ()+picture_to_pdf_and_svg = picture_to_file_set [Render.F_PDF,Render.F_SVG]

@@ -0,0 +1,19 @@+module Render.CG.Minus.Poppler where++import Control.Monad {- base -}+import System.FilePath {- filepath -}+import System.Process {- process -}++type Cmd = (String,[String])++run_cmd :: Cmd -> IO ()+run_cmd (c,a) = void (rawSystem c a)++pdf_to_svg_cmd :: FilePath -> Cmd+pdf_to_svg_cmd fn = ("pdftocairo",["-svg",fn,replaceExtension fn ".svg"])++-- | Run pdftocairo to translate a PDF file to an SVG file.+--+-- > pdf_to_svg "/tmp/t.0.pdf"+pdf_to_svg :: FilePath -> IO ()+pdf_to_svg = run_cmd . pdf_to_svg_cmd

@@ -1,5 +1,5 @@ name:              hcg-minus-cairo-version:           0.15+version:           0.16 synopsis:          haskell cg (minus) (cairo rendering) description:       cg (minus) library (cairo rendering) license:           BSD3@@ -7,22 +7,24 @@ author:            Rohan Drape maintainer:        rd@slavepianos.org homepage:          http://rd.slavepianos.org/t/hcg-minus-cairo-tested-with:       GHC == 7.8.2+tested-with:       GHC == 8.0.1 build-type:        Simple cabal-version:     >= 1.8  data-files:        README  library-  build-depends:   base == 4.*,+  build-depends:   base == 4.* && < 5,                    cairo,                    colour,-                   hcg-minus == 0.15.*,+                   hcg-minus == 0.16.*,                    filepath,-                   utf8-string+                   process   ghc-options:     -Wall -fwarn-tabs   exposed-modules: Render.CG.Minus                    Render.CG.Minus.Arrow+                   Render.CG.Minus.Picture+                   Render.CG.Minus.Poppler  Source-Repository  head   Type:            darcs