{-# language DeriveDataTypeable #-}
{-# language FlexibleInstances #-}
{-# language OverloadedStrings #-}
{-# language ViewPatterns #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}

module CodeWorld.Test.Normalize (
  NormalizedPicture(..),
  contains,
  couldHaveTranslation,
  count,
  getColor,
  getRotation,
  getExactRotation,
  getScalingFactors,
  getExactScalingFactors,
  getTranslation,
  getExactTranslation,
  getReflectionAngle,
  getExactReflectionAngle,
  getCircleRadius,
  getExactCircleRadius,
  getRectangleLengths,
  getExactRectangleLengths,
  getExactPointList,
  getSubPictures,
  stripTranslation,
  toConcretePicture,
  ) where


import Data.Data                        (Data,Typeable)
import Data.Text                        (Text)
import Data.List.Extra                  (headDef, takeEnd)
import Data.Maybe                       (listToMaybe)
import Data.Tuple.Extra                 (both)
import Data.Generics.Uniplate.Data      (transform, universe)

import CodeWorld.Tasks.API              (Drawable(..))
import CodeWorld.Tasks.VectorSpace (
  Point,
  vectorSum,
  atOriginWithOffset,
  isRectangle,
  reflectedPoint,
  rotationAngle,
  scaledVector,
  sideLengths,
  rotatedVector,
  )
import CodeWorld.Test.AbsTypes

import qualified CodeWorld.Tasks.Picture as P


{- |
A more abstract syntax tree representing images.
Comparisons between values of this type are intentionally fuzzy:
Concrete number or point values are abstracted into coarser categories.
Notably, those values are not lost and can be retrieved if desired.

The constructors of this type are not exposed.
Values are built using the CodeWorld API.
-}
data NormalizedPicture
  = Rectangle !ShapeKind !Size !Size
  | Circle !ShapeKind !Size
  | Lettering !Text
  | Color !AbsColor !NormalizedPicture
  | Translate !Position !Position !NormalizedPicture
  | Scale !Factor !Factor !NormalizedPicture
  | Rotate !Angle !NormalizedPicture
  | Pictures [NormalizedPicture]
  | CoordinatePlane
  | Logo
  | Blank
  | Polyline !ShapeKind [AbsPoint]
  | Curve !ShapeKind [AbsPoint]
  | Arc !ShapeKind !Angle !Angle !Size
  | Reflect !Angle !NormalizedPicture
  | Clip !Size !Size !NormalizedPicture
  deriving (Int -> NormalizedPicture -> ShowS
[NormalizedPicture] -> ShowS
NormalizedPicture -> [Char]
(Int -> NormalizedPicture -> ShowS)
-> (NormalizedPicture -> [Char])
-> ([NormalizedPicture] -> ShowS)
-> Show NormalizedPicture
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NormalizedPicture -> ShowS
showsPrec :: Int -> NormalizedPicture -> ShowS
$cshow :: NormalizedPicture -> [Char]
show :: NormalizedPicture -> [Char]
$cshowList :: [NormalizedPicture] -> ShowS
showList :: [NormalizedPicture] -> ShowS
Show,NormalizedPicture -> NormalizedPicture -> Bool
(NormalizedPicture -> NormalizedPicture -> Bool)
-> (NormalizedPicture -> NormalizedPicture -> Bool)
-> Eq NormalizedPicture
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NormalizedPicture -> NormalizedPicture -> Bool
== :: NormalizedPicture -> NormalizedPicture -> Bool
$c/= :: NormalizedPicture -> NormalizedPicture -> Bool
/= :: NormalizedPicture -> NormalizedPicture -> Bool
Eq,Eq NormalizedPicture
Eq NormalizedPicture =>
(NormalizedPicture -> NormalizedPicture -> Ordering)
-> (NormalizedPicture -> NormalizedPicture -> Bool)
-> (NormalizedPicture -> NormalizedPicture -> Bool)
-> (NormalizedPicture -> NormalizedPicture -> Bool)
-> (NormalizedPicture -> NormalizedPicture -> Bool)
-> (NormalizedPicture -> NormalizedPicture -> NormalizedPicture)
-> (NormalizedPicture -> NormalizedPicture -> NormalizedPicture)
-> Ord NormalizedPicture
NormalizedPicture -> NormalizedPicture -> Bool
NormalizedPicture -> NormalizedPicture -> Ordering
NormalizedPicture -> NormalizedPicture -> NormalizedPicture
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 :: NormalizedPicture -> NormalizedPicture -> Ordering
compare :: NormalizedPicture -> NormalizedPicture -> Ordering
$c< :: NormalizedPicture -> NormalizedPicture -> Bool
< :: NormalizedPicture -> NormalizedPicture -> Bool
$c<= :: NormalizedPicture -> NormalizedPicture -> Bool
<= :: NormalizedPicture -> NormalizedPicture -> Bool
$c> :: NormalizedPicture -> NormalizedPicture -> Bool
> :: NormalizedPicture -> NormalizedPicture -> Bool
$c>= :: NormalizedPicture -> NormalizedPicture -> Bool
>= :: NormalizedPicture -> NormalizedPicture -> Bool
$cmax :: NormalizedPicture -> NormalizedPicture -> NormalizedPicture
max :: NormalizedPicture -> NormalizedPicture -> NormalizedPicture
$cmin :: NormalizedPicture -> NormalizedPicture -> NormalizedPicture
min :: NormalizedPicture -> NormalizedPicture -> NormalizedPicture
Ord,Typeable NormalizedPicture
Typeable NormalizedPicture =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> NormalizedPicture
 -> c NormalizedPicture)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c NormalizedPicture)
-> (NormalizedPicture -> Constr)
-> (NormalizedPicture -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c NormalizedPicture))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c NormalizedPicture))
-> ((forall b. Data b => b -> b)
    -> NormalizedPicture -> NormalizedPicture)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> NormalizedPicture -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> NormalizedPicture -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> NormalizedPicture -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> NormalizedPicture -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> NormalizedPicture -> m NormalizedPicture)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> NormalizedPicture -> m NormalizedPicture)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> NormalizedPicture -> m NormalizedPicture)
-> Data NormalizedPicture
NormalizedPicture -> Constr
NormalizedPicture -> DataType
(forall b. Data b => b -> b)
-> NormalizedPicture -> NormalizedPicture
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) -> NormalizedPicture -> u
forall u. (forall d. Data d => d -> u) -> NormalizedPicture -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NormalizedPicture -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NormalizedPicture -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> NormalizedPicture -> m NormalizedPicture
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> NormalizedPicture -> m NormalizedPicture
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NormalizedPicture
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NormalizedPicture -> c NormalizedPicture
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NormalizedPicture)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c NormalizedPicture)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NormalizedPicture -> c NormalizedPicture
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NormalizedPicture -> c NormalizedPicture
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NormalizedPicture
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NormalizedPicture
$ctoConstr :: NormalizedPicture -> Constr
toConstr :: NormalizedPicture -> Constr
$cdataTypeOf :: NormalizedPicture -> DataType
dataTypeOf :: NormalizedPicture -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NormalizedPicture)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NormalizedPicture)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c NormalizedPicture)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c NormalizedPicture)
$cgmapT :: (forall b. Data b => b -> b)
-> NormalizedPicture -> NormalizedPicture
gmapT :: (forall b. Data b => b -> b)
-> NormalizedPicture -> NormalizedPicture
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NormalizedPicture -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NormalizedPicture -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NormalizedPicture -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NormalizedPicture -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> NormalizedPicture -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> NormalizedPicture -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> NormalizedPicture -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> NormalizedPicture -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> NormalizedPicture -> m NormalizedPicture
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> NormalizedPicture -> m NormalizedPicture
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> NormalizedPicture -> m NormalizedPicture
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> NormalizedPicture -> m NormalizedPicture
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> NormalizedPicture -> m NormalizedPicture
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> NormalizedPicture -> m NormalizedPicture
Data,Typeable)


instance Drawable NormalizedPicture where

  pictures :: [NormalizedPicture] -> NormalizedPicture
pictures = (NormalizedPicture -> NormalizedPicture -> NormalizedPicture)
-> NormalizedPicture -> [NormalizedPicture] -> NormalizedPicture
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr NormalizedPicture -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => a -> a -> a
(&) NormalizedPicture
Blank

  NormalizedPicture
Blank & :: NormalizedPicture -> NormalizedPicture -> NormalizedPicture
& NormalizedPicture
p = NormalizedPicture
p
  NormalizedPicture
p & NormalizedPicture
Blank = NormalizedPicture
p
  Polyline (Hollow Thickness
Normal) [AbsPoint]
ps1 & Polyline (Hollow Thickness
Thick) [AbsPoint]
ps2 =
    ShapeKind -> [AbsPoint] -> NormalizedPicture
Polyline (Thickness -> ShapeKind
Hollow Thickness
Thick) [AbsPoint]
ps2 NormalizedPicture -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => a -> a -> a
& ShapeKind -> [AbsPoint] -> NormalizedPicture
Polyline (Thickness -> ShapeKind
Hollow Thickness
Normal) [AbsPoint]
ps1
  Polyline (Hollow Thickness
t) [AbsPoint]
ps1 & Polyline ShapeKind
Solid [AbsPoint]
ps2 =
    ShapeKind -> [AbsPoint] -> NormalizedPicture
Polyline ShapeKind
Solid [AbsPoint]
ps2 NormalizedPicture -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => a -> a -> a
& ShapeKind -> [AbsPoint] -> NormalizedPicture
Polyline (Thickness -> ShapeKind
Hollow Thickness
t) [AbsPoint]
ps1
  Curve (Hollow Thickness
Normal) [AbsPoint]
ps1 & Curve (Hollow Thickness
Thick) [AbsPoint]
ps2 =
    ShapeKind -> [AbsPoint] -> NormalizedPicture
Curve (Thickness -> ShapeKind
Hollow Thickness
Thick) [AbsPoint]
ps2 NormalizedPicture -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => a -> a -> a
& ShapeKind -> [AbsPoint] -> NormalizedPicture
Curve (Thickness -> ShapeKind
Hollow Thickness
Normal) [AbsPoint]
ps1
  Curve (Hollow Thickness
t) [AbsPoint]
ps1 & Curve ShapeKind
Solid [AbsPoint]
ps2 =
    ShapeKind -> [AbsPoint] -> NormalizedPicture
