{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE ViewPatterns               #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Attributes
-- Copyright   :  (c) 2011-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 some common attributes; particular
-- backends may also define more backend-specific attributes.
--
-- Every attribute type must have a /semigroup/ structure, that is, an
-- associative binary operation for combining two attributes into one.
-- Unless otherwise noted, all the attributes defined here use the
-- 'Last' structure, that is, combining two attributes simply keeps
-- the second one and throws away the first.  This means that child
-- attributes always override parent attributes.
--
-----------------------------------------------------------------------------

module Diagrams.Attributes (
    -- ** Standard measures
    ultraThin, veryThin, thin, medium, thick, veryThick, ultraThick, none
  , tiny, verySmall, small, normal, large, veryLarge, huge

    -- ** Line width
  , LineWidth, getLineWidth
  , _LineWidth, _LineWidthM
  , lineWidth, lineWidthM
  , _lineWidth, _lw, _lineWidthU
  , lw, lwN, lwO, lwL, lwG

    -- ** Dashing
  , Dashing(..), getDashing
  , dashing, dashingN, dashingO, dashingL, dashingG
  , _dashing, _dashingU

  -- * Color
  -- $color

  , Color(..), SomeColor(..), _SomeColor, someToAlpha

  -- ** Opacity
  , Opacity, _Opacity
  , getOpacity, opacity, _opacity

  , FillOpacity, _FillOpacity
  , getFillOpacity, fillOpacity, _fillOpacity

  , StrokeOpacity, _StrokeOpacity
  , getStrokeOpacity, strokeOpacity, _strokeOpacity

  -- ** Converting colors
  , colorToSRGBA, colorToRGBA

  -- * Line stuff
  -- ** Cap style
  , LineCap(..)
  , getLineCap, lineCap, _lineCap

  -- ** Join style
  , LineJoin(..)
  , getLineJoin, lineJoin, _lineJoin

  -- ** Miter limit
  , LineMiterLimit(..), _LineMiterLimit
  , getLineMiterLimit, lineMiterLimit, lineMiterLimitA, _lineMiterLimit

  -- * Recommend optics

  , _Recommend
  , _Commit
  , _recommend
  , isCommitted
  , committed

  ) where

import           Control.Lens          hiding (none, over)
import           Data.Colour
import           Data.Colour.RGBSpace  (RGB (..))
import           Data.Colour.SRGB      (toSRGB)
import           Data.Default.Class
import           Data.Distributive
import           Data.Monoid.Recommend
import           Data.Semigroup
import           Data.Typeable

import           Diagrams.Core

------------------------------------------------------------------------
-- Standard measures
------------------------------------------------------------------------

none, ultraThin, veryThin, thin, medium, thick, veryThick, ultraThick,
  tiny, verySmall, small, normal, large, veryLarge, huge
  :: OrderedField n => Measure n
none :: Measure n
none       = n -> Measure n
forall n. n -> Measure n
output n
0
ultraThin :: Measure n
ultraThin  = n -> Measure n
forall n. Num n => n -> Measure n
normalized n
0.0005 Measure n -> Measure n -> Measure n
forall n. Ord n => Measure n -> Measure n -> Measure n
`atLeast` n -> Measure n
forall n. n -> Measure n
output n
0.5
veryThin :: Measure n
veryThin   = n -> Measure n
forall n. Num n => n -> Measure n
normalized n
0.001  Measure n -> Measure n -> Measure n
forall n. Ord n => Measure n -> Measure n -> Measure n
`atLeast` n -> Measure n
forall n. n -> Measure n
output n
0.5
thin :: Measure n
thin       = n -> Measure n
forall n. Num n => n -> Measure n
normalized n
0.002  Measure n -> Measure n -> Measure n
forall n. Ord n => Measure n -> Measure n -> Measure n
`atLeast` n -> Measure n
forall n. n -> Measure n
output n
0.5
medium :: Measure n
medium     = n -> Measure n
forall n. Num n => n -> Measure n
normalized n
0.004  Measure n -> Measure n -> Measure n
forall n. Ord n => Measure n -> Measure n -> Measure n
`atLeast` n -> Measure n
forall n. n -> Measure n
output n
0.5
thick :: Measure n
thick      = n -> Measure n
forall n. Num n => n -> Measure n
normalized n
0.0075 Measure n -> Measure n -> Measure n
forall n. Ord n => Measure n -> Measure n -> Measure n
`atLeast` n -> Measure n
forall n. n -> Measure n
output n
0.5
veryThick :: Measure n
veryThick  = n -> Measure n
forall n. Num n => n -> Measure n
normalized n
0.01   Measure n -> Measure n -> Measure n
forall n. Ord n => Measure n -> Measure n -> Measure n
`atLeast` n -> Measure n
forall n. n -> Measure n
output n
0.5
ultraThick :: Measure n
ultraThick = n -> Measure n
forall n. Num n => n -> Measure n
normalized n
0.02   Measure n -> Measure n -> Measure n
forall n. Ord n => Measure n -> Measure n -> Measure n
`atLeast` n -> Measure n
forall n. n -> Measure n
output n
0.5

tiny :: Measure n
tiny      = n -> Measure n
forall n. Num n => n -> Measure n
normalized n
0.01
verySmall :: Measure n
verySmall = n -> Measure n
forall n. Num n => n -> Measure n
normalized n
0.015
small :: Measure n
small     = n -> Measure n
forall n. Num n => n -> Measure n
normalized n
0.023
normal :: Measure n
normal    = n -> Measure n
forall n. Num n => n -> Measure n
normalized n
0.035
large :: Measure n
large     = n -> Measure n
forall n. Num n => n -> Measure n
normalized n
0.05
veryLarge :: Measure n
veryLarge = n -> Measure n
forall n. Num n => n -> Measure n
normalized n
0.07
huge :: Measure n
huge      = n -> Measure n
forall n. Num n => n -> Measure n
normalized n
0.10

------------------------------------------------------------------------
-- Line width
------------------------------------------------------------------------

-- | Line widths specified on child nodes always override line widths
--   specified at parent nodes.
newtype LineWidth n = LineWidth (Last n)
  deriving (Typeable, b -> LineWidth n -> LineWidth n
NonEmpty (LineWidth n) -> LineWidth n
LineWidth n -> LineWidth n -> LineWidth n
(LineWidth n -> LineWidth n -> LineWidth n)
-> (NonEmpty (LineWidth n) -> LineWidth n)
-> (forall b. Integral b => b -> LineWidth n -> LineWidth n)
-> Semigroup (LineWidth n)
forall b. Integral b => b -> LineWidth n -> LineWidth n
forall n. NonEmpty (LineWidth n) -> LineWidth n
forall n. LineWidth n -> LineWidth n -> LineWidth n
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall n b. Integral b => b -> LineWidth n -> LineWidth n
stimes :: b -> LineWidth n -> LineWidth n
$cstimes :: forall n b. Integral b => b -> LineWidth n -> LineWidth n
sconcat :: NonEmpty (LineWidth n) -> LineWidth n
$csconcat :: forall n. NonEmpty (LineWidth n) -> LineWidth n
<> :: LineWidth n -> LineWidth n -> LineWidth n
$c<> :: forall n. LineWidth n -> LineWidth n -> LineWidth n
Semigroup)

_LineWidth :: Iso' (LineWidth n) n
_LineWidth :: p n (f n) -> p (LineWidth n) (f (LineWidth n))
_LineWidth = (LineWidth n -> n)
-> (n -> LineWidth n) -> Iso (LineWidth n) (LineWidth n) n n
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso LineWidth n -> n
forall n. LineWidth n -> n
getLineWidth (Last n -> LineWidth n
forall n. Last n -> LineWidth n
LineWidth (Last n -> LineWidth n) -> (n -> Last n) -> n -> LineWidth n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Last n
forall a. a -> Last a
Last)

_LineWidthM :: Iso' (LineWidthM n) (Measure n)
_LineWidthM :: p (Measure n) (f (Measure n))
-> p (LineWidthM n) (f (LineWidthM n))
_LineWidthM = AnIso (LineWidth n) (LineWidth n) n n
-> Iso (LineWidthM n) (LineWidthM n) (Measure n) (Measure n)
forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
mapping AnIso (LineWidth n) (LineWidth n) n n
forall n. Iso' (LineWidth n) n
_LineWidth

instance Typeable n => AttributeClass (LineWidth n)

type LineWidthM n = Measured n (LineWidth n)

instance OrderedField n => Default (LineWidthM n) where
  def :: LineWidthM n
def = (n -> LineWidth n) -> Measured n n -> LineWidthM n
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Last n -> LineWidth n
forall n. Last n -> LineWidth n
LineWidth (Last n -> LineWidth n) -> (n -> Last n) -> n -> LineWidth n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Last n
forall a. a -> Last a
Last) Measured n n
forall n. OrderedField n => Measure n
medium

