--{-# LANGUAGE TupleSections #-}
{-# LANGUAGE BangPatterns #-}
module Shader.Poke
    ( pokeVerxs
    , pokeLayVerxs
    , pokeArrayOff
    , pokePoint3s
    , pokePoint33s
    , poke224s
    ) where
import Shader.Data
import Shader.Parameters
import Picture.Data
import Geometry.Data

import Foreign
import qualified Data.Vector.Unboxed.Mutable as UMV
import qualified Data.Vector.Mutable as MV
import qualified Data.Vector.Fusion.Stream.Monadic as VS
import Control.Monad.Primitive

pokeVerxs 
    :: MV.MVector (PrimState IO) FullShader
    -> UMV.MVector (PrimState IO) Int 
    -> [Verx] 
    -> IO ()
pokeVerxs vbos count vxs = VS.mapM_ (pokeVerx vbos count) $ VS.fromList vxs

pokeVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do
    typeOff <- UMV.unsafeRead offsets sn
    basePtr <- _vboPtr . _vaoVBO . _shaderVAO <$> MV.read vbos sn
    let thePtr = plusPtr basePtr (typeOff * pokeStride sn * floatSize)
    poke34 thePtr thePos theCol
    pokeArrayOff thePtr 7 ext
    UMV.unsafeModify offsets (+1) sn
  where
    sn = _unShadNum theShadNum

pokeLayVerxs 
    :: MV.MVector (PrimState IO) FullShader 
    -> UMV.MVector (PrimState IO) Int
    -> [Verx] 
    -> IO ()
pokeLayVerxs vbos counts vxs = VS.mapM_ (pokeLayVerx vbos counts) $ VS.fromList vxs

pokeLayVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
--{-# INLINE pokeLayVerx #-}
pokeLayVerx vbos counts vx = do
    theOff <- UMV.unsafeRead counts vecPos
    basePtr <- _vboPtr . _vaoVBO . _shaderVAO <$> MV.unsafeRead vbos sn
    let thePtr = plusPtr basePtr ((theOff + layOff) * theStride * floatSize)
    poke34 thePtr thePos theCol
    pokeArrayOff thePtr 7 (_vxExt vx)
    UMV.unsafeModify counts (+ 1) vecPos
  where
    sn = _unShadNum (_vxShadNum vx)
    vecPos = theLayer * 6 + sn
    theLayer = _vxLayer vx
    thePos = _vxPos vx
    theCol = _vxCol vx
    layOff = theLayer * numSubElements
    theStride = pokeStride sn

pokeStride :: Int -> Int
{-# INLINE pokeStride #-}
pokeStride 0 = 7
pokeStride 1 = 8
pokeStride 2 = 11
pokeStride 3 = 9
pokeStride 4 = 10
pokeStride 5 = 7
pokeStride _ = undefined


poke34 :: Ptr Float -> Point3 -> Point4 -> IO ()
{-# INLINE poke34 #-}
poke34 ptr (V3 a b c) (V4 d e f g) = do
    pokeElemOff ptr 0 a
    pokeElemOff ptr 1 b
    pokeElemOff ptr 2 c
    pokeElemOff ptr 3 d
    pokeElemOff ptr 4 e
    pokeElemOff ptr 5 f
    pokeElemOff ptr 6 g

pokeArrayOff :: Ptr Float -> Int -> [Float] -> IO ()
{-# INLINE pokeArrayOff #-}
pokeArrayOff ptr i = pokeArray (plusPtr ptr (floatSize * i))

pokePoint33s :: Ptr Float -> [(Point3,Point3)] -> IO Int
pokePoint33s ptr vals0 = go vals0 0
  where
    go [] n = return n
    go ( (V3 a b c,V3 d e f):vals) !n = do
        pokeElemOff ptr (off 0) a
        pokeElemOff ptr (off 1) b
        pokeElemOff ptr (off 2) c
        pokeElemOff ptr (off 3) d
        pokeElemOff ptr (off 4) e
        pokeElemOff ptr (off 5) f
        go vals (n+1)
      where
        off i = n*6 + i

pokePoint3s :: Ptr Float -> [Point3] -> IO Int
pokePoint3s ptr vals0 = go vals0 0
  where
    go [] n = return n
    go ( V3 a b c:vals) !n = do
        pokeElemOff ptr (off 0) a
        pokeElemOff ptr (off 1) b
        pokeElemOff ptr (off 2) c
        go vals (n+1)
      where
        off i = n*3 + i

poke224s :: Ptr Float -> [((Point2,Point2),Point4)] -> IO Int
poke224s ptr vals0 = go vals0 0
  where
    go [] n = return n
    go (((V2 a b,V2 c d),V4 e f g h):vals) !n = do
        pokeElemOff ptr (off 0) a
        pokeElemOff ptr (off 1) b
        pokeElemOff ptr (off 2) c
        pokeElemOff ptr (off 3) d
        pokeElemOff ptr (off 4) e
        pokeElemOff ptr (off 5) f
        pokeElemOff ptr (off 6) g
        pokeElemOff ptr (off 7) h
        go vals (n+1)
      where
        off i = n*8 + i