{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE PatternSynonyms #-}
module NumHask.Space.XY
( XY (..),
pattern P,
pattern R,
toRect,
toPoint,
projectOn,
projectTo,
)
where
import GHC.Show (show)
import NumHask.Prelude hiding (show)
import NumHask.Space.Point
import NumHask.Space.Rect
import NumHask.Space.Types
data XY a
= PointXY (Point a)
| RectXY (Rect a)
deriving (XY a -> XY a -> Bool
(XY a -> XY a -> Bool) -> (XY a -> XY a -> Bool) -> Eq (XY a)
forall a. Eq a => XY a -> XY a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XY a -> XY a -> Bool
$c/= :: forall a. Eq a => XY a -> XY a -> Bool
== :: XY a -> XY a -> Bool
$c== :: forall a. Eq a => XY a -> XY a -> Bool
Eq, a -> XY b -> XY a
(a -> b) -> XY a -> XY b
(forall a b. (a -> b) -> XY a -> XY b)
-> (forall a b. a -> XY b -> XY a) -> Functor XY
forall a b. a -> XY b -> XY a
forall a b. (a -> b) -> XY a -> XY b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> XY b -> XY a
$c<$ :: forall a b. a -> XY b -> XY a
fmap :: (a -> b) -> XY a -> XY b
$cfmap :: forall a b. (a -> b) -> XY a -> XY b
Functor)
instance (Show a) => Show (XY a) where
show :: XY a -> String
show (PointXY (Point a
x a
y)) = String
"P " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
y
show (RectXY (Rect a
x a
z a
y a
w)) = String
"R " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
z String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
y String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
w
pattern P :: a -> a -> XY a
pattern $bP :: a -> a -> XY a
$mP :: forall r a. XY a -> (a -> a -> r) -> (Void# -> r) -> r
P x y = PointXY (Point x y)
{-# COMPLETE P #-}
pattern R :: a -> a -> a -> a -> XY a
pattern $bR :: a -> a -> a -> a -> XY a
$mR :: forall r a. XY a -> (a -> a -> a -> a -> r) -> (Void# -> r) -> r
R x z y w = RectXY (Rect x z y w)
{-# COMPLETE R #-}
instance (Additive a) => Additive (XY a) where
PointXY (Point a
x a
y) + :: XY a -> XY a -> XY a
+ PointXY (Point a
x' a
y') = Point a -> XY a
forall a. Point a -> XY a
PointXY (a -> a -> Point a
forall a. a -> a -> Point a
Point (a
x a -> a -> a
forall a. Additive a => a -> a -> a
+ a
x') (a
y a -> a -> a
forall a. Additive a => a -> a -> a
+ a
y'))
PointXY (Point a
x' a
y') + RectXY (Rect a
x a
z a
y a
w) = Rect a -> XY a
forall a. Rect a -> XY a
RectXY (Rect a -> XY a) -> Rect a -> XY a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Rect a
forall a. a -> a -> a -> a -> Rect a
Rect (a
x a -> a -> a
forall a. Additive a => a -> a -> a
+ a
x') (a
z a -> a -> a
forall a. Additive a => a -> a -> a
+ a
x') (a
y a -> a -> a
forall a. Additive a => a -> a -> a
+ a
y') (a
w a -> a -> a
forall a. Additive a => a -> a -> a
+ a
y')
RectXY (Rect a
x a
z a
y a
w) + PointXY (Point a
x' a
y') = Rect a -> XY a
forall a. Rect a -> XY a
RectXY (Rect a -> XY a) -> Rect a -> XY a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Rect a
forall a. a -> a -> a -> a -> Rect a
Rect (a
x a -> a -> a
forall a. Additive a => a -> a -> a
+ a
x') (a
z a -> a -> a
forall a. Additive a => a -> a -> a
+ a
x') (a
y a -> a -> a
forall a. Additive a => a -> a -> a
+ a
y') (a
w a -> a -> a
forall a. Additive a => a -> a -> a
+ a
y')
RectXY (Rect a
x a
z a
y a
w) + RectXY (Rect a
x' a
z' a
y' a
w') =
Rect a -> XY a
forall a. Rect a -> XY a
RectXY (Rect a -> XY a) -> Rect a -> XY a
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Rect a
forall a. a -> a -> a -> a -> Rect a
Rect (a
x a -> a -> a
forall a. Additive a => a -> a -> a
+ a
x') (a
z a -> a -> a
forall a. Additive a => a -> a -> a
+ a
z') (a
y a -> a -> a
forall a. Additive a => a -> a -> a
+ a
y') (a
w a -> a -> a
forall a. Additive a => a -> a -> a
+ a
w')
zero :: XY a
zero = Point a -> XY a
forall a. Point a -> XY a
PointXY (a -> a -> Point a
forall a. a -> a -> Point a
Point a
forall a. Additive a => a
zero a
forall a. Additive a => a
zero)
instance (Ord a, Field a) => Multiplicative (XY a) where
XY a
x * :: XY a -> XY a -> XY a
* XY a
y = Rect a -> XY a
forall a. Rect a -> XY a
RectXY (Rect a -> XY a) -> Rect a -> XY a
forall a b. (a -> b) -> a -> b
$ XY a -> Rect a
forall a. XY a -> Rect a
toRect XY a
x Rect a -> Rect a -> Rect a
forall a. Multiplicative a => a -> a -> a
* XY a -> Rect a
forall a. XY a -> Rect a
toRect XY a
y
one :: XY a
one = Rect a -> XY a
forall a. Rect a -> XY a
RectXY Rect a
forall a. Multiplicative a => a
one
instance (Ord a, Subtractive a) => Subtractive (XY a) where
negate :: XY a -> XY a
negate (PointXY (Point a
x a
y)) = Point a -> XY a
forall a. Point a -> XY a
PointXY (a -> a -> Point a
forall a. a -> a -> Point a
Point (a -> a
forall a. Subtractive a => a -> a
negate a
x) (a -> a
forall a. Subtractive a => a -> a
negate a
y))
negate (RectXY (Rect a
x a
z a
y a
w)) = Rect a -> XY a
forall a. Rect a -> XY a
RectXY (a -> a -> a -> a -> Rect a
forall a. a -> a -> a -> a -> Rect a
Rect (a -> a
forall a. Subtractive a => a -> a
negate a
x) (a -> a
forall a. Subtractive a => a -> a
negate a
z) (a -> a
forall a. Subtractive a => a -> a
negate a
y) (a -> a
forall a. Subtractive a => a -> a
negate a
w))
instance (Ord a, Field a, Signed a) => Signed (XY a) where
abs :: XY a -> XY a
abs XY a
x = Point a -> XY a
forall a. Point a -> XY a
PointXY (Point a -> XY a) -> Point a -> XY a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Signed a => a -> a
abs (a -> a) -> Point a -> Point a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XY a -> Point a
forall a. (Ord a, Field a) => XY a -> Point a
toPoint XY a
x
sign :: XY a -> XY a
sign XY a
x = Point a -> XY a
forall a. Point a -> XY a
PointXY (Point a -> XY a) -> Point a -> XY a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Signed a => a -> a
sign (a -> a) -> Point a -> Point a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XY a -> Point a
forall a. (Ord a, Field a) => XY a -> Point a
toPoint XY a
x
toRect :: XY a -> Rect a
toRect :: XY a -> Rect a
toRect (PointXY (Point a
x a
y)) = a -> a -> a -> a -> Rect a
forall a. a -> a -> a -> a -> Rect a
Rect a
x a
x a
y a
y
toRect (RectXY Rect a
a) = Rect a
a
toPoint :: (Ord a, Field a) => XY a -> Point a
toPoint :: XY a -> Point a
toPoint (PointXY (Point a
x a
y)) = a -> a -> Point a
forall a. a -> a -> Point a
Point a
x a
y
toPoint (RectXY (Ranges Range a
x Range a
y)) = a -> a -> Point a
forall a. a -> a -> Point a
Point (Range a -> Element (Range a)
forall s. (Space s, Field (Element s)) => s -> Element s
mid Range a
x) (Range a -> Element (Range a)
forall s. (Space s, Field (Element s)) => s -> Element s
mid Range a
y)
instance (Ord a) => Semigroup (XY a) where
<> :: XY a -> XY a -> XY a
(<>) XY a
a XY a
b = Rect a -> XY a
forall a. Rect a -> XY a
RectXY (XY a -> Rect a
forall a. XY a -> Rect a
toRect XY a
a Rect a -> Rect a -> Rect a
forall s. Space s => s -> s -> s
`union` XY a -> Rect a
forall a. XY a -> Rect a
toRect XY a
b)
projectOn :: Rect Double -> Rect Double -> XY Double -> XY Double
projectOn :: Rect Double -> Rect Double -> XY Double -> XY Double
projectOn Rect Double
new Rect Double
old (PointXY Point Double
p) = Point Double -> XY Double
forall a. Point a -> XY a
PointXY (Point Double -> XY Double) -> Point Double -> XY Double
forall a b. (a -> b) -> a -> b
$ Rect Double -> Rect Double -> Point Double -> Point Double
projectOnP Rect Double
new Rect Double
old Point Double
p
projectOn Rect Double
new Rect Double
old (RectXY Rect Double
r) = Rect Double -> XY Double
forall a. Rect a -> XY a
RectXY (Rect Double -> XY Double) -> Rect Double -> XY Double
forall a b. (a -> b) -> a -> b
$ Rect Double -> Rect Double -> Rect Double -> Rect Double
projectOnR Rect Double
new Rect Double
old Rect Double
r
projectTo :: Rect Double -> [XY Double] -> [XY Double]
projectTo :: Rect Double -> [XY Double] -> [XY Double]
projectTo Rect Double
_ [] = []
projectTo Rect Double
vb (XY Double
x : [XY Double]
xs) = Rect Double -> Rect Double -> XY Double -> XY Double
projectOn Rect Double
vb (XY Double -> Rect Double
forall a. XY a -> Rect a
toRect (XY Double -> Rect Double) -> XY Double -> Rect Double
forall a b. (a -> b) -> a -> b
$ NonEmpty (XY Double) -> XY Double
forall a. Semigroup a => NonEmpty a -> a
sconcat (XY Double
x XY Double -> [XY Double] -> NonEmpty (XY Double)
forall a. a -> [a] -> NonEmpty a
:| [XY Double]
xs)) (XY Double -> XY Double) -> [XY Double] -> [XY Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XY Double
x XY Double -> [XY Double] -> [XY Double]
forall a. a -> [a] -> [a]
: [XY Double]
xs)