{-# LANGUAGE OverloadedLists #-}

module Render.Unlit.Sprite.Pipeline
  ( Pipeline
  , Config
  , config
  , allocate
  -- , allocateOutline
  , 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.Types (HasVulkan, HasRenderPass(..), DsBindings)
import Render.Code (compileVert, compileFrag)
import Render.DescSets.Set0 (Scene)
import Render.Unlit.Sprite.Code qualified as Code
import Render.Unlit.Sprite.Model qualified as Model

type Pipeline = Graphics.Pipeline '[Scene] () Model.InstanceAttrs
type Config = Graphics.Configure Pipeline
type instance Graphics.Specialization Pipeline = (Float, Bool)

allocate
  :: ( HasVulkan env
     , HasRenderPass renderpass
     )
  => Vk.SampleCountFlagBits
  -> Maybe Float
  -> Bool
  -> Tagged Scene DsBindings
  -> renderpass
  -> ResourceT (RIO env) Pipeline
allocate :: forall env renderpass.
(HasVulkan env, HasRenderPass renderpass) =>
SampleCountFlagBits
-> Maybe Float
-> Bool
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
allocate SampleCountFlagBits
multisample Maybe Float
discardAlpha Bool
outline Tagged Scene DsBindings
set0 = do
  ((ReleaseKey, Pipeline) -> Pipeline)
-> ResourceT (RIO env) (ReleaseKey, Pipeline)
-> ResourceT (RIO env) Pipeline
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] () InstanceAttrs (Float, Bool)
-> renderpass
-> ResourceT (RIO env) (ReleaseKey, Pipeline)
forall config pipeline (dsl :: [*]) vertices instances 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
    (Maybe Float
-> Bool -> Tagged Scene DsBindings -> Configure Pipeline
config Maybe Float
discardAlpha Bool
outline Tagged Scene DsBindings
set0)

config
  :: Maybe Float
  -> Bool
  -> Tagged Scene DsBindings
  -> Config
config :: Maybe Float
-> Bool -> Tagged Scene DsBindings -> Configure Pipeline
config Maybe Float
discardAlpha Bool
outline (Tagged DsBindings
set0) =
  Config '[] Any Any ()
forall vertices instances. Config '[] vertices instances ()
Graphics.baseConfig
    { $sel:cStages:Config :: StageSpirv
Graphics.cStages         = StageSpirv
stageSpirv
    , $sel:cDescLayouts:Config :: Tagged '[Scene] [DsBindings]
Graphics.cDescLayouts    = forall {s :: [*]} {b}. b -> Tagged s b
forall {k} (s :: k) b. b -> Tagged s b
Tagged @'[Scene] [DsBindings
Item [DsBindings]
set0]
    , $sel:cVertexInput:Config :: SomeStruct PipelineVertexInputStateCreateInfo
Graphics.cVertexInput    = SomeStruct PipelineVertexInputStateCreateInfo
vertexInput
    , $sel:cDepthTest:Config :: Bool
Graphics.cDepthTest      = Bool
False
    , $sel:cDepthWrite:Config :: Bool
Graphics.cDepthWrite     = Bool
False
    , $sel:cBlend:Config :: Bool
Graphics.cBlend          = Bool
True
    , $sel:cCull:Config :: CullModeFlagBits
Graphics.cCull           = CullModeFlagBits
Vk.CULL_MODE_NONE
    , $sel:cSpecialization:Config :: (Float, Bool)
Graphics.cSpecialization = (Float, Bool)
specs
    }
  where
    vertexInput :: SomeStruct PipelineVertexInputStateCreateInfo
vertexInput = [(VertexInputRate, [Format])]
-> SomeStruct PipelineVertexInputStateCreateInfo
Graphics.vertexInput
      [ (VertexInputRate
Vk.VERTEX_INPUT_RATE_INSTANCE, [Format]
Model.vkInstanceAttrs)
      ]

    specs :: (Float, Bool)
specs =
      ( Float -> Maybe Float -> Float
forall a. a -> Maybe a -> a
fromMaybe Float
0.0 Maybe Float
discardAlpha
      , Bool
outline
      )

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)