lp-diagrams-svg 1.0 → 1.1

raw patch · 4 files changed

+51/−27 lines, 4 filesdep +gaspsetup-changed

Dependencies added: gasp

Files

• Graphics/Diagrams/Backend/SVGTree.hs +14/−4
• Setup.hs +2/−0
• examples/Main.hs +25/−21
• lp-diagrams-svg.cabal +10/−2

@@ -3,15 +3,25 @@ module Graphics.Diagrams.Backend.SVGTree (renderDiagram, saveDiagram, SvgDiagram) where  import Graphics.Diagrams.Core as D-import Prelude hiding (sum,mapM_,mapM,concatMap)-import Graphics.Svg as S+import Prelude hiding (sum,mapM_,mapM,concatMap,Num(..),(/))+import qualified Prelude+import Graphics.Svg as S hiding (Group) import Control.Monad.RWS import Linear.V2 (V2(..)) import Codec.Picture.Types (PixelRGBA8(..)) import Graphics.Text.TrueType import qualified Data.Vector.Unboxed as V import qualified Data.Map as M+import Algebra.Classes +instance Additive a => Additive (V2 a) where+  a + b = (+) <$> a <*> b+  zero = pure zero++instance Group a => Group (V2 a) where+  a - b = (-) <$> a <*> b+  negate = fmap negate+ -- TODO -- add a newtype so this does not leak to the user code. type SvgM = RWS Font [Path] (V2 Double,V2 Double) @@ -65,8 +75,8 @@         V2 hi'x hi'y = hi + border         border = V2 5 5 -ptToPx :: forall a. Fractional a => a -> a-ptToPx z = 4*z / 3+ptToPx :: forall a. Field a => a -> a+ptToPx z = fromInteger 4*z / fromInteger 3  renderPoint :: FrozenPoint -> V2 Double renderPoint (D.Point x y) = V2 (ptToPx x) (negate $ ptToPx y)

@@ -1,2 +1,4 @@+#!/usr/bin/env runhaskell import Distribution.Simple+main :: IO () main = defaultMain

@@ -1,41 +1,45 @@ import Graphics.Diagrams.SVG-+import Algebra.Classes+import Prelude hiding (Num(..)) -- autoLab s i = do---   o <- labelObj s+--   o <- label s --   -- stroke "red" $ path $ polyline [o # BaseW, o # BaseE] --   -- stroke "blue" $ path $ polygon [o # NW, o # NE, o # SE, o # SW] --   autoLabelObj o i -autoLab = autoLabel+label' x = label x x+autoLabel' x = autoLabel x x  testDiagram :: SvgDiagram () testDiagram = do-  -- draw $ path $ circle (Point 0 0) 5-  a   <- labelObj $ "ha"-  b   <- labelObj $ "b"-  a'  <- draw $ circleShape -- labelObj $ ensureMath $ "c"-  width a' === 15-  b'  <- labelObj $ "b'"-  a'' <- labelObj $ "."-  b'' <- labelObj $ "."+  noOverlap =<< label' "whatever1"+  noOverlap =<< label' "whatever2"+  -- noOverlap =<< label' "whatever3"+  -- noOverlap =<< label' "whatever4"+  a   <- label' $ "ha" -  -- c <- texObj $ ensureMath $ "c"-  -- Center ▸ c === MP.center [E ▸ a'', E ▸ b''] + (20 +: 0)+  b   <- label' $ "b"+  a'  <- draw $ circle "circleEx" -- label $ ensureMath $ "c"+  width a' === constant 15+  b'  <- label' $ "b'"+  a'' <- label' $ "."+  b'' <- label' $ "." -  let width = 70-  vdist b a === 30+  let width = constant 70+  vdist b a === constant 30   hdist a a' === width   hdist a' a'' === width   alignMatrix $ map (map (#Center)) $ [[a,a',a'']                                       ,[b, b',b'']]-  autoLab "aa'" =<< arrow a a'-  autoLab "bb'" =<< arrow b b'-  autoLab "ab" . turn180 =<< arrow a b-  autoLab "a'a''" =<< arrow a' a''-  autoLab "b'b''" =<< arrow b' b''+  noOverlap =<< autoLabel' "aa'" =<< arrow a a'+  noOverlap =<< autoLabel' "bb'" =<< arrow b b'+  noOverlap =<< autoLabel' "ab" . turn180 =<< arrow a b+  noOverlap =<< autoLabel' "a'a''" =<< arrow a' a''+  noOverlap =<< autoLabel' "b'b''" =<< arrow b' b'' +   draw $ do-    autoLab "equal" =<< edge a'' b''+    autoLabel' "equal" =<< edge a'' b''   return ()  main :: IO ()

@@ -1,14 +1,20 @@ name:           lp-diagrams-svg-version:        1.0+version:        1.1 category:       Graphics synopsis:       SVG Backend for lp-diagrams-license:        AGPL-3+license:        GPL license-file:   LICENSE author:         Jean-Philippe Bernardy maintainer:     jeanphilippe.bernardy@gmail.com Cabal-Version:  >= 1.18 build-type:     Simple+description:+  SVG backend for lp-diagrams +source-repository head+  type: git+  location: https://github.com/jyp/lp-diagrams-svg+ Flag example   Description: Compile example.   manual: True@@ -29,6 +35,7 @@                , FontyFruity                , vector                , optparse-applicative+               , gasp   exposed-modules: Graphics.Diagrams.Backend.SVGTree   exposed-modules: Graphics.Diagrams.SVG @@ -48,6 +55,7 @@                , containers                , lens                , FontyFruity+               , gasp                -- , svg-tree                -- , mtl                -- , linear