{-# language DeriveDataTypeable #-}
{-# language ViewPatterns #-}

module CodeWorld.Test.AbsTypes (
  Size,
  Angle,
  Factor(..),
  Position(..),
  AbsColor(..),
  ShapeKind(..),
  Thickness(..),
  AbsPoint,
  toFactor,
  fromFactor,
  toPosition,
  fromPosition,
  toAngle,
  fromAngle,
  toAbsPoint,
  fromAbsPoint,
  fromSize,
  toSize,
  toAbsColor,
  fromAbsColor,
  isSameColor,
  equalColorCustom,
  applyToAbsPoint,
  thickness,
) where


import Data.Data                        (Data)
import Data.Tuple.Extra                 (both)

import CodeWorld.Tasks.Color            (Color)
import CodeWorld.Tasks.VectorSpace      (Point)
import qualified CodeWorld.Tasks.Color  as T



{- |
Abstract representation of radii and side lengths.
All values are considered equal.
-}
newtype Size = Size Double deriving (Eq Size
Eq Size =>
(Size -> Size -> Ordering)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Size)
-> (Size -> Size -> Size)
-> Ord Size
Size -> Size -> Bool
Size -> Size -> Ordering
Size -> Size -> Size
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
$ccompare :: Size -> Size -> Ordering
compare :: Size -> Size -> Ordering
$c< :: Size -> Size -> Bool
< :: Size -> Size -> Bool
$c<= :: Size -> Size -> Bool
<= :: Size -> Size -> Bool
$c> :: Size -> Size -> Bool
> :: Size -> Size -> Bool
$c>= :: Size -> Size -> Bool
>= :: Size -> Size -> Bool
$cmax :: Size -> Size -> Size
max :: Size -> Size -> Size
$cmin :: Size -> Size -> Size
min :: Size -> Size -> Size
Ord,Typeable Size
Typeable Size =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Size -> c Size)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Size)
-> (Size -> Constr)
-> (Size -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Size))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Size))
-> ((forall b. Data b => b -> b) -> Size -> Size)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Size -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Size -> r)
-> (forall u. (forall d. Data d => d -> u) -> Size -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Size -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Size -> m Size)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Size -> m Size)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Size -> m Size)
-> Data Size
Size -> Constr
Size -> DataType
(forall b. Data b => b -> b) -> Size -> Size
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Size -> u
forall u. (forall d. Data d => d -> u) -> Size -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Size -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Size -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Size -> m Size
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Size -> m Size
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Size
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Size -> c Size
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Size)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Size)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Size -> c Size
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Size -> c Size
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Size
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Size
$ctoConstr :: Size -> Constr
toConstr :: Size -> Constr
$cdataTypeOf :: Size -> DataType
dataTypeOf :: Size -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Size)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Size)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Size)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Size)
$cgmapT :: (forall b. Data b => b -> b) -> Size -> Size
gmapT :: (forall b. Data b => b -> b) -> Size -> Size
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Size -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Size -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Size -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Size -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Size -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Size -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Size -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Size -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Size -> m Size
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Size -> m Size
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Size -> m Size
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Size -> m Size
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Size -> m Size
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Size -> m Size
Data)

{- |
Abstract representation of points in 2D space.
All values are considered equal.
-}
newtype AbsPoint = AbsPoint {AbsPoint -> (Position, Position)
unAbsPoint :: (Position,Position)} deriving (Eq AbsPoint
Eq AbsPoint =>
(AbsPoint -> AbsPoint -> Ordering)
-> (AbsPoint -> AbsPoint -> Bool)
-> (AbsPoint -> AbsPoint -> Bool)
-> (AbsPoint -> AbsPoint -> Bool)
-> (AbsPoint -> AbsPoint -> Bool)
-> (AbsPoint -> AbsPoint -> AbsPoint)
-> (AbsPoint -> AbsPoint -> AbsPoint)
-> Ord AbsPoint
AbsPoint -> AbsPoint -> Bool
AbsPoint -> AbsPoint -> Ordering
AbsPoint -> AbsPoint -> AbsPoint
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
$ccompare :: AbsPoint -> AbsPoint -> Ordering
compare :: AbsPoint -> AbsPoint -> Ordering
$c< :: AbsPoint -> AbsPoint -> Bool
< :: AbsPoint -> AbsPoint -> Bool
$c<= :: AbsPoint -> AbsPoint -> Bool
<= :: AbsPoint -> AbsPoint -> Bool
$c> :: AbsPoint -> AbsPoint -> Bool
> :: AbsPoint -> AbsPoint -> Bool
$c>= :: AbsPoint -> AbsPoint -> Bool
>= :: AbsPoint -> AbsPoint -> Bool
$cmax :: AbsPoint -> AbsPoint -> AbsPoint
max :: AbsPoint -> AbsPoint -> AbsPoint
$cmin :: AbsPoint -> AbsPoint -> AbsPoint
min :: AbsPoint -> AbsPoint -> AbsPoint
Ord,Int -> AbsPoint -> ShowS
[AbsPoint] -> ShowS
AbsPoint -> String
(Int -> AbsPoint -> ShowS)
-> (AbsPoint -> String) -> ([AbsPoint] -> ShowS) -> Show AbsPoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AbsPoint -> ShowS
showsPrec :: Int -> AbsPoint -> ShowS
$cshow :: AbsPoint -> String
show :: AbsPoint -> String
$cshowList :: [AbsPoint] -> ShowS
showList :: [AbsPoint] -> ShowS
Show,Typeable AbsPoint
Typeable AbsPoint =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> AbsPoint -> c AbsPoint)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AbsPoint)
-> (AbsPoint -> Constr)
-> (AbsPoint -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AbsPoint))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AbsPoint))
-> ((forall b. Data b => b -> b) -> AbsPoint -> AbsPoint)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AbsPoint -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AbsPoint -> r)
-> (forall u. (forall d. Data d => d -> u) -> AbsPoint -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> AbsPoint -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> AbsPoint -> m AbsPoint)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AbsPoint -> m AbsPoint)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AbsPoint -> m AbsPoint)
-> Data AbsPoint
AbsPoint -> Constr
AbsPoint -> DataType
(forall b. Data b => b -> b) -> AbsPoint -> AbsPoint
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> AbsPoint -> u
forall u. (forall d. Data d => d -> u) -> AbsPoint -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AbsPoint -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AbsPoint -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AbsPoint -> m AbsPoint
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AbsPoint -> m AbsPoint
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AbsPoint
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AbsPoint -> c AbsPoint
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AbsPoint)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AbsPoint)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AbsPoint -> c AbsPoint
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AbsPoint -> c AbsPoint
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AbsPoint
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AbsPoint
$ctoConstr :: AbsPoint -> Constr
toConstr :: AbsPoint -> Constr
$cdataTypeOf :: AbsPoint -> DataType
dataTypeOf :: AbsPoint -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AbsPoint)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AbsPoint)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AbsPoint)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AbsPoint)
$cgmapT :: (forall b. Data b => b -> b) -> AbsPoint -> AbsPoint
gmapT :: (forall b. Data b => b -> b) -> AbsPoint -> AbsPoint
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AbsPoint -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AbsPoint -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AbsPoint -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AbsPoint -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AbsPoint -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> AbsPoint -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AbsPoint -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AbsPoint -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AbsPoint -> m AbsPoint
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AbsPoint -> m AbsPoint
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AbsPoint -> m AbsPoint
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AbsPoint -> m AbsPoint
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AbsPoint -> m AbsPoint
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AbsPoint -> m AbsPoint
Data)