Curve ShapeKind
Solid [AbsPoint]
ps2 NormalizedPicture -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => a -> a -> a
& ShapeKind -> [AbsPoint] -> NormalizedPicture
Curve (Thickness -> ShapeKind
Hollow Thickness
t) [AbsPoint]
ps1
  Polyline ShapeKind
sp [AbsPoint]
ps1 & Curve ShapeKind
sc [AbsPoint]
ps2 = ShapeKind -> [AbsPoint] -> NormalizedPicture
Curve ShapeKind
sc [AbsPoint]
ps2 NormalizedPicture -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => a -> a -> a
& ShapeKind -> [AbsPoint] -> NormalizedPicture
Polyline ShapeKind
sp [AbsPoint]
ps1
  Polyline ShapeKind
s1 [AbsPoint]
ps1 & Polyline ShapeKind
s2 [AbsPoint]
ps2 = Bool
-> ShapeKind
-> ShapeKind
-> [AbsPoint]
-> [AbsPoint]
-> NormalizedPicture
handleFreeShape Bool
True  ShapeKind
s1 ShapeKind
s2 [AbsPoint]
ps1 [AbsPoint]
ps2
  Curve    ShapeKind
s1 [AbsPoint]
ps1 & Curve    ShapeKind
s2 [AbsPoint]
ps2 = Bool
-> ShapeKind
-> ShapeKind
-> [AbsPoint]
-> [AbsPoint]
-> NormalizedPicture
handleFreeShape Bool
False ShapeKind
s1 ShapeKind
s2 [AbsPoint]
ps1 [AbsPoint]
ps2
  NormalizedPicture
p & Polyline ShapeKind
s [AbsPoint]
ps = ShapeKind -> [AbsPoint] -> NormalizedPicture
Polyline ShapeKind
s [AbsPoint]
ps NormalizedPicture -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => a -> a -> a
& NormalizedPicture
p
  NormalizedPicture
p & Curve ShapeKind
s [AbsPoint]
ps = ShapeKind -> [AbsPoint] -> NormalizedPicture
Curve ShapeKind
s [AbsPoint]
ps NormalizedPicture -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => a -> a -> a
& NormalizedPicture
p
  NormalizedPicture
p1 & NormalizedPicture
p2 = [NormalizedPicture] -> NormalizedPicture
Pictures ([NormalizedPicture] -> NormalizedPicture)
-> [NormalizedPicture] -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ [NormalizedPicture]
ps1 [NormalizedPicture] -> [NormalizedPicture] -> [NormalizedPicture]
forall a. [a] -> [a] -> [a]
++ [NormalizedPicture]
ps2
    where
      ps1 :: [NormalizedPicture]
ps1 = case NormalizedPicture
p1 of
        Pictures [NormalizedPicture]
ps -> [NormalizedPicture]
ps
        NormalizedPicture
_           -> [NormalizedPicture
p1]
      ps2 :: [NormalizedPicture]
ps2 = case NormalizedPicture
p2 of
        Pictures [NormalizedPicture]
ps -> [NormalizedPicture]
ps
        NormalizedPicture
_           -> [NormalizedPicture
p2]

  blank :: NormalizedPicture
blank = NormalizedPicture
Blank

  coordinatePlane :: NormalizedPicture
coordinatePlane = NormalizedPicture
CoordinatePlane
  codeWorldLogo :: NormalizedPicture
codeWorldLogo = NormalizedPicture
Logo

  circle :: Double -> NormalizedPicture
circle Double
0 = NormalizedPicture
forall a. Drawable a => a
blank
  circle Double
r = ShapeKind -> Size -> NormalizedPicture
Circle (Thickness -> ShapeKind
Hollow Thickness
Normal) (Size -> NormalizedPicture) -> Size -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ Double -> Size
toSize Double
r

  solidCircle :: Double -> NormalizedPicture
solidCircle Double
0 = NormalizedPicture
forall a. Drawable a => a
blank
  solidCircle Double
r = ShapeKind -> Size -> NormalizedPicture
Circle ShapeKind
Solid (Size -> NormalizedPicture) -> Size -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ Double -> Size
toSize Double
r

  thickCircle :: Double -> Double -> NormalizedPicture
thickCircle Double
0 Double
_ = NormalizedPicture
forall a. Drawable a => a
blank
  thickCircle (Double -> Double
validThickness -> Double
t) (Double -> Double
forall a. Num a => a -> a
abs -> Double
r)
    | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r = ShapeKind -> Size -> NormalizedPicture
Circle ShapeKind
shape (Size -> NormalizedPicture) -> Size -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ Double -> Size
toSize (Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
tDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2)
    | Bool
otherwise = [Char] -> NormalizedPicture
forall a. HasCallStack => [Char] -> a
error ([Char] -> NormalizedPicture) -> [Char] -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$
        [Char]
"The line width of a thickCircle must not be greater than the diameter. " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
        [Char]
"(This error was thrown inside the test suite)"
    where
      shape :: ShapeKind
shape
        | Double
t Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
r = ShapeKind
Solid
        | Bool
otherwise = Thickness -> ShapeKind
Hollow (Thickness -> ShapeKind) -> Thickness -> ShapeKind
forall a b. (a -> b) -> a -> b
$ Double -> Thickness
forall a. (Eq a, Fractional a) => a -> Thickness
thickness Double
t

  rectangle :: Double -> Double -> NormalizedPicture
rectangle Double
0 Double
_ = NormalizedPicture
forall a. Drawable a => a
blank
  rectangle Double
_ Double
0 = NormalizedPicture
forall a. Drawable a => a
blank
  rectangle Double
l Double
w = ShapeKind -> Double -> Double -> NormalizedPicture
toWideRectangle (Thickness -> ShapeKind
Hollow Thickness
Normal) Double
l Double
w

  solidRectangle :: Double -> Double -> NormalizedPicture
solidRectangle Double
0 Double
_ = NormalizedPicture
forall a. Drawable a => a
blank
  solidRectangle Double
_ Double
0 = NormalizedPicture
forall a. Drawable a => a
blank
  solidRectangle Double
l Double
w = ShapeKind -> Double -> Double -> NormalizedPicture
toWideRectangle ShapeKind
Solid Double
l Double
w

  thickRectangle :: Double -> Double -> Double -> NormalizedPicture
thickRectangle Double
_ Double
0 Double
_ = NormalizedPicture
forall a. Drawable a => a
blank
  thickRectangle Double
_ Double
_ Double
0 = NormalizedPicture
forall a. Drawable a => a
blank
  thickRectangle (Double -> Double
validThickness -> Double
t) (Double -> Double
forall a. Num a => a -> a
abs -> Double
l) (Double -> Double
forall a. Num a => a -> a
abs -> Double
w) =
      ShapeKind -> Double -> Double -> NormalizedPicture
toWideRectangle ShapeKind
shape (Double
l Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
tDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) (Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
tDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2)
    where
      shape :: ShapeKind
shape
        | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
l Bool -> Bool -> Bool
|| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
w = ShapeKind
Solid
        | Bool
otherwise = Thickness -> ShapeKind
Hollow (Thickness -> ShapeKind) -> Thickness -> ShapeKind
forall a b. (a -> b) -> a -> b
$ Double -> Thickness
forall a. (Eq a, Fractional a) => a -> Thickness
thickness Double
t

  arc :: Double -> Double -> Double -> NormalizedPicture
arc      = ShapeKind -> Double -> Double -> Double -> NormalizedPicture
checkForCircle (ShapeKind -> Double -> Double -> Double -> NormalizedPicture)
-> ShapeKind -> Double -> Double -> Double -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ Thickness -> ShapeKind
Hollow Thickness
Normal
  sector :: Double -> Double -> Double -> NormalizedPicture
sector   = ShapeKind -> Double -> Double -> Double -> NormalizedPicture
checkForCircle ShapeKind
Solid
  thickArc :: Double -> Double -> Double -> Double -> NormalizedPicture
thickArc (Double -> Double
validThickness -> Double
t) = ShapeKind -> Double -> Double -> Double -> NormalizedPicture
checkForCircle (ShapeKind -> Double -> Double -> Double -> NormalizedPicture)
-> ShapeKind -> Double -> Double -> Double -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ Thickness -> ShapeKind
Hollow (Thickness -> ShapeKind) -> Thickness -> ShapeKind
forall a b. (a -> b) -> a -> b
$ Double -> Thickness
forall a. (Eq a, Fractional a) => a -> Thickness
thickness Double
t

  curve :: [Point] -> NormalizedPicture
curve            = ([AbsPoint] -> NormalizedPicture) -> [Point] -> NormalizedPicture
forall a. Drawable a => ([AbsPoint] -> a) -> [Point] -> a
handlePointList (([AbsPoint] -> NormalizedPicture) -> [Point] -> NormalizedPicture)
-> ([AbsPoint] -> NormalizedPicture)
-> [Point]
-> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ ShapeKind -> [AbsPoint] -> NormalizedPicture
Curve (ShapeKind -> [AbsPoint] -> NormalizedPicture)
-> ShapeKind -> [AbsPoint] -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ Thickness -> ShapeKind
Hollow Thickness
Normal
  thickCurve :: Double -> [Point] -> NormalizedPicture
thickCurve (Double -> Double
validThickness -> Double
t) = ([AbsPoint] -> NormalizedPicture) -> [Point] -> NormalizedPicture
forall a. Drawable a => ([AbsPoint] -> a) -> [Point] -> a
handlePointList (([AbsPoint] -> NormalizedPicture) -> [Point] -> NormalizedPicture)
-> ([AbsPoint] -> NormalizedPicture)
-> [Point]
-> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ ShapeKind -> [AbsPoint] -> NormalizedPicture
Curve (ShapeKind -> [AbsPoint] -> NormalizedPicture)
-> ShapeKind -> [AbsPoint] -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ Thickness -> ShapeKind
Hollow (Thickness -> ShapeKind) -> Thickness -> ShapeKind
forall a b. (a -> b) -> a -> b
$ Double -> Thickness
forall a. (Eq a, Fractional a) => a -> Thickness
thickness Double
t
  solidClosedCurve :: [Point] -> NormalizedPicture
