{-# 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
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)
instance GStorable InstanceAttrs
instance HasVkFormat InstanceAttrs where
getVkFormat :: [Format]
getVkFormat =
[ Item [Format]
Format
Vk.FORMAT_R32G32B32A32_SFLOAT
, Item [Format]
Format
Vk.FORMAT_R32G32B32A32_SFLOAT
]
instance HasVertexInputBindings InstanceAttrs where
vertexInputBindings :: [VertexInputBinding]
vertexInputBindings =
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