106 lines
3.4 KiB
Haskell
106 lines
3.4 KiB
Haskell
module Dodge.Render.Shadow where
|
|
|
|
--import Data.Vector.Unboxed as UV
|
|
|
|
--import Dodge.Data.Universe
|
|
--import Control.Lens
|
|
import Data.Preload.Render
|
|
--import qualified Data.Vector as V
|
|
--import qualified Data.Vector.Fusion.Stream.Monadic as VFSM
|
|
--import Foreign
|
|
import Geometry
|
|
--import Graphics.GL.Core45
|
|
--import Linear.V3 (cross)
|
|
--import Shader.Data
|
|
--import Shader.ExtraPrimitive
|
|
--import Shader.Parameters
|
|
import Shape.Data
|
|
--
|
|
drawCPUShadows :: RenderData -> Shape -> Point3 -> Float -> IO ()
|
|
drawCPUShadows _ _ _ _ = return ()
|
|
--drawCPUShadows pdata s pos rad = do
|
|
-- let theshad = pdata ^. positionalBlankShader
|
|
-- theptr = _vboPtr $ _vaoVBO $ _shadVAO' theshad
|
|
-- i <- VFSM.foldlM' (pokeShapeShad pos rad theptr) 0 $ VFSM.fromList s
|
|
-- glBufferSubData
|
|
-- (theshad ^. shadVAO' . vaoVBO . vboName)
|
|
-- 0
|
|
-- (fromIntegral $ floatSize * i)
|
|
-- (theshad ^. shadVAO' . vaoVBO . vboPtr)
|
|
-- glUseProgram (theshad ^. shadName)
|
|
-- glBindVertexArray . _vaoName $ _shadVAO' theshad
|
|
-- glDrawArrays
|
|
-- (marshalEPrimitiveMode $ _shadPrim' theshad)
|
|
-- 0
|
|
-- (fromIntegral i)
|
|
-- return ()
|
|
|
|
--pokeShapeShad :: Point3 -> Float -> Ptr Float -> Int -> ShapeObj -> IO Int
|
|
--pokeShapeShad pos r theptr i so = do
|
|
-- let vs = V.fromList $ map _svPos (_shVs so)
|
|
-- is = memoTopPrismEdges V.! (so ^. shType . prismSize - 2)
|
|
-- V.foldM' (pokeShadEdge pos r theptr vs) i is
|
|
|
|
--pokeShadEdge ::
|
|
-- Point3 ->
|
|
-- Float ->
|
|
-- Ptr Float ->
|
|
-- V.Vector Point3 ->
|
|
-- Int ->
|
|
-- (Int, Int, Int, Int) ->
|
|
-- IO Int
|
|
--pokeShadEdge pos _ ptr vxs i (a, b, x, y) = do
|
|
-- let p0 = vxs V.! a
|
|
-- p1 = vxs V.! b
|
|
-- --mid = 0.5 * (p0 + p1)
|
|
-- n0a = vxs V.! x
|
|
-- n1a = vxs V.! y -- this should almost certainly be done with backpermute
|
|
-- n0 = cross (p1 - p0) (n0a - p0)
|
|
-- n1 = cross (p0 - p1) (n1a - p1)
|
|
-- lightdir = p0 - pos
|
|
-- shift' p = p + (10000 *.*.* (p - pos))
|
|
-- -- projNear p =
|
|
-- -- shiftNear p =
|
|
-- if dotV3 n0 lightdir * dotV3 n1 lightdir <= 0
|
|
-- then do
|
|
-- let p2 = shift' p0
|
|
-- p3 = shift' p1
|
|
-- if dotV3 n0 lightdir > 0
|
|
-- then
|
|
-- pokeV3 ptr p0 i >>= pokeV3 ptr p1 >>= pokeV3 ptr p2
|
|
-- >>= pokeV3 ptr p0
|
|
-- >>= pokeV3 ptr p2
|
|
-- >>= pokeV3 ptr p3
|
|
-- else
|
|
-- pokeV3 ptr p1 i >>= pokeV3 ptr p0 >>= pokeV3 ptr p3
|
|
-- >>= pokeV3 ptr p1
|
|
-- >>= pokeV3 ptr p3
|
|
-- >>= pokeV3 ptr p2
|
|
-- else return i
|
|
--
|
|
--pokeV3 :: Ptr Float -> Point3 -> Int -> IO Int
|
|
--pokeV3 ptr (V3 x y z) i = do
|
|
-- pokeElemOff ptr (3 * i) x
|
|
-- pokeElemOff ptr (3 * i + 1) y
|
|
-- pokeElemOff ptr (3 * i + 2) z
|
|
-- return (i + 1)
|
|
--
|
|
--memoTopPrismEdges :: V.Vector (V.Vector (Int, Int, Int, Int))
|
|
--memoTopPrismEdges =
|
|
-- V.generate 10 $
|
|
-- V.fromList . topPrismEdges . (+ 2)
|
|
--
|
|
--topPrismEdges :: Int -> [(Int, Int, Int, Int)]
|
|
--topPrismEdges n = concatMap f [0 .. n -1]
|
|
-- where
|
|
-- f i =
|
|
-- map
|
|
-- h
|
|
-- [ (0, 2, 1, 4)
|
|
-- , (0, 1, -2, 3)
|
|
-- , (1, 3, -1, 2)
|
|
-- ]
|
|
-- where
|
|
-- h (a, b, c, d) = (g a, g b, g c, g d)
|
|
-- g j = (2 * i + j) `mod` (2 * n)
|