{-# 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.Type.Equality (type (~))
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
  Maybe Text
-> Queues CommandPool
-> BufferUsageFlagBits
-> Int
-> Vector Packed
-> m Segment
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
    (Vector Packed -> Int
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 =
  [Packed] -> Vector Packed
forall a. Storable a => [a] -> Vector a
Storable.fromList ([Packed] -> Vector Packed)
-> ([Vec3] -> [Packed]) -> [Vec3] -> Vector Packed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vec3 -> Packed) -> [Vec3] -> [Packed]
forall a b. (a -> b) -> [a] -> [b]
map Vec3 -> Packed
Vec3.Packed ([Vec3] -> Vector Packed) -> [Vec3] -> Vector Packed
forall a b. (a -> b) -> a -> b
$
    [[Vec3]] -> [Vec3]
forall a. Monoid a => [a] -> a
mconcat
      [ [Vec3]
Item [[Vec3]]
segment
      , [Vec3]
Item [[Vec3]]
leftSemi
      , [Vec3]
Item [[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
Item [Float]
resolution]
      let
        theta0 :: Float
theta0 = Float
forall a. Floating a => a
pi Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Float
step Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
0) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
resolution
        theta1 :: Float
theta1 = Float
forall a. Floating a => a
pi Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Float
step Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
1) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi Float -> Float -> Float
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 (Float -> Float
forall a. Floating a => a -> a
cos Float
theta0) (Float -> Float
forall a. Floating a => a -> a
sin Float
theta0) Float
0 Vec3 -> Vec3 -> Vec3
forall a. Num a => a -> a -> a
* Vec3
0.5
        c :: Vec3
c = Float -> Float -> Float -> Vec3
vec3 (Float -> Float
forall a. Floating a => a -> a
cos Float
theta1) (Float -> Float
forall a. Floating a => a -> a
sin Float
theta1) Float
0 Vec3 -> Vec3 -> Vec3
forall a. Num a => a -> a -> a
* Vec3
0.5
      [ Item [Vec3]
Vec3
a, Item [Vec3]
Vec3
b, Item [Vec3]
Vec3
c ]

    rightSemi :: [Vec3]
rightSemi = do
      Float
step <- [Item [Float]
0..Float
Item [Float]
resolution]
      let
        theta0 :: Float
theta0 = Float
3 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Float
step Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
0) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
resolution
        theta1 :: Float
theta1 = Float
3 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Float
step Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
1) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi Float -> Float -> Float
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 (Float -> Float
forall a. Floating a => a -> a
cos Float
theta0) (Float -> Float
forall a. Floating a => a -> a
sin Float
theta0) Float
2 Vec3 -> Vec3 -> Vec3
forall a. Num a => a -> a -> a
* Vec3
0.5
        c :: Vec3
