-- | Module providing basic helper functions to help

-- build vector/point calculations.

module Graphics.Rasterific.Operators
    ( Point
      -- * Lifted operators

    , (^&&^)
    , (^||^)
    , (^==^)
    , (^/=^)
    , (^<=^)
    , (^<^)
    , (^<)

      -- *  Lifted functions

    , 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 ^||^

-- | Represent a point

type Point = V2 Float

-- | Pairwise boolean and operator

(^&&^) :: (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
(&&)

-- | Pairwise boolean or operator

(^||^) :: (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
(||)

-- | Pairwise vector/point equal operator

(^==^) :: (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
(==)

-- | Pairwise vector/point lower than or equal operator

(^<=^) :: (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
(<=)

-- | Pairwise vector/point lower than operator

(^<^) :: (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
(<)

-- | Component/scalar lower than operator.

(^<) :: (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

-- | Pairwise vector/point difference operator.

(^/=^) :: (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
(/=)

-- | Min function between two vector/points.

-- Work on every component separately.

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

-- | Max function between to vector/point.

-- Work on every component separatly.

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

-- | Abs function for every component of the vector/point.

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

-- | Floor function for every component of the vector/point.

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

-- | ceil function for every component of the vector/point.

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

-- | Given a point, clamp every coordinates between

-- a given minimum and maximum.

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

-- | Given two points, return a point in the middle

-- of them.

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

-- | Given a boolean choice vector, return elements of

-- the first one if true, of the second one otherwise.

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

-- | Calculate a normal vector

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)

-- | Return the second operand if the vector is

-- nearly null

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

-- | Tell if two points are nearly indistinguishable.

-- If indistinguishable, we can treat them as the same

-- point.

-- point with degenerate coordinates (Infinity/NaN) will be considered

-- as nearby.

isNearby :: Point -> Point -> Bool
{-# INLINE isNearby #-}
isNearby :: Point -> Point -> Bool
isNearby Point
p1 Point
p2 =
    -- we keep really small distances because when drawing geometry

    -- (possibly scaled) from a large model, every small line account

    -- to the coverage, and discarding "small" lines will make artifact

    -- because we didn't count coverage correctly.

    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 -- degenerate case protection

  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

-- | simply `not (a `isNearby` b)`

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