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

{-# LANGUAGE DeriveAnyClass #-}

module Render.Unlit.TileMap.Model
  ( Model

    -- * Vertex data
  , Vertex
  , VertexAttrs

    -- * Instance data
  , AttrsF(..)
  , Attrs
  , Stores
  , Buffers

  , TileMapParams(..)

  , ObserverCoherent
  ) where

import RIO

import Foreign.Storable.Generic (GStorable)
import Geomancy (IVec4, Transform, Vec2)
import Geomancy.Vec3 qualified as Vec3
import RIO.Vector.Storable qualified as Storable
import Vulkan.NamedType ((:::))
import Vulkan.Zero (Zero(..))

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

-- XXX: Can be a quad, full screen-triangle or fancy-shaped viewport.
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 TileMapParams
params     :: HKD f TileMapParams
  , 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
-- XXX: not correct, but shouldn't be needed
-- instance GStorable Attrs

instance HasVertexInputBindings Attrs where
  vertexInputBindings :: [VertexInputBinding]
vertexInputBindings =
    [ forall a. HasVkFormat a => VertexInputBinding
instanceFormat @TileMapParams
    , 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

data TileMapParams = TileMapParams
  { TileMapParams -> IVec4
tmpTextureIds         :: IVec4
  , TileMapParams -> Vec2
tmpViewOffset         :: Vec2
  , TileMapParams -> Vec2
tmpViewportSize       :: Vec2
  , TileMapParams -> Vec2
tmpMapTextureSize     :: Vec2
  , TileMapParams -> Vec2
tmpTilesetTextureSize :: Vec2
  , TileMapParams -> Vec2
tmpTileSize           :: Vec2
  , TileMapParams -> Vec2
tmpTilesetOffset      :: Vec2
  , TileMapParams -> Vec2
tmpTilesetBorder      :: Vec2
  }
  deriving (forall x. Rep TileMapParams x -> TileMapParams
forall x. TileMapParams -> Rep TileMapParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TileMapParams x -> TileMapParams
$cfrom :: forall x. TileMapParams -> Rep TileMapParams x
Generic, Int -> TileMapParams -> ShowS
[TileMapParams] -> ShowS
TileMapParams -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TileMapParams] -> ShowS
$cshowList :: [TileMapParams] -> ShowS
show :: TileMapParams -> String
$cshow :: TileMapParams -> String
showsPrec :: Int -> TileMapParams -> ShowS
$cshowsPrec :: Int -> TileMapParams -> ShowS
Show, [Format]
forall a. [Format] -> HasVkFormat a
getVkFormat :: [Format]
$cgetVkFormat :: [Format]
HasVkFormat)

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

instance Zero TileMapParams where
  zero :: TileMapParams
zero = TileMapParams
    { $sel:tmpTextureIds:TileMapParams :: IVec4
tmpTextureIds         = IVec4
0
    , $sel:tmpViewOffset:TileMapParams :: Vec2
tmpViewOffset         = Vec2
0
    , $sel:tmpViewportSize:TileMapParams :: Vec2
tmpViewportSize       = Vec2
1
    , $sel:tmpMapTextureSize:TileMapParams :: Vec2
tmpMapTextureSize     = Vec2
1
    , $sel:tmpTilesetTextureSize:TileMapParams :: Vec2
tmpTilesetTextureSize = Vec2
1
    , $sel:tmpTileSize:TileMapParams :: Vec2
tmpTileSize           = Vec2
1
    , $sel:tmpTilesetOffset:TileMapParams :: Vec2
tmpTilesetOffset      = Vec2
0
    , $sel:tmpTilesetBorder:TileMapParams :: Vec2
tmpTilesetBorder      = Vec2
0
    }