Refactor shapes, prepare for different normals at single vertex pos

src/Dodge/Render/Shadow.hs

@@ -3,19 +3,19 @@ module Dodge.Render.Shadow where
 --import Data.Vector.Unboxed as UV
 
 --import Dodge.Data.Universe
-import Control.Lens
+--import Control.Lens
 import Data.Preload.Render
-import qualified Data.Vector as V
+--import qualified Data.Vector as V
 --import qualified Data.Vector.Fusion.Stream.Monadic as VFSM
-import Foreign
+--import Foreign
 import Geometry
 --import Graphics.GL.Core45
-import Linear.V3 (cross)
+--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
@@ -35,71 +35,71 @@ drawCPUShadows _ _ _ _ = return ()
 --        (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
+--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)
+--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)

src/Dodge/Room/Foreground.hs

@@ -144,7 +144,7 @@ putShape sh =
 --shapePoints :: Shape -> Stream (Of Point2) Identity ()
 --shapePoints = S.each . concatMap (map (stripZ . _svPos) . _shVs)
 shapePoints :: Shape -> [Point2]
-shapePoints = concatMap (map (stripZ . _svPos) . _shVs)
+shapePoints = concatMap (map stripZ . _sfVs)
 
 shapeBounds :: Shape -> (Float, Float, Float, Float)
 shapeBounds = fromMaybe (0, 0, 0, 0) . boundPoints . shapePoints