{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Diagrams.ThreeD.Attributes where
import Control.Lens
import Data.Semigroup
import Data.Typeable
import Data.Colour
import Diagrams.Core
newtype SurfaceColor = SurfaceColor (Last (Colour Double))
deriving (Typeable, NonEmpty SurfaceColor -> SurfaceColor
SurfaceColor -> SurfaceColor -> SurfaceColor
(SurfaceColor -> SurfaceColor -> SurfaceColor)
-> (NonEmpty SurfaceColor -> SurfaceColor)
-> (forall b. Integral b => b -> SurfaceColor -> SurfaceColor)
-> Semigroup SurfaceColor
forall b. Integral b => b -> SurfaceColor -> SurfaceColor
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: SurfaceColor -> SurfaceColor -> SurfaceColor
<> :: SurfaceColor -> SurfaceColor -> SurfaceColor
$csconcat :: NonEmpty SurfaceColor -> SurfaceColor
sconcat :: NonEmpty SurfaceColor -> SurfaceColor
$cstimes :: forall b. Integral b => b -> SurfaceColor -> SurfaceColor
stimes :: forall b. Integral b => b -> SurfaceColor -> SurfaceColor
Semigroup, Int -> SurfaceColor -> ShowS
[SurfaceColor] -> ShowS
SurfaceColor -> String
(Int -> SurfaceColor -> ShowS)
-> (SurfaceColor -> String)
-> ([SurfaceColor] -> ShowS)
-> Show SurfaceColor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SurfaceColor -> ShowS
showsPrec :: Int -> SurfaceColor -> ShowS
$cshow :: SurfaceColor -> String
show :: SurfaceColor -> String
$cshowList :: [SurfaceColor] -> ShowS
showList :: [SurfaceColor] -> ShowS
Show)
instance AttributeClass SurfaceColor
_SurfaceColor :: Iso' SurfaceColor (Colour Double)
_SurfaceColor :: Iso' SurfaceColor (Colour Double)
_SurfaceColor = (SurfaceColor -> Colour Double)
-> (Colour Double -> SurfaceColor)
-> Iso' SurfaceColor (Colour Double)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(SurfaceColor (Last Colour Double
c)) -> Colour Double
c) (Last (Colour Double) -> SurfaceColor
SurfaceColor (Last (Colour Double) -> SurfaceColor)
-> (Colour Double -> Last (Colour Double))
-> Colour Double
-> SurfaceColor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Colour Double -> Last (Colour Double)
forall a. a -> Last a
Last)
sc :: HasStyle d => Colour Double -> d -> d
sc :: forall d. HasStyle d => Colour Double -> d -> d
sc = SurfaceColor -> d -> d
forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr (SurfaceColor -> d -> d)
-> (Colour Double -> SurfaceColor) -> Colour Double -> d -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AReview SurfaceColor (Colour Double)
-> Colour Double -> SurfaceColor
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview SurfaceColor (Colour Double)
Iso' SurfaceColor (Colour Double)
_SurfaceColor
_sc :: Lens' (Style v n) (Maybe (Colour Double))
_sc :: forall (v :: * -> *) n (f :: * -> *).
Functor f =>
(Maybe (Colour Double) -> f (Maybe (Colour Double)))
-> Style v n -> f (Style v n)
_sc = (Maybe SurfaceColor -> f (Maybe SurfaceColor))
-> Style v n -> f (Style v n)
forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
Lens' (Style v n) (Maybe SurfaceColor)
atAttr ((Maybe SurfaceColor -> f (Maybe SurfaceColor))
-> Style v n -> f (Style v n))
-> ((Maybe (Colour Double) -> f (Maybe (Colour Double)))
-> Maybe SurfaceColor -> f (Maybe SurfaceColor))
-> (Maybe (Colour Double) -> f (Maybe (Colour Double)))
-> Style v n
-> f (Style v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso SurfaceColor SurfaceColor (Colour Double) (Colour Double)
-> Iso
(Maybe SurfaceColor)
(Maybe SurfaceColor)
(Maybe (Colour Double))
(Maybe (Colour 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 SurfaceColor SurfaceColor (Colour Double) (Colour Double)
Iso' SurfaceColor (Colour Double)
_SurfaceColor
newtype Diffuse = Diffuse (Last Double)
deriving (Typeable, NonEmpty Diffuse -> Diffuse
Diffuse -> Diffuse -> Diffuse
(Diffuse -> Diffuse -> Diffuse)
-> (NonEmpty Diffuse -> Diffuse)
-> (forall b. Integral b => b -> Diffuse -> Diffuse)
-> Semigroup Diffuse
forall b. Integral b => b -> Diffuse -> Diffuse
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Diffuse -> Diffuse -> Diffuse
<> :: Diffuse -> Diffuse -> Diffuse
$csconcat :: NonEmpty Diffuse -> Diffuse
sconcat :: NonEmpty Diffuse -> Diffuse
$cstimes :: forall b. Integral b => b -> Diffuse -> Diffuse
stimes :: forall b. Integral b => b -> Diffuse -> Diffuse
Semigroup, Int -> Diffuse -> ShowS
[Diffuse] -> ShowS
Diffuse -> String
(Int -> Diffuse -> ShowS)
-> (Diffuse -> String) -> ([Diffuse] -> ShowS) -> Show Diffuse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Diffuse -> ShowS
showsPrec :: Int -> Diffuse -> ShowS
$cshow :: Diffuse -> String
show :: Diffuse -> String
$cshowList :: [Diffuse] -> ShowS
showList :: [Diffuse] -> ShowS
Show)
instance AttributeClass Diffuse
_Diffuse :: Iso' Diffuse Double
_Diffuse :: Iso' Diffuse Double
_Diffuse = (Diffuse -> Double) -> (Double -> Diffuse) -> Iso' Diffuse Double
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(Diffuse (Last Double
d)) -> Double
d) (Last Double -> Diffuse
Diffuse (Last Double -> Diffuse)
-> (Double -> Last Double) -> Double -> Diffuse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Last Double
forall a. a -> Last a
Last)
diffuse :: HasStyle d => Double -> d -> d
diffuse :: forall d. HasStyle d => Double -> d -> d
diffuse = Diffuse -> d -> d
forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr (Diffuse -> d -> d) -> (Double -> Diffuse) -> Double -> d -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AReview Diffuse Double -> Double -> Diffuse
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview Diffuse Double
Iso' Diffuse Double
_Diffuse
_diffuse :: Lens' (Style v n) (Maybe Double)
_diffuse :: forall (v :: * -> *) n (f :: * -> *).
Functor f =>
(Maybe Double -> f (Maybe Double)) -> Style v n -> f (Style v n)
_diffuse = (Maybe Diffuse -> f (Maybe Diffuse)) -> Style v n -> f (Style v n)
forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
Lens' (Style v n) (Maybe Diffuse)
atAttr ((Maybe Diffuse -> f (Maybe Diffuse))
-> Style v n -> f (Style v n))
-> ((Maybe Double -> f (Maybe Double))
-> Maybe Diffuse -> f (Maybe Diffuse))
-> (Maybe Double -> f (Maybe Double))
-> Style v n
-> f (Style v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso Diffuse Diffuse Double Double
-> Iso
(Maybe Diffuse) (Maybe Diffuse) (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 Diffuse Diffuse Double Double
Iso' Diffuse Double
_Diffuse
newtype Ambient = Ambient (Last Double)
deriving (Typeable, NonEmpty Ambient -> Ambient
Ambient -> Ambient -> Ambient
(Ambient -> Ambient -> Ambient)
-> (NonEmpty Ambient -> Ambient)
-> (forall b. Integral b => b -> Ambient -> Ambient)
-> Semigroup Ambient
forall b. Integral b => b -> Ambient -> Ambient
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Ambient -> Ambient -> Ambient
<> :: Ambient -> Ambient -> Ambient
$csconcat :: NonEmpty Ambient -> Ambient
sconcat :: NonEmpty Ambient -> Ambient
$cstimes :: forall b. Integral b => b -> Ambient -> Ambient
stimes :: forall b. Integral b => b -> Ambient -> Ambient
Semigroup, Int -> Ambient -> ShowS
[Ambient] -> ShowS
Ambient -> String
(Int -> Ambient -> ShowS)
-> (Ambient -> String) -> ([Ambient] -> ShowS) -> Show Ambient
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ambient -> ShowS
showsPrec :: Int -> Ambient -> ShowS
$cshow :: Ambient -> String
show :: Ambient -> String
$cshowList :: [Ambient] -> ShowS
showList :: [Ambient] -> ShowS
Show)
instance AttributeClass Ambient
_Ambient :: Iso' Ambient Double
_Ambient :: Iso' Ambient Double
_Ambient = (Ambient -> Double) -> (Double -> Ambient) -> Iso' Ambient Double
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(Ambient (Last Double
d)) -> Double
d) (Last Double -> Ambient
Ambient (Last Double -> Ambient)
-> (Double -> Last Double) -> Double -> Ambient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Last Double
forall a. a -> Last a
Last)
ambient :: HasStyle d => Double -> d -> d
ambient :: forall d. HasStyle d => Double -> d -> d
ambient = Ambient -> d -> d
forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr (Ambient -> d -> d) -> (Double -> Ambient) -> Double -> d -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AReview Ambient Double -> Double -> Ambient
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview Ambient Double
Iso' Ambient Double
_Ambient
_ambient :: Lens' (Style v n) (Maybe Double)
_ambient :: forall (v :: * -> *) n (f :: * -> *).
Functor f =>
(Maybe Double -> f (Maybe Double)) -> Style v n -> f (Style v n)
_ambient = (Maybe Ambient -> f (Maybe Ambient)) -> Style v n -> f (Style v n)
forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
Lens' (Style v n) (Maybe Ambient)
atAttr ((Maybe Ambient -> f (Maybe Ambient))
-> Style v n -> f (Style v n))
-> ((Maybe Double -> f (Maybe Double))
-> Maybe Ambient -> f (Maybe Ambient))
-> (Maybe Double -> f (Maybe Double))
-> Style v n
-> f (Style v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso Ambient Ambient Double Double
-> Iso
(Maybe Ambient) (Maybe Ambient) (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 Ambient Ambient Double Double
Iso' Ambient Double
_Ambient
data Specular = Specular
{ Specular -> Double
_specularIntensity :: Double
, Specular -> Double
_specularSize :: Double
} deriving Int -> Specular -> ShowS
[Specular] -> ShowS
Specular -> String
(Int -> Specular -> ShowS)
-> (Specular -> String) -> ([Specular] -> ShowS) -> Show Specular
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Specular -> ShowS
showsPrec :: Int -> Specular -> ShowS
$cshow :: Specular -> String
show :: Specular -> String
$cshowList :: [Specular] -> ShowS
showList :: [Specular] -> ShowS
Show
makeLenses ''Specular
newtype Highlight = Highlight (Last Specular)
deriving (Typeable, NonEmpty Highlight -> Highlight
Highlight -> Highlight -> Highlight
(Highlight -> Highlight -> Highlight)
-> (NonEmpty Highlight -> Highlight)
-> (forall b. Integral b => b -> Highlight -> Highlight)
-> Semigroup Highlight
forall b. Integral b => b -> Highlight -> Highlight
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Highlight -> Highlight -> Highlight
<> :: Highlight -> Highlight -> Highlight
$csconcat :: NonEmpty Highlight -> Highlight
sconcat :: NonEmpty Highlight -> Highlight
$cstimes :: forall b. Integral b => b -> Highlight -> Highlight
stimes :: forall b. Integral b => b -> Highlight -> Highlight
Semigroup, Int -> Highlight -> ShowS
[Highlight] -> ShowS
Highlight -> String
(Int -> Highlight -> ShowS)
-> (Highlight -> String)
-> ([Highlight] -> ShowS)
-> Show Highlight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Highlight -> ShowS
showsPrec :: Int -> Highlight -> ShowS
$cshow :: Highlight -> String
show :: Highlight -> String
$cshowList :: [Highlight] -> ShowS
showList :: [Highlight] -> ShowS
Show)
instance AttributeClass Highlight
_Highlight :: Iso' Highlight Specular
_Highlight :: Iso' Highlight Specular
_Highlight = (Highlight -> Specular)
-> (Specular -> Highlight) -> Iso' Highlight Specular
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(Highlight (Last Specular
s)) -> Specular
s) (Last Specular -> Highlight
Highlight (Last Specular -> Highlight)
-> (Specular -> Last Specular) -> Specular -> Highlight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Specular -> Last Specular
forall a. a -> Last a
Last)
highlight :: HasStyle d => Specular -> d -> d
highlight :: forall d. HasStyle d => Specular -> d -> d
highlight = Highlight -> d -> d
forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr (Highlight -> d -> d)
-> (Specular -> Highlight) -> Specular -> d -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AReview Highlight Specular -> Specular -> Highlight
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview Highlight Specular
Iso' Highlight Specular
_Highlight
_highlight :: Lens' (Style v n) (Maybe Specular)
_highlight :: forall (v :: * -> *) n (f :: * -> *).
Functor f =>
(Maybe Specular -> f (Maybe Specular))
-> Style v n -> f (Style v n)
_highlight = (Maybe Highlight -> f (Maybe Highlight))
-> Style v n -> f (Style v n)
forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
Lens' (Style v n) (Maybe Highlight)
atAttr ((Maybe Highlight -> f (Maybe Highlight))
-> Style v n -> f (Style v n))
-> ((Maybe Specular -> f (Maybe Specular))
-> Maybe Highlight -> f (Maybe Highlight))
-> (Maybe Specular -> f (Maybe Specular))
-> Style v n
-> f (Style v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso Highlight Highlight Specular Specular
-> Iso
(Maybe Highlight)
(Maybe Highlight)
(Maybe Specular)
(Maybe Specular)
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 Highlight Highlight Specular Specular
Iso' Highlight Specular
_Highlight
highlightIntensity :: Traversal' (Style v n) Double
highlightIntensity :: forall (v :: * -> *) n (f :: * -> *).
Applicative f =>
(Double -> f Double) -> Style v n -> f (Style v n)
highlightIntensity = (Maybe Specular -> f (Maybe Specular))
-> Style v n -> f (Style v n)
forall (v :: * -> *) n (f :: * -> *).
Functor f =>
(Maybe Specular -> f (Maybe Specular))
-> Style v n -> f (Style v n)
_highlight ((Maybe Specular -> f (Maybe Specular))
-> Style v n -> f (Style v n))
-> ((Double -> f Double) -> Maybe Specular -> f (Maybe Specular))
-> (Double -> f Double)
-> Style v n
-> f (Style v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Specular -> f Specular) -> Maybe Specular -> f (Maybe Specular)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Specular -> f Specular) -> Maybe Specular -> f (Maybe Specular))
-> ((Double -> f Double) -> Specular -> f Specular)
-> (Double -> f Double)
-> Maybe Specular
-> f (Maybe Specular)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> f Double) -> Specular -> f Specular
Lens' Specular Double
specularSize
highlightSize :: Traversal' (Style v n) Double
highlightSize :: forall (v :: * -> *) n (f :: * -> *).
Applicative f =>
(Double -> f Double) -> Style v n -> f (Style v n)
highlightSize = (Maybe Specular -> f (Maybe Specular))
-> Style v n -> f (Style v n)
forall (v :: * -> *) n (f :: * -> *).
Functor f =>
(Maybe Specular -> f (Maybe Specular))
-> Style v n -> f (Style v n)
_highlight ((Maybe Specular -> f (Maybe Specular))
-> Style v n -> f (Style v n))
-> ((Double -> f Double) -> Maybe Specular -> f (Maybe Specular))
-> (Double -> f Double)
-> Style v n
-> f (Style v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Specular -> f Specular) -> Maybe Specular -> f (Maybe Specular)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Specular -> f Specular) -> Maybe Specular -> f (Maybe Specular))
-> ((Double -> f Double) -> Specular -> f Specular)
-> (Double -> f Double)
-> Maybe Specular
-> f (Maybe Specular)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> f Double) -> Specular -> f Specular
Lens' Specular Double
specularSize