solidClosedCurve = ([AbsPoint] -> NormalizedPicture) -> [Point] -> NormalizedPicture
forall a. Drawable a => ([AbsPoint] -> a) -> [Point] -> a
handlePointList (ShapeKind -> [AbsPoint] -> NormalizedPicture
Curve ShapeKind
Solid) ([Point] -> NormalizedPicture)
-> ([Point] -> [Point]) -> [Point] -> NormalizedPicture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point] -> [Point]
toOpenShape

  closedCurve :: [Point] -> NormalizedPicture
closedCurve        = [Point] -> NormalizedPicture
forall a. Drawable a => [Point] -> a
curve ([Point] -> NormalizedPicture)
-> ([Point] -> [Point]) -> [Point] -> NormalizedPicture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point] -> [Point]
toOpenShape
  thickClosedCurve :: Double -> [Point] -> NormalizedPicture
thickClosedCurve (Double -> Double
validThickness -> Double
t) = Double -> [Point] -> NormalizedPicture
forall a. Drawable a => Double -> [Point] -> a
thickCurve Double
t ([Point] -> NormalizedPicture)
-> ([Point] -> [Point]) -> [Point] -> NormalizedPicture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point] -> [Point]
toOpenShape

  polyline :: [Point] -> NormalizedPicture
polyline        = ShapeKind -> [Point] -> NormalizedPicture
checkForRectangle (ShapeKind -> [Point] -> NormalizedPicture)
-> ShapeKind -> [Point] -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ Thickness -> ShapeKind
Hollow Thickness
Normal
  thickPolyline :: Double -> [Point] -> NormalizedPicture
thickPolyline (Double -> Double
validThickness -> Double
t) = ShapeKind -> [Point] -> NormalizedPicture
checkForRectangle (ShapeKind -> [Point] -> NormalizedPicture)
-> ShapeKind -> [Point] -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ Thickness -> ShapeKind
Hollow (Thickness -> ShapeKind) -> Thickness -> ShapeKind
forall a b. (a -> b) -> a -> b
$ Double -> Thickness
forall a. (Eq a, Fractional a) => a -> Thickness
thickness Double
t
  solidPolygon :: [Point] -> NormalizedPicture
solidPolygon    = ShapeKind -> [Point] -> NormalizedPicture
checkForRectangle ShapeKind
Solid ([Point] -> NormalizedPicture)
-> ([Point] -> [Point]) -> [Point] -> NormalizedPicture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point] -> [Point]
toOpenShape

  polygon :: [Point] -> NormalizedPicture
polygon        = [Point] -> NormalizedPicture
forall a. Drawable a => [Point] -> a
polyline ([Point] -> NormalizedPicture)
-> ([Point] -> [Point]) -> [Point] -> NormalizedPicture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point] -> [Point]
toOpenShape
  thickPolygon :: Double -> [Point] -> NormalizedPicture
thickPolygon (Double -> Double
validThickness -> Double
t) = Double -> [Point] -> NormalizedPicture
forall a. Drawable a => Double -> [Point] -> a
thickPolyline Double
t ([Point] -> NormalizedPicture)
-> ([Point] -> [Point]) -> [Point] -> NormalizedPicture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point] -> [Point]
toOpenShape

  lettering :: Text -> NormalizedPicture
lettering Text
"" = NormalizedPicture
forall a. Drawable a => a
blank
  lettering Text
t  = Text -> NormalizedPicture
Lettering Text
t

  styledLettering :: TextStyle -> Font -> Text -> NormalizedPicture
styledLettering TextStyle
_ Font
_ Text
"" = NormalizedPicture
forall a. Drawable a => a
blank
  styledLettering TextStyle
_ Font
_ Text
t = Text -> NormalizedPicture
Lettering Text
t

  translated :: Double -> Double -> NormalizedPicture -> NormalizedPicture
translated Double
0 Double
0 NormalizedPicture
p = NormalizedPicture
p
  translated Double
x Double
y NormalizedPicture
p = case NormalizedPicture
p of
    Translate Position
a Position
b NormalizedPicture
q -> Double -> Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> Double -> a -> a
translated (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Position -> Double
fromPosition Position
a) (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Position -> Double
fromPosition Position
b) NormalizedPicture
q
    Pictures [NormalizedPicture]
ps     -> [NormalizedPicture] -> NormalizedPicture
Pictures ([NormalizedPicture] -> NormalizedPicture)
-> [NormalizedPicture] -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ (NormalizedPicture -> NormalizedPicture)
-> [NormalizedPicture] -> [NormalizedPicture]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> Double -> a -> a
translated Double
x Double
y) [NormalizedPicture]
ps
    NormalizedPicture
Blank           -> NormalizedPicture
Blank
    Color AbsColor
c NormalizedPicture
q       -> AbsColor -> NormalizedPicture -> NormalizedPicture
Color AbsColor
c (NormalizedPicture -> NormalizedPicture)
-> NormalizedPicture -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ Double -> Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> Double -> a -> a
translated Double
x Double
y NormalizedPicture
q
    Polyline ShapeKind
s [AbsPoint]
ps   -> ShapeKind -> [AbsPoint] -> NormalizedPicture
Polyline ShapeKind
s ([AbsPoint] -> NormalizedPicture)
-> [AbsPoint] -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ (AbsPoint -> AbsPoint) -> [AbsPoint] -> [AbsPoint]
forall a b. (a -> b) -> [a] -> [b]
map ((Point -> Point) -> AbsPoint -> AbsPoint
applyToAbsPoint (Point -> Point -> Point
vectorSum (Double
x,Double
y))) [AbsPoint]
ps
    Curve ShapeKind
s [AbsPoint]
ps      -> ShapeKind -> [AbsPoint] -> NormalizedPicture
Curve    ShapeKind
s ([AbsPoint] -> NormalizedPicture)
-> [AbsPoint] -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ (AbsPoint -> AbsPoint) -> [AbsPoint] -> [AbsPoint]
forall a b. (a -> b) -> [a] -> [b]
map ((Point -> Point) -> AbsPoint -> AbsPoint
applyToAbsPoint (Point -> Point -> Point
vectorSum (Double
x,Double
y))) [AbsPoint]
ps
    NormalizedPicture
a               -> Position -> Position -> NormalizedPicture -> NormalizedPicture
Translate (Double -> Position
toPosition Double
x) (Double -> Position
toPosition Double
y) NormalizedPicture
a

  colored :: Color -> NormalizedPicture -> NormalizedPicture
colored Color
c NormalizedPicture
p = case NormalizedPicture
p of
    Color AbsColor
_ NormalizedPicture
q      -> Color -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Color -> a -> a
colored Color
c NormalizedPicture
q
    Pictures [NormalizedPicture]
ps    -> [NormalizedPicture] -> NormalizedPicture
Pictures ([NormalizedPicture] -> NormalizedPicture)
-> [NormalizedPicture] -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ (NormalizedPicture -> NormalizedPicture)
-> [NormalizedPicture] -> [NormalizedPicture]
forall a b. (a -> b) -> [a] -> [b]
map (Color -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Color -> a -> a
colored Color
c) [NormalizedPicture]
ps
    NormalizedPicture
Blank          -> NormalizedPicture
Blank
    NormalizedPicture
q              -> case Color -> AbsColor
toAbsColor Color
c of
      Tone Double
0 Double
0 Double
0 -> NormalizedPicture
q
      AbsColor
absC       -> AbsColor -> NormalizedPicture -> NormalizedPicture
Color AbsColor
absC NormalizedPicture
q

  dilated :: Double -> NormalizedPicture -> NormalizedPicture
dilated Double
fac = Double -> Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> Double -> a -> a
scaled Double
fac Double
fac

  scaled :: Double -> Double -> NormalizedPicture -> NormalizedPicture
scaled Double
0 Double
_ NormalizedPicture
_ = NormalizedPicture
forall a. Drawable a => a
blank
  scaled Double
_ Double
0 NormalizedPicture
_ = NormalizedPicture
forall a. Drawable a => a
blank
  scaled Double
1 Double
1 NormalizedPicture
p = NormalizedPicture
p
  scaled Double
fac1 Double
fac2 (Circle ShapeKind
sk Size
s) | Double
fac1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
fac2 =
    ShapeKind -> Size -> NormalizedPicture
Circle ShapeKind
sk (Double -> Size
toSize (Double -> Size) -> Double -> Size
forall a b. (a -> b) -> a -> b
$ Size -> Double
fromSize Size
s Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
fac1)
  scaled Double
fac1 Double
fac2 (Rectangle ShapeKind
sk Size
s1 Size
s2) =
    ShapeKind -> Double -> Double -> NormalizedPicture
shapeKindToRectangle ShapeKind
sk (Size -> Double
fromSize Size
s1 Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
fac1) (Size -> Double
fromSize Size
s2 Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
fac2)
  scaled Double
fac1 Double
fac2 NormalizedPicture
p = case NormalizedPicture
p of
    Scale Factor
f1 Factor
f2 NormalizedPicture
q    -> Double -> Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> Double -> a -> a
scaled (Factor -> Double
fromFactor Factor
f1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
fac1) (Factor -> Double
fromFactor Factor
f2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
fac2) NormalizedPicture
q
    Translate Position
x Position
y NormalizedPicture
q  -> Position -> Position -> NormalizedPicture -> NormalizedPicture
Translate
      (Double -> Position
toPosition (Double -> Position) -> Double -> Position
forall a b. (a -> b) -> a -> b
$ Position -> Double
fromPosition Position
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
fac1)
      (Double -> Position
toPosition (Double -> Position) -> Double -> Position
forall a b. (a -> b) -> a -> b
$ Position -> Double
fromPosition Position
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
fac2)
      (NormalizedPicture -> NormalizedPicture)
-> NormalizedPicture -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ Double -> Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> Double -> a -> a
scaled Double
fac1 Double
fac2 NormalizedPicture
q
    NormalizedPicture
Blank            -> NormalizedPicture
Blank
    Color AbsColor
c NormalizedPicture
q        -> AbsColor -> NormalizedPicture -> NormalizedPicture
Color AbsColor
c (NormalizedPicture -> NormalizedPicture)
-> NormalizedPicture -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ Double -> Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> Double -> a -> a
scaled Double
fac1 Double
fac2 NormalizedPicture
q
    Pictures [NormalizedPicture]
ps      -> [NormalizedPicture] -> NormalizedPicture
Pictures ([NormalizedPicture] -> NormalizedPicture)
-> [NormalizedPicture] -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ (NormalizedPicture -> NormalizedPicture)
-> [NormalizedPicture] -> [NormalizedPicture]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> Double -> a -> a
scaled Double
fac1 Double
fac2) [NormalizedPicture]
ps
    Polyline ShapeKind
