diagrams-cairo 0.1.2 → 0.2

raw patch · 10 files changed

+159/−45 lines, 10 filesdep ~cmdargsdep ~diagrams-coredep ~diagrams-libPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: cmdargs, diagrams-core, diagrams-lib

API changes (from Hackage documentation)

Files

• CHANGES +18/−0
• diagrams-cairo.cabal +5/−4
• example/Hasse.hs +55/−0
• example/Hilbert.hs +25/−0
• example/golden.hs +3/−2
• example/gray.hs +4/−4
• example/hslogo.hs +1/−1
• example/paradox.hs +0/−2
• src/Diagrams/Backend/Cairo.hs +46/−30
• src/Diagrams/Backend/Cairo/CmdLine.hs +2/−2

@@ -0,0 +1,18 @@+0.1: 17 May 2011+  * initial preview release++0.1.1: 18 May 2011+  * fix tic-tac-toe example++0.1.2: 18 May 2011+  * link to new website++0.2: 3 June 2011++  * add Typeable and other instances for Cairo type++  * generalize Result type to (IO (), Render ()), so programs that+    don't want to generate a file but just want a Render operation+    (e.g. to use to paint a gtk window) can use the second component.++  * add support for opacity attribute and path clipping

@@ -1,5 +1,5 @@ Name:                diagrams-cairo-Version:             0.1.2+Version:             0.2 Synopsis:            Cairo backend for diagrams drawing EDSL Description:         This package provides a modular backend for rendering                      diagrams created with the diagrams EDSL using the @@ -13,6 +13,7 @@ Category:            Graphics Build-type:          Simple Cabal-version:       >=1.6+Extra-source-files:  CHANGES Tested-with:         GHC == 6.12.3, GHC >= 7.0.2 && <= 7.0.3 Extra-source-files:  example/*.hs, example/tic-tac-toe/*.hs Source-repository head@@ -27,10 +28,10 @@                        process >= 1.0 && < 1.1,                        directory >= 1.0 && < 1.2,                        old-time >= 1.0 && < 1.1,-                       diagrams-core >= 0.1 && < 0.2,-                       diagrams-lib >= 0.1 && < 0.2,+                       diagrams-core >= 0.2 && < 0.3,+                       diagrams-lib >= 0.2 && < 0.3,                        cairo >= 0.10.1 && < 0.13,-                       cmdargs >= 0.6 && < 0.7,+                       cmdargs >= 0.6 && < 0.8,                        split >= 0.1.2 && < 0.2   if !os(windows)     cpp-options: -DCMDLINELOOP

@@ -0,0 +1,55 @@+{-# LANGUAGE NoMonomorphismRestriction #-}++import Diagrams.Prelude+import Diagrams.Backend.Cairo.CmdLine++import Data.List+import Data.Ord (comparing)+import Data.Function (on)++type D = Diagram Cairo R2++colors = [black, blue, red, yellow, green, orange, purple, brown]++data Subset = Subset Int [Int]++(Subset _ elts1) `isSubset` (Subset _ elts2) = all (`elem` elts2) elts1++subsetsBySize :: Int -> [[Subset]]+subsetsBySize n = map (map (Subset n))+                . groupBy ((==) `on` length)+                . sortBy (comparing length)+                . subsequences+                $ [1..n]++drawSet :: Subset -> D+drawSet (Subset n elts) = (    drawElts n elts # centerXY+                            <> square # scaleX (fromIntegral n + 0.5) # scaleY 1.5+                                      # dashing [0.2,0.2] 0+                                      # lw 0.03+                                      # namePoint (boundary (negateV unitY)) "B"+                                      # namePoint (boundary unitY) "T"+                                      # (show elts |>)+                          )+                          # freeze++drawElts n elts = hcat . map (\i -> if i `elem` elts then drawElt i else strutX 1) $ [1..n]+drawElt e = square # fc (colors !! e) # lw 0.05 # freeze+++hasseDiagram n = setsD # drawConnections+  where setsD = vcat' with {sep = fromIntegral n} . map hasseRow . reverse $ subsets+        drawConnections = applyAll connections+        connections = concat $ zipWith connectSome subsets (tail subsets)+        connectSome subs1 subs2 = [ connect s1 s2 | s1 <- subs1+                                                  , s2 <- subs2+                                                  , s1 `isSubset` s2 ]+        connect (Subset _ elts1) (Subset _ elts2) =+          withName (show elts1 ||> "T") $ \p1 ->+          withName (show elts2 ||> "B") $ \p2 ->+          (<> stroke (fromVertices [p1,p2]) # lw 0.03)+        subsets = subsetsBySize n++hasseRow = centerX . hcat' with {sep = 2} . map drawSet++main = defaultMain (pad 1.1 $ hasseDiagram 4)

@@ -0,0 +1,25 @@+{-# LANGUAGE NoMonomorphismRestriction #-}++import Diagrams.Prelude+import Diagrams.Backend.Cairo.CmdLine++hilbert :: [Trail R2]+hilbert = iterate genHilbert mempty+  where genHilbert t = let t' = reverseTrail t+                       in  mconcat [ rotateBy (-1/4) t'+                                   , fromOffsets [unitY]+                                   , t+                                   , fromOffsets [unitX]+                                   , t+                                   , fromOffsets [negateV unitY]+                                   , rotateBy (1/4) t'+                                   ]++d = (hilbert !! 6)+  # strokeT+  # lw 0.2+  # fc red+  # centerXY+  # pad 1.1++main = defaultMain d

@@ -7,14 +7,15 @@ type D = Diagram Cairo R2  sq :: D-sq = (lw 1 . stroke $ arc (pi / 2) pi) `atop` (translate (-0.5, 0.5) . lw 0.5 $ square)+sq = (lw 1 . stroke $ arc (pi / 2 :: Rad) (pi :: Rad))+     `atop` (translate (-0.5, 0.5) . lw 0.5 $ square)  phi :: Double phi = (1 + sqrt 5) / 2  step :: D -> D -> D step a b = besideAlign (-1,0) (0,1) a b'-  where b' = rotate (-pi/2) . scale (1/phi) $ b+  where b' = rotate (-pi/2 :: Rad) . scale (1/phi) $ b  besideAlign :: R2 -> R2 -> D -> D -> D besideAlign u v a b = beside u b' a

@@ -16,17 +16,17 @@   where g = gray (n-1)  rings n = mkRingsDia . map ringOffsets . transpose . gray $ n-  where ringOffsets :: [Bool] -> [(Angle, Angle)]-        ringOffsets = map l2t . chunk 2 . findEdges . zip [0,2*pi/(2^n)..2*pi]+  where ringOffsets :: [Bool] -> [(CircleFrac, CircleFrac)]+        ringOffsets = map l2t . chunk 2 . findEdges . zip [0,1/(2^n)..1]         l2t [x,y] = (x,y)         l2t [x]   = (x,2*pi) -findEdges :: Eq a => [(Angle, a)] -> [Angle]+findEdges :: Eq a => [(CircleFrac, a)] -> [CircleFrac] findEdges = catMaybes . (zipWith edge <*> tail)   where edge (_,c1) (a,c2) | c1 /= c2  = Just a                            | otherwise = Nothing -mkRingsDia :: [[(Angle, Angle)]] -> D+mkRingsDia :: [[(CircleFrac, CircleFrac)]] -> D mkRingsDia = freeze . mconcat . zipWith mkRingDia [2,3..]   where mkRingDia r = lw 1.05 . mconcat . map (stroke . scale r . uncurry arc) 

@@ -33,7 +33,7 @@    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE    POSSIBILITY OF SUCH DAMAGE. -} -import Diagrams.Prelude+import Diagrams.Prelude hiding (intersection)  import Diagrams.Backend.Cairo import Diagrams.Backend.Cairo.CmdLine

@@ -2,8 +2,6 @@ import Diagrams.Prelude import Diagrams.Backend.Cairo.CmdLine -import Diagrams.TwoD.Align  -- for abbreviations- fibs = 0 : 1 : zipWith (+) fibs (tail fibs)  thick = 0.15

@@ -3,6 +3,8 @@            , FlexibleInstances            , FlexibleContexts            , TypeSynonymInstances+           , DeriveDataTypeable+           , ViewPatterns   #-}  -----------------------------------------------------------------------------@@ -31,15 +33,19 @@ import qualified Graphics.Rendering.Cairo as C import qualified Graphics.Rendering.Cairo.Matrix as CM +import Control.Applicative ((<$>)) import Control.Monad (when) import Data.Maybe (catMaybes)  import Data.Monoid import qualified Data.Foldable as F +import Data.Typeable+ -- | This data declaration is simply used as a token to distinguish --   this rendering engine. data Cairo = Cairo+  deriving (Eq,Ord,Read,Show,Typeable)  -- | Cairo is able to output to several file formats, which each have --   their own associated properties that affect the output.@@ -60,7 +66,7 @@  instance Backend Cairo R2 where   data Render  Cairo R2 = C (C.Render ())-  type Result  Cairo R2 = IO ()+  type Result  Cairo R2 = (IO (), C.Render ())   data Options Cairo R2 = CairoOptions           { fileName     :: String       -- ^ the name of the file you want generated           , outputFormat :: OutputFormat -- ^ the output format and associated options@@ -68,23 +74,25 @@    withStyle _ s t (C r) = C $ do     C.save+    doClip s     r     cairoTransf t     cairoStyle s     C.stroke     C.restore -  doRender _ options (C r) = do-    let surfaceF surface = C.renderWith surface r-        file = fileName options-    case outputFormat options of-      PNG (w,h) -> do-        C.withImageSurface C.FormatARGB32 w h $ \surface -> do-          surfaceF surface-          C.surfaceWriteToPNG surface file-      PS  (w,h) -> C.withPSSurface  file w h surfaceF-      PDF (w,h) -> C.withPDFSurface file w h surfaceF-      SVG (w,h) -> C.withSVGSurface file w h surfaceF+  doRender _ options (C r) = (renderIO, r)+    where renderIO = do+            let surfaceF s = C.renderWith s r+                file = fileName options+            case outputFormat options of+              PNG (w,h) ->+                C.withImageSurface C.FormatARGB32 w h $ \surface -> do+                  surfaceF surface+                  C.surfaceWriteToPNG surface file+              PS  (w,h) -> C.withPSSurface  file w h surfaceF+              PDF (w,h) -> C.withPDFSurface file w h surfaceF+              SVG (w,h) -> C.withSVGSurface file w h surfaceF    -- Set the line width to 0.01 and line color to black (in case they   -- were not set), freeze the diagram in its final form, and then do@@ -109,8 +117,13 @@ renderC :: (Renderable a Cairo, V a ~ R2) => a -> C.Render () renderC a = case (render Cairo a) of C r -> r -cairoStyle :: Style -> C.Render ()-cairoStyle s = foldr (>>) (return ())+doClip :: Style v -> C.Render ()+doClip s = case getAttr s of+  Just (Clip ps) -> mapM_ (\p -> renderC p >> C.clip) ps+  Nothing -> return ()++cairoStyle :: Style v -> C.Render ()+cairoStyle s = sequence_              . catMaybes $ [ handle fColor                            , handle lColor  -- see Note [color order]                            , handle lWidth@@ -120,20 +133,23 @@                            ]   where handle :: (AttributeClass a) => (a -> C.Render ()) -> Maybe (C.Render ())         handle f = f `fmap` getAttr s-        fColor (FillColor (SomeColor c)) = do-          let (r,g,b,a) = colorToRGBA c-          C.setSourceRGBA r g b a+        fColor c = do+          let (r,g,b,a) = colorToRGBA . getFillColor $ c+          let a' = case getOpacity <$> getAttr s of+                     Nothing -> a+                     Just d  -> a * d+          C.setSourceRGBA r g b a'           C.fillPreserve-        lColor (LineColor (SomeColor c)) = do-          let (r,g,b,a) = colorToRGBA c-          C.setSourceRGBA r g b a-        lWidth (LineWidth w) = do-          C.setLineWidth w-        lCap lcap = do-          C.setLineCap (fromLineCap lcap)-        lJoin lj = do-          C.setLineJoin (fromLineJoin lj)-        lDashing (Dashing ds offs) = do+        lColor c = do+          let (r,g,b,a) = colorToRGBA . getLineColor $ c+          let a' = case getOpacity <$> getAttr s of+                     Nothing -> a+                     Just d  -> a * d+          C.setSourceRGBA r g b a'+        lWidth = C.setLineWidth . getLineWidth+        lCap   = C.setLineCap . fromLineCap . getLineCap+        lJoin  = C.setLineJoin . fromLineJoin . getLineJoin+        lDashing (getDashing -> Dashing ds offs) =           C.setDash ds offs  cairoTransf :: Transformation R2 -> C.Render ()@@ -164,7 +180,7 @@   render _ ell = C $ do     let P (xc,yc) = ellipseCenter ell         (xs,ys)   = ellipseScale ell-        th        = ellipseAngle ell+        Rad th    = ellipseAngle ell     C.newPath     C.save     C.translate xc yc@@ -181,10 +197,10 @@ instance Renderable (Trail R2) Cairo where   render _ (Trail segs c) = C $ do     mapM_ renderC segs-    when c $ C.closePath+    when c C.closePath  instance Renderable (Path R2) Cairo where   render _ (Path trs) = C $ C.newPath >> F.mapM_ renderTrail trs-    where renderTrail (tr, P p) = do+    where renderTrail (P p, tr) = do             uncurry C.moveTo p             renderC tr

@@ -98,7 +98,7 @@ #endif  chooseRender :: DiagramOpts -> Diagram Cairo R2 -> IO ()-chooseRender opts d = do+chooseRender opts d =   case splitOn "." (output opts) of     [""] -> putStrLn "No output file given."     ps | last ps `elem` ["png", "ps", "pdf", "svg"] -> do@@ -108,7 +108,7 @@                  "pdf" -> PDF (fromIntegral $ width opts, fromIntegral $ height opts)                  "svg" -> SVG (fromIntegral $ width opts, fromIntegral $ height opts)                  _     -> PDF (fromIntegral $ width opts, fromIntegral $ height opts)-           renderDia Cairo (CairoOptions (output opts) outfmt) d+           fst $ renderDia Cairo (CairoOptions (output opts) outfmt) d        | otherwise -> putStrLn $ "Unknown file type: " ++ last ps  multiMain :: [(String, Diagram Cairo R2)] -> IO ()