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

import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
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
import Control.Monad
import Data.Bifoldable
--import qualified Data.DList as DL

pokeVerxs 
    :: MV.MVector (PrimState IO) FullShader
    -> UMV.MVector (PrimState IO) Int 
    -> Picture 
    -> 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 . _shadVAO <$> 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

pokeShape 
    :: Ptr Float    -- ^ vertex data pointer
    -> Ptr Float    -- ^ edge data pointer
    -> Ptr GLushort -- ^ vertex indices pointer
    -> Ptr GLushort -- ^ edge indices pointer
    -> Shape 
    -> IO (Int,Int,Int,Int)
pokeShape vptr eptr iptr ieptr = bifoldlM 
    (pokeShapeObjs vptr iptr ieptr) 
    (pokeShapeEs eptr ieptr) (0,0,0,0)

pokeShapeObjs 
    :: Ptr Float 
    -> Ptr GLushort 
    -> Ptr GLushort -> (Int,Int,Int,Int) -> [ShapeObj] -> IO (Int, Int,Int,Int)
pokeShapeObjs ptr iptr _ count = VS.foldlM' (pokeShapeObj ptr iptr) count . VS.fromList

pokeShapeObj :: Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> ShapeObj -> IO (Int,Int,Int,Int)
pokeShapeObj ptr iptr counts (ShapeObj shType shVerts) = case shType of
    ListV -> pokeShapeVs ptr iptr counts shVerts
    TopPrism size -> pokeTopPrism size ptr iptr counts shVerts

pokeTopPrism :: Int -> Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> [ShapeV] -> IO (Int,Int,Int,Int)
pokeTopPrism size ptr iptr count svs = do
    count' <- pokeTopPrismIndices size iptr count
    VS.foldlM' (pokeJustV ptr) count' (VS.fromList svs)

pokeTopPrismIndices :: Int -> Ptr GLushort -> (Int,Int,Int,Int) -> IO (Int,Int,Int,Int)
pokeTopPrismIndices size iptr (nv,ne,ni,nei) = do
    ni' <- foldM (pokeTopPrismIndex nv iptr) ni (topPrismIndices size)
    return (nv,ne,ni',nei)

pokeTopPrismIndex :: Int -> Ptr GLushort -> Int -> Int -> IO Int
pokeTopPrismIndex nv iptr ni ioff = do
    pokeElemOff iptr ni (fromIntegral $ nv + ioff)
    return (ni + 1)

pokeShapeVs :: Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> [ShapeV] -> IO (Int, Int,Int,Int)
pokeShapeVs ptr iptr count = VS.foldlM' (pokeShapeV ptr iptr) count . VS.fromList

pokeShapeEs :: Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> [Point3] -> IO (Int,Int,Int,Int)
pokeShapeEs ptr ieptr count = VS.foldlM' (pokeShapeE ptr ieptr) count . VS.fromList


pokeShapeE :: Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> Point3 -> IO (Int,Int,Int,Int)
pokeShapeE eptr ieptr (nv,n,ni,nei) (V3 a b c) = do
    pokeElemOff eptr (n * 3) a
    pokeElemOff eptr (n * 3 + 1) b
    pokeElemOff eptr (n * 3 + 2) c
    pokeElemOff ieptr nei (fromIntegral n)
    return $ (nv,n + 1,ni,nei+1)

topPrismIndices :: Int -> [Int]
topPrismIndices n = concatMap f [1..n-2]    -- triangles on top face
    ++ [2*n-2,2*n-1,1
        ,2*n-2,1,0]                         -- last side triangle (applies mod 2n)
    ++ concatMap g [0..n-2]                 -- other triangles on sides
  where
    f x = [0,2*x,2*x+2]
    g x = [2*x,2*x+1,2*x+3
            ,2*x,2*x+3,2*x+2]

pokeJustV :: Ptr Float -> (Int,Int,Int,Int) -> ShapeV -> IO (Int,Int,Int,Int)
pokeJustV ptr (nv,ne,ni,nei) sh = 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
    return (nv+1,ne,ni,nei)
  where
    off i = nv*7 + i
    V3 a b c    = _svPos sh
    V4 d e f g  = _svCol sh

pokeShapeV :: Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> ShapeV -> IO (Int,Int,Int,Int)
pokeShapeV ptr iptr (nv,ne,ni,nei) sh = 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 iptr ni (fromIntegral nv)
    return (nv+1,ne,ni+1,nei)
  where
    off i = nv*7 + i
    V3 a b c    = _svPos sh
    V4 d e f g  = _svCol sh


pokePoint3s :: Ptr Float -> VS.Stream IO Point3 -> IO Int
pokePoint3s ptr = VS.foldlM' (pokePoint3 ptr) 0

pokePoint3 :: Ptr Float -> Int -> Point3 -> IO Int
pokePoint3 ptr n (V3 a b c) = do
    pokeElemOff ptr (n * 3) a
    pokeElemOff ptr (n * 3 + 1) b
    pokeElemOff ptr (n * 3 + 2) c
    return $ n + 1

pokeLayVerxs 
    :: MV.MVector (PrimState IO) FullShader 
    -> UMV.MVector (PrimState IO) Int
    -> Picture 
    -> 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 . _shadVAO <$> 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))

--pokeTwoOff 
--    :: Ptr Float 
--    -> Int 
--    -> (Float,Float) 
--    -> IO ()
--{-# INLINE pokeTwoOff #-}
--pokeTwoOff ptr n (x,y) = do
--    pokeElemOff ptr (2*n+0) x
--    pokeElemOff ptr (2*n+1) y
--pokeThreeOff 
--    :: Ptr Float 
--    -> Int 
--    -> (Float,Float,Float) 
--    -> IO ()
--{-# INLINE pokeThreeOff #-}
--pokeThreeOff ptr n (x,y,z) = do
--    pokeElemOff ptr (3*n+0) x
--    pokeElemOff ptr (3*n+1) y
--    pokeElemOff ptr (3*n+2) z
--pokeFourOff :: Ptr Float -> Int -> (Float,Float,Float,Float) -> IO ()
--{-# INLINE pokeFourOff #-}
--pokeFourOff ptr n (x,y,z,w) = do
--    pokeElemOff ptr (4*n+0) x
--    pokeElemOff ptr (4*n+1) y
--    pokeElemOff ptr (4*n+2) z
--    pokeElemOff ptr (4*n+3) w

pokePoint33s :: Ptr Float -> [(Point3,Point3)] -> IO Int
pokePoint33s ptr = VS.foldlM' (pokePoint33 ptr) 0 . VS.fromList

pokePoint33 :: Ptr Float -> Int -> (Point3,Point3) -> IO Int
pokePoint33 ptr n (V3 a b c,V3 d e f) = 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
    return (n+1)
  where
    off i = n*6 + i

pokePoint224 :: Ptr Float -> Int -> ((Point2,Point2),Point4) -> IO Int
pokePoint224 ptr n ((V2 a b,V2 c d),V4 e f g h) = 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
    return (n + 1)
  where
    off i = n*8 + i

poke224s :: Ptr Float -> [((Point2,Point2),Point4)] -> IO Int
poke224s ptr = VS.foldlM' (pokePoint224 ptr) 0 . VS.fromList