packages feed

diagrams-hsqml 0.0.0.2 → 0.1.0.0

raw patch · 5 files changed

+59/−48 lines, 5 filesdep ~basedep ~diagrams-coredep ~diagrams-lib

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

Files

diagrams-hsqml.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                diagrams-hsqml-version:             0.0.0.2+version:             0.1.0.0 synopsis:            HsQML (Qt5) backend for Diagrams description:            `diagrams-hsqml` is a `diagrams` backend painting on a QtQuick Canvas.@@ -36,16 +36,24 @@                        Diagrams.Backend.HsQML.Tutorial   -- other-modules:          -- other-extensions:    -  build-depends:       base >=4.7 && <4.8+  build-depends:       base >=4.8 && < 4.9                      , colour                      , containers-                     , diagrams-core-                     , diagrams-lib+                     , diagrams-core >= 1.3+                     , diagrams-lib >= 1.3                      , hsqml                      , lens                      , text                      , transformers   hs-source-dirs:      src   default-language:    Haskell2010-  ghc-options:       -Wall+  ghc-options:       -Wall +  if flag(devel) +    ghc-options: -Werror++Flag devel+  Description: Development settings+  Manual:      True+  Default:     False+
src/Diagrams/Backend/HsQML.hs view
@@ -11,23 +11,22 @@  module Diagrams.Backend.HsQML (     renderHsQML-  , SizeSpec2D(..)+  , SizeSpec   , mkSizeSpec   , HsQML(..), Options(..)   , B   , DiagramObj ) where -import Diagrams.Core.Types(Backend(..)) import Diagrams.Backend.HsQML.Render hiding (renderHsQML) import Diagrams.Backend.HsQML.DiagramObj.Type import Diagrams.Core-import Diagrams.TwoD.Size import Diagrams.TwoD.Types+import Diagrams.Size import Graphics.QML  type B = HsQML -renderHsQML :: SizeSpec2D -> Diagram HsQML R2 -> IO (ObjRef (DiagramObj ()))+renderHsQML :: SizeSpec V2 Double -> Diagram HsQML -> IO (ObjRef (DiagramObj ())) -- ^Render a diagram to a QML object that controls a Canvas. renderHsQML s = renderDia HsQML (HsQMLOptions s)
src/Diagrams/Backend/HsQML/DiagramObj/Commands.hs view
@@ -6,7 +6,7 @@ Maintainer  : marcin.jan.mrotek@gmail.com Stability   : experimental -As 'DiagramObj' is a 'Monoid', complex diagrams may be optained by 'mappend'ing simple ones together.+As 'DiagramObj' is a 'Monoid', complex diagrams may be obtained by 'mappend'ing simple ones together. This module provides functions creating 'DiagramObj's containing a single command each. -} @@ -22,7 +22,7 @@ import Control.Monad.IO.Class import Data.Colour import Data.Colour.SRGB-import Diagrams.Prelude+import Diagrams.Prelude hiding (over) import Diagrams.TwoD.Attributes import Diagrams.TwoD.Text import Graphics.QML@@ -47,7 +47,7 @@ -- ^Connect the current path vertex to the start of the path. closePath = DiagramObj $ fireSignal S.closePath -moveTo :: P2 -> DiagramObj ()+moveTo :: P2 Double -> DiagramObj () -- ^Change the current position. moveTo p = let (x,y) = unp2 p in DiagramObj $ \this -> fireSignal S.moveTo this x y @@ -59,15 +59,15 @@ -- ^Fill the current path. Works only on paths that were previously 'close'd. fill = DiagramObj $ fireSignal S.fill -lineTo :: P2 -> DiagramObj ()+lineTo :: P2 Double -> DiagramObj () -- ^Draw a straight line from the current position to a given point. lineTo p = DiagramObj $ \this -> fireSignal S.lineTo this x y   where (x,y) = unp2 p  bezierCurveTo -  :: P2 -- ^First control point.-  -> P2 -- ^Second control point-  -> P2 -- ^End point.+  :: P2 Double -- ^First control point.+  -> P2 Double -- ^Second control point+  -> P2 Double -- ^End point.    -> DiagramObj ()  -- ^Draw a bezier curve from the current position to a given point, using two control points. bezierCurveTo cp1 cp2 p = DiagramObj $ \this -> @@ -100,9 +100,9 @@ -- ^Set the global alpha (subject to 'save' and 'restore'). setOpacity o = DiagramObj $ \this -> fireSignal S.setGlobalAlpha this (getOpacity o) -setLineWidth :: LineWidth -> DiagramObj ()+setLineWidth :: LineWidth Double -> DiagramObj () -- ^Set the line width (output coordinates assumed).-setLineWidth w = DiagramObj $ \this -> fireSignal S.setLineWidth this (fromOutput $ getLineWidth w)+setLineWidth w = DiagramObj $ \this -> fireSignal S.setLineWidth this (getLineWidth w)  getRGBA :: SomeColor -> (Double, Double, Double, Double) -- ^Convert a colour to a tuple of (r,g,b,a) components.@@ -111,7 +111,7 @@         a = alphaChannel ac         ac = someToAlpha c -getLinearGradient :: LGradient -> DiagramObj (ObjRef GradientObj)+getLinearGradient :: LGradient Double -> DiagramObj (ObjRef GradientObj) -- ^Create a linear gradient. getLinearGradient lg = DiagramObj $ \this -> do     g <- newGradient@@ -120,7 +120,7 @@   where (x0,y0) = unp2.papply (lg^.lGradTrans) $ lg^.lGradStart         (x1,y1) = unp2.papply (lg^.lGradTrans) $ lg^.lGradEnd    -getRadialGradient :: RGradient -> DiagramObj (ObjRef GradientObj)+getRadialGradient :: RGradient Double -> DiagramObj (ObjRef GradientObj) -- ^Create a radial gradient. getRadialGradient rg = DiagramObj $ \this -> do     g <- newGradient@@ -140,7 +140,7 @@ -- ^Set stroke style to a previously assembled gradient. setLineGradient = DiagramObj $ fireSignal S.setLineGradient -setLineTexture :: LineTexture -> DiagramObj ()+setLineTexture :: LineTexture Double -> DiagramObj () -- ^Set stroke style. setLineTexture tex =    case getLineTexture tex of@@ -148,7 +148,7 @@      LG l -> getLinearGradient l >>= liftIO.(setGradient $ l^.lGradStops) >> setLineGradient      RG r -> getRadialGradient r >>= liftIO.(setGradient $ r^.rGradStops) >> setLineGradient -setGradient :: [GradientStop] -> ObjRef GradientObj -> IO ()+setGradient :: [GradientStop Double] -> ObjRef GradientObj -> IO () -- ^Add colour stops to a gradient. setGradient stops grad = forM_ stops     $ \stop -> let (r,g,b,a) = getRGBA (stop^.stopColor)@@ -164,7 +164,7 @@ -- ^Set fill style to a previously defined gradient. setFillGradient = DiagramObj $ fireSignal S.setFillGradient -setFillTexture :: FillTexture -> DiagramObj ()+setFillTexture :: FillTexture Double -> DiagramObj () -- ^Set fill style. setFillTexture tex =    case getFillTexture tex of
src/Diagrams/Backend/HsQML/DiagramObj/Type.hs view
@@ -22,9 +22,7 @@  import Diagrams.Backend.HsQML.DiagramObj.Signals -import Control.Applicative import Control.Monad.IO.Class-import Data.Monoid import Data.Typeable  import Graphics.QML
src/Diagrams/Backend/HsQML/Render.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# OPTIONS_HADDOCK show-extensions #-} {-# LANGUAGE      DeriveDataTypeable@@ -23,11 +24,11 @@ import Diagrams.Backend.HsQML.DiagramObj  import Data.Foldable (foldl', foldMap)-import Control.Lens hiding ((#), from)+import Control.Lens hiding ((#), from, transform, under) import Data.Monoid import Data.Tree import Data.Typeable-import Diagrams.Prelude hiding ((<>), start, moveTo, stroke, text)+import Diagrams.Prelude hiding ((<>), start, moveTo, stroke, text, from) import Diagrams.Core.Types import Diagrams.TwoD.Adjust import Diagrams.TwoD.Attributes(LineTexture, FillTexture) -- imported for haddock hyperlinks@@ -37,25 +38,30 @@  data HsQML = HsQML deriving Typeable -instance Backend HsQML R2 where-  data Render HsQML R2 = HsQMLRender {getObj :: DiagramObj ()}-  type Result HsQML R2 = IO (ObjRef (DiagramObj ()))-  data Options HsQML R2 = HsQMLOptions { _sizeSpec :: SizeSpec2D }+type instance V HsQML = V2+type instance N HsQML = Double++instance Backend HsQML V2 Double where+  data Render HsQML V2 Double = HsQMLRender {getObj :: DiagramObj ()}+  type Result HsQML V2 Double = IO (ObjRef (DiagramObj ()))+  data Options HsQML V2 Double = HsQMLOptions { _sizeSpec :: SizeSpec V2 Double }   renderRTree HsQML opts tree = newObjectDC . getObj $ renderHsQML opts tree-  adjustDia HsQML opts dia = adjustDia2D sizeSpec HsQML opts (dia # reflectY)+  adjustDia HsQML opts dia = (opts', reflectionY <> trans, dia' # scale 0.87 `underT` inv trans)+    where+      (opts', trans, dia') = adjustDia2D sizeSpec HsQML opts $ reflectY dia  sizeSpec -  :: Functor f => (SizeSpec2D -> f SizeSpec2D) -> Options HsQML R2 -> f (Options HsQML R2) --- ^A lens from HsQML backend options to a 'SizeSpec2D'.+  :: Functor f => (SizeSpec V2 Double -> f (SizeSpec V2 Double)) -> Options HsQML V2 Double -> f (Options HsQML V2 Double) +-- ^A lens from HsQML backend options to a 'SizeSpec V2 Double'. -- --- @ sizeSpec :: 'Lens'' ('Options' 'HsQML' 'R2') 'SizeSpec2D' @+-- @ sizeSpec :: 'Lens'' ('Options' 'HsQML' 'V2') ('SizeSpec' 'V2' 'Double') @ sizeSpec = lens (\(HsQMLOptions s) -> s) (\_ s -> HsQMLOptions s) -addAnnotation :: String -> DiagramObj ()+addAnnotation :: Annotation -> DiagramObj () -- ^Currently not supported, returns 'mempty'. addAnnotation _ = mempty -useStyle :: Style R2 -> DiagramObj ()+useStyle :: Style V2 Double -> DiagramObj () {-^ Apply style to a Context2D. Currently supports the following 'Attribute's: @@ -82,22 +88,22 @@     ]   where handle f = fmap f.getAttr -renderHsQML :: Options HsQML R2 -> RTree HsQML R2 Annotation -> Render HsQML R2+renderHsQML :: Options HsQML V2 Double -> RTree HsQML V2 Double Annotation -> Render HsQML V2 Double -- ^Render a 'RTree' to an intermediate representation. renderHsQML opts (Node root ns) =     case root of        RStyle        s  -> HsQMLRender $ save <> useStyle s <> proceed <> restore-       RAnnot (Href  s) -> HsQMLRender $ addAnnotation s <> proceed+       RAnnot        a -> HsQMLRender $ addAnnotation a <> proceed        RPrim         p  -> render HsQML p        REmpty           -> HsQMLRender $ proceed   where     proceed = mconcat $ map (getObj . renderHsQML opts) ns -instance Renderable Text HsQML where-  render HsQML (Text _ t2 _ str) = HsQMLRender $ text str x y +instance Renderable (Text Double) HsQML where+  render HsQML (Text t2 _ str) = HsQMLRender $ text str x y       where (x,y) = unp2 . papply t2 $ origin -renderTrail :: P2 -> Trail R2 -> DiagramObj ()+renderTrail :: P2 Double -> Trail V2 Double -> DiagramObj () -- ^Render a trail, closing loops. renderTrail start trail = mconcat     [ beginPath@@ -114,23 +120,23 @@                                , next)            where next = p .+^ segOffset seg -renderSeg :: P2 -> Segment Closed R2 -> DiagramObj ()+renderSeg :: P2 Double -> Segment Closed V2 Double -> DiagramObj () -- ^Render a closed segment beginning on a given point. renderSeg from (Linear (OffsetClosed v)) = lineTo (from .+^ v) renderSeg from (Cubic c1 c2 (OffsetClosed v)) = bezierCurveTo (from .+^ c1) (from .+^ c2) (from .+^ v)  closeSeg -  :: Segment Open R2 -- ^The last segment of a loop.-  -> P2 -- ^First end.-  -> P2 -- ^Second end.+  :: Segment Open V2 Double -- ^The last segment of a loop.+  -> P2 Double -- ^First end.+  -> P2 Double -- ^Second end.   -> DiagramObj () -- ^Close a loop using the last (open) segment and two endpoints. closeSeg (Linear _) _ start = lineTo start closeSeg (Cubic c1 c2 _) prev start = bezierCurveTo (prev .+^ c1) (prev .+^ c2) start  -instance Renderable (Trail R2) HsQML where+instance Renderable (Trail V2 Double) HsQML where   render HsQML trail = HsQMLRender $ renderTrail origin trail -instance Renderable (Path R2) HsQML where+instance Renderable (Path V2 Double) HsQML where   render HsQML path = HsQMLRender . foldMap (uncurry renderTrail . viewLoc) $ pathTrails path