s [AbsPoint]
ps    -> ShapeKind -> [AbsPoint] -> NormalizedPicture
Polyline ShapeKind
s ([AbsPoint] -> NormalizedPicture)
-> [AbsPoint] -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ (AbsPoint -> AbsPoint) -> [AbsPoint] -> [AbsPoint]
forall a b. (a -> b) -> [a] -> [b]
map ((Point -> Point) -> AbsPoint -> AbsPoint
applyToAbsPoint (Double -> Double -> Point -> Point
scaledVector Double
fac1 Double
fac2)) [AbsPoint]
ps
    Curve ShapeKind
s [AbsPoint]
ps       -> ShapeKind -> [AbsPoint] -> NormalizedPicture
Curve    ShapeKind
s ([AbsPoint] -> NormalizedPicture)
-> [AbsPoint] -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ (AbsPoint -> AbsPoint) -> [AbsPoint] -> [AbsPoint]
forall a b. (a -> b) -> [a] -> [b]
map ((Point -> Point) -> AbsPoint -> AbsPoint
applyToAbsPoint (Double -> Double -> Point -> Point
scaledVector Double
fac1 Double
fac2)) [AbsPoint]
ps
    NormalizedPicture
a                -> Factor -> Factor -> NormalizedPicture -> NormalizedPicture
Scale (Double -> Factor
toFactor Double
fac1) (Double -> Factor
toFactor Double
fac2) NormalizedPicture
a

  rotated :: Double -> NormalizedPicture -> NormalizedPicture
rotated Double
a NormalizedPicture
p
    | Double
modAngle Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 = NormalizedPicture
p
    | Bool
otherwise = case NormalizedPicture
p of
      Scale Factor
fac1 Factor
fac2 c :: NormalizedPicture
c@(Circle {})
        | Double
modAngle Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2 Bool -> Bool -> Bool
|| Double
modAngle Double -> Double -> Bool
forall a. Eq 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 -> Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> Double -> a -> a
scaled (Factor -> Double
fromFactor Factor
fac2) (Factor -> Double
fromFactor Factor
fac1) NormalizedPicture
c
      Rotate Angle
a2 NormalizedPicture
q     -> Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> a -> a
rotated (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Angle -> Double
fromAngle Angle
a2) NormalizedPicture
q
      Reflect Angle
a2 NormalizedPicture
q    -> Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> a -> a
reflected (Angle -> Double
fromAngle Angle
a2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
aDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) NormalizedPicture
q
      Translate Position
x Position
y NormalizedPicture
q -> Position -> Position -> NormalizedPicture -> NormalizedPicture
Translate
                          (Double -> Position
toPosition (Double -> Position) -> Double -> Position
forall a b. (a -> b) -> a -> b
$ Position -> Double
fromPosition Position
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double -> Double
forall a. Floating a => a -> a
cos Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
- Position -> Double
fromPosition Position
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double -> Double
forall a. Floating a => a -> a
sin Double
a)
                          (Double -> Position
toPosition (Double -> Position) -> Double -> Position
forall a b. (a -> b) -> a -> b
$ Position -> Double
fromPosition Position
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double -> Double
forall a. Floating a => a -> a
sin Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Position -> Double
fromPosition Position
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double -> Double
forall a. Floating a => a -> a
cos Double
a)
                          (NormalizedPicture -> NormalizedPicture)
-> NormalizedPicture -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> a -> a
rotated Double
a NormalizedPicture
q
      Color AbsColor
c NormalizedPicture
q       -> AbsColor -> NormalizedPicture -> NormalizedPicture
Color AbsColor
c (NormalizedPicture -> NormalizedPicture)
-> NormalizedPicture -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> a -> a
rotated Double
a NormalizedPicture
q
      Pictures [NormalizedPicture]
ps     -> [NormalizedPicture] -> NormalizedPicture
Pictures ([NormalizedPicture] -> NormalizedPicture)
-> [NormalizedPicture] -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ (NormalizedPicture -> NormalizedPicture)
-> [NormalizedPicture] -> [NormalizedPicture]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> a -> a
rotated Double
a) [NormalizedPicture]
ps
      Polyline ShapeKind
s [AbsPoint]
ps   -> ShapeKind -> [AbsPoint] -> NormalizedPicture
Polyline ShapeKind
s ([AbsPoint] -> NormalizedPicture)
-> [AbsPoint] -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ (AbsPoint -> AbsPoint) -> [AbsPoint] -> [AbsPoint]
forall a b. (a -> b) -> [a] -> [b]
map ((Point -> Point) -> AbsPoint -> AbsPoint
applyToAbsPoint (Double -> Point -> Point
rotatedVector Double
a)) [AbsPoint]
ps
      Curve ShapeKind
s [AbsPoint]
ps      -> ShapeKind -> [AbsPoint] -> NormalizedPicture
Curve    ShapeKind
s ([AbsPoint] -> NormalizedPicture)
-> [AbsPoint] -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ (AbsPoint -> AbsPoint) -> [AbsPoint] -> [AbsPoint]
forall a b. (a -> b) -> [a] -> [b]
map ((Point -> Point) -> AbsPoint -> AbsPoint
applyToAbsPoint (Double -> Point -> Point
rotatedVector Double
a)) [AbsPoint]
ps
      Rectangle ShapeKind
s Size
x Size
y
        | Angle -> Double
fromAngle Angle
absAngle Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>=  Double
forall a. Floating a => a
pi  -> Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> a -> a
rotated (Double
modAngle Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
forall a. Floating a => a
pi) (NormalizedPicture -> NormalizedPicture)
-> NormalizedPicture -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ ShapeKind -> Size -> Size -> NormalizedPicture
Rectangle ShapeKind
s Size
x Size
y
      Circle ShapeKind
s Size
r      -> ShapeKind -> Size -> NormalizedPicture
Circle ShapeKind
s Size
r
      NormalizedPicture
q               -> Angle -> NormalizedPicture -> NormalizedPicture
Rotate Angle
absAngle NormalizedPicture
q
    where
      absAngle :: Angle
absAngle = Double -> Angle
toAngle Double
a
      modAngle :: Double
modAngle = Angle -> Double
fromAngle Angle
absAngle


  reflected :: Double -> NormalizedPicture -> NormalizedPicture
reflected Double
a1 (Reflect Angle
a2 NormalizedPicture
p)
    | Double
a1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Angle -> Double
fromAngle Angle
a2 = NormalizedPicture
p
    | Bool
otherwise = Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> a -> a
rotated (Double
a1Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Angle -> Double
fromAngle Angle
a2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
2) NormalizedPicture
p
  reflected Double
a (Rectangle ShapeKind
s Size
x Size
y) = Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> a -> a
rotated (Double
aDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
2) (NormalizedPicture -> NormalizedPicture)
-> NormalizedPicture -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ ShapeKind -> Size -> Size -> NormalizedPicture
Rectangle ShapeKind
s Size
x Size
y
  reflected Double
_ (Circle ShapeKind
s Size
r) = ShapeKind -> Size -> NormalizedPicture
Circle ShapeKind
s Size
r
  reflected Double
a (Polyline ShapeKind
s [AbsPoint]
ps) = ShapeKind -> [AbsPoint] -> NormalizedPicture
Polyline ShapeKind
s ([AbsPoint] -> NormalizedPicture)
-> [AbsPoint] -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ (AbsPoint -> AbsPoint) -> [AbsPoint] -> [AbsPoint]
forall a b. (a -> b) -> [a] -> [b]
map ((Point -> Point) -> AbsPoint -> AbsPoint
applyToAbsPoint (Double -> Point -> Point
reflectedPoint Double
a)) [AbsPoint]
ps
  reflected Double
a (Curve ShapeKind
s [AbsPoint]
ps) = ShapeKind -> [AbsPoint] -> NormalizedPicture
Curve ShapeKind
s ([AbsPoint] -> NormalizedPicture)
-> [AbsPoint] -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ (AbsPoint -> AbsPoint) -> [AbsPoint] -> [AbsPoint]
forall a b. (a -> b) -> [a] -> [b]
map ((Point -> Point) -> AbsPoint -> AbsPoint
applyToAbsPoint (Double -> Point -> Point
reflectedPoint Double
a)) [AbsPoint]
ps
  reflected Double
a (Pictures [NormalizedPicture]
ps) = [NormalizedPicture] -> NormalizedPicture
Pictures ([NormalizedPicture] -> NormalizedPicture)
-> [NormalizedPicture] -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ (NormalizedPicture -> NormalizedPicture)
-> [NormalizedPicture] -> [NormalizedPicture]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> a -> a
reflected Double
a) [NormalizedPicture]
ps
  reflected Double
a (Translate Position
x Position
y NormalizedPicture
p) =
    let
      exactX :: Double
exactX = Position -> Double
fromPosition Position
x
      exactY :: Double
exactY = Position -> Double
fromPosition Position
y
      twoTimesSquaredSubOne :: (Double -> a) -> a
twoTimesSquaredSubOne Double -> a
f = a
2 a -> a -> a
forall a. Num a => a -> a -> a
* Double -> a
f Double
aa -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
2 :: Int) a -> a -> a
forall a. Num a => a -> a -> a
-a
1
      twoTimesCosSin :: Double
twoTimesCosSin = Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sin Double
a
    in Double -> Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> Double -> a -> a
translated
      ((Double -> Double) -> Double
forall {a}. Num a => (Double -> a) -> a
twoTimesSquaredSubOne Double -> Double
forall a. Floating a => a -> a
cos Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
exactX Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
twoTimesCosSin Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
exactY)
      (Double
twoTimesCosSin Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
exactX Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double -> Double) -> Double
forall {a}. Num a => (Double -> a) -> a
twoTimesSquaredSubOne Double -> Double
forall a. Floating a => a -> a
sin Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
exactY)
      (NormalizedPicture -> NormalizedPicture)
-> NormalizedPicture -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> a -> a
reflected Double
a NormalizedPicture
p
  reflected Double
a (Rotate Angle
a2 NormalizedPicture
p) = Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> a -> a
reflected (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Angle -> Double
fromAngle Angle
a2Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2)) NormalizedPicture
p
  reflected Double
a (Color AbsColor
c NormalizedPicture
q)   = AbsColor -> NormalizedPicture -> NormalizedPicture
Color AbsColor
c (NormalizedPicture -> NormalizedPicture)
-> NormalizedPicture -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> a -> a
reflected Double
a NormalizedPicture
q
  reflected Double
