working - no arrows

diagrams-lib.cabal

@@ -55,6 +55,7 @@ Library
                        Diagrams.TwoD.Align,
 --                       Diagrams.TwoD.Arrow,
 --                       Diagrams.TwoD.Arrowheads,
+                       Diagrams.TwoD.Attributes,
                        Diagrams.TwoD.Combinators,
                        Diagrams.TwoD.Deform,
                        Diagrams.TwoD.Transform,

src/Diagrams/Attributes.hs

@@ -39,10 +39,7 @@ module Diagrams.Attributes (
   -- ** Converting colors
   , colorToSRGBA, colorToRGBA
 
-  -- * Lines
-  -- ** Width
-  , LineWidth, getLineWidth, lineWidth, lineWidthA, lw
-
+  -- * Line stuff
   -- ** Cap style
   , LineCap(..), LineCapA, getLineCap, lineCap
 
@@ -55,8 +52,6 @@ module Diagrams.Attributes (
   -- ** Dashing
   , Dashing(..), DashingA, getDashing, dashing
 
-  -- * Measure conversion
-  , toOutput
 
   ) where
 
@@ -69,12 +64,9 @@ import           Data.Maybe            (fromMaybe)
 import           Data.Monoid.Recommend
 import           Data.Semigroup
 import           Data.Typeable
-import           Data.VectorSpace      (magnitude)
 
 import           Diagrams.Core
-import           Diagrams.Core.Compile (mapRTreeStyle)
 import           Diagrams.Core.Style   (setAttr)
-import           Diagrams.Core.Types   (RTree)
 
 ------------------------------------------------------------
 --  Color  -------------------------------------------------
@@ -273,58 +265,9 @@ opacity :: HasStyle a => Double -> a -> a
 opacity = applyAttr . Opacity . Product
 
 ------------------------------------------------------------
---  Lines and stuff    -------------------------------------
+--  Line stuff    -------------------------------------
 ------------------------------------------------------------
 
--- | Line widths specified on child nodes always override line widths
---   specified at parent nodes.
-newtype LineWidth = LineWidth (Last (Measure Double))
-  deriving (Typeable, Semigroup)
-instance AttributeClass LineWidth
-
-geometricScale :: Transformation t -> Double
-geometricScale t = sqrt (w * h)
-  where
-    w = magnitude $ transform t unitX
-    h = magnitude $ transform t unitY
-
---instance Transformable LineWidth where
---  transform t l@(LineWidth (Last (Output w))) = l
---  transform t    LineWidth (Last (Normalized w)) =
-
-instance Default LineWidth where
-    def = LineWidth (Last (Output 1))
-
-getLineWidth :: LineWidth -> (Measure Double)
-getLineWidth (LineWidth (Last w)) = w
-
--- | Set the line (stroke) width.
-lineWidth :: HasStyle a => (Measure Double) -> a -> a
-lineWidth = applyAttr . LineWidth . Last
-
--- | Apply a 'LineWidth' attribute.
-lineWidthA ::  HasStyle a => LineWidth -> a -> a
-lineWidthA = applyAttr
-
--- | A convenient synonym for 'lineWidth'.
-lw :: HasStyle a => (Measure Double) -> a -> a
-lw = lineWidth
-
--- | Convert all of the @LineWidth@ attributes in an @RTree@ to output
---   units. `w` and `h` are the width and height of the final diagram.
---   The scaling factor is the geometric mean of `h` and `w`.
-toOutput :: Double -> Double -> RTree b v () -> RTree b v ()
-toOutput w h tr = mapRTreeStyle f tr
-  where
-    f sty = case getAttr sty of
-              Just (LineWidth (Last (Output t))) -> out t sty
-              Just (LineWidth (Last (Normalized t))) -> out (s*t) sty
-              Just (LineWidth (Last (Local t))) -> out (s*t) sty
-              Just (LineWidth (Last (Global t))) -> out t sty
-              Nothing -> sty
-    out z st = setAttr (LineWidth (Last (Output z))) st
-    s = sqrt (w * h)
-
 -- | What sort of shape should be placed at the endpoints of lines?
 data LineCap = LineCapButt   -- ^ Lines end precisely at their endpoints.
              | LineCapRound  -- ^ Lines are capped with semicircles

src/Diagrams/TwoD.hs

@@ -233,6 +233,12 @@ module Diagrams.TwoD
          -- ** Adjusting size
        , sized, sizedAs
 
+       -- ** Width
+       , LineWidth, getLineWidth, lineWidth, lineWidthA, lw
+
+       -- * Measure conversion
+       , toOutput
+
          -- * Visual aids for understanding the internal model
        , showOrigin
        , showOrigin'
@@ -243,6 +249,7 @@ module Diagrams.TwoD
 
 import           Diagrams.TwoD.Align
 import           Diagrams.TwoD.Arc
+import           Diagrams.TwoD.Attributes
 --import           Diagrams.TwoD.Arrow
 --import           Diagrams.TwoD.Arrowheads
 import           Diagrams.TwoD.Combinators

src/Diagrams/TwoD/Adjust.hs

@@ -24,18 +24,19 @@ module Diagrams.TwoD.Adjust
 
 import Diagrams.Core
 
-import Diagrams.Attributes  (lineWidthA, lineColorA, lineCap
-                            , lineJoin, lineMiterLimitA
-                            )
-import Diagrams.Util        ((#))
+import Diagrams.Attributes      (lineColorA, lineCap
+                                , lineJoin, lineMiterLimitA
+                                )
+import Diagrams.Util            ((#))
 
-import Diagrams.TwoD.Types  (R2, p2)
-import Diagrams.TwoD.Size   ( size2D, center2D, SizeSpec2D(..)
-                            , requiredScaleT, requiredScale
-                            )
-import Diagrams.TwoD.Text   (fontSizeA)
+import Diagrams.TwoD.Attributes (lineWidthA)
+import Diagrams.TwoD.Types      (R2, p2)
+import Diagrams.TwoD.Size       ( size2D, center2D, SizeSpec2D(..)
+                                , requiredScaleT, requiredScale
+                                )
+import Diagrams.TwoD.Text       (fontSizeA)
 
-import Data.AffineSpace     ((.-.))
+import Data.AffineSpace         ((.-.))
 import Data.Semigroup
 
 import Data.Default.Class

src/Diagrams/TwoD/Attributes.hs

@@ -0,0 +1,98 @@
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeFamilies               #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Diagrams.TwoD.Attributes
+-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)
+-- License     :  BSD-style (see LICENSE)
+-- Maintainer  :  diagrams-discuss@googlegroups.com
+--
+-- Diagrams may have /attributes/ which affect the way they are
+-- rendered. This module defines /Textures/ (Gradients and Colors) in two
+-- dimensions. Like the attriubtes defined in the Diagrams.Attributes module,
+-- all attributes defined here use the 'Last' or 'Recommend' /semigroup/ structure.
+-- 'FillColor' and 'LineColor' attributes are provided so that backends that
+-- don't support gradients need not be concerned with using textures. Backends
+-- should only implement color attributes or textures attributes, not both.
+--
+-----------------------------------------------------------------------------
+
+module Diagrams.TwoD.Attributes (
+  -- ** Width
+      LineWidth, getLineWidth, lineWidth, lineWidthA, lw
+
+  -- * Measure conversion
+    , toOutput
+
+    ) where
+
+import           Data.Default.Class
+import           Data.Semigroup
+import           Data.Typeable
+import           Data.VectorSpace      (magnitude)
+
+import           Diagrams.Core
+import           Diagrams.Core.Compile (mapRTreeStyle)
+import           Diagrams.Core.Style   (setAttr)
+import           Diagrams.Core.Types   (RTree)
+import           Diagrams.TwoD.Types   (R2)
+import           Diagrams.TwoD.Vector  (unitX, unitY)
+
+------------------------------------------------------------
+--  Line Width  -------------------------------------------------
+------------------------------------------------------------
+
+-- | Line widths specified on child nodes always override line widths
+--   specified at parent nodes.
+newtype LineWidth = LineWidth (Last (Measure Double))
+  deriving (Typeable, Semigroup)
+instance AttributeClass LineWidth
+
+type instance V LineWidth = R2
+
+-- Estimate the line width scaling based on the geometric mean of the x and y
+-- scaling of the transformation
+geometricScale :: Transformation R2 -> Double -> Double
+geometricScale t w = w * sqrt (x*y)
+  where
+    x = magnitude $ transform t unitX
+    y = magnitude $ transform t unitY
+
+instance Transformable LineWidth where
+  transform t (LineWidth (Last (Local w))) =
+    LineWidth (Last (Local (geometricScale t w)))
+  transform _ l = l
+
+instance Default LineWidth where
+    def = LineWidth (Last (Output 1))
+
+getLineWidth :: LineWidth -> (Measure Double)
+getLineWidth (LineWidth (Last w)) = w
+
+-- | Set the line (stroke) width.
+lineWidth :: (HasStyle a, V a ~ R2) => (Measure Double) -> a -> a
+lineWidth = applyTAttr . LineWidth . Last
+
+-- | Apply a 'LineWidth' attribute.
+lineWidthA ::  (HasStyle a, V a ~ R2) => LineWidth -> a -> a
+lineWidthA = applyTAttr
+
+-- | A convenient synonym for 'lineWidth'.
+lw :: (HasStyle a, V a ~ R2) => (Measure Double) -> a -> a
+lw = lineWidth
+
+-- | Convert all of the @LineWidth@ attributes in an @RTree@ to output
+--   units. `w` and `h` are the width and height of the final diagram.
+--   The scaling factor is the geometric mean of `h` and `w`.
+toOutput :: Double -> Double -> RTree b v () -> RTree b v ()
+toOutput w h tr = mapRTreeStyle f tr
+  where
+    f sty = case getAttr sty of
+              Just (LineWidth (Last (Output t))) -> out t sty
+              Just (LineWidth (Last (Normalized t))) -> out (s*t) sty
+              Just (LineWidth (Last (Local t))) -> out t sty
+              Nothing -> sty
+    out z st = setAttr (LineWidth (Last (Output z))) st
+    s = sqrt (w * h)

src/Diagrams/TwoD/Combinators.hs

@@ -45,20 +45,21 @@ import           Data.VectorSpace
 
 import           Diagrams.Core
 
-import           Diagrams.Attributes     (fc, lw)
+import           Diagrams.Attributes      (fc)
 import           Diagrams.BoundingBox
 import           Diagrams.Combinators
 import           Diagrams.Coordinates
 import           Diagrams.Path
 import           Diagrams.Segment
 import           Diagrams.TrailLike
 import           Diagrams.TwoD.Align
-import           Diagrams.TwoD.Path      ()
+import           Diagrams.TwoD.Attributes (lw)
+import           Diagrams.TwoD.Path       ()
 import           Diagrams.TwoD.Shapes
-import           Diagrams.TwoD.Transform (scaleX, scaleY)
+import           Diagrams.TwoD.Transform  (scaleX, scaleY)
 import           Diagrams.TwoD.Types
-import           Diagrams.TwoD.Vector    (fromDirection, unitX, unitY)
-import           Diagrams.Util           (( # ))
+import           Diagrams.TwoD.Vector     (fromDirection, unitX, unitY)
+import           Diagrams.Util            (( # ))
 
 
 infixl 6 ===

src/Diagrams/TwoD/Model.hs

@@ -25,6 +25,7 @@ import           Control.Lens          (makeLenses, (^.))
 import           Diagrams.Core
 import           Diagrams.Attributes
 import           Diagrams.Path
+import           Diagrams.TwoD.Attributes
 import           Diagrams.TwoD.Ellipse
 import           Diagrams.TwoD.Path
 import           Diagrams.TwoD.Size    (size2D)