{-# LANGUAGE DeriveGeneric #-}
{-
  Home of basic types without fields.
-}
module Graphics.SvgTree.Types.Basic where

import           Codec.Picture             (PixelRGBA8 (..))
import           GHC.Generics              (Generic)
import           Graphics.SvgTree.CssTypes (Number)
import           Linear                    (V2)

-- | Basic coordinate type.
type Coord = Double

-- | Real Point, fully determined and
-- independent of the rendering context.
type RPoint = V2 Coord

-- FIXME: Use 'V2 Number' instead of tuple
-- | Possibly context dependant point.
type Point = (Number, Number)

-- | Tell if a path command is absolute (in the current
-- user coordiante) or relative to the previous point.
data Origin
  = OriginAbsolute -- ^ Next point in absolute coordinate
  | OriginRelative -- ^ Next point relative to the previous
  deriving (Origin -> Origin -> Bool
(Origin -> Origin -> Bool)
-> (Origin -> Origin -> Bool) -> Eq Origin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Origin -> Origin -> Bool
$c/= :: Origin -> Origin -> Bool
== :: Origin -> Origin -> Bool
$c== :: Origin -> Origin -> Bool
Eq, Int -> Origin -> ShowS
[Origin] -> ShowS
Origin -> String
(Int -> Origin -> ShowS)
-> (Origin -> String) -> ([Origin] -> ShowS) -> Show Origin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Origin] -> ShowS
$cshowList :: [Origin] -> ShowS
show :: Origin -> String
$cshow :: Origin -> String
showsPrec :: Int -> Origin -> ShowS
$cshowsPrec :: Int -> Origin -> ShowS
Show, (forall x. Origin -> Rep Origin x)
-> (forall x. Rep Origin x -> Origin) -> Generic Origin
forall x. Rep Origin x -> Origin
forall x. Origin -> Rep Origin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Origin x -> Origin
$cfrom :: forall x. Origin -> Rep Origin x
Generic)


data MeshGradientType
  = GradientBilinear
  | GradientBicubic
  deriving (MeshGradientType -> MeshGradientType -> Bool
(MeshGradientType -> MeshGradientType -> Bool)
-> (MeshGradientType -> MeshGradientType -> Bool)
-> Eq MeshGradientType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MeshGradientType -> MeshGradientType -> Bool
$c/= :: MeshGradientType -> MeshGradientType -> Bool
== :: MeshGradientType -> MeshGradientType -> Bool
$c== :: MeshGradientType -> MeshGradientType -> Bool
Eq, Int -> MeshGradientType -> ShowS
[MeshGradientType] -> ShowS
MeshGradientType -> String
(Int -> MeshGradientType -> ShowS)
-> (MeshGradientType -> String)
-> ([MeshGradientType] -> ShowS)
-> Show MeshGradientType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MeshGradientType] -> ShowS
$cshowList :: [MeshGradientType] -> ShowS
show :: MeshGradientType -> String
$cshow :: MeshGradientType -> String
showsPrec :: Int -> MeshGradientType -> ShowS
$cshowsPrec :: Int -> MeshGradientType -> ShowS
Show, (forall x. MeshGradientType -> Rep MeshGradientType x)
-> (forall x. Rep MeshGradientType x -> MeshGradientType)
-> Generic MeshGradientType
forall x. Rep MeshGradientType x -> MeshGradientType
forall x. MeshGradientType -> Rep MeshGradientType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MeshGradientType x -> MeshGradientType
$cfrom :: forall x. MeshGradientType -> Rep MeshGradientType x
Generic)

-- | Defines the possible values of various *units attributes
-- used in the definition of the gradients and masks.
data CoordinateUnits
    = CoordUserSpace   -- ^ `userSpaceOnUse` value
    | CoordBoundingBox -- ^ `objectBoundingBox` value
    deriving (CoordinateUnits -> CoordinateUnits -> Bool
(CoordinateUnits -> CoordinateUnits -> Bool)
-> (CoordinateUnits -> CoordinateUnits -> Bool)
-> Eq CoordinateUnits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoordinateUnits -> CoordinateUnits -> Bool
$c/= :: CoordinateUnits -> CoordinateUnits -> Bool
== :: CoordinateUnits -> CoordinateUnits -> Bool
$c== :: CoordinateUnits -> CoordinateUnits -> Bool
Eq, Int -> CoordinateUnits -> ShowS
[CoordinateUnits] -> ShowS
CoordinateUnits -> String
(Int -> CoordinateUnits -> ShowS)
-> (CoordinateUnits -> String)
-> ([CoordinateUnits] -> ShowS)
-> Show CoordinateUnits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoordinateUnits] -> ShowS
$cshowList :: [CoordinateUnits] -> ShowS
show :: CoordinateUnits -> String
$cshow :: CoordinateUnits -> String
showsPrec :: Int -> CoordinateUnits -> ShowS
$cshowsPrec :: Int -> CoordinateUnits -> ShowS
Show, (forall x. CoordinateUnits -> Rep CoordinateUnits x)
-> (forall x. Rep CoordinateUnits x -> CoordinateUnits)
-> Generic CoordinateUnits
forall x. Rep CoordinateUnits x -> CoordinateUnits
forall x. CoordinateUnits -> Rep CoordinateUnits x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CoordinateUnits x -> CoordinateUnits
$cfrom :: forall x. CoordinateUnits -> Rep CoordinateUnits x
Generic)

