{-# LANGUAGE OverloadedLists #-}

module Render.Font.EvanwSdf.Pipeline
  ( Pipeline
  , allocate
  ) 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 (Config(..))
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)
import Render.DescSets.Set0.Code (set0binding0, set0binding1, set0binding2)
import Render.Font.EvanwSdf.Model qualified as Model

type Pipeline = Pipeline.Pipeline '[Scene] () Model.InstanceAttrs

allocate
  :: ( HasVulkan env
     , HasRenderPass renderpass
     )
  => Vk.SampleCountFlagBits
  -> Tagged Scene DsBindings
  -> renderpass
  -> ResourceT (RIO env) Pipeline
allocate :: SampleCountFlagBits
-> Tagged Scene DsBindings
-> renderpass
-> ResourceT (RIO env) Pipeline
allocate SampleCountFlagBits
multisample (Tagged 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
-> 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
    Config Any Any Any
forall a. Zero a => a
zero
      { $sel:cVertexCode:Config :: Maybe ByteString
cVertexCode         = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
vertCode
      , $sel:cFragmentCode:Config :: Maybe ByteString
cFragmentCode       = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
fragCode
      , $sel:cDescLayouts:Config :: Tagged '[Scene] [DsBindings]
cDescLayouts        = [DsBindings] -> Tagged '[Scene] [DsBindings]
forall k (s :: k) b. b -> Tagged s b
Tagged @'[Scene] [DsBindings
Item [DsBindings]
set0]
      , $sel:cVertexInput:Config :: SomeStruct PipelineVertexInputStateCreateInfo
cVertexInput        = SomeStruct PipelineVertexInputStateCreateInfo
vertexInput
      , $sel:cDepthTest:Config :: Bool
cDepthTest          = Bool
False
      , $sel:cDepthWrite:Config :: Bool
cDepthWrite         = Bool
False
      , $sel:cBlend:Config :: Bool
cBlend              = Bool
True
      , $sel:cCull:Config :: CullModeFlagBits
cCull               = CullModeFlagBits
Vk.CULL_MODE_NONE
      }
  where
    vertexInput :: SomeStruct PipelineVertexInputStateCreateInfo
vertexInput = [(VertexInputRate, [Format])]
-> SomeStruct PipelineVertexInputStateCreateInfo
Pipeline.vertexInput
      [ (VertexInputRate
Vk.VERTEX_INPUT_RATE_INSTANCE, [Format]
Model.vkInstanceAttrs)
      ]

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

    ${set0binding0}

    layout(location = 0) in  vec4 iVert;
    layout(location = 1) in  vec4 iFrag;
    layout(location = 2) in  vec4 iColor;
    layout(location = 3) in  vec4 iOutlineColor;
    layout(location = 4) in ivec2 iTextureIds;
    layout(location = 5) in  vec2 iSdf;

    layout(location = 0)      out  vec2 fTexCoord;
    layout(location = 1) flat out  vec4 fColor;
    layout(location = 2) flat out  vec4 fOutlineColor;
    layout(location = 3) flat out ivec2 fTextureIds;
    layout(location = 4) flat out  vec2 fSdf;

    vec2 positions[6] = vec2[](
      vec2(-0.5, 0.5),
      vec2(0.5, 0.5),
      vec2(-0.5, -0.5),

      vec2(0.5, -0.5),
      vec2(-0.5, -0.5),
      vec2(0.5, 0.5)
    );

    vec2 texCoords[6] = vec2[](
      vec2(0.0, 0.0),
      vec2(1.0, 0.0),
      vec2(0.0, 1.0),

      vec2(1.0, 1.0),
      vec2(0.0, 1.0),
      vec2(1.0, 0.0)
    );

    void main() {
      vec2 pos = positions[gl_VertexIndex];

      gl_Position
        = scene.projection
        * scene.view
      // TODO: * iModel
        * vec4(iVert.xy + pos * iVert.zw, 0, 1.0);

      vec2 uv = texCoords[gl_VertexIndex];
      fTexCoord = iFrag.xy + uv * iFrag.zw;

      fColor = iColor;
      fOutlineColor = iOutlineColor;
      fTextureIds = iTextureIds;
      fSdf = iSdf;
    }
  |])

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

    ${set0binding1}
    ${set0binding2}

    layout(location = 0)      in  vec2 fTexCoord;
    layout(location = 1) flat in  vec4 fColor;
    layout(location = 2) flat in  vec4 fOutlineColor;
    layout(location = 3) flat in ivec2 fTextureIds;
    layout(location = 4) flat in  vec2 fSdf;

    layout(location = 0) out vec4 outColor;

    void main() {
      float sdf = texture(
        sampler2D(
          textures[nonuniformEXT(fTextureIds.t)],
          samplers[nonuniformEXT(fTextureIds.s)]
        ),
        fTexCoord
      ).r;

      float smoothing    = fSdf[0];
      float outlineWidth = fSdf[1];

      float outerEdgeCenter = 0.5 - outlineWidth;

      float alpha = smoothstep(
        outerEdgeCenter - smoothing,
        outerEdgeCenter + smoothing,
        sdf
      );
      float border = smoothstep(
        0.5 - smoothing,
        0.5 + smoothing,
        sdf
      );
      outColor = mix(fOutlineColor, fColor, border);
      outColor *= alpha;
    }
  |])