a NormalizedPicture
p = Angle -> NormalizedPicture -> NormalizedPicture
Reflect (Double -> Angle
toAngle Double
a) NormalizedPicture
p

  -- TODO: clip free shapes?
  clipped :: Double -> Double -> NormalizedPicture -> NormalizedPicture
clipped Double
x Double
y = Size -> Size -> NormalizedPicture -> NormalizedPicture
Clip (Double -> Size
toSize Double
x) (Double -> Size
toSize Double
y)


checkForCircle :: ShapeKind -> Double -> Double -> Double -> NormalizedPicture
checkForCircle :: ShapeKind -> Double -> Double -> Double -> NormalizedPicture
checkForCircle ShapeKind
_ Double
_ Double
_ Double
0 = NormalizedPicture
forall a. Drawable a => a
blank
checkForCircle ShapeKind
shape Double
a1 Double
a2 Double
r
  | Double
a1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
a2  = NormalizedPicture
forall a. Drawable a => a
blank
  | Double
a1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
a2 = Double -> Double -> Double -> NormalizedPicture
forall a. Drawable a => Double -> Double -> Double -> a
arc Double
a2 Double
a1 Double
r
  | 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
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
pi = Double -> NormalizedPicture
circleKind Double
r
  | Bool
otherwise = ShapeKind -> Angle -> Angle -> Size -> NormalizedPicture
Arc ShapeKind
shape (Double -> Angle
toAngle Double
a1) (Double -> Angle
toAngle Double
a2) (Double -> Size
toSize Double
r)
  where
    circleKind :: Double -> NormalizedPicture
circleKind = case ShapeKind
shape of
      Hollow Thickness
Normal -> Double -> NormalizedPicture
forall a. Drawable a => Double -> a
circle
      Hollow Thickness
Thick  -> Double -> Double -> NormalizedPicture
forall a. Drawable a => Double -> Double -> a
thickCircle Double
1
      ShapeKind
Solid         -> Double -> NormalizedPicture
forall a. Drawable a => Double -> a
solidCircle


checkForRectangle :: ShapeKind -> [Point] -> NormalizedPicture
checkForRectangle :: ShapeKind -> [Point] -> NormalizedPicture
checkForRectangle ShapeKind
shape [Point]
ps = case ShapeKind -> [Point] -> Maybe NormalizedPicture
pointsToRectangle ShapeKind
shape [Point]
ps of
  Maybe NormalizedPicture
Nothing -> ([AbsPoint] -> NormalizedPicture) -> [Point] -> NormalizedPicture
forall a. Drawable a => ([AbsPoint] -> a) -> [Point] -> a
handlePointList (ShapeKind -> [AbsPoint] -> NormalizedPicture
Polyline ShapeKind
shape) [Point]
ps
  Just NormalizedPicture
r  -> NormalizedPicture
r


handlePointList :: Drawable a => ([AbsPoint] -> a) -> [Point] -> a
handlePointList :: forall a. Drawable a => ([AbsPoint] -> a) -> [Point] -> a
handlePointList [AbsPoint] -> a
f [Point]
ps
    | [Point] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Point]
noRepeats Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = a
forall a. Drawable a => a
blank
    | Bool
otherwise = [AbsPoint] -> a
f ([AbsPoint] -> a) -> [AbsPoint] -> a
forall a b. (a -> b) -> a -> b
$ (Point -> AbsPoint) -> [Point] -> [AbsPoint]
forall a b. (a -> b) -> [a] -> [b]
map Point -> AbsPoint
toAbsPoint [Point]
noRepeats
  where
    noRepeats :: [Point]
noRepeats = [Point] -> [Point]
forall a. Eq a => [a] -> [a]
removeDupes [Point]
ps