c = Float -> Float -> Float -> Vec3
vec3 (Float -> Float
forall a. Floating a => a -> a
cos Float
theta1) (Float -> Float
forall a. Floating a => a -> a
sin Float
theta1) Float
2 Vec3 -> Vec3 -> Vec3
forall a. Num a => a -> a -> a
* Vec3
0.5
      [ Item [Vec3]
Vec3
a, Item [Vec3]
Vec3
b, Item [Vec3]
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 (Vec2 -> Float -> Vec3
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
(InstanceAttrs -> InstanceAttrs -> Bool)
-> (InstanceAttrs -> InstanceAttrs -> Bool) -> Eq InstanceAttrs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InstanceAttrs -> InstanceAttrs -> Bool
== :: InstanceAttrs -> InstanceAttrs -> Bool
$c/= :: InstanceAttrs -> InstanceAttrs -> Bool
/= :: InstanceAttrs -> InstanceAttrs -> Bool
Eq, Int -> InstanceAttrs -> ShowS
[InstanceAttrs] -> ShowS
InstanceAttrs -> String
(Int -> InstanceAttrs -> ShowS)
-> (InstanceAttrs -> String)
-> ([InstanceAttrs] -> ShowS)
-> Show InstanceAttrs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InstanceAttrs -> ShowS
showsPrec :: Int -> InstanceAttrs -> ShowS
$cshow :: InstanceAttrs -> String
show :: InstanceAttrs -> String
$cshowList :: [InstanceAttrs] -> ShowS
showList :: [InstanceAttrs] -> ShowS
Show, (forall x. InstanceAttrs -> Rep InstanceAttrs x)
-> (forall x. Rep InstanceAttrs x -> InstanceAttrs)
-> Generic InstanceAttrs
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
$cfrom :: forall x. InstanceAttrs -> Rep InstanceAttrs x
from :: forall x. InstanceAttrs -> Rep InstanceAttrs x
$cto :: forall x. Rep InstanceAttrs x -> InstanceAttrs
to :: forall x. Rep InstanceAttrs x -> InstanceAttrs
Generic)

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

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

instance HasVertexInputBindings InstanceAttrs where
  vertexInputBindings :: [VertexInputBinding]
vertexInputBindings =
    -- XXX: instance buffer is bound 2 times with a shift
    Int -> VertexInputBinding -> [VertexInputBinding]
forall a. Int -> a -> [a]
replicate Int
2 (VertexInputBinding -> [VertexInputBinding])
-> VertexInputBinding -> [VertexInputBinding]
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
(Batches v a -> Batches v a -> Bool)
-> (Batches v a -> Batches v a -> Bool) -> Eq (Batches v a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (v :: k -> *) (a :: k).
Eq (v a) =>
Batches v a -> Batches v a -> Bool
$c== :: forall k (v :: k -> *) (a :: k).
Eq (v a) =>
Batches v a -> Batches v a -> Bool
== :: Batches v a -> Batches v a -> Bool
$c/= :: forall k (v :: k -> *) (a :: k).
Eq (v a) =>
Batches v a -> Batches v a -> Bool
/= :: Batches v a -> Batches v a -> Bool
Eq, Int -> Batches v a -> ShowS
[Batches v a] -> ShowS
Batches v a -> String
(Int -> Batches v a -> ShowS)
-> (Batches v a -> String)
-> ([Batches v a] -> ShowS)
-> Show (Batches v a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (v :: k -> *) (a :: k).
Show (v a) =>
Int -> Batches v a -> ShowS
forall k (v :: k -> *) (a :: k).
Show (v a) =>
[Batches v a] -> ShowS
forall k (v :: k -> *) (a :: k).
Show (v a) =>
Batches v a -> String
$cshowsPrec :: forall k (v :: k -> *) (a :: k).
Show (v a) =>
Int -> Batches v a -> ShowS
showsPrec :: Int -> Batches v a -> ShowS
$cshow :: forall k (v :: k -> *) (a :: k).
Show (v a) =>
Batches v a -> String
show :: Batches v a -> String
$cshowList :: forall k (v :: k -> *) (a :: k).
Show (v a) =>
[Batches v a] -> ShowS
showList :: [Batches v a] -> ShowS
Show, Eq (Batches v a)
Eq (Batches v a)
-> (Batches v a -> Batches v a -> Ordering)
-> (Batches v a -> Batches v a -> Bool)
-> (Batches v a -> Batches v a -> Bool)
-> (Batches v a -> Batches v a -> Bool)
-> (Batches v a -> Batches v a -> Bool)
-> (Batches v a -> Batches v a -> Batches v a)
-> (Batches v a -> Batches v a -> Batches v a)
-> Ord (Batches v a)
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 {k} {v :: k -> *} {a :: k}. Ord (v a) => Eq (Batches v a)
forall k (v :: k -> *) (a :: k).
Ord (v a) =>
Batches v a -> Batches v a -> Bool
forall k (v :: k -> *) (a :: k).
Ord (v a) =>
Batches v a -> Batches v a -> Ordering
forall k (v :: k -> *) (a :: k).
Ord (v a) =>
Batches v a -> Batches v a -> Batches v a
$ccompare :: forall k (v :: k -> *) (a :: k).
Ord (v a) =>
Batches v a -> Batches v a -> Ordering
compare :: Batches v a -> Batches v a -> Ordering
$c< :: forall k (v :: k -> *) (a :: k).
Ord (v a) =>
Batches v a -> Batches v a -> Bool
< :: Batches v a -> Batches v a -> Bool
$c<= :: forall k (v :: k -> *) (a :: k).
Ord (v a) =>
Batches v a -> Batches v a -> Bool
<= :: Batches v a -> Batches v a -> Bool
$c> :: forall k (v :: k -> *) (a :: k).
Ord (v a) =>
Batches v a -> Batches v a -> Bool
> :: Batches v a -> Batches v a -> Bool
$c>= :: forall k (v :: k -> *) (a :: k).
Ord (v a) =>
Batches v a -> Batches v a -> Bool
>= :: Batches v a -> Batches v a -> Bool
$cmax :: forall k (v :: k -> *) (a :: k).
Ord (v a) =>
Batches v a -> Batches v a -> Batches v a
max :: Batches v a -> Batches v a -> Batches v a
$cmin :: forall k (v :: k -> *) (a :: k).
Ord (v a) =>
Batches v a -> Batches v a -> Batches v a
min :: Batches v a -> Batches v a -> Batches v a
Ord, (forall a b. (a -> b) -> Batches v a -> Batches v b)
-> (forall a b. a -> Batches v b -> Batches v a)
-> Functor (Batches v)
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
$cfmap :: forall (v :: * -> *) a b.
Functor v =>
(a -> b) -> Batches v a -> Batches v b
fmap :: forall a b. (a -> b) -> Batches v a -> Batches v b
$c<$ :: forall (v :: * -> *) a b.
Functor v =>
a -> Batches v b -> Batches v a
<$ :: forall a b. a -> Batches v b -> Batches v a
Functor, (forall m. Monoid m => Batches v m -> m)
-> (forall m a. Monoid m => (a -> m) -> Batches v a -> m)
-> (forall m a. Monoid m => (a -> m) -> Batches v a -> m)
-> (forall a b. (a -> b -> b) -> b -> Batches v a -> b)
-> (forall a b. (a -> b -> b) -> b -> Batches v a -> b)
-> (forall b a. (b -> a -> b) -> b -> Batches v a -> b)
-> (forall b a. (b -> a -> b) -> b -> Batches v a -> b)
-> (forall a. (a -> a -> a) -> Batches v a -> a)
-> (forall a. (a -> a -> a) -> Batches v a -> a)
-> (forall a. Batches v a -> [a])
-> (forall a. Batches v a -> Bool)
-> (forall a. Batches v a -> Int)
-> (forall a. Eq a => a -> Batches v a -> Bool)
-> (forall a. Ord a => Batches v a -> a)
-> (forall a. Ord a => Batches v a -> a)
-> (forall a. Num a => Batches v a -> a)
-> (forall a. Num a => Batches v a -> a)
-> Foldable (Batches v)
forall a. Eq a => a -> Batches v a -> Bool
forall a. Num a => Batches v a -> a
forall a. Ord a => Batches v a -> a
forall m. Monoid m => Batches v m -> m
forall a. Batches v a -> Bool
forall a. Batches v a -> Int
forall a. Batches v a -> [a]
forall a. (a -> a -> a) -> Batches v a -> a
forall m a. Monoid m => (a -> m) -> Batches v a -> m
forall b a. (b -> a -> b) -> b -> Batches v a -> b
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
$cfold :: forall (v :: * -> *) m. (Foldable v, Monoid m) => Batches v m -> m
fold :: forall m. Monoid m => Batches v m -> 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
foldMap' :: forall m a. Monoid m => (a -> m) -> Batches v a -> m
$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
foldr' :: forall a b. (a -> b -> 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
foldl' :: forall b a. (b -> a -> b) -> b -> Batches v a -> b
$cfoldr1 :: forall (v :: * -> *) a.
Foldable v =>
(a -> a -> a) -> Batches v a -> a
foldr1 :: forall a. (a -> a -> a) -> Batches v a -> a
$cfoldl1 :: forall (v :: * -> *) a.
Foldable v =>
(a -> a -> a) -> Batches v a -> a
foldl1 :: forall a. (a -> a -> a) -> Batches v a -> a
$ctoList :: forall (v :: * -> *) a. Foldable v => Batches v a -> [a]
toList :: forall a. Batches v a -> [a]
$cnull :: forall (v :: * -> *) a. Foldable v => Batches v a -> Bool
null :: forall a. Batches v a -> Bool
$clength :: forall (v :: * -> *) a. Foldable v => Batches v a -> Int
length :: forall a. Batches v a -> Int
$celem :: forall (v :: * -> *) a.
(Foldable v, Eq a) =>
a -> Batches v a -> Bool
elem :: forall a. Eq a => a -> Batches v a -> Bool
$cmaximum :: forall (v :: * -> *) a. (Foldable v, Ord a) => Batches v a -> a
maximum :: forall a. Ord a => Batches v a -> a
$cminimum :: forall (v :: * -> *) a. (Foldable v, Ord a) => Batches v a -> a
minimum :: forall a. Ord a => Batches v a -> a
$csum :: forall (v :: * -> *) a. (Foldable v, Num a) => Batches v a -> a
sum :: forall a. Num a => Batches v a -> a
$cproduct :: forall (v :: * -> *) a. (Foldable v, Num a) => Batches v a -> a
product :: forall a. Num a => Batches v a -> a
Foldable, Functor (Batches v)
Foldable (Batches v)
Functor (Batches v)
-> Foldable (Batches v)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Batches v a -> f (Batches v b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Batches v (f a) -> f (Batches v a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Batches v a -> m (Batches v b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Batches v (m a) -> m (Batches v a))
-> Traversable (Batches v)
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 (m :: * -> *) a.
Monad m =>
Batches v (m a) -> m (Batches v a)
forall (f :: * -> *) a.
Applicative f =>
Batches v (f a) -> f (Batches v a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Batches v a -> m (Batches v b)
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)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Batches v a -> f (Batches v b)
$csequenceA :: forall (v :: * -> *) (f :: * -> *) a.
(Traversable v, Applicative f) =>
Batches v (f a) -> f (Batches v a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Batches v (f a) -> f (Batches v a)
$cmapM :: forall (v :: * -> *) (m :: * -> *) a b.
(Traversable v, Monad m) =>
(a -> m b) -> Batches v a -> m (Batches v b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Batches v a -> m (Batches v b)
$csequence :: forall (v :: * -> *) (m :: * -> *) a.
(Traversable v, Monad m) =>
Batches v (m a) -> m (Batches v a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Batches v (m a) -> m (Batches v a)
Traversable, NonEmpty (Batches v a) -> Batches v a
Batches v a -> Batches v a -> Batches v a
(Batches v a -> Batches v a -> Batches v a)
-> (NonEmpty (Batches v a) -> Batches v a)
-> (forall b. Integral b => b -> Batches v a -> Batches v a)
-> Semigroup (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 k (v :: k -> *) (a :: k).
NonEmpty (Batches v a) -> Batches v a
forall k (v :: k -> *) (a :: k).
Batches v a -> Batches v a -> Batches v a
forall k (v :: k -> *) (a :: k) b.
Integral b =>
b -> Batches v a -> Batches v a
$c<> :: forall k (v :: k -> *) (a :: k).
Batches v a -> Batches v a -> Batches v a
<> :: Batches v a -> Batches v a -> Batches v a
$csconcat :: forall k (v :: k -> *) (a :: k).
NonEmpty (Batches v a) -> Batches v a
sconcat :: NonEmpty (Batches v a) -> Batches v a
$cstimes :: forall k (v :: k -> *) (a :: k) b.
Integral b =>
b -> Batches v a -> Batches v a
stimes :: forall b. Integral b => b -> Batches v a -> Batches v a
Semigroup, Semigroup (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] -> Batches v a)
-> Monoid (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 k (v :: k -> *) (a :: k). Semigroup (Batches v a)
forall k (v :: k -> *) (a :: k). Batches v a
forall k (v :: k -> *) (a :: k). [Batches v a] -> Batches v a
forall k (v :: k -> *) (a :: k).
Batches v a -> Batches v a -> Batches v a
$cmempty :: forall k (v :: k -> *) (a :: k). Batches v a
mempty :: Batches v a
$cmappend :: forall k (v :: k -> *) (a :: k).
Batches v a -> Batches v a -> Batches v a
mappend :: Batches v a -> Batches v a -> Batches v a
$cmconcat :: forall k (v :: k -> *) (a :: k). [Batches v a] -> Batches v a
mconcat :: [Batches 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 <- Maybe Text
-> BufferUsageFlagBits
-> Int
-> Vector InstanceAttrs
-> m (Allocated 'Coherent InstanceAttrs)
forall a env (m :: * -> *).
(MonadVulkan env m, Storable a) =>
Maybe Text
-> BufferUsageFlagBits
-> Int
-> Vector a
-> m (Allocated 'Coherent a)
Buffer.createCoherent
    (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Line2D")
    BufferUsageFlagBits
Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT
    Int
initialSize
    Vector InstanceAttrs
forall a. Monoid a => a
mempty
  BatchObserver
observer <- (Allocated 'Coherent InstanceAttrs, Ranges) -> m BatchObserver
forall (m :: * -> *) a. MonadIO m => a -> m (ObserverIO a)
Worker.newObserverIO (Allocated 'Coherent InstanceAttrs
initialBuffer, [])

  env
context <- m env
forall r (m :: * -> *). MonadReader r m => m r
ask
  m ReleaseKey -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ReleaseKey -> m ()) -> m ReleaseKey -> m ()
forall a b. (a -> b) -> a -> b
$! IO () -> m ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
Resource.register do
    (Allocated 'Coherent InstanceAttrs
currentBuffer, Ranges
_ranges) <- BatchObserver -> IO (Allocated 'Coherent InstanceAttrs, Ranges)
forall (m :: * -> *) a.
MonadUnliftIO m =>
IORef (Versioned a) -> m a
Worker.readObservedIO BatchObserver
observer
    env -> Allocated 'Coherent InstanceAttrs -> IO ()
forall {k} (io :: * -> *) context (s :: Store) (a :: k).
(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 =
  output
-> BatchObserver
-> ((Allocated 'Coherent InstanceAttrs, Ranges)
    -> GetOutput output
    -> m (Allocated 'Coherent InstanceAttrs, Ranges))
-> m ()
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 = [Vector InstanceAttrs] -> [Vector InstanceAttrs]
forall (v :: * -> *) a. Vector v a => [v a] -> [v a]
filterSegments [Vector InstanceAttrs]
batches
    Allocated 'Coherent InstanceAttrs
buf' <- Allocated 'Coherent InstanceAttrs
-> Vector InstanceAttrs -> m (Allocated 'Coherent InstanceAttrs)
forall env (m :: * -> *) a.
(MonadVulkan env m, Storable a) =>
Allocated 'Coherent a -> Vector a -> m (Allocated 'Coherent a)
Buffer.updateCoherentResize_ Allocated 'Coherent InstanceAttrs
buf (Vector InstanceAttrs -> m (Allocated 'Coherent InstanceAttrs))
-> Vector InstanceAttrs -> m (Allocated 'Coherent InstanceAttrs)
forall a b. (a -> b) -> a -> b
$
      [Vector InstanceAttrs] -> Vector InstanceAttrs
forall a. Storable a => [Vector a] -> Vector a
Storable.concat [Vector InstanceAttrs]
segments
    pure (Allocated 'Coherent InstanceAttrs
buf', [Vector InstanceAttrs] -> Ranges
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 = (v a -> Bool) -> [v a] -> [v a]
forall a. (a -> Bool) -> [a] -> [a]
filter \v a
v ->
  v a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
Vector.length v a
v Int -> Int -> Bool
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 = [v a] -> [(i, i)]
forall {b} {v :: * -> *} {a}.
(Num b, Vector v a) =>
[v a] -> [(b, b)]
collect ([v a] -> [(i, i)]) -> ([v a] -> [v a]) -> [v a] -> [(i, i)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v a -> Bool) -> [v a] -> [v a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (v a -> Bool) -> v a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v a -> Bool
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 (Vector (b, b) -> [(b, b)]) -> Vector (b, b) -> [(b, b)]
forall a b. (a -> b) -> a -> b
$ Vector b -> Vector b -> Vector (b, 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 = [b] -> Vector b
forall (v :: * -> *) a. Vector v a => [a] -> v a
Vector.fromList ([b] -> Vector b) -> [b] -> Vector b
forall a b. (a -> b) -> a -> b
$ (v a -> b) -> [v a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> b) -> (v a -> Int) -> v a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
Vector.length) [v a]
v
        offsets :: Vector b
offsets = (b -> b -> b) -> b -> Vector b -> Vector b
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b -> a) -> a -> v b -> v a
Vector.scanl' b -> b -> b
forall a. Num a => a -> a -> a
(+) b
0 Vector b
sizes