{- |
Abstract representation of line width.
Differentiates between standard line width and custom thickness.
-}
data Thickness
  = Normal
  | Thick
  deriving (Int -> Thickness -> ShowS
[Thickness] -> ShowS
Thickness -> String
(Int -> Thickness -> ShowS)
-> (Thickness -> String)
-> ([Thickness] -> ShowS)
-> Show Thickness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Thickness -> ShowS
showsPrec :: Int -> Thickness -> ShowS
$cshow :: Thickness -> String
show :: Thickness -> String
$cshowList :: [Thickness] -> ShowS
showList :: [Thickness] -> ShowS
Show,Thickness -> Thickness -> Bool
(Thickness -> Thickness -> Bool)
-> (Thickness -> Thickness -> Bool) -> Eq Thickness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Thickness -> Thickness -> Bool
== :: Thickness -> Thickness -> Bool
$c/= :: Thickness -> Thickness -> Bool
/= :: Thickness -> Thickness -> Bool
Eq,Eq Thickness
Eq Thickness =>
(Thickness -> Thickness -> Ordering)
-> (Thickness -> Thickness -> Bool)
-> (Thickness -> Thickness -> Bool)
-> (Thickness -> Thickness -> Bool)
-> (Thickness -> Thickness -> Bool)
-> (Thickness -> Thickness -> Thickness)
-> (Thickness -> Thickness -> Thickness)
-> Ord Thickness
Thickness -> Thickness -> Bool
Thickness -> Thickness -> Ordering
Thickness -> Thickness -> Thickness
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
$ccompare :: Thickness -> Thickness -> Ordering
compare :: Thickness -> Thickness -> Ordering
$c< :: Thickness -> Thickness -> Bool
< :: Thickness -> Thickness -> Bool
$c<= :: Thickness -> Thickness -> Bool
<= :: Thickness -> Thickness -> Bool
$c> :: Thickness -> Thickness -> Bool
> :: Thickness -> Thickness -> Bool
$c>= :: Thickness -> Thickness -> Bool
>= :: Thickness -> Thickness -> Bool
$cmax :: Thickness -> Thickness -> Thickness
max :: Thickness -> Thickness -> Thickness
$cmin :: Thickness -> Thickness -> Thickness
min :: Thickness -> Thickness -> Thickness
Ord,Typeable Thickness
Typeable Thickness =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Thickness -> c Thickness)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Thickness)
-> (Thickness -> Constr)
-> (Thickness -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Thickness))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Thickness))
-> ((forall b. Data b => b -> b) -> Thickness -> Thickness)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Thickness -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Thickness -> r)
-> (forall u. (forall d. Data d => d -> u) -> Thickness -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Thickness -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Thickness -> m Thickness)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Thickness -> m Thickness)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Thickness -> m Thickness)
-> Data Thickness
Thickness -> Constr
Thickness -> DataType
(forall b. Data b => b -> b) -> Thickness -> Thickness
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Thickness -> u
forall u. (forall d. Data d => d -> u) -> Thickness -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Thickness -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Thickness -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Thickness -> m Thickness
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Thickness -> m Thickness
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Thickness
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Thickness -> c Thickness
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Thickness)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Thickness)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Thickness -> c Thickness
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Thickness -> c Thickness
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Thickness
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Thickness
$ctoConstr :: Thickness -> Constr
toConstr :: Thickness -> Constr
$cdataTypeOf :: Thickness -> DataType
dataTypeOf :: Thickness -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Thickness)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Thickness)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Thickness)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Thickness)
$cgmapT :: (forall b. Data b => b -> b) -> Thickness -> Thickness
gmapT :: (forall b. Data b => b -> b) -> Thickness -> Thickness
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Thickness -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Thickness -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Thickness -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Thickness -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Thickness -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Thickness -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Thickness -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Thickness -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Thickness -> m Thickness
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Thickness -> m Thickness
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Thickness -> m Thickness
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Thickness -> m Thickness
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Thickness -> m Thickness
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Thickness -> m Thickness
Data)