toOpenShape :: [Point] -> [Point]
toOpenShape :: [Point] -> [Point]
toOpenShape [Point]
ps = [Point]
ps [Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
take Int
1 [Point]
ps


removeDupes :: Eq a => [a] -> [a]
removeDupes :: forall a. Eq a => [a] -> [a]
removeDupes (a
x:a
y:[a]
xs)
  | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y    =      [a]
rec
  | Bool
otherwise =  a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rec
  where rec :: [a]
rec = [a] -> [a]
forall a. Eq a => [a] -> [a]
removeDupes (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
removeDupes [a]
xs = [a]
xs


pointsToRectangle :: ShapeKind -> [Point] -> Maybe NormalizedPicture
pointsToRectangle :: ShapeKind -> [Point] -> Maybe NormalizedPicture
pointsToRectangle ShapeKind
shapeKind [Point]
ps
  | [Point] -> Bool
isRectangle [Point]
ps = NormalizedPicture -> Maybe NormalizedPicture
forall a. a -> Maybe a
Just (NormalizedPicture -> Maybe NormalizedPicture)
-> NormalizedPicture -> Maybe NormalizedPicture
forall a b. (a -> b) -> a -> b
$ Double -> Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> Double -> a -> a
translated Double
x Double
y (NormalizedPicture -> NormalizedPicture)
-> NormalizedPicture -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> a -> a
rotated Double
angle (NormalizedPicture -> NormalizedPicture)
-> NormalizedPicture -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ Double -> Double -> NormalizedPicture
shapeToUse Double
xLen Double
yLen
  | Bool
otherwise = Maybe NormalizedPicture
forall a. Maybe a
Nothing
  where
    (Double
xLen,Double
yLen) = [Point] -> Point
sideLengths [Point]
ps
    angle :: Double
angle = [Point] -> Double
rotationAngle [Point]
originPs
    ([Point]
originPs,(Double
x,Double
y)) = [Point] -> ([Point], Point)
atOriginWithOffset (Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
drop Int
1 [Point]
ps)
    shapeToUse :: Double -> Double -> NormalizedPicture
shapeToUse = case ShapeKind
shapeKind of
      Hollow Thickness
Normal -> Double -> Double -> NormalizedPicture
forall a. Drawable a => Double -> Double -> a
rectangle
      Hollow Thickness
Thick  -> Double -> Double -> Double -> NormalizedPicture
forall a. Drawable a => Double -> Double -> Double -> a
thickRectangle Double
1
      ShapeKind
Solid         -> Double -> Double -> NormalizedPicture
forall a. Drawable a => Double -> Double -> a
solidRectangle


toWideRectangle :: ShapeKind -> Double -> Double -> NormalizedPicture
toWideRectangle :: ShapeKind -> Double -> Double -> NormalizedPicture
toWideRectangle ShapeKind
shape Double
l Double
w
    | Double
l Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
w = ShapeKind -> Size -> Size -> NormalizedPicture
Rectangle ShapeKind
shape (Double -> Size
toSize Double
l) (Size -> NormalizedPicture) -> Size -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ Double -> Size
toSize Double
w
    | Bool
otherwise = Double -> NormalizedPicture -> NormalizedPicture
forall a. Drawable a => Double -> a -> a
rotated (Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) (NormalizedPicture -> NormalizedPicture)
-> NormalizedPicture -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ ShapeKind -> Size -> Size -> NormalizedPicture
Rectangle ShapeKind
shape (Double -> Size
toSize Double
w) (Size -> NormalizedPicture) -> Size -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ Double -> Size
toSize Double
l


shapeKindToRectangle :: ShapeKind -> Double -> Double -> NormalizedPicture
shapeKindToRectangle :: ShapeKind -> Double -> Double -> NormalizedPicture
shapeKindToRectangle (Hollow Thickness
Normal) = Double -> Double -> NormalizedPicture
forall a. Drawable a => Double -> Double -> a
rectangle
shapeKindToRectangle (Hollow Thickness
Thick) = Double -> Double -> Double -> NormalizedPicture
forall a. Drawable a => Double -> Double -> Double -> a
thickRectangle Double
1
shapeKindToRectangle ShapeKind
Solid = Double -> Double -> NormalizedPicture
forall a. Drawable a => Double -> Double -> a
solidRectangle


handleFreeShape
  :: Bool
  -> ShapeKind
  -> ShapeKind
  -> [AbsPoint]
  -> [AbsPoint]
  -> NormalizedPicture
handleFreeShape :: Bool
-> ShapeKind
-> ShapeKind
-> [AbsPoint]
-> [AbsPoint]
-> NormalizedPicture
handleFreeShape Bool
isPolyline ShapeKind
s1 ShapeKind
s2 [AbsPoint]
ps1 [AbsPoint]
ps2
  | [Point]
endPs1 [Point] -> [Point] -> Bool
forall a. Eq a => a -> a -> Bool
== [AbsPoint] -> [Point]
toPoints [AbsPoint]
startPs2
    Bool -> Bool -> Bool
&& ShapeKind
s1 ShapeKind -> ShapeKind -> Bool
forall a. Eq a => a -> a -> Bool
== ShapeKind
s2
  = ShapeKind -> [Point] -> NormalizedPicture
func ShapeKind
s1 ([AbsPoint] -> [Point]
toPoints ([AbsPoint] -> [Point]) -> [AbsPoint] -> [Point]
forall a b. (a -> b) -> a -> b
$ [AbsPoint]
ps1 [AbsPoint] -> [AbsPoint] -> [AbsPoint]
forall a. [a] -> [a] -> [a]
++ [AbsPoint]
restPs2)
  | [Point]
endPs1 [Point] -> [Point] -> Bool
forall a. Eq a => a -> a -> Bool
== [AbsPoint] -> [Point]
toPoints [AbsPoint]
startRevPs2
    Bool -> Bool -> Bool
&& ShapeKind
s1 ShapeKind -> ShapeKind -> Bool
forall a. Eq a => a -> a -> Bool
== ShapeKind
s2
  = ShapeKind -> [Point] -> NormalizedPicture
func ShapeKind
s1 ([AbsPoint] -> [Point]
toPoints ([AbsPoint] -> [Point]) -> [AbsPoint] -> [Point]
forall a b. (a -> b) -> a -> b
$ [AbsPoint]
ps1 [AbsPoint] -> [AbsPoint] -> [AbsPoint]
forall a. [a] -> [a] -> [a]
++ [AbsPoint]
endRevPs2)
  | Bool
otherwise = [NormalizedPicture] -> NormalizedPicture
Pictures [ShapeKind -> [Point] -> NormalizedPicture
func ShapeKind
s1 ([AbsPoint] -> [Point]
toPoints [AbsPoint]
ps1), ShapeKind -> [Point] -> NormalizedPicture
func ShapeKind
s2 ([AbsPoint] -> [Point]
toPoints [AbsPoint]
ps2)]
    where
      toPoints :: [AbsPoint] -> [Point]
toPoints = (AbsPoint -> Point) -> [AbsPoint] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map AbsPoint -> Point
fromAbsPoint
      ([AbsPoint]
startPs2,[AbsPoint]
restPs2) = Int -> [AbsPoint] -> ([AbsPoint], [AbsPoint])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 [AbsPoint]
ps2
      ([AbsPoint]
startRevPs2, [AbsPoint]
endRevPs2) = Int -> [AbsPoint] -> ([AbsPoint], [AbsPoint])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 ([AbsPoint] -> ([AbsPoint], [AbsPoint]))
-> [AbsPoint] -> ([AbsPoint], [AbsPoint])
forall a b. (a -> b) -> a -> b
$ [AbsPoint] -> [AbsPoint]
forall a. [a] -> [a]
reverse [AbsPoint]
ps2
      endPs1 :: [Point]
endPs1 = [AbsPoint] -> [Point]
toPoints ([AbsPoint] -> [Point]) -> [AbsPoint] -> [Point]
forall a b. (a -> b) -> a -> b
$ Int -> [AbsPoint] -> [AbsPoint]
forall a. Int -> [a] -> [a]
takeEnd Int
1 [AbsPoint]
ps1
      solidCurveHelper :: [Point] -> NormalizedPicture
solidCurveHelper = ([AbsPoint] -> NormalizedPicture) -> [Point] -> NormalizedPicture
forall a. Drawable a => ([AbsPoint] -> a) -> [Point] -> a
handlePointList (([AbsPoint] -> NormalizedPicture) -> [Point] -> NormalizedPicture)
-> ([AbsPoint] -> NormalizedPicture)
-> [Point]
-> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ ShapeKind -> [AbsPoint] -> NormalizedPicture
Curve ShapeKind
Solid
      solidPolylineHelper :: [Point] -> NormalizedPicture
solidPolylineHelper = ShapeKind -> [Point] -> NormalizedPicture
checkForRectangle ShapeKind
Solid

      func :: ShapeKind -> [Point] -> NormalizedPicture
func ShapeKind
s = case ShapeKind
s of
        (Hollow Thickness
Normal)
          | Bool
isPolyline -> [Point] -> NormalizedPicture
forall a. Drawable a => [Point] -> a
polyline
          | Bool
otherwise  -> [Point] -> NormalizedPicture
forall a. Drawable a => [Point] -> a
curve
        (Hollow Thickness
Thick)
          | Bool
isPolyline -> Double -> [Point] -> NormalizedPicture
forall a. Drawable a => Double -> [Point] -> a
thickPolyline Double
1
          | Bool
otherwise  -> Double -> [Point] -> NormalizedPicture
forall a. Drawable a => Double -> [Point] -> a
thickCurve Double
1
        ShapeKind
Solid
          | Bool
isPolyline -> [Point] -> NormalizedPicture
solidPolylineHelper
          | Bool
otherwise  -> [Point] -> NormalizedPicture
solidCurveHelper


{-|
True if the first image contains the second image.
This uses fuzzy comparison.
-}
contains :: NormalizedPicture -> NormalizedPicture -> Bool
NormalizedPicture
p contains :: NormalizedPicture -> NormalizedPicture -> Bool
`contains` (Pictures [NormalizedPicture]
ps) = (NormalizedPicture -> Bool) -> [NormalizedPicture] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (NormalizedPicture -> NormalizedPicture -> Bool
contains NormalizedPicture
p) [NormalizedPicture]
ps
(Pictures [NormalizedPicture]
ps) `contains` NormalizedPicture
p = (NormalizedPicture -> Bool) -> [NormalizedPicture] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (NormalizedPicture -> NormalizedPicture -> Bool
`contains` NormalizedPicture
p) [NormalizedPicture]
ps
NormalizedPicture
p `contains` NormalizedPicture
q = NormalizedPicture
p NormalizedPicture -> NormalizedPicture -> Bool
forall a. Eq a => a -> a -> Bool
== NormalizedPicture
q Bool -> Bool -> Bool
|| case NormalizedPicture
p of
  Translate Position
x Position
y NormalizedPicture
pic -> case NormalizedPicture
q of
    Translate Position
x2 Position
y2 NormalizedPicture
innerP -> Position
x2 Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
== Position
x Bool -> Bool -> Bool
&& Position
y Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
== Position
y2 Bool -> Bool -> Bool
&& NormalizedPicture
pic NormalizedPicture -> NormalizedPicture -> Bool
`contains` NormalizedPicture
innerP
    NormalizedPicture
_                      -> NormalizedPicture
pic NormalizedPicture -> NormalizedPicture -> Bool
`contains` NormalizedPicture
q
  Rotate Angle
a NormalizedPicture
pic -> case NormalizedPicture
q of
    Rotate Angle
a2 NormalizedPicture
innerP -> Angle
a2 Angle -> Angle -> Bool
forall a. Eq a => a -> a -> Bool
== Angle
a Bool -> Bool -> Bool
&& NormalizedPicture
pic NormalizedPicture -> NormalizedPicture -> Bool
`contains` NormalizedPicture
innerP
    NormalizedPicture
_                -> NormalizedPicture
pic NormalizedPicture -> NormalizedPicture -> Bool
`contains` NormalizedPicture
q
  Reflect Angle
a NormalizedPicture
pic -> case NormalizedPicture
q of
    Reflect Angle
a2 NormalizedPicture
innerP -> Angle
a Angle -> Angle -> Bool
forall a. Eq a => a -> a -> Bool
== Angle
a2 Bool -> Bool -> Bool
&& NormalizedPicture
pic NormalizedPicture -> NormalizedPicture -> Bool
`contains` NormalizedPicture
innerP
    NormalizedPicture
_                 -> NormalizedPicture
pic NormalizedPicture -> NormalizedPicture -> Bool
`contains` NormalizedPicture
q
  Scale Factor
f1 Factor
f2 NormalizedPicture
pic -> case NormalizedPicture
q of
    Scale Factor
g1 Factor
g2 NormalizedPicture
innerP -> Factor
f1 Factor -> Factor -> Bool
forall a. Eq a => a -> a -> Bool
== Factor
g1 Bool -> Bool -> Bool
&& Factor
f2 Factor -> Factor -> Bool
forall a. Eq a => a -> a -> Bool
== Factor
g2 Bool -> Bool -> Bool
&& NormalizedPicture
pic NormalizedPicture -> NormalizedPicture -> Bool
`contains` NormalizedPicture
innerP
    NormalizedPicture
_                  -> NormalizedPicture
pic NormalizedPicture -> NormalizedPicture -> Bool
`contains` NormalizedPicture
q
  Color AbsColor
c NormalizedPicture
pic -> case NormalizedPicture
q of
    Color AbsColor
c2 NormalizedPicture
innerP -> AbsColor
c AbsColor -> AbsColor -> Bool
forall a. Eq a => a -> a -> Bool
== AbsColor
c2 Bool -> Bool -> Bool
&& NormalizedPicture
pic NormalizedPicture -> NormalizedPicture -> Bool
`contains` NormalizedPicture
innerP
    NormalizedPicture
_               -> NormalizedPicture
pic NormalizedPicture -> NormalizedPicture -> Bool
`contains` NormalizedPicture
q
  NormalizedPicture
_ -> Bool
False


{- |
Returns how often a subpicture appears in the image.
-}
count :: NormalizedPicture -> NormalizedPicture -> Int
count :: NormalizedPicture -> NormalizedPicture -> Int
count NormalizedPicture
thing NormalizedPicture
inside = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (NormalizedPicture -> Int) -> [NormalizedPicture] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map NormalizedPicture -> Int
singleCount ([NormalizedPicture] -> [Int]) -> [NormalizedPicture] -> [Int]
forall a b. (a -> b) -> a -> b
$ NormalizedPicture -> [NormalizedPicture]
getSubPictures NormalizedPicture
thing
  where
    singleCount :: NormalizedPicture -> Int
singleCount NormalizedPicture
p = [NormalizedPicture] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([NormalizedPicture] -> Int) -> [NormalizedPicture] -> Int
forall a b. (a -> b) -> a -> b
$ (NormalizedPicture -> Bool)
-> [NormalizedPicture] -> [NormalizedPicture]
forall a. (a -> Bool) -> [a] -> [a]
filter (NormalizedPicture -> NormalizedPicture -> Bool
`contains` NormalizedPicture
p) ([NormalizedPicture] -> [NormalizedPicture])
-> [NormalizedPicture] -> [NormalizedPicture]
forall a b. (a -> b) -> a -> b
$ NormalizedPicture -> [NormalizedPicture]
getSubPictures NormalizedPicture
inside


stripTranslation :: NormalizedPicture -> NormalizedPicture
stripTranslation :: NormalizedPicture -> NormalizedPicture
stripTranslation (Translate Position
_ Position
_ NormalizedPicture
p) = NormalizedPicture
p
stripTranslation (Color AbsColor
c NormalizedPicture
p) = AbsColor -> NormalizedPicture -> NormalizedPicture
Color AbsColor
c (NormalizedPicture -> NormalizedPicture)
-> NormalizedPicture -> NormalizedPicture
forall a b. (a -> b) -> a -> b
$ NormalizedPicture -> NormalizedPicture
stripTranslation NormalizedPicture
p
stripTranslation NormalizedPicture
p                 = NormalizedPicture
p


{-|
Returns the abstract translation of the image.
Neutral translation if none.
-}
getTranslation :: NormalizedPicture -> (Position, Position)
getTranslation :: NormalizedPicture -> (Position, Position)
getTranslation (Translate Position
x Position
y NormalizedPicture
_)   = (Position
x,Position
y)
getTranslation (Color AbsColor
_ NormalizedPicture
p)         = NormalizedPicture -> (Position, Position)
getTranslation NormalizedPicture
p
getTranslation NormalizedPicture
p                   = case NormalizedPicture
p of
  (Polyline ShapeKind
_ [AbsPoint]
points) -> [AbsPoint] -> (Position, Position)
absPointsToAbsTranslation [AbsPoint]
points
  (Curve ShapeKind
_ [AbsPoint]
points) -> [AbsPoint] -> (Position, Position)
absPointsToAbsTranslation ([AbsPoint] -> (Position, Position))
-> [AbsPoint] -> (Position, Position)
forall a b. (a -> b) -> a -> b
$ Int -> [AbsPoint] -> [AbsPoint]
forall a. Int -> [a] -> [a]
drop Int
1 [AbsPoint]
points
  NormalizedPicture
_ -> (Position
0,Position
0)
  where
    absPointsToAbsTranslation :: [AbsPoint] -> (Position, Position)
absPointsToAbsTranslation =
      (Double -> Position) -> Point -> (Position, Position)
forall a b. (a -> b) -> (a, a) -> (b, b)
both Double -> Position
toPosition (Point -> (Position, Position))
-> ([AbsPoint] -> Point) -> [AbsPoint] -> (Position, Position)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Point], Point) -> Point
forall a b. (a, b) -> b
snd (([Point], Point) -> Point)
-> ([AbsPoint] -> ([Point], Point)) -> [AbsPoint] -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point] -> ([Point], Point)
atOriginWithOffset ([Point] -> ([Point], Point))
-> ([AbsPoint] -> [Point]) -> [AbsPoint] -> ([Point], Point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbsPoint -> Point) -> [AbsPoint] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map AbsPoint -> Point
fromAbsPoint


