--{-# 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 as V
import qualified Data.Vector.Unboxed as UV
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.Parallel.Strategies
--import System.Environment
import Control.Monad.Parallel as MP
--import Control.Monad
--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 GLushort -- ^ vertex indices pointer
    -> Ptr GLushort -- ^ edge indices pointer
    -> Shape 
    -> IO (Int,Int,Int)
pokeShape vptr iptr ieptr = pokeShapeObjs vptr iptr ieptr (0,0,0)

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

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

pokeTopPrism :: Int -> Ptr Float -> Ptr GLushort 
    -> Ptr GLushort -> (Int,Int,Int) -> [ShapeV] -> IO (Int,Int,Int)
{-# INLINE pokeTopPrism #-}
pokeTopPrism size ptr iptr ieptr (nv,ni,nei) svs = do
    MP.bindM3 (\a b c -> return (a,b,c))
        (VS.foldlM' (pokeJustV ptr) nv (VS.fromList svs) )
        (UV.foldM (pokeTopPrismIndex nv iptr)      ni  (memoTopPrismIndices     V.! (size - 2)) )
        (UV.foldM (pokeTopPrismEdgeIndex nv ieptr) nei (memoTopPrismEdgeIndices V.! (size - 2)) )
--    ni'  <- UV.foldM (pokeTopPrismIndex nv iptr)      ni  (memoTopPrismIndices     V.! (size - 2))
--    nei' <- UV.foldM (pokeTopPrismEdgeIndex nv ieptr) nei (memoTopPrismEdgeIndices V.! (size - 2))
--    nv'  <- VS.foldlM' (pokeJustV ptr) nv (VS.fromList svs)
--    return (nv',ni',nei')

pokeTopPrismEdgeIndex :: Int -> Ptr GLushort -> Int -> Int -> IO Int
{-# INLINE pokeTopPrismEdgeIndex #-}
pokeTopPrismEdgeIndex nv iptr ni ioff = do
    pokeElemOff iptr ni (fromIntegral $ nv + ioff)
    return (ni + 1)

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

memoTopPrismEdgeIndices :: V.Vector (UV.Vector Int)
memoTopPrismEdgeIndices = V.generate 6 f
  where
    f n = UV.fromList $ topPrismEdgeIndices (n + 2)

memoTopPrismIndices :: V.Vector (UV.Vector Int)
memoTopPrismIndices = V.generate 6 f
  where
    f n = UV.fromList $ topPrismIndices (n + 2)

topPrismEdgeIndices :: Int -> [Int]
topPrismEdgeIndices n = concatMap f [0..n-1]
  where
    f i = map g
        [ 0 , 2 , 1 , 4
        , 0 , 1 ,-2 , 3
        , 1 , 3 ,-1 , 2
        ]
      where
        g j = (2 * i + j) `mod` (2*n)

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 -> ShapeV -> IO Int
pokeJustV ptr nv 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)
  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