-- | This type represents the align information of the
-- `preserveAspectRatio` SVGattribute
data Alignment
  = AlignNone     -- ^ `none` value
  | AlignxMinYMin -- ^ `xMinYMin` value
  | AlignxMidYMin -- ^ `xMidYMin` value
  | AlignxMaxYMin -- ^ `xMaxYMin` value
  | AlignxMinYMid -- ^ `xMinYMid` value
  | AlignxMidYMid -- ^ `xMidYMid` value
  | AlignxMaxYMid -- ^ `xMaxYMid` value
  | AlignxMinYMax -- ^ `xMinYMax` value
  | AlignxMidYMax -- ^ `xMidYMax` value
  | AlignxMaxYMax -- ^ `xMaxYMax` value
  deriving (Alignment -> Alignment -> Bool
(Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool) -> Eq Alignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Alignment -> Alignment -> Bool
$c/= :: Alignment -> Alignment -> Bool
== :: Alignment -> Alignment -> Bool
$c== :: Alignment -> Alignment -> Bool
Eq, Int -> Alignment -> ShowS
[Alignment] -> ShowS
Alignment -> String
(Int -> Alignment -> ShowS)
-> (Alignment -> String)
-> ([Alignment] -> ShowS)
-> Show Alignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Alignment] -> ShowS
$cshowList :: [Alignment] -> ShowS
show :: Alignment -> String
$cshow :: Alignment -> String
showsPrec :: Int -> Alignment -> ShowS
$cshowsPrec :: Int -> Alignment -> ShowS
Show, (forall x. Alignment -> Rep Alignment x)
-> (forall x. Rep Alignment x -> Alignment) -> Generic Alignment
forall x. Rep Alignment x -> Alignment
forall x. Alignment -> Rep Alignment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Alignment x -> Alignment
$cfrom :: forall x. Alignment -> Rep Alignment x
Generic)

-- | This type represents the "meet or slice" information
-- of the `preserveAspectRatio` SVG attribute
data MeetSlice = Meet | Slice
    deriving (MeetSlice -> MeetSlice -> Bool
(MeetSlice -> MeetSlice -> Bool)
-> (MeetSlice -> MeetSlice -> Bool) -> Eq MeetSlice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MeetSlice -> MeetSlice -> Bool
$c/= :: MeetSlice -> MeetSlice -> Bool
== :: MeetSlice -> MeetSlice -> Bool
$c== :: MeetSlice -> MeetSlice -> Bool
Eq, Int -> MeetSlice -> ShowS
[MeetSlice] -> ShowS
MeetSlice -> String
(Int -> MeetSlice -> ShowS)
-> (MeetSlice -> String)
-> ([MeetSlice] -> ShowS)
-> Show MeetSlice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MeetSlice] -> ShowS
$cshowList :: [MeetSlice] -> ShowS
show :: MeetSlice -> String
$cshow :: MeetSlice -> String
showsPrec :: Int -> MeetSlice -> ShowS
$cshowsPrec :: Int -> MeetSlice -> ShowS
Show, (forall x. MeetSlice -> Rep MeetSlice x)
-> (forall x. Rep MeetSlice x -> MeetSlice) -> Generic MeetSlice
forall x. Rep MeetSlice x -> MeetSlice
forall x. MeetSlice -> Rep MeetSlice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MeetSlice x -> MeetSlice
$cfrom :: forall x. MeetSlice -> Rep MeetSlice x
Generic)

