module Render.Debug.Pipeline
  ( Config
  , config
  , Pipeline
  , allocate
  , Mode(..)
  , stageCode
  , stageSpirv
  ) where

import RIO

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

import Engine.Vulkan.Pipeline.Graphics qualified as Graphics
import Engine.Vulkan.Shader qualified as Shader
import Engine.Vulkan.Types (DsLayoutBindings, HasVulkan, HasRenderPass(..))
import Render.Code (compileVert, compileFrag)
import Render.Debug.Code qualified as Code
import Render.Debug.Model qualified as Model
import Render.DescSets.Set0 (Scene)

type Pipeline = Graphics.Pipeline '[Scene] Model.Vertex Model.Attrs
type Config = Graphics.Configure Pipeline
type instance Graphics.Specialization Pipeline = Mode

data Mode
  = UV
  | Texture
  | Shadow Word32
  deriving (Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
/= :: Mode -> Mode -> Bool
Eq, Eq Mode
Eq Mode
-> (Mode -> Mode -> Ordering)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Mode)
-> (Mode -> Mode -> Mode)
-> Ord Mode
Mode -> Mode -> Bool
Mode -> Mode -> Ordering
Mode -> Mode -> Mode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Mode -> Mode -> Ordering
compare :: Mode -> Mode -> Ordering
$c< :: Mode -> Mode -> Bool
< :: Mode -> Mode -> Bool
$c<= :: Mode -> Mode -> Bool
<= :: Mode -> Mode -> Bool
$c> :: Mode -> Mode -> Bool
> :: Mode -> Mode -> Bool
$c>= :: Mode -> Mode -> Bool
>= :: Mode -> Mode -> Bool
$cmax :: Mode -> Mode -> Mode
max :: Mode -> Mode -> Mode
$cmin :: Mode -> Mode -> Mode
min :: Mode -> Mode -> Mode
Ord, Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mode -> ShowS
showsPrec :: Int -> Mode -> ShowS
$cshow :: Mode -> String
show :: Mode -> String
$cshowList :: [Mode] -> ShowS
showList :: [Mode] -> ShowS
Show)

instance Shader.Specialization Mode where
  specializationData :: Mode -> [Word32]
specializationData = \case
    Mode
UV ->
      [Word32
0]
    Mode
Texture ->
      [Word32
1]
    Shadow Word32
bits ->
      [Word32
2, Word32
bits]

allocate
  :: ( HasVulkan env
     , HasRenderPass renderpass
     )
  => Mode
  -> Vk.SampleCountFlagBits
  -> Tagged Scene DsLayoutBindings
  -> renderpass
  -> ResourceT (RIO env) Pipeline
allocate :: forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
Mode
-> SampleCountFlagBits
-> Tagged Scene DsLayoutBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
allocate Mode
mode SampleCountFlagBits
multisample Tagged Scene DsLayoutBindings
tset0 = do
  ((ReleaseKey, Pipeline) -> Pipeline)
-> ResourceT (RIO env) (ReleaseKey, Pipeline)
-> ResourceT (RIO env) Pipeline
forall a b.
(a -> b) -> ResourceT (RIO env) a -> ResourceT (RIO env) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReleaseKey, Pipeline) -> Pipeline
forall a b. (a, b) -> b
snd (ResourceT (RIO env) (ReleaseKey, Pipeline)
 -> ResourceT (RIO env) Pipeline)
-> (renderpass -> ResourceT (RIO env) (ReleaseKey, Pipeline))
-> renderpass
-> ResourceT (RIO env) Pipeline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Extent2D
-> SampleCountFlagBits
-> Config
     '[Scene] (Vertex Packed VertexAttrs) (AttrsF Identity) Mode
-> renderpass
-> ResourceT (RIO env) (ReleaseKey, Pipeline)
forall {k1} {k2} config pipeline (dsl :: [*]) (vertices :: k1)
       (instances :: k2) spec env (m :: * -> *) renderpass.
(config ~ Configure pipeline,
 pipeline ~ Pipeline dsl vertices instances,
 spec ~ Specialization pipeline, Specialization spec, HasCallStack,
 MonadVulkan env m, MonadResource m, HasRenderPass renderpass) =>
Maybe Extent2D
-> SampleCountFlagBits
-> Config dsl vertices instances spec
-> renderpass
-> m (ReleaseKey, pipeline)
Graphics.allocate Maybe Extent2D
forall a. Maybe a
Nothing SampleCountFlagBits
multisample (Mode -> Tagged Scene DsLayoutBindings -> Configure Pipeline
config Mode
mode Tagged Scene DsLayoutBindings
tset0)

config :: Mode -> Tagged Scene DsLayoutBindings -> Config
config :: Mode -> Tagged Scene DsLayoutBindings -> Configure Pipeline
config Mode
mode (Tagged DsLayoutBindings
set0) = Config '[] Any Any ()
forall {k1} {k2} (vertices :: k1) (instances :: k2).
Config '[] vertices instances ()
Graphics.baseConfig
  { $sel:cDescLayouts:Config :: Tagged '[Scene] [DsLayoutBindings]
Graphics.cDescLayouts    = forall (s :: [*]) b. b -> Tagged s b
forall {k} (s :: k) b. b -> Tagged s b
Tagged @'[Scene] [DsLayoutBindings
set0]
  , $sel:cStages:Config :: StageSpirv
Graphics.cStages         = StageSpirv
stageSpirv
  , $sel:cVertexInput:Config :: SomeStruct PipelineVertexInputStateCreateInfo
Graphics.cVertexInput    = forall a (pipeLayout :: [*]) vertices instances.
(a ~ Pipeline pipeLayout vertices instances,
 HasVertexInputBindings vertices,
 HasVertexInputBindings instances) =>
SomeStruct PipelineVertexInputStateCreateInfo
forall {k1} {k2} a (pipeLayout :: [*]) (vertices :: k1)
       (instances :: k2).
(a ~ Pipeline pipeLayout vertices instances,
 HasVertexInputBindings vertices,
 HasVertexInputBindings instances) =>
SomeStruct PipelineVertexInputStateCreateInfo
Graphics.vertexInput @Pipeline
  , $sel:cSpecialization:Config :: Mode
Graphics.cSpecialization = Mode
mode
  }

stageCode :: Graphics.StageCode
stageCode :: StageCode
stageCode = ("vert" ::: Code) -> ("vert" ::: Code) -> StageCode
forall a.
("vert" ::: a) -> ("vert" ::: a) -> Stages (Maybe ("vert" ::: a))
Graphics.basicStages "vert" ::: Code
Code.vert "vert" ::: Code
Code.frag

stageSpirv :: Graphics.StageSpirv
stageSpirv :: StageSpirv
stageSpirv = ("vert" ::: ByteString) -> ("vert" ::: ByteString) -> StageSpirv
forall a.
("vert" ::: a) -> ("vert" ::: a) -> Stages (Maybe ("vert" ::: a))
Graphics.basicStages "vert" ::: ByteString
vertSpirv "vert" ::: ByteString
fragSpirv

vertSpirv :: ByteString
vertSpirv :: "vert" ::: ByteString
vertSpirv = $(compileVert Code.vert)

fragSpirv :: ByteString
fragSpirv :: "vert" ::: ByteString
fragSpirv = $(compileFrag Code.frag)