module Render.Unlit.Colored.Pipeline
  ( Pipeline
  , allocate
  , allocateWireframe
  ) where

import RIO

import Control.Monad.Trans.Resource (ResourceT)
import Data.Tagged (Tagged(..))
import Vulkan.Core10 qualified as Vk
import Vulkan.Zero (zero)

import Engine.Vulkan.Pipeline qualified as Pipeline
import Engine.Vulkan.Types (HasVulkan, HasRenderPass(..), DsBindings)
import Render.Code (compileVert, compileFrag, glsl)
import Render.DescSets.Set0 (Scene, vertexPos, instanceTransform)
import Render.DescSets.Set0.Code (set0binding0)
import Render.Unlit.Colored.Model qualified as Model

type Config = Pipeline.Config '[Scene] Model.VertexAttrs Model.InstanceAttrs
type Pipeline = Pipeline.Pipeline '[Scene] Model.VertexAttrs Model.InstanceAttrs

allocate
  :: ( HasVulkan env
     , HasRenderPass renderpass
     )
  => Bool
  -> Vk.SampleCountFlagBits
  -> Tagged Scene DsBindings
  -> renderpass
  -> ResourceT (RIO env) Pipeline
allocate :: Bool
-> SampleCountFlagBits
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
allocate Bool
useDepth SampleCountFlagBits
multisample Tagged Scene DsBindings
tset0 renderpass
rp = do
  (ReleaseKey
_, Pipeline
p) <- Maybe Extent2D
-> SampleCountFlagBits
-> Config '[Scene] VertexAttrs InstanceAttrs
-> renderpass
-> ResourceT (RIO env) (ReleaseKey, Pipeline)
forall env (m :: * -> *) renderpass (dsl :: [*]) vertices
       instances.
(MonadVulkan env m, MonadResource m, HasRenderPass renderpass,
 HasCallStack) =>
Maybe Extent2D
-> SampleCountFlagBits
-> Config dsl vertices instances
-> renderpass
-> m (ReleaseKey, Pipeline dsl vertices instances)
Pipeline.allocate
    Maybe Extent2D
forall a. Maybe a
Nothing
    SampleCountFlagBits
multisample
    (Bool
-> Tagged Scene DsBindings
-> Config '[Scene] VertexAttrs InstanceAttrs
config Bool
useDepth Tagged Scene DsBindings
tset0)
    renderpass
rp
  Pipeline -> ResourceT (RIO env) Pipeline
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pipeline
p

allocateWireframe
  :: ( HasVulkan env
     , HasRenderPass renderpass
     )
  => Bool
  -> Vk.SampleCountFlagBits
  -> Tagged Scene DsBindings
  -> renderpass
  -> ResourceT (RIO env) Pipeline
allocateWireframe :: Bool
-> SampleCountFlagBits
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
allocateWireframe Bool
useDepth SampleCountFlagBits
multisample Tagged Scene DsBindings
tset0 renderpass
rp = do
  (ReleaseKey
_, Pipeline
p) <- Maybe Extent2D
-> SampleCountFlagBits
-> Config '[Scene] VertexAttrs InstanceAttrs
-> renderpass
-> ResourceT (RIO env) (ReleaseKey, Pipeline)
forall env (m :: * -> *) renderpass (dsl :: [*]) vertices
       instances.
(MonadVulkan env m, MonadResource m, HasRenderPass renderpass,
 HasCallStack) =>
Maybe Extent2D
-> SampleCountFlagBits
-> Config dsl vertices instances
-> renderpass
-> m (ReleaseKey, Pipeline dsl vertices instances)
Pipeline.allocate
    Maybe Extent2D
forall a. Maybe a
Nothing
    SampleCountFlagBits
multisample
    (Bool
-> Tagged Scene DsBindings
-> Config '[Scene] VertexAttrs InstanceAttrs
configWireframe Bool
useDepth Tagged Scene DsBindings
tset0)
    renderpass
rp
  Pipeline -> ResourceT (RIO env) Pipeline
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pipeline
p

config :: Bool -> Tagged Scene DsBindings -> Config
config :: Bool
-> Tagged Scene DsBindings
-> Config '[Scene] VertexAttrs InstanceAttrs
config Bool
useDepth (Tagged DsBindings
set0) = Config Any Any Any
forall a. Zero a => a
zero
  { $sel:cDescLayouts:Config :: Tagged '[Scene] [DsBindings]
Pipeline.cDescLayouts  = [DsBindings] -> Tagged '[Scene] [DsBindings]
forall k (s :: k) b. b -> Tagged s b
Tagged @'[Scene] [DsBindings
set0]
  , $sel:cVertexCode:Config :: Maybe ByteString
Pipeline.cVertexCode   = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
vertCode
  , $sel:cVertexInput:Config :: SomeStruct PipelineVertexInputStateCreateInfo
Pipeline.cVertexInput  = SomeStruct PipelineVertexInputStateCreateInfo
vertexInput
  , $sel:cFragmentCode:Config :: Maybe ByteString
Pipeline.cFragmentCode = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
fragCode
  , $sel:cBlend:Config :: Bool
Pipeline.cBlend        = Bool
True
  , $sel:cDepthTest:Config :: Bool
Pipeline.cDepthTest    = Bool
useDepth
  , $sel:cDepthWrite:Config :: Bool
Pipeline.cDepthWrite   = Bool
useDepth
  }
  where
    vertexInput :: SomeStruct PipelineVertexInputStateCreateInfo
vertexInput = [(VertexInputRate, [Format])]
-> SomeStruct PipelineVertexInputStateCreateInfo
Pipeline.vertexInput
      [ (VertexInputRate, [Format])
vertexPos
      , (VertexInputRate
Vk.VERTEX_INPUT_RATE_VERTEX, [Format]
Model.vkVertexAttrs)
      , (VertexInputRate, [Format])
instanceTransform
      ]

configWireframe :: Bool -> Tagged Scene DsBindings -> Config
configWireframe :: Bool
-> Tagged Scene DsBindings
-> Config '[Scene] VertexAttrs InstanceAttrs
configWireframe Bool
useDepth Tagged Scene DsBindings
tset0 = (Bool
-> Tagged Scene DsBindings
-> Config '[Scene] VertexAttrs InstanceAttrs
config Bool
useDepth Tagged Scene DsBindings
tset0)
  { $sel:cTopology:Config :: PrimitiveTopology
Pipeline.cTopology = PrimitiveTopology
Vk.PRIMITIVE_TOPOLOGY_LINE_LIST
  }

vertCode :: ByteString
vertCode :: ByteString
vertCode =
  $(compileVert [glsl|
    #version 450
    #extension GL_ARB_separate_shader_objects : enable

    ${set0binding0}

    layout(location = 0) in vec3 vPosition;
    layout(location = 1) in vec4 vColor;

    layout(location = 2) in mat4 iModel;

    layout(location = 0) out vec4 fColor;

    void main() {
      gl_Position
        = scene.projection
        * scene.view
        * iModel
        * vec4(vPosition, 1.0);

      fColor = vColor;
      fColor.rgb * fColor.a;
    }
  |])

fragCode :: ByteString
fragCode :: ByteString
fragCode =
  $(compileFrag [glsl|
    #version 450
    #extension GL_ARB_separate_shader_objects : enable

    layout(location = 0) in vec4 fragColor;

    layout(location = 0) out vec4 outColor;

    void main() {
      outColor = fragColor;
    }
  |])