module Language.GLSL.Runtime.PrimFuns where
import Control.Monad ((>=>))
import Language.GLSL.Runtime.Math (floor, fract, mod, smoothstep,
step)
import Language.GLSL.Runtime.Value (Eval, Value (..), evalCoerce)
import Language.GLSL.Types (FunName (..), Type (..), pp,
ppFunName)
import Linear
import Prelude hiding (floor, mod)
flt :: Value -> Eval Float
flt :: Value -> Eval Float
flt = Type -> Value -> Eval Value
evalCoerce Type
TyFloat (Value -> Eval Value)
-> (Value -> Eval Float) -> Value -> Eval Float
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Value -> Eval Float
forall (f :: * -> *). MonadFail f => Value -> f Float
convert
where
convert :: Value -> f Float
convert (FloatValue Float
v) = Float -> f Float
forall (f :: * -> *) a. Applicative f => a -> f a
pure Float
v
convert Value
v = String -> f Float
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> f Float) -> String -> f Float
forall a b. (a -> b) -> a -> b
$ String
"not a Float value: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
v
v4 :: Value -> Eval (V4 Float)
v4 :: Value -> Eval (V4 Float)
v4 = Type -> Value -> Eval Value
evalCoerce (Int -> Type
TyVec Int
4) (Value -> Eval Value)
-> (Value -> Eval (V4 Float)) -> Value -> Eval (V4 Float)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Value -> Eval (V4 Float)
forall (f :: * -> *). MonadFail f => Value -> f (V4 Float)
convert
where
convert :: Value -> f (V4 Float)
convert (Vec4Value V4 Float
v) = V4 Float -> f (V4 Float)
forall (f :: * -> *) a. Applicative f => a -> f a
pure V4 Float
v
convert Value
v = String -> f (V4 Float)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> f (V4 Float)) -> String -> f (V4 Float)
forall a b. (a -> b) -> a -> b
$ String
"not a V4 value: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
v
eval :: FunName -> [Value] -> Eval Value
eval :: FunName -> [Value] -> Eval Value
eval FunName
PrimVec2 [Value
x, Value
y] =
(V2 Float -> Value)
-> StateT EvalState EvalResult (V2 Float) -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap V2 Float -> Value
Vec2Value (StateT EvalState EvalResult (V2 Float) -> Eval Value)
-> StateT EvalState EvalResult (V2 Float) -> Eval Value
forall a b. (a -> b) -> a -> b
$ Float -> Float -> V2 Float
forall a. a -> a -> V2 a
V2
(Float -> Float -> V2 Float)
-> Eval Float -> StateT EvalState EvalResult (Float -> V2 Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Eval Float
flt Value
x
StateT EvalState EvalResult (Float -> V2 Float)
-> Eval Float -> StateT EvalState EvalResult (V2 Float)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Eval Float
flt Value
y
eval FunName
PrimVec3 [Value
x, Value
y, Value
z] =
(V3 Float -> Value)
-> StateT EvalState EvalResult (V3 Float) -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap V3 Float -> Value
Vec3Value (StateT EvalState EvalResult (V3 Float) -> Eval Value)
-> StateT EvalState EvalResult (V3 Float) -> Eval Value
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> V3 Float
forall a. a -> a -> a -> V3 a
V3
(Float -> Float -> Float -> V3 Float)
-> Eval Float
-> StateT EvalState EvalResult (Float -> Float -> V3 Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Eval Float
flt Value
x
StateT EvalState EvalResult (Float -> Float -> V3 Float)
-> Eval Float -> StateT EvalState EvalResult (Float -> V3 Float)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Eval Float
flt Value
y
StateT EvalState EvalResult (Float -> V3 Float)
-> Eval Float -> StateT EvalState EvalResult (V3 Float)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Eval Float
flt Value
z
eval FunName
PrimVec4 [Value
x, Value
y, Value
z, Value
w] =
(V4 Float -> Value) -> Eval (V4 Float) -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap V4 Float -> Value
Vec4Value (Eval (V4 Float) -> Eval Value) -> Eval (V4 Float) -> Eval Value
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> V4 Float
forall a. a -> a -> a -> a -> V4 a
V4
(Float -> Float -> Float -> Float -> V4 Float)
-> Eval Float
-> StateT
EvalState EvalResult (Float -> Float -> Float -> V4 Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Eval Float
flt Value
x
StateT EvalState EvalResult (Float -> Float -> Float -> V4 Float)
-> Eval Float
-> StateT EvalState EvalResult (Float -> Float -> V4 Float)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Eval Float
flt Value
y
StateT EvalState EvalResult (Float -> Float -> V4 Float)
-> Eval Float -> StateT EvalState EvalResult (Float -> V4 Float)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Eval Float
flt Value
z
StateT EvalState EvalResult (Float -> V4 Float)
-> Eval Float -> Eval (V4 Float)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Eval Float
flt Value
w
eval FunName
PrimMat4x4 [Value
x, Value
y, Value
z, Value
w] =
(M44 Float -> Value)
-> StateT EvalState EvalResult (M44 Float) -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap M44 Float -> Value
Mat4x4Value (StateT EvalState EvalResult (M44 Float) -> Eval Value)
-> StateT EvalState EvalResult (M44 Float) -> Eval Value
forall a b. (a -> b) -> a -> b
$ V4 Float -> V4 Float -> V4 Float -> V4 Float -> M44 Float
forall a. a -> a -> a -> a -> V4 a
V4
(V4 Float -> V4 Float -> V4 Float -> V4 Float -> M44 Float)
-> Eval (V4 Float)
-> StateT
EvalState
EvalResult
(V4 Float -> V4 Float -> V4 Float -> M44 Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Eval (V4 Float)
v4 Value
x
StateT
EvalState
EvalResult
(V4 Float -> V4 Float -> V4 Float -> M44 Float)
-> Eval (V4 Float)
-> StateT EvalState EvalResult (V4 Float -> V4 Float -> M44 Float)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Eval (V4 Float)
v4 Value
y
StateT EvalState EvalResult (V4 Float -> V4 Float -> M44 Float)
-> Eval (V4 Float)
-> StateT EvalState EvalResult (V4 Float -> M44 Float)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Eval (V4 Float)
v4 Value
z
StateT EvalState EvalResult (V4 Float -> M44 Float)
-> Eval (V4 Float) -> StateT EvalState EvalResult (M44 Float)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Eval (V4 Float)
v4 Value
w
eval FunName
PrimLength [Vec2Value V2 Float
a] = Value -> Eval Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Eval Value) -> Value -> Eval Value
forall a b. (a -> b) -> a -> b
$ Float -> Value
FloatValue (Float -> Value) -> Float -> Value
forall a b. (a -> b) -> a -> b
$ V2 Float -> Float
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm V2 Float
a
eval FunName
PrimLength [Vec3Value V3 Float
a] = Value -> Eval Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Eval Value) -> Value -> Eval Value
forall a b. (a -> b) -> a -> b
$ Float -> Value
FloatValue (Float -> Value) -> Float -> Value
forall a b. (a -> b) -> a -> b
$ V3 Float -> Float
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm V3 Float
a
eval FunName
PrimLength [Vec4Value V4 Float
a] = Value -> Eval Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Eval Value) -> Value -> Eval Value
forall a b. (a -> b) -> a -> b
$ Float -> Value
FloatValue (Float -> Value) -> Float -> Value
forall a b. (a -> b) -> a -> b
$ V4 Float -> Float
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm V4 Float
a
eval FunName
PrimNormalize [Vec2Value V2 Float
a] = Value -> Eval Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Eval Value) -> Value -> Eval Value
forall a b. (a -> b) -> a -> b
$ V2 Float -> Value
Vec2Value (V2 Float -> Value) -> V2 Float -> Value
forall a b. (a -> b) -> a -> b
$ V2 Float -> V2 Float
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm V2 Float
a
eval FunName
PrimNormalize [Vec3Value V3 Float
a] = Value -> Eval Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Eval Value) -> Value -> Eval Value
forall a b. (a -> b) -> a -> b
$ V3 Float -> Value
Vec3Value (V3 Float -> Value) -> V3 Float -> Value
forall a b. (a -> b) -> a -> b
$ V3 Float -> V3 Float
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm V3 Float
a
eval FunName
PrimNormalize [Vec4Value V4 Float
a] = Value -> Eval Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Eval Value) -> Value -> Eval Value
forall a b. (a -> b) -> a -> b
$ V4 Float -> Value
Vec4Value (V4 Float -> Value) -> V4 Float -> Value
forall a b. (a -> b) -> a -> b
$ V4 Float -> V4 Float
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm V4 Float
a
eval FunName
PrimSqrt [Value
a] = Float -> Value
FloatValue (Float -> Value) -> (Float -> Float) -> Float -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Floating a => a -> a
sqrt (Float -> Value) -> Eval Float -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Eval Float
flt Value
a
eval FunName
PrimSin [Value
a] = Float -> Value
FloatValue (Float -> Value) -> (Float -> Float) -> Float -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Floating a => a -> a
sin (Float -> Value) -> Eval Float -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Eval Float
flt Value
a
eval FunName
PrimAsin [Value
a] = Float -> Value
FloatValue (Float -> Value) -> (Float -> Float) -> Float -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Floating a => a -> a
asin (Float -> Value) -> Eval Float -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Eval Float
flt Value
a
eval FunName
PrimCos [Value
a] = Float -> Value
FloatValue (Float -> Value) -> (Float -> Float) -> Float -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Floating a => a -> a
cos (Float -> Value) -> Eval Float -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Eval Float
flt Value
a
eval FunName
PrimAbs [Value
a] = Float -> Value
FloatValue (Float -> Value) -> (Float -> Float) -> Float -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Value) -> Eval Float -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Eval Float
flt Value
a
eval FunName
PrimFloor [Value
a] = Float -> Value
FloatValue (Float -> Value) -> (Float -> Float) -> Float -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
floor (Float -> Value) -> Eval Float -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Eval Float
flt Value
a
eval FunName
PrimFract [Value
a] = Float -> Value
FloatValue (Float -> Value) -> (Float -> Float) -> Float -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
fract (Float -> Value) -> Eval Float -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Eval Float
flt Value
a
eval FunName
PrimMod [Value
a,Value
b] = (Float -> Value) -> Eval Float -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Value
FloatValue (Eval Float -> Eval Value) -> Eval Float -> Eval Value
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float
mod (Float -> Float -> Float)
-> Eval Float -> StateT EvalState EvalResult (Float -> Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Eval Float
flt Value
a StateT EvalState EvalResult (Float -> Float)
-> Eval Float -> Eval Float
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Eval Float
flt Value
b
eval FunName
PrimAtan [Value
a,Value
b] = (Float -> Value) -> Eval Float -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Value
FloatValue (Eval Float -> Eval Value) -> Eval Float -> Eval Value
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float
forall a. RealFloat a => a -> a -> a
atan2 (Float -> Float -> Float)
-> Eval Float -> StateT EvalState EvalResult (Float -> Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Eval Float
flt Value
a StateT EvalState EvalResult (Float -> Float)
-> Eval Float -> Eval Float
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Eval Float
flt Value
b
eval FunName
PrimSmoothstep [Value
a,Value
b,Value
c] = (Float -> Value) -> Eval Float -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Value
FloatValue (Eval Float -> Eval Value) -> Eval Float -> Eval Value
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float
smoothstep (Float -> Float -> Float -> Float)
-> Eval Float
-> StateT EvalState EvalResult (Float -> Float -> Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Eval Float
flt Value
a StateT EvalState EvalResult (Float -> Float -> Float)
-> Eval Float -> StateT EvalState EvalResult (Float -> Float)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Eval Float
flt Value
b StateT EvalState EvalResult (Float -> Float)
-> Eval Float -> Eval Float
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Eval Float
flt Value
c
eval FunName
PrimStep [Value
a,Value
b] = (Float -> Value) -> Eval Float -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Value
FloatValue (Eval Float -> Eval Value) -> Eval Float -> Eval Value
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float
step (Float -> Float -> Float)
-> Eval Float -> StateT EvalState EvalResult (Float -> Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Eval Float
flt Value
a StateT EvalState EvalResult (Float -> Float)
-> Eval Float -> Eval Float
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Eval Float
flt Value
b
eval FunName
fun [Value]
_ = String -> Eval Value
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Eval Value) -> String -> Eval Value
forall a b. (a -> b) -> a -> b
$ String
"primfun not implemented: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (FunName -> Builder) -> FunName -> String
forall a. (a -> Builder) -> a -> String
pp FunName -> Builder
ppFunName FunName
fun