{- |
Abstract representation of line drawing and filling mode.
Differentiates between the three common shapes: standard, thick, filled.

This does not retain the concrete value.
-}
data ShapeKind
  = Hollow Thickness
  | Solid
  deriving (Eq ShapeKind
Eq ShapeKind =>
(ShapeKind -> ShapeKind -> Ordering)
-> (ShapeKind -> ShapeKind -> Bool)
-> (ShapeKind -> ShapeKind -> Bool)
-> (ShapeKind -> ShapeKind -> Bool)
-> (ShapeKind -> ShapeKind -> Bool)
-> (ShapeKind -> ShapeKind -> ShapeKind)
-> (ShapeKind -> ShapeKind -> ShapeKind)
-> Ord ShapeKind
ShapeKind -> ShapeKind -> Bool
ShapeKind -> ShapeKind -> Ordering
ShapeKind -> ShapeKind -> ShapeKind
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
$ccompare :: ShapeKind -> ShapeKind -> Ordering
compare :: ShapeKind -> ShapeKind -> Ordering
$c< :: ShapeKind -> ShapeKind -> Bool
< :: ShapeKind -> ShapeKind -> Bool
$c<= :: ShapeKind -> ShapeKind -> Bool
<= :: ShapeKind -> ShapeKind -> Bool
$c> :: ShapeKind -> ShapeKind -> Bool
> :: ShapeKind -> ShapeKind -> Bool
$c>= :: ShapeKind -> ShapeKind -> Bool
>= :: ShapeKind -> ShapeKind -> Bool
$cmax :: ShapeKind -> ShapeKind -> ShapeKind
max :: ShapeKind -> ShapeKind -> ShapeKind
$cmin :: ShapeKind -> ShapeKind -> ShapeKind
min :: ShapeKind -> ShapeKind -> ShapeKind
Ord,Int -> ShapeKind -> ShowS
[ShapeKind] -> ShowS
ShapeKind -> String
(Int -> ShapeKind -> ShowS)
-> (ShapeKind -> String)
-> ([ShapeKind] -> ShowS)
-> Show ShapeKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShapeKind -> ShowS
showsPrec :: Int -> ShapeKind -> ShowS
$cshow :: ShapeKind -> String
show :: ShapeKind -> String
$cshowList :: [ShapeKind] -> ShowS
showList :: [ShapeKind] -> ShowS
Show,Typeable ShapeKind
Typeable ShapeKind =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ShapeKind -> c ShapeKind)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ShapeKind)
-> (ShapeKind -> Constr)
-> (ShapeKind -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ShapeKind))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ShapeKind))
-> ((forall b. Data b => b -> b) -> ShapeKind -> ShapeKind)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ShapeKind -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ShapeKind -> r)
-> (forall u. (forall d. Data d => d -> u) -> ShapeKind -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ShapeKind -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ShapeKind -> m ShapeKind)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ShapeKind -> m ShapeKind)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ShapeKind -> m ShapeKind)
-> Data ShapeKind
ShapeKind -> Constr
ShapeKind -> DataType
(forall b. Data b => b -> b) -> ShapeKind -> ShapeKind
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ShapeKind -> u
forall u. (forall d. Data d => d -> u) -> ShapeKind -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ShapeKind -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ShapeKind -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ShapeKind -> m ShapeKind
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ShapeKind -> m ShapeKind
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ShapeKind
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ShapeKind -> c ShapeKind
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ShapeKind)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ShapeKind)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ShapeKind -> c ShapeKind
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ShapeKind -> c ShapeKind
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ShapeKind
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ShapeKind
$ctoConstr :: ShapeKind -> Constr
toConstr :: ShapeKind -> Constr
$cdataTypeOf :: ShapeKind -> DataType
dataTypeOf :: ShapeKind -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ShapeKind)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ShapeKind)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ShapeKind)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ShapeKind)
$cgmapT :: (forall b. Data b => b -> b) -> ShapeKind -> ShapeKind
gmapT :: (forall b. Data b => b -> b) -> ShapeKind -> ShapeKind
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ShapeKind -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ShapeKind -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ShapeKind -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ShapeKind -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ShapeKind -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ShapeKind -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ShapeKind -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ShapeKind -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ShapeKind -> m ShapeKind
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ShapeKind -> m ShapeKind
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ShapeKind -> m ShapeKind
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ShapeKind -> m ShapeKind
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ShapeKind -> m ShapeKind
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ShapeKind -> m ShapeKind
Data)


{- |
Abstract representation of angles.
Rotation is divided into four equal sections on the unit circle.
-}
data Angle
  = ToQuarter Double
  | ToHalf Double
  | ToThreeQuarter Double
  | ToFull Double
  deriving (Eq Angle
Eq Angle =>
(Angle -> Angle -> Ordering)
-> (Angle -> Angle -> Bool)
-> (Angle -> Angle -> Bool)
-> (Angle -> Angle -> Bool)
-> (Angle -> Angle -> Bool)
-> (Angle -> Angle -> Angle)
-> (Angle -> Angle -> Angle)
-> Ord Angle
Angle -> Angle -> Bool
Angle -> Angle -> Ordering
Angle -> Angle -> Angle
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
$ccompare :: Angle -> Angle -> Ordering
compare :: Angle -> Angle -> Ordering
$c< :: Angle -> Angle -> Bool
< :: Angle -> Angle -> Bool
$c<= :: Angle -> Angle -> Bool
<= :: Angle -> Angle -> Bool
$c> :: Angle -> Angle -> Bool
> :: Angle -> Angle -> Bool
$c>= :: Angle -> Angle -> Bool
>= :: Angle -> Angle -> Bool
$cmax :: Angle -> Angle -> Angle
max :: Angle -> Angle -> Angle
$cmin :: Angle -> Angle -> Angle
min :: Angle -> Angle -> Angle
Ord,Typeable Angle
Typeable Angle =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Angle -> c Angle)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Angle)
-> (Angle -> Constr)
-> (Angle -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Angle))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Angle))
-> ((forall b. Data b => b -> b) -> Angle -> Angle)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Angle -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Angle -> r)
-> (forall u. (forall d. Data d => d -> u) -> Angle -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Angle -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Angle -> m Angle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Angle -> m Angle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Angle -> m Angle)
-> Data Angle
Angle -> Constr
Angle -> DataType
(forall b. Data b => b -> b) -> Angle -> Angle
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Angle -> u
forall u. (forall d. Data d => d -> u) -> Angle -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Angle -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Angle -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Angle -> m Angle
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Angle -> m Angle
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Angle
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Angle -> c Angle
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Angle)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Angle)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Angle -> c Angle
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Angle -> c Angle
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Angle
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Angle
$ctoConstr :: Angle -> Constr
toConstr :: Angle -> Constr
$cdataTypeOf :: Angle -> DataType
dataTypeOf :: Angle -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Angle)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Angle)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Angle)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Angle)
$cgmapT :: (forall b. Data b => b -> b) -> Angle -> Angle
gmapT :: (forall b. Data b => b -> b) -> Angle -> Angle
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Angle -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Angle -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Angle -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Angle -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Angle -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Angle -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Angle -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Angle -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Angle -> m Angle
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Angle -> m Angle
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Angle -> m Angle
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Angle -> m Angle
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Angle -> m Angle
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Angle -> m Angle
Data)