{-|
Returns the actual translation of the image.
(0,0) if none.
-}
getExactTranslation :: NormalizedPicture -> (Double, Double)
getExactTranslation :: NormalizedPicture -> Point
getExactTranslation = (Position -> Double) -> (Position, Position) -> Point
forall a b. (a -> b) -> (a, a) -> (b, b)
both Position -> Double
fromPosition ((Position, Position) -> Point)
-> (NormalizedPicture -> (Position, Position))
-> NormalizedPicture
-> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedPicture -> (Position, Position)
getTranslation


couldHaveTranslation :: NormalizedPicture -> Bool
couldHaveTranslation :: NormalizedPicture -> Bool
couldHaveTranslation Translate {} = Bool
True
couldHaveTranslation Polyline {}  = Bool
True
couldHaveTranslation Curve {}     = Bool
True
couldHaveTranslation (Color AbsColor
_ (Translate {})) = Bool
True
couldHaveTranslation NormalizedPicture
_            = Bool
False


{-|
Returns the `AbsColor` of the image.
Nothing if it is one of logo or coordinate plane.
Black if none.
-}
getColor :: NormalizedPicture -> Maybe AbsColor
getColor :: NormalizedPicture -> Maybe AbsColor
getColor (Color AbsColor
c NormalizedPicture
_) = AbsColor -> Maybe AbsColor
forall a. a -> Maybe a
Just AbsColor
c
getColor NormalizedPicture
Blank       = Maybe AbsColor
forall a. Maybe a
Nothing
getColor NormalizedPicture
Logo        = Maybe AbsColor
forall a. Maybe a
Nothing
getColor NormalizedPicture
_           = AbsColor -> Maybe AbsColor
forall a. a -> Maybe a
Just (AbsColor -> Maybe AbsColor) -> AbsColor -> Maybe AbsColor
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> AbsColor
Tone Double
0 Double
0 Double
0


{-|
Returns the abstract scaling factors of the image.
Neutral factors if none.
-}
getScalingFactors :: NormalizedPicture -> (Factor,Factor)
getScalingFactors :: NormalizedPicture -> (Factor, Factor)
getScalingFactors NormalizedPicture
p = (Factor, Factor) -> [(Factor, Factor)] -> (Factor, Factor)
forall a. a -> [a] -> a
headDef (Factor
Same,Factor
Same) [(Factor
f1,Factor
f2) | NormalizedPicture -> Bool
isBasic NormalizedPicture
p, Scale Factor
f1 Factor
f2 NormalizedPicture
_ <- NormalizedPicture -> [NormalizedPicture]
forall on. Uniplate on => on -> [on]
universe NormalizedPicture
p]


{-|
Returns actual scaling factors of the image.
(1,1) if none.
-}
getExactScalingFactors :: NormalizedPicture -> (Double,Double)
getExactScalingFactors :: NormalizedPicture -> Point
getExactScalingFactors = (Factor -> Double) -> (Factor, Factor) -> Point
forall a b. (a -> b) -> (a, a) -> (b, b)
both Factor -> Double
fromFactor ((Factor, Factor) -> Point)
-> (NormalizedPicture -> (Factor, Factor))
-> NormalizedPicture
-> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedPicture -> (Factor, Factor)
getScalingFactors


{-|
Returns abstract rotation of the image if it has any.
-}
getRotation :: NormalizedPicture -> Maybe Angle
getRotation :: NormalizedPicture -> Maybe Angle
getRotation NormalizedPicture
p = [Angle] -> Maybe Angle
forall a. [a] -> Maybe a
listToMaybe [Angle
a | NormalizedPicture -> Bool
isBasic NormalizedPicture
p, Rotate Angle
a NormalizedPicture
_ <- NormalizedPicture -> [NormalizedPicture]
forall on. Uniplate on => on -> [on]
universe NormalizedPicture
p]


{-|
Returns actual rotation of the image if it has any.
-}
getExactRotation :: NormalizedPicture -> Double
getExactRotation :: NormalizedPicture -> Double
getExactRotation = Double -> (Angle -> Double) -> Maybe Angle -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 Angle -> Double
fromAngle (Maybe Angle -> Double)
-> (NormalizedPicture -> Maybe Angle)
-> NormalizedPicture
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedPicture -> Maybe Angle
getRotation


{-|
Returns abstract reflection of the image if it has any.
-}
getReflectionAngle :: NormalizedPicture -> Maybe Angle
getReflectionAngle :: NormalizedPicture -> Maybe Angle
getReflectionAngle NormalizedPicture
p = [Angle] -> Maybe Angle
forall a. [a] -> Maybe a
listToMaybe [Angle
a | NormalizedPicture -> Bool
isBasic NormalizedPicture
p, Reflect Angle
a NormalizedPicture
_ <- NormalizedPicture -> [NormalizedPicture]
forall on. Uniplate on => on -> [on]
universe NormalizedPicture
p]


{-|
Returns actual reflection of the image if it has any.
-}
getExactReflectionAngle :: NormalizedPicture -> Double
getExactReflectionAngle :: NormalizedPicture -> Double
getExactReflectionAngle = Double -> (Angle -> Double) -> Maybe Angle -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 Angle -> Double
fromAngle (Maybe Angle -> Double)
-> (NormalizedPicture -> Maybe Angle)
-> NormalizedPicture
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedPicture -> Maybe Angle
getReflectionAngle


{-|
Returns abstract radius of the image if it actually a circle or circle segment.
-}
getCircleRadius :: NormalizedPicture -> Maybe Size
getCircleRadius :: NormalizedPicture -> Maybe Size
getCircleRadius NormalizedPicture
p
  | NormalizedPicture -> Bool
isBasic NormalizedPicture
p = let elements :: [NormalizedPicture]
elements = NormalizedPicture -> [NormalizedPicture]
forall on. Uniplate on => on -> [on]
universe NormalizedPicture
p
    in [Size] -> Maybe Size
forall a. [a] -> Maybe a
listToMaybe ([Size] -> Maybe Size) -> [Size] -> Maybe Size
forall a b. (a -> b) -> a -> b
$
      [Size
s | Circle ShapeKind
_ Size
s  <- [NormalizedPicture]
elements] [Size] -> [Size] -> [Size]
forall a. [a] -> [a] -> [a]
++
      [Size
s | Arc ShapeKind
_ Angle
_ Angle
_ Size
s <- [NormalizedPicture]
elements]
  | Bool
otherwise = Maybe Size
forall a. Maybe a
Nothing


{-|
Returns actual radius of the image if it actually a circle or circle segment.
-}
getExactCircleRadius :: NormalizedPicture -> Maybe Double
getExactCircleRadius :: NormalizedPicture -> Maybe Double
getExactCircleRadius = (Size -> Double) -> Maybe Size -> Maybe Double
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Size -> Double
fromSize (Maybe Size -> Maybe Double)
-> (NormalizedPicture -> Maybe Size)
-> NormalizedPicture
-> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedPicture -> Maybe Size
getCircleRadius


{-|
Returns abstract side lengths of the image if it actually a rectangle.
-}
getRectangleLengths :: NormalizedPicture -> Maybe (Size,Size)
getRectangleLengths :: NormalizedPicture -> Maybe (Size, Size)
getRectangleLengths NormalizedPicture
p = [(Size, Size)] -> Maybe (Size, Size)
forall a. [a] -> Maybe a
listToMaybe [(Size
sx,Size
sy) | NormalizedPicture -> Bool
isBasic NormalizedPicture
p, Rectangle ShapeKind
_ Size
sx Size
sy <- NormalizedPicture -> [NormalizedPicture]
forall on. Uniplate on => on -> [on]
universe NormalizedPicture
p]


{-|
Returns actual side lengths of the image if it actually a rectangle.
-}
getExactRectangleLengths :: NormalizedPicture -> Maybe (Double,Double)
getExactRectangleLengths :: NormalizedPicture -> Maybe Point
getExactRectangleLengths = ((Size, Size) -> Point) -> Maybe (Size, Size) -> Maybe Point
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Size -> Double) -> (Size, Size) -> Point
forall a b. (a -> b) -> (a, a) -> (b, b)
both Size -> Double
fromSize) (Maybe (Size, Size) -> Maybe Point)
-> (NormalizedPicture -> Maybe (Size, Size))
-> NormalizedPicture
-> Maybe Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedPicture -> Maybe (Size, Size)
getRectangleLengths


{-|
Returns actual list of points in the image if it is a \"free shape\",
[] otherwise.
-}
getExactPointList :: NormalizedPicture -> [Point]
getExactPointList :: NormalizedPicture -> [Point]
getExactPointList (Curve ShapeKind
_ [AbsPoint]
ps) = (AbsPoint -> Point) -> [AbsPoint] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map AbsPoint -> Point
fromAbsPoint [AbsPoint]
ps
getExactPointList (Polyline ShapeKind
_ [AbsPoint]
ps) = (AbsPoint -> Point) -> [AbsPoint] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map AbsPoint -> Point
fromAbsPoint [AbsPoint]
ps
getExactPointList NormalizedPicture
_               = []


