{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Geomancy.Gl.Funs
  ( GlClamp(..)
  , glSaturate

  , GlStep(..)
  , normRange
  , smoothstepPoly
  , smootherstepPoly

  , GlNearest(..)
  , glFract

  , GlMod(..)
  , GlModf(..)

  , GlMix(..)
  ) where

import Geomancy.Elementwise (Element, Elementwise(..))
import Geomancy.Interpolate (linear, linearE)

class GlClamp edge a where
  glMin :: a -> edge -> a
  glMax :: a -> edge -> a
  glClamp :: a -> edge -> edge -> a

  glClamp a
x edge
minVal = a -> edge -> a
forall edge a. GlClamp edge a => a -> edge -> a
glMin (a -> edge -> a
forall edge a. GlClamp edge a => a -> edge -> a
glMax a
x edge
minVal)

instance {-# OVERLAPS #-} GlClamp Float Float where
  glMin :: Float -> Float -> Float
glMin = Float -> Float -> Float
forall a. Ord a => a -> a -> a
min
  glMax :: Float -> Float -> Float
glMax = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max

instance (Element v ~ Float, Elementwise v) => GlClamp Float v where
  {-# INLINE glMin #-}
  glMin :: v -> Float -> v
glMin v
a Float
b = (Element v -> Element v -> Element v) -> v -> v -> v
forall a.
Elementwise a =>
(Element a -> Element a -> Element a) -> a -> a -> a
emap2 Element v -> Element v -> Element v
forall edge a. GlClamp edge a => a -> edge -> a
glMin v
a (Element v -> v
forall a. Elementwise a => Element a -> a
epoint Float
Element v
b)

  {-# INLINE glMax #-}
  glMax :: v -> Float -> v
glMax v
a Float
b = (Element v -> Element v -> Element v) -> v -> v -> v
forall a.
Elementwise a =>
(Element a -> Element a -> Element a) -> a -> a -> a
emap2 Element v -> Element v -> Element v
forall edge a. GlClamp edge a => a -> edge -> a
glMax v
a (Element v -> v
forall a. Elementwise a => Element a -> a
epoint Float
Element v
b)

instance (Element v ~ Float, Elementwise v) => GlClamp v v where
  {-# INLINE glMin #-}
  glMin :: v -> v -> v
glMin = (Element v -> Element v -> Element v) -> v -> v -> v
forall a.
Elementwise a =>
(Element a -> Element a -> Element a) -> a -> a -> a
emap2 Element v -> Element v -> Element v
forall edge a. GlClamp edge a => a -> edge -> a
glMin

  {-# INLINE glMax #-}
  glMax :: v -> v -> v
glMax = (Element v -> Element v -> Element v) -> v -> v -> v
forall a.
Elementwise a =>
(Element a -> Element a -> Element a) -> a -> a -> a
emap2 Element v -> Element v -> Element v
forall edge a. GlClamp edge a => a -> edge -> a
glMax

glSaturate :: forall a . (GlClamp a a, Num a) => a -> a
glSaturate :: a -> a
glSaturate a
x = a -> a -> a -> a
forall edge a. GlClamp edge a => a -> edge -> edge -> a
glClamp @a a
x a
0 a
1

class GlClamp edge a => GlStep edge a where
  glStep :: edge -> a -> a
  glSmoothstep :: edge -> edge -> a -> a
  glSmootherstep :: edge -> edge -> a -> a

instance (Element v ~ Float, Elementwise v) => GlStep Float v where
  glStep :: Float -> v -> v
glStep Float
edge = (Element v -> Element v -> Element v) -> v -> v -> v
forall a.
Elementwise a =>
(Element a -> Element a -> Element a) -> a -> a -> a
emap2 Element v -> Element v -> Element v
forall edge a. GlStep edge a => edge -> a -> a
glStep (Element v -> v
forall a. Elementwise a => Element a -> a
epoint Float
Element v
edge)
  glSmoothstep :: Float -> Float -> v -> v
glSmoothstep Float
edge0 Float
edge1 = (Element v -> Element v -> Element v -> Element v)
-> v -> v -> v -> v
forall a.
Elementwise a =>
(Element a -> Element a -> Element a -> Element a)
-> a -> a -> a -> a
emap3 Element v -> Element v -> Element v -> Element v
forall edge a. GlStep edge a => edge -> edge -> a -> a
glSmoothstep (Element v -> v
forall a. Elementwise a => Element a -> a
epoint Float
Element v
edge0) (Element v -> v
forall a. Elementwise a => Element a -> a
epoint Float
Element v
edge1)
  glSmootherstep :: Float -> Float -> v -> v
glSmootherstep Float
edge0 Float
edge1 = (Element v -> Element v -> Element v -> Element v)
-> v -> v -> v -> v
forall a.
Elementwise a =>
(Element a -> Element a -> Element a -> Element a)
-> a -> a -> a -> a
emap3 Element v -> Element v -> Element v -> Element v
forall edge a. GlStep edge a => edge -> edge -> a -> a
glSmootherstep (Element v -> v
forall a. Elementwise a => Element a -> a
epoint Float
Element v
edge0) (Element v -> v
forall a. Elementwise a => Element a -> a
epoint Float
Element v
edge1)

instance (Element v ~ Float, Elementwise v) => GlStep v v where
  glStep :: v -> v -> v
glStep = (Element v -> Element v -> Element v) -> v -> v -> v
forall a.
Elementwise a =>
(Element a -> Element a -> Element a) -> a -> a -> a
emap2 Element v -> Element v -> Element v
forall edge a. GlStep edge a => edge -> a -> a
glStep
  glSmoothstep :: v -> v -> v -> v
glSmoothstep = (Element v -> Element v -> Element v -> Element v)
-> v -> v -> v -> v
forall a.
Elementwise a =>
(Element a -> Element a -> Element a -> Element a)
-> a -> a -> a -> a
emap3 Element v -> Element v -> Element v -> Element v
forall edge a. GlStep edge a => edge -> edge -> a -> a
glSmoothstep
  glSmootherstep :: v -> v -> v -> v
glSmootherstep = (Element v -> Element v -> Element v -> Element v)
-> v -> v -> v -> v
forall a.
Elementwise a =>
(Element a -> Element a -> Element a -> Element a)
-> a -> a -> a -> a
emap3 Element v -> Element v -> Element v -> Element v
forall edge a. GlStep edge a => edge -> edge -> a -> a
glSmootherstep

instance {-# OVERLAPS #-} GlStep Float Float where
  {-# INLINE glStep #-}
  glStep :: Float -> Float -> Float
glStep Float
edge Float
x =
    if Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
edge then
      Float
0
    else
      Float
1

  glSmoothstep :: Float -> Float -> Float -> Float
glSmoothstep Float
edge0 Float
edge1 Float
x =
    Float -> Float
forall a. Num a => a -> a
smoothstepPoly (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. (GlClamp a a, Num a) => a -> a
glSaturate (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$
      Float -> Float -> Float -> Float
forall a. Fractional a => a -> a -> a -> a
normRange Float
edge0 Float
edge1 Float
x

  glSmootherstep :: Float -> Float -> Float -> Float
glSmootherstep Float
edge0 Float
edge1 Float
x =
    Float -> Float
forall a. Num a => a -> a
smootherstepPoly (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. (GlClamp a a, Num a) => a -> a
glSaturate (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$
      Float -> Float -> Float -> Float
forall a. Fractional a => a -> a -> a -> a
normRange Float
edge0 Float
edge1 Float
x

{-# INLINE normRange #-}
normRange :: Fractional a => a -> a -> a -> a
normRange :: a -> a -> a -> a
normRange a
edge0 a
edge1 a
x = (a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
edge0) a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
edge1 a -> a -> a
forall a. Num a => a -> a -> a
- a
edge0)

{-# INLINE smoothstepPoly #-}
smoothstepPoly :: Num a => a -> a
smoothstepPoly :: a -> a
smoothstepPoly a
t = a
t a -> a -> a
forall a. Num a => a -> a -> a
* a
t a -> a -> a
forall a. Num a => a -> a -> a
* (a
3 a -> a -> a
forall a. Num a => a -> a -> a
- a
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
t)

{-# INLINE smootherstepPoly #-}
smootherstepPoly :: Num a => a -> a
smootherstepPoly :: a -> a
smootherstepPoly a
t = a
t a -> a -> a
forall a. Num a => a -> a -> a
* a
t a -> a -> a
forall a. Num a => a -> a -> a
* a
t a -> a -> a
forall a. Num a => a -> a -> a
* (a
t a -> a -> a
forall a. Num a => a -> a -> a
* (a
t a -> a -> a
forall a. Num a => a -> a -> a
* a
6 a -> a -> a
forall a. Num a => a -> a -> a
- a
15) a -> a -> a
forall a. Num a => a -> a -> a
+ a
10)

class GlNearest a where
  glCeil  :: a -> a
  glFloor :: a -> a
  glRound :: a -> a
  glTrunc :: a -> a

  default glCeil :: (Elementwise a, Element a ~ Float) => a -> a
  glCeil = (Element a -> Element a) -> a -> a
forall a. Elementwise a => (Element a -> Element a) -> a -> a
emap Element a -> Element a
forall a. GlNearest a => a -> a
glCeil

  default glFloor :: (Elementwise a, Element a ~ Float) => a -> a
  glFloor = (Element a -> Element a) -> a -> a
forall a. Elementwise a => (Element a -> Element a) -> a -> a
emap Element a -> Element a
forall a. GlNearest a => a -> a
glFloor

  default glRound :: (Elementwise a, Element a ~ Float) => a -> a
  glRound = (Element a -> Element a) -> a -> a
forall a. Elementwise a => (Element a -> Element a) -> a -> a
emap Element a -> Element a
forall a. GlNearest a => a -> a
glRound

  default glTrunc :: (Elementwise a, Element a ~ Float) => a -> a
  glTrunc = (Element a -> Element a) -> a -> a
forall a. Elementwise a => (Element a -> Element a) -> a -> a
emap Element a -> Element a
forall a. GlNearest a => a -> a
glTrunc

instance GlNearest Float where
  {-# INLINE glCeil #-}
  glCeil :: Float -> Float
glCeil  = Integer -> Float
forall a. Num a => Integer -> a
fromInteger (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling

  {-# INLINE glFloor #-}
  glFloor :: Float -> Float
glFloor = Integer -> Float
forall a. Num a => Integer -> a
fromInteger (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor

  {-# INLINE glRound #-}
  glRound :: Float -> Float
glRound = Integer -> Float
forall a. Num a => Integer -> a
fromInteger (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round

  {-# INLINE glTrunc #-}
  glTrunc :: Float -> Float
glTrunc = Integer -> Float
forall a. Num a => Integer -> a
fromInteger (Integer -> Float) -> (Float -> Integer) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate

{-# INLINE glFract #-}
glFract :: (Num a, GlNearest a) => a -> a
glFract :: a -> a
glFract a
x = a
x a -> a -> a
forall a. Num a => a -> a -> a
- a -> a
forall a. GlNearest a => a -> a
glFloor a
x

class GlModf i f where
  glModf :: f -> (i, f)

instance GlModf Integer Float where
  {-# INLINE glModf #-}
  glModf :: Float -> (Integer, Float)
glModf Float
x =
    let
      integral :: Integer
integral = Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor Float
x
    in
      (Integer
integral, Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
- Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
integral)

instance GlModf Float Float where
  {-# INLINE glModf #-}
  glModf :: Float -> (Float, Float)
glModf Float
x = (Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
i, Float
f)
    where
      (Integer
i, Float
f) = Float -> (Integer, Float)
forall i f. GlModf i f => f -> (i, f)
glModf Float
x

class GlMod x y where
  glMod :: x -> y -> x

instance GlMod Float Float where
  {-# INLINE glMod #-}
  glMod :: Float -> Float -> Float
glMod Float
x Float
y = Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float
forall a. GlNearest a => a -> a
glFloor (Float
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
y)

class GlMix alpha x where
  glMix :: x -> x -> alpha -> x

instance {-# OVERLAPS #-} GlMix Float Float where
  {-# INLINE glMix #-}
  glMix :: Float -> Float -> Float -> Float
glMix = Float -> Float -> Float -> Float
forall v a. VectorSpace v a => v -> v -> a -> v
linear

instance (Element v ~ Float, Elementwise v) => GlMix Float v where
  {-# INLINE glMix #-}
  glMix :: v -> v -> Float -> v
glMix v
a v
b Float
t = v -> v -> v -> v
forall v. (Elementwise v, Element v ~ Float) => v -> v -> v -> v
linearE v
a v
b (Element v -> v
forall a. Elementwise a => Element a -> a
epoint Float
Element v
t)

instance (Element v ~ Float, Elementwise v) => GlMix v v where
  {-# INLINE glMix #-}
  glMix :: v -> v -> v -> v
glMix = v -> v -> v -> v
forall v. (Elementwise v, Element v ~ Float) => v -> v -> v -> v
linearE