-- | Describes how the line should be terminated
-- when stroked. Describes the values of the
-- `stroke-linecap` attribute.
-- See `_strokeLineCap`
data Cap
  = CapRound -- ^ End with a round (`round` value)
  | CapButt  -- ^ Define straight just at the end (`butt` value)
  | CapSquare -- ^ Straight further of the ends (`square` value)
  deriving (Cap -> Cap -> Bool
(Cap -> Cap -> Bool) -> (Cap -> Cap -> Bool) -> Eq Cap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cap -> Cap -> Bool
$c/= :: Cap -> Cap -> Bool
== :: Cap -> Cap -> Bool
$c== :: Cap -> Cap -> Bool
Eq, Int -> Cap -> ShowS
[Cap] -> ShowS
Cap -> String
(Int -> Cap -> ShowS)
-> (Cap -> String) -> ([Cap] -> ShowS) -> Show Cap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cap] -> ShowS
$cshowList :: [Cap] -> ShowS
show :: Cap -> String
$cshow :: Cap -> String
showsPrec :: Int -> Cap -> ShowS
$cshowsPrec :: Int -> Cap -> ShowS
Show, (forall x. Cap -> Rep Cap x)
-> (forall x. Rep Cap x -> Cap) -> Generic Cap
forall x. Rep Cap x -> Cap
forall x. Cap -> Rep Cap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cap x -> Cap
$cfrom :: forall x. Cap -> Rep Cap x
Generic)

-- | Defines the possible values of the `stroke-linejoin`
-- attribute.
-- see `_strokeLineJoin`
data LineJoin
    = JoinMiter -- ^ `miter` value
    | JoinBevel -- ^ `bevel` value
    | JoinRound -- ^ `round` value
    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, 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, (forall x. LineJoin -> Rep LineJoin x)
-> (forall x. Rep LineJoin x -> LineJoin) -> Generic LineJoin
forall x. Rep LineJoin x -> LineJoin
forall x. LineJoin -> Rep LineJoin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineJoin x -> LineJoin
$cfrom :: forall x. LineJoin -> Rep LineJoin x
Generic)

-- | Describes the different values which can be used
-- in the `fill` or `stroke` attributes.
data Texture
  = ColorRef   PixelRGBA8 -- ^ Direct solid color (#rrggbb, #rgb)
  | TextureRef String     -- ^ Link to a complex texture (url(#name))
  | FillNone              -- ^ Equivalent to the `none` value.
  deriving (Texture -> Texture -> Bool
(Texture -> Texture -> Bool)
-> (Texture -> Texture -> Bool) -> Eq Texture
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Texture -> Texture -> Bool
$c/= :: Texture -> Texture -> Bool
== :: Texture -> Texture -> Bool
$c== :: Texture -> Texture -> Bool
Eq, Int -> Texture -> ShowS
[Texture] -> ShowS
Texture -> String
(Int -> Texture -> ShowS)
-> (Texture -> String) -> ([Texture] -> ShowS) -> Show Texture
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Texture] -> ShowS
$cshowList :: [Texture] -> ShowS
show :: Texture -> String
$cshow :: Texture -> String
showsPrec :: Int -> Texture -> ShowS
$cshowsPrec :: Int -> Texture -> ShowS
Show, (forall x. Texture -> Rep Texture x)
-> (forall x. Rep Texture x -> Texture) -> Generic Texture
forall x. Rep Texture x -> Texture
forall x. Texture -> Rep Texture x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Texture x -> Texture
$cfrom :: forall x. Texture -> Rep Texture x
Generic)

-- | Describe the possible filling algorithms.
-- Map the values of the `fill-rule` attributes.
data FillRule
    = FillEvenOdd -- ^ Corresponds to the `evenodd` value.
    | FillNonZero -- ^ Corresponds to the `nonzero` value.
    deriving (FillRule -> FillRule -> Bool
(FillRule -> FillRule -> Bool)
-> (FillRule -> FillRule -> Bool) -> Eq FillRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FillRule -> FillRule -> Bool
$c/= :: FillRule -> FillRule -> Bool
== :: FillRule -> FillRule -> Bool
$c== :: FillRule -> FillRule -> Bool
Eq, Int -> FillRule -> ShowS
[FillRule] -> ShowS
FillRule -> String
(Int -> FillRule -> ShowS)
-> (FillRule -> String) -> ([FillRule] -> ShowS) -> Show FillRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FillRule] -> ShowS
$cshowList :: [FillRule] -> ShowS
show :: FillRule -> String
$cshow :: FillRule -> String
showsPrec :: Int -> FillRule -> ShowS
$cshowsPrec :: Int -> FillRule -> ShowS
Show, (forall x. FillRule -> Rep FillRule x)
-> (forall x. Rep FillRule x -> FillRule) -> Generic FillRule
forall x. Rep FillRule x -> FillRule
forall x. FillRule -> Rep FillRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FillRule x -> FillRule
$cfrom :: forall x. FillRule -> Rep FillRule x
Generic)