{- |
Abstract representation of translations.
Considers values equal if
both are translated by a positive or negative number or not at all.
-}
data Position
  = Neg Double
  | Zero
  | Pos Double
  deriving (Eq Position
Eq Position =>
(Position -> Position -> Ordering)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Position)
-> (Position -> Position -> Position)
-> Ord Position
Position -> Position -> Bool
Position -> Position -> Ordering
Position -> Position -> Position
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
$ccompare :: Position -> Position -> Ordering
compare :: Position -> Position -> Ordering
$c< :: Position -> Position -> Bool
< :: Position -> Position -> Bool
$c<= :: Position -> Position -> Bool
<= :: Position -> Position -> Bool
$c> :: Position -> Position -> Bool
> :: Position -> Position -> Bool
$c>= :: Position -> Position -> Bool
>= :: Position -> Position -> Bool
$cmax :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
min :: Position -> Position -> Position
Ord,Typeable Position
Typeable Position =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Position -> c Position)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Position)
-> (Position -> Constr)
-> (Position -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Position))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Position))
-> ((forall b. Data b => b -> b) -> Position -> Position)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Position -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Position -> r)
-> (forall u. (forall d. Data d => d -> u) -> Position -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Position -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Position -> m Position)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Position -> m Position)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Position -> m Position)
-> Data Position
Position -> Constr
Position -> DataType
(forall b. Data b => b -> b) -> Position -> Position
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Position -> u
forall u. (forall d. Data d => d -> u) -> Position -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Position -> m Position
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Position -> m Position
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Position
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Position -> c Position
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Position)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Position)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Position -> c Position
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Position -> c Position
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Position
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Position
$ctoConstr :: Position -> Constr
toConstr :: Position -> Constr
$cdataTypeOf :: Position -> DataType
dataTypeOf :: Position -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Position)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Position)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Position)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Position)
$cgmapT :: (forall b. Data b => b -> b) -> Position -> Position
gmapT :: (forall b. Data b => b -> b) -> Position -> Position
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Position -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Position -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Position -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Position -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Position -> m Position
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Position -> m Position
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Position -> m Position
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Position -> m Position
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Position -> m Position
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Position -> m Position
Data)


{- |
Abstract representation of scaling factors.
Considers values equal if
both are scaled larger, smaller or not at all.
-}
data Factor
  = Smaller Double
  | Same
  | Larger Double
  deriving (Eq Factor
Eq Factor =>
(Factor -> Factor -> Ordering)
-> (Factor -> Factor -> Bool)
-> (Factor -> Factor -> Bool)
-> (Factor -> Factor -> Bool)
-> (Factor -> Factor -> Bool)
-> (Factor -> Factor -> Factor)
-> (Factor -> Factor -> Factor)
-> Ord Factor
Factor -> Factor -> Bool
Factor -> Factor -> Ordering
Factor -> Factor -> Factor
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
$ccompare :: Factor -> Factor -> Ordering
compare :: Factor -> Factor -> Ordering
$c< :: Factor -> Factor -> Bool
< :: Factor -> Factor -> Bool
$c<= :: Factor -> Factor -> Bool
<= :: Factor -> Factor -> Bool
$c> :: Factor -> Factor -> Bool
> :: Factor -> Factor -> Bool
$c>= :: Factor -> Factor -> Bool
>= :: Factor -> Factor -> Bool
$cmax :: Factor -> Factor -> Factor
max :: Factor -> Factor -> Factor
$cmin :: Factor -> Factor -> Factor
min :: Factor -> Factor -> Factor
Ord,Typeable Factor
Typeable Factor =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Factor -> c Factor)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Factor)
-> (Factor -> Constr)
-> (Factor -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Factor))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Factor))
-> ((forall b. Data b => b -> b) -> Factor -> Factor)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Factor -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Factor -> r)
-> (forall u. (forall d. Data d => d -> u) -> Factor -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Factor -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Factor -> m Factor)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Factor -> m Factor)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Factor -> m Factor)
-> Data Factor
Factor -> Constr
Factor -> DataType
(forall b. Data b => b -> b) -> Factor -> Factor
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Factor -> u
forall u. (forall d. Data d => d -> u) -> Factor -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Factor -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Factor -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Factor -> m Factor
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Factor -> m Factor
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Factor
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Factor -> c Factor
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Factor)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Factor)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Factor -> c Factor
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Factor -> c Factor
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Factor
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Factor
$ctoConstr :: Factor -> Constr
toConstr :: Factor -> Constr
$cdataTypeOf :: Factor -> DataType
dataTypeOf :: Factor -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Factor)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Factor)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Factor)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Factor)
$cgmapT :: (forall b. Data b => b -> b) -> Factor -> Factor
gmapT :: (forall b. Data b => b -> b) -> Factor -> Factor
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Factor -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Factor -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Factor -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Factor -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Factor -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Factor -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Factor -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Factor -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Factor -> m Factor
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Factor -> m Factor
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Factor -> m Factor
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Factor -> m Factor
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Factor -> m Factor
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Factor -> m Factor
Data)


