{-# LANGUAGE DeriveAnyClass #-}

module Resource.Model.Observer.Example where

import RIO

import Control.Monad.Trans.Resource (ResourceT)
import Data.Vector.Storable qualified as Storable

import Engine.Types (HKD, StageRIO)
import Engine.Vulkan.Types (MonadVulkan)
import Engine.Worker qualified as Worker
import Resource.Buffer qualified as Buffer
import Resource.Model.Observer qualified as Observer

data ExampleF f = Example
  { forall (f :: * -> *). ExampleF f -> HKD f Float
x :: HKD f Float
  , forall (f :: * -> *). ExampleF f -> HKD f Float
y :: HKD f Float
  }
  deriving ((forall x. ExampleF f -> Rep (ExampleF f) x)
-> (forall x. Rep (ExampleF f) x -> ExampleF f)
-> Generic (ExampleF f)
forall x. Rep (ExampleF f) x -> ExampleF f
forall x. ExampleF f -> Rep (ExampleF f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (ExampleF f) x -> ExampleF f
forall (f :: * -> *) x. ExampleF f -> Rep (ExampleF f) x
$cfrom :: forall (f :: * -> *) x. ExampleF f -> Rep (ExampleF f) x
from :: forall x. ExampleF f -> Rep (ExampleF f) x
$cto :: forall (f :: * -> *) x. Rep (ExampleF f) x -> ExampleF f
to :: forall x. Rep (ExampleF f) x -> ExampleF f
Generic)

type Example = ExampleF Identity
deriving instance Show Example
{- DON'T: instance GStorable Example.

Vertex attributes are packed while GStorable gives something like std140.
-}

type ExampleStores = ExampleF Storable.Vector
deriving instance Show ExampleStores

type ExampleBuffers = ExampleF (Buffer.Allocated 'Buffer.Coherent)
deriving instance Show ExampleBuffers
instance Observer.VertexBuffers ExampleBuffers

instance Observer.UpdateCoherent ExampleBuffers ExampleStores

{-# DEPRECATED new "Just use Observer.newCoherent" #-}
new :: ResourceT (StageRIO st) (Worker.ObserverIO ExampleBuffers)
new :: forall st. ResourceT (StageRIO st) (ObserverIO ExampleBuffers)
new = Int -> Text -> ResourceT (StageRIO st) (ObserverIO ExampleBuffers)
forall res env (m :: * -> *).
(VertexBuffers res, MonadVulkan env m) =>
Int -> Text -> ResourceT m (ObserverIO res)
Observer.newCoherent Int
1 Text
"SomeExample"

{-# DEPRECATED update "Just use Observer.updateCoherent" #-}
update :: MonadVulkan env m => ExampleBuffers -> ExampleStores -> m ExampleBuffers
update :: forall env (m :: * -> *).
MonadVulkan env m =>
ExampleBuffers -> ExampleStores -> m ExampleBuffers
update = ExampleBuffers -> ExampleStores -> m ExampleBuffers
forall bufs stores env (m :: * -> *).
(UpdateCoherent bufs stores, MonadVulkan env m) =>
bufs -> stores -> m bufs
forall env (m :: * -> *).
MonadVulkan env m =>
ExampleBuffers -> ExampleStores -> m ExampleBuffers
Observer.updateCoherent