diagrams-wx (empty) → 0.1.0.0
raw patch · 6 files changed
+278/−0 lines, 6 filesdep +basedep +cairodep +diagrams-cairosetup-changed
Dependencies added: base, cairo, diagrams-cairo, diagrams-lib, diagrams-wx, wx, wxcore
Files
- LICENSE +28/−0
- Setup.hs +2/−0
- demo/Demo.hs +30/−0
- diagrams-wx.cabal +45/−0
- lib/util.c +23/−0
- src/Diagrams/Backend/WX.hs +150/−0
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2016, Michael Smith+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++* Neither the name of liquidhaskell-cabal nor the names of its+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ demo/Demo.hs view
@@ -0,0 +1,30 @@+import Diagrams.Prelude as D+import Diagrams.Backend.Cairo+import Diagrams.Backend.WX++import Graphics.UI.WX as W hiding (circle, (#))+import qualified Graphics.UI.WX.Types as W++main :: IO ()+main = W.start $ do+ f <- W.frame [W.text := "diagrams-wx demo"]+ p <- panel f [on paint := paintDiagram]++ W.set f [ fullRepaintOnResize := False+ , layout := minsize (sz 300 300) $ fill $ widget p+ ]++paintDiagram :: DC a -> Rect -> IO ()+paintDiagram dc rect = drawDiagram dc sampleDiagram pt rs W.white []+ where+ pt = W.Point (rectLeft rect) (rectTop rect)+ rs = dims2D (fromIntegral $ rectWidth rect) (fromIntegral $ rectHeight rect)++sampleDiagram :: QDiagram Cairo V2 Double Any+sampleDiagram = mconcat+ [ circle 0.1 # fc D.green+ , triangle 1 # scale 0.4 # fc D.yellow+ , square 1 # fc D.blue+ , circle 1 # fc D.red+ ]+
+ diagrams-wx.cabal view
@@ -0,0 +1,45 @@+name: diagrams-wx+version: 0.1.0.0+synopsis: Backend for rendering diagrams in wxWidgets+description: An optional add-on to the diagrams-cairo package which+ allows rendering diagrams in wxWidgets (using wxHaskell).+homepage: https://github.com/spinda/diagrams-wx#readme+bug-reports: https://github.com/spinda/diagrams-wx/issues+license: BSD3+license-file: LICENSE+author: Michael Smith+maintainer: Michael Smith <michael@spinda.net>+copyright: 2016 Michael Smith+category: Graphics+build-type: Simple+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Diagrams.Backend.WX+ build-depends: base >= 4.4 && < 5+ , cairo >= 0.12.4 && < 0.14+ , diagrams-cairo >= 1.3 && < 1.4+ , diagrams-lib >= 1.3 && < 1.4+ , wx >= 0.92 && < 0.93+ , wxcore >= 0.92 && < 0.93+ default-language: Haskell2010+ c-sources: lib/util.c++executable diagrams-wx-demo+ hs-source-dirs: demo+ main-is: Demo.hs+ build-depends: base+ , diagrams-wx+ , cairo >= 0.12.4 && < 0.14+ , diagrams-cairo >= 1.3 && < 1.4+ , diagrams-lib >= 1.3 && < 1.4+ , wx >= 0.92 && < 0.93+ , wxcore >= 0.92 && < 0.93+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/spinda/diagrams-wx+
+ lib/util.c view
@@ -0,0 +1,23 @@+#include <stddef.h>+#include <string.h>++void copyCairoToWxWidgets ( float r, float g, float b+ , ptrdiff_t size, unsigned char * cairo+ , unsigned char * wx+ ) {++ unsigned char * cairoEnd = cairo + size;++ while (cairo < cairoEnd) {+ float a1 = (float) cairo[3] / 255;+ float a2 = 1 - a1;++ wx[0] = (unsigned char) ((float) cairo[2] * a1 + r * a2);+ wx[1] = (unsigned char) ((float) cairo[1] * a1 + g * a2);+ wx[2] = (unsigned char) ((float) cairo[0] * a1 + b * a2);++ cairo += 4;+ wx += 3;+ }+}+
+ src/Diagrams/Backend/WX.hs view
@@ -0,0 +1,150 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- | An optional add-on to the+-- <https://hackage.haskell.org/package/diagrams-cairo diagrams-cairo>+-- package which allows rendering diagrams in wxWidgets (using+-- <https://wiki.haskell.org/WxHaskell wxHaskell>).+--+-- wxHaskell doesn't support transparency when drawing 'Image's, so each+-- of these functions takes a 'W.Color' to use as the background color+-- when rendering the 'QDiagram'.+module Diagrams.Backend.WX (+ -- * Drawing to DC+ drawDiagram+ -- * Drawing to uImages+ , withDiagramImage+ , renderDiagramToNewImage+ , renderDiagramToImage+ , ImageSizeException(..)+ ) where++import Control.Exception+import Control.Monad++import Data.Bifunctor+import Data.Typeable++import Diagrams.Prelude+import Diagrams.Backend.Cairo+import Diagrams.Backend.Cairo.Internal++import Graphics.Rendering.Cairo++import Graphics.UI.WX as W hiding (bracket, when)+import Graphics.UI.WX.Draw++import Graphics.UI.WXCore.Image+import Graphics.UI.WXCore.WxcClassesAL+import Graphics.UI.WXCore.WxcClassTypes++import Foreign+import Foreign.C.Types++--------------------------------------------------------------------------------+-- Drawing to DC ---------------------------------------------------------------+--------------------------------------------------------------------------------++-- | Simple interface for drawing a diagram to a 'DC', like 'drawImage'.+--+-- Note that this creates, renders to, draws, and then deletes a+-- new 'Image' instance every invocation. Particularly performance-sensitive+-- users may want to look at using 'renderDiagramToImage' with the same 'Image'+-- instance every repaint.+drawDiagram :: (Monoid b, Semigroup b)+ => DC a+ -> QDiagram Cairo V2 Double b -> W.Point -> SizeSpec V2 Double+ -> W.Color -> [Prop (DC a)] -> IO ()+drawDiagram dc diagram point size bgColor props =+ withDiagramImage diagram size bgColor $ \image ->+ drawImage dc image point props++--------------------------------------------------------------------------------+-- Drawing to Images -----------------------------------------------------------+--------------------------------------------------------------------------------++-- | Safe wrapper around 'renderDiagramToNewImage' that ensures the 'Image'+-- instance is properly deleted when you're done using it.+--+-- > withDiagramImage diagram size =+-- > bracket (renderDiagramToNewImage diagram size) imageDelete+withDiagramImage :: (Monoid b, Semigroup b)+ => QDiagram Cairo V2 Double b -> SizeSpec V2 Double+ -> W.Color -> (Image () -> IO c) -> IO c+withDiagramImage diagram size bgColor =+ bracket (renderDiagramToNewImage diagram size bgColor) imageDelete++-- | Create a new 'Image' of the appropriate size and render the given+-- 'QDiagram' to it with Cairo.+--+-- Make sure 'imageDelete' is called to free the 'Image' instance! Using+-- 'bracket' is recommended to ensure that the 'Image' is still freed in the+-- case of an exception:+--+-- > bracket (renderDiagramToNewImage diagram size) imageDelete doStuffWithImage+--+-- 'withDiagramImage' provides a convenient wrapper for this.+renderDiagramToNewImage :: (Monoid b, Semigroup b)+ => QDiagram Cairo V2 Double b -> SizeSpec V2 Double+ -> W.Color -> IO (Image ())+renderDiagramToNewImage diagram size bgColor = do+ let (w, h) = finalSize size diagram+ image <- imageCreateSized $ sz w h+ renderDiagramToImage' w h diagram bgColor image+ return image++-- | Render a 'QDiagram' to an existing 'Image'. Throws an 'ImageSizeException'+-- if the target 'Image' is too small for the resulting rendered diagram size.+renderDiagramToImage :: (Monoid b, Semigroup b)+ => QDiagram Cairo V2 Double b -> SizeSpec V2 Double+ -> W.Color -> Image i -> IO ()+renderDiagramToImage diagram size bgColor image = do+ let (w, h) = finalSize size diagram+ w' <- imageGetWidth image+ h' <- imageGetHeight image+ when (w' < w || w' < h) $ throw $ ImageSizeException (w, h) (w', h')+ renderDiagramToImage' w h diagram bgColor image++renderDiagramToImage' :: (Monoid b, Semigroup b)+ => Int -> Int -> QDiagram Cairo V2 Double b+ -> W.Color -> Image i -> IO ()+renderDiagramToImage' w h diagram bgColor image = do+ let fmt = FormatARGB32+ let stride = formatStrideForWidth fmt w+ let size = stride * h+ let opt = CairoOptions+ { _cairoSizeSpec = fromIntegral <$> dims2D w h+ , _cairoOutputType = RenderOnly+ , _cairoBypassAdjust = False+ , _cairoFileName = ""+ }+ (_, r) = renderDia Cairo opt diagram++ bracket (callocArray size) free $ \cairoPtr -> do+ withImageSurfaceForData cairoPtr fmt w h stride (`renderWith` r)+ withImageData image $ \wxPtr -> copyCairoToWxWidgets+ (colorRed bgColor) (colorGreen bgColor) (colorBlue bgColor)+ (fromIntegral size) cairoPtr (castPtr wxPtr)++finalSize :: (Monoid b, Semigroup b)+ => SizeSpec V2 Double -> QDiagram Cairo V2 Double b -> (Int, Int)+finalSize size = unr2 . fmap ceiling . fst . sizeAdjustment size . boundingBox++-- | Exception indicating that the target image was the wrong size (too small)+-- for the rendered diagram size.+data ImageSizeException+ -- | @ImageSizeException renderedDiagramSize targetImageSize@+ = ImageSizeException !(Int, Int) !(Int, Int)+ deriving (Show, Typeable)++instance Exception ImageSizeException where+ displayException (ImageSizeException needed avail) =+ "Can't render diagram with output size "+ ++ show needed+ ++ " to image of size "+ ++ show avail++foreign import ccall "util.c copyCairoToWxWidgets"+ copyCairoToWxWidgets :: CFloat -> CFloat -> CFloat+ -> CPtrdiff -> Ptr CUChar -> Ptr CUChar+ -> IO ()+