{- |
Abstract representation of `Color`.
Equal if each HSLA parameter has an acceptable distance from those of the other color.
-}
data AbsColor
  = Tone Double Double Double
  -- ^ Represents concrete `Color`'s HSL value
  | Translucent Double AbsColor
  -- ^ Transparency modifier
  | AnyColor
  -- ^ Is equal to any color when compared.
  deriving (Eq AbsColor
Eq AbsColor =>
(AbsColor -> AbsColor -> Ordering)
-> (AbsColor -> AbsColor -> Bool)
-> (AbsColor -> AbsColor -> Bool)
-> (AbsColor -> AbsColor -> Bool)
-> (AbsColor -> AbsColor -> Bool)
-> (AbsColor -> AbsColor -> AbsColor)
-> (AbsColor -> AbsColor -> AbsColor)
-> Ord AbsColor
AbsColor -> AbsColor -> Bool
AbsColor -> AbsColor -> Ordering
AbsColor -> AbsColor -> AbsColor
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
$ccompare :: AbsColor -> AbsColor -> Ordering
compare :: AbsColor -> AbsColor -> Ordering
$c< :: AbsColor -> AbsColor -> Bool
< :: AbsColor -> AbsColor -> Bool
$c<= :: AbsColor -> AbsColor -> Bool
<= :: AbsColor -> AbsColor -> Bool
$c> :: AbsColor -> AbsColor -> Bool
> :: AbsColor -> AbsColor -> Bool
$c>= :: AbsColor -> AbsColor -> Bool
>= :: AbsColor -> AbsColor -> Bool
$cmax :: AbsColor -> AbsColor -> AbsColor
max :: AbsColor -> AbsColor -> AbsColor
$cmin :: AbsColor -> AbsColor -> AbsColor
min :: AbsColor -> AbsColor -> AbsColor
Ord,Int -> AbsColor -> ShowS
[AbsColor] -> ShowS
AbsColor -> String
(Int -> AbsColor -> ShowS)
-> (AbsColor -> String) -> ([AbsColor] -> ShowS) -> Show AbsColor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AbsColor -> ShowS
showsPrec :: Int -> AbsColor -> ShowS
$cshow :: AbsColor -> String
show :: AbsColor -> String
$cshowList :: [AbsColor] -> ShowS
showList :: [AbsColor] -> ShowS
Show,Typeable AbsColor
Typeable AbsColor =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> AbsColor -> c AbsColor)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AbsColor)
-> (AbsColor -> Constr)
-> (AbsColor -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AbsColor))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AbsColor))
-> ((forall b. Data b => b -> b) -> AbsColor -> AbsColor)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AbsColor -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AbsColor -> r)
-> (forall u. (forall d. Data d => d -> u) -> AbsColor -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> AbsColor -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> AbsColor -> m AbsColor)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AbsColor -> m AbsColor)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AbsColor -> m AbsColor)
-> Data AbsColor
AbsColor -> Constr
AbsColor -> DataType
(forall b. Data b => b -> b) -> AbsColor -> AbsColor
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> AbsColor -> u
forall u. (forall d. Data d => d -> u) -> AbsColor -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AbsColor -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AbsColor -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AbsColor -> m AbsColor
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AbsColor -> m AbsColor
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AbsColor
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AbsColor -> c AbsColor
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AbsColor)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AbsColor)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AbsColor -> c AbsColor
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AbsColor -> c AbsColor
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AbsColor
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AbsColor
$ctoConstr :: AbsColor -> Constr
toConstr :: AbsColor -> Constr
$cdataTypeOf :: AbsColor -> DataType
dataTypeOf :: AbsColor -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AbsColor)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AbsColor)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AbsColor)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AbsColor)
$cgmapT :: (forall b. Data b => b -> b) -> AbsColor -> AbsColor
gmapT :: (forall b. Data b => b -> b) -> AbsColor -> AbsColor
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AbsColor -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AbsColor -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AbsColor -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AbsColor -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AbsColor -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> AbsColor -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AbsColor -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AbsColor -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AbsColor -> m AbsColor
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AbsColor -> m AbsColor
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AbsColor -> m AbsColor
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AbsColor -> m AbsColor
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AbsColor -> m AbsColor
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AbsColor -> m AbsColor
Data)


instance Eq AbsColor where
  Tone Double
h1 Double
s1 Double
l1      == :: AbsColor -> AbsColor -> Bool
== Tone Double
h2 Double
s2 Double
l2
    -- Luminosity at extremes => almost pure white/black
    | (Double
l2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0.981 Bool -> Bool -> Bool
&& Double
l1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0.981) Bool -> Bool -> Bool
||
      (Double
l2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.051 Bool -> Bool -> Bool
&& Double
l1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.051) = Bool
True
    -- Saturation extremely low => almost pure grey
    | Double
s1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.051 Bool -> Bool -> Bool
&& Double
s2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.051  = Double
lDiff Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.301
    -- Same hue and non-extreme luminosity/saturation => allow for larger range
    | Double
h1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
h2                    = Double
sDiff Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.51 Bool -> Bool -> Bool
&& Double
lDiff Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.251
    -- Difference of hsl values is in certain range (hue range depends on saturation)
    | Bool
otherwise                   =
      Double
hDiff Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.151 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
0.1Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
hueMod) Bool -> Bool -> Bool
&& Double
sDiff Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.251 Bool -> Bool -> Bool
&& Double
lDiff Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.151
    where
      lDiff :: Double
