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

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedRecordDot #-}

module Render.Unlit.Textured.Model
  ( Model
  , Vertex
  , VertexAttrs

  , AttrsF(..)
  , Attrs
  , attrs

  , Stores
  , attrStores
  , stores1
  , Buffers

  , TextureParams(..)

  , ObserverCoherent
  ) where

import RIO

import Geomancy (Transform, Vec2, Vec4)
import Geomancy.Vec3 qualified as Vec3
import RIO.Vector.Storable qualified as Storable
import Vulkan.Core10 qualified as Vk
import Vulkan.NamedType ((:::))
import Vulkan.Zero (Zero(..))
import Geomancy.Gl.Block (Block)
import Geomancy.Gl.Block qualified as Block

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

type Model buf = Model.Indexed buf Vec3.Packed VertexAttrs
type Vertex = Model.Vertex3d VertexAttrs

type VertexAttrs = "uv" ::: Vec2

data AttrsF f = Attrs
  { forall (f :: * -> *). AttrsF f -> HKD f TextureParams
params     :: HKD f TextureParams
  , forall (f :: * -> *). AttrsF f -> HKD f Transform
transforms :: HKD f Transform
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (AttrsF f) x -> AttrsF f
forall (f :: * -> *) x. AttrsF f -> Rep (AttrsF f) x
$cto :: forall (f :: * -> *) x. Rep (AttrsF f) x -> AttrsF f
$cfrom :: forall (f :: * -> *) x. AttrsF f -> Rep (AttrsF f) x
Generic)

type Attrs = AttrsF Identity
deriving instance Show Attrs

instance HasVertexInputBindings Attrs where
  vertexInputBindings :: [VertexInputBinding]
vertexInputBindings =
    [ forall a. HasVkFormat a => VertexInputBinding
instanceFormat @TextureParams
    , forall a. HasVkFormat a => VertexInputBinding
instanceFormat @Transform
    ]

type Stores = AttrsF Storable.Vector
deriving instance Show Stores

type Buffers = AttrsF (Buffer.Allocated 'Buffer.Coherent)
deriving instance Show Buffers
instance Observer.VertexBuffers Buffers
type ObserverCoherent = Worker.ObserverIO Buffers

instance Observer.UpdateCoherent Buffers Stores

instance Model.HasVertexBuffers Buffers where
  type VertexBuffersOf Buffers = Attrs

instance Zero Attrs where
  zero :: Attrs
zero = Attrs
    { $sel:params:Attrs :: HKD Identity TextureParams
params = forall a. Zero a => a
zero
    , $sel:transforms:Attrs :: HKD Identity Transform
transforms = forall a. Monoid a => a
mempty
    }

attrs :: Int32 -> Int32 -> [Transform] -> Attrs
attrs :: Int32 -> Int32 -> [Transform] -> Attrs
attrs Int32
samplerId Int32
textureId [Transform]
transforms = Attrs
  { $sel:params:Attrs :: HKD Identity TextureParams
params = forall a. Zero a => a
zero
      { $sel:tpSamplerId:TextureParams :: Int32
tpSamplerId = Int32
samplerId
      , $sel:tpTextureId:TextureParams :: Int32
tpTextureId = Int32
textureId
      }
  , $sel:transforms:Attrs :: HKD Identity Transform
transforms = forall a. Monoid a => [a] -> a
mconcat [Transform]
transforms
  }

attrStores :: Foldable t => t Attrs -> Stores
attrStores :: forall (t :: * -> *). Foldable t => t Attrs -> Stores
attrStores t Attrs
source = Attrs
  { $sel:params:Attrs :: HKD Vector TextureParams
params = forall a. Storable a => [a] -> Vector a
Storable.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (.params) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Attrs
source
  , $sel:transforms:Attrs :: HKD Vector Transform
transforms = forall a. Storable a => [a] -> Vector a
Storable.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (.transforms) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Attrs
source
  }

stores1 :: Int32 -> Int32 -> [Transform] -> Stores
stores1 :: Int32 -> Int32 -> [Transform] -> Stores
stores1 Int32
samplerId Int32
textureId [Transform]
transforms =
  Attrs
    { $sel:params:Attrs :: HKD Vector TextureParams
params = forall a. Storable a => a -> Vector a
Storable.singleton Attrs
attrs1.params
    , $sel:transforms:Attrs :: HKD Vector Transform
transforms = forall a. Storable a => a -> Vector a
Storable.singleton Attrs
attrs1.transforms
    }
  where
    attrs1 :: Attrs
attrs1 = Int32 -> Int32 -> [Transform] -> Attrs
attrs
      Int32
samplerId
      Int32
textureId
      [Transform]
transforms

data TextureParams = TextureParams
  { TextureParams -> Vec2
tpScale     :: Vec2
  , TextureParams -> Vec2
tpOffset    :: Vec2
  , TextureParams -> Vec4
tpGamma     :: Vec4
  , TextureParams -> Int32
tpSamplerId :: Int32
  , TextureParams -> Int32
tpTextureId :: Int32
  }
  deriving (forall x. Rep TextureParams x -> TextureParams
forall x. TextureParams -> Rep TextureParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextureParams x -> TextureParams
$cfrom :: forall x. TextureParams -> Rep TextureParams x
Generic, Int -> TextureParams -> ShowS
[TextureParams] -> ShowS
TextureParams -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextureParams] -> ShowS
$cshowList :: [TextureParams] -> ShowS
show :: TextureParams -> String
$cshow :: TextureParams -> String
showsPrec :: Int -> TextureParams -> ShowS
$cshowsPrec :: Int -> TextureParams -> ShowS
Show, forall b.
(forall (proxy :: * -> *). proxy b -> Int)
-> (forall (proxy :: * -> *). proxy b -> Int)
-> (forall (proxy :: * -> *). proxy b -> Bool)
-> (forall (m :: * -> *) a. MonadIO m => Ptr a -> Diff a b -> m b)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a b -> b -> m ())
-> (forall (proxy :: * -> *). proxy b -> Int)
-> (forall (proxy :: * -> *). proxy b -> Int)
-> (forall (m :: * -> *) a. MonadIO m => Ptr a -> Diff a b -> m b)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a b -> b -> m ())
-> (forall (proxy :: * -> *). proxy b -> Int)
-> (forall (m :: * -> *) a. MonadIO m => Ptr a -> Diff a b -> m b)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a b -> b -> m ())
-> Block b
forall (proxy :: * -> *). proxy TextureParams -> Bool
forall (proxy :: * -> *). proxy TextureParams -> Int
forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> m TextureParams
forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> TextureParams -> m ()
writePacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> TextureParams -> m ()
$cwritePacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> TextureParams -> m ()
readPacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> m TextureParams
$creadPacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> m TextureParams
sizeOfPacked :: forall (proxy :: * -> *). proxy TextureParams -> Int
$csizeOfPacked :: forall (proxy :: * -> *). proxy TextureParams -> Int
write430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> TextureParams -> m ()
$cwrite430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> TextureParams -> m ()
read430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> m TextureParams
$cread430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> m TextureParams
sizeOf430 :: forall (proxy :: * -> *). proxy TextureParams -> Int
$csizeOf430 :: forall (proxy :: * -> *). proxy TextureParams -> Int
alignment430 :: forall (proxy :: * -> *). proxy TextureParams -> Int
$calignment430 :: forall (proxy :: * -> *). proxy TextureParams -> Int
write140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> TextureParams -> m ()
$cwrite140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> TextureParams -> m ()
read140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> m TextureParams
$cread140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a TextureParams -> m TextureParams
isStruct :: forall (proxy :: * -> *). proxy TextureParams -> Bool
$cisStruct :: forall (proxy :: * -> *). proxy TextureParams -> Bool
sizeOf140 :: forall (proxy :: * -> *). proxy TextureParams -> Int
$csizeOf140 :: forall (proxy :: * -> *). proxy TextureParams -> Int
alignment140 :: forall (proxy :: * -> *). proxy TextureParams -> Int
$calignment140 :: forall (proxy :: * -> *). proxy TextureParams -> Int
Block)
  deriving Ptr TextureParams -> IO TextureParams
