{-# 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