lDiff = Double -> Double
forall a. Num a => a -> a
abs (Double
l1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
l2)
      sDiff :: Double
sDiff = Double -> Double
forall a. Num a => a -> a
abs (Double
s1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
s2)
      hDiff :: Double
hDiff = Double -> Double
forall a. Num a => a -> a
abs (Double
h1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
h2)
      hueMod :: Double
hueMod = Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
s1 Double
s2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
sDiff

  Translucent Double
a1 AbsColor
c1 == Translucent Double
a2 AbsColor
c2 = Double -> Double
forall a. Num a => a -> a
abs (Double
a1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a2) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.151 Bool -> Bool -> Bool
&& AbsColor
c1 AbsColor -> AbsColor -> Bool
forall a. Eq a => a -> a -> Bool
== AbsColor
c2
  Translucent Double
a AbsColor
c1  == AbsColor
c                 = Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.151 Bool -> Bool -> Bool
&& AbsColor
c1 AbsColor -> AbsColor -> Bool
forall a. Eq a => a -> a -> Bool
== AbsColor
c
  AbsColor
c                 == Translucent Double
a AbsColor
c1  = Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.151 Bool -> Bool -> Bool
&& AbsColor
c1 AbsColor -> AbsColor -> Bool
forall a. Eq a => a -> a -> Bool
== AbsColor
c
  AbsColor
AnyColor          == AbsColor
_                 = Bool
True
  AbsColor
_                 == AbsColor
AnyColor          = Bool
True


{- |
Abstract a concrete color.
-}
toAbsColor :: Color -> AbsColor
toAbsColor :: Color -> AbsColor
toAbsColor Color
T.AnyColor          = AbsColor
AnyColor
toAbsColor (T.RGB Double
1   Double
1   Double
1  ) = Double -> Double -> Double -> AbsColor
Tone Double
0 Double
0 Double
1
toAbsColor (T.RGB Double
0   Double
0   Double
0  ) = Double -> Double -> Double -> AbsColor
Tone Double
0 Double
0 Double
0
toAbsColor (T.RGB Double
0.5 Double
0.5 Double
0.5) = Double -> Double -> Double -> AbsColor
Tone Double
0 Double
0 Double
0.5
toAbsColor Color
c
  | Color -> Double
T.alpha Color
c Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
1 = Double -> Double -> Double -> AbsColor
Tone (Color -> Double
T.hue Color
c) (Color -> Double
T.saturation Color
c) (Color -> Double
T.luminosity Color
c)
  | Bool
otherwise      = Double -> AbsColor -> AbsColor
Translucent (Color -> Double
T.alpha Color
c) (AbsColor -> AbsColor) -> AbsColor -> AbsColor
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> AbsColor
Tone (Color -> Double
T.hue Color
c) (Color -> Double
T.saturation Color
c) (Color -> Double
T.luminosity Color
c)


{- |
Concretize an abstract color.
-}
fromAbsColor :: AbsColor -> Color
fromAbsColor :: AbsColor -> Color
fromAbsColor (Tone Double
h Double
s Double
l) = Double -> Double -> Double -> Color
T.HSL Double
h Double
s Double
l
fromAbsColor (Translucent Double
_ AbsColor
c) = Color -> Color
T.Translucent (Color -> Color) -> Color -> Color
forall a b. (a -> b) -> a -> b
$ AbsColor -> Color
fromAbsColor AbsColor
c
fromAbsColor AbsColor
AnyColor = Color
T.AnyColor


{- |
A more strict equality test for `AbsColor`.
Contrary to the `Eq` instance,
this only succeeds if both colors are completely identical in their HSLA values.
-}
isSameColor :: AbsColor -> AbsColor -> Bool
isSameColor :: AbsColor -> AbsColor -> Bool
isSameColor (Tone Double
h1 Double
s1 Double
l1)      (Tone Double
h2 Double
s2 Double
l2)      =
  Double
h1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
h2 Bool -> Bool -> Bool
&& Double
s1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
s2 Bool -> Bool -> Bool
&& Double
l1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
l2
isSameColor (Translucent Double
a1 AbsColor
c1) (Translucent Double
a2 AbsColor
c2) =
  Double
a1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
a2 Bool -> Bool -> Bool
&& AbsColor
c1 AbsColor -> AbsColor -> Bool
`isSameColor` AbsColor
c2
isSameColor AbsColor
AnyColor            AbsColor
_                   = Bool
True
isSameColor AbsColor
_                   AbsColor
AnyColor            = Bool
True
isSameColor AbsColor
_                   AbsColor
_                   = Bool
False


{- |
Allows for custom thresholds on color similarity detection.
This is exported to be able to correct unexpected complications in live tests.
-}
equalColorCustom :: Double -> Double -> Double -> Double -> AbsColor -> AbsColor -> Bool
equalColorCustom :: Double
-> Double -> Double -> Double -> AbsColor -> AbsColor -> Bool
equalColorCustom Double
hRange Double
sRange Double
lRange Double
_ (Tone Double
h1 Double
s1 Double
l1) (Tone Double
h2 Double
s2 Double
l2)
    | (Double
l2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0.98 Bool -> Bool -> Bool
&& Double
l1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0.98) Bool -> Bool -> Bool
||
      (Double
l2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.05 Bool -> Bool -> Bool
&& Double
l1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.05) = Bool
True
    | Double
s1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.05 Bool -> Bool -> Bool
&& Double
s2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.05    = Double
lDiff Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
lRange
    | Bool
otherwise                   =
      Double
hDiff Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
hRange Bool -> Bool -> Bool
&& Double
sDiff Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
sRange Bool -> Bool -> Bool
&& Double
lDiff Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
lRange
    where
      lDiff :: Double
lDiff = Double -> Double
forall a. Num a => a -> a
abs (Double
l1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
l2)
      sDiff :: Double
