{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.TwoD.Attributes
-- Copyright   :  (c) 2013-2015 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 attributes 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 (
  -- * Textures
    Texture(..), solid, _SC, _AC, _LG, _RG, defaultLG, defaultRG
  , GradientStop(..), stopColor, stopFraction, mkStops
  , SpreadMethod(..), lineLGradient, lineRGradient

  -- ** Linear Gradients
  , LGradient(..), lGradStops, lGradTrans, lGradStart, lGradEnd
  , lGradSpreadMethod, mkLinearGradient

  -- ** Radial Gradients
  , RGradient(..), rGradStops, rGradTrans
  , rGradCenter0, rGradRadius0, rGradCenter1, rGradRadius1
  , rGradSpreadMethod, mkRadialGradient

  -- ** Line texture
  , LineTexture(..), _LineTexture, getLineTexture, lineTexture, lineTextureA
  , mkLineTexture, _lineTexture

  -- ** Line color
  , lineColor, lc, lcA

  -- ** Fill texture
  , FillTexture(..), _FillTexture, getFillTexture, fillTexture
  , mkFillTexture, _fillTexture, _fillTextureR

  -- ** Fill color
  , fillColor, fc, fcA, recommendFillColor

  -- * Compilation utilities
  , splitTextureFills

  ) where

import           Control.Lens                hiding (transform)
import           Data.Colour                 hiding (AffineSpace, over)
import           Data.Data
import           Data.Default.Class
import           Data.Monoid.Recommend
import           Data.Semigroup

import           Diagrams.Attributes
import           Diagrams.Attributes.Compile
import           Diagrams.Core
import           Diagrams.Core.Types         (RTree)
import           Diagrams.Located            (unLoc)
import           Diagrams.Path               (Path, pathTrails)
import           Diagrams.Trail              (isLoop)
import           Diagrams.TwoD.Types
import           Diagrams.Util


-----------------------------------------------------------------
--  Gradients  --------------------------------------------------
-----------------------------------------------------------------

-- | A gradient stop contains a color and fraction (usually between 0 and 1)
data GradientStop d = GradientStop
  { forall d. GradientStop d -> SomeColor
_stopColor    :: SomeColor
  , forall d. GradientStop d -> d
_stopFraction :: d
  }

makeLensesWith (lensRules & generateSignatures .~ False) ''GradientStop

-- | A color for the stop.
stopColor :: Lens' (GradientStop n) SomeColor

-- | The fraction for stop.
stopFraction :: Lens' (GradientStop n) n

-- | The 'SpreadMethod' determines what happens before 'lGradStart' and after
--   'lGradEnd'. 'GradPad' fills the space before the start of the gradient
--   with the color of the first stop and the color after end of the gradient
--   with the color of the last stop. 'GradRepeat' restarts the gradient and
--   'GradReflect' restarts the gradient with the stops in reverse order.
data SpreadMethod = GradPad | GradReflect | GradRepeat

-- | Linear Gradient
data LGradient n = LGradient
  { forall n. LGradient n -> [GradientStop n]
_lGradStops        :: [GradientStop n]
  , forall n. LGradient n -> Point V2 n
_lGradStart        :: Point V2 n
  , forall n. LGradient n -> Point V2 n
_lGradEnd          :: Point V2 n
  , forall n. LGradient n -> Transformation V2 n
_lGradTrans        :: Transformation V2 n
  , forall n. LGradient n -> SpreadMethod
_lGradSpreadMethod :: SpreadMethod }

type instance V (LGradient n) = V2
type instance N (LGradient n) = n

makeLensesWith (lensRules & generateSignatures .~ False) ''LGradient

instance Fractional n => Transformable (LGradient n) where
  transform :: Transformation (V (LGradient n)) (N (LGradient n))
-> LGradient n -> LGradient n
transform = ASetter
  (LGradient n)
  (LGradient n)
  (Transformation V2 n)
  (Transformation V2 n)
-> (Transformation V2 n -> Transformation V2 n)
-> LGradient n
-> LGradient n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (LGradient n)
  (LGradient n)
  (Transformation V2 n)
  (Transformation V2 n)
forall n (f :: * -> *).
Functor f =>
(Transformation V2 n -> f (Transformation V2 n))
-> LGradient n -> f (LGradient n)
lGradTrans ((Transformation V2 n -> Transformation V2 n)
 -> LGradient n -> LGradient n)
-> (Transformation V2 n
    -> Transformation V2 n -> Transformation V2 n)
-> Transformation V2 n
-> LGradient n
-> LGradient n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transformation (V (Transformation V2 n)) (N (Transformation V2 n))
-> Transformation V2 n -> Transformation V2 n
Transformation V2 n -> Transformation V2 n -> Transformation V2 n
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform

-- | A list of stops (colors and fractions).
lGradStops :: Lens' (LGradient n) [GradientStop n]

-- | A transformation to be applied to the gradient. Usually this field will
--   start as the identity transform and capture the transforms that are applied
--   to the gradient.
lGradTrans :: Lens' (LGradient n) (Transformation V2 n)

-- | The starting point for the first gradient stop. The coordinates are in
--   'local' units and the default is (-0.5, 0).
lGradStart :: Lens' (LGradient n) (Point V2 n)

-- | The ending point for the last gradient stop.The coordinates are in
--   'local' units and the default is (0.5, 0).
lGradEnd :: Lens' (LGradient n) (Point V2 n)

-- | For setting the spread method.
lGradSpreadMethod :: Lens' (LGradient n) SpreadMethod

-- | Radial Gradient
data RGradient n = RGradient
  { forall n. RGradient n -> [GradientStop n]
_rGradStops        :: [GradientStop n]
  , forall n. RGradient n -> Point V2 n
_rGradCenter0      :: Point V2 n
  , forall n. RGradient n -> n
_rGradRadius0      :: n
  , forall n. RGradient n -> Point V2 n
_rGradCenter1      :: Point V2 n
  , forall n. RGradient n -> n
_rGradRadius1      :: n
  , forall n. RGradient n -> Transformation V2 n
_rGradTrans        :: Transformation V2 n
  , forall n. RGradient n -> SpreadMethod
_rGradSpreadMethod :: SpreadMethod }

makeLensesWith (lensRules & generateSignatures .~ False) ''RGradient

type instance V (RGradient n) = V2
type instance N (RGradient n) = n

instance Fractional n => Transformable (RGradient n) where
  transform :: Transformation (V (RGradient n)) (N (RGradient n))
-> RGradient n -> RGradient n
transform = ASetter
  (RGradient n)
  (RGradient n)
  (Transformation V2 n)
  (Transformation V2 n)
-> (Transformation V2 n -> Transformation V2 n)
-> RGradient n
-> RGradient n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (RGradient n)
  (RGradient n)
  (Transformation V2 n)
  (Transformation V2 n)
forall n (f :: * -> *).
Functor f =>
(Transformation V2 n -> f (Transformation V2 n))
-> RGradient n -> f (RGradient n)
rGradTrans ((Transformation V2 n -> Transformation V2 n)
 -> RGradient n -> RGradient n)
-> (Transformation V2 n
    -> Transformation V2 n -> Transformation V2 n)
-> Transformation V2 n
-> RGradient n
-> RGradient n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transformation (V (Transformation V2 n)) (N (Transformation V2 n))
-> Transformation V2 n -> Transformation V2 n
Transformation V2 n -> Transformation V2 n -> Transformation V2 n
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform

-- | A list of stops (colors and fractions).
rGradStops :: Lens' (RGradient n) [GradientStop n]

-- | The center point of the inner circle.
rGradCenter0 :: Lens' (RGradient n) (Point V2 n)

-- | The radius of the inner cirlce in 'local' coordinates.
rGradRadius0 :: Lens' (RGradient n) n

-- | The center of the outer circle.
rGradCenter1  :: Lens' (RGradient n) (Point V2 n)

-- | The radius of the outer circle in 'local' coordinates.
rGradRadius1 :: Lens' (RGradient n) n

-- | A transformation to be applied to the gradient. Usually this field will
--   start as the identity transform and capture the transforms that are applied
--   to the gradient.
rGradTrans :: Lens' (RGradient n) (Transformation V2 n)

-- | For setting the spread method.
rGradSpreadMethod :: Lens' (RGradient n) SpreadMethod

-----------------------------------------------------------------
--  Textures  ---------------------------------------------------
-----------------------------------------------------------------

-- | A Texture is either a color 'SC', linear gradient 'LG', or radial gradient 'RG'.
--   An object can have only one texture which is determined by the 'Last'
--   semigroup structure.
data Texture n = SC SomeColor | LG (LGradient n) | RG (RGradient n)
  deriving Typeable

type instance V (Texture n) = V2
type instance N (Texture n) = n

makePrisms ''Texture

-- | Prism onto an 'AlphaColour' 'Double' of a 'SC' texture.
_AC :: Prism' (Texture n) (AlphaColour Double)
_AC :: forall n (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (AlphaColour Double) (f (AlphaColour Double))
-> p (Texture n) (f (Texture n))
_AC = p SomeColor (f SomeColor) -> p (Texture n) (f (Texture n))
forall n (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p SomeColor (f SomeColor) -> p (Texture n) (f (Texture n))
_SC (p SomeColor (f SomeColor) -> p (Texture n) (f (Texture n)))
-> (p (AlphaColour Double) (f (AlphaColour Double))
    -> p SomeColor (f SomeColor))
-> p (AlphaColour Double) (f (AlphaColour Double))
-> p (Texture n) (f (Texture n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (AlphaColour Double) (f (AlphaColour Double))
-> p SomeColor (f SomeColor)
Iso' SomeColor (AlphaColour Double)
_SomeColor

instance Floating n => Transformable (Texture n) where
  transform :: Transformation (V (Texture n)) (N (Texture n))
-> Texture n -> Texture n
transform Transformation (V (Texture n)) (N (Texture n))
t (LG LGradient n
lg) = LGradient n -> Texture n
forall n. LGradient n -> Texture n
LG (LGradient n -> Texture n) -> LGradient n -> Texture n
forall a b. (a -> b) -> a -> b
$ Transformation (V (LGradient n)) (N (LGradient n))
-> LGradient n -> LGradient n
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation (V (LGradient n)) (N (LGradient n))
Transformation (V (Texture n)) (N (Texture n))
t LGradient n
lg
  transform Transformation (V (Texture n)) (N (Texture n))
t (RG RGradient n
rg) = RGradient n -> Texture n
forall n. RGradient n -> Texture n
RG (RGradient n -> Texture n) -> RGradient n -> Texture n
forall a b. (a -> b) -> a -> b
$ Transformation (V (RGradient n)) (N (RGradient n))
-> RGradient n -> RGradient n
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation (V (RGradient n)) (N (RGradient n))
Transformation (V (Texture n)) (N (Texture n))
t RGradient n
rg
  transform Transformation (V (Texture n)) (N (Texture n))
_ Texture n
sc      = Texture n
sc

-- | Convert a solid colour into a texture.
solid :: Color a => a -> Texture n
solid :: forall a n. Color a => a -> Texture n
solid = SomeColor -> Texture n
forall n. SomeColor -> Texture n
SC (SomeColor -> Texture n) -> (a -> SomeColor) -> a -> Texture n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SomeColor
forall c. Color c => c -> SomeColor
SomeColor

-- | A default is provided so that linear gradients can easily be created using
--   lenses. For example, @lg = defaultLG & lGradStart .~ (0.25 ^& 0.33)@. Note that
--   no default value is provided for @lGradStops@, this must be set before
--   the gradient value is used, otherwise the object will appear transparent.
defaultLG :: Fractional n => Texture n
defaultLG :: forall n. Fractional n => Texture n
defaultLG = LGradient n -> Texture n
forall n. LGradient n -> Texture n
LG LGradient
  { _lGradStops :: [GradientStop n]
_lGradStops        = []
  , _lGradStart :: Point V2 n
_lGradStart        = n -> n -> Point V2 n
forall n. n -> n -> P2 n
mkP2 (-n
0.5) n
0
  , _lGradEnd :: Point V2 n
_lGradEnd          = n -> n -> Point V2 n
forall n. n -> n -> P2 n
mkP2 n
0.5 n
0
  , _lGradTrans :: Transformation V2 n
_lGradTrans        = Transformation V2 n
forall a. Monoid a => a
mempty
  , _lGradSpreadMethod :: SpreadMethod
_lGradSpreadMethod = SpreadMethod
GradPad
  }

-- | A default is provided so that radial gradients can easily be created using
--   lenses. For example, @rg = defaultRG & rGradRadius1 .~ 0.25@. Note that
--   no default value is provided for @rGradStops@, this must be set before
--   the gradient value is used, otherwise the object will appear transparent.
defaultRG :: Fractional n => Texture n
defaultRG :: forall n. Fractional n => Texture n
defaultRG = RGradient n -> Texture n
forall n. RGradient n -> Texture n
RG RGradient
  { _rGradStops :: [GradientStop n]
_rGradStops        = []
  , _rGradCenter0 :: Point V2 n
_rGradCenter0      = n -> n -> Point V2 n
forall n. n -> n -> P2 n
mkP2 n
0 n
0
  , _rGradRadius0 :: n
_rGradRadius0      = n
0.0
  , _rGradCenter1 :: Point V2 n
_rGradCenter1      = n -> n -> Point V2 n
forall n. n -> n -> P2 n
mkP2 n
0 n
0
  , _rGradRadius1 :: n
_rGradRadius1      = n
0.5
  , _rGradTrans :: Transformation V2 n
_rGradTrans        = Transformation V2 n
forall a. Monoid a => a
mempty
  , _rGradSpreadMethod :: SpreadMethod
_rGradSpreadMethod = SpreadMethod
GradPad
  }

-- | A convenient function for making gradient stops from a list of triples.
--   (An opaque color, a stop fraction, an opacity).
mkStops :: [(Colour Double, d, Double)] -> [GradientStop d]
mkStops :: forall d. [(Colour Double, d, Double)] -> [GradientStop d]
mkStops = ((Colour Double, d, Double) -> GradientStop d)
-> [(Colour Double, d, Double)] -> [GradientStop d]
forall a b. (a -> b) -> [a] -> [b]
map (\(Colour Double
x, d
y, Double
z) -> SomeColor -> d -> GradientStop d
forall d. SomeColor -> d -> GradientStop d
GradientStop (AlphaColour Double -> SomeColor
forall c. Color c => c -> SomeColor
SomeColor (Colour Double -> Double -> AlphaColour Double
forall a. Num a => Colour a -> a -> AlphaColour a
withOpacity Colour Double
x Double
z)) d
y)

-- | Make a linear gradient texture from a stop list, start point, end point,
--   and 'SpreadMethod'. The 'lGradTrans' field is set to the identity
--   transfrom, to change it use the 'lGradTrans' lens.
mkLinearGradient :: Num n => [GradientStop n] -> Point V2 n -> Point V2 n -> SpreadMethod -> Texture n
mkLinearGradient :: forall n.
Num n =>
[GradientStop n]
-> Point V2 n -> Point V2 n -> SpreadMethod -> Texture n
mkLinearGradient [GradientStop n]
stops  Point V2 n
start Point V2 n
end SpreadMethod
spreadMethod
  = LGradient n -> Texture n
forall n. LGradient n -> Texture n
LG ([GradientStop n]
-> Point V2 n
-> Point V2 n
-> Transformation V2 n
-> SpreadMethod
-> LGradient n
forall n.
[GradientStop n]
-> Point V2 n
-> Point V2 n
-> Transformation V2 n
-> SpreadMethod
-> LGradient n
LGradient [GradientStop n]
stops Point V2 n
start Point V2 n
end Transformation V2 n
forall a. Monoid a => a
mempty SpreadMethod
spreadMethod)

-- | Make a radial gradient texture from a stop list, radius, start point,
--   end point, and 'SpreadMethod'. The 'rGradTrans' field is set to the identity
--   transfrom, to change it use the 'rGradTrans' lens.
mkRadialGradient :: Num n => [GradientStop n] -> Point V2 n -> n
                  -> Point V2 n -> n -> SpreadMethod -> Texture n
mkRadialGradient :: forall n.
Num n =>
[GradientStop n]
-> Point V2 n -> n -> Point V2 n -> n -> SpreadMethod -> Texture n
mkRadialGradient [GradientStop n]
stops Point V2 n
c0 n
r0 Point V2 n
c1 n
r1 SpreadMethod
spreadMethod
  = RGradient n -> Texture n
forall n. RGradient n -> Texture n
RG ([GradientStop n]
-> Point V2 n
-> n
-> Point V2 n
-> n
-> Transformation V2 n
-> SpreadMethod
-> RGradient n
forall n.
[GradientStop n]
-> Point V2 n
-> n
-> Point V2 n
-> n
-> Transformation V2 n
-> SpreadMethod
-> RGradient n
RGradient [GradientStop n]
stops Point V2 n
c0 n
r0 Point V2 n
c1 n
r1 Transformation V2 n
forall a. Monoid a => a
mempty SpreadMethod
spreadMethod)

-- Line Texture --------------------------------------------------------

-- | The texture with which lines are drawn.  Note that child
--   textures always override parent textures.
--   More precisely, the semigroup structure on line texture attributes
--   is that of 'Last'.
newtype LineTexture n = LineTexture (Last (Texture n))
  deriving (Typeable, NonEmpty (LineTexture n) -> LineTexture n
LineTexture n -> LineTexture n -> LineTexture n
(LineTexture n -> LineTexture n -> LineTexture n)
-> (NonEmpty (LineTexture n) -> LineTexture n)
-> (forall b. Integral b => b -> LineTexture n -> LineTexture n)
-> Semigroup (LineTexture n)
forall b. Integral b => b -> LineTexture n -> LineTexture n
forall n. NonEmpty (LineTexture n) -> LineTexture n
forall n. LineTexture n -> LineTexture n -> LineTexture n
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall n b. Integral b => b -> LineTexture n -> LineTexture n
$c<> :: forall n. LineTexture n -> LineTexture n -> LineTexture n
<> :: LineTexture n -> LineTexture n -> LineTexture n
$csconcat :: forall n. NonEmpty (LineTexture n) -> LineTexture n
sconcat :: NonEmpty (LineTexture n) -> LineTexture n
$cstimes :: forall n b. Integral b => b -> LineTexture n -> LineTexture n
stimes :: forall b. Integral b => b -> LineTexture n -> LineTexture n
Semigroup)
instance (Typeable n) => AttributeClass (LineTexture n)

type instance V (LineTexture n) = V2
type instance N (LineTexture n) = n

_LineTexture :: Iso (LineTexture n) (LineTexture n')
                    (Texture n)     (Texture n')
_LineTexture :: forall n n' (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Texture n) (f (Texture n'))
-> p (LineTexture n) (f (LineTexture n'))
_LineTexture = (LineTexture n -> Texture n)
-> (Texture n' -> LineTexture n')
-> Iso (LineTexture n) (LineTexture n') (Texture n) (Texture n')
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso LineTexture n -> Texture n
forall n. LineTexture n -> Texture n
getLineTexture (Last (Texture n') -> LineTexture n'
forall n. Last (Texture n) -> LineTexture n
LineTexture (Last (Texture n') -> LineTexture n')
-> (Texture n' -> Last (Texture n'))
-> Texture n'
-> LineTexture n'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Texture n' -> Last (Texture n')
forall a. a -> Last a
Last)

-- Only gradients get transformed. The transform is applied to the gradients
-- transform field. Colors are left unchanged.
instance Floating n => Transformable (LineTexture n) where
  transform :: Transformation (V (LineTexture n)) (N (LineTexture n))
-> LineTexture n -> LineTexture n
transform Transformation (V (LineTexture n)) (N (LineTexture n))
t (LineTexture (Last Texture n
tx)) = Last (Texture n) -> LineTexture n
forall n. Last (Texture n) -> LineTexture n
LineTexture (Texture n -> Last (Texture n)
forall a. a -> Last a
Last (Texture n -> Last (Texture n)) -> Texture n -> Last (Texture n)
forall a b. (a -> b) -> a -> b
$ Transformation (V (Texture n)) (N (Texture n))
-> Texture n -> Texture n
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation (V (Texture n)) (N (Texture n))
Transformation (V (LineTexture n)) (N (LineTexture n))
t Texture n
tx)

instance Default (LineTexture n) where
  def :: LineTexture n
def = Tagged (Texture n) (Identity (Texture n))
-> Tagged (LineTexture n) (Identity (LineTexture n))
forall n n' (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Texture n) (f (Texture n'))
-> p (LineTexture n) (f (LineTexture n'))
_LineTexture (Tagged (Texture n) (Identity (Texture n))
 -> Tagged (LineTexture n) (Identity (LineTexture n)))
-> (Tagged SomeColor (Identity SomeColor)
    -> Tagged (Texture n) (Identity (Texture n)))
-> Tagged SomeColor (Identity SomeColor)
-> Tagged (LineTexture n) (Identity (LineTexture n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged SomeColor (Identity SomeColor)
-> Tagged (Texture n) (Identity (Texture n))
forall n (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p SomeColor (f SomeColor) -> p (Texture n) (f (Texture n))
_SC (Tagged SomeColor (Identity SomeColor)
 -> Tagged (LineTexture n) (Identity (LineTexture n)))
-> SomeColor -> LineTexture n
forall t b. AReview t b -> b -> t
## Colour Double -> SomeColor
forall c. Color c => c -> SomeColor
SomeColor Colour Double
forall a. Num a => Colour a
black

mkLineTexture :: Texture n -> LineTexture n
mkLineTexture :: forall n. Texture n -> LineTexture n
mkLineTexture = Last (Texture n) -> LineTexture n
forall n. Last (Texture n) -> LineTexture n
LineTexture (Last (Texture n) -> LineTexture n)
-> (Texture n -> Last (Texture n)) -> Texture n -> LineTexture n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Texture n -> Last (Texture n)
forall a. a -> Last a
Last

getLineTexture :: LineTexture n -> Texture n
getLineTexture :: forall n. LineTexture n -> Texture n
getLineTexture (LineTexture (Last Texture n
t)) = Texture n
t

lineTexture :: (InSpace V2 n a, Typeable n, Floating n, HasStyle a) => Texture n -> a -> a
lineTexture :: forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Texture n -> a -> a
lineTexture = LineTexture n -> a -> a
forall a d.
(AttributeClass a, Transformable a, V a ~ V d, N a ~ N d,
 HasStyle d) =>
a -> d -> d
applyTAttr (LineTexture n -> a -> a)
-> (Texture n -> LineTexture n) -> Texture n -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Last (Texture n) -> LineTexture n
forall n. Last (Texture n) -> LineTexture n
LineTexture (Last (Texture n) -> LineTexture n)
-> (Texture n -> Last (Texture n)) -> Texture n -> LineTexture n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Texture n -> Last (Texture n)
forall a. a -> Last a
Last

lineTextureA :: (InSpace V2 n a, Typeable n, Floating n, HasStyle a) => LineTexture n -> a -> a
lineTextureA :: forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
LineTexture n -> a -> a
lineTextureA = LineTexture n -> a -> a
forall a d.
(AttributeClass a, Transformable a, V a ~ V d, N a ~ N d,
 HasStyle d) =>
a -> d -> d
applyTAttr

_lineTexture :: (Floating n, Typeable n) => Lens' (Style V2 n) (Texture n)
_lineTexture :: forall n.
(Floating n, Typeable n) =>
Lens' (Style V2 n) (Texture n)
_lineTexture = (Maybe (LineTexture n) -> f (Maybe (LineTexture n)))
-> Style V2 n -> f (Style V2 n)
forall a (v :: * -> *) n.
(V a ~ v, N a ~ n, AttributeClass a, Transformable a) =>
Lens' (Style v n) (Maybe a)
Lens' (Style V2 n) (Maybe (LineTexture n))
atTAttr ((Maybe (LineTexture n) -> f (Maybe (LineTexture n)))
 -> Style V2 n -> f (Style V2 n))
-> ((Texture n -> f (Texture n))
    -> Maybe (LineTexture n) -> f (Maybe (LineTexture n)))
-> (Texture n -> f (Texture n))
-> Style V2 n
-> f (Style V2 n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineTexture n
-> (LineTexture n -> Bool)
-> Iso' (Maybe (LineTexture n)) (LineTexture n)
forall a. a -> (a -> Bool) -> Iso' (Maybe a) a
anon LineTexture n
forall a. Default a => a
def LineTexture n -> Bool
forall {n'}. LineTexture n' -> Bool
isDef ((LineTexture n -> f (LineTexture n))
 -> Maybe (LineTexture n) -> f (Maybe (LineTexture n)))
-> ((Texture n -> f (Texture n))
    -> LineTexture n -> f (LineTexture n))
-> (Texture n -> f (Texture n))
-> Maybe (LineTexture n)
-> f (Maybe (LineTexture n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Texture n -> f (Texture n)) -> LineTexture n -> f (LineTexture n)
forall n n' (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Texture n) (f (Texture n'))
-> p (LineTexture n) (f (LineTexture n'))
_LineTexture
  where
    isDef :: LineTexture n' -> Bool
isDef = Getting Any (LineTexture n') (AlphaColour Double)
-> (AlphaColour Double -> Bool) -> LineTexture n' -> Bool
forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf ((Texture n' -> Const Any (Texture n'))
-> LineTexture n' -> Const Any (LineTexture n')
forall n n' (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Texture n) (f (Texture n'))
-> p (LineTexture n) (f (LineTexture n'))
_LineTexture ((Texture n' -> Const Any (Texture n'))
 -> LineTexture n' -> Const Any (LineTexture n'))
-> ((AlphaColour Double -> Const Any (AlphaColour Double))
    -> Texture n' -> Const Any (Texture n'))
-> Getting Any (LineTexture n') (AlphaColour Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AlphaColour Double -> Const Any (AlphaColour Double))
-> Texture n' -> Const Any (Texture n')
forall n (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (AlphaColour Double) (f (AlphaColour Double))
-> p (Texture n) (f (Texture n))
_AC) (AlphaColour Double -> AlphaColour Double -> Bool
forall a. Eq a => a -> a -> Bool
== Colour Double -> AlphaColour Double
forall a. Num a => Colour a -> AlphaColour a
opaque Colour Double
forall a. Num a => Colour a
black)

-- | Set the line (stroke) color.  This function is polymorphic in the
--   color type (so it can be used with either 'Colour' or
--   'AlphaColour'), but this can sometimes create problems for type
--   inference, so the 'lc' and 'lcA' variants are provided with more
--   concrete types.
lineColor :: (InSpace V2 n a, Color c, Typeable n, Floating n, HasStyle a) => c -> a -> a
lineColor :: forall n a c.
(InSpace V2 n a, Color c, Typeable n, Floating n, HasStyle a) =>
c -> a -> a
lineColor = Texture n -> a -> a
forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Texture n -> a -> a
lineTexture (Texture n -> a -> a) -> (c -> Texture n) -> c -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeColor -> Texture n
forall n. SomeColor -> Texture n
SC (SomeColor -> Texture n) -> (c -> SomeColor) -> c -> Texture n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> SomeColor
forall c. Color c => c -> SomeColor
SomeColor

-- | A synonym for 'lineColor', specialized to @'Colour' Double@
--   (i.e. opaque colors).  See comment in 'lineColor' about backends.
lc :: (InSpace V2 n a, Typeable n, Floating n, HasStyle a) => Colour Double -> a -> a
lc :: forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Colour Double -> a -> a
lc = Colour Double -> a -> a
forall n a c.
(InSpace V2 n a, Color c, Typeable n, Floating n, HasStyle a) =>
c -> a -> a
lineColor

-- | A synonym for 'lineColor', specialized to @'AlphaColour' Double@
--   (i.e. colors with transparency).  See comment in 'lineColor'
--   about backends.
lcA :: (InSpace V2 n a, Typeable n, Floating n, HasStyle a) => AlphaColour Double -> a -> a
lcA :: forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
AlphaColour Double -> a -> a
lcA = AlphaColour Double -> a -> a
forall n a c.
(InSpace V2 n a, Color c, Typeable n, Floating n, HasStyle a) =>
c -> a -> a
lineColor

-- | Apply a linear gradient.
lineLGradient :: (InSpace V2 n a, Typeable n, Floating n, HasStyle a) => LGradient n -> a -> a
lineLGradient :: forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
LGradient n -> a -> a
lineLGradient LGradient n
g = Texture n -> a -> a
forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Texture n -> a -> a
lineTexture (LGradient n -> Texture n
forall n. LGradient n -> Texture n
LG LGradient n
g)

-- | Apply a radial gradient.
lineRGradient :: (InSpace V2 n a, Typeable n, Floating n, HasStyle a) => RGradient n -> a -> a
lineRGradient :: forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
RGradient n -> a -> a
lineRGradient RGradient n
g = Texture n -> a -> a
forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Texture n -> a -> a
lineTexture (RGradient n -> Texture n
forall n. RGradient n -> Texture n
RG RGradient n
g)

-- Fill Texture --------------------------------------------------------

-- | The texture with which objects are filled.
--   The semigroup structure on fill texture attributes
--   is that of 'Recommed . Last'.
newtype FillTexture n = FillTexture (Recommend (Last (Texture n)))
  deriving (Typeable, NonEmpty (FillTexture n) -> FillTexture n
FillTexture n -> FillTexture n -> FillTexture n
(FillTexture n -> FillTexture n -> FillTexture n)
-> (NonEmpty (FillTexture n) -> FillTexture n)
-> (forall b. Integral b => b -> FillTexture n -> FillTexture n)
-> Semigroup (FillTexture n)
forall b. Integral b => b -> FillTexture n -> FillTexture n
forall n. NonEmpty (FillTexture n) -> FillTexture n
forall n. FillTexture n -> FillTexture n -> FillTexture n
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall n b. Integral b => b -> FillTexture n -> FillTexture n
$c<> :: forall n. FillTexture n -> FillTexture n -> FillTexture n
<> :: FillTexture n -> FillTexture n -> FillTexture n
$csconcat :: forall n. NonEmpty (FillTexture n) -> FillTexture n
sconcat :: NonEmpty (FillTexture n) -> FillTexture n
$cstimes :: forall n b. Integral b => b -> FillTexture n -> FillTexture n
stimes :: forall b. Integral b => b -> FillTexture n -> FillTexture n
Semigroup)

instance Typeable n => AttributeClass (FillTexture n)

_FillTexture :: Iso' (FillTexture n) (Recommend (Texture n))
_FillTexture :: forall n (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Recommend (Texture n)) (f (Recommend (Texture n)))
-> p (FillTexture n) (f (FillTexture n))
_FillTexture = (FillTexture n -> Recommend (Texture n))
-> (Recommend (Texture n) -> FillTexture n)
-> Iso
     (FillTexture n)
     (FillTexture n)
     (Recommend (Texture n))
     (Recommend (Texture n))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso FillTexture n -> Recommend (Texture n)
forall {n}. FillTexture n -> Recommend (Texture n)
getter Recommend (Texture n) -> FillTexture n
forall {n}. Recommend (Texture n) -> FillTexture n
setter
  where
    getter :: FillTexture n -> Recommend (Texture n)
getter (FillTexture (Recommend (Last Texture n
t))) = Texture n -> Recommend (Texture n)
forall a. a -> Recommend a
Recommend Texture n
t
    getter (FillTexture (Commit    (Last Texture n
t))) = Texture n -> Recommend (Texture n)
forall a. a -> Recommend a
Commit Texture n
t
    setter :: Recommend (Texture n) -> FillTexture n
setter (Recommend Texture n
t) = Recommend (Last (Texture n)) -> FillTexture n
forall n. Recommend (Last (Texture n)) -> FillTexture n
FillTexture (Last (Texture n) -> Recommend (Last (Texture n))
forall a. a -> Recommend a
Recommend (Texture n -> Last (Texture n)
forall a. a -> Last a
Last Texture n
t))
    setter (Commit Texture n
t)    = Recommend (Last (Texture n)) -> FillTexture n
forall n. Recommend (Last (Texture n)) -> FillTexture n
FillTexture (Last (Texture n) -> Recommend (Last (Texture n))
forall a. a -> Recommend a
Commit (Texture n -> Last (Texture n)
forall a. a -> Last a
Last Texture n
t))
  -- = iso (\(FillTexture a) -> a) FillTexture . mapping _Wrapped
  -- -- once we depend on monoid-extras-0.4

type instance V (FillTexture n) = V2
type instance N (FillTexture n) = n

-- Only gradients get transformed. The transform is applied to the gradients
-- transform field. Colors are left unchanged.
instance Floating n => Transformable (FillTexture n) where
  transform :: Transformation (V (FillTexture n)) (N (FillTexture n))
-> FillTexture n -> FillTexture n
transform = ASetter (FillTexture n) (FillTexture n) (Texture n) (Texture n)
-> (Texture n -> Texture n) -> FillTexture n -> FillTexture n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Recommend (Texture n) -> Identity (Recommend (Texture n)))
-> FillTexture n -> Identity (FillTexture n)
forall n (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Recommend (Texture n)) (f (Recommend (Texture n)))
-> p (FillTexture n) (f (FillTexture n))
_FillTexture ((Recommend (Texture n) -> Identity (Recommend (Texture n)))
 -> FillTexture n -> Identity (FillTexture n))
-> ((Texture n -> Identity (Texture n))
    -> Recommend (Texture n) -> Identity (Recommend (Texture n)))
-> ASetter (FillTexture n) (FillTexture n) (Texture n) (Texture n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Texture n -> Identity (Texture n))
-> Recommend (Texture n) -> Identity (Recommend (Texture n))
forall a b (f :: * -> *).
Functor f =>
(a -> f b) -> Recommend a -> f (Recommend b)
_recommend) ((Texture n -> Texture n) -> FillTexture n -> FillTexture n)
-> (Transformation V2 n -> Texture n -> Texture n)
-> Transformation V2 n
-> FillTexture n
-> FillTexture n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transformation (V (Texture n)) (N (Texture n))
-> Texture n -> Texture n
Transformation V2 n -> Texture n -> Texture n
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform

instance Default (FillTexture n) where
  def :: FillTexture n
def = Texture n -> FillTexture n
forall n. Texture n -> FillTexture n
mkFillTexture (Texture n -> FillTexture n) -> Texture n -> FillTexture n
forall a b. (a -> b) -> a -> b
$ Tagged (AlphaColour Double) (Identity (AlphaColour Double))
-> Tagged (Texture n) (Identity (Texture n))
forall n (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (AlphaColour Double) (f (AlphaColour Double))
-> p (Texture n) (f (Texture n))
_AC (Tagged (AlphaColour Double) (Identity (AlphaColour Double))
 -> Tagged (Texture n) (Identity (Texture n)))
-> AlphaColour Double -> Texture n
forall t b. AReview t b -> b -> t
## AlphaColour Double
forall a. Num a => AlphaColour a
transparent

getFillTexture :: FillTexture n -> Texture n
getFillTexture :: forall n. FillTexture n -> Texture n
getFillTexture (FillTexture Recommend (Last (Texture n))
tx) = Last (Texture n) -> Texture n
forall a. Last a -> a
getLast (Last (Texture n) -> Texture n)
-> (Recommend (Last (Texture n)) -> Last (Texture n))
-> Recommend (Last (Texture n))
-> Texture n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Recommend (Last (Texture n)) -> Last (Texture n)
forall a. Recommend a -> a
getRecommend (Recommend (Last (Texture n)) -> Texture n)
-> Recommend (Last (Texture n)) -> Texture n
forall a b. (a -> b) -> a -> b
$ Recommend (Last (Texture n))
tx

fillTexture :: (InSpace V2 n a, Typeable n, Floating n, HasStyle a) => Texture n -> a -> a
fillTexture :: forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Texture n -> a -> a
fillTexture = FillTexture n -> a -> a
forall a d.
(AttributeClass a, Transformable a, V a ~ V d, N a ~ N d,
 HasStyle d) =>
a -> d -> d
applyTAttr (FillTexture n -> a -> a)
-> (Texture n -> FillTexture n) -> Texture n -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Texture n -> FillTexture n
forall n. Texture n -> FillTexture n
mkFillTexture

mkFillTexture :: Texture n -> FillTexture n
mkFillTexture :: forall n. Texture n -> FillTexture n
mkFillTexture = Recommend (Last (Texture n)) -> FillTexture n
forall n. Recommend (Last (Texture n)) -> FillTexture n
FillTexture (Recommend (Last (Texture n)) -> FillTexture n)
-> (Texture n -> Recommend (Last (Texture n)))
-> Texture n
-> FillTexture n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Last (Texture n) -> Recommend (Last (Texture n))
forall a. a -> Recommend a
Commit (Last (Texture n) -> Recommend (Last (Texture n)))
-> (Texture n -> Last (Texture n))
-> Texture n
-> Recommend (Last (Texture n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Texture n -> Last (Texture n)
forall a. a -> Last a
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 :: forall n.
(Typeable n, Floating n) =>
Lens' (Style V2 n) (Recommend (Texture n))
_fillTextureR = (Maybe (FillTexture n) -> f (Maybe (FillTexture n)))
-> Style V2 n -> f (Style V2 n)
forall a (v :: * -> *) n.
(V a ~ v, N a ~ n, AttributeClass a, Transformable a) =>
Lens' (Style v n) (Maybe a)
Lens' (Style V2 n) (Maybe (FillTexture n))
atTAttr ((Maybe (FillTexture n) -> f (Maybe (FillTexture n)))
 -> Style V2 n -> f (Style V2 n))
-> ((Recommend (Texture n) -> f (Recommend (Texture n)))
    -> Maybe (FillTexture n) -> f (Maybe (FillTexture n)))
-> (Recommend (Texture n) -> f (Recommend (Texture n)))
-> Style V2 n
-> f (Style V2 n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FillTexture n
-> (FillTexture n -> Bool)
-> Iso' (Maybe (FillTexture n)) (FillTexture n)
forall a. a -> (a -> Bool) -> Iso' (Maybe a) a
anon FillTexture n
forall a. Default a => a
def FillTexture n -> Bool
forall {n}. FillTexture n -> Bool
isDef ((FillTexture n -> f (FillTexture n))
 -> Maybe (FillTexture n) -> f (Maybe (FillTexture n)))
-> ((Recommend (Texture n) -> f (Recommend (Texture n)))
    -> FillTexture n -> f (FillTexture n))
-> (Recommend (Texture n) -> f (Recommend (Texture n)))
-> Maybe (FillTexture n)
-> f (Maybe (FillTexture n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Recommend (Texture n) -> f (Recommend (Texture n)))
-> FillTexture n -> f (FillTexture n)
forall n (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Recommend (Texture n)) (f (Recommend (Texture n)))
-> p (FillTexture n) (f (FillTexture n))
_FillTexture
  where
    isDef :: FillTexture n -> Bool
isDef = Getting Any (FillTexture n) (AlphaColour Double)
-> (AlphaColour Double -> Bool) -> FillTexture n -> Bool
forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf ((Recommend (Texture n) -> Const Any (Recommend (Texture n)))
-> FillTexture n -> Const Any (FillTexture n)
forall n (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Recommend (Texture n)) (f (Recommend (Texture n)))
-> p (FillTexture n) (f (FillTexture n))
_FillTexture ((Recommend (Texture n) -> Const Any (Recommend (Texture n)))
 -> FillTexture n -> Const Any (FillTexture n))
-> ((AlphaColour Double -> Const Any (AlphaColour Double))
    -> Recommend (Texture n) -> Const Any (Recommend (Texture n)))
-> Getting Any (FillTexture n) (AlphaColour Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Texture n -> Const Any (Texture n))
-> Recommend (Texture n) -> Const Any (Recommend (Texture n))
forall a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f a) -> p (Recommend a) (f (Recommend a))
_Recommend ((Texture n -> Const Any (Texture n))
 -> Recommend (Texture n) -> Const Any (Recommend (Texture n)))
-> ((AlphaColour Double -> Const Any (AlphaColour Double))
    -> Texture n -> Const Any (Texture n))
-> (AlphaColour Double -> Const Any (AlphaColour Double))
-> Recommend (Texture n)
-> Const Any (Recommend (Texture n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AlphaColour Double -> Const Any (AlphaColour Double))
-> Texture n -> Const Any (Texture n)
forall n (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (AlphaColour Double) (f (AlphaColour Double))
-> p (Texture n) (f (Texture n))
_AC) (AlphaColour Double -> AlphaColour Double -> Bool
forall a. Eq a => a -> a -> Bool
== AlphaColour Double
forall a. Num a => AlphaColour a
transparent)

-- | Commit a fill texture in a style. This is /not/ a valid setter
--   because it doesn't abide the functor law (see 'committed').
_fillTexture :: (Typeable n, Floating n) => Lens' (Style V2 n) (Texture n)
_fillTexture :: forall n.
(Typeable n, Floating n) =>
Lens' (Style V2 n) (Texture n)
_fillTexture = (Recommend (Texture n) -> f (Recommend (Texture n)))
-> Style V2 n -> f (Style V2 n)
forall n.
(Typeable n, Floating n) =>
Lens' (Style V2 n) (Recommend (Texture n))
Lens' (Style V2 n) (Recommend (Texture n))
_fillTextureR ((Recommend (Texture n) -> f (Recommend (Texture n)))
 -> Style V2 n -> f (Style V2 n))
-> ((Texture n -> f (Texture n))
    -> Recommend (Texture n) -> f (Recommend (Texture n)))
-> (Texture n -> f (Texture n))
-> Style V2 n
-> f (Style V2 n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Texture n -> f (Texture n))
-> Recommend (Texture n) -> f (Recommend (Texture n))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p a (f b) -> p (Recommend a) (f (Recommend b))
committed

-- | Set the fill color.  This function is polymorphic in the color
--   type (so it can be used with either 'Colour' or 'AlphaColour'),
--   but this can sometimes create problems for type inference, so the
--   'fc' and 'fcA' variants are provided with more concrete types.
fillColor :: (InSpace V2 n a, Color c, Typeable n, Floating n, HasStyle a) => c -> a -> a
fillColor :: forall n a c.
(InSpace V2 n a, Color c, Typeable n, Floating n, HasStyle a) =>
c -> a -> a
fillColor = Texture n -> a -> a
forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Texture n -> a -> a
fillTexture (Texture n -> a -> a) -> (c -> Texture n) -> c -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeColor -> Texture n
forall n. SomeColor -> Texture n
SC (SomeColor -> Texture n) -> (c -> SomeColor) -> c -> Texture n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> SomeColor
forall c. Color c => c -> SomeColor
SomeColor

-- | Set a \"recommended\" fill color, to be used only if no explicit
--   calls to 'fillColor' (or 'fc', or 'fcA') are used.
--   See comment after 'fillColor' about backends.
recommendFillColor :: (InSpace V2 n a, Color c, Typeable n, Floating n, HasStyle a) => c -> a -> a
recommendFillColor :: forall n a c.
(InSpace V2 n a, Color c, Typeable n, Floating n, HasStyle a) =>
c -> a -> a
recommendFillColor =
  FillTexture n -> a -> a
forall a d.
(AttributeClass a, Transformable a, V a ~ V d, N a ~ N d,
 HasStyle d) =>
a -> d -> d
applyTAttr (FillTexture n -> a -> a) -> (c -> FillTexture n) -> c -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Recommend (Last (Texture n)) -> FillTexture n
forall n. Recommend (Last (Texture n)) -> FillTexture n
FillTexture (Recommend (Last (Texture n)) -> FillTexture n)
-> (c -> Recommend (Last (Texture n))) -> c -> FillTexture n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Last (Texture n) -> Recommend (Last (Texture n))
forall a. a -> Recommend a
Recommend (Last (Texture n) -> Recommend (Last (Texture n)))
-> (c -> Last (Texture n)) -> c -> Recommend (Last (Texture n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Texture n -> Last (Texture n)
forall a. a -> Last a
Last (Texture n -> Last (Texture n))
-> (c -> Texture n) -> c -> Last (Texture n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeColor -> Texture n
forall n. SomeColor -> Texture n
SC (SomeColor -> Texture n) -> (c -> SomeColor) -> c -> Texture n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> SomeColor
forall c. Color c => c -> SomeColor
SomeColor

-- | A synonym for 'fillColor', specialized to @'Colour' Double@
--   (i.e. opaque colors). See comment after 'fillColor' about backends.
fc :: (InSpace V2 n a, Floating n, Typeable n, HasStyle a) => Colour Double -> a -> a
fc :: forall n a.
(InSpace V2 n a, Floating n, Typeable n, HasStyle a) =>
Colour Double -> a -> a
fc = Colour Double -> a -> a
forall n a c.
(InSpace V2 n a, Color c, Typeable n, Floating n, HasStyle a) =>
c -> a -> a
fillColor

-- | A synonym for 'fillColor', specialized to @'AlphaColour' Double@
--   (i.e. colors with transparency). See comment after 'fillColor' about backends.
fcA :: (InSpace V2 n a, Floating n, Typeable n, HasStyle a) => AlphaColour Double -> a -> a
fcA :: forall n a.
(InSpace V2 n a, Floating n, Typeable n, HasStyle a) =>
AlphaColour Double -> a -> a
fcA = AlphaColour Double -> a -> a
forall n a c.
(InSpace V2 n a, Color c, Typeable n, Floating n, HasStyle a) =>
c -> a -> a
fillColor

-- Split fills ---------------------------------------------------------

data FillTextureLoops n = FillTextureLoops

instance Typeable n => SplitAttribute (FillTextureLoops n) where
  type AttrType (FillTextureLoops n) = FillTexture n
  type PrimType (FillTextureLoops n) = Path V2 n

  primOK :: FillTextureLoops n -> PrimType (FillTextureLoops n) -> Bool
primOK FillTextureLoops n
_ = (Located (Trail V2 n) -> Bool) -> [Located (Trail V2 n)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Trail V2 n -> Bool
forall (v :: * -> *) n. Trail v n -> Bool
isLoop (Trail V2 n -> Bool)
-> (Located (Trail V2 n) -> Trail V2 n)
-> Located (Trail V2 n)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Trail V2 n) -> Trail V2 n
forall a. Located a -> a
unLoc) ([Located (Trail V2 n)] -> Bool)
-> (Path V2 n -> [Located (Trail V2 n)]) -> Path V2 n -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path V2 n -> [Located (Trail V2 n)]
forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails

-- | Push fill attributes down until they are at the root of subtrees
--   containing only loops. This makes life much easier for backends,
--   which typically have a semantics where fill attributes are
--   applied to lines/non-closed paths as well as loops/closed paths,
--   whereas in the semantics of diagrams, fill attributes only apply
--   to loops.
splitTextureFills
  :: forall b v n a. (
                     Typeable n) => RTree b v n a -> RTree b v n a
splitTextureFills :: forall b (v :: * -> *) n a.
Typeable n =>
RTree b v n a -> RTree b v n a
splitTextureFills = FillTextureLoops n -> RTree b v n a -> RTree b v n a
forall code b (v :: * -> *) n a.
SplitAttribute code =>
code -> RTree b v n a -> RTree b v n a
splitAttr (FillTextureLoops n
forall n. FillTextureLoops n
FillTextureLoops :: FillTextureLoops n)