{-# OPTIONS_GHC -Wno-partial-fields #-}

module Mischief.Render.Sprite where

import Data.Text qualified as T
import Linear.V4
import Mischief.ECS
import Mischief.Materials.Sprite (Bindings (..), SpriteData (..))
import Mischief.Math hiding (qd)
import Mischief.Math.Quat qualified as Quat
import Mischief.Math.Transform
import Mischief.Render.Buffer
import Mischief.Render.Camera
import Mischief.Render.Core
import Mischief.Render.Image
import Mischief.Render.Material.Definition
import Mischief.Render.Sprite.Common
import Mischief.Render.Texture

data SpritePlugin

instance Plugin SpritePlugin where
  init :: System ()
init = do
    System () -> SystemConfig
forall a. ToSystems a => a -> SystemConfig
systems System ()
updateSpriteData
      SystemConfig -> (SystemConfig -> System ()) -> System ()
forall a b. a -> (a -> b) -> b
& forall sc. Schedule sc => SystemConfig -> System ()
forall {k} (sc :: k). Schedule sc => SystemConfig -> System ()
schedule @RenderPrepare
  deps :: [Dependency]
deps = [forall p. Plugin p => Dependency
dep @ImageUploadingPlugin]

updateSpriteData :: System ()
updateSpriteData :: System ()
updateSpriteData = Query System () -> System ()
forall w (m :: * -> *) out. MonadSystem w m => Query m out -> m ()
query_ (Query System () -> System ()) -> Query System () -> System ()
forall a b. (a -> b) -> a -> b
$ do
  (sprite, Sprite {image}, GlobalTransform spriteT, slice', SpriteFlip {x = flipX, y = flipY}, buffer, Anchor anchor) <-
    [q|Entity, Sprite, GlobalTransform, Maybe SpriteSlice, SpriteFlip, Maybe (Buffer SpriteData), Anchor
      / Without (Buffer SpriteData) || Changed GlobalTransform || Changed Sprite || Changed SpriteSlice || Changed SpriteFlip || Changed Anchor|]

  ImageTexture Texture {desc} <- qget image [qd|ImageTexture|]

  queue <- qres
  device <- qres

  qlift $ do
    buffer <- case buffer of
      Just Buffer SpriteData
b -> Buffer SpriteData -> System (Buffer SpriteData)
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Buffer SpriteData
b
      Maybe (Buffer SpriteData)
Nothing -> do
        buffer <- forall (a :: * -> *).
Bufferable a =>
RenderDevice -> System (Buffer a)
createBuffer @SpriteData RenderDevice
device
        insert buffer sprite
        pure buffer

    let scale = Float -> Float -> V2 Float
forall a. a -> a -> V2 a
V2 Transform
spriteT.scale.x Transform
spriteT.scale.y

    let size = case Maybe SpriteSlice
slice' of
          Just SpriteSlice {size :: SpriteSlice -> V2 Int
size = V2 Int
x Int
y} -> Float -> Float -> V2 Float
forall a. a -> a -> V2 a
V2 (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) V2 Float -> V2 Float -> V2 Float
forall a. Num a => a -> a -> a
* V2 Float
scale
          Maybe SpriteSlice
Nothing -> Float -> Float -> V2 Float
forall a. a -> a -> V2 a
V2 (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral TextureDescriptor
desc.width) (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral TextureDescriptor
desc.height) V2 Float -> V2 Float -> V2 Float
forall a. Num a => a -> a -> a
* V2 Float
scale

    let slice = case Maybe SpriteSlice
slice' of
          Just SpriteSlice {V2 Int
start :: V2 Int
start :: SpriteSlice -> V2 Int
start, V2 Int
size :: SpriteSlice -> V2 Int
size :: V2 Int
size} ->
            Float -> Float -> Float -> Float -> V4 Float
forall a. a -> a -> a -> a -> V4 a
V4
              (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral V2 Int
start.x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral TextureDescriptor
desc.width)
              (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral V2 Int
start.y Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral TextureDescriptor
desc.height)
              (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral V2 Int
size.x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral TextureDescriptor
desc.width)
              (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral V2 Int
size.y Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral TextureDescriptor
desc.height)
          Maybe SpriteSlice
Nothing -> Float -> Float -> Float -> Float -> V4 Float
forall a. a -> a -> a -> a -> V4 a
V4 Float
0 Float
0 Float
1 Float
1

    let calcFlip Bool
x = if Bool
x then a
1 else a
0
    let flip = Int -> Int -> V2 Int
forall a. a -> a -> V2 a
V2 (Bool -> Int
forall {a}. Num a => Bool -> a
calcFlip Bool
flipY) (Bool -> Int
forall {a}. Num a => Bool -> a
calcFlip Bool
flipX)

    let anchorOffset = (V2 Float
anchor V2 Float -> V2 Float -> V2 Float
forall a. Num a => a -> a -> a
- Float -> Float -> V2 Float
forall a. a -> a -> V2 a
V2 Float
0.5 Float
0.5) V2 Float -> V2 Float -> V2 Float
forall a. Num a => a -> a -> a
* V2 Float
size
    let rotation = V3 (V3 Float) -> V3 (V3 Float)
forall (g :: * -> *) (f :: * -> *) a.
(Distributive g, Functor f) =>
f (g a) -> g (f a)
transpose (V3 (V3 Float) -> V3 (V3 Float)) -> V3 (V3 Float) -> V3 (V3 Float)
forall a b. (a -> b) -> a -> b
$ Quat -> V3 (V3 Float)
Quat.toMat3 Transform
spriteT.rotation

    uploadBuffer queue buffer (SpriteData {coords = spriteT.translation + V3 anchorOffset.x anchorOffset.y 0, size, slice, flip, rotation})

fetchSpriteBindings :: FetchBindings Bindings
fetchSpriteBindings :: FetchBindings Bindings
fetchSpriteBindings =
  (Entity -> Query System (Buffer Matrices, Sampler))
-> (Entity -> Query System (Buffer SpriteData, TextureView))
-> ((Buffer Matrices, Sampler)
    -> (Buffer SpriteData, TextureView) -> Bindings CPU)
-> FetchBindings Bindings
forall x y (b :: * -> *).
Bindable b =>
(Entity -> Query System x)
-> (Entity -> Query System y)
-> (x -> y -> b CPU)
-> FetchBindings b
FetchBindings
    ( \Entity
camera -> do
        (DefaultSampler sampler) <- forall c (m :: * -> *) w.
(MonadSystem w m, Component c) =>
Query m c
qres @DefaultSampler
        CameraMatrices matrices <- qget camera [qd|CameraMatrices|]
        pure (matrices, sampler)
    )
    ( \Entity
sprite -> do
        (Sprite {image}, buffer) <- Entity
-> (C Sprite, C (Buffer SpriteData))
-> Query System (Sprite, Buffer SpriteData)
forall w (m :: * -> *) qd out.
(MonadSystem w m, Queryable qd out) =>
Entity -> qd -> Query m out
qget Entity
sprite [qd|Sprite, (Buffer SpriteData)|]
        ImageTextureView texture <- qget image [qd|ImageTextureView|]
        pure (buffer, texture)
    )
    (\(Buffer Matrices
matrices, Sampler
sampler) (Buffer SpriteData
buffer, TextureView
texture) -> Bindings {Buffer Matrices
Uniform CPU (Matrices CPU)
matrices :: Buffer Matrices
matrices :: Uniform CPU (Matrices CPU)
matrices, Sampler
Binding CPU Sampler
sampler :: Sampler
sampler :: Binding CPU Sampler
sampler, sprite :: Uniform CPU (SpriteData CPU)
sprite = Buffer SpriteData
Uniform CPU (SpriteData CPU)
buffer, TextureView
Binding CPU Texture
texture :: TextureView
texture :: Binding CPU Texture
texture})

-- newtype SpriteBuffer = SpriteBuffer (Buffer SpriteData) deriving anyclass (Component)