Creature shadow test

src/Dodge/Default/World.hs

@@ -97,4 +97,4 @@ youLight =
         ,_tlsTime = 0
         }
   where
-    f (V2 x y) = V3 x y 25
+    f (V2 x y) = V3 x y 10

src/Dodge/Item/Weapon/TriggerType.hs

@@ -271,7 +271,8 @@ withTempLight time rad col eff item cr = eff item cr
     V2 x y = _crPos cr +.+ 5 *.* unitVectorAtAngle (_crDir cr)
 
 withMuzFlareI :: ChainEffect
-withMuzFlareI f it cr w = tempLightForAt 3 pos . muzzleFlashAt pos2 $ f it cr w
+withMuzFlareI f it cr w = tempLightForAt 3 pos2 -- . muzzleFlashAt pos2 
+    $ f it cr w
   where 
     pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
     pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)

src/Dodge/LightSources.hs

@@ -47,7 +47,7 @@ tLightRad
     -> Point2 
     -> TempLightSource
 tLightRad 0 rmax _ (V2 x y) = TLS 
-    { _tlsPos = V3 x y 0
+    { _tlsPos = V3 x y 1
     , _tlsRad = rmax
     , _tlsIntensity = 0.5
     , _tlsUpdate = \w _ -> (w, Nothing)

src/Dodge/Render.hs

@@ -8,6 +8,7 @@ import Dodge.Data
 import Dodge.Config.Data
 import Dodge.Base.Window
 import Dodge.Render.Picture
+import Dodge.Creature.ShadowBox
 import Geometry
 import Render
 import Data.Preload.Render
@@ -52,11 +53,12 @@ doDrawing pdata w = do
     -- poke wall points and colors
     nWalls <- poke224s (shadVBOptr $ _wallTextureShader pdata) wallPointsCol
     nSils <- pokePoint3s (shadVBOptr $ _lightingLineShadowShader pdata) 
-                (_foregroundEdgeVerx w)
+                $ youSil w ++ _foregroundEdgeVerx w
     -- poke foreground geometry and floor
     let addC (V2 xx yy) = V3 xx yy 0
     nsurfVs <- pokePoint3s (shadVBOptr $ _lightingSurfaceShader pdata)
-        $ polyToTris (map addC $ screenPolygon w)
+        $ youBox w
+        ++ polyToTris (map addC $ screenPolygon w)
         ++ concatMap polyToGeoRender (foregroundPics w)
     -- bind wall points, silhouette data, surface geometry
     uncurry bindShaderBuffers $ unzip

src/Dodge/WorldEvent.hs

@@ -51,9 +51,6 @@ createBarrelSpark pos dir maycid time colid w
       where sp = head (_btTrail' bt)
             ep = sp +.+ _btVel' bt
 
-
-                
-
 damCrsOnLine :: Int -> Point2 -> Point2 -> World -> World
 damCrsOnLine dam p1 p2 = over creatures (IM.map damIfOnLine)
     where damIfOnLine cr | circOnSeg p1 p2 (_crPos cr) (_crRad cr) 

src/Polyhedra.hs

@@ -34,6 +34,16 @@ constructEdges (face:faces) = mapMaybe (findReverseEdge otherEdges) (faceEdges f
     otherEdges = concatMap faceEdges faces
 constructEdges _ = []
 
+-- | a version of construct edges that directly returns the flattened list of
+-- tuples
+constructEdgesList :: [[Point3]] -> [Point3]
+constructEdgesList (face:faces) = concatMap (findReverseEdgeList otherEdges) (faceEdges face) 
+    ++ constructEdgesList faces
+  where
+    otherEdges = concatMap faceEdges faces
+constructEdgesList _ = []
+
+
 findReverseEdge 
     :: [(Point3,Point3,Point3)] 
     -> (Point3,Point3,Point3) 
@@ -41,6 +51,14 @@ findReverseEdge
 findReverseEdge otherEdges (x,y,z) = (\(_,_,n) -> (x,y,z,n))
     <$> find (\(a,b,_) -> (x,y) == (b,a)) otherEdges
 
+findReverseEdgeList
+    :: [(Point3,Point3,Point3)] 
+    -> (Point3,Point3,Point3) 
+    -> [Point3]
+findReverseEdgeList a b = case findReverseEdge a b of
+    Nothing -> []
+    Just (x,y,z,w) -> [x,y,z,w]
+
 faceEdges :: [Point3] -> [(Point3,Point3,Point3)]
 faceEdges xs = zipWith addNormal xs (tail xs ++ [head xs])
   where