module Mischief.Materials.Fullscreen where

import Mischief.Materials
import Prelude ()

data Bindings f = Bindings deriving ((forall x. Bindings f -> Rep (Bindings f) x)
-> (forall x. Rep (Bindings f) x -> Bindings f)
-> Generic (Bindings f)
forall x. Rep (Bindings f) x -> Bindings f
forall x. Bindings f -> Rep (Bindings f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (f :: k) x. Rep (Bindings f) x -> Bindings f
forall k (f :: k) x. Bindings f -> Rep (Bindings f) x
$cfrom :: forall k (f :: k) x. Bindings f -> Rep (Bindings f) x
from :: forall x. Bindings f -> Rep (Bindings f) x
$cto :: forall k (f :: k) x. Rep (Bindings f) x -> Bindings f
to :: forall x. Rep (Bindings f) x -> Bindings f
Generic, Typeable Bindings
Typeable Bindings =>
(Nat -> Proxy (Bindings Internal) -> (Bindings, Nat))
-> (Nat
    -> Proxy (Bindings Internal) -> ([WGPUBindGroupLayoutEntry], Nat))
-> (Nat -> Bindings CPU -> ([WGPUBindGroupEntry], Nat))
-> (Nat -> (Bindings GPU, Nat))
-> Bindable Bindings
Nat -> (Bindings GPU, Nat)
Nat
-> Proxy (Bindings Internal) -> ([WGPUBindGroupLayoutEntry], Nat)
Nat -> Proxy (Bindings Internal) -> (Bindings, Nat)
Nat -> Bindings CPU -> ([WGPUBindGroupEntry], Nat)
forall (a :: * -> *).
Typeable a =>
(Nat -> Proxy (a Internal) -> (Bindings, Nat))
-> (Nat -> Proxy (a Internal) -> ([WGPUBindGroupLayoutEntry], Nat))
-> (Nat -> a CPU -> ([WGPUBindGroupEntry], Nat))
-> (Nat -> (a GPU, Nat))
-> Bindable a
$ccollectBindings :: Nat -> Proxy (Bindings Internal) -> (Bindings, Nat)
collectBindings :: Nat -> Proxy (Bindings Internal) -> (Bindings, Nat)
$ccollectLayouts :: Nat
-> Proxy (Bindings Internal) -> ([WGPUBindGroupLayoutEntry], Nat)
collectLayouts :: Nat
-> Proxy (Bindings Internal) -> ([WGPUBindGroupLayoutEntry], Nat)
$ccollectEntries :: Nat -> Bindings CPU -> ([WGPUBindGroupEntry], Nat)
collectEntries :: Nat -> Bindings CPU -> ([WGPUBindGroupEntry], Nat)
$cdummyBinding :: Nat -> (Bindings GPU, Nat)
dummyBinding :: Nat -> (Bindings GPU, Nat)
Bindable)

newtype VertexInput f = VertexInput (BuiltIn f "vertex_index" Uint)
  deriving stock ((forall x. VertexInput f -> Rep (VertexInput f) x)
-> (forall x. Rep (VertexInput f) x -> VertexInput f)
-> Generic (VertexInput f)
forall x. Rep (VertexInput f) x -> VertexInput f
forall x. VertexInput f -> Rep (VertexInput f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall f x. Rep (VertexInput f) x -> VertexInput f
forall f x. VertexInput f -> Rep (VertexInput f) x
$cfrom :: forall f x. VertexInput f -> Rep (VertexInput f) x
from :: forall x. VertexInput f -> Rep (VertexInput f) x
$cto :: forall f x. Rep (VertexInput f) x -> VertexInput f
to :: forall x. Rep (VertexInput f) x -> VertexInput f
Generic)
  deriving anyclass (Typeable (VertexInput GPU)
Params
ParamDefinition
VertexInput GPU
Typeable (VertexInput GPU) =>
Params
-> ParamDefinition
-> VertexInput GPU
-> (VertexInput GPU -> Values)
-> ShaderParam VertexInput
VertexInput GPU -> Values
forall (a :: * -> *).
Typeable (a GPU) =>
Params
-> ParamDefinition -> a GPU -> (a GPU -> Values) -> ShaderParam a
$ccollectParams :: Params
collectParams :: Params
$cparamDefinition :: ParamDefinition
paramDefinition :: ParamDefinition
$cdummyParam :: VertexInput GPU
dummyParam :: VertexInput GPU
$ccollectValues :: VertexInput GPU -> Values
collectValues :: VertexInput GPU -> Values
ShaderParam)

data VertexOutput f = VertexOutput
  { forall f. VertexOutput f -> BuiltIn f "position" (Vec 4 Float)
pos :: BuiltIn f "position" (Vec 4 Float),
    forall f. VertexOutput f -> Location f 0 (Vec 2 Float)
uv :: Location f 0 (Vec 2 Float)
  }
  deriving ((forall x. VertexOutput f -> Rep (VertexOutput f) x)
-> (forall x. Rep (VertexOutput f) x -> VertexOutput f)
-> Generic (VertexOutput f)
forall x. Rep (VertexOutput f) x -> VertexOutput f
forall x. VertexOutput f -> Rep (VertexOutput f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall f x. Rep (VertexOutput f) x -> VertexOutput f
forall f x. VertexOutput f -> Rep (VertexOutput f) x
$cfrom :: forall f x. VertexOutput f -> Rep (VertexOutput f) x
from :: forall x. VertexOutput f -> Rep (VertexOutput f) x
$cto :: forall f x. Rep (VertexOutput f) x -> VertexOutput f
to :: forall x. Rep (VertexOutput f) x -> VertexOutput f
Generic, Typeable (VertexOutput GPU)
Params
ParamDefinition
VertexOutput GPU
Typeable (VertexOutput GPU) =>
Params
-> ParamDefinition
-> VertexOutput GPU
-> (VertexOutput GPU -> Values)
-> ShaderParam VertexOutput
VertexOutput GPU -> Values
forall (a :: * -> *).
Typeable (a GPU) =>
Params
-> ParamDefinition -> a GPU -> (a GPU -> Values) -> ShaderParam a
$ccollectParams :: Params
collectParams :: Params
$cparamDefinition :: ParamDefinition
paramDefinition :: ParamDefinition
$cdummyParam :: VertexOutput GPU
dummyParam :: VertexOutput GPU
$ccollectValues :: VertexOutput GPU -> Values
collectValues :: VertexOutput GPU -> Values
ShaderParam)

-- | Material for rendering something to the whole screen.
data FullscreenMaterial

instance Material FullscreenMaterial where
  type VI FullscreenMaterial = VertexInput
  type VO FullscreenMaterial = VertexOutput
  type B FullscreenMaterial = Bindings

  vertex :: VertexInput GPU -> Shader FullscreenMaterial (VertexOutput GPU)
  vertex :: VertexInput GPU -> Shader FullscreenMaterial (VertexOutput GPU)
vertex (VertexInput BuiltIn GPU "vertex_index" (Expr ('Primitive 'TUInt))
index) = do
    positions <- Expr ('ArrayType (DesugarExpr (Vec 2 Float)))
-> Shader
     FullscreenMaterial (Expr ('ArrayType (DesugarExpr (Vec 2 Float))))
forall {k} (a :: Types) (m :: k).
SingI a =>
Expr a -> Shader m (Expr a)
var (Expr ('ArrayType (DesugarExpr (Vec 2 Float)))
 -> Shader
      FullscreenMaterial (Expr ('ArrayType (DesugarExpr (Vec 2 Float)))))
-> Expr ('ArrayType (DesugarExpr (Vec 2 Float)))
-> Shader
     FullscreenMaterial (Expr ('ArrayType (DesugarExpr (Vec 2 Float))))
forall a b. (a -> b) -> a -> b
$ forall a.
SingI (DesugarExpr a) =>
[Expr (DesugarExpr a)] -> Array a
array @(Vec 2 Float) [Expr ('Primitive (DesugarPrimitiveExpr Float))
-> Expr ('Primitive (DesugarPrimitiveExpr Float)) -> Vec 2 Float
forall a.
(Expr ('Primitive (DesugarPrimitiveExpr a)) ~ a,
 SingI (DesugarPrimitiveExpr a),
 PrintVecElements 2 (DesugarPrimitiveExpr a)) =>
Expr ('Primitive (DesugarPrimitiveExpr a))
-> Expr ('Primitive (DesugarPrimitiveExpr a)) -> Vec 2 a
vec2 (-Float
1) (-Float
1), Expr ('Primitive (DesugarPrimitiveExpr Float))
-> Expr ('Primitive (DesugarPrimitiveExpr Float)) -> Vec 2 Float
forall a.
(Expr ('Primitive (DesugarPrimitiveExpr a)) ~ a,
 SingI (DesugarPrimitiveExpr a),
 PrintVecElements 2 (DesugarPrimitiveExpr a)) =>
Expr ('Primitive (DesugarPrimitiveExpr a))
-> Expr ('Primitive (DesugarPrimitiveExpr a)) -> Vec 2 a
vec2 Float
Expr ('Primitive (DesugarPrimitiveExpr Float))
3 (-Float
1), Expr ('Primitive (DesugarPrimitiveExpr Float))
-> Expr ('Primitive (DesugarPrimitiveExpr Float)) -> Vec 2 Float
forall a.
(Expr ('Primitive (DesugarPrimitiveExpr a)) ~ a,
 SingI (DesugarPrimitiveExpr a),
 PrintVecElements 2 (DesugarPrimitiveExpr a)) =>
Expr ('Primitive (DesugarPrimitiveExpr a))
-> Expr ('Primitive (DesugarPrimitiveExpr a)) -> Vec 2 a
vec2 (-Float
1) Float
Expr ('Primitive (DesugarPrimitiveExpr Float))
3]
    let pos = Expr ('ArrayType (DesugarExpr (Expr ('VectorType 2 'TFloat))))
Expr ('ArrayType (DesugarExpr (Vec 2 Float)))
positions Expr ('ArrayType (DesugarExpr (Expr ('VectorType 2 'TFloat))))
-> Expr ('Primitive 'TUInt) -> Expr ('VectorType 2 'TFloat)
forall (a :: Types).
SingI a =>
Array (Expr a) -> Expr ('Primitive 'TUInt) -> Expr a
!! Expr ('Primitive 'TUInt)
BuiltIn GPU "vertex_index" (Expr ('Primitive 'TUInt))
index
    pure
      $ VertexOutput
        { pos = vec4 pos.x pos.y 0 1,
          uv = vec2 (pos.x * 0.5 + 0.5) (1.0 - (pos.y * 0.5 + 0.5))
        }

  fragment :: VertexOutput GPU -> Shader FullscreenMaterial (Vec 4 Float)
  fragment :: VertexOutput GPU -> Shader FullscreenMaterial (Vec 4 Float)
fragment VertexOutput GPU
_ = Vec 4 Float -> Shader FullscreenMaterial (Vec 4 Float)
forall a. a -> Shader FullscreenMaterial a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vec 4 Float -> Shader FullscreenMaterial (Vec 4 Float))
-> Vec 4 Float -> Shader FullscreenMaterial (Vec 4 Float)
forall a b. (a -> b) -> a -> b
$ Expr ('Primitive (DesugarPrimitiveExpr Float)) -> Vec 4 Float
forall (n :: Nat) (a :: PrimitiveTypes).
(n <= 4, KnownNat n, SingI a) =>
Expr ('Primitive a) -> Expr ('VectorType n a)
diag Float
Expr ('Primitive (DesugarPrimitiveExpr Float))
0

  fetch :: FetchBindings (B FullscreenMaterial)
fetch = (CameraEntity -> Query System ())
-> (CameraEntity -> Query System ())
-> (() -> () -> Bindings CPU)
-> FetchBindings Bindings
forall x y (b :: * -> *).
Bindable b =>
(CameraEntity -> Query System x)
-> (CameraEntity -> Query System y)
-> (x -> y -> b CPU)
-> FetchBindings b
FetchBindings (Query System () -> CameraEntity -> Query System ()
forall a b. a -> b -> a
const (Query System () -> CameraEntity -> Query System ())
-> Query System () -> CameraEntity -> Query System ()
forall a b. (a -> b) -> a -> b
$ () -> Query System ()
forall a. a -> Query System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Query System () -> CameraEntity -> Query System ()
forall a b. a -> b -> a
const (Query System () -> CameraEntity -> Query System ())
-> Query System () -> CameraEntity -> Query System ()
forall a b. (a -> b) -> a -> b
$ () -> Query System ()
forall a. a -> Query System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ((() -> Bindings CPU) -> () -> () -> Bindings CPU
forall a b. a -> b -> a
const ((() -> Bindings CPU) -> () -> () -> Bindings CPU)
-> (() -> Bindings CPU) -> () -> () -> Bindings CPU
forall a b. (a -> b) -> a -> b
$ Bindings CPU -> () -> Bindings CPU
forall a b. a -> b -> a
const Bindings CPU
forall {k} (f :: k). Bindings f
Bindings)