{-# LANGUAGE OverloadedLists #-}

module Render.Unlit.Line2d.Draw where

import RIO

import Vulkan.Core10 qualified as Vk
import Vulkan.NamedType ((:::))

import Engine.Vulkan.Types (Bound(..))
import Render.Unlit.Line2d.Model qualified as Model
import Resource.Buffer qualified as Buffer

batch
  :: (MonadIO m, Foldable t)
  => Vk.CommandBuffer
  -> Model.Segment
  -> Buffer.Allocated s Model.InstanceAttrs
  -> t ("firstInstance" ::: Word32, "instanceCount" ::: Word32)
  -> Bound dsl vertices instances m ()
batch :: forall {k} {k1} (m :: * -> *) (t :: * -> *) (s :: Store)
       (dsl :: [*]) (vertices :: k) (instances :: k1).
(MonadIO m, Foldable t) =>
CommandBuffer
-> Segment
-> Allocated s InstanceAttrs
-> t ("firstInstance" ::: Word32, "firstInstance" ::: Word32)
-> Bound dsl vertices instances m ()
batch CommandBuffer
cmd Segment
vertices Allocated s InstanceAttrs
points t ("firstInstance" ::: Word32, "firstInstance" ::: Word32)
ranges =
  Bool
-> Bound dsl vertices instances m ()
-> Bound dsl vertices instances m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Allocated s InstanceAttrs -> "firstInstance" ::: Word32
forall {k} (s :: Store) (a :: k).
Allocated s a -> "firstInstance" ::: Word32
Buffer.aUsed Allocated s InstanceAttrs
points ("firstInstance" ::: Word32)
-> ("firstInstance" ::: Word32) -> Bool
forall a. Ord a => a -> a -> Bool
>= "firstInstance" ::: Word32
2) do -- XXX: at least one segment to draw
    CommandBuffer
-> Segment
-> Allocated s InstanceAttrs
-> Bound dsl vertices instances m ()
forall (io :: * -> *) (s :: Store).
MonadIO io =>
CommandBuffer -> Segment -> Buffer s -> io ()
bind CommandBuffer
cmd Segment
vertices Allocated s InstanceAttrs
points
    -- TODO: check bindings
    m () -> Bound dsl vertices instances m ()
forall {k} {k1} {k2} (dsl :: [*]) (vertices :: k) (instances :: k1)
       (m :: k2 -> *) (a :: k2).
m a -> Bound dsl vertices instances m a
Bound (m () -> Bound dsl vertices instances m ())
-> m () -> Bound dsl vertices instances m ()
forall a b. (a -> b) -> a -> b
$
      (("firstInstance" ::: Word32, "firstInstance" ::: Word32) -> m ())
-> t ("firstInstance" ::: Word32, "firstInstance" ::: Word32)
-> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (CommandBuffer
-> Segment
-> ("firstInstance" ::: Word32, "firstInstance" ::: Word32)
-> m ()
forall {k} (io :: * -> *) (s :: Store) (a :: k).
MonadIO io =>
CommandBuffer
-> Allocated s a
-> ("firstInstance" ::: Word32, "firstInstance" ::: Word32)
-> io ()
segments CommandBuffer
cmd Segment
vertices) t ("firstInstance" ::: Word32, "firstInstance" ::: Word32)
ranges

single
  :: MonadIO m
  => Vk.CommandBuffer
  -> Model.Segment
  -> Buffer.Allocated s Model.InstanceAttrs
  -> Bound dsl vertices instances m ()
single :: forall {k} {k1} (m :: * -> *) (s :: Store) (dsl :: [*])
       (vertices :: k) (instances :: k1).
MonadIO m =>
CommandBuffer
-> Segment
-> Allocated s InstanceAttrs
-> Bound dsl vertices instances m ()
single CommandBuffer
cmd Segment
vertices Allocated s InstanceAttrs
points =
  CommandBuffer
-> Segment
-> Allocated s InstanceAttrs
-> Maybe ("firstInstance" ::: Word32, "firstInstance" ::: Word32)
-> Bound dsl vertices instances m ()
forall {k} {k1} (m :: * -> *) (t :: * -> *) (s :: Store)
       (dsl :: [*]) (vertices :: k) (instances :: k1).
(MonadIO m, Foldable t) =>
CommandBuffer
-> Segment
-> Allocated s InstanceAttrs
-> t ("firstInstance" ::: Word32, "firstInstance" ::: Word32)
-> Bound dsl vertices instances m ()
batch CommandBuffer
cmd Segment
vertices Allocated s InstanceAttrs
points (Maybe ("firstInstance" ::: Word32, "firstInstance" ::: Word32)
 -> Bound dsl vertices instances m ())
-> Maybe ("firstInstance" ::: Word32, "firstInstance" ::: Word32)
-> Bound dsl vertices instances m ()
forall a b. (a -> b) -> a -> b
$
    ("firstInstance" ::: Word32, "firstInstance" ::: Word32)
-> Maybe ("firstInstance" ::: Word32, "firstInstance" ::: Word32)
forall a. a -> Maybe a
Just
      ( "firstInstance" ::: Word32
0
      , Allocated s InstanceAttrs -> "firstInstance" ::: Word32
forall {k} (s :: Store) (a :: k).
Allocated s a -> "firstInstance" ::: Word32
Buffer.aUsed Allocated s InstanceAttrs
points
      )