Ptr TextureParams -> Int -> IO TextureParams
Ptr TextureParams -> Int -> TextureParams -> IO ()
Ptr TextureParams -> TextureParams -> IO ()
TextureParams -> Int
forall b. Ptr b -> Int -> IO TextureParams
forall b. Ptr b -> Int -> TextureParams -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr TextureParams -> TextureParams -> IO ()
$cpoke :: Ptr TextureParams -> TextureParams -> IO ()
peek :: Ptr TextureParams -> IO TextureParams
$cpeek :: Ptr TextureParams -> IO TextureParams
pokeByteOff :: forall b. Ptr b -> Int -> TextureParams -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> TextureParams -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO TextureParams
$cpeekByteOff :: forall b. Ptr b -> Int -> IO TextureParams
pokeElemOff :: Ptr TextureParams -> Int -> TextureParams -> IO ()
$cpokeElemOff :: Ptr TextureParams -> Int -> TextureParams -> IO ()
peekElemOff :: Ptr TextureParams -> Int -> IO TextureParams
$cpeekElemOff :: Ptr TextureParams -> Int -> IO TextureParams
alignment :: TextureParams -> Int
$calignment :: TextureParams -> Int
sizeOf :: TextureParams -> Int
$csizeOf :: TextureParams -> Int
Storable via (Block.Packed TextureParams)

instance Zero TextureParams where
  zero :: TextureParams
zero = TextureParams
    { $sel:tpScale:TextureParams :: Vec2
tpScale     = Vec2
1.0
    , $sel:tpOffset:TextureParams :: Vec2
tpOffset    = Vec2
0.0
    , $sel:tpGamma:TextureParams :: Vec4
tpGamma     = Vec4
1.0
    , $sel:tpSamplerId:TextureParams :: Int32
tpSamplerId = forall a. Bounded a => a
minBound
    , $sel:tpTextureId:TextureParams :: Int32
tpTextureId = forall a. Bounded a => a
minBound
    }

instance HasVkFormat TextureParams where
  getVkFormat :: [Format]
getVkFormat =
    [ Format
Vk.FORMAT_R32G32B32A32_SFLOAT -- iTextureScaleOffset :: vec4
    , Format
Vk.FORMAT_R32G32B32A32_SFLOAT -- iTextureGamma       :: vec4
    , Format
Vk.FORMAT_R32G32_SINT         -- iTextureIds         :: ivec2
    ]