{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Diagrams.SVG.Path
(
commandsToPaths
, splittedCommands
, outline
, nextSegment
, svgArc
, myDouble
, PathCommand(..)
, parsePathCommand
, commands
)
where
import Data.Attoparsec.Combinator
import Data.Attoparsec.Text
import qualified Data.Attoparsec.Text as AT
import Data.Char (digitToInt, isAlpha, isHexDigit)
import Data.Colour.Names (readColourName)
import Data.Colour.SRGB
import Data.Digits (digits)
import Data.List (foldl')
import qualified Data.List.Split as S
import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust, isNothing, maybeToList)
import Data.Text (Text (..), empty, pack, unpack)
import qualified Data.Text as T
import Diagrams.Attributes
import Diagrams.Path
import Diagrams.Prelude
import Diagrams.Segment
import Diagrams.TwoD.Types
data AbsRel = Abs | Rel deriving Int -> AbsRel -> ShowS
[AbsRel] -> ShowS
AbsRel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AbsRel] -> ShowS
$cshowList :: [AbsRel] -> ShowS
show :: AbsRel -> String
$cshow :: AbsRel -> String
showsPrec :: Int -> AbsRel -> ShowS
$cshowsPrec :: Int -> AbsRel -> ShowS
Show
data PathCommand n =
M AbsRel !(n,n) |
Z |
L AbsRel !(n,n) |
H AbsRel !n |
V AbsRel !n |
C AbsRel !(n,n,n,n,n,n) |
S AbsRel !(n,n,n,n) |
Q AbsRel !(n,n,n,n) |
T AbsRel !(n,n) |
A AbsRel !(n,n,n,n,n,n,n)
deriving Int -> PathCommand n -> ShowS
forall n. Show n => Int -> PathCommand n -> ShowS
forall n. Show n => [PathCommand n] -> ShowS
forall n. Show n => PathCommand n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathCommand n] -> ShowS
$cshowList :: forall n. Show n => [PathCommand n] -> ShowS
show :: PathCommand n -> String
$cshow :: forall n. Show n => PathCommand n -> String
showsPrec :: Int -> PathCommand n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> PathCommand n -> ShowS
Show
parsePathCommand :: Parser Text (Maybe [PathCommand n])
parsePathCommand = do { Parser ()
AT.skipSpace;
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_m, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_M, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_l, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_L, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_h, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_H,
forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_v, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_V, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_c, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_C, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_S, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_s,
forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_q, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_Q, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_t, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_T, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_a, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_A, forall {n}. Parser Text (Maybe [PathCommand n])
parse_z]
}
parse_m :: Parser Text (Maybe [PathCommand n])
parse_m = do { Text -> Parser Text
AT.string Text
"m"; [(n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b}. (Fractional a, Fractional b) => Parser Text (a, b)
tuple2; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (forall n. AbsRel -> (n, n) -> PathCommand n
M AbsRel
Rel forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(n, n)]
t)forall a. a -> [a] -> [a]
: (forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n) -> PathCommand n
L AbsRel
Rel) (forall a. [a] -> [a]
tail [(n, n)]
t)) ) }
parse_M :: Parser Text (Maybe [PathCommand n])
parse_M = do { Text -> Parser Text
AT.string Text
"M"; [(n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b}. (Fractional a, Fractional b) => Parser Text (a, b)
tuple2; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n) -> PathCommand n
M AbsRel
Abs) [(n, n)]
t) }
parse_z :: Parser Text (Maybe [PathCommand n])
parse_z = do { forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Text -> Parser Text
AT.string Text
"z", Text -> Parser Text
AT.string Text
"Z"]; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just [forall n. PathCommand n
Z]) }
parse_l :: Parser Text (Maybe [PathCommand n])
parse_l = do { Text -> Parser Text
AT.string Text
"l"; [(n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b}. (Fractional a, Fractional b) => Parser Text (a, b)
tuple2; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n) -> PathCommand n
L AbsRel
Rel) [(n, n)]
t) }
parse_L :: Parser Text (Maybe [PathCommand n])
parse_L = do { Text -> Parser Text
AT.string Text
"L"; [(n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b}. (Fractional a, Fractional b) => Parser Text (a, b)
tuple2; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n) -> PathCommand n
L AbsRel
Abs) [(n, n)]
t) }
parse_h :: Parser Text (Maybe [PathCommand a])
parse_h = do { Text -> Parser Text
AT.string Text
"h"; [a]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {b}. Fractional b => Parser Text b
spaceDouble; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> n -> PathCommand n
H AbsRel
Rel) [a]
t) }
parse_H :: Parser Text (Maybe [PathCommand a])
parse_H = do { Text -> Parser Text
AT.string Text
"H"; [a]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {b}. Fractional b => Parser Text b
spaceDouble; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> n -> PathCommand n
H AbsRel
Abs) [a]
t) }
parse_v :: Parser Text (Maybe [PathCommand a])
parse_v = do { Text -> Parser Text
AT.string Text
"v"; [a]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {b}. Fractional b => Parser Text b
spaceDouble; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> n -> PathCommand n
V AbsRel
Rel) [a]
t) }
parse_V :: Parser Text (Maybe [PathCommand a])
parse_V = do { Text -> Parser Text
AT.string Text
"V"; [a]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {b}. Fractional b => Parser Text b
spaceDouble; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> n -> PathCommand n
V AbsRel
Abs) [a]
t) }
parse_c :: Parser Text (Maybe [PathCommand n])
parse_c = do { Text -> Parser Text
AT.string Text
"c"; [(n, n, n, n, n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b} {c} {d} {e} {f}.
(Fractional a, Fractional b, Fractional c, Fractional d,
Fractional e, Fractional f) =>
Parser Text (a, b, c, d, e, f)
tuple6; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n, n, n, n, n) -> PathCommand n
C AbsRel
Rel) [(n, n, n, n, n, n)]
t) }
parse_C :: Parser Text (Maybe [PathCommand n])
parse_C = do { Text -> Parser Text
AT.string Text
"C"; [(n, n, n, n, n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b} {c} {d} {e} {f}.
(Fractional a, Fractional b, Fractional c, Fractional d,
Fractional e, Fractional f) =>
Parser Text (a, b, c, d, e, f)
tuple6; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n, n, n, n, n) -> PathCommand n
C AbsRel
Abs) [(n, n, n, n, n, n)]
t) }
parse_s :: Parser Text (Maybe [PathCommand n])
parse_s = do { Text -> Parser Text
AT.string Text
"s"; [(n, n, n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b} {c} {d}.
(Fractional a, Fractional b, Fractional c, Fractional d) =>
Parser Text (a, b, c, d)
tuple4; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n, n, n) -> PathCommand n
S AbsRel
Rel) [(n, n, n, n)]
t) }
parse_S :: Parser Text (Maybe [PathCommand n])
parse_S = do { Text -> Parser Text
AT.string Text
"S"; [(n, n, n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b} {c} {d}.
(Fractional a, Fractional b, Fractional c, Fractional d) =>
Parser Text (a, b, c, d)
tuple4; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n, n, n) -> PathCommand n
S AbsRel
Abs) [(n, n, n, n)]
t) }
parse_q :: Parser Text (Maybe [PathCommand n])
parse_q = do { Text -> Parser Text
AT.string Text
"q"; [(n, n, n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b} {c} {d}.
(Fractional a, Fractional b, Fractional c, Fractional d) =>
Parser Text (a, b, c, d)
tuple4; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n, n, n) -> PathCommand n
Q AbsRel
Rel) [(n, n, n, n)]
t) }
parse_Q :: Parser Text (Maybe [PathCommand n])
parse_Q = do { Text -> Parser Text
AT.string Text
"Q"; [(n, n, n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b} {c} {d}.
(Fractional a, Fractional b, Fractional c, Fractional d) =>
Parser Text (a, b, c, d)
tuple4; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n, n, n) -> PathCommand n
Q AbsRel
Abs) [(n, n, n, n)]
t) }
parse_t :: Parser Text (Maybe [PathCommand n])
parse_t = do { Text -> Parser Text
AT.string Text
"t"; [(n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b}. (Fractional a, Fractional b) => Parser Text (a, b)
tuple2; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n) -> PathCommand n
T AbsRel
Rel) [(n, n)]
t) }
parse_T :: Parser Text (Maybe [PathCommand n])
parse_T = do { Text -> Parser Text
AT.string Text
"T"; [(n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b}. (Fractional a, Fractional b) => Parser Text (a, b)
tuple2; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n) -> PathCommand n
T AbsRel
Abs) [(n, n)]
t) }
parse_a :: Parser Text (Maybe [PathCommand n])
parse_a = do { Text -> Parser Text
AT.string Text
"a"; [(n, n, n, n, n, n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b} {c} {f} {g} {d} {e}.
(Fractional a, Fractional b, Fractional c, Fractional f,
Fractional g, Num d, Num e) =>
Parser Text (a, b, c, d, e, f, g)
tuple7; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n, n, n, n, n, n) -> PathCommand n
A AbsRel
Rel) [(n, n, n, n, n, n, n)]
t) }
parse_A :: Parser Text (Maybe [PathCommand n])
parse_A = do { Text -> Parser Text
AT.string Text
"A"; [(n, n, n, n, n, n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b} {c} {f} {g} {d} {e}.
(Fractional a, Fractional b, Fractional c, Fractional f,
Fractional g, Num d, Num e) =>
Parser Text (a, b, c, d, e, f, g)
tuple7; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n, n, n, n, n, n) -> PathCommand n
A AbsRel
Abs) [(n, n, n, n, n, n, n)]
t) }
withOptional :: Parser Text a -> Char -> Parser Text a
withOptional Parser Text a
parser Char
a = do { Parser ()
AT.skipSpace;
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [ do { Char -> Parser Char
AT.char Char
a; a
b <- Parser Text a
parser; forall (m :: * -> *) a. Monad m => a -> m a
return a
b},
do { a
b <- Parser Text a
parser; forall (m :: * -> *) a. Monad m => a -> m a
return a
b} ] }
myDouble :: Parser Text Double
myDouble = forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [forall {b}. Fractional b => Parser Text b
dotDouble, Parser Text Double
double]
dotDouble :: Parser Text b
dotDouble =
do Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
'.'
Integer
frac <- forall a. Integral a => Parser a
AT.decimal
let denominator :: b
denominator = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
10forall a b. (Num a, Integral b) => a -> b -> a
^(forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall n. Integral n => n -> n -> [n]
digits Integer
10 Integer
frac))
forall (m :: * -> *) a. Monad m => a -> m a
return ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
frac) forall a. Fractional a => a -> a -> a
/ forall {b}. Num b => b
denominator)
doubleWithOptional :: Char -> Parser Text b
doubleWithOptional Char
a = do { Double
d <- Parser Text Double
myDouble forall {a}. Parser Text a -> Char -> Parser Text a
`withOptional` Char
a ; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ forall a. Real a => a -> Rational
toRational Double
d) }
spaceDouble :: Parser Text b
spaceDouble = do { Parser ()
AT.skipSpace; Double
d <- Parser Text Double
myDouble; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ forall a. Real a => a -> Rational
toRational Double
d) }
tuple2 :: Parser Text (a, b)
tuple2 = do { a
a <- forall {b}. Fractional b => Parser Text b
spaceDouble; b
b <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
','; forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b) }
tuple4 :: Parser Text (a, b, c, d)
tuple4 = do { a
a <- forall {b}. Fractional b => Parser Text b
spaceDouble;
b
b <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
c
c <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
d
d <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b, c
c, d
d) }
tuple6 :: Parser Text (a, b, c, d, e, f)
tuple6 = do { a
a <- forall {b}. Fractional b => Parser Text b
spaceDouble;
b
b <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
c
c <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
d
d <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
e
e <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
f
f <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
','; forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b, c
c, d
d, e
e, f
f) }
tuple7 :: Parser Text (a, b, c, d, e, f, g)
tuple7 = do { a
a <- forall {b}. Fractional b => Parser Text b
spaceDouble;
b
b <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
c
c <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
Integer
d <- forall a. Integral a => Parser a
decimal forall {a}. Parser Text a -> Char -> Parser Text a
`withOptional` Char
',';
Integer
e <- forall a. Integral a => Parser a
decimal forall {a}. Parser Text a -> Char -> Parser Text a
`withOptional` Char
',';
f
f <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
g
g <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
(a
a, b
b, c
c, forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d, forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
e, f
f, g
g) }
commands :: (RealFloat n, Show n) => Maybe Text -> [PathCommand n]
commands :: forall n. (RealFloat n, Show n) => Maybe Text -> [PathCommand n]
commands = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const []) forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(forall a. Parser a -> Text -> Either String a
AT.parseOnly (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parsePathCommand)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(forall a. a -> Maybe a -> a
fromMaybe Text
T.empty)
commandsToPaths :: (RealFloat n, Show n) => [PathCommand n] -> [Path V2 n]
commandsToPaths :: forall n. (RealFloat n, Show n) => [PathCommand n] -> [Path V2 n]
commandsToPaths [PathCommand n]
pathCommands = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall n.
(RealFloat n, Show n) =>
[(Path V2 n, (n, n))] -> [PathCommand n] -> [(Path V2 n, (n, n))]
outline [] (forall {n}. RealFloat n => [PathCommand n] -> [[PathCommand n]]
splittedCommands [PathCommand n]
pathCommands)
splittedCommands :: [PathCommand n] -> [[PathCommand n]]
splittedCommands [PathCommand n]
pathCommands = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Splitter a -> [a] -> [[a]]
S.split (forall a. Splitter a -> Splitter a
S.keepDelimsR (forall a. (a -> Bool) -> Splitter a
S.whenElt forall {n}. PathCommand n -> Bool
isZ))) forall a b. (a -> b) -> a -> b
$
forall n. RealFloat n => [[PathCommand n]] -> [[PathCommand n]]
mergeMs forall a b. (a -> b) -> a -> b
$
forall a. Splitter a -> [a] -> [[a]]
S.split (forall a. Splitter a -> Splitter a
S.keepDelimsL (forall a. (a -> Bool) -> Splitter a
S.whenElt forall {n}. PathCommand n -> Bool
isM))
[PathCommand n]
pathCommands
where
isM :: PathCommand n -> Bool
isM (M AbsRel
ar (n, n)
p) = Bool
True
isM PathCommand n
_ = Bool
False
isZ :: PathCommand n -> Bool
isZ PathCommand n
Z = Bool
True
isZ PathCommand n
_ = Bool
False
mergeMs :: RealFloat n => [[PathCommand n]] -> [[PathCommand n]]
mergeMs :: forall n. RealFloat n => [[PathCommand n]] -> [[PathCommand n]]
mergeMs ( [M AbsRel
Rel (n
x,n
y)] : ( ((M AbsRel
Rel (n
x0,n
y0)):[PathCommand n]
cs):[[PathCommand n]]
ds ) ) = forall n. RealFloat n => [[PathCommand n]] -> [[PathCommand n]]
mergeMs (((forall n. AbsRel -> (n, n) -> PathCommand n
M AbsRel
Rel (n
xforall a. Num a => a -> a -> a
+n
x0,n
yforall a. Num a => a -> a -> a
+n
y0))forall a. a -> [a] -> [a]
:[PathCommand n]
cs)forall a. a -> [a] -> [a]
:[[PathCommand n]]
ds)
mergeMs ( [M AbsRel
Rel (n
x,n
y)] : ( ((M AbsRel
Abs (n
x0,n
y0)):[PathCommand n]
cs):[[PathCommand n]]
ds ) ) = forall n. RealFloat n => [[PathCommand n]] -> [[PathCommand n]]
mergeMs (((forall n. AbsRel -> (n, n) -> PathCommand n
M AbsRel
Abs (n
x0, n
y0))forall a. a -> [a] -> [a]
:[PathCommand n]
cs)forall a. a -> [a] -> [a]
:[[PathCommand n]]
ds)
mergeMs ( [M AbsRel
Abs (n
x,n
y)] : ( ((M AbsRel
Rel (n
x0,n
y0)):[PathCommand n]
cs):[[PathCommand n]]
ds ) ) = forall n. RealFloat n => [[PathCommand n]] -> [[PathCommand n]]
mergeMs (((forall n. AbsRel -> (n, n) -> PathCommand n
M AbsRel
Abs (n
xforall a. Num a => a -> a -> a
+n
x0,n
yforall a. Num a => a -> a -> a
+n
y0))forall a. a -> [a] -> [a]
:[PathCommand n]
cs)forall a. a -> [a] -> [a]
:[[PathCommand n]]
ds)
mergeMs ( [M AbsRel
Abs (n
x,n
y)] : ( ((M AbsRel
Abs (n
x0,n
y0)):[PathCommand n]
cs):[[PathCommand n]]
ds ) ) = forall n. RealFloat n => [[PathCommand n]] -> [[PathCommand n]]
mergeMs (((forall n. AbsRel -> (n, n) -> PathCommand n
M AbsRel
Abs (n
x0, n
y0))forall a. a -> [a] -> [a]
:[PathCommand n]
cs)forall a. a -> [a] -> [a]
:[[PathCommand n]]
ds)
mergeMs ([PathCommand n]
c:[[PathCommand n]]
cs) = [PathCommand n]
c forall a. a -> [a] -> [a]
: (forall n. RealFloat n => [[PathCommand n]] -> [[PathCommand n]]
mergeMs [[PathCommand n]]
cs)
mergeMs [] = []
data ClosedTrail a = O a | Closed a
isClosed :: ClosedTrail a -> Bool
isClosed (Closed a
_) = Bool
True
isClosed ClosedTrail a
_ = Bool
False
getTrail :: ClosedTrail a -> a
getTrail (Closed a
a) = a
a
getTrail (O a
a) = a
a
outline :: (RealFloat n, Show n) => [(Path V2 n, (n, n))] -> [PathCommand n] -> [(Path V2 n, (n, n))]
outline :: forall n.
(RealFloat n, Show n) =>
[(Path V2 n, (n, n))] -> [PathCommand n] -> [(Path V2 n, (n, n))]
outline [(Path V2 n, (n, n))]
paths [PathCommand n]
cs = [(Path V2 n, (n, n))]
paths forall a. [a] -> [a] -> [a]
++ [(Path V2 n
newPath,(n, n)
newPoint)]
where
newPath :: Path V2 n
newPath = forall t. Transformable t => Vn t -> t -> t
translate (forall n. (n, n) -> V2 n
r2 (n
trx,n
try)) forall a b. (a -> b) -> a -> b
$
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Path v n
pathFromTrail forall a b. (a -> b) -> a -> b
$
if forall {a}. ClosedTrail a -> Bool
isClosed ClosedTrail [Trail' Line V2 n]
trail
then forall (v :: * -> *) n. Trail' Loop v n -> Trail v n
wrapLoop forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. Trail' Line v n -> Trail' Loop v n
closeLine (forall a. Monoid a => [a] -> a
mconcat (forall {a}. ClosedTrail a -> a
getTrail ClosedTrail [Trail' Line V2 n]
trail))
else forall (v :: * -> *) n. Trail' Loop v n -> Trail v n
wrapLoop forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. Trail' Line v n -> Trail' Loop v n
closeLine (forall a. Monoid a => [a] -> a
mconcat (forall {a}. ClosedTrail a -> a
getTrail ClosedTrail [Trail' Line V2 n]
trail))
newPoint :: (n, n)
newPoint | forall {a}. ClosedTrail a -> Bool
isClosed ClosedTrail [Trail' Line V2 n]
trail = (n
trx, n
try)
| Bool
otherwise = (n, n)
startPoint
((n, n)
ctrlPoint, (n, n)
startPoint, ClosedTrail [Trail' Line V2 n]
trail) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall n.
(RealFloat n, Show n) =>
((n, n), (n, n), ClosedTrail [Trail' Line V2 n])
-> PathCommand n
-> ((n, n), (n, n), ClosedTrail [Trail' Line V2 n])
nextSegment ((n
x,n
y), (n
x,n
y), forall a. a -> ClosedTrail a
O []) [PathCommand n]
cs
(n
trx,n
try) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PathCommand n]
cs = (n
0,n
0)
| Bool
otherwise = forall {a} {b} {c}. (a, b, c) -> a
sel2 forall a b. (a -> b) -> a -> b
$ forall n.
(RealFloat n, Show n) =>
((n, n), (n, n), ClosedTrail [Trail' Line V2 n])
-> PathCommand n
-> ((n, n), (n, n), ClosedTrail [Trail' Line V2 n])
nextSegment ((n
x,n
y), (n
x,n
y), forall a. a -> ClosedTrail a
O []) (forall a. [a] -> a
head [PathCommand n]
cs)
(n
x,n
y) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Path V2 n, (n, n))]
paths = (n
0,n
0)
| Bool
otherwise = forall a b. (a, b) -> b
snd (forall a. [a] -> a
last [(Path V2 n, (n, n))]
paths)
sel2 :: (a, b, c) -> a
sel2 (a
a,b
b,c
c) = a
a
nextSegment :: (RealFloat n, Show n) => ((n,n), (n,n), ClosedTrail [Trail' Line V2 n]) -> PathCommand n -> ( (n,n), (n,n), ClosedTrail [Trail' Line V2 n])
nextSegment :: forall n.
(RealFloat n, Show n) =>
((n, n), (n, n), ClosedTrail [Trail' Line V2 n])
-> PathCommand n
-> ((n, n), (n, n), ClosedTrail [Trail' Line V2 n])
nextSegment ((n, n)
ctrlPoint, (n, n)
startPoint, O [Trail' Line V2 n]
trail) PathCommand n
Z = ((n, n)
ctrlPoint, (n, n)
startPoint, forall a. a -> ClosedTrail a
Closed [Trail' Line V2 n]
trail)
nextSegment ((n, n)
_, (n, n)
_, ClosedTrail [Trail' Line V2 n]
_ ) (M AbsRel
Abs (n, n)
point) = ((n, n)
point, (n, n)
point, forall a. a -> ClosedTrail a
O [])
nextSegment ((n, n)
_, (n
x0,n
y0), ClosedTrail [Trail' Line V2 n]
_ ) (M AbsRel
Rel (n
x,n
y)) = ((n
xforall a. Num a => a -> a -> a
+n
x0, n
yforall a. Num a => a -> a -> a
+n
y0), (n
xforall a. Num a => a -> a -> a
+n
x0, n
yforall a. Num a => a -> a -> a
+n
y0), forall a. a -> ClosedTrail a
O [])
nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (L AbsRel
Abs (n
x,n
y)) = ((n
x, n
y ), (n
x, n
y ), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}. (Floating n, Ord n) => (n, n) -> Trail' Line V2 n
straight' (n
xforall a. Num a => a -> a -> a
-n
x0, n
yforall a. Num a => a -> a -> a
-n
y0)])
nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (L AbsRel
Rel (n
x,n
y)) = ((n
xforall a. Num a => a -> a -> a
+n
x0, n
yforall a. Num a => a -> a -> a
+n
y0), (n
xforall a. Num a => a -> a -> a
+n
x0, n
yforall a. Num a => a -> a -> a
+n
y0), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}. (Floating n, Ord n) => (n, n) -> Trail' Line V2 n
straight' (n
x, n
y )])
nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (H AbsRel
Abs n
x) = ((n
x, n
y0), (n
x, n
y0), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}. (Floating n, Ord n) => (n, n) -> Trail' Line V2 n
straight' (n
xforall a. Num a => a -> a -> a
-n
x0, n
0)])
nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (H AbsRel
Rel n
x) = ((n
xforall a. Num a => a -> a -> a
+n
x0, n
y0), (n
xforall a. Num a => a -> a -> a
+n
x0, n
y0), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}. (Floating n, Ord n) => (n, n) -> Trail' Line V2 n
straight' (n
x, n
0)])
nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (V AbsRel
Abs n
y) = (( n
x0, n
y ), ( n
x0, n
y ), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}. (Floating n, Ord n) => (n, n) -> Trail' Line V2 n
straight' (n
0 , n
yforall a. Num a => a -> a -> a
-n
y0)])
nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (V AbsRel
Rel n
y) = (( n
x0, n
yforall a. Num a => a -> a -> a
+n
y0), ( n
x0, n
yforall a. Num a => a -> a -> a
+n
y0), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}. (Floating n, Ord n) => (n, n) -> Trail' Line V2 n
straight' (n
0, n
y )])
nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (C AbsRel
Abs (n
x1,n
y1,n
x2,n
y2,n
x,n
y)) = ((n
x2,n
y2), (n
x,n
y), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}.
(Floating n, Ord n) =>
(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n
x1forall a. Num a => a -> a -> a
-n
x0, n
y1forall a. Num a => a -> a -> a
-n
y0) (n
x2forall a. Num a => a -> a -> a
-n
x0, n
y2forall a. Num a => a -> a -> a
-n
y0) (n
xforall a. Num a => a -> a -> a
-n
x0,n
yforall a. Num a => a -> a -> a
-n
y0)])
nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (C AbsRel
Rel (n
x1,n
y1,n
x2,n
y2,n
x,n
y)) = ((n
x2forall a. Num a => a -> a -> a
+n
x0, n
y2forall a. Num a => a -> a -> a
+n
y0), (n
xforall a. Num a => a -> a -> a
+n
x0, n
yforall a. Num a => a -> a -> a
+n
y0), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}.
(Floating n, Ord n) =>
(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n
x1, n
y1) (n
x2, n
y2) (n
x,n
y)])
nextSegment ((n
cx,n
cy),(n
x0,n
y0), O [Trail' Line V2 n]
trail) (S AbsRel
Abs (n
x2,n
y2,n
x,n
y)) = ((n
x2, n
y2), (n
x, n
y), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}.
(Floating n, Ord n) =>
(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n
x0forall a. Num a => a -> a -> a
-n
cx, n
y0forall a. Num a => a -> a -> a
-n
cy) (n
x2forall a. Num a => a -> a -> a
-n
x0, n
y2forall a. Num a => a -> a -> a
-n
y0) (n
xforall a. Num a => a -> a -> a
-n
x0, n
yforall a. Num a => a -> a -> a
-n
y0)])
nextSegment ((n
cx,n
cy),(n
x0,n
y0), O [Trail' Line V2 n]
trail) (S AbsRel
Rel (n
x2,n
y2,n
x,n
y)) = ((n
x2forall a. Num a => a -> a -> a
+n
x0, n
y2forall a. Num a => a -> a -> a
+n
y0), (n
xforall a. Num a => a -> a -> a
+n
x0, n
yforall a. Num a => a -> a -> a
+n
y0), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}.
(Floating n, Ord n) =>
(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n
x0forall a. Num a => a -> a -> a
-n
cx, n
y0forall a. Num a => a -> a -> a
-n
cy) (n
x2, n
y2) (n
x, n
y)])
nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (Q AbsRel
Abs (n
x1,n
y1,n
x,n
y)) = ((n
x1, n
y1), (n
x, n
y), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}.
(Floating n, Ord n) =>
(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n
x1forall a. Num a => a -> a -> a
-n
x0, n
y1forall a. Num a => a -> a -> a
-n
y0) (n
xforall a. Num a => a -> a -> a
-n
x0, n
yforall a. Num a => a -> a -> a
-n
y0) (n
xforall a. Num a => a -> a -> a
-n
x0, n
yforall a. Num a => a -> a -> a
-n
y0)])
nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (Q AbsRel
Rel (n
x1,n
y1,n
x,n
y)) = ((n
x1forall a. Num a => a -> a -> a
+n
x0, n
y1forall a. Num a => a -> a -> a
+n
y0), (n
xforall a. Num a => a -> a -> a
+n
x0, n
yforall a. Num a => a -> a -> a
+n
y0), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}.
(Floating n, Ord n) =>
(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n
x1, n
y1) (n
x, n
y) (n
x, n
y)])
nextSegment ((n
cx,n
cy), (n
x0,n
y0), O [Trail' Line V2 n]
trail) (T AbsRel
Abs (n
x,n
y)) = ((n
2forall a. Num a => a -> a -> a
*n
x0forall a. Num a => a -> a -> a
-n
cx, n
2forall a. Num a => a -> a -> a
*n
y0forall a. Num a => a -> a -> a
-n
cy ), (n
x, n
y), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}.
(Floating n, Ord n) =>
(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n
x0forall a. Num a => a -> a -> a
-n
cx, n
y0forall a. Num a => a -> a -> a
-n
cy) (n
xforall a. Num a => a -> a -> a
-n
x0, n
yforall a. Num a => a -> a -> a
-n
y0) (n
xforall a. Num a => a -> a -> a
-n
x0, n
yforall a. Num a => a -> a -> a
-n
y0)])
nextSegment ((n
cx,n
cy), (n
x0,n
y0), O [Trail' Line V2 n]
trail) (T AbsRel
Rel (n
x,n
y)) = ((n
2forall a. Num a => a -> a -> a
*n
x0forall a. Num a => a -> a -> a
-n
cx, n
2forall a. Num a => a -> a -> a
*n
y0forall a. Num a => a -> a -> a
-n
cy), (n
x, n
y), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}.
(Floating n, Ord n) =>
(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n
x0forall a. Num a => a -> a -> a
-n
cx, n
y0forall a. Num a => a -> a -> a
-n
cy) (n
x, n
y) (n
x, n
y)])
nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (A AbsRel
Abs (n
rx,n
ry,n
xAxisRot,n
fl0,n
fl1,n
x,n
y) ) = ((n
x, n
y), (n
x, n
y), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall n.
(RealFloat n, Show n) =>
(n, n) -> n -> n -> n -> (n, n) -> Trail' Line V2 n
svgArc (n
rx,n
ry) n
xAxisRot n
fl0 n
fl1 (n
xforall a. Num a => a -> a -> a
-n
x0, n
yforall a. Num a => a -> a -> a
-n
y0)])
nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (A AbsRel
Rel (n
rx,n
ry,n
xAxisRot,n
fl0,n
fl1,n
x,n
y) ) = ((n
xforall a. Num a => a -> a -> a
+n
x0, n
yforall a. Num a => a -> a -> a
+n
y0), (n
xforall a. Num a => a -> a -> a
+n
x0, n
yforall a. Num a => a -> a -> a
+n
y0), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall n.
(RealFloat n, Show n) =>
(n, n) -> n -> n -> n -> (n, n) -> Trail' Line V2 n
svgArc (n
rx,n
ry) n
xAxisRot n
fl0 n
fl1 (n
x, n
y)])
straight' :: (n, n) -> Trail' Line V2 n
straight' = forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Segment Closed v n] -> Trail' Line v n
lineFromSegments forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n. v n -> Segment Closed v n
straight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. (n, n) -> V2 n
r2
bez3 :: (n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n, n)
point1 (n, n)
point2 (n, n)
point3 = forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Segment Closed v n] -> Trail' Line v n
lineFromSegments [forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bezier3 (forall n. (n, n) -> V2 n
r2 (n, n)
point1) (forall n. (n, n) -> V2 n
r2 (n, n)
point2) (forall n. (n, n) -> V2 n
r2 (n, n)
point3)]
svgArc :: (RealFloat n, Show n) => (n, n) -> n -> n -> n -> (n,n) -> Trail' Line V2 n
svgArc :: forall n.
(RealFloat n, Show n) =>
(n, n) -> n -> n -> n -> (n, n) -> Trail' Line V2 n
svgArc (n
rxx, n
ryy) n
xAxisRot n
largeArcFlag n
sweepFlag (n
x2, n
y2)
| n
x2 forall a. Eq a => a -> a -> Bool
== n
0 Bool -> Bool -> Bool
&& n
y2 forall a. Eq a => a -> a -> Bool
== n
0 = forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n
emptyLine
| n
rx forall a. Eq a => a -> a -> Bool
== n
0 Bool -> Bool -> Bool
|| n
ry forall a. Eq a => a -> a -> Bool
== n
0 = forall {n}. (Floating n, Ord n) => (n, n) -> Trail' Line V2 n
straight' (n
x2,n
y2)
| Bool
otherwise =
forall a. Located a -> a
unLoc (forall n t.
(InSpace V2 n t, OrderedField n, TrailLike t) =>
n -> Direction V2 n -> Angle n -> t
arc' n
1 Direction V2 n
dir1 (n
dtheta forall b a. b -> AReview a b -> a
@@ forall n. Iso' (Angle n) n
rad) forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleY n
ry forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleX n
rx forall a b. a -> (a -> b) -> b
# forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (n
phi forall b a. b -> AReview a b -> a
@@ forall n. Iso' (Angle n) n
rad))
where rx :: n
rx | n
rxx forall a. Ord a => a -> a -> Bool
< n
0 = -n
rxx
| Bool
otherwise = n
rxx
ry :: n
ry | n
ryy forall a. Ord a => a -> a -> Bool
< n
0 = -n
ryy
| Bool
otherwise = n
ryy
fa :: a
fa | n
largeArcFlag forall a. Eq a => a -> a -> Bool
== n
0 = a
0
| Bool
otherwise = a
1
fs :: a
fs | n
sweepFlag forall a. Eq a => a -> a -> Bool
== n
0 = a
0
| Bool
otherwise = a
1
phi :: n
phi = n
xAxisRot forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ n
180
(a
x1,b
y1) = (a
0,b
0)
x1x2 :: n
x1x2 = (forall {b}. Num b => b
x1 forall a. Num a => a -> a -> a
- n
x2)forall a. Fractional a => a -> a -> a
/n
2
y1y2 :: n
y1y2 = (forall {b}. Num b => b
y1 forall a. Num a => a -> a -> a
- n
y2)forall a. Fractional a => a -> a -> a
/n
2
x1' :: n
x1' = (forall a. Floating a => a -> a
cos n
phi) forall a. Num a => a -> a -> a
* n
x1x2 forall a. Num a => a -> a -> a
+ (forall a. Floating a => a -> a
sin n
phi) forall a. Num a => a -> a -> a
* n
y1y2
y1' :: n
y1' = -(forall a. Floating a => a -> a
sin n
phi) forall a. Num a => a -> a -> a
* n
x1x2 forall a. Num a => a -> a -> a
+ (forall a. Floating a => a -> a
cos n
phi) forall a. Num a => a -> a -> a
* n
y1y2
s :: n
s = (n
rxforall a. Num a => a -> a -> a
*n
rxforall a. Num a => a -> a -> a
*n
ryforall a. Num a => a -> a -> a
*n
ry forall a. Num a => a -> a -> a
- n
rxforall a. Num a => a -> a -> a
*n
rxforall a. Num a => a -> a -> a
*n
y1'forall a. Num a => a -> a -> a
*n
y1' forall a. Num a => a -> a -> a
- n
ryforall a. Num a => a -> a -> a
*n
ryforall a. Num a => a -> a -> a
*n
x1'forall a. Num a => a -> a -> a
*n
x1') forall a. Fractional a => a -> a -> a
/ (n
rxforall a. Num a => a -> a -> a
*n
rxforall a. Num a => a -> a -> a
*n
y1'forall a. Num a => a -> a -> a
*n
y1' forall a. Num a => a -> a -> a
+ n
ryforall a. Num a => a -> a -> a
*n
ryforall a. Num a => a -> a -> a
*n
x1'forall a. Num a => a -> a -> a
*n
x1' )
root :: n
root | n
s forall a. Ord a => a -> a -> Bool
<= n
0 = n
0
| Bool
otherwise = forall a. Floating a => a -> a
sqrt n
s
cx' :: n
cx' | forall {b}. Num b => b
fa forall a. Eq a => a -> a -> Bool
/= forall {b}. Num b => b
fs = n
root forall a. Num a => a -> a -> a
* n
rx forall a. Num a => a -> a -> a
* n
y1' forall a. Fractional a => a -> a -> a
/ n
ry
| Bool
otherwise = - n
root forall a. Num a => a -> a -> a
* n
rx forall a. Num a => a -> a -> a
* n
y1' forall a. Fractional a => a -> a -> a
/ n
ry
cy' :: n
cy' | forall {b}. Num b => b
fa forall a. Eq a => a -> a -> Bool
/= forall {b}. Num b => b
fs = - n
root forall a. Num a => a -> a -> a
* n
ry forall a. Num a => a -> a -> a
* n
x1' forall a. Fractional a => a -> a -> a
/ n
rx
| Bool
otherwise = n
root forall a. Num a => a -> a -> a
* n
ry forall a. Num a => a -> a -> a
* n
x1' forall a. Fractional a => a -> a -> a
/ n
rx
cx :: n
cx = (forall a. Floating a => a -> a
cos n
phi) forall a. Num a => a -> a -> a
* n
cx' forall a. Num a => a -> a -> a
- (forall a. Floating a => a -> a
sin n
phi) forall a. Num a => a -> a -> a
* n
cy' forall a. Num a => a -> a -> a
+ ((forall {b}. Num b => b
x1forall a. Num a => a -> a -> a
+n
x2)forall a. Fractional a => a -> a -> a
/n
2)
cy :: n
cy = (forall a. Floating a => a -> a
sin n
phi) forall a. Num a => a -> a -> a
* n
cx' forall a. Num a => a -> a -> a
+ (forall a. Floating a => a -> a
cos n
phi) forall a. Num a => a -> a -> a
* n
cy' forall a. Num a => a -> a -> a
+ ((forall {b}. Num b => b
y1forall a. Num a => a -> a -> a
+n
y2)forall a. Fractional a => a -> a -> a
/n
2)
dir1 :: Direction V2 n
dir1 = forall (v :: * -> *) n.
(Additive v, Num n) =>
Point v n -> Point v n -> Direction v n
dirBetween forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin (forall n. (n, n) -> P2 n
p2 ((n
x1'forall a. Num a => a -> a -> a
-n
cx')forall a. Fractional a => a -> a -> a
/n
rx, (n
y1'forall a. Num a => a -> a -> a
-n
cy')forall a. Fractional a => a -> a -> a
/n
ry))
v1 :: V2 n
v1 = forall n. (n, n) -> V2 n
r2 (( n
x1'forall a. Num a => a -> a -> a
-n
cx')forall a. Fractional a => a -> a -> a
/n
rx, (n
y1'forall a. Num a => a -> a -> a
-n
cy')forall a. Fractional a => a -> a -> a
/n
ry)
v2 :: V2 n
v2 = forall n. (n, n) -> V2 n
r2 ((-n
x1'forall a. Num a => a -> a -> a
-n
cx')forall a. Fractional a => a -> a -> a
/n
rx, (-n
y1'forall a. Num a => a -> a -> a
-n
cy')forall a. Fractional a => a -> a -> a
/n
ry)
angleV1V2 :: n
angleV1V2 | (forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm V2 n
v1 forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm V2 n
v2) forall a. Ord a => a -> a -> Bool
>= n
1 = (forall n. Floating n => n -> Angle n
acosA n
1 ) forall s a. s -> Getting a s a -> a
^. forall n. Iso' (Angle n) n
rad
| (forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm V2 n
v1 forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm V2 n
v2) forall a. Ord a => a -> a -> Bool
<= -n
1 = (forall n. Floating n => n -> Angle n
acosA (-n
1)) forall s a. s -> Getting a s a -> a
^. forall n. Iso' (Angle n) n
rad
| Bool
otherwise = (forall n. RealFloat n => V2 n -> V2 n -> Angle n
signedAngleBetween V2 n
v2 V2 n
v1) forall s a. s -> Getting a s a -> a
^. forall n. Iso' (Angle n) n
rad
dtheta :: n
dtheta | forall {b}. Num b => b
fs forall a. Eq a => a -> a -> Bool
== Integer
0 = if n
angleV1V2 forall a. Ord a => a -> a -> Bool
> n
0 then n
angleV1V2 forall a. Num a => a -> a -> a
- (n
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
pi) else n
angleV1V2
| Bool
otherwise = if n
angleV1V2 forall a. Ord a => a -> a -> Bool
< n
0 then n
angleV1V2 forall a. Num a => a -> a -> a
+ (n
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
pi) else n
angleV1V2