bind
  :: MonadIO io
  => Vk.CommandBuffer
  -> Model.Segment
  -> Model.Buffer s
  -> io ()
bind :: forall (io :: * -> *) (s :: Store).
MonadIO io =>
CommandBuffer -> Segment -> Buffer s -> io ()
bind CommandBuffer
cmd Segment
vertices Buffer s
points = do
  CommandBuffer
-> ("firstInstance" ::: Word32)
-> Vector Buffer
-> ("offsets" ::: Vector DeviceSize)
-> io ()
forall (io :: * -> *).
MonadIO io =>
CommandBuffer
-> ("firstInstance" ::: Word32)
-> Vector Buffer
-> ("offsets" ::: Vector DeviceSize)
-> io ()
Vk.cmdBindVertexBuffers
    CommandBuffer
cmd
    "firstInstance" ::: Word32
0
    Vector Buffer
buffers
    "offsets" ::: Vector DeviceSize
offsets
  where
    buffers :: Vector Buffer
buffers =
      [ Segment -> Buffer
forall {k} (s :: Store) (a :: k). Allocated s a -> Buffer
Buffer.aBuffer Segment
vertices
      , Buffer s -> Buffer
forall {k} (s :: Store) (a :: k). Allocated s a -> Buffer
Buffer.aBuffer Buffer s
points
      , Buffer s -> Buffer
forall {k} (s :: Store) (a :: k). Allocated s a -> Buffer
Buffer.aBuffer Buffer s
points
      ]

    offsets :: "offsets" ::: Vector DeviceSize
offsets =
      [ Item ("offsets" ::: Vector DeviceSize)
0
      , Item ("offsets" ::: Vector DeviceSize)
0
      , Item ("offsets" ::: Vector DeviceSize)
4Item ("offsets" ::: Vector DeviceSize)
-> Item ("offsets" ::: Vector DeviceSize)
-> Item ("offsets" ::: Vector DeviceSize)
forall a. Num a => a -> a -> a
*Item ("offsets" ::: Vector DeviceSize)
4 Item ("offsets" ::: Vector DeviceSize)
-> Item ("offsets" ::: Vector DeviceSize)
-> Item ("offsets" ::: Vector DeviceSize)
forall a. Num a => a -> a -> a
+ Item ("offsets" ::: Vector DeviceSize)
4Item ("offsets" ::: Vector DeviceSize)
-> Item ("offsets" ::: Vector DeviceSize)
-> Item ("offsets" ::: Vector DeviceSize)
forall a. Num a => a -> a -> a
*Item ("offsets" ::: Vector DeviceSize)
4 -- vec4, vec4
      ]

segments
  :: MonadIO io
  => Vk.CommandBuffer
  -> Buffer.Allocated s a
  -> ("firstInstance" ::: Word32, "instanceCount" ::: Word32)
  -> io ()
segments :: forall {k} (io :: * -> *) (s :: Store) (a :: k).
MonadIO io =>
CommandBuffer
-> Allocated s a
-> ("firstInstance" ::: Word32, "firstInstance" ::: Word32)
-> io ()
segments CommandBuffer
cmd Allocated s a
vertices ("firstInstance" ::: Word32
offset, "firstInstance" ::: Word32
size) =
  Bool -> io () -> io ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ("firstInstance" ::: Word32
numSegments ("firstInstance" ::: Word32)
-> ("firstInstance" ::: Word32) -> Bool
forall a. Ord a => a -> a -> Bool
> "firstInstance" ::: Word32
0) (io () -> io ()) -> io () -> io ()
forall a b. (a -> b) -> a -> b
$
    CommandBuffer
-> ("firstInstance" ::: Word32)
-> ("firstInstance" ::: Word32)
-> ("firstInstance" ::: Word32)
-> ("firstInstance" ::: Word32)
-> io ()
forall (io :: * -> *).
MonadIO io =>
CommandBuffer
-> ("firstInstance" ::: Word32)
-> ("firstInstance" ::: Word32)
-> ("firstInstance" ::: Word32)
-> ("firstInstance" ::: Word32)
-> io ()
Vk.cmdDraw
      CommandBuffer
cmd
      "firstInstance" ::: Word32
vertexCount
      "firstInstance" ::: Word32
instanceCount
      "firstInstance" ::: Word32
firstVertex
      "firstInstance" ::: Word32
firstInstance
  where
    firstVertex :: "firstInstance" ::: Word32
firstVertex = "firstInstance" ::: Word32
0
    vertexCount :: "firstInstance" ::: Word32
vertexCount = Allocated s a -> "firstInstance" ::: Word32
forall {k} (s :: Store) (a :: k).
Allocated s a -> "firstInstance" ::: Word32
Buffer.aUsed Allocated s a
vertices

    numSegments :: "firstInstance" ::: Word32
numSegments = "firstInstance" ::: Word32
size ("firstInstance" ::: Word32)
-> ("firstInstance" ::: Word32) -> "firstInstance" ::: Word32
forall a. Num a => a -> a -> a
- "firstInstance" ::: Word32
1
    firstInstance :: "firstInstance" ::: Word32
firstInstance = "firstInstance" ::: Word32
offset
    instanceCount :: "firstInstance" ::: Word32
instanceCount = "firstInstance" ::: Word32
numSegments