module Graphics.Rasterific.Operators
( Point
, (^&&^)
, (^||^)
, (^==^)
, (^/=^)
, (^<=^)
, (^<^)
, (^<)
, vmin
, vmax
, vabs
, vfloor
, vceil
, clampPoint
, midPoint
, middle
, vpartition
, normal
, ifZero
, isNearby
, isDistingableFrom
, isDegenerate
) where
import Control.Applicative( liftA2, liftA3 )
import Graphics.Rasterific.Linear
( V2( .. )
, Additive( .. )
, Epsilon( nearZero )
, (^+^)
, (^*)
, dot
, normalize
)
infix 4 ^<, ^<=^, ^<^, ^==^, ^/=^
infixr 3 ^&&^
infixr 2 ^||^
type Point = V2 Float
(^&&^) :: (Applicative a) => a Bool -> a Bool -> a Bool
{-# INLINE (^&&^) #-}
^&&^ :: a Bool -> a Bool -> a Bool
(^&&^) = (Bool -> Bool -> Bool) -> a Bool -> a Bool -> a Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&)
(^||^) :: (Applicative a) => a Bool -> a Bool -> a Bool
{-# INLINE (^||^) #-}
^||^ :: a Bool -> a Bool -> a Bool
(^||^) = (Bool -> Bool -> Bool) -> a Bool -> a Bool -> a Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||)
(^==^) :: (Eq v, Applicative a) => a v -> a v -> a Bool
{-# INLINE (^==^) #-}
^==^ :: a v -> a v -> a Bool
(^==^) = (v -> v -> Bool) -> a v -> a v -> a Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 v -> v -> Bool
forall a. Eq a => a -> a -> Bool
(==)
(^<=^) :: (Ord v, Applicative a) => a v -> a v -> a Bool
{-# INLINE (^<=^) #-}
^<=^ :: a v -> a v -> a Bool
(^<=^) = (v -> v -> Bool) -> a v -> a v -> a Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 v -> v -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
(^<^) :: (Ord v, Applicative a) => a v -> a v -> a Bool
{-# INLINE (^<^) #-}
^<^ :: a v -> a v -> a Bool
(^<^) = (v -> v -> Bool) -> a v -> a v -> a Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 v -> v -> Bool
forall a. Ord a => a -> a -> Bool
(<)
(^<) :: (Applicative a, Ord v) => a v -> v -> a Bool
{-# INLINE (^<) #-}
^< :: a v -> v -> a Bool
(^<) a v
vec v
v = (v -> v -> Bool
forall a. Ord a => a -> a -> Bool
< v
v) (v -> Bool) -> a v -> a Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a v
vec
(^/=^) :: (Applicative a, Eq v) => a v -> a v -> a Bool
{-# INLINE (^/=^) #-}
^/=^ :: a v -> a v -> a Bool
(^/=^) = (v -> v -> Bool) -> a v -> a v -> a Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 v -> v -> Bool
forall a. Eq a => a -> a -> Bool
(/=)
vmin :: (Ord n, Applicative a) => a n -> a n -> a n
{-# INLINE vmin #-}
vmin :: a n -> a n -> a n
vmin = (n -> n -> n) -> a n -> a n -> a n
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 n -> n -> n
forall a. Ord a => a -> a -> a
min
vmax :: (Ord n, Applicative a) => a n -> a n -> a n
{-# INLINE vmax #-}
vmax :: a n -> a n -> a n
vmax = (n -> n -> n) -> a n -> a n -> a n
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 n -> n -> n
forall a. Ord a => a -> a -> a
max
vabs :: (Num n, Functor a) => a n -> a n
{-# INLINE vabs #-}
vabs :: a n -> a n
vabs = (n -> n) -> a n -> a n
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap n -> n
forall a. Num a => a -> a
abs
vfloor :: (Functor a) => a Float -> a Int
{-# INLINE vfloor #-}
vfloor :: a Float -> a Int
vfloor = (Float -> Int) -> a Float -> a Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor
vceil :: (Functor a) => a Float -> a Int
{-# INLINE vceil #-}
vceil :: a Float -> a Int
vceil = (Float -> Int) -> a Float -> a Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling
clampPoint :: Point -> Point -> Point -> Point
{-# INLINE clampPoint #-}
clampPoint :: Point -> Point -> Point -> Point
clampPoint Point
mini Point
maxi Point
v = Point -> Point -> Point
forall n (a :: * -> *). (Ord n, Applicative a) => a n -> a n -> a n
vmin Point
maxi (Point -> Point) -> Point -> Point
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Point
forall n (a :: * -> *). (Ord n, Applicative a) => a n -> a n -> a n
vmax Point
mini Point
v
midPoint :: (Additive a, Fractional coord) => a coord -> a coord -> a coord
{-# INLINE midPoint #-}
midPoint :: a coord -> a coord -> a coord
midPoint a coord
a a coord
b = (a coord
a a coord -> a coord -> a coord
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ a coord
b) a coord -> coord -> a coord
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* coord
0.5
middle :: (Fractional a) => a -> a -> a
{-# INLINE middle #-}
middle :: a -> a -> a
middle a
a a
b = (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
b) a -> a -> a
forall a. Num a => a -> a -> a
* a
0.5
vpartition :: (Applicative a) => a Bool -> a v -> a v -> a v
{-# INLINE vpartition #-}
vpartition :: a Bool -> a v -> a v -> a v
vpartition = (Bool -> v -> v -> v) -> a Bool -> a v -> a v -> a v
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Bool -> v -> v -> v
forall p. Bool -> p -> p -> p
choose
where choose :: Bool -> p -> p -> p
choose Bool
True p
a p
_ = p
a
choose Bool
False p
_ p
b = p
b
normal :: (Floating v, Epsilon v) => V2 v -> V2 v -> V2 v
{-# INLINE normal #-}
normal :: V2 v -> V2 v -> V2 v
normal (V2 v
ax v
ay) (V2 v
bx v
by) = V2 v -> V2 v
forall a (f :: * -> *).
(Floating a, Metric f, Epsilon a) =>
f a -> f a
normalize (V2 v -> V2 v) -> V2 v -> V2 v
forall a b. (a -> b) -> a -> b
$ v -> v -> V2 v
forall a. a -> a -> V2 a
V2 (v
ay v -> v -> v
forall a. Num a => a -> a -> a
- v
by) (v
bx v -> v -> v
forall a. Num a => a -> a -> a
- v
ax)
ifZero :: (Epsilon v) => v -> v -> v
{-# INLINE ifZero #-}
ifZero :: v -> v -> v
ifZero v
u v
v | v -> Bool
forall a. Epsilon a => a -> Bool
nearZero v
u = v
v
| Bool
otherwise = v
u
isNearby :: Point -> Point -> Bool
{-# INLINE isNearby #-}
isNearby :: Point -> Point -> Bool
isNearby Point
p1 Point
p2 =
Float
squareDist Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.0001 Bool -> Bool -> Bool
||
Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
squareDist Bool -> Bool -> Bool
|| Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
squareDist
where vec :: Point
vec = Point
p1 Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
p2
squareDist :: Float
squareDist = Point
vec Point -> Point -> Float
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` Point
vec
isDegenerate :: Point -> Bool
isDegenerate :: Point -> Bool
isDegenerate (V2 Float
x Float
y) =
Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
x Bool -> Bool -> Bool
|| Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
y Bool -> Bool -> Bool
|| Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
x Bool -> Bool -> Bool
|| Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
y
isDistingableFrom :: Point -> Point -> Bool
{-# INLINE isDistingableFrom #-}
isDistingableFrom :: Point -> Point -> Bool
isDistingableFrom Point
a Point
b = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Bool
isNearby Point
a Point
b