module Shader.Poke (
    pokeVerxs,
    pokeLayVerxs,
    pokeArrayOff,
    pokeShape,
    pokeWallsWindows,
    memoTopPrismEdgeIndices,
    pokeFloors,
) where

import Shape.Parameters
import Color
import Control.Monad.Primitive
import qualified Data.Vector as V
import qualified Data.Vector.Fusion.Stream.Monadic as VFSM
import qualified Data.Vector.Mutable as MV
import qualified Data.Vector.Unboxed as UV
import qualified Data.Vector.Unboxed.Mutable as UMV
import Dodge.Data.Wall
import Foreign
import Geometry.Data
import Geometry.Triangulate
import Geometry.Vector
import Graphics.GL.Core45
import Linear.V3 (cross)
import Picture.Data
import Shader.Data
import Shader.Parameters
import Shape.Data

pokeVerxs ::
    MV.MVector (PrimState IO) (Shader, VBO) ->
    UMV.MVector (PrimState IO) Int ->
    Picture ->
    IO ()
pokeVerxs vbos count = VFSM.mapM_ (pokeVerx vbos count) . VFSM.fromList

pokeVerx :: MV.MVector (PrimState IO) (Shader, VBO) -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
{-# INLINE pokeVerx #-}
pokeVerx vbos offsets Verx{_vxPos = thePos, _vxCol = theCol, _vxExt = ext, _vxShadNum = shadnum} = do
    typeOff <- UMV.unsafeRead offsets sn
    basePtr <- _vboPtr . snd <$> MV.unsafeRead vbos sn
    let thePtr = plusPtr basePtr (typeOff * pokeStride shadnum * floatSize)
    poke34 thePtr thePos theCol
    pokeArrayOff thePtr 7 ext
    UMV.unsafeModify offsets (+ 1) sn
  where
    sn = fromEnum shadnum

pokeWallsWindows ::
    Ptr Float ->
    Ptr Float ->
    [((Point2, Point2), Point4)] ->
    [Wall] ->
    IO (Int, Int)
pokeWallsWindows wiptr truewlptr wis truewls = do
    wlcounts2 <- VFSM.foldlM' (pokeW wiptr) 0 (VFSM.fromList wis)
    wlcounts3 <- VFSM.foldlM' (pokeWall truewlptr) 0 (VFSM.fromList truewls)
    return (wlcounts2, wlcounts3)

pokeFloors ::
    Ptr Float ->
    [(Point3, Point3)] ->
    IO Int
pokeFloors flptr fls = VFSM.foldlM' (pokeF flptr) 0 (VFSM.fromList fls)

pokeF :: Ptr Float -> Int -> (Point3, Point3) -> IO Int
pokeF ptr i' (V3 a b c, V3 d e f) = do
    let i = i' * 6
    pokeElemOff ptr (i + 0) a
    pokeElemOff ptr (i + 1) b
    pokeElemOff ptr (i + 2) c
    pokeElemOff ptr (i + 3) d
    pokeElemOff ptr (i + 4) e
    pokeElemOff ptr (i + 5) f
    return $ i' + 1

pokeWall :: Ptr Float -> Int -> Wall -> IO Int
{-# INLINE pokeWall #-}
pokeWall ptr nw wl = do
    UV.imapM_ f $ UV.fromList [x, y, x1, y1, t, a, 1, 1]
    return $ nw + 1
  where
    f i = pokeElemOff ptr (nw * 8 + i)
    (V2 x y, V2 x1 y1) = _wlLine wl
    t = fromIntegral $ _opTexture $ _wlOpacity wl
    a = argV (V2 x1 y1 -.- V2 x y)

pokeW :: Ptr Float -> Int -> ((Point2, Point2), Point4) -> IO Int
pokeW ptr i' ((V2 a b, V2 c d), V4 e f g h) = do
    let i = i' * 8
    pokeElemOff ptr (i + 0) a
    pokeElemOff ptr (i + 1) b
    pokeElemOff ptr (i + 2) c
    pokeElemOff ptr (i + 3) d
    pokeElemOff ptr (i + 4) e
    pokeElemOff ptr (i + 5) f
    pokeElemOff ptr (i + 6) g
    pokeElemOff ptr (i + 7) h
    return $ i' + 1

--pokeShape' ::
--    Ptr Float ->
--    Ptr GLushort ->
--    Ptr GLushort ->
--    (Int, Int, Int) ->
--    [Surface] ->
--    IO (Int, Int, Int)
--pokeShape' = pokeShape $ const False

pokeShape ::
    (Surface -> Bool) ->
    Ptr Float ->
    Ptr GLushort ->
    Ptr GLushort ->
    (Int, Int, Int) ->
    [Surface] ->
    IO (Int, Int, Int)
{-# INLINE pokeShape #-}
pokeShape shadowtest ptr iptr ieptr is =
    VFSM.foldlM' (pokeShapeObj shadowtest ptr iptr ieptr) is
        . VFSM.fromList

pokeShapeObj ::
    (Surface -> Bool) ->
    Ptr Float ->
    Ptr GLushort ->
    Ptr GLushort ->
    (Int, Int, Int) ->
    Surface ->
    IO (Int, Int, Int)
{-# INLINE pokeShapeObj #-}
pokeShapeObj shadowtest ptr iptr ieptr counts surf@(Surface shtype shVerts col _ _) = case shtype of
    FlatFaces size -> pokeBox blockshadows col size ptr iptr ieptr counts shVerts
    RoundedFaces size -> pokeRoundedFaces blockshadows col size ptr iptr ieptr counts shVerts
    Cylinder size -> pokeCylinder blockshadows col size ptr iptr ieptr counts shVerts
  where
    blockshadows = shadowtest surf

pokeRoundedFaces ::
    Bool ->
    Point4 ->
    Int ->
    Ptr Float ->
    Ptr GLushort ->
    Ptr GLushort ->
    (Int, Int, Int) ->
    [Point3] ->
    IO (Int, Int, Int)
{-# INLINE pokeRoundedFaces #-}
pokeRoundedFaces sfid col size ptr iptr ieptr (nv, nsi, nei) (tc : bc : svs) = do
    nv' <- pokeRoundedCurve xdata col ptr tc bc svs nv
    nsi' <-
        UV.foldM'
            (pokeIndex nv iptr)
            nsi
            (memoTopPrismIndices V.! (size - 3))
    nei' <-
        if sfid
            then return nei
            else
                UV.foldM' (pokeIndex nv ieptr) nei $
                    memoTopPrismEdgeIndices V.! (size - 3)
    return (nv', nsi', nei')
  where
    xdata
        | sfid = 0 -- this records whether the shadow should be shown or not
        -- honestly, I think things where faster without this
        | otherwise = 1
pokeRoundedFaces _ _ _ _ _ _ _ _ = undefined

pokeCylinder ::
    Bool ->
    Point4 ->
    Int ->
    Ptr Float ->
    Ptr GLushort ->
    Ptr GLushort ->
    (Int, Int, Int) ->
    [Point3] ->
    IO (Int, Int, Int)
{-# INLINE pokeCylinder #-}
pokeCylinder sfid col size ptr iptr ieptr (nv, nsi, nei) (tc : bc : svs) = do
    nv' <- pokeRoundedCurve xdata col ptr tc bc svs nv
         >>= pokeCylinderCaps xdata col ptr svs
    nsi' <-
        UV.foldM'
            (pokeIndex nv iptr)
            nsi
            (memoCylinderIndices V.! (size - 3))
    nei' <-
        if sfid
            then return nei
            else
                UV.foldM' (pokeIndex nv ieptr) nei $
                    memoTopPrismEdgeIndices V.! (size - 3)
    return (nv', nsi', nei')
  where
    xdata
        | sfid = 0
        | otherwise = 1
pokeCylinder _ _ _ _ _ _ _ _ = undefined

pokeRoundedCurve :: Float -> Point4 -> Ptr Float -> Point3 -> Point3 -> [Point3] -> Int -> IO Int
{-# INLINE pokeRoundedCurve #-}
pokeRoundedCurve xdata col ptr tc bc = go True
  where
    go True (x : xs) n = pokeJustV xdata tc col ptr n x >>= go False xs
    go False (x : xs) n = pokeJustV xdata bc col ptr n x >>= go True xs
    go _ [] n = return n

-- I am not completely sure the normals are correct here
-- they assume that we do actually have a cylinder, with normals for the caps
-- that can be determined by the first two vertices
pokeCylinderCaps :: Float -> Point4 -> Ptr Float -> [Point3] -> Int 
    -> IO Int
{-# INLINE pokeCylinderCaps #-}
pokeCylinderCaps xdata col ptr (a:b:as) = go True (a:b:as)
  where
    n1 = a - b
    n2 = b - a
    go True (x : xs) n = pokeFlatV xdata n1 col ptr n x >>= go False xs
    go False (x : xs) n = pokeFlatV xdata n2 col ptr n x >>= go True xs
    go _ [] n = return n
pokeCylinderCaps _ _ _ _ = const $ return 0

pokeBox ::
    Bool ->
    Point4 ->
    Int ->
    Ptr Float ->
    Ptr GLushort ->
    Ptr GLushort ->
    (Int, Int, Int) ->
    [Point3] ->
    IO (Int, Int, Int)
{-# INLINE pokeBox #-}
pokeBox sfid col size ptr iptr ieptr (nv, nsi, nei) svs = do
    nv' <- VFSM.foldM' (pokeBoxSurface xdata col ptr svsv) nv $ VFSM.fromList $ memoBoxSurfaces V.! size
--    nv' <- VFSM.foldM' (pokeBoxSurface xdata col ptr svsv) nv $ VFSM.fromList $ boxSurfaces size
    nsi' <-
        UV.foldM'
            (pokeIndex nv iptr)
            nsi
            (memoFlatIndices V.! (size -3))
--        VFSM.foldM' (pokeIndex nv iptr) nsi 
--            (VFSM.fromList . concatMap polyToTris $ boxSurfacesIndices size)
    nei' <-
        if sfid
            then return nei
            else
                UV.foldM' (pokeIndex nv ieptr) nei $
                    memoBoxEdgeIndices V.! (size - 3)
    return (nv', nsi', nei')
  where
    svsv = UV.fromList svs
    xdata
        | sfid = 0
        | otherwise = 1

-- should probably use a vector of Point3
pokeBoxSurface :: Float -> Point4 -> Ptr Float -> UV.Vector Point3 -> Int -> [Int] -> IO Int
{-# INLINE pokeBoxSurface #-}
pokeBoxSurface xdata col ptr vs n is =
    UV.foldM'
        (pokeFlatV xdata norm col ptr)
        n
        v
  where
    v = UV.backpermute vs (UV.fromList is)
    x = v UV.! 0
    y = v UV.! 1
    z = v UV.! 2
    norm = negate $ cross (x - y) (z - y)

-- should probably memoize this
boxSurfaces :: Int -> [[Int]]
{-# INLINE boxSurfaces #-}
boxSurfaces size =
    [0, 2 .. size * 2 -1] :
    [1, 3 .. size * 2] :
    map f [0, 2 .. size * 2 - 1]
  where
    f x = map (`mod` (size * 2)) [x, x + 1, x + 3, x + 2]

memoBoxSurfaces :: V.Vector [[Int]]
{-# INLINE memoBoxSurfaces #-}
memoBoxSurfaces = V.generate 10 boxSurfaces

boxSurfacesIndices :: Int -> [[Int]]
{-# INLINE boxSurfacesIndices #-}
boxSurfacesIndices n =
    [0 .. n -1] :
    reverse [n .. n * 2 -1] :
        [map ((2 * n) +) [4 * i, 4 * i + 1, 4 * i + 2, 4 * i + 3] | i <- [0 .. n -1]]

pokeIndex ::
    -- | base index
    Int ->
    Ptr GLushort ->
    -- | number poked
    Int ->
    -- | index offset
    Int ->
    IO Int
{-# INLINE pokeIndex #-}
pokeIndex nv eiptr ni ioff = do
    pokeElemOff eiptr ni (fromIntegral $ nv + ioff)
    return $ ni + 1

memoFlatIndices :: V.Vector (UV.Vector Int)
{-# INLINE memoFlatIndices #-}
memoFlatIndices =
    V.generate 10 $
        UV.fromList . concatMap polyToTris . boxSurfacesIndices . (+ 3)

memoTopPrismIndices :: V.Vector (UV.Vector Int)
{-# INLINE memoTopPrismIndices #-}
memoTopPrismIndices =
    V.generate 10 $
        UV.fromList . topPrismIndices . (+ 3)

memoCylinderIndices :: V.Vector (UV.Vector Int)
{-# INLINE memoCylinderIndices #-}
memoCylinderIndices =
    V.generate 10 $
        UV.fromList . cylinderIndices . (+ 3)

memoTopPrismEdgeIndices :: V.Vector (UV.Vector Int)
{-# INLINE memoTopPrismEdgeIndices #-}
memoTopPrismEdgeIndices =
    V.generate 10 $
        UV.fromList . topPrismEdgeIndices . (+ 3)

topPrismEdgeIndices ::
    -- | the number of vertices on the top surface, ie. half the total
    Int ->
    [Int]
{-# INLINE topPrismEdgeIndices #-}
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)

memoBoxEdgeIndices :: V.Vector (UV.Vector Int)
{-# INLINE memoBoxEdgeIndices #-}
memoBoxEdgeIndices =
    V.generate 10 $
        UV.fromList . boxEdgeIndices . (+ 3)

boxEdgeIndices ::
    -- | the number of vertices on the top surface, ie. half the total
    Int ->
    [Int]
{-# INLINE boxEdgeIndices #-}
boxEdgeIndices n = concatMap f [0 .. n -1]
  where
    f i =
        [ g 0
        , g 1
        , n + g 0
        , g 2
        , g 0
        , n + g 0
        , n + g (-1)
        , g 1
        , n + g 0
        , n + g 1
        , n + g (-1)
        , g 1
        ]
      where
        g j = (i + j) `mod` n

cylinderIndices :: Int -> [Int]
{-# INLINE cylinderIndices #-}
cylinderIndices n =
    cylinderRoundIndices n
        ++ polyToTris [2 * n, 2 * n + 2 .. 4 * n - 1]
        ++ polyToTris [2 * n + 1, 2 * n + 3 .. 4 * n - 1]

cylinderRoundIndices :: Int -> [Int]
{-# INLINE cylinderRoundIndices #-}
cylinderRoundIndices n =
    [ 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
    g x =
        [ 2 * x
        , 2 * x + 1
        , 2 * x + 3
        , 2 * x
        , 2 * x + 3
        , 2 * x + 2
        ]

topPrismIndices :: Int -> [Int]
{-# INLINE topPrismIndices #-}
topPrismIndices n =
    concatMap f [1 .. n -2] -- triangles on top face
        ++ concatMap f' [1 .. n -2] -- triangles on bottom face
        -- these should be checked
        ++ [ 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]
    f' x = [1, 2 * x + 3, 2 * x + 1]
    g x =
        [ 2 * x
        , 2 * x + 1
        , 2 * x + 3
        , 2 * x
        , 2 * x + 3
        , 2 * x + 2
        ]

-- consider changing the position to a vec4
pokeJustV ::
    Float ->
    Point3 ->
    Point4 ->
    Ptr Float ->
    Int ->
    Point3 ->
    IO Int
{-# INLINE pokeJustV #-}
pokeJustV xdata cp col ptr nv sh = do
    pokeByteOff ptr (nv * shapeVerxSize) (V4 x y z xdata)
    pokeByteOff ptr (nv *shapeVerxSize + 4 * floatSize) (toColor8 col)
    pokeByteOff ptr (nv *shapeVerxSize + 4 * (floatSize + ubyteSize)) (V4 nx ny nz 1)
    return (nv + 1)
  where
    V3 x y z = sh
    V3 nx ny nz = cp

pokeFlatV ::
    Float ->
    Point3 ->
    Point4 ->
    Ptr Float ->
    Int ->
    Point3 ->
    IO Int
{-# INLINE pokeFlatV #-}
pokeFlatV xdata norm col ptr nv sh = do
    pokeByteOff ptr (nv * shapeVerxSize) (V4 x y z xdata)
    pokeByteOff ptr (nv *shapeVerxSize + 4 * floatSize) (toColor8 col)
    pokeByteOff ptr (nv *shapeVerxSize + 4 * (floatSize + ubyteSize)) (V4 nx ny nz 1)
    return (nv + 1)
  where
    V3 x y z = sh
    V3 nx ny nz = sh - norm

pokeLayVerxs ::
    MV.MVector (PrimState IO) (Shader, VBO) ->
    UMV.MVector (PrimState IO) Int ->
    Picture ->
    IO ()
pokeLayVerxs vbos counts = VFSM.mapM_ (pokeLayVerx vbos counts) . VFSM.fromList

pokeLayVerx :: MV.MVector (PrimState IO) (Shader, VBO) -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
{-# INLINE pokeLayVerx #-}
pokeLayVerx vbos counts vx = do
    theOff <- UMV.unsafeRead counts vecPos
    basePtr <- _vboPtr . snd <$> 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 = fromEnum shadnum
    shadnum = _vxShadNum vx
    vecPos = theLayer * numLayers + sn
    theLayer = fromEnum $ _vxLayer vx
    thePos = _vxPos vx
    theCol = _vxCol vx
    layOff = theLayer * numSubElements
    theStride = pokeStride shadnum

pokeStride :: ShadNum -> Int
{-# INLINE pokeStride #-}
pokeStride PolyShad = 7
pokeStride TextShad = 11
pokeStride ArcShad = 10
pokeStride EllShad = 7

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))