-- To access translation before it is abstracted away
getSubPictures :: NormalizedPicture -> [NormalizedPicture]
getSubPictures :: NormalizedPicture -> [NormalizedPicture]
getSubPictures (Pictures [NormalizedPicture]
xs) = [NormalizedPicture]
xs
getSubPictures NormalizedPicture
p = [NormalizedPicture
p]



isBasic :: NormalizedPicture -> Bool
isBasic :: NormalizedPicture -> Bool
isBasic (Pictures {}) = Bool
False
isBasic (Clip {}) = Bool
False
isBasic NormalizedPicture
_ = Bool
True


{- |
Transform a `NormalizedPicture` into a t`CodeWorld.Test.Picture`.
Used to compare normalized sample solution to student submission in plain form.
This only makes sense if there's exactly one way to solve the given task.
-}
toConcretePicture :: NormalizedPicture -> P.Picture
toConcretePicture :: NormalizedPicture -> Picture
toConcretePicture NormalizedPicture
p = ReifyPicture Picture -> Picture
P.PRec (ReifyPicture Picture -> Picture)
-> ReifyPicture Picture -> Picture
forall a b. (a -> b) -> a -> b
$ case NormalizedPicture
p of
  Rectangle ShapeKind
sk Size
sx Size
sy -> (case ShapeKind
sk of
    Hollow Thickness
Normal -> Double -> Double -> ReifyPicture Picture
forall a. Double -> Double -> ReifyPicture a
P.Rectangle
    Hollow Thickness
Thick  -> Double -> Double -> Double -> ReifyPicture Picture
forall a. Double -> Double -> Double -> ReifyPicture a
P.ThickRectangle Double
1
    ShapeKind
_             -> Double -> Double -> ReifyPicture Picture
forall a. Double -> Double -> ReifyPicture a
P.SolidRectangle) (Size -> Double
fromSize Size
sx) (Size -> Double
fromSize Size
sy)
  Circle ShapeKind
sk Size
s -> (case ShapeKind
sk of
    Hollow Thickness
Normal -> Double -> ReifyPicture Picture
forall a. Double -> ReifyPicture a
P.Circle
    Hollow Thickness
Thick  -> Double -> Double -> ReifyPicture Picture
forall a. Double -> Double -> ReifyPicture a
P.ThickCircle Double
1
    ShapeKind
_             -> Double -> ReifyPicture Picture
forall a. Double -> ReifyPicture a
P.SolidCircle) (Size -> Double
fromSize Size
s)
  Lettering Text
t -> Text -> ReifyPicture Picture
forall a. Text -> ReifyPicture a
P.Lettering Text
t
  Color AbsColor
c NormalizedPicture
q -> Color -> Picture -> ReifyPicture Picture
forall a. Color -> a -> ReifyPicture a
P.Color (AbsColor -> Color
fromAbsColor AbsColor
c) (Picture -> ReifyPicture Picture)
-> Picture -> ReifyPicture Picture
forall a b. (a -> b) -> a -> b
$ NormalizedPicture -> Picture
toConcretePicture NormalizedPicture
q
  Translate Position
x Position
y NormalizedPicture
q -> Double -> Double -> Picture -> ReifyPicture Picture
forall a. Double -> Double -> a -> ReifyPicture a
P.Translate (Position -> Double
fromPosition Position
x) (Position -> Double
fromPosition Position
y) (Picture -> ReifyPicture Picture)
-> Picture -> ReifyPicture Picture
forall a b. (a -> b) -> a -> b
$ NormalizedPicture -> Picture
toConcretePicture NormalizedPicture
q
  Scale Factor
f1 Factor
f2 NormalizedPicture
q -> Double -> Double -> Picture -> ReifyPicture Picture
forall a. Double -> Double -> a -> ReifyPicture a
P.Scale (Factor -> Double
fromFactor Factor
f1) (Factor -> Double
fromFactor Factor
f2) (Picture -> ReifyPicture Picture)
-> Picture -> ReifyPicture Picture
forall a b. (a -> b) -> a -> b
$ NormalizedPicture -> Picture
toConcretePicture NormalizedPicture
q
  Rotate Angle
a NormalizedPicture
q -> Double -> Picture -> ReifyPicture Picture
forall a. Double -> a -> ReifyPicture a
P.Rotate (Angle -> Double
fromAngle Angle
a) (Picture -> ReifyPicture Picture)
-> Picture -> ReifyPicture Picture
forall a b. (a -> b) -> a -> b
$ NormalizedPicture -> Picture
toConcretePicture NormalizedPicture
q
  Pictures [NormalizedPicture]
qs -> [Picture] -> ReifyPicture Picture
forall a. [a] -> ReifyPicture a
P.Pictures ([Picture] -> ReifyPicture Picture)
-> [Picture] -> ReifyPicture Picture
forall a b. (a -> b) -> a -> b
$ (NormalizedPicture -> Picture) -> [NormalizedPicture] -> [Picture]
forall a b. (a -> b) -> [a] -> [b]
map NormalizedPicture -> Picture
toConcretePicture [NormalizedPicture]
qs
  NormalizedPicture
CoordinatePlane -> ReifyPicture Picture
forall a. ReifyPicture a
P.CoordinatePlane
  NormalizedPicture
Logo -> ReifyPicture Picture
forall a. ReifyPicture a
P.Logo
  NormalizedPicture
Blank -> ReifyPicture Picture
forall a. ReifyPicture a
P.Blank
  Polyline ShapeKind
sk [AbsPoint]
ps -> case ShapeKind
sk of
    Hollow Thickness
Normal -> [Point] -> ReifyPicture Picture
forall a. [Point] -> ReifyPicture a
P.Polyline ([Point] -> ReifyPicture Picture)
-> [Point] -> ReifyPicture Picture
forall a b. (a -> b) -> a -> b
$ (AbsPoint -> Point) -> [AbsPoint] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map AbsPoint -> Point
fromAbsPoint [AbsPoint]
ps
    Hollow Thickness
Thick  -> Double -> [Point] -> ReifyPicture Picture
forall a. Double -> [Point] -> ReifyPicture a
P.ThickPolyline Double
1 ([Point] -> ReifyPicture Picture)
-> [Point] -> ReifyPicture Picture
forall a b. (a -> b) -> a -> b
$ (AbsPoint -> Point) -> [AbsPoint] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map AbsPoint -> Point
fromAbsPoint [AbsPoint]
ps
    ShapeKind
_             -> [Point] -> ReifyPicture Picture
forall a. [Point] -> ReifyPicture a
P.SolidPolygon ([Point] -> ReifyPicture Picture)
-> [Point] -> ReifyPicture Picture
forall a b. (a -> b) -> a -> b
$ [Point] -> [Point]
forall a. HasCallStack => [a] -> [a]
init ([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ (AbsPoint -> Point) -> [AbsPoint] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map AbsPoint -> Point
fromAbsPoint [AbsPoint]
ps
  Curve ShapeKind
sk [AbsPoint]
ps -> case ShapeKind
sk of
    Hollow Thickness
Normal -> [Point] -> ReifyPicture Picture
forall a. [Point] -> ReifyPicture a
P.Curve ([Point] -> ReifyPicture Picture)
-> [Point] -> ReifyPicture Picture
forall a b. (a -> b) -> a -> b
$ (AbsPoint -> Point) -> [AbsPoint] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map AbsPoint -> Point
fromAbsPoint [AbsPoint]
ps
    Hollow Thickness
Thick  -> Double -> [Point] -> ReifyPicture Picture
forall a. Double -> [Point] -> ReifyPicture a
P.ThickCurve Double
1 ([Point] -> ReifyPicture Picture)
-> [Point] -> ReifyPicture Picture
forall a b. (a -> b) -> a -> b
$ (AbsPoint -> Point) -> [AbsPoint] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map AbsPoint -> Point
fromAbsPoint [AbsPoint]
ps
    ShapeKind
_             -> [Point] -> ReifyPicture Picture
forall a. [Point] -> ReifyPicture a
P.SolidClosedCurve ([Point] -> ReifyPicture Picture)
-> [Point] -> ReifyPicture Picture
forall a b. (a -> b) -> a -> b
$ [Point] -> [Point]
forall a. HasCallStack => [a] -> [a]
init ([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ (AbsPoint -> Point) -> [AbsPoint] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map AbsPoint -> Point
fromAbsPoint [AbsPoint]
ps
  Arc ShapeKind
sk Angle
a1 Angle
a2 Size
s -> (case ShapeKind
sk of
    Hollow Thickness
Normal -> Double -> Double -> Double -> ReifyPicture Picture
forall a. Double -> Double -> Double -> ReifyPicture a
P.Arc
    Hollow Thickness
Thick  -> Double -> Double -> Double -> Double -> ReifyPicture Picture
forall a. Double -> Double -> Double -> Double -> ReifyPicture a
P.ThickArc Double
1
    ShapeKind
_             -> Double -> Double -> Double -> ReifyPicture Picture
forall a. Double -> Double -> Double -> ReifyPicture a
P.Sector) (Angle -> Double
fromAngle Angle
a1) (Angle -> Double
fromAngle Angle
a2) (Size -> Double
fromSize Size
s)
  Reflect Angle
a NormalizedPicture
q -> Double -> Picture -> ReifyPicture Picture
forall a. Double -> a -> ReifyPicture a
P.Reflect (Angle -> Double
fromAngle Angle
a) (Picture -> ReifyPicture Picture)
-> Picture -> ReifyPicture Picture
forall a b. (a -> b) -> a -> b
$ NormalizedPicture -> Picture
toConcretePicture NormalizedPicture
q
  Clip Size
sx Size
sy NormalizedPicture
q -> Double -> Double -> Picture -> ReifyPicture Picture
forall a. Double -> Double -> a -> ReifyPicture a
P.Clip (Size -> Double
fromSize Size
sx) (Size -> Double
fromSize Size
sy) (Picture -> ReifyPicture Picture)
-> Picture -> ReifyPicture Picture
forall a b. (a -> b) -> a -> b
$ NormalizedPicture -> Picture
toConcretePicture NormalizedPicture
q


validThickness :: Double -> Double
validThickness :: Double -> Double
validThickness Double
t
  | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0     = [Char] -> Double
forall a. HasCallStack => [Char] -> a
error ([Char] -> Double) -> [Char] -> Double
forall a b. (a -> b) -> a -> b
$
      [Char]
"The line width must be non-negative. " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
      [Char]
"(This error was thrown inside the test suite)"
  | Bool
otherwise = Double
t