{-# LANGUAGE ScopedTypeVariables #-}
module Waterfall.TwoD.Path2D
( Path2D
, Sense (..)
, module Waterfall.Path.Common
, arc
, arcTo
, arcRelative
, repeatLooping
, closeLoop
, line2D
, lineTo2D
, lineRelative2D
, arcVia2D
, arcViaTo2D
, arcViaRelative2D
, bezier2D
, bezierTo2D
, bezierRelative2D
, pathFrom2D
, pathFromTo2D
) where
import Waterfall.TwoD.Internal.Path2D (Path2D(..))
import Waterfall.TwoD.Transforms (rotate2D)
import qualified Waterfall.Internal.Edges as Internal.Edges
import Linear.V2 (V2(..))
import Control.Monad.IO.Class (liftIO)
import Control.Lens ((^.))
import Linear ((^*), _xy, distance, normalize, unangle)
import Waterfall.Path.Common
data Sense = Clockwise | Counterclockwise deriving (Sense -> Sense -> Bool
(Sense -> Sense -> Bool) -> (Sense -> Sense -> Bool) -> Eq Sense
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sense -> Sense -> Bool
== :: Sense -> Sense -> Bool
$c/= :: Sense -> Sense -> Bool
/= :: Sense -> Sense -> Bool
Eq, Int -> Sense -> ShowS
[Sense] -> ShowS
Sense -> String
(Int -> Sense -> ShowS)
-> (Sense -> String) -> ([Sense] -> ShowS) -> Show Sense
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sense -> ShowS
showsPrec :: Int -> Sense -> ShowS
$cshow :: Sense -> String
show :: Sense -> String
$cshowList :: [Sense] -> ShowS
showList :: [Sense] -> ShowS
Show)
arc :: Sense -> Double -> V2 Double -> V2 Double -> Path2D
arc :: Sense -> Double -> V2 Double -> V2 Double -> Path2D
arc Sense
sense Double
radius V2 Double
start V2 Double
end =
let mid :: V2 Double
mid = (V2 Double
start V2 Double -> V2 Double -> V2 Double
forall a. Num a => a -> a -> a
+ V2 Double
end) V2 Double -> Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Double
0.5
(V2 Double
dx Double
dy) = V2 Double -> V2 Double
forall a (f :: * -> *).
(Floating a, Metric f, Epsilon a) =>
f a -> f a
normalize (V2 Double -> V2 Double) -> V2 Double -> V2 Double
forall a b. (a -> b) -> a -> b
$ V2 Double
end V2 Double -> V2 Double -> V2 Double
forall a. Num a => a -> a -> a
- V2 Double
start
rotD :: V2 Double
rotD = case Sense
sense of
Sense
Clockwise -> Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 Double
dy (-Double
dx)
Sense
Counterclockwise -> Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 (-Double
dy) Double
dx
dse :: Double
dse = V2 Double -> V2 Double -> Double
forall a. Floating a => V2 a -> V2 a -> a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a -> a
distance V2 Double
start V2 Double
end
tangent :: Double
tangent = Double
radius Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
forall a. Floating a => a -> a
sqrt (Double
radius Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
radius Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
dse Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dse Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
4)
arcMid :: V2 Double
arcMid = V2 Double
mid V2 Double -> V2 Double -> V2 Double
forall a. Num a => a -> a -> a
+ V2 Double
rotD V2 Double -> Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Double
tangent
in if Double
dse Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
radius
then String -> Path2D
forall a. HasCallStack => String -> a
error String
"points too far apart in arc"
else V2 Double -> V2 Double -> V2 Double -> Path2D
forall point path.
AnyPath point path =>
point -> point -> point -> path
arcVia V2 Double
start V2 Double
arcMid V2 Double
end
arcTo :: Sense -> Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)
arcTo :: Sense -> Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)
arcTo Sense
sense Double
radius V2 Double
end = \V2 Double
start -> (V2 Double
end, Sense -> Double -> V2 Double -> V2 Double -> Path2D
arc Sense
sense Double
radius V2 Double
start V2 Double
end)
arcRelative :: Sense -> Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)
arcRelative :: Sense -> Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)
arcRelative Sense
sense Double
radius V2 Double
dEnd = do
V2 Double
end <- (V2 Double -> V2 Double -> V2 Double
forall a. Num a => a -> a -> a
+ V2 Double
dEnd)
Sense -> Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)
arcTo Sense
sense Double
radius V2 Double
end
repeatLooping :: Path2D -> Path2D
repeatLooping :: Path2D -> Path2D
repeatLooping Path2D
p = Acquire (Ptr Wire) -> Path2D
Path2D (Acquire (Ptr Wire) -> Path2D) -> Acquire (Ptr Wire) -> Path2D
forall a b. (a -> b) -> a -> b
$ do
Ptr Wire
path <- Path2D -> Acquire (Ptr Wire)
runPath Path2D
p
(V3 Double
s, V3 Double
e) <- IO (V3 Double, V3 Double) -> Acquire (V3 Double, V3 Double)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (V3 Double, V3 Double) -> Acquire (V3 Double, V3 Double))
-> (Ptr Wire -> IO (V3 Double, V3 Double))
-> Ptr Wire
-> Acquire (V3 Double, V3 Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Wire -> IO (V3 Double, V3 Double)
Internal.Edges.wireEndpoints (Ptr Wire -> Acquire (V3 Double, V3 Double))
-> Ptr Wire -> Acquire (V3 Double, V3 Double)
forall a b. (a -> b) -> a -> b
$ Ptr Wire
path
let a :: Double
a = V2 Double -> Double
forall a. (Floating a, Ord a) => V2 a -> a
unangle (V3 Double
e V3 Double
-> Getting (V2 Double) (V3 Double) (V2 Double) -> V2 Double
forall s a. s -> Getting a s a -> a
^. Getting (V2 Double) (V3 Double) (V2 Double)
forall a. Lens' (V3 a) (V2 a)
forall (t :: * -> *) a. R2 t => Lens' (t a) (V2 a)
_xy) Double -> Double -> Double
forall a. Num a => a -> a -> a
- V2 Double -> Double
forall a. (Floating a, Ord a) => V2 a -> a
unangle (V3 Double
s V3 Double
-> Getting (V2 Double) (V3 Double) (V2 Double) -> V2 Double
forall s a. s -> Getting a s a -> a
^. Getting (V2 Double) (V3 Double) (V2 Double)
forall a. Lens' (V3 a) (V2 a)
forall (t :: * -> *) a. R2 t => Lens' (t a) (V2 a)
_xy)
let Integer
times :: Integer = Integer -> Integer
forall a. Num a => a -> a
abs (Integer -> Integer) -> (Double -> Integer) -> Double -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$ Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
a
Path2D -> Acquire (Ptr Wire)
runPath (Path2D -> Acquire (Ptr Wire)) -> Path2D -> Acquire (Ptr Wire)
forall a b. (a -> b) -> a -> b
$ [Path2D] -> Path2D
forall a. Monoid a => [a] -> a
mconcat [Double -> Path2D -> Path2D
forall a. Transformable2D a => Double -> a -> a
rotate2D (Double -> Double
forall a. Num a => a -> a
negate (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a) Path2D
p | Integer
n <- [Integer
0..Integer
times]]
closeLoop :: Path2D -> Path2D
closeLoop :: Path2D -> Path2D
closeLoop Path2D
p = Acquire (Ptr Wire) -> Path2D
Path2D (Acquire (Ptr Wire) -> Path2D) -> Acquire (Ptr Wire) -> Path2D
forall a b. (a -> b) -> a -> b
$ do
Ptr Wire
path <- Path2D -> Acquire (Ptr Wire)
runPath Path2D
p
(V3 Double
s, V3 Double
e) <- IO (V3 Double, V3 Double) -> Acquire (V3 Double, V3 Double)
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (V3 Double, V3 Double) -> Acquire (V3 Double, V3 Double))
-> (Ptr Wire -> IO (V3 Double, V3 Double))
-> Ptr Wire
-> Acquire (V3 Double, V3 Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Wire -> IO (V3 Double, V3 Double)
Internal.Edges.wireEndpoints (Ptr Wire -> Acquire (V3 Double, V3 Double))
-> Ptr Wire -> Acquire (V3 Double, V3 Double)
forall a b. (a -> b) -> a -> b
$ Ptr Wire
path
Path2D -> Acquire (Ptr Wire)
runPath (Path2D -> Acquire (Ptr Wire)) -> Path2D -> Acquire (Ptr Wire)
forall a b. (a -> b) -> a -> b
$ [Path2D] -> Path2D
forall a. Monoid a => [a] -> a
mconcat [Path2D
p, V2 Double -> V2 Double -> Path2D
forall point path. AnyPath point path => point -> point -> path
line (V3 Double
e V3 Double
-> Getting (V2 Double) (V3 Double) (V2 Double) -> V2 Double
forall s a. s -> Getting a s a -> a
^. Getting (V2 Double) (V3 Double) (V2 Double)
forall a. Lens' (V3 a) (V2 a)
forall (t :: * -> *) a. R2 t => Lens' (t a) (V2 a)
_xy) (V3 Double
s V3 Double
-> Getting (V2 Double) (V3 Double) (V2 Double) -> V2 Double
forall s a. s -> Getting a s a -> a
^. Getting (V2 Double) (V3 Double) (V2 Double)
forall a. Lens' (V3 a) (V2 a)
forall (t :: * -> *) a. R2 t => Lens' (t a) (V2 a)
_xy)]
line2D :: V2 Double -> V2 Double -> Path2D
line2D :: V2 Double -> V2 Double -> Path2D
line2D = V2 Double -> V2 Double -> Path2D
forall point path. AnyPath point path => point -> point -> path
line
lineTo2D :: V2 Double -> V2 Double -> (V2 Double, Path2D)
lineTo2D :: V2 Double -> V2 Double -> (V2 Double, Path2D)
lineTo2D = V2 Double -> V2 Double -> (V2 Double, Path2D)
forall point path.
AnyPath point path =>
point -> point -> (point, path)
lineTo
lineRelative2D :: V2 Double -> V2 Double -> (V2 Double, Path2D)
lineRelative2D :: V2 Double -> V2 Double -> (V2 Double, Path2D)
lineRelative2D = V2 Double -> V2 Double -> (V2 Double, Path2D)
forall point path.
(AnyPath point path, Num point) =>
point -> point -> (point, path)
lineRelative
arcVia2D :: V2 Double -> V2 Double -> V2 Double -> Path2D
arcVia2D :: V2 Double -> V2 Double -> V2 Double -> Path2D
arcVia2D = V2 Double -> V2 Double -> V2 Double -> Path2D
forall point path.
AnyPath point path =>
point -> point -> point -> path
arcVia
arcViaTo2D :: V2 Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)
arcViaTo2D :: V2 Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)
arcViaTo2D = V2 Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)
forall point path.
AnyPath point path =>
point -> point -> point -> (point, path)
arcViaTo
arcViaRelative2D :: V2 Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)
arcViaRelative2D :: V2 Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)
arcViaRelative2D = V2 Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)
forall point path.
(AnyPath point path, Num point) =>
point -> point -> point -> (point, path)
arcViaRelative
bezier2D :: V2 Double -> V2 Double -> V2 Double -> V2 Double -> Path2D
bezier2D :: V2 Double -> V2 Double -> V2 Double -> V2 Double -> Path2D
bezier2D = V2 Double -> V2 Double -> V2 Double -> V2 Double -> Path2D
forall point path.
AnyPath point path =>
point -> point -> point -> point -> path
bezier
bezierTo2D :: V2 Double -> V2 Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)
bezierTo2D :: V2 Double
-> V2 Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)
bezierTo2D = V2 Double
-> V2 Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)
forall point path.
AnyPath point path =>
point -> point -> point -> point -> (point, path)
bezierTo
bezierRelative2D :: V2 Double -> V2 Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)
bezierRelative2D :: V2 Double
-> V2 Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)
bezierRelative2D = V2 Double
-> V2 Double -> V2 Double -> V2 Double -> (V2 Double, Path2D)
forall point path.
(AnyPath point path, Num point) =>
point -> point -> point -> point -> (point, path)
bezierRelative
pathFrom2D :: V2 Double -> [V2 Double -> (V2 Double, Path2D)] -> Path2D
pathFrom2D :: V2 Double -> [V2 Double -> (V2 Double, Path2D)] -> Path2D
pathFrom2D = V2 Double -> [V2 Double -> (V2 Double, Path2D)] -> Path2D
forall path point.
Monoid path =>
point -> [point -> (point, path)] -> path
pathFrom
pathFromTo2D :: [V2 Double -> (V2 Double, Path2D)] -> V2 Double -> (V2 Double, Path2D)
pathFromTo2D :: [V2 Double -> (V2 Double, Path2D)]
-> V2 Double -> (V2 Double, Path2D)
pathFromTo2D = [V2 Double -> (V2 Double, Path2D)]
-> V2 Double -> (V2 Double, Path2D)
forall path point.
Monoid path =>
[point -> (point, path)] -> point -> (point, path)
pathFromTo