diff --git a/CHANGES b/CHANGES deleted file mode 100644 --- a/CHANGES +++ /dev/null @@ -1,84 +0,0 @@ -0.5.0.2 : 13 May 2012 - - * Allow building under mtl 2.1.* - -0.5.0.1 : 9 March 2012 - - * Remove statement in package description that a development version - of gtk2hs must be used with GHC 7.4; this is no longer true as of - the 0.12.3 release of gtk2hs. - -0.5: 9 March 2012 - - * New features - - - New Diagrams.Backend.Cairo.Text module by Michael Sloan, with - functions for creating appropriately sized text objects by - querying cairo for the size, and related supporting functions. - - - Basic support for animation, by generating frames sampled at - regular intervals. - - - Proper vertical alignment of default text based on font - parameters (Michael Sloan). - - - Requesting just a width or height now causes the other to be - computed appropriately. - - * API changes - - - Move "Diagrams.Backend.Cairo" to - "Diagrams.Backend.Cairo.Internal" and export everything. - "Diagrams.Backend.Cairo" now just re-exports selected functions - from Internal. This allows anyone who wants access to the - helper/utility functions to import Internal. - - * Dependency/version changes - - - relax cmdargs upper bound - - GHC 7.4.1 compatibility: update base, filepath, old-time upper bounds - - * Bug fixes - - - #54: Generate warning for missing image files (Ian Ross). - -0.4: 22 October 2011 - - * New features: - + Support for drawing directly to Gtk widgets - + Support for path fill rule attribute - - * New/improved examples - - * Improved documentation - - * Bug fixes: - + Warning for unsupported image types (#41) - -0.3: 18 June 2011 - - * Some new/improved examples - - * New features: - + simple text support - + simple support for external PNG images - -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 - -0.1.2: 18 May 2011 - * link to new website - -0.1.1: 18 May 2011 - * fix tic-tac-toe example - -0.1: 17 May 2011 - * initial preview release - diff --git a/CHANGES.markdown b/CHANGES.markdown new file mode 100644 --- /dev/null +++ b/CHANGES.markdown @@ -0,0 +1,148 @@ +0.6: 11 December 2012 +--------------------- + +* **New features** + + - New `--list` option for `multiMain` to list all available diagrams + + - Major documentation improvements + + - New modules: + + + `Diagrams.Backend.Cairo.Ptr`, for rendering directly to buffers + in memory + + + `Diagrams.Backend.Cairo.List`, for rendering to a list of lists + of pixels. + +* **API changes** + + - Removal of `StyleParam` from `Diagrams.Backend.Cairo.Text`, change + functions in that module to accept `Style R2`. Usage can be fixed + by applying these style functions to `mempty`. + + - GTK rendering has been split out into a new package, diagrams-gtk. + + + The `Diagrams.Backend.Cairo.Gtk` module is now + `Diagrams.Backend.Gtk` in the `diagrams-gtk` package. + + + The `CairoOptions` record has a new boolean `cairoBypassAdjust` + option; when set, the backend should bypass calling `adjustDia2D`. + + + The GTK output type is gone. + + + There is a new `RenderOnly` output type, for when you don't + care about the `IO` action but only want the cairo `Render` action. + +* **Dependency/version changes** + + - Upper bounds relaxed to allow + `base`-4.6, `unix`-2.6, `cmdargs`-0.10, `split`-0.2.*, `mtl`-2.1 + + - Add a dependency on `time`, and conditional compilation to use + either ClockTime or UTCTime depending on the version of the + `directory` package + + - Add dependency on `colour` + + - Lower bound on `cairo` raised to 0.12.4 + +* **Bug fixes** + + - Fixed looped compile mode, which was repeatedly trying to compile + when the code contained errors, instead of trying once and then + waiting for a change. + + - Fix a bug where default attributes were not being set when using + the "bypass" mode used by the gtk backend. ([\#16](https://github.com/diagrams/diagrams-cairo/pull/16)) + +0.5.0.2 : 13 May 2012 +--------------------- + +* Allow building under `mtl` 2.1.* + +0.5.0.1 : 9 March 2012 +---------------------- + +* Remove statement in package description that a development version + of `gtk2hs` must be used with GHC 7.4; this is no longer true as of + the 0.12.3 release of `gtk2hs`. + +0.5: 9 March 2012 +----------------- + +* **New features** + - New `Diagrams.Backend.Cairo.Text` module by Michael Sloan, with + functions for creating appropriately sized text objects by + querying cairo for the size, and related supporting functions. + - Basic support for animation with `animMain` function, by + generating frames sampled at regular intervals. + - Proper vertical alignment of default text based on font + parameters (Michael Sloan). + - Requesting just a width or height now causes the other to be + computed appropriately. + +* **API changes** + - Move `Diagrams.Backend.Cairo` to + `Diagrams.Backend.Cairo.Internal` and export everything. + `Diagrams.Backend.Cairo` now just re-exports selected functions + from `Internal`. This allows anyone who wants access to the + helper/utility functions to import `Internal`. + +* **Dependency/version changes** + - relax `cmdargs` upper bound + - GHC 7.4.1 compatibility: update `base`, `filepath`, and + `old-time` upper bounds + +* **Bug fixes** + - [\#54](http://code.google.com/p/diagrams/issues/detail?id=54): Generate warning for missing image files (Ian Ross). + +0.4: 22 October 2011 +-------------------- + +* New features: + + Support for drawing directly to Gtk widgets + + Support for path fill rule attribute + +* New/improved examples + +* Improved documentation + +* Bug fixes: + + Warning for unsupported image types (#41) + +0.3: 18 June 2011 +----------------- + +* Some new/improved examples + +* New features: + + simple text support + + simple support for external PNG images + +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 + +0.1.2: 18 May 2011 +------------------ + +* link to new website + +0.1.1: 18 May 2011 +------------------ + +* fix tic-tac-toe example + +0.1: 17 May 2011 +---------------- + +* initial preview release + diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,6 +1,7 @@ Copyright 2011-2012 diagrams-cairo team: Sam Griffin + Niklas Haas John Lato Ian Ross Michael Sloan diff --git a/README b/README deleted file mode 100644 --- a/README +++ /dev/null @@ -1,9 +0,0 @@ -A rendering backend for diagrams, a Haskell embedded domain-specific -language for compositional, declarative drawing. See - - http://projects.haskell.org/diagrams/ - -for more information about the project, including installation -instructions, tutorials, a user manual, a gallery of example images, -and links to the mailing list, IRC channel, developer wiki and bug -tracker. diff --git a/README.markdown b/README.markdown new file mode 100644 --- /dev/null +++ b/README.markdown @@ -0,0 +1,71 @@ +[![Build Status](https://secure.travis-ci.org/diagrams/diagrams-cairo.png)](http://travis-ci.org/diagrams/diagrams-cairo) + +_diagrams-cairo_ is a rendering backend for [diagrams], a powerful, +flexible, declarative domain-specific language for creating vector graphics, +using the [Haskell programming language][haskell]. + +[diagrams]: http://projects.haskell.org/diagrams/ +[haskell]: http://www.haskell.org/haskellwiki/Haskell + +_diagrams-cairo_ is implemented using the [cairo] rendering engine and +is a fully-featured, officially supported backend for diagrams. + +[cairo]: http://www.cairographics.org/ + +# Installation + +``` +cabal update && cabal install gtk2hs-buildtools diagrams-cairo +``` + +# Basic usage + +A simple example that uses _diagrams-cairo_ to draw a blue circle: + +```haskell +import Diagrams.Prelude +import Diagrams.Backend.Cairo.CmdLine + +d = circle 1 # fc blue + +main = defaultMain (pad 1.1 d) +``` + +Save this to file named `Circle.hs` and compile it: + +``` +ghc --make Circle.hs +``` + +This will generate an executable which, when run, outputs a blue +circle to some file. Run the executable with the `--help` option to +find out more about how to call it. + +``` +$ ./Circle --help +Command-line diagram generation. + +Circle [OPTIONS] + +Common flags: + -w --width=INT Desired width of the output image + -h --height=INT Desired height of the output image + -o --output=FILE Output file + -? --help Display help message + -V --version Print version information +``` + +The output type will be automatically determined from the file +extension. Currently PNG, PDF, PS, and SVG are supported. + +``` +$ ./Circle -o circle.png -w 400 +``` + +The command above generates a PNG file with a width of 400px. + +# Advanced usage + +Instead of just creating a standalone executable, the cairo backend +can also be called from within a larger program. For more +information, see the Diagram.Backend.Cairo module. diff --git a/diagrams-cairo.cabal b/diagrams-cairo.cabal --- a/diagrams-cairo.cabal +++ b/diagrams-cairo.cabal @@ -1,50 +1,68 @@ Name: diagrams-cairo -Version: 0.5.0.2 +Version: 0.6 Synopsis: Cairo backend for diagrams drawing EDSL Description: A full-featured backend for rendering diagrams using the cairo rendering engine. - To get started, see "Diagrams.Backend.Cairo.CmdLine". + . + * "Diagrams.Backend.Cairo.CmdLine" - if you're + just getting started with diagrams, begin here. + . + * "Diagrams.Backend.Cairo" - look at this next. + The general API for the cairo backend. + . + * "Diagrams.Backend.Cairo.Internal" - the + implementation guts of the cairo backend. + Users should normally not need to import this + module. + . + * "Diagrams.Backend.Cairo.Text" - cairo-specific + text support, including automatic bounding + boxes. + . + * "Diagrams.Backend.Cairo.List" - render diagrams + to two-dimensional lists of colors (/i.e./ + pixels). + . + * "Diagrams.Backend.Cairo.Ptr" - render diagrams + to buffers in memory. Homepage: http://projects.haskell.org/diagrams License: BSD3 License-file: LICENSE Author: Brent Yorgey Maintainer: diagrams-discuss@googlegroups.com +Bug-reports: http://github.com/diagrams/diagrams-cairo/issues Category: Graphics Build-type: Simple -Cabal-version: >=1.6 -Extra-source-files: CHANGES, README -Tested-with: GHC == 6.12.3, GHC == 7.0.4, GHC == 7.2.1, GHC == 7.4.1 +Cabal-version: >=1.10 +Extra-source-files: CHANGES.markdown, README.markdown +Tested-with: GHC == 7.2.1, GHC == 7.4.2, GHC == 7.6.1 Source-repository head - type: darcs - location: http://patch-tag.com/r/byorgey/diagrams-cairo + type: git + location: http://github.com/diagrams/diagrams-cairo.git Library Exposed-modules: Diagrams.Backend.Cairo Diagrams.Backend.Cairo.CmdLine - Diagrams.Backend.Cairo.Gtk Diagrams.Backend.Cairo.Internal + Diagrams.Backend.Cairo.List + Diagrams.Backend.Cairo.Ptr Diagrams.Backend.Cairo.Text Hs-source-dirs: src - Build-depends: base >= 4.2 && < 4.6, + Build-depends: base >= 4.2 && < 4.7, mtl >= 2.0 && < 2.2, - process >= 1.0 && < 1.2, - directory >= 1.0 && < 1.2, - filepath >= 1.1 && < 1.4, - old-time >= 1.0 && < 1.2, - diagrams-core >= 0.5 && < 0.6, - diagrams-lib >= 0.5 && < 0.6, - cairo >= 0.10.1 && < 0.13, - cmdargs >= 0.6 && < 0.10, - gtk >= 0.12.0 && < 0.13.0, - split >= 0.1.2 && < 0.2 + process, + directory, + filepath, + old-time, + time, + diagrams-core >= 0.6 && < 0.7, + diagrams-lib >= 0.6 && < 0.7, + cairo >= 0.12.4 && < 0.13, + cmdargs >= 0.6 && < 0.11, + colour, + split >= 0.1.2 && < 0.3 + default-language: Haskell2010 + if !os(windows) cpp-options: -DCMDLINELOOP - Build-depends: unix >= 2.4 && < 2.6 - - if impl(ghc >= 7.2.1 && < 7.4) - Build-depends: cairo >= 0.12.1, - gtk >= 0.12.1 - - if impl(ghc >= 7.4.1) - Build-depends: cairo >= 0.12.3, - gtk >= 0.12.3 + Build-depends: unix >= 2.4 && < 2.7 diff --git a/src/Diagrams/Backend/Cairo.hs b/src/Diagrams/Backend/Cairo.hs --- a/src/Diagrams/Backend/Cairo.hs +++ b/src/Diagrams/Backend/Cairo.hs @@ -10,6 +10,46 @@ -- A full-featured rendering backend for diagrams using the -- cairo rendering engine. -- +-- To invoke the cairo backend, use methods from the +-- 'Diagrams.Core.Types.Backend' instance for @Cairo@. In particular, +-- 'Diagrams.Core.Types.renderDia' has the generic type +-- +-- > renderDia :: b -> Options b v -> QDiagram b v m -> Result b v +-- +-- (omitting a few type class constraints). @b@ represents the +-- backend type, @v@ the vector space, and @m@ the type of monoidal +-- query annotations on the diagram. 'Options' and 'Result' are +-- associated data and type families, respectively, which yield the +-- type of option records and rendering results specific to any +-- particular backend. For @b ~ Cairo@ and @v ~ R2@, we have +-- +-- > data family Options Cairo R2 = CairoOptions +-- > { cairoFileName :: String -- ^ The name of the file you want generated +-- > , cairoSizeSpec :: SizeSpec2D -- ^ The requested size of the output +-- > , cairoOutputType :: OutputType -- ^ the output format and associated options +-- > , cairoBypassAdjust :: Bool -- ^ Should the 'adjustDia' step be bypassed during rendering? +-- > } +-- +-- @ +-- data family Render Cairo R2 = C ('RenderM' ()) +-- @ +-- +-- @ +-- type family Result Cairo R2 = (IO (), 'Graphics.Rendering.Cairo.Render' ()) +-- @ +-- +-- So the type of 'renderDia' resolves to +-- +-- @ +-- renderDia :: Cairo -> Options Cairo R2 -> QDiagram Cairo R2 m -> (IO (), 'Graphics.Rendering.Cairo.Render' ()) +-- @ +-- +-- which you could call like @renderDia Cairo (CairoOptions "foo.png" +-- (Width 250) PNG) myDiagram@. This would return a pair; the first +-- element is an @IO ()@ action which will write out @foo.png@ to +-- disk, and the second is a cairo rendering action which can be used, +-- for example, to directly draw to a Gtk window. +-- ----------------------------------------------------------------------------- module Diagrams.Backend.Cairo @@ -55,6 +95,8 @@ -- -- > renderDia Cairo (CairoOptions "foo.png" (Width 250) PNG) myDiagram -- --- /Important note/: a bug in GHC 7.0.x prevents re-exporting this --- data family. To bring CairoOptions into scope when using GHC 7.0.x --- you must import "Diagrams.Backend.Cairo.Internal". +-- /Important note/: a bug in GHC 7.0.x and 7.4.1 prevents +-- re-exporting this data family. (Strangely, this bug seems to be +-- present in 7.0 and 7.4 but not 7.2.) To bring CairoOptions into +-- scope when using GHC 7.0.x or 7.4 you must import +-- "Diagrams.Backend.Cairo.Internal". diff --git a/src/Diagrams/Backend/Cairo/CmdLine.hs b/src/Diagrams/Backend/Cairo/CmdLine.hs --- a/src/Diagrams/Backend/Cairo/CmdLine.hs +++ b/src/Diagrams/Backend/Cairo/CmdLine.hs @@ -9,6 +9,26 @@ -- Convenient creation of command-line-driven executables for -- rendering diagrams using the cairo backend. -- +-- * 'defaultMain' creates an executable which can render a single +-- diagram at various options. +-- +-- * 'multiMain' is like 'defaultMain' but allows for a list of +-- diagrams from which the user can choose one to render. +-- +-- * 'animMain' is like 'defaultMain' but for animations instead of +-- diagrams. +-- +-- If you want to generate diagrams programmatically---/i.e./ if you +-- want to do anything more complex than what the below functions +-- provide---you have several options. +-- +-- * A simple but somewhat inflexible approach is to wrap up +-- 'defaultMain' (or 'multiMain', or 'animMain') in a call to +-- 'System.Environment.withArgs'. +-- +-- * A more flexible approach is to directly call 'renderDia'; see +-- "Diagrams.Backend.Cairo" for more information. +-- ----------------------------------------------------------------------------- module Diagrams.Backend.Cairo.CmdLine @@ -19,6 +39,7 @@ , Cairo ) where +import Data.List (intercalate) import Diagrams.Prelude hiding (width, height, interval) import Diagrams.Backend.Cairo @@ -33,7 +54,7 @@ import Prelude hiding (catch) import Data.Maybe (fromMaybe) -import Control.Monad (when, forM_) +import Control.Monad (when, forM_, mplus) import Data.List.Split import Text.Printf @@ -45,18 +66,29 @@ import System.IO (openFile, hClose, IOMode(..), hSetBuffering, BufferMode(..), stdout) import System.Exit (ExitCode(..)) -import System.Time (ClockTime, getClockTime) import Control.Concurrent (threadDelay) import Control.Exception (catch, SomeException(..), bracket) #ifdef CMDLINELOOP import System.Posix.Process (executeFile) +#if MIN_VERSION_directory(1,2,0) +import Data.Time.Clock (UTCTime,getCurrentTime) +type ModuleTime = UTCTime +getModuleTime :: IO ModuleTime +getModuleTime = getCurrentTime +#else +import System.Time (ClockTime, getClockTime) +type ModuleTime = ClockTime +getModuleTime :: IO ModuleTime +getModuleTime = getClockTime #endif +#endif data DiagramOpts = DiagramOpts { width :: Maybe Int , height :: Maybe Int , output :: FilePath + , list :: Bool , selection :: Maybe String , fpu :: Double #ifdef CMDLINELOOP @@ -85,6 +117,9 @@ &= help "Name of the diagram to render" &= (if sel then typ "NAME" else ignore) + , list = def + &= (if sel then help "List all available diagrams" else ignore) + , fpu = 30 &= typ "FLOAT" &= help "Frames per unit time (for animations)" @@ -104,20 +139,52 @@ -- | This is the simplest way to render diagrams, and is intended to -- be used like so: -- --- > ... definitions ... +-- > ... other definitions ... +-- > myDiagram = ... -- > -- > main = defaultMain myDiagram -- --- Compiling this file will result in an executable which takes --- various command-line options for setting the size, output file, --- and so on, and renders @myDiagram@ with the specified options. +-- Compiling a source file like the above example will result in an +-- executable which takes command-line options for setting the size, +-- output file, and so on, and renders @myDiagram@ with the +-- specified options. -- -- On Unix systems, the generated executable also supports a -- rudimentary \"looped\" mode, which watches the source file for -- changes and recompiles itself on the fly. -- -- Pass @--help@ to the generated executable to see all available --- options. +-- options. Currently it looks something like +-- +-- @ +-- Command-line diagram generation. +-- +-- Foo [OPTIONS] +-- +-- Common flags: +-- -w --width=INT Desired width of the output image +-- -h --height=INT Desired height of the output image +-- -o --output=FILE Output file +-- -f --fpu=FLOAT Frames per unit time (for animations) +-- -l --loop Run in a self-recompiling loop +-- -s --src=FILE Source file to watch +-- -i --interval=SECONDS When running in a loop, check for changes every n +-- seconds. +-- -? --help Display help message +-- -V --version Print version information +-- @ +-- +-- For example, a couple common scenarios include +-- +-- @ +-- $ ghc --make MyDiagram +-- +-- # output image.png with a width of 400px (and auto-determined height) +-- $ ./MyDiagram -o image.png -w 400 +-- +-- # output 200x200 dia.pdf, then watch for changes every 10 seconds +-- $ ./MyDiagram -o dia.pdf -h 200 -w 200 -l -i 10 +-- @ defaultMain :: Diagram Cairo R2 -> IO () defaultMain d = do @@ -140,49 +207,74 @@ "pdf" -> PDF "svg" -> SVG _ -> PDF - sizeSpec = case (width opts, height opts) of - (Nothing, Nothing) -> Absolute - (Just w, Nothing) -> Width (fromIntegral w) - (Nothing, Just h) -> Height (fromIntegral h) - (Just w, Just h) -> Dims (fromIntegral w) - (fromIntegral h) - fst $ renderDia Cairo (CairoOptions - (output opts) - sizeSpec - outTy - ) - d + fst $ renderDia + Cairo + ( CairoOptions + (output opts) + (mkSizeSpec + (fromIntegral <$> width opts) + (fromIntegral <$> height opts) + ) + outTy + False + ) + d | otherwise -> putStrLn $ "Unknown file type: " ++ last ps -- | @multiMain@ is like 'defaultMain', except instead of a single -- diagram it takes a list of diagrams paired with names as input. --- The generated executable then takes an argument specifying the --- name of the diagram that should be rendered. This is a --- convenient way to create an executable that can render many --- different diagrams without modifying the source code in between --- each one. +-- The generated executable then takes a @--selection@ option +-- specifying the name of the diagram that should be rendered. The +-- list of available diagrams may also be printed by passing the +-- option @--list@. +-- +-- Example usage: +-- +-- @ +-- $ ghc --make MultiTest +-- [1 of 1] Compiling Main ( MultiTest.hs, MultiTest.o ) +-- Linking MultiTest ... +-- $ ./MultiTest --list +-- Available diagrams: +-- foo bar +-- $ ./MultiTest --selection bar -o Bar.png -w 200 +-- @ + multiMain :: [(String, Diagram Cairo R2)] -> IO () multiMain ds = do prog <- getProgName opts <- cmdArgs (diagramOpts prog True) - case selection opts of - Nothing -> putStrLn "No diagram selected." - Just sel -> case lookup sel ds of - Nothing -> putStrLn $ "Unknown diagram: " ++ sel - Just d -> chooseRender opts d + if list opts + then showDiaList (map fst ds) + else + case selection opts of + Nothing -> putStrLn "No diagram selected." >> showDiaList (map fst ds) + Just sel -> case lookup sel ds of + Nothing -> putStrLn $ "Unknown diagram: " ++ sel + Just d -> chooseRender opts d --- | @animMain@ takes an animation and produces a command-line program --- which will crudely \"render\" the animation by rendering one image --- for each frame, named by extending the given output file name by --- consecutive integers. For example if the given output file name --- is @foo\/blah.png@, the frames will be saved in @foo\/blah001.png@, --- @foo\/blah002.png@, and so on (the number of padding digits used --- depends on the total number of frames). It is up to the user to --- take these images and stitch them together into an actual --- animation format (using, /e.g./ @ffmpeg@). +-- | Display the list of diagrams available for rendering. +showDiaList :: [String] -> IO () +showDiaList ds = do + putStrLn "Available diagrams:" + putStrLn $ " " ++ intercalate " " ds + +-- | @animMain@ is like 'defaultMain', but renders an animation +-- instead of a diagram. It takes as input an animation and produces +-- a command-line program which will crudely \"render\" the animation +-- by rendering one image for each frame, named by extending the given +-- output file name by consecutive integers. For example if the given +-- output file name is @foo\/blah.png@, the frames will be saved in +-- @foo\/blah001.png@, @foo\/blah002.png@, and so on (the number of +-- padding digits used depends on the total number of frames). It is +-- up to the user to take these images and stitch them together into +-- an actual animation format (using, /e.g./ @ffmpeg@). -- -- Of course, this is a rather crude method of rendering animations; -- more sophisticated methods will likely be added in the future. +-- +-- The @--fpu@ option can be used to control how many frames will be +-- output for each second (unit time) of animation. animMain :: Animation Cairo R2 -> IO () animMain anim = do prog <- getProgName @@ -202,7 +294,7 @@ (base, ext) = splitExtension (output opts) #ifdef CMDLINELOOP -waitForChange :: Maybe ClockTime -> DiagramOpts -> String -> [String] -> IO () +waitForChange :: Maybe ModuleTime -> DiagramOpts -> String -> [String] -> IO () waitForChange lastAttempt opts prog args = do hSetBuffering stdout NoBuffering go lastAttempt @@ -212,7 +304,7 @@ (newBin, newAttempt) <- recompile lastAtt prog (src opts) if newBin then executeFile prog False args Nothing - else go $ getFirst (First newAttempt <> First lastAtt) + else go $ newAttempt `mplus` lastAtt -- | @recompile t prog@ attempts to recompile @prog@, assuming the -- last attempt was made at time @t@. If @t@ is @Nothing@ assume @@ -222,7 +314,7 @@ -- of this attempt. Otherwise (if nothing has changed since the -- last attempt), return @Nothing@. Also return a Bool saying -- whether a successful recompilation happened. -recompile :: Maybe ClockTime -> String -> Maybe String -> IO (Bool, Maybe ClockTime) +recompile :: Maybe ModuleTime -> String -> Maybe String -> IO (Bool, Maybe ModuleTime) recompile lastAttempt prog mSrc = do let errFile = prog ++ ".errors" srcFile = fromMaybe (prog ++ ".hs") mSrc @@ -239,7 +331,7 @@ then putStrLn "" >> putStrLn (replicate 75 '-') >> readFile errFile >>= putStr else putStrLn "done." - curTime <- getClockTime + curTime <- getModuleTime return (status == ExitSuccess, Just curTime) else return (False, Nothing) diff --git a/src/Diagrams/Backend/Cairo/Gtk.hs b/src/Diagrams/Backend/Cairo/Gtk.hs deleted file mode 100644 --- a/src/Diagrams/Backend/Cairo/Gtk.hs +++ /dev/null @@ -1,70 +0,0 @@ -{-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ --- | --- Module : Diagrams.Backend.Cairo.Gtk --- Copyright : (c) 2011 Diagrams-cairo team (see LICENSE) --- License : BSD-style (see LICENSE) --- Maintainer : diagrams-discuss@googlegroups.com --- --- Convenient interface to rendering diagrams directly --- on Gtk widgets using the Cairo backend. --- ------------------------------------------------------------------------------ - -module Diagrams.Backend.Cairo.Gtk - ( defaultRender - , toGtkCoords - , renderToGtk - ) where - -import Diagrams.Prelude hiding (width, height) -import Diagrams.Backend.Cairo - --- Below hack is needed because GHC 7.0.x has a bug regarding export --- of data family constructors; see comments in Diagrams.Backend.Cairo -#if __GLASGOW_HASKELL__ < 702 || __GLASGOW_HASKELL__ >= 704 -import Diagrams.Backend.Cairo.Internal -#endif - -import Graphics.UI.Gtk - --- | Convert a Diagram to the backend coordinates. --- --- Provided to Query the diagram with coordinates from a mouse click --- event. --- --- > widget `on` buttonPressEvent $ tryEvent $ do --- > click <- eventClick --- > (x,y) <- eventCoordinates --- > let result = runQuery (query $ toGtkCoords myDiagram) (P (x,y)) --- > do_something_with result --- --- `toGtkCoords` does no rescaling of the diagram, however it is centered in --- the window. -toGtkCoords :: Monoid' m => QDiagram Cairo R2 m -> QDiagram Cairo R2 m -toGtkCoords d = snd $ - adjustDia Cairo - (CairoOptions "" Absolute (GTK (undefined :: DrawWindow) False)) - d - --- | Render a diagram to a DrawingArea, rescaling to fit the full area. -defaultRender :: Monoid' m => DrawingArea -> QDiagram Cairo R2 m -> IO () -defaultRender da d = do - (w,h) <- widgetGetSize da - dw <- widgetGetDrawWindow da - fst $ renderDia Cairo (CairoOptions "" (Dims (fromIntegral w) (fromIntegral h)) - (GTK dw False) - ) - d - --- | Render a diagram to a DrawableClass. No rescaling or transformations --- will be performed. --- --- Typically the diagram will already have been transformed by `toGtkCoords`. -renderToGtk :: - (DrawableClass dc, Monoid' m) - => dc -- ^ widget to render onto - -> QDiagram Cairo R2 m -- ^ Diagram - -> IO () -renderToGtk dc d = - fst $ renderDia Cairo (CairoOptions "" Absolute (GTK dc True)) d diff --git a/src/Diagrams/Backend/Cairo/Internal.hs b/src/Diagrams/Backend/Cairo/Internal.hs --- a/src/Diagrams/Backend/Cairo/Internal.hs +++ b/src/Diagrams/Backend/Cairo/Internal.hs @@ -15,22 +15,31 @@ -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- --- Implementation of the diagrams Cairo backend. This module exports the --- internal helper functions, for usage elsewhere. +-- This module contains the internal implementation guts of the +-- diagrams cairo backend. If you want to see how the cairo backend +-- works under the hood, you are in the right place (try clicking on +-- the \"Source\" links). (Guts under the hood, what an awful mixed +-- metaphor.) If you know what you are doing and really want access +-- to the internals of the implementation, you are also in the right +-- place. Otherwise, you should have no need of this module; import +-- "Diagrams.Backend.Cairo.CmdLine" or "Diagrams.Backend.Cairo" +-- instead. -- +-- The one exception is that this module may have to be imported +-- sometimes to work around an apparent bug in certain versions of +-- GHC, which results in a \"not in scope\" error for 'CairoOptions'. +-- ----------------------------------------------------------------------------- module Diagrams.Backend.Cairo.Internal where -import Graphics.Rendering.Diagrams.Transform +import Diagrams.Core.Transform import Diagrams.Prelude import Diagrams.TwoD.Path (Clip(..), getFillRule) import Diagrams.TwoD.Text import Diagrams.TwoD.Image -import Diagrams.TwoD.Adjust (adjustDia2D, adjustSize) - -import Graphics.UI.Gtk (DrawableClass) -import qualified Graphics.UI.Gtk.Cairo as CG +import Diagrams.TwoD.Adjust (adjustDia2D, setDefault2DAttributes) +import Diagrams.TwoD.Size (requiredScaleT) import qualified Graphics.Rendering.Cairo as C import qualified Graphics.Rendering.Cairo.Matrix as CM @@ -46,31 +55,35 @@ import Data.Typeable -- | This data declaration is simply used as a token to distinguish --- this rendering engine. +-- the cairo backend: (1) when calling functions where the type +-- inference engine would otherwise have know way to know which +-- backend you wanted to use, and (2) as an argument to the +-- 'Backend' and 'Renderable' type classes. data Cairo = Cairo deriving (Eq,Ord,Read,Show,Typeable) -- | Output types supported by cairo, including four different file --- types (PNG, PS, PDF, SVG) as well as Gtk windows. +-- types (PNG, PS, PDF, SVG). If you want to output directly to GTK +-- windows, see the diagrams-gtk package. data OutputType = - -- | Output directly to a Gtk window. See "Diagrams.Backends.Cairo.Gtk". - forall dw. (DrawableClass dw) => - GTK { gtkWindow :: dw - -- ^ The window on which to draw. - - , gtkBypass :: Bool - -- ^ Should the 'adjustDia' step be bypassed during rendering? - } - - | PNG -- ^ Portable Network Graphics output. + PNG -- ^ Portable Network Graphics output. | PS -- ^ PostScript output | PDF -- ^ Portable Document Format output. | SVG -- ^ Scalable Vector Graphics output. + | RenderOnly -- ^ Don't output any file; the returned @IO ()@ + -- action will do nothing, but the @Render ()@ action + -- can be used (e.g. to draw to a Gtk window) instance Monoid (Render Cairo R2) where mempty = C $ return () (C rd1) `mappend` (C rd2) = C (rd1 >> rd2) +-- | The custom monad in which intermediate drawing options take +-- place; 'Graphics.Rendering.Cairo.Render' is cairo's own rendering +-- monad. At one point @RenderM@ really did use @StateT@, but then +-- the state got taken out... but the @StateT@ remains, now with a +-- zen-like state of type unit, \"just in case\". Think of it as a +-- good luck charm. type RenderM a = StateT () C.Render a -- no state for now -- simple, stupid implementations of save and restore for now, since @@ -79,9 +92,11 @@ -- implementation using an "undoable state" monad which lets you save -- (push state onto a stack) and restore (pop from the stack). +-- | Push the current context onto a stack. save :: RenderM () save = lift C.save +-- | Restore the context from a stack. restore :: RenderM () restore = lift C.restore @@ -92,6 +107,7 @@ { cairoFileName :: String -- ^ The name of the file you want generated , cairoSizeSpec :: SizeSpec2D -- ^ The requested size of the output , cairoOutputType :: OutputType -- ^ the output format and associated options + , cairoBypassAdjust :: Bool -- ^ Should the 'adjustDia' step be bypassed during rendering? } withStyle _ s t (C r) = C $ do @@ -104,7 +120,7 @@ C.stroke restore - doRender _ (CairoOptions file size out) (C r) = (renderIO, r') + doRender _ (CairoOptions file size out _) (C r) = (renderIO, r') where r' = evalStateT r () renderIO = do let surfaceF s = C.renderWith s r' @@ -120,7 +136,6 @@ Absolute -> (100,100) case out of - GTK win _ -> CG.renderWithDrawable win r' PNG -> C.withImageSurface C.FormatARGB32 (round w) (round h) $ \surface -> do surfaceF surface @@ -128,19 +143,20 @@ PS -> C.withPSSurface file w h surfaceF PDF -> C.withPDFSurface file w h surfaceF SVG -> C.withSVGSurface file w h surfaceF + RenderOnly -> return () - adjustDia c opts d = if bypass (cairoOutputType opts) - then (opts,d) + adjustDia c opts d = if cairoBypassAdjust opts + then (opts, d # setDefault2DAttributes) else adjustDia2D cairoSizeSpec setCairoSizeSpec c opts (d # reflectY) where setCairoSizeSpec sz o = o { cairoSizeSpec = sz } - bypass (GTK _ x) = x - bypass _ = False renderC :: (Renderable a Cairo, V a ~ R2) => a -> RenderM () renderC a = case (render Cairo a) of C r -> r +-- | Handle \"miscellaneous\" style attributes (clip, font stuff, fill +-- color and fill rule). cairoMiscStyle :: Style v -> RenderM () cairoMiscStyle s = sequence_ @@ -172,6 +188,7 @@ fromFontWeight FontWeightNormal = C.FontWeightNormal fromFontWeight FontWeightBold = C.FontWeightBold +-- | Handle style attributes having to do with stroke. cairoStrokeStyle :: Style v -> C.Render () cairoStrokeStyle s = sequence_ @@ -200,6 +217,8 @@ Just d -> a * d +-- | Multiply the current transformation matrix by the given 2D +-- transformation. cairoTransf :: T2 -> C.Render () cairoTransf t = C.transform m where m = CM.Matrix a1 a2 b1 b2 c1 c2 @@ -260,7 +279,7 @@ Right pngSurf -> do w <- C.imageSurfaceGetWidth pngSurf h <- C.imageSurfaceGetHeight pngSurf - cairoTransf $ adjustSize sz (fromIntegral w, fromIntegral h) + cairoTransf $ requiredScaleT sz (fromIntegral w, fromIntegral h) C.setSourceSurface pngSurf (-fromIntegral w / 2) (-fromIntegral h / 2) Left _ -> diff --git a/src/Diagrams/Backend/Cairo/List.hs b/src/Diagrams/Backend/Cairo/List.hs new file mode 100644 --- /dev/null +++ b/src/Diagrams/Backend/Cairo/List.hs @@ -0,0 +1,48 @@ + +----------------------------------------------------------------------------- +-- | +-- Module : Diagrams.Backend.Cairo.List +-- Copyright : (c) 2012 Diagrams-cairo team (see LICENSE) +-- License : BSD-style (see LICENSE) +-- Maintainer : diagrams-discuss@googlegroups.com +-- +-- Render a diagram directly to a list of lists of Colour values +-- (/i.e./ pixels). +-- +----------------------------------------------------------------------------- + +module Diagrams.Backend.Cairo.List where + +import Control.Applicative ((<$>)) +import Control.Exception (bracket) + +import Data.Colour +import Data.Colour.SRGB (sRGB) +import Data.Word (Word8) + +import Diagrams.Prelude (Diagram, R2) +import Diagrams.Backend.Cairo (Cairo) +import Diagrams.Backend.Cairo.Ptr (renderPtr) + +import Foreign.Marshal.Alloc (free) +import Foreign.Marshal.Array (peekArray) + +-- | Render to a regular list of Colour values. + +renderToList :: (Ord a, Floating a) => + Int -> Int -> Diagram Cairo R2 -> IO [[AlphaColour a]] +renderToList w h d = + f 0 <$> bracket (renderPtr w h d) free (peekArray $ w*h*4) + where + f :: (Ord a, Floating a) => Int -> [Word8] -> [[AlphaColour a]] + f _ [] = [] + f n xs | n >= w = [] : f 0 xs + f n (g:b:r:a:xs) = + let l n = fromIntegral n / fromIntegral a + c = sRGB (l r) (l g) (l b) `withOpacity` (fromIntegral a / 255) + + in case f (n+1) xs of + [] -> [[c]] + cs:ys -> (c:cs) : ys + + f _ _ = error "renderToList: Internal format error" diff --git a/src/Diagrams/Backend/Cairo/Ptr.hs b/src/Diagrams/Backend/Cairo/Ptr.hs new file mode 100644 --- /dev/null +++ b/src/Diagrams/Backend/Cairo/Ptr.hs @@ -0,0 +1,55 @@ + +----------------------------------------------------------------------------- +-- | +-- Module : Diagrams.Backend.Cairo.Ptr +-- Copyright : (c) 2012 Diagrams-cairo team (see LICENSE) +-- License : BSD-style (see LICENSE) +-- Maintainer : diagrams-discuss@googlegroups.com +-- +-- Render diagrams to buffers in memory. +-- +----------------------------------------------------------------------------- + +module Diagrams.Backend.Cairo.Ptr where + +import Data.Word (Word8) + +import Diagrams.Prelude (Diagram, R2, SizeSpec2D (..), renderDia) +import Diagrams.Backend.Cairo +import Diagrams.Backend.Cairo.Internal + +import Foreign.ForeignPtr.Safe (ForeignPtr, newForeignPtr) +import Foreign.Marshal.Alloc (finalizerFree) +import Foreign.Marshal.Array (mallocArray, pokeArray) +import Foreign.Ptr (Ptr, castPtr) + +import Graphics.Rendering.Cairo ( Format (..) + , formatStrideForWidth + , renderWith + , withImageSurfaceForData + ) + +-- | Render a diagram to a new buffer in memory, with the format ARGB32. + +renderPtr :: Int -> Int -> Diagram Cairo R2 -> IO (Ptr Word8) +renderPtr w h d = do + let stride = formatStrideForWidth FormatARGB32 w + size = stride * h + opt = CairoOptions + { cairoSizeSpec = Dims (fromIntegral w) (fromIntegral h) + , cairoOutputType = RenderOnly + , cairoBypassAdjust = False + , cairoFileName = "" + } + (_, r) = renderDia Cairo opt d + + b <- mallocArray size + pokeArray b (replicate size 0) + withImageSurfaceForData b FormatARGB32 w h stride (`renderWith` r) + + return (castPtr b) + +-- | Like 'renderPtr' but automatically garbage collected by Haskell. + +renderForeignPtr :: Int -> Int -> Diagram Cairo R2 -> IO (ForeignPtr Word8) +renderForeignPtr w h d = renderPtr w h d >>= newForeignPtr finalizerFree diff --git a/src/Diagrams/Backend/Cairo/Text.hs b/src/Diagrams/Backend/Cairo/Text.hs --- a/src/Diagrams/Backend/Cairo/Text.hs +++ b/src/Diagrams/Backend/Cairo/Text.hs @@ -6,34 +6,30 @@ -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- --- This module provides convenience functions for querying information from --- Cairo. In particular, this provides utilities for information about fonts, --- and creating text primitives with bounds based on the font being used. +-- This module provides convenience functions for querying information +-- from cairo. In particular, this provides utilities for information +-- about fonts, and creating text primitives with bounds based on the +-- font being used. To render text with automatically determined +-- envelopes, use 'textLineBounded', 'textLineBoundedIO', +-- 'textVisualBounded', or 'textVisualBoundedIO'. -- +-- Many of these functions take a 'Style' 'R2' parameter, determining the +-- style to apply to the text before rendering / querying information about +-- the text. These 'Style' 'R2' parameters can be created a variety of ways, +-- but the most direct will likely be by applying style-transforming functions +-- such as 'font', 'fontSize', 'fontSlant', and 'fontWeight' to 'mempty'. +-- This works because there are instances of 'HasStyle' and 'Monoid' for +-- @'Style' v@. +-- ----------------------------------------------------------------------------- module Diagrams.Backend.Cairo.Text ( - -- * Cairo Utilities - queryCairo, unsafeCairo - , StyleParam, cairoWithStyle - - -- * Extents - - -- ** Data Structures - - , TextExtents(..), FontExtents(..) - - -- ** Queries - - , getTextExtents, getFontExtents, getExtents - , kerningCorrectionIO - -- * Primitives -- | These create diagrams instantiated with extents-based envelopes - , textLineBoundedIO, textVisualBoundedIO + textLineBoundedIO, textVisualBoundedIO - -- * Unsafe + -- ** Unsafe -- | These are convenient unsafe variants of the above operations -- postfixed with \"IO\". They should be pretty well-behaved as the @@ -41,6 +37,20 @@ -- (which ought to stay the same during a given execution). , kerningCorrection, textLineBounded, textVisualBounded + + -- * Extents + + -- ** Data Structures + , TextExtents(..), FontExtents(..) + + -- ** Queries + + , getTextExtents, getFontExtents, getExtents + , kerningCorrectionIO + + -- * Utilities + , queryCairo, unsafeCairo + , cairoWithStyle ) where import Diagrams.Backend.Cairo.Internal @@ -60,19 +70,14 @@ unsafeCairo :: C.Render a -> a unsafeCairo = unsafePerformIO . queryCairo --- | Existential type for mutations on objects that \"have style\". This is --- used as a parameter to @getTextExtents@ and @getFontExtents@ in order to --- set font-size and font-face. -type StyleParam = forall a. HasStyle a => a -> a - -- | Executes the given cairo action, with styling applied. -- This does not do all styling - just attributes that are processed by -- \"cairoMiscStyle\", which does clip, fill color, fill rule, and, -- importantly for this module, font face, style, and weight. -cairoWithStyle :: C.Render a -> StyleParam -> C.Render a +cairoWithStyle :: C.Render a -> Style R2 -> C.Render a cairoWithStyle f style = do C.save - evalStateT (cairoMiscStyle (style mempty)) () + evalStateT (cairoMiscStyle style) () result <- f C.restore return result @@ -86,7 +91,7 @@ = TextExtents (r2 (xb,yb)) (r2 (w,h)) (r2 (xa,ya)) -- | Get the extents of a string of text, given a style to render it with. -getTextExtents :: StyleParam -> String -> C.Render TextExtents +getTextExtents :: Style R2 -> String -> C.Render TextExtents getTextExtents style txt = cairoWithStyle (processTextExtents <$> C.textExtents txt) style @@ -101,14 +106,14 @@ = FontExtents a d h (r2 (mx,my)) -- | Gets the intrinsic extents of a font. -getFontExtents :: StyleParam -> C.Render FontExtents +getFontExtents :: Style R2 -> C.Render FontExtents getFontExtents style = cairoWithStyle (processFontExtents <$> C.fontExtents) style -- | Gets both the "FontExtents" and "TextExtents" of the string with the a -- particular style applied. This is more efficient than calling both -- @getFontExtents@ and @getTextExtents@. -getExtents :: StyleParam -> String -> C.Render (FontExtents, TextExtents) +getExtents :: Style R2 -> String -> C.Render (FontExtents, TextExtents) getExtents style str = cairoWithStyle (do fe <- processFontExtents <$> C.fontExtents te <- processTextExtents <$> C.textExtents str @@ -118,7 +123,7 @@ -- | Queries the amount of horizontal offset that needs to be applied in order to -- position the second character properly, in the event that it is @hcat@-ed -- @baselineText@. -kerningCorrectionIO :: StyleParam -> Char -> Char -> IO Double +kerningCorrectionIO :: Style R2 -> Char -> Char -> IO Double kerningCorrectionIO style a b = do let ax t = fst . unr2 . advance <$> queryCairo (getTextExtents style t) l <- ax [a, b] @@ -129,25 +134,25 @@ -- | Creates text diagrams with their envelopes set such that using -- @vcat . map (textLineBounded style)@ stacks them in the way that -- the font designer intended. -textLineBoundedIO :: StyleParam -> String -> IO (Diagram Cairo R2) +textLineBoundedIO :: Style R2 -> String -> IO (Diagram Cairo R2) textLineBoundedIO style str = do (fe, te) <- queryCairo $ getExtents style str let box = fromCorners (p2 (0, negate $ descent fe)) (p2 (fst . unr2 $ advance te, ascent fe)) - return . setEnvelope (getEnvelope box) $ style (baselineText str) + return . setEnvelope (getEnvelope box) . applyStyle style $ baselineText str -- | Creates a text diagram with its envelope set to enclose the glyphs of the text, -- including leading (though not trailing) whitespace. -textVisualBoundedIO :: StyleParam -> String -> IO (Diagram Cairo R2) +textVisualBoundedIO :: Style R2 -> String -> IO (Diagram Cairo R2) textVisualBoundedIO style str = do te <- queryCairo $ getTextExtents style str let box = fromCorners (origin .+^ bearing te) - (origin .+^ bearing te ^+^ (textSize te)) - return . setEnvelope (getEnvelope box) $ style (baselineText str) + ((origin .+^ bearing te) .+^ textSize te) + return . setEnvelope (getEnvelope box) . applyStyle style $ baselineText str -kerningCorrection :: StyleParam -> Char -> Char -> Double +kerningCorrection :: Style R2 -> Char -> Char -> Double kerningCorrection style a = unsafePerformIO . kerningCorrectionIO style a -textLineBounded, textVisualBounded :: StyleParam -> String -> Diagram Cairo R2 -textLineBounded style = unsafePerformIO . textLineBoundedIO style +textLineBounded, textVisualBounded :: Style R2 -> String -> Diagram Cairo R2 +textLineBounded style = unsafePerformIO . textLineBoundedIO style textVisualBounded style = unsafePerformIO . textVisualBoundedIO style