getLineWidth :: LineWidth n -> n
getLineWidth :: LineWidth n -> n
getLineWidth (LineWidth (Last n
w)) = n
w

-- | Set the line (stroke) width.
lineWidth :: (N a ~ n, HasStyle a, Typeable n) => Measure n -> a -> a
lineWidth :: Measure n -> a -> a
lineWidth = Measured n (LineWidth n) -> a -> a
forall a d n.
(AttributeClass a, N d ~ n, HasStyle d) =>
Measured n a -> d -> d
applyMAttr (Measured n (LineWidth n) -> a -> a)
-> (Measure n -> Measured n (LineWidth n)) -> Measure n -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> LineWidth n) -> Measure n -> Measured n (LineWidth n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Last n -> LineWidth n
forall n. Last n -> LineWidth n
LineWidth (Last n -> LineWidth n) -> (n -> Last n) -> n -> LineWidth n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Last n
forall a. a -> Last a
Last)

-- | Apply a 'LineWidth' attribute.
lineWidthM :: (N a ~ n, HasStyle a, Typeable n) => LineWidthM n -> a -> a
lineWidthM :: LineWidthM n -> a -> a
lineWidthM = LineWidthM n -> a -> a
forall a d n.
(AttributeClass a, N d ~ n, HasStyle d) =>
Measured n a -> d -> d
applyMAttr

-- | Default for 'lineWidth'.
lw :: (N a ~ n, HasStyle a, Typeable n) => Measure n -> a -> a
lw :: Measure n -> a -> a
lw = Measure n -> a -> a
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lineWidth

