Model.hs

{-# 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
  { params     :: HKD f TileMapParams
  , transforms :: HKD f Transform
  }
  deriving (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 =
    [ instanceFormat @TileMapParams
    , 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
  { tmpTextureIds         :: IVec4
  , tmpViewOffset         :: Vec2
  , tmpViewportSize       :: Vec2
  , tmpMapTextureSize     :: Vec2
  , tmpTilesetTextureSize :: Vec2
  , tmpTileSize           :: Vec2
  , tmpTilesetOffset      :: Vec2
  , tmpTilesetBorder      :: Vec2
  }
  deriving (Generic, Show, HasVkFormat)

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

instance Zero TileMapParams where
  zero = TileMapParams
    { tmpTextureIds         = 0
    , tmpViewOffset         = 0
    , tmpViewportSize       = 1
    , tmpMapTextureSize     = 1
    , tmpTilesetTextureSize = 1
    , tmpTileSize           = 1
    , tmpTilesetOffset      = 0
    , tmpTilesetBorder      = 0
    }