diff --git a/src/Diagrams/Attributes.hs b/src/Diagrams/Attributes.hs index 99dff242..eac42d4d 100644 --- a/src/Diagrams/Attributes.hs +++ b/src/Diagrams/Attributes.hs @@ -51,9 +51,6 @@ module Diagrams.Attributes ( -- ** Miter limit , LineMiterLimit(..), getLineMiterLimit, lineMiterLimit, lineMiterLimitA - -- ** Dashing - , Dashing(..), DashingA, getDashing, dashing - -- * Compilation utilities , splitFills @@ -342,28 +339,6 @@ lineMiterLimit = applyAttr . LineMiterLimit . Last -- | Apply a 'LineMiterLimit' attribute. lineMiterLimitA :: HasStyle a => LineMiterLimit -> a -> a lineMiterLimitA = applyAttr - --- | Create lines that are dashing... er, dashed. -data Dashing = Dashing [Double] Double - deriving (Typeable, Eq) - -newtype DashingA = DashingA (Last Dashing) - deriving (Typeable, Semigroup, Eq) -instance AttributeClass DashingA - -getDashing :: DashingA -> Dashing -getDashing (DashingA (Last d)) = d - --- | Set the line dashing style. -dashing :: HasStyle a => - [Double] -- ^ A list specifying alternate lengths of on - -- and off portions of the stroke. The empty - -- list indicates no dashing. - -> Double -- ^ An offset into the dash pattern at which the - -- stroke should start. - -> a -> a -dashing ds offs = applyAttr (DashingA (Last (Dashing ds offs))) - ------------------------------------------------------------ data FillLoops v = FillLoops diff --git a/src/Diagrams/TwoD.hs b/src/Diagrams/TwoD.hs index dcaa4ac9..4621ce09 100644 --- a/src/Diagrams/TwoD.hs +++ b/src/Diagrams/TwoD.hs @@ -233,6 +233,9 @@ module Diagrams.TwoD , LineWidth, getLineWidth, lineWidth, lineWidthA, lw, lwN, lwO, lwL , ultraThin, veryThin, thin, medium, thick, veryThick + -- ** Dashing + , Dashing(..), DashingA, getDashing, dashing + -- * Visual aids for understanding the internal model , showOrigin , showOrigin' diff --git a/src/Diagrams/TwoD/Attributes.hs b/src/Diagrams/TwoD/Attributes.hs index 8f4f9f22..35748b1f 100644 --- a/src/Diagrams/TwoD/Attributes.hs +++ b/src/Diagrams/TwoD/Attributes.hs @@ -25,6 +25,9 @@ module Diagrams.TwoD.Attributes ( , lw, lwN, lwO, lwL , ultraThin, veryThin, thin, medium, thick, veryThick + -- ** Dashing + , Dashing(..), DashingA, getDashing, dashing + ) where import Data.Data @@ -90,3 +93,36 @@ thin = lwO 1 medium = lwO 2 thick = lwO 4 veryThick = lwO 5 + +------------------------------------------------------------ + +-- | Create lines that are dashing... er, dashed. +data Dashing = Dashing [Measure Double] (Measure Double) + deriving (Typeable, Data, Eq) + +newtype DashingA = DashingA (Last Dashing) + deriving (Typeable, Data, Semigroup, Eq) +instance AttributeClass DashingA + +type instance V DashingA = R2 + +instance Transformable DashingA where + transform t (DashingA (Last (Dashing [Local w] (Local v)))) = + DashingA (Last (Dashing [Local r] (Local s))) + where + r = avgScale t * w + s = avgScale t * v + transform _ l = l + +getDashing :: DashingA -> Dashing +getDashing (DashingA (Last d)) = d + +-- | Set the line dashing style. +dashing :: (HasStyle a, V a ~ R2) => + [Measure Double] -- ^ A list specifying alternate lengths of on + -- and off portions of the stroke. The empty + -- list indicates no dashing. + -> Measure Double -- ^ An offset into the dash pattern at which the + -- stroke should start. + -> a -> a +dashing ds offs = applyGTAttr (DashingA (Last (Dashing ds offs)))