sDiff = Double -> Double
forall a. Num a => a -> a
abs (Double
s1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
s2)
      hDiff :: Double
hDiff = Double -> Double
forall a. Num a => a -> a
abs (Double
h1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
h2)
equalColorCustom Double
h Double
s Double
l Double
aRange (Translucent Double
a1 AbsColor
c1) (Translucent Double
a2 AbsColor
c2) =
  Double -> Double
forall a. Num a => a -> a
abs (Double
a1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a2) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
aRange Bool -> Bool -> Bool
&& Double
-> Double -> Double -> Double -> AbsColor -> AbsColor -> Bool
equalColorCustom Double
h Double
s Double
l Double
aRange AbsColor
c1 AbsColor
c2
equalColorCustom Double
h Double
s Double
l Double
aRange (Translucent Double
a AbsColor
c1)  AbsColor
c                   =
  Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
aRange Bool -> Bool -> Bool
&& Double
-> Double -> Double -> Double -> AbsColor -> AbsColor -> Bool
equalColorCustom Double
h Double
s Double
l Double
aRange AbsColor
c1 AbsColor
c
equalColorCustom Double
h Double
s Double
l Double
aRange AbsColor
c                   (Translucent Double
a AbsColor
c1)  =
  Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
aRange Bool -> Bool -> Bool
&& Double
-> Double -> Double -> Double -> AbsColor -> AbsColor -> Bool
equalColorCustom Double
h Double
s Double
l Double
aRange AbsColor
c1 AbsColor
c
equalColorCustom Double
_ Double
_ Double
_ Double
_      AbsColor
AnyColor            AbsColor
_                   = Bool
True
equalColorCustom Double
_ Double
_ Double
_ Double
_      AbsColor
_                   AbsColor
AnyColor            = Bool
True


instance Eq AbsPoint where
  AbsPoint
_ == :: AbsPoint -> AbsPoint -> Bool
== AbsPoint
_ = Bool
True


instance Show Size where
  show :: Size -> String
show Size
_ = String
"Size"


instance Eq Size where
  Size
_ == :: Size -> Size -> Bool
== Size
_ = Bool
True


instance Eq ShapeKind where
  Hollow Thickness
_ == :: ShapeKind -> ShapeKind -> Bool
== Hollow Thickness
_ = Bool
True
  ShapeKind
Solid    == ShapeKind
Solid    = Bool
True
  ShapeKind
_        == ShapeKind
_        = Bool
False


instance Show Position where
  show :: Position -> String
show Position
Zero    = String
"Zero"
  show (Neg Double
_) = String
"Neg"
  show (Pos Double
_) = String
"Pos"

instance Eq Position where
  (Neg Double
_) == :: Position -> Position -> Bool
== (Neg Double
_) = Bool
True
  (Pos Double
_) == (Pos Double
_) = Bool
True
  Position
Zero    == Position
Zero    = Bool
True
  Position
_       == Position
_       = Bool
False


instance Num Position where
  Position
Zero + :: Position -> Position -> Position
+ Position
a = Position
a
  Position
a + Position
Zero = Position
a
  Pos Double
a + Pos Double
b = Double -> Position
Pos (Double -> Position) -> Double -> Position
forall a b. (a -> b) -> a -> b
$ Double
aDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
b
  Neg Double
a + Neg Double
b = Double -> Position
Neg (Double -> Position) -> Double -> Position
forall a b. (a -> b) -> a -> b
$ Double
aDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
b
  Pos Double
a + Neg Double
b
    | Double
aDouble -> Double -> Bool
forall a. Eq a => a -> a -> Bool
==Double
b = Position
Zero
    | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
b = Double -> Position
Neg (Double -> Position) -> Double -> Position
forall a b. (a -> b) -> a -> b
$ Double
bDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
a
    | Bool
otherwise = Double -> Position
Pos (Double -> Position) -> Double -> Position
forall a b. (a -> b) -> a -> b
$ Double
aDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
b
  a :: Position
a@(Neg Double
_) + b :: Position
b@(Pos Double
_) = Position
b Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
a

  abs :: Position -> Position
abs Position
Zero = Position
Zero
  abs (Neg Double
a) = Double -> Position
Pos Double
a
  abs Position
a = Position
a

  Position
Zero * :: Position -> Position -> Position
* Position
_ = Position
Zero
  Position
_ * Position
Zero = Position
Zero
  Pos Double
a * Pos Double
b = Double -> Position
Pos (Double -> Position) -> Double -> Position
forall a b. (a -> b) -> a -> b
$ Double
aDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
b
  Neg Double
a * Neg Double
b = Double -> Position
Pos (Double -> Position) -> Double -> Position
forall a b. (a -> b) -> a -> b
$ Double
aDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
b
  Pos Double
a * Neg Double
b = Double -> Position
Neg (Double -> Position) -> Double -> Position
forall a b. (a -> b) -> a -> b
$ Double
aDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
b
  Position
a * Position
b = Position
bPosition -> Position -> Position
forall a. Num a => a -> a -> a
*Position
a

  signum :: Position -> Position
signum Position
Zero = Position
Zero
  signum (Pos Double
_) = Double -> Position
Pos Double
1
  signum (Neg Double
_) = Double -> Position
Neg Double
1

  negate :: Position -> Position
negate Position
Zero = Position
Zero
  negate (Pos Double
a) = Double -> Position
Neg Double
a
  negate (Neg Double
a) = Double -> Position
Pos Double
a

  fromInteger :: Integer -> Position
fromInteger Integer
i
    | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Position
Zero
    | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = Double -> Position
Neg (Double -> Position) -> Double -> Position
forall a b. (a -> b) -> a -> b
$ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i
    | Bool
otherwise = Double -> Position
Pos (Double -> Position) -> Double -> Position
forall a b. (a -> b) -> a -> b
$ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i


instance Eq Factor where
  Smaller Double
