{-# 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 = forall edge a. GlClamp edge a => a -> edge -> a
glMin (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 = forall a. Ord a => a -> a -> a
min
  glMax :: Float -> Float -> Float
glMax = 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 = forall a.
Elementwise a =>
(Element a -> Element a -> Element a) -> a -> a -> a
emap2 forall edge a. GlClamp edge a => a -> edge -> a
glMin v
a (forall a. Elementwise a => Element a -> a
epoint Float
b)

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

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

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

glSaturate :: forall a . (GlClamp a a, Num a) => a -> a
glSaturate :: forall a. (GlClamp a a, Num a) => a -> a
glSaturate a
x = 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 = forall a.
Elementwise a =>
(Element a -> Element a -> Element a) -> a -> a -> a
emap2 forall edge a. GlStep edge a => edge -> a -> a
glStep (forall a. Elementwise a => Element a -> a
epoint Float
edge)
  glSmoothstep :: Float -> Float -> v -> v
glSmoothstep Float
edge0 Float
edge1 = forall a.
Elementwise a =>
(Element a -> Element a -> Element a -> Element a)
-> a -> a -> a -> a
emap3 forall edge a. GlStep edge a => edge -> edge -> a -> a
glSmoothstep (forall a. Elementwise a => Element a -> a
epoint Float
edge0) (forall a. Elementwise a => Element a -> a
epoint Float
edge1)
  glSmootherstep :: Float -> Float -> v -> v
glSmootherstep Float
edge0 Float
edge1 = forall a.
Elementwise a =>
(Element a -> Element a -> Element a -> Element a)
-> a -> a -> a -> a
emap3 forall edge a. GlStep edge a => edge -> edge -> a -> a
glSmootherstep (forall a. Elementwise a => Element a -> a
epoint Float
edge0) (forall a. Elementwise a => Element a -> a
epoint Float
edge1)

instance (Element v ~ Float, Elementwise v) => GlStep v v where
  glStep :: v -> v -> v
glStep = forall a.
Elementwise a =>
(Element a -> Element a -> Element a) -> a -> a -> a
emap2 forall edge a. GlStep edge a => edge -> a -> a
glStep
  glSmoothstep :: v -> v -> v -> v
glSmoothstep = forall a.
Elementwise a =>
(Element a -> Element a -> Element a -> Element a)
-> a -> a -> a -> a
emap3 forall edge a. GlStep edge a => edge -> edge -> a -> a
glSmoothstep
  glSmootherstep :: v -> v -> v -> v
glSmootherstep = forall a.
Elementwise a =>
(Element a -> Element a -> Element a -> Element a)
-> a -> a -> a -> a
emap3 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 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 =
    forall a. Num a => a -> a
smoothstepPoly forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (GlClamp a a, Num a) => a -> a
glSaturate forall a b. (a -> b) -> a -> b
$
      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 =
    forall a. Num a => a -> a
smootherstepPoly forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (GlClamp a a, Num a) => a -> a
glSaturate forall a b. (a -> b) -> a -> b
$
      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 :: forall a. Fractional a => a -> a -> a -> a
normRange a
edge0 a
edge1 a
x = (a
x forall a. Num a => a -> a -> a
- a
edge0) forall a. Fractional a => a -> a -> a
/ (a
edge1 forall a. Num a => a -> a -> a
- a
edge0)

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

{-# INLINE smootherstepPoly #-}
smootherstepPoly :: Num a => a -> a
smootherstepPoly :: forall a. Num a => a -> a
smootherstepPoly a
t = a
t forall a. Num a => a -> a -> a
* a
t forall a. Num a => a -> a -> a
* a
t forall a. Num a => a -> a -> a
* (a
t forall a. Num a => a -> a -> a
* (a
t forall a. Num a => a -> a -> a
* a
6 forall a. Num a => a -> a -> a
- a
15) 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 = forall a. Elementwise a => (Element a -> Element a) -> a -> a
emap forall a. GlNearest a => a -> a
glCeil

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

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

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

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

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

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

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

{-# INLINE glFract #-}
glFract :: (Num a, GlNearest a) => a -> a
glFract :: forall a. (Num a, GlNearest a) => a -> a
glFract a
x = a
x forall a. Num 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 = forall a b. (RealFrac a, Integral b) => a -> b
floor Float
x
    in
      (Integer
integral, Float
x forall a. Num a => a -> a -> a
- 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 = (forall a. Num a => Integer -> a
fromInteger Integer
i, Float
f)
    where
      (Integer
i, Float
f) = 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 forall a. Num a => a -> a -> a
- Float
y forall a. Num a => a -> a -> a
* forall a. GlNearest a => a -> a
glFloor (Float
x 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 = forall v a. (VectorSpace v a, Num 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 = forall v. (Elementwise v, Element v ~ Float) => v -> v -> v -> v
linearE v
a v
b (forall a. Elementwise a => Element a -> a
epoint Float
t)

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