diff --git a/src/Diagrams/TwoD/Arrow.hs b/src/Diagrams/TwoD/Arrow.hs index 81db36e7..9ad92501 100644 --- a/src/Diagrams/TwoD/Arrow.hs +++ b/src/Diagrams/TwoD/Arrow.hs @@ -228,17 +228,17 @@ lengths f opts = (\h t -> opts & headLength .~ h & tailLength .~ t) <$> f (opts -- color to blue. For more general control over the style of arrowheads, -- see 'headStyle'. headTexture :: TypeableFloat n => Lens' (ArrowOpts n) (Texture n) -headTexture = headStyle . _fillTexture +headTexture = headStyle . atTAttr . anon def (const False) . _FillTexture . committed -- | A lens for setting or modifying the texture of an arrow -- tail. This is *not* a valid lens (see 'committed'). tailTexture :: TypeableFloat n => Lens' (ArrowOpts n) (Texture n) -tailTexture = tailStyle . _fillTexture +tailTexture = tailStyle . atTAttr . anon def (const False) . _FillTexture . committed -- | A lens for setting or modifying the texture of an arrow -- shaft. shaftTexture :: TypeableFloat n => Lens' (ArrowOpts n) (Texture n) -shaftTexture = shaftStyle . _lineTexture +shaftTexture = shaftStyle . atTAttr . anon def (const False) . _LineTexture -- Set the default shaft style of an `ArrowOpts` record by applying the -- default style after all other styles have been applied. diff --git a/src/Diagrams/TwoD/Attributes.hs b/src/Diagrams/TwoD/Attributes.hs index 004e2f0d..2b3cba42 100644 --- a/src/Diagrams/TwoD/Attributes.hs +++ b/src/Diagrams/TwoD/Attributes.hs @@ -362,17 +362,14 @@ fillTexture = applyTAttr . mkFillTexture mkFillTexture :: Texture n -> FillTexture n mkFillTexture = FillTexture . Commit . Last --- | Lens onto the 'Recommend' of a fill texture in a style. -_fillTextureR :: (Typeable n, Floating n) => Lens' (Style V2 n) (Recommend (Texture n)) -_fillTextureR = atTAttr . anon def isDef . _FillTexture - where - isDef (FillTexture (Recommend (Last (SC sc)))) = toAlphaColour sc == transparent - isDef _ = False +-- | Lens onto the possible recommend of a fill texture in a style. +_fillTextureR :: (Typeable n, Floating n) => Lens' (Style V2 n) (Maybe (Recommend (Texture n))) +_fillTextureR = atTAttr . mapping _FillTexture -- | Commit a fill texture in a style. This is *not* a valid lens -- because the resulting texture is always 'Commit' (see 'committed'). -_fillTexture :: (Typeable n, Floating n) => Lens' (Style V2 n) (Texture n) -_fillTexture = _fillTextureR . committed +_fillTexture :: (Typeable n, Floating n) => Lens' (Style V2 n) (Maybe (Texture n)) +_fillTexture = _fillTextureR . mapping committed -- | Set the fill color. This function is polymorphic in the color -- type (so it can be used with either 'Colour' or 'AlphaColour'),