-- | A convenient synonym for 'lineWidth (global w)'.
lwG :: (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
lwG :: n -> a -> a
lwG = Measure n -> a -> a
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw (Measure n -> a -> a) -> (n -> Measure n) -> n -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Measure n
forall n. Num n => n -> Measure n
global

-- | A convenient synonym for 'lineWidth (normalized w)'.
lwN :: (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
lwN :: n -> a -> a
lwN = Measure n -> a -> a
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw (Measure n -> a -> a) -> (n -> Measure n) -> n -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Measure n
forall n. Num n => n -> Measure n
normalized

-- | A convenient synonym for 'lineWidth (output w)'.
lwO :: (N a ~ n, HasStyle a, Typeable n) => n -> a -> a
lwO :: n -> a -> a
lwO = Measure n -> a -> a
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw (Measure n -> a -> a) -> (n -> Measure n) -> n -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Measure n
forall n. n -> Measure n
output

-- | A convenient sysnonym for 'lineWidth (local w)'.
lwL :: (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
lwL :: n -> a -> a
lwL = Measure n -> a -> a
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw (Measure n -> a -> a) -> (n -> Measure n) -> n -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Measure n
forall n. Num n => n -> Measure n
local

-- | Lens onto a measured line width in a style.
_lineWidth, _lw :: (Typeable n, OrderedField n) => Lens' (Style v n) (Measure n)
_lineWidth :: Lens' (Style v n) (Measure n)
_lineWidth = (Maybe (Measured n (LineWidth n))
 -> f (Maybe (Measured n (LineWidth n))))
-> Style v n -> f (Style v n)
forall a n (v :: * -> *).
(AttributeClass a, Typeable n) =>
Lens' (Style v n) (Maybe (Measured n a))
atMAttr ((Maybe (Measured n (LineWidth n))
  -> f (Maybe (Measured n (LineWidth n))))
 -> Style v n -> f (Style v n))
-> ((Measure n -> f (Measure n))
    -> Maybe (Measured n (LineWidth n))
    -> f (Maybe (Measured n (LineWidth n))))
-> (Measure n -> f (Measure n))
-> Style v n
-> f (Style v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Measured n (LineWidth n)
-> (Measured n (LineWidth n) -> Bool)
-> Iso'
     (Maybe (Measured n (LineWidth n))) (Measured n (LineWidth n))
forall a. a -> (a -> Bool) -> Iso' (Maybe a) a
anon Measured n (LineWidth n)
forall a. Default a => a
def (Bool -> Measured n (LineWidth n) -> Bool
forall a b. a -> b -> a
const Bool
False) ((Measured n (LineWidth n) -> f (Measured n (LineWidth n)))
 -> Maybe (Measured n (LineWidth n))
 -> f (Maybe (Measured n (LineWidth n))))
-> ((Measure n -> f (Measure n))
    -> Measured n (LineWidth n) -> f (Measured n (LineWidth n)))
-> (Measure n -> f (Measure n))
-> Maybe (Measured n (LineWidth n))
-> f (Maybe (Measured n (LineWidth n)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Measure n -> f (Measure n))
-> Measured n (LineWidth n) -> f (Measured n (LineWidth n))
forall n. Iso' (LineWidthM n) (Measure n)
_LineWidthM
_lw :: Lens' (Style v n) (Measure n)
_lw = (Measure n -> f (Measure n)) -> Style v n -> f (Style v n)
forall n (v :: * -> *).
(Typeable n, OrderedField n) =>
Lens' (Style v n) (Measure n)
_lineWidth

-- | Lens onto the unmeasured linewith attribute. This is useful for
--   backends to use on styles once they have been unmeasured. Using on
--   a diagram style could lead to unexpected results.
_lineWidthU :: Typeable n => Lens' (Style v n) (Maybe n)
_lineWidthU :: Lens' (Style v n) (Maybe n)
_lineWidthU = (Maybe (LineWidth n) -> f (Maybe (LineWidth n)))
-> Style v n -> f (Style v n)
forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
atAttr ((Maybe (LineWidth n) -> f (Maybe (LineWidth n)))
 -> Style v n -> f (Style v n))
-> ((Maybe n -> f (Maybe n))
    -> Maybe (LineWidth n) -> f (Maybe (LineWidth n)))
-> (Maybe n -> f (Maybe n))
-> Style v n
-> f (Style v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso (LineWidth n) (LineWidth n) n n
-> Iso
     (Maybe (LineWidth n)) (Maybe (LineWidth n)) (Maybe n) (Maybe n)
forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
mapping AnIso (LineWidth n) (LineWidth n) n n
forall n. Iso' (LineWidth n) n
_LineWidth

------------------------------------------------------------------------
-- Dashing
------------------------------------------------------------------------

-- | Create lines that are dashing... er, dashed.
data Dashing n = Dashing [n] n
  deriving (a -> Dashing b -> Dashing a
(a -> b) -> Dashing a -> Dashing b
(forall a b. (a -> b) -> Dashing a -> Dashing b)
-> (forall a b. a -> Dashing b -> Dashing a) -> Functor Dashing
forall a b. a -> Dashing b -> Dashing a
forall a b. (a -> b) -> Dashing a -> Dashing b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Dashing b -> Dashing a
$c<$ :: forall a b. a -> Dashing b -> Dashing a
fmap :: (a -> b) -> Dashing a -> Dashing b
$cfmap :: forall a b. (a -> b) -> Dashing a -> Dashing b
Functor, Typeable, Dashing n -> Dashing n -> Bool
(Dashing n -> Dashing n -> Bool)
-> (Dashing n -> Dashing n -> Bool) -> Eq (Dashing n)
forall n. Eq n => Dashing n -> Dashing n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dashing n -> Dashing n -> Bool
$c/= :: forall n. Eq n => Dashing n -> Dashing n -> Bool
== :: Dashing n -> Dashing n -> Bool
$c== :: forall n. Eq n => Dashing n -> Dashing n -> Bool
Eq)

instance Semigroup (Dashing n) where
  Dashing n
_ <> :: Dashing n -> Dashing n -> Dashing n
<> Dashing n
b = Dashing n
b

instance Typeable n => AttributeClass (Dashing n)

getDashing :: Dashing n -> Dashing n
getDashing :: Dashing n -> Dashing n
getDashing = Dashing n -> Dashing n
forall a. a -> a
id

-- | Set the line dashing style.
dashing :: (N a ~ n, HasStyle a, Typeable n)
        => [Measure n]  -- ^ A list specifying alternate lengths of on
                        --   and off portions of the stroke.  The empty
                        --   list indicates no dashing.
        -> Measure n    -- ^ An offset into the dash pattern at which the
                        --   stroke should start.
        -> a -> a
dashing :: [Measure n] -> Measure n -> a -> a
dashing [Measure n]
ds Measure n
offs = Measured n (Dashing n) -> a -> a
forall a d n.
(AttributeClass a, N d ~ n, HasStyle d) =>
Measured n a -> d -> d
applyMAttr (Measured n (Dashing n) -> a -> a)
-> (Dashing (Measure n) -> Measured n (Dashing n))
-> Dashing (Measure n)
-> a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dashing (Measure n) -> Measured n (Dashing n)
forall (g :: * -> *) (f :: * -> *) a.
(Distributive g, Functor f) =>
f (g a) -> g (f a)
distribute (Dashing (Measure n) -> a -> a) -> Dashing (Measure n) -> a -> a
forall a b. (a -> b) -> a -> b
$ [Measure n] -> Measure n -> Dashing (Measure n)
forall n. [n] -> n -> Dashing n
Dashing [Measure n]
ds Measure n
offs

-- | A convenient synonym for 'dashing (global w)'.
dashingG :: (N a ~ n, HasStyle a, Typeable n, Num n) => [n] -> n -> a -> a
dashingG :: [n] -> n -> a -> a
dashingG [n]
w n
v = [Measure n] -> Measure n -> a -> a
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
[Measure n] -> Measure n -> a -> a
dashing ((n -> Measure n) -> [n] -> [Measure n]
forall a b. (a -> b) -> [a] -> [b]
map n -> Measure n
forall n. Num n => n -> Measure n
global [n]
w) (n -> Measure n
forall n. Num n => n -> Measure n
global n
v)

-- | A convenient synonym for 'dashing (normalized w)'.
dashingN :: (N a ~ n, HasStyle a, Typeable n, Num n) => [n] -> n -> a -> a
dashingN :: [n] -> n -> a -> a
dashingN [n]
w n
v = [Measure n] -> Measure n -> a -> a
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
[Measure n] -> Measure n -> a -> a
dashing ((n -> Measure n) -> [n] -> [Measure n]
forall a b. (a -> b) -> [a] -> [b]
map n -> Measure n
forall n. Num n => n -> Measure n
normalized [n]
w) (n -> Measure n
forall n. Num n => n -> Measure n
normalized n
v)

-- | A convenient synonym for 'dashing (output w)'.
dashingO :: (N a ~ n, HasStyle a, Typeable n) => [n] -> n -> a -> a
dashingO :: [n] -> n -> a -> a
dashingO [n]
w n
v = [Measure n] -> Measure n -> a -> a
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
[Measure n] -> Measure n -> a -> a
dashing ((n -> Measure n) -> [n] -> [Measure n]
forall a b. (a -> b) -> [a] -> [b]
map n -> Measure n
forall n. n -> Measure n
output [n]
w) (n -> Measure n
forall n. n -> Measure n
output n
v)

-- | A convenient sysnonym for 'dashing (local w)'.
dashingL :: (N a ~ n, HasStyle a, Typeable n, Num n) => [n] -> n -> a -> a
dashingL :: [n] -> n -> a -> a
dashingL [n]
w n
v = [Measure n] -> Measure n -> a -> a
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
[Measure n] -> Measure n -> a -> a
dashing ((n -> Measure n) -> [n] -> [Measure n]
forall a b. (a -> b) -> [a] -> [b]
map n -> Measure n
forall n. Num n => n -> Measure n
local [n]
w) (n -> Measure n
forall n. Num n => n -> Measure n
local n
v)

-- | Lens onto a measured dashing attribute in a style.
_dashing :: Typeable n
         => Lens' (Style v n) (Maybe (Measured n (Dashing n)))
_dashing :: Lens' (Style v n) (Maybe (Measured n (Dashing n)))
_dashing = (Maybe (Measured n (Dashing n))
 -> f (Maybe (Measured n (Dashing n))))
-> Style v n -> f (Style v n)
forall a n (v :: * -> *).
(AttributeClass a, Typeable n) =>
Lens' (Style v n) (Maybe (Measured n a))
atMAttr

-- | Lens onto the unmeasured 'Dashing' attribute. This is useful for
--   backends to use on styles once they have been unmeasured. Using on
--   a diagram style could lead to unexpected results.
_dashingU :: Typeable n => Lens' (Style v n) (Maybe (Dashing n))
_dashingU :: Lens' (Style v n) (Maybe (Dashing n))
_dashingU = (Maybe (Dashing n) -> f (Maybe (Dashing n)))
-> Style v n -> f (Style v n)
forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
atAttr

------------------------------------------------------------------------
-- Color
------------------------------------------------------------------------

-- $color
-- Diagrams outsources all things color-related to Russell O\'Connor\'s
-- very nice colour package
-- (<http://hackage.haskell.org/package/colour>).  For starters, it
-- provides a large collection of standard color names.  However, it
-- also provides a rich set of combinators for combining and
-- manipulating colors; see its documentation for more information.

-- | The 'Color' type class encompasses color representations which
--   can be used by the Diagrams library.  Instances are provided for
--   both the 'Data.Colour.Colour' and 'Data.Colour.AlphaColour' types
--   from the "Data.Colour" library.
class Color c where
  -- | Convert a color to its standard representation, AlphaColour.
  toAlphaColour :: c -> AlphaColour Double

  -- | Convert from an AlphaColour Double.  Note that this direction
  --   may lose some information. For example, the instance for
  --   'Colour' drops the alpha channel.
  fromAlphaColour :: AlphaColour Double -> c

-- | An existential wrapper for instances of the 'Color' class.
data SomeColor = forall c. Color c => SomeColor c
  deriving Typeable

instance Show SomeColor where
  showsPrec :: Int -> SomeColor -> ShowS
showsPrec Int
d (SomeColor -> (Double, Double, Double, Double)
forall c. Color c => c -> (Double, Double, Double, Double)
colorToSRGBA -> (Double
r,Double
g,Double
b,Double
a)) =
    Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"SomeColor " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      if Double
a Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0
        then String -> ShowS
showString String
"transparent"
        else String -> ShowS
showString String
"(sRGB " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Double
r ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
                                 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Double
g ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
                                 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Double
b ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        (if Double
a Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
1
                           then String -> ShowS
showString String
" `withOpacity` " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Double
a
                           else ShowS
forall a. a -> a
id) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
')'

-- | Isomorphism between 'SomeColor' and 'AlphaColour' 'Double'.
_SomeColor :: Iso' SomeColor (AlphaColour Double)
_SomeColor :: p (AlphaColour Double) (f (AlphaColour Double))
-> p SomeColor (f SomeColor)
_SomeColor = (SomeColor -> AlphaColour Double)
-> (AlphaColour Double -> SomeColor)
-> Iso
     SomeColor SomeColor (AlphaColour Double) (AlphaColour Double)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso SomeColor -> AlphaColour Double
forall c. Color c => c -> AlphaColour Double
toAlphaColour AlphaColour Double -> SomeColor
forall c. Color c => AlphaColour Double -> c
fromAlphaColour

someToAlpha :: SomeColor -> AlphaColour Double
someToAlpha :: SomeColor -> AlphaColour Double
someToAlpha (SomeColor c
c) = c -> AlphaColour Double
forall c. Color c => c -> AlphaColour Double
toAlphaColour c
c

instance a ~ Double => Color (Colour a) where
  toAlphaColour :: Colour a -> AlphaColour Double
toAlphaColour   = Colour a -> AlphaColour Double
forall a. Num a => Colour a -> AlphaColour a
opaque
  fromAlphaColour :: AlphaColour Double -> Colour a
fromAlphaColour = (AlphaColour a -> Colour a -> Colour a
forall (f :: * -> *) a.
(ColourOps f, Num a) =>
AlphaColour a -> f a -> f a
`over` Colour a
forall a. Num a => Colour a
black)

instance a ~ Double => Color (AlphaColour a) where
  toAlphaColour :: AlphaColour a -> AlphaColour Double
toAlphaColour   = AlphaColour a -> AlphaColour Double
forall a. a -> a
id
  fromAlphaColour :: AlphaColour Double -> AlphaColour a
fromAlphaColour = AlphaColour Double -> AlphaColour a
forall a. a -> a
id

instance Color SomeColor where
  toAlphaColour :: SomeColor -> AlphaColour Double
toAlphaColour (SomeColor c
c) = c -> AlphaColour Double
forall c. Color c => c -> AlphaColour Double
toAlphaColour c
c
  fromAlphaColour :: AlphaColour Double -> SomeColor
fromAlphaColour             = AlphaColour Double -> SomeColor
forall c. Color c => c -> SomeColor
SomeColor

-- | Convert to sRGBA.
colorToSRGBA, colorToRGBA :: Color c => c -> (Double, Double, Double, Double)
colorToSRGBA :: c -> (Double, Double, Double, Double)
colorToSRGBA c
col = (Double
r, Double
g, Double
b, Double
a)
  where
    c' :: AlphaColour Double
c' = c -> AlphaColour Double
forall c. Color c => c -> AlphaColour Double
toAlphaColour c
col
    c :: Colour Double
c = AlphaColour Double -> Colour Double
forall a. (Floating a, Ord a) => AlphaColour a -> Colour a
alphaToColour AlphaColour Double
c'
    a :: Double
a = AlphaColour Double -> Double
forall a. AlphaColour a -> a
alphaChannel AlphaColour Double
c'
    RGB Double
r Double
g Double
b = Colour Double -> RGB Double
forall b. (Ord b, Floating b) => Colour b -> RGB b
toSRGB Colour Double
c

colorToRGBA :: c -> (Double, Double, Double, Double)
colorToRGBA = c -> (Double, Double, Double, Double)
forall c. Color c => c -> (Double, Double, Double, Double)
colorToSRGBA
{-# DEPRECATED colorToRGBA "Renamed to colorToSRGBA." #-}

alphaToColour :: (Floating a, Ord a) => AlphaColour a -> Colour a
alphaToColour :: AlphaColour a -> Colour a
alphaToColour AlphaColour a
ac | AlphaColour a -> a
forall a. AlphaColour a -> a
alphaChannel AlphaColour a
ac a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = AlphaColour a
ac AlphaColour a -> Colour a -> Colour a
forall (f :: * -> *) a.
(ColourOps f, Num a) =>
AlphaColour a -> f a -> f a
`over` Colour a
forall a. Num a => Colour a
black
                 | Bool
otherwise = a -> Colour a -> Colour a
forall (f :: * -> *) a. (ColourOps f, Num a) => a -> f a -> f a
darken (a -> a
forall a. Fractional a => a -> a
recip (AlphaColour a -> a
forall a. AlphaColour a -> a
alphaChannel AlphaColour a
ac)) (AlphaColour a
ac AlphaColour a -> Colour a -> Colour a
forall (f :: * -> *) a.
(ColourOps f, Num a) =>
AlphaColour a -> f a -> f a
`over` Colour a
forall a. Num a => Colour a
black)

------------------------------------------------------------------------
-- Opacity
------------------------------------------------------------------------

-- | Although the individual colors in a diagram can have
--   transparency, the opacity/transparency of a diagram as a whole
--   can be specified with the @Opacity@ attribute.  The opacity is a
--   value between 1 (completely opaque, the default) and 0
--   (completely transparent).  Opacity is multiplicative, that is,
--   @'opacity' o1 . 'opacity' o2 === 'opacity' (o1 * o2)@.  In other
--   words, for example, @opacity 0.8@ means \"decrease this diagram's
--   opacity to 80% of its previous opacity\".
newtype Opacity = Opacity (Product Double)
  deriving (Typeable, b -> Opacity -> Opacity
NonEmpty Opacity -> Opacity
Opacity -> Opacity -> Opacity
(Opacity -> Opacity -> Opacity)
-> (NonEmpty Opacity -> Opacity)
-> (forall b. Integral b => b -> Opacity -> Opacity)
-> Semigroup Opacity
forall b. Integral b => b -> Opacity -> Opacity
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Opacity -> Opacity
$cstimes :: forall b. Integral b => b -> Opacity -> Opacity
sconcat :: NonEmpty Opacity -> Opacity
$csconcat :: NonEmpty Opacity -> Opacity
<> :: Opacity -> Opacity -> Opacity
$c<> :: Opacity -> Opacity -> Opacity
Semigroup)
instance AttributeClass Opacity

_Opacity :: Iso' Opacity Double
_Opacity :: p Double (f Double) -> p Opacity (f Opacity)
_Opacity = (Opacity -> Double)
-> (Double -> Opacity) -> Iso Opacity Opacity Double Double
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Opacity -> Double
getOpacity (Product Double -> Opacity
Opacity (Product Double -> Opacity)
-> (Double -> Product Double) -> Double -> Opacity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Product Double
forall a. a -> Product a
Product)

getOpacity :: Opacity -> Double
getOpacity :: Opacity -> Double
getOpacity (Opacity (Product Double
d)) = Double
d

-- | Multiply the opacity (see 'Opacity') by the given value.  For
--   example, @opacity 0.8@ means \"decrease this diagram's opacity to
--   80% of its previous opacity\".
opacity :: HasStyle a => Double -> a -> a
opacity :: Double -> a -> a
opacity = Opacity -> a -> a
forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr (Opacity -> a -> a) -> (Double -> Opacity) -> Double -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Product Double -> Opacity
Opacity (Product Double -> Opacity)
-> (Double -> Product Double) -> Double -> Opacity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Product Double
forall a. a -> Product a
Product

-- | Lens onto the opacity in a style.
_opacity :: Lens' (Style v n) Double
_opacity :: (Double -> f Double) -> Style v n -> f (Style v n)
_opacity = (Maybe Opacity -> f (Maybe Opacity)) -> Style v n -> f (Style v n)
forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
atAttr ((Maybe Opacity -> f (Maybe Opacity))
 -> Style v n -> f (Style v n))
-> ((Double -> f Double) -> Maybe Opacity -> f (Maybe Opacity))
-> (Double -> f Double)
-> Style v n
-> f (Style v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso Opacity Opacity Double Double
-> Iso
     (Maybe Opacity) (Maybe Opacity) (Maybe Double) (Maybe Double)
forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
mapping AnIso Opacity Opacity Double Double
Iso Opacity Opacity Double Double
_Opacity ((Maybe Double -> f (Maybe Double))
 -> Maybe Opacity -> f (Maybe Opacity))
-> ((Double -> f Double) -> Maybe Double -> f (Maybe Double))
-> (Double -> f Double)
-> Maybe Opacity
-> f (Maybe Opacity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Iso' (Maybe Double) Double
forall a. Eq a => a -> Iso' (Maybe a) a
non Double
1

-- fill opacity --------------------------------------------------------

-- | Like 'Opacity', but set the opacity only for fills (as opposed to strokes).
--   As with 'Opacity', the fill opacity is a value between 1
--   (completely opaque, the default) and 0 (completely transparent),
--   and is multiplicative.
newtype FillOpacity = FillOpacity (Product Double)
  deriving (Typeable, b -> FillOpacity -> FillOpacity
NonEmpty FillOpacity -> FillOpacity
FillOpacity -> FillOpacity -> FillOpacity
(FillOpacity -> FillOpacity -> FillOpacity)
-> (NonEmpty FillOpacity -> FillOpacity)
-> (forall b. Integral b => b -> FillOpacity -> FillOpacity)
-> Semigroup FillOpacity
forall b. Integral b => b -> FillOpacity -> FillOpacity
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> FillOpacity -> FillOpacity
$cstimes :: forall b. Integral b => b -> FillOpacity -> FillOpacity
sconcat :: NonEmpty FillOpacity -> FillOpacity
$csconcat :: NonEmpty FillOpacity -> FillOpacity
<> :: FillOpacity -> FillOpacity -> FillOpacity
$c<> :: FillOpacity -> FillOpacity -> FillOpacity
Semigroup)
instance AttributeClass FillOpacity

_FillOpacity :: Iso' FillOpacity Double
_FillOpacity :: p Double (f Double) -> p FillOpacity (f FillOpacity)
_FillOpacity = (FillOpacity -> Double)
-> (Double -> FillOpacity)
-> Iso FillOpacity FillOpacity Double Double
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso FillOpacity -> Double
getFillOpacity (Product Double -> FillOpacity
FillOpacity (Product Double -> FillOpacity)
-> (Double -> Product Double) -> Double -> FillOpacity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Product Double
forall a. a -> Product a
Product)

getFillOpacity :: FillOpacity -> Double
getFillOpacity :: FillOpacity -> Double
getFillOpacity (FillOpacity (Product Double
d)) = Double
d

-- | Multiply the fill opacity (see 'FillOpacity') by the given value.  For
--   example, @fillOpacity 0.8@ means \"decrease this diagram's fill opacity to
--   80% of its previous value\".
fillOpacity :: HasStyle a => Double -> a -> a
fillOpacity :: Double -> a -> a
fillOpacity = FillOpacity -> a -> a
forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr (FillOpacity -> a -> a)
-> (Double -> FillOpacity) -> Double -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Product Double -> FillOpacity
FillOpacity (Product Double -> FillOpacity)
-> (Double -> Product Double) -> Double -> FillOpacity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Product Double
forall a. a -> Product a
Product

-- | Lens onto the fill opacity in a style.
_fillOpacity :: Lens' (Style v n) Double
_fillOpacity :: (Double -> f Double) -> Style v n -> f (Style v n)
_fillOpacity = (Maybe FillOpacity -> f (Maybe FillOpacity))
-> Style v n -> f (Style v n)
forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
atAttr ((Maybe FillOpacity -> f (Maybe FillOpacity))
 -> Style v n -> f (Style v n))
-> ((Double -> f Double)
    -> Maybe FillOpacity -> f (Maybe FillOpacity))
-> (Double -> f Double)
-> Style v n
-> f (Style v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso FillOpacity FillOpacity Double Double
-> Iso
     (Maybe FillOpacity)
     (Maybe FillOpacity)
     (Maybe Double)
     (Maybe Double)
forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
mapping AnIso FillOpacity FillOpacity Double Double
Iso FillOpacity FillOpacity Double Double
_FillOpacity ((Maybe Double -> f (Maybe Double))
 -> Maybe FillOpacity -> f (Maybe FillOpacity))
-> ((Double -> f Double) -> Maybe Double -> f (Maybe Double))
-> (Double -> f Double)
-> Maybe FillOpacity
-> f (Maybe FillOpacity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Iso' (Maybe Double) Double
forall a. Eq a => a -> Iso' (Maybe a) a
non Double
1

-- stroke opacity --------------------------------------------------------

-- | Like 'Opacity', but set the opacity only for strokes (as opposed to fills).
--   As with 'Opacity', the fill opacity is a value between 1
--   (completely opaque, the default) and 0 (completely transparent),
--   and is multiplicative.
newtype StrokeOpacity = StrokeOpacity (Product Double)
  deriving (Typeable, b -> StrokeOpacity -> StrokeOpacity
NonEmpty StrokeOpacity -> StrokeOpacity
StrokeOpacity -> StrokeOpacity -> StrokeOpacity
(StrokeOpacity -> StrokeOpacity -> StrokeOpacity)
-> (NonEmpty StrokeOpacity -> StrokeOpacity)
-> (forall b. Integral b => b -> StrokeOpacity -> StrokeOpacity)
-> Semigroup StrokeOpacity
forall b. Integral b => b -> StrokeOpacity -> StrokeOpacity
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> StrokeOpacity -> StrokeOpacity
$cstimes :: forall b. Integral b => b -> StrokeOpacity -> StrokeOpacity
sconcat :: NonEmpty StrokeOpacity -> StrokeOpacity
$csconcat :: NonEmpty StrokeOpacity -> StrokeOpacity
<> :: StrokeOpacity -> StrokeOpacity -> StrokeOpacity
$c<> :: StrokeOpacity -> StrokeOpacity -> StrokeOpacity
Semigroup)
instance AttributeClass StrokeOpacity

_StrokeOpacity :: Iso' StrokeOpacity Double
_StrokeOpacity :: p Double (f Double) -> p StrokeOpacity (f StrokeOpacity)
_StrokeOpacity = (StrokeOpacity -> Double)
-> (Double -> StrokeOpacity)
-> Iso StrokeOpacity StrokeOpacity Double Double
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso StrokeOpacity -> Double
getStrokeOpacity (Product Double -> StrokeOpacity
StrokeOpacity (Product Double -> StrokeOpacity)
-> (Double -> Product Double) -> Double -> StrokeOpacity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Product Double
forall a. a -> Product a
Product)

getStrokeOpacity :: StrokeOpacity -> Double
getStrokeOpacity :: StrokeOpacity -> Double
getStrokeOpacity (StrokeOpacity (Product Double
d)) = Double
d

-- | Multiply the stroke opacity (see 'StrokeOpacity') by the given value.  For
--   example, @strokeOpacity 0.8@ means \"decrease this diagram's
--   stroke opacity to 80% of its previous value\".
strokeOpacity :: HasStyle a => Double -> a -> a
strokeOpacity :: Double -> a -> a
strokeOpacity = StrokeOpacity -> a -> a
forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr (StrokeOpacity -> a -> a)
-> (Double -> StrokeOpacity) -> Double -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Product Double -> StrokeOpacity
StrokeOpacity (Product Double -> StrokeOpacity)
-> (Double -> Product Double) -> Double -> StrokeOpacity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Product Double
forall a. a -> Product a
Product

-- | Lens onto the stroke opacity in a style.
_strokeOpacity :: Lens' (Style v n) Double
_strokeOpacity :: (Double -> f Double) -> Style v n -> f (Style v n)
_strokeOpacity = (Maybe StrokeOpacity -> f (Maybe StrokeOpacity))
-> Style v n -> f (Style v n)
forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
atAttr ((Maybe StrokeOpacity -> f (Maybe StrokeOpacity))
 -> Style v n -> f (Style v n))
-> ((Double -> f Double)
    -> Maybe StrokeOpacity -> f (Maybe StrokeOpacity))
-> (Double -> f Double)
-> Style v n
-> f (Style v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso StrokeOpacity StrokeOpacity Double Double
-> Iso
     (Maybe StrokeOpacity)
     (Maybe StrokeOpacity)
     (Maybe Double)
     (Maybe Double)
forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
mapping AnIso StrokeOpacity StrokeOpacity Double Double
Iso StrokeOpacity StrokeOpacity Double Double
_StrokeOpacity ((Maybe Double -> f (Maybe Double))
 -> Maybe StrokeOpacity -> f (Maybe StrokeOpacity))
-> ((Double -> f Double) -> Maybe Double -> f (Maybe Double))
-> (Double -> f Double)
-> Maybe StrokeOpacity
-> f (Maybe StrokeOpacity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Iso' (Maybe Double) Double
forall a. Eq a => a -> Iso' (Maybe a) a
non Double
1

------------------------------------------------------------------------
-- Line stuff
------------------------------------------------------------------------

-- line cap ------------------------------------------------------------

-- | 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
                             --   centered on endpoints.
             | LineCapSquare -- ^ Lines are capped with a squares
                             --   centered on endpoints.
  deriving (LineCap -> LineCap -> Bool
(LineCap -> LineCap -> Bool)
-> (LineCap -> LineCap -> Bool) -> Eq LineCap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineCap -> LineCap -> Bool
$c/= :: LineCap -> LineCap -> Bool
== :: LineCap -> LineCap -> Bool
$c== :: LineCap -> LineCap -> Bool
Eq, Eq LineCap
Eq LineCap
-> (LineCap -> LineCap -> Ordering)
-> (LineCap -> LineCap -> Bool)
-> (LineCap -> LineCap -> Bool)
-> (LineCap -> LineCap -> Bool)
-> (LineCap -> LineCap -> Bool)
-> (LineCap -> LineCap -> LineCap)
-> (LineCap -> LineCap -> LineCap)
-> Ord LineCap
LineCap -> LineCap -> Bool
LineCap -> LineCap -> Ordering
LineCap -> LineCap -> LineCap
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LineCap -> LineCap -> LineCap
$cmin :: LineCap -> LineCap -> LineCap
max :: LineCap -> LineCap -> LineCap
$cmax :: LineCap -> LineCap -> LineCap
>= :: LineCap -> LineCap -> Bool
$c>= :: LineCap -> LineCap -> Bool
> :: LineCap -> LineCap -> Bool
$c> :: LineCap -> LineCap -> Bool
<= :: LineCap -> LineCap -> Bool
$c<= :: LineCap -> LineCap -> Bool
< :: LineCap -> LineCap -> Bool
$c< :: LineCap -> LineCap -> Bool
compare :: LineCap -> LineCap -> Ordering
$ccompare :: LineCap -> LineCap -> Ordering
$cp1Ord :: Eq LineCap
Ord, Int -> LineCap -> ShowS
[LineCap] -> ShowS
LineCap -> String
(Int -> LineCap -> ShowS)
-> (LineCap -> String) -> ([LineCap] -> ShowS) -> Show LineCap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineCap] -> ShowS
$cshowList :: [LineCap] -> ShowS
show :: LineCap -> String
$cshow :: LineCap -> String
showsPrec :: Int -> LineCap -> ShowS
$cshowsPrec :: Int -> LineCap -> ShowS
Show, Typeable)

instance Default LineCap where
  def :: LineCap
def = LineCap
LineCapButt

instance AttributeClass LineCap

-- | Last semigroup structure.
instance Semigroup LineCap where
  LineCap
_ <> :: LineCap -> LineCap -> LineCap
<> LineCap
b = LineCap
b

getLineCap :: LineCap -> LineCap
getLineCap :: LineCap -> LineCap
getLineCap = LineCap -> LineCap
forall a. a -> a
id

-- | Set the line end cap attribute.
lineCap :: HasStyle a => LineCap -> a -> a
lineCap :: LineCap -> a -> a
lineCap = LineCap -> a -> a
forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr

-- | Lens onto the line cap in a style.
_lineCap :: Lens' (Style v n) LineCap
_lineCap :: (LineCap -> f LineCap) -> Style v n -> f (Style v n)
_lineCap = (Maybe LineCap -> f (Maybe LineCap)) -> Style v n -> f (Style v n)
forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
atAttr ((Maybe LineCap -> f (Maybe LineCap))
 -> Style v n -> f (Style v n))
-> ((LineCap -> f LineCap) -> Maybe LineCap -> f (Maybe LineCap))
-> (LineCap -> f LineCap)
-> Style v n
-> f (Style v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineCap -> Iso' (Maybe LineCap) LineCap
forall a. Eq a => a -> Iso' (Maybe a) a
non LineCap
forall a. Default a => a
def

-- line join -----------------------------------------------------------

-- | How should the join points between line segments be drawn?
data LineJoin = LineJoinMiter    -- ^ Use a \"miter\" shape (whatever that is).
              | LineJoinRound    -- ^ Use rounded join points.
              | LineJoinBevel    -- ^ Use a \"bevel\" shape (whatever
                                 --   that is).  Are these...
                                 --   carpentry terms?
  deriving (LineJoin -> LineJoin -> Bool
(LineJoin -> LineJoin -> Bool)
-> (LineJoin -> LineJoin -> Bool) -> Eq LineJoin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineJoin -> LineJoin -> Bool
$c/= :: LineJoin -> LineJoin -> Bool
== :: LineJoin -> LineJoin -> Bool
$c== :: LineJoin -> LineJoin -> Bool
Eq, Eq LineJoin
Eq LineJoin
-> (LineJoin -> LineJoin -> Ordering)
-> (LineJoin -> LineJoin -> Bool)
-> (LineJoin -> LineJoin -> Bool)
-> (LineJoin -> LineJoin -> Bool)
-> (LineJoin -> LineJoin -> Bool)
-> (LineJoin -> LineJoin -> LineJoin)
-> (LineJoin -> LineJoin -> LineJoin)
-> Ord LineJoin
LineJoin -> LineJoin -> Bool
LineJoin -> LineJoin -> Ordering
LineJoin -> LineJoin -> LineJoin
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LineJoin -> LineJoin -> LineJoin
$cmin :: LineJoin -> LineJoin -> LineJoin
max :: LineJoin -> LineJoin -> LineJoin
$cmax :: LineJoin -> LineJoin -> LineJoin
>= :: LineJoin -> LineJoin -> Bool
$c>= :: LineJoin -> LineJoin -> Bool
> :: LineJoin -> LineJoin -> Bool
$c> :: LineJoin -> LineJoin -> Bool
<= :: LineJoin -> LineJoin -> Bool
$c<= :: LineJoin -> LineJoin -> Bool
< :: LineJoin -> LineJoin -> Bool
$c< :: LineJoin -> LineJoin -> Bool
compare :: LineJoin -> LineJoin -> Ordering
$ccompare :: LineJoin -> LineJoin -> Ordering
$cp1Ord :: Eq LineJoin
Ord, Int -> LineJoin -> ShowS
[LineJoin] -> ShowS
LineJoin -> String
(Int -> LineJoin -> ShowS)
-> (LineJoin -> String) -> ([LineJoin] -> ShowS) -> Show LineJoin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineJoin] -> ShowS
$cshowList :: [LineJoin] -> ShowS
show :: LineJoin -> String
$cshow :: LineJoin -> String
showsPrec :: Int -> LineJoin -> ShowS
$cshowsPrec :: Int -> LineJoin -> ShowS
Show, Typeable)

instance AttributeClass LineJoin

-- | Last semigroup structure.
instance Semigroup LineJoin where
  LineJoin
_ <> :: LineJoin -> LineJoin -> LineJoin
<> LineJoin
b = LineJoin
b

instance Default LineJoin where
  def :: LineJoin
def = LineJoin
LineJoinMiter

getLineJoin :: LineJoin -> LineJoin
getLineJoin :: LineJoin -> LineJoin
getLineJoin = LineJoin -> LineJoin
forall a. a -> a
id

-- | Set the segment join style.
lineJoin :: HasStyle a => LineJoin -> a -> a
lineJoin :: LineJoin -> a -> a
lineJoin = LineJoin -> a -> a
forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr

-- | Lens onto the line join type in a style.
_lineJoin :: Lens' (Style v n) LineJoin
_lineJoin :: (LineJoin -> f LineJoin) -> Style v n -> f (Style v n)
_lineJoin = (Maybe LineJoin -> f (Maybe LineJoin))
-> Style v n -> f (Style v n)
forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
atAttr ((Maybe LineJoin -> f (Maybe LineJoin))
 -> Style v n -> f (Style v n))
-> ((LineJoin -> f LineJoin)
    -> Maybe LineJoin -> f (Maybe LineJoin))
-> (LineJoin -> f LineJoin)
-> Style v n
-> f (Style v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineJoin -> Iso' (Maybe LineJoin) LineJoin
forall a. Eq a => a -> Iso' (Maybe a) a
non LineJoin
forall a. Default a => a
def

-- miter limit ---------------------------------------------------------

-- | Miter limit attribute affecting the 'LineJoinMiter' joins.
--   For some backends this value may have additional effects.
newtype LineMiterLimit = LineMiterLimit (Last Double)
  deriving (Typeable, b -> LineMiterLimit -> LineMiterLimit
NonEmpty LineMiterLimit -> LineMiterLimit
LineMiterLimit -> LineMiterLimit -> LineMiterLimit
(LineMiterLimit -> LineMiterLimit -> LineMiterLimit)
-> (NonEmpty LineMiterLimit -> LineMiterLimit)
-> (forall b. Integral b => b -> LineMiterLimit -> LineMiterLimit)
-> Semigroup LineMiterLimit
forall b. Integral b => b -> LineMiterLimit -> LineMiterLimit
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> LineMiterLimit -> LineMiterLimit
$cstimes :: forall b. Integral b => b -> LineMiterLimit -> LineMiterLimit
sconcat :: NonEmpty LineMiterLimit -> LineMiterLimit
$csconcat :: NonEmpty LineMiterLimit -> LineMiterLimit
<> :: LineMiterLimit -> LineMiterLimit -> LineMiterLimit
$c<> :: LineMiterLimit -> LineMiterLimit -> LineMiterLimit
Semigroup, LineMiterLimit -> LineMiterLimit -> Bool
(LineMiterLimit -> LineMiterLimit -> Bool)
-> (LineMiterLimit -> LineMiterLimit -> Bool) -> Eq LineMiterLimit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineMiterLimit -> LineMiterLimit -> Bool
$c/= :: LineMiterLimit -> LineMiterLimit -> Bool
== :: LineMiterLimit -> LineMiterLimit -> Bool
$c== :: LineMiterLimit -> LineMiterLimit -> Bool
Eq, Eq LineMiterLimit
Eq LineMiterLimit
-> (LineMiterLimit -> LineMiterLimit -> Ordering)
-> (LineMiterLimit -> LineMiterLimit -> Bool)
-> (LineMiterLimit -> LineMiterLimit -> Bool)
-> (LineMiterLimit -> LineMiterLimit -> Bool)
-> (LineMiterLimit -> LineMiterLimit -> Bool)
-> (LineMiterLimit -> LineMiterLimit -> LineMiterLimit)
-> (LineMiterLimit -> LineMiterLimit -> LineMiterLimit)
-> Ord LineMiterLimit
LineMiterLimit -> LineMiterLimit -> Bool
LineMiterLimit -> LineMiterLimit -> Ordering
LineMiterLimit -> LineMiterLimit -> LineMiterLimit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LineMiterLimit -> LineMiterLimit -> LineMiterLimit
$cmin :: LineMiterLimit -> LineMiterLimit -> LineMiterLimit
max :: LineMiterLimit -> LineMiterLimit -> LineMiterLimit
$cmax :: LineMiterLimit -> LineMiterLimit -> LineMiterLimit
>= :: LineMiterLimit -> LineMiterLimit -> Bool
$c>= :: LineMiterLimit -> LineMiterLimit -> Bool
> :: LineMiterLimit -> LineMiterLimit -> Bool
$c> :: LineMiterLimit -> LineMiterLimit -> Bool
<= :: LineMiterLimit -> LineMiterLimit -> Bool
$c<= :: LineMiterLimit -> LineMiterLimit -> Bool
< :: LineMiterLimit -> LineMiterLimit -> Bool
$c< :: LineMiterLimit -> LineMiterLimit -> Bool
compare :: LineMiterLimit -> LineMiterLimit -> Ordering
$ccompare :: LineMiterLimit -> LineMiterLimit -> Ordering
$cp1Ord :: Eq LineMiterLimit
Ord)
instance AttributeClass LineMiterLimit

_LineMiterLimit :: Iso' LineMiterLimit Double
_LineMiterLimit :: p Double (f Double) -> p LineMiterLimit (f LineMiterLimit)
_LineMiterLimit = (LineMiterLimit -> Double)
-> (Double -> LineMiterLimit)
-> Iso LineMiterLimit LineMiterLimit Double Double
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso LineMiterLimit -> Double
getLineMiterLimit (Last Double -> LineMiterLimit
LineMiterLimit (Last Double -> LineMiterLimit)
-> (Double -> Last Double) -> Double -> LineMiterLimit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Last Double
forall a. a -> Last a
Last)

instance Default LineMiterLimit where
  def :: LineMiterLimit
def = Last Double -> LineMiterLimit
LineMiterLimit (Double -> Last Double
forall a. a -> Last a
Last Double
10)

getLineMiterLimit :: LineMiterLimit -> Double
getLineMiterLimit :: LineMiterLimit -> Double
getLineMiterLimit (LineMiterLimit (Last Double
l)) = Double
l

-- | Set the miter limit for joins with 'LineJoinMiter'.
lineMiterLimit :: HasStyle a => Double -> a -> a
lineMiterLimit :: Double -> a -> a
lineMiterLimit = LineMiterLimit -> a -> a
forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr (LineMiterLimit -> a -> a)
-> (Double -> LineMiterLimit) -> Double -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Last Double -> LineMiterLimit
LineMiterLimit (Last Double -> LineMiterLimit)
-> (Double -> Last Double) -> Double -> LineMiterLimit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Last Double
forall a. a -> Last a
Last

-- | Apply a 'LineMiterLimit' attribute.
lineMiterLimitA :: HasStyle a => LineMiterLimit -> a -> a
lineMiterLimitA :: LineMiterLimit -> a -> a
lineMiterLimitA = LineMiterLimit -> a -> a
forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr

-- | Lens onto the line miter limit in a style.
_lineMiterLimit :: Lens' (Style v n) Double
_lineMiterLimit :: (Double -> f Double) -> Style v n -> f (Style v n)
_lineMiterLimit = (Maybe LineMiterLimit -> f (Maybe LineMiterLimit))
-> Style v n -> f (Style v n)
forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
atAttr ((Maybe LineMiterLimit -> f (Maybe LineMiterLimit))
 -> Style v n -> f (Style v n))
-> ((Double -> f Double)
    -> Maybe LineMiterLimit -> f (Maybe LineMiterLimit))
-> (Double -> f Double)
-> Style v n
-> f (Style v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineMiterLimit -> Iso' (Maybe LineMiterLimit) LineMiterLimit
forall a. Eq a => a -> Iso' (Maybe a) a
non LineMiterLimit
forall a. Default a => a
def ((LineMiterLimit -> f LineMiterLimit)
 -> Maybe LineMiterLimit -> f (Maybe LineMiterLimit))
-> ((Double -> f Double) -> LineMiterLimit -> f LineMiterLimit)
-> (Double -> f Double)
-> Maybe LineMiterLimit
-> f (Maybe LineMiterLimit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> f Double) -> LineMiterLimit -> f LineMiterLimit
Iso LineMiterLimit LineMiterLimit Double Double
_LineMiterLimit

------------------------------------------------------------------------
-- Recommend optics
------------------------------------------------------------------------

-- | Prism onto a 'Recommend'.
_Recommend :: Prism' (Recommend a) a
_Recommend :: p a (f a) -> p (Recommend a) (f (Recommend a))
_Recommend = (a -> Recommend a)
-> (Recommend a -> Maybe a)
-> Prism (Recommend a) (Recommend a) a a
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' a -> Recommend a
forall a. a -> Recommend a
Recommend ((Recommend a -> Maybe a) -> Prism (Recommend a) (Recommend a) a a)
-> (Recommend a -> Maybe a)
-> Prism (Recommend a) (Recommend a) a a
forall a b. (a -> b) -> a -> b
$ \case (Recommend a
a) -> a -> Maybe a
forall a. a -> Maybe a
Just a
a; Recommend a
_ -> Maybe a
forall a. Maybe a
Nothing

-- | Prism onto a 'Commit'.
_Commit :: Prism' (Recommend a) a
_Commit :: p a (f a) -> p (Recommend a) (f (Recommend a))
_Commit = (a -> Recommend a)
-> (Recommend a -> Maybe a)
-> Prism (Recommend a) (Recommend a) a a
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' a -> Recommend a
forall a. a -> Recommend a
Commit ((Recommend a -> Maybe a) -> Prism (Recommend a) (Recommend a) a a)
-> (Recommend a -> Maybe a)
-> Prism (Recommend a) (Recommend a) a a
forall a b. (a -> b) -> a -> b
$ \case (Commit a
a) -> a -> Maybe a
forall a. a -> Maybe a
Just a
a; Recommend a
_ -> Maybe a
forall a. Maybe a
Nothing

-- | Lens onto the value inside either a 'Recommend' or 'Commit'. Unlike
--   'committed', this is a valid lens.
_recommend :: Lens (Recommend a) (Recommend b) a b
_recommend :: (a -> f b) -> Recommend a -> f (Recommend b)
_recommend a -> f b
f (Recommend a
a) = b -> Recommend b
forall a. a -> Recommend a
Recommend (b -> Recommend b) -> f b -> f (Recommend b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
_recommend a -> f b
f (Commit a
a)    = b -> Recommend b
forall a. a -> Recommend a
Commit (b -> Recommend b) -> f b -> f (Recommend b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a

-- | Lens onto whether something is committed or not.
isCommitted :: Lens' (Recommend a) Bool
isCommitted :: (Bool -> f Bool) -> Recommend a -> f (Recommend a)
isCommitted Bool -> f Bool
f r :: Recommend a
r@(Recommend a
a) = Bool -> f Bool
f Bool
False f Bool -> (Bool -> Recommend a) -> f (Recommend a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Bool
b -> if Bool
b then a -> Recommend a
forall a. a -> Recommend a
Commit a
a else Recommend a
r
isCommitted Bool -> f Bool
f r :: Recommend a
r@(Commit a
a)    = Bool -> f Bool
f Bool
True  f Bool -> (Bool -> Recommend a) -> f (Recommend a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Bool
b -> if Bool
b then Recommend a
r else a -> Recommend a
forall a. a -> Recommend a
Recommend a
a

-- | 'Commit' a value for any 'Recommend'. This is *not* a valid 'Iso'
--   because the resulting @Recommend b@ is always a 'Commit'. This is
--   useful because it means any 'Recommend' styles set with a lens will
--   not be accidentally overridden. If you want a valid lens onto a
--   recommend value use '_recommend'.
--
--   Other lenses that use this are labeled with a warning.
committed :: Iso (Recommend a) (Recommend b) a b
committed :: p a (f b) -> p (Recommend a) (f (Recommend b))
committed = (Recommend a -> a)
-> (b -> Recommend b) -> Iso (Recommend a) (Recommend b) a b
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Recommend a -> a
forall a. Recommend a -> a
getRecommend b -> Recommend b
forall a. a -> Recommend a
Commit