_ == :: Factor -> Factor -> Bool
== Smaller Double
_ = Bool
True
  Larger Double
_  == Larger Double
_  = Bool
True
  Factor
Same      == Factor
Same      = Bool
True
  Factor
_         == Factor
_         = Bool
False


instance Show Factor where
  show :: Factor -> String
show (Smaller Double
_) = String
"Smaller"
  show (Larger Double
_)  = String
"Larger"
  show Factor
Same        = String
"Same"


instance Eq Angle where
  (ToQuarter Double
_)      == :: Angle -> Angle -> Bool
== (ToQuarter Double
_)      = Bool
True
  (ToHalf Double
_)         == (ToHalf Double
_)         = Bool
True
  (ToThreeQuarter Double
_) == (ToThreeQuarter Double
_) = Bool
True
  (ToFull Double
_)         == (ToFull Double
_)         = Bool
True
  Angle
_                  == Angle
_                  = Bool
False


instance Show Angle where
  show :: Angle -> String
show (ToQuarter Double
_) = String
"NoneToQuarter"
  show (ToHalf Double
_) = String
"QuarterToHalf"
  show (ToThreeQuarter Double
_) = String
"HalfToThreeQuarter"
  show (ToFull Double
_) = String
"ThreeQuarterToFull"



{- |
Abstract a concrete line width.
-}
thickness :: (Eq a, Fractional a) => a -> Thickness
thickness :: forall a. (Eq a, Fractional a) => a -> Thickness
thickness a
d
  | a
d a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0 = Thickness
Thick
  | Bool
otherwise = Thickness
Normal


{- |
Abstract a concrete size.
-}
toSize :: Double -> Size
toSize :: Double -> Size
toSize = Double -> Size
Size (Double -> Size) -> (Double -> Double) -> Double -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Num a => a -> a
abs


{- |
Concretize an abstract size.
-}
fromSize :: Size -> Double
fromSize :: Size -> Double
fromSize (Size Double
d) = Double
d


{- |
Abstract a concrete factor.
-}
toFactor :: Double -> Factor
toFactor :: Double -> Factor
toFactor (Double -> Double
forall a. Num a => a -> a
abs -> Double
1) = Factor
Same
toFactor (Double -> Double
forall a. Num a => a -> a
abs -> Double
x)
  | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1 = Double -> Factor
Larger Double
x
  | Bool
otherwise = Double -> Factor
Smaller Double
x


{- |
Concretize an abstract factor.
-}
fromFactor :: Factor -> Double
fromFactor :: Factor -> Double
fromFactor Factor
Same = Double
1
fromFactor (Smaller Double
x) = Double
x
fromFactor (Larger Double
x) = Double
x


{- |
Abstract a concrete angle.
-}
toAngle :: Double -> Angle
toAngle :: Double -> Angle
toAngle Double
a
  | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 = Double -> Angle
toAngle (Double
aDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
pi)
  | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2 = Double -> Angle
ToQuarter Double
a
  | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
forall a. Floating a => a
pi = Double -> Angle
ToHalf Double
a
  | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
3Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2 = Double -> Angle
ToThreeQuarter Double
a
  | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
pi = Double -> Angle
ToFull Double
a
  | Bool
otherwise = Double -> Angle
toAngle (Double
aDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
pi)


{- |
Concretize an abstract angle.
-}
fromAngle :: Angle -> Double
fromAngle :: Angle -> Double
fromAngle (ToQuarter Double
a) = Double
a
fromAngle (ToHalf Double
a) = Double
a
fromAngle (ToThreeQuarter Double
a) = Double
a
fromAngle (ToFull Double
a) = Double
a


{- |
Concretize an abstract translation.
-}
fromPosition :: Position -> Double
fromPosition :: Position -> Double
fromPosition Position
Zero    = Double
0
fromPosition (Neg Double
d) = Double -> Double
fuzz (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ -Double
d
fromPosition (Pos Double
d) = Double -> Double
fuzz Double
d


fuzz :: Double -> Double
fuzz :: Double -> Double
fuzz Double
a = if Double -> Double
forall a. Num a => a -> a
abs Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.005 then Double
0 else Double
a


{- |
Abstract a concrete translation.
-}
toPosition :: Double -> Position
toPosition :: Double -> Position
toPosition Double
d
  | Double
d Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 = Position
Zero
  | Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 = Double -> Position
Neg (Double -> Position) -> Double -> Position
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Num a => a -> a
abs Double
d
  | Bool
otherwise = Double -> Position
Pos Double
d


{- |
Concretize an abstract point.
-}
fromAbsPoint :: AbsPoint -> Point
fromAbsPoint :: AbsPoint -> Point
fromAbsPoint = (Position -> Double) -> (Position, Position) -> Point
forall a b. (a -> b) -> (a, a) -> (b, b)
both Position -> Double
fromPosition ((Position, Position) -> Point)
-> (AbsPoint -> (Position, Position)) -> AbsPoint -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsPoint -> (Position, Position)
unAbsPoint


{- |
Abstract a concrete point.
-}
toAbsPoint :: Point -> AbsPoint
toAbsPoint :: Point -> AbsPoint
toAbsPoint (Double
x,Double
y) = (Position, Position) -> AbsPoint
AbsPoint (Double -> Position
toPosition Double
x, Double -> Position
toPosition Double
y)


{- |
Apply a function on concrete points to the contents of an abstract point.
-}
applyToAbsPoint :: (Point -> Point) -> AbsPoint -> AbsPoint
applyToAbsPoint :: (Point -> Point) -> AbsPoint -> AbsPoint
applyToAbsPoint Point -> Point
f AbsPoint
ap = Point -> AbsPoint
toAbsPoint (Point -> AbsPoint) -> Point -> AbsPoint
forall a b. (a -> b) -> a -> b
$ Point -> Point
f (AbsPoint -> Point
fromAbsPoint AbsPoint
ap)