{-# OPTIONS_GHC -fplugin Foreign.Storable.Generic.Plugin #-}

{-# LANGUAGE OverloadedLists #-}

module Render.Unlit.Line2d.Model
  ( Segment

  , Vertex
  , createVertices
  , verticesRoundRound
  , Points

  , point
  , InstanceAttrs(..)

  , Buffer
  , Observer
  , Buffer.observeCoherentResize_

  , Batches(..)
  , BatchObserver
  , newBatchObserver
  , observeCoherentBatches
  ) where

import RIO

import Control.Monad.Trans.Resource qualified as Resource
import Data.Vector.Generic qualified as Generic
import Foreign.Storable.Generic (GStorable)
import Geomancy (Vec2, Vec4, vec3)
import Geomancy.Vec3 qualified as Vec3
import RIO.Vector qualified as Vector
import RIO.Vector.Storable qualified as Storable
import Vulkan.Core10 qualified as Vk
import Vulkan.NamedType ((:::))

import Engine.Vulkan.Format (HasVkFormat(..))
import Engine.Vulkan.Pipeline.Graphics (HasVertexInputBindings(..), instanceFormat)
import Engine.Vulkan.Types (MonadVulkan, Queues)
import Engine.Worker qualified as Worker
import Resource.Buffer qualified as Buffer
import Resource.Model qualified as Model

type Segment = Buffer.Allocated 'Buffer.Staged Vec3.Packed
type Vertex = Model.Vertex3d ()

createVertices
  :: MonadVulkan env m
  => Maybe Text
  -> Queues Vk.CommandPool
  -> Float
  -> m Segment
createVertices :: forall env (m :: * -> *).
MonadVulkan env m =>
Maybe Text -> Queues CommandPool -> Float -> m Segment
createVertices Maybe Text
label Queues CommandPool
pools Float
resolution = do
  forall a env (m :: * -> *).
(Storable a, MonadVulkan env m) =>
Maybe Text
-> Queues CommandPool
-> BufferUsageFlagBits
-> Int
-> Vector a
-> m (Allocated 'Staged a)
Buffer.createStaged
    Maybe Text
label
    Queues CommandPool
pools
    BufferUsageFlagBits
Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT
    (forall a. Storable a => Vector a -> Int
Storable.length Vector Packed
vertices)
    Vector Packed
vertices
  where
    vertices :: Vector Packed
vertices = Float -> Vector Packed
verticesRoundRound Float
resolution

{- |
  Generate mesh for the round joints / round caps special case.

  With a bit of vertex shader code it allows drawing a batch of
  smooth lines in one call.
-}
verticesRoundRound :: Float -> Storable.Vector Vec3.Packed
verticesRoundRound :: Float -> Vector Packed
verticesRoundRound Float
resolution =
  forall a. Storable a => [a] -> Vector a
Storable.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Vec3 -> Packed
Vec3.Packed forall a b. (a -> b) -> a -> b
$
    forall a. Monoid a => [a] -> a
mconcat
      [ [Vec3]
segment
      , [Vec3]
leftSemi
      , [Vec3]
rightSemi
      ]
  where
    segment :: [Vec3]
segment =
      [ Float -> Float -> Float -> Vec3
vec3 Float
0 (-Float
0.5) Float
0
      , Float -> Float -> Float -> Vec3
vec3 Float
0 (-Float
0.5) Float
1
      , Float -> Float -> Float -> Vec3
vec3 Float
0   Float
0.5  Float
1
      , Float -> Float -> Float -> Vec3
vec3 Float
0 (-Float
0.5) Float
0
      , Float -> Float -> Float -> Vec3
vec3 Float
0   Float
0.5  Float
1
      , Float -> Float -> Float -> Vec3
vec3 Float
0   Float
0.5  Float
0
      ]

    leftSemi :: [Vec3]
leftSemi = do
      Float
step <- [Item [Float]
0..Float
resolution]
      let
        theta0 :: Float
theta0 = forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Float
2 forall a. Num a => a -> a -> a
+ (Float
step forall a. Num a => a -> a -> a
+ Float
0) forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Float
resolution
        theta1 :: Float
theta1 = forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Float
2 forall a. Num a => a -> a -> a
+ (Float
step forall a. Num a => a -> a -> a
+ Float
1) forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Float
resolution
        a :: Vec3
a = Float -> Float -> Float -> Vec3
vec3 Float
0 Float
0 Float
0
        b :: Vec3
b = Float -> Float -> Float -> Vec3
vec3 (forall a. Floating a => a -> a
cos Float
theta0) (forall a. Floating a => a -> a
sin Float
theta0) Float
0 forall a. Num a => a -> a -> a
* Vec3
0.5
        c :: Vec3
c = Float -> Float -> Float -> Vec3
vec3 (forall a. Floating a => a -> a
cos Float
theta1) (forall a. Floating a => a -> a
sin Float
theta1) Float
0 forall a. Num a => a -> a -> a
* Vec3
0.5
      [ Vec3
a, Vec3
b, Vec3
c ]

    rightSemi :: [Vec3]
rightSemi = do
      Float
step <- [Item [Float]
0..Float
resolution]
      let
        theta0 :: Float
theta0 = Float
3 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Float
2 forall a. Num a => a -> a -> a
+ (Float
step forall a. Num a => a -> a -> a
+ Float
0) forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Float
resolution
        theta1 :: Float
theta1 = Float
3 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Float
2 forall a. Num a => a -> a -> a
+ (Float
step forall a. Num a => a -> a -> a
+ Float
1) forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Float
resolution
        a :: Vec3
a = Float -> Float -> Float -> Vec3
vec3 Float
0 Float
0 Float
0
        b :: Vec3
b = Float -> Float -> Float -> Vec3
vec3 (forall a. Floating a => a -> a
cos Float
theta0) (forall a. Floating a => a -> a
sin Float
theta0) Float
2 forall a. Num a => a -> a -> a
* Vec3
0.5
        c :: Vec3
c = Float -> Float -> Float -> Vec3
vec3 (forall a. Floating a => a -> a
cos Float
theta1) (forall a. Floating a => a -> a
sin Float
theta1) Float
2 forall a. Num a => a -> a -> a
* Vec3
0.5
      [ Vec3
a, Vec3
b, Vec3
c ]

type Points = Storable.Vector InstanceAttrs

point :: Float -> Vec4 -> Vec2 -> InstanceAttrs
point :: Float -> Vec4 -> Vec2 -> InstanceAttrs
point Float
width Vec4
color Vec2
position = InstanceAttrs
  { $sel:color:InstanceAttrs :: Vec4
color    = Vec4
color
  , $sel:position:InstanceAttrs :: Packed
position = Vec3 -> Packed
Vec3.Packed (forall a. Coercible Vec3 a => Vec2 -> Float -> a
Vec3.fromVec2 Vec2
position Float
0)
  , $sel:width:InstanceAttrs :: Float
width    = Float
width
  }

data InstanceAttrs = InstanceAttrs
  { InstanceAttrs -> Vec4
color    :: Vec4

  , InstanceAttrs -> Packed
position :: Vec3.Packed
  , InstanceAttrs -> Float
width    :: Float
  } deriving (InstanceAttrs -> InstanceAttrs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstanceAttrs -> InstanceAttrs -> Bool
$c/= :: InstanceAttrs -> InstanceAttrs -> Bool
== :: InstanceAttrs -> InstanceAttrs -> Bool
$c== :: InstanceAttrs -> InstanceAttrs -> Bool
Eq, Int -> InstanceAttrs -> ShowS
[InstanceAttrs] -> ShowS
InstanceAttrs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstanceAttrs] -> ShowS
$cshowList :: [InstanceAttrs] -> ShowS
show :: InstanceAttrs -> String
$cshow :: InstanceAttrs -> String
showsPrec :: Int -> InstanceAttrs -> ShowS
$cshowsPrec :: Int -> InstanceAttrs -> ShowS
Show, forall x. Rep InstanceAttrs x -> InstanceAttrs
forall x. InstanceAttrs -> Rep InstanceAttrs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InstanceAttrs x -> InstanceAttrs
$cfrom :: forall x. InstanceAttrs -> Rep InstanceAttrs x
Generic)

-- XXX: okay, the layout matches
instance GStorable InstanceAttrs

instance HasVkFormat InstanceAttrs where
  getVkFormat :: [Format]
getVkFormat =
    [ Format
Vk.FORMAT_R32G32B32A32_SFLOAT -- color
    , Format
Vk.FORMAT_R32G32B32A32_SFLOAT -- position+width
    ]

instance HasVertexInputBindings InstanceAttrs where
  vertexInputBindings :: [VertexInputBinding]
vertexInputBindings =
    -- XXX: instance buffer is bound 2 times with a shift
    forall a. Int -> a -> [a]
replicate Int
2 forall a b. (a -> b) -> a -> b
$ forall a. HasVkFormat a => VertexInputBinding
instanceFormat @InstanceAttrs

type Buffer s = Buffer.Allocated s InstanceAttrs

type Observer = Buffer.ObserverCoherent InstanceAttrs
type BatchObserver = Worker.ObserverIO (Buffer 'Buffer.Coherent, Ranges)
type Ranges = [(Word32, Word32)]

newtype Batches v a = Batches [v a]
  deriving (Batches v a -> Batches v a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (v :: * -> *) a.
Eq (v a) =>
Batches v a -> Batches v a -> Bool
/= :: Batches v a -> Batches v a -> Bool
$c/= :: forall (v :: * -> *) a.
Eq (v a) =>
Batches v a -> Batches v a -> Bool
== :: Batches v a -> Batches v a -> Bool
$c== :: forall (v :: * -> *) a.
Eq (v a) =>
Batches v a -> Batches v a -> Bool
Eq, Int -> Batches v a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (v :: * -> *) a. Show (v a) => Int -> Batches v a -> ShowS
forall (v :: * -> *) a. Show (v a) => [Batches v a] -> ShowS
forall (v :: * -> *) a. Show (v a) => Batches v a -> String
showList :: [Batches v a] -> ShowS
$cshowList :: forall (v :: * -> *) a. Show (v a) => [Batches v a] -> ShowS
show :: Batches v a -> String
$cshow :: forall (v :: * -> *) a. Show (v a) => Batches v a -> String
showsPrec :: Int -> Batches v a -> ShowS
$cshowsPrec :: forall (v :: * -> *) a. Show (v a) => Int -> Batches v a -> ShowS
Show, Batches v a -> Batches v a -> Bool
Batches v a -> Batches v a -> Ordering
Batches v a -> Batches v a -> Batches v a
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
forall {v :: * -> *} {a}. Ord (v a) => Eq (Batches v a)
forall (v :: * -> *) a.
Ord (v a) =>
Batches v a -> Batches v a -> Bool
forall (v :: * -> *) a.
Ord (v a) =>
Batches v a -> Batches v a -> Ordering
forall (v :: * -> *) a.
Ord (v a) =>
Batches v a -> Batches v a -> Batches v a
min :: Batches v a -> Batches v a -> Batches v a
$cmin :: forall (v :: * -> *) a.
Ord (v a) =>
Batches v a -> Batches v a -> Batches v a
max :: Batches v a -> Batches v a -> Batches v a
$cmax :: forall (v :: * -> *) a.
Ord (v a) =>
Batches v a -> Batches v a -> Batches v a
>= :: Batches v a -> Batches v a -> Bool
$c>= :: forall (v :: * -> *) a.
Ord (v a) =>
Batches v a -> Batches v a -> Bool
> :: Batches v a -> Batches v a -> Bool
$c> :: forall (v :: * -> *) a.
Ord (v a) =>
Batches v a -> Batches v a -> Bool
<= :: Batches v a -> Batches v a -> Bool
$c<= :: forall (v :: * -> *) a.
Ord (v a) =>
Batches v a -> Batches v a -> Bool
< :: Batches v a -> Batches v a -> Bool
$c< :: forall (v :: * -> *) a.
Ord (v a) =>
Batches v a -> Batches v a -> Bool
compare :: Batches v a -> Batches v a -> Ordering
$ccompare :: forall (v :: * -> *) a.
Ord (v a) =>
Batches v a -> Batches v a -> Ordering
Ord, forall a b. a -> Batches v b -> Batches v a
forall a b. (a -> b) -> Batches v a -> Batches v b
forall (v :: * -> *) a b.
Functor v =>
a -> Batches v b -> Batches v a
forall (v :: * -> *) a b.
Functor v =>
(a -> b) -> Batches v a -> Batches v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Batches v b -> Batches v a
$c<$ :: forall (v :: * -> *) a b.
Functor v =>
a -> Batches v b -> Batches v a
fmap :: forall a b. (a -> b) -> Batches v a -> Batches v b
$cfmap :: forall (v :: * -> *) a b.
Functor v =>
(a -> b) -> Batches v a -> Batches v b
Functor, forall a. Batches v a -> Bool
forall m a. Monoid m => (a -> m) -> Batches v a -> m
forall a b. (a -> b -> b) -> b -> Batches v a -> b
forall (v :: * -> *) a.
(Foldable v, Eq a) =>
a -> Batches v a -> Bool
forall (v :: * -> *) a. (Foldable v, Num a) => Batches v a -> a
forall (v :: * -> *) a. (Foldable v, Ord a) => Batches v a -> a
forall (v :: * -> *) m. (Foldable v, Monoid m) => Batches v m -> m
forall (v :: * -> *) a. Foldable v => Batches v a -> Bool
forall (v :: * -> *) a. Foldable v => Batches v a -> Int
forall (v :: * -> *) a. Foldable v => Batches v a -> [a]
forall (v :: * -> *) a.
Foldable v =>
(a -> a -> a) -> Batches v a -> a
forall (v :: * -> *) m a.
(Foldable v, Monoid m) =>
(a -> m) -> Batches v a -> m
forall (v :: * -> *) b a.
Foldable v =>
(b -> a -> b) -> b -> Batches v a -> b
forall (v :: * -> *) a b.
Foldable v =>
(a -> b -> b) -> b -> Batches v a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Batches v a -> a
$cproduct :: forall (v :: * -> *) a. (Foldable v, Num a) => Batches v a -> a
sum :: forall a. Num a => Batches v a -> a
$csum :: forall (v :: * -> *) a. (Foldable v, Num a) => Batches v a -> a
minimum :: forall a. Ord a => Batches v a -> a
$cminimum :: forall (v :: * -> *) a. (Foldable v, Ord a) => Batches v a -> a
maximum :: forall a. Ord a => Batches v a -> a
$cmaximum :: forall (v :: * -> *) a. (Foldable v, Ord a) => Batches v a -> a
elem :: forall a. Eq a => a -> Batches v a -> Bool
$celem :: forall (v :: * -> *) a.
(Foldable v, Eq a) =>
a -> Batches v a -> Bool
length :: forall a. Batches v a -> Int
$clength :: forall (v :: * -> *) a. Foldable v => Batches v a -> Int
null :: forall a. Batches v a -> Bool
$cnull :: forall (v :: * -> *) a. Foldable v => Batches v a -> Bool
toList :: forall a. Batches v a -> [a]
$ctoList :: forall (v :: * -> *) a. Foldable v => Batches v a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Batches v a -> a
$cfoldl1 :: forall (v :: * -> *) a.
Foldable v =>
(a -> a -> a) -> Batches v a -> a
foldr1 :: forall a. (a -> a -> a) -> Batches v a -> a
$cfoldr1 :: forall (v :: * -> *) a.
Foldable v =>
(a -> a -> a) -> Batches v a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Batches v a -> b
$cfoldl' :: forall (v :: * -> *) b a.
Foldable v =>
(b -> a -> b) -> b -> Batches v a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Batches v a -> b
$cfoldl :: forall (v :: * -> *) b a.
Foldable v =>
(b -> a -> b) -> b -> Batches v a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Batches v a -> b
$cfoldr' :: forall (v :: * -> *) a b.
Foldable v =>
(a -> b -> b) -> b -> Batches v a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Batches v a -> b
$cfoldr :: forall (v :: * -> *) a b.
Foldable v =>
(a -> b -> b) -> b -> Batches v a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Batches v a -> m
$cfoldMap' :: forall (v :: * -> *) m a.
(Foldable v, Monoid m) =>
(a -> m) -> Batches v a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Batches v a -> m
$cfoldMap :: forall (v :: * -> *) m a.
(Foldable v, Monoid m) =>
(a -> m) -> Batches v a -> m
fold :: forall m. Monoid m => Batches v m -> m
$cfold :: forall (v :: * -> *) m. (Foldable v, Monoid m) => Batches v m -> m
Foldable, forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall {v :: * -> *}. Traversable v => Functor (Batches v)
forall {v :: * -> *}. Traversable v => Foldable (Batches v)
forall (v :: * -> *) (m :: * -> *) a.
(Traversable v, Monad m) =>
Batches v (m a) -> m (Batches v a)
forall (v :: * -> *) (f :: * -> *) a.
(Traversable v, Applicative f) =>
Batches v (f a) -> f (Batches v a)
forall (v :: * -> *) (m :: * -> *) a b.
(Traversable v, Monad m) =>
(a -> m b) -> Batches v a -> m (Batches v b)
forall (v :: * -> *) (f :: * -> *) a b.
(Traversable v, Applicative f) =>
(a -> f b) -> Batches v a -> f (Batches v b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Batches v a -> f (Batches v b)
sequence :: forall (m :: * -> *) a.
Monad m =>
Batches v (m a) -> m (Batches v a)
$csequence :: forall (v :: * -> *) (m :: * -> *) a.
(Traversable v, Monad m) =>
Batches v (m a) -> m (Batches v a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Batches v a -> m (Batches v b)
$cmapM :: forall (v :: * -> *) (m :: * -> *) a b.
(Traversable v, Monad m) =>
(a -> m b) -> Batches v a -> m (Batches v b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Batches v (f a) -> f (Batches v a)
$csequenceA :: forall (v :: * -> *) (f :: * -> *) a.
(Traversable v, Applicative f) =>
Batches v (f a) -> f (Batches v a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Batches v a -> f (Batches v b)
$ctraverse :: forall (v :: * -> *) (f :: * -> *) a b.
(Traversable v, Applicative f) =>
(a -> f b) -> Batches v a -> f (Batches v b)
Traversable, NonEmpty (Batches v a) -> Batches v a
Batches v a -> Batches v a -> Batches v a
forall b. Integral b => b -> Batches v a -> Batches v a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall (v :: * -> *) a. NonEmpty (Batches v a) -> Batches v a
forall (v :: * -> *) a. Batches v a -> Batches v a -> Batches v a
forall (v :: * -> *) a b.
Integral b =>
b -> Batches v a -> Batches v a
stimes :: forall b. Integral b => b -> Batches v a -> Batches v a
$cstimes :: forall (v :: * -> *) a b.
Integral b =>
b -> Batches v a -> Batches v a
sconcat :: NonEmpty (Batches v a) -> Batches v a
$csconcat :: forall (v :: * -> *) a. NonEmpty (Batches v a) -> Batches v a
<> :: Batches v a -> Batches v a -> Batches v a
$c<> :: forall (v :: * -> *) a. Batches v a -> Batches v a -> Batches v a
Semigroup, Batches v a
[Batches v a] -> Batches v a
Batches v a -> Batches v a -> Batches v a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall (v :: * -> *) a. Semigroup (Batches v a)
forall (v :: * -> *) a. Batches v a
forall (v :: * -> *) a. [Batches v a] -> Batches v a
forall (v :: * -> *) a. Batches v a -> Batches v a -> Batches v a
mconcat :: [Batches v a] -> Batches v a
$cmconcat :: forall (v :: * -> *) a. [Batches v a] -> Batches v a
mappend :: Batches v a -> Batches v a -> Batches v a
$cmappend :: forall (v :: * -> *) a. Batches v a -> Batches v a -> Batches v a
mempty :: Batches v a
$cmempty :: forall (v :: * -> *) a. Batches v a
Monoid)

newBatchObserver
  :: ( MonadVulkan env m
     , Resource.MonadResource m
     )
  => "initial size" ::: Int
  -> m BatchObserver
newBatchObserver :: forall env (m :: * -> *).
(MonadVulkan env m, MonadResource m) =>
Int -> m BatchObserver
newBatchObserver Int
initialSize = do
  Allocated 'Coherent InstanceAttrs
initialBuffer <- forall a env (m :: * -> *).
(MonadVulkan env m, Storable a) =>
Maybe Text
-> BufferUsageFlagBits
-> Int
-> Vector a
-> m (Allocated 'Coherent a)
Buffer.createCoherent
    (forall a. a -> Maybe a
Just Text
"Line2D")
    BufferUsageFlagBits
Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT
    Int
initialSize
    forall a. Monoid a => a
mempty
  BatchObserver
observer <- forall (m :: * -> *) a. MonadIO m => a -> m (ObserverIO a)
Worker.newObserverIO (Allocated 'Coherent InstanceAttrs
initialBuffer, [])

  env
context <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$! forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
Resource.register do
    (Allocated 'Coherent InstanceAttrs
currentBuffer, Ranges
_ranges) <- forall (m :: * -> *) a.
MonadUnliftIO m =>
IORef (Versioned a) -> m a
Worker.readObservedIO BatchObserver
observer
    forall (io :: * -> *) context (s :: Store) a.
(MonadUnliftIO io, HasVulkan context) =>
context -> Allocated s a -> io ()
Buffer.destroy env
context Allocated 'Coherent InstanceAttrs
currentBuffer

  pure (BatchObserver
observer :: BatchObserver)

observeCoherentBatches
  :: ( Worker.GetOutput output ~ Batches Storable.Vector InstanceAttrs
     , Worker.HasOutput output
     , MonadVulkan env m
     )
  => output
  -> BatchObserver
  -> m ()
observeCoherentBatches :: forall output env (m :: * -> *).
(GetOutput output ~ Batches Vector InstanceAttrs, HasOutput output,
 MonadVulkan env m) =>
output -> BatchObserver -> m ()
observeCoherentBatches output
source BatchObserver
observer =
  forall (m :: * -> *) output a.
(MonadUnliftIO m, HasOutput output) =>
output -> ObserverIO a -> (a -> GetOutput output -> m a) -> m ()
Worker.observeIO_ output
source BatchObserver
observer \(Allocated 'Coherent InstanceAttrs
buf, Ranges
_ranges) (Batches [Vector InstanceAttrs]
batches) -> do
    let segments :: [Vector InstanceAttrs]
segments = forall (v :: * -> *) a. Vector v a => [v a] -> [v a]
filterSegments [Vector InstanceAttrs]
batches
    Allocated 'Coherent InstanceAttrs
buf' <- forall env (m :: * -> *) a.
(MonadVulkan env m, Storable a) =>
Allocated 'Coherent a -> Vector a -> m (Allocated 'Coherent a)
Buffer.updateCoherentResize_ Allocated 'Coherent InstanceAttrs
buf forall a b. (a -> b) -> a -> b
$
      forall a. Storable a => [Vector a] -> Vector a
Storable.concat [Vector InstanceAttrs]
segments
    pure (Allocated 'Coherent InstanceAttrs
buf', forall (v :: * -> *) a i.
(Vector v a, Integral i) =>
[v a] -> [(i, i)]
toRanges [Vector InstanceAttrs]
segments)

filterSegments
  :: Generic.Vector v a
  => [v a]
  -> [v a]
filterSegments :: forall (v :: * -> *) a. Vector v a => [v a] -> [v a]
filterSegments = forall a. (a -> Bool) -> [a] -> [a]
filter \v a
v ->
  forall (v :: * -> *) a. Vector v a => v a -> Int
Vector.length v a
v forall a. Ord a => a -> a -> Bool
>= Int
2

toRanges
  :: ( Generic.Vector v a
     , Integral i
     )
  => [v a]
  -> [(i, i)]
toRanges :: forall (v :: * -> *) a i.
(Vector v a, Integral i) =>
[v a] -> [(i, i)]
toRanges = forall {b} {v :: * -> *} {a}.
(Num b, Vector v a) =>
[v a] -> [(b, b)]
collect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a. Vector v a => v a -> Bool
Vector.null)
  where
    collect :: [v a] -> [(b, b)]
collect [v a]
v = forall (v :: * -> *) a. Vector v a => v a -> [a]
Vector.toList @Vector forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) a b.
(Vector v a, Vector v b, Vector v (a, b)) =>
v a -> v b -> v (a, b)
Vector.zip Vector b
offsets Vector b
sizes
      where
        sizes :: Vector b
sizes = forall (v :: * -> *) a. Vector v a => [a] -> v a
Vector.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a. Vector v a => v a -> Int
Vector.length) [v a]
v
        offsets :: Vector b
offsets = forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b -> a) -> a -> v b -> v a
Vector.scanl' forall a. Num a => a -> a -> a
(+) b
0 Vector b
sizes