Almost working shadows

shader/lighting/lineShadow.geom

@@ -10,18 +10,31 @@ void main()
     vec4 p0 = gl_in[0].gl_Position;
     vec3 n0 = gl_in[2].gl_Position.xyz;
     vec3 n1 = gl_in[3].gl_Position.xyz;
+    vec3 n2 = n0 + n1; // assumes the summands are normalized
     vec3 lightDir = p0.xyz - lightPos.xyz;
-    if ( dot(n0 , lightDir) * dot(n1 , lightDir) < 0 );
+    // first test if the edge is part of the silhouette
+    // that is, if the normals of the faces connected by the edge point in
+    // "different directions" wrt the light direction
+    if ( dot(n0 , lightDir) * dot(n1 , lightDir) < 0 )
     {
-        gl_Position = f(p0); EmitVertex();
         vec4 p1 = gl_in[1].gl_Position;
-        gl_Position = f(p1); EmitVertex();
         vec4 p2 = shift(p0);
-        gl_Position = f(p2); EmitVertex();
         vec4 p3 = shift(p1);
-        gl_Position = f(p3); EmitVertex();
+        if ( dot(n0 , lightDir) > 0)
+        {
+            gl_Position = f(p0); EmitVertex();
+            gl_Position = f(p1); EmitVertex();
+            gl_Position = f(p2); EmitVertex();
+            gl_Position = f(p3); EmitVertex();
+        }
+        else
+        {
+            gl_Position = f(p1); EmitVertex();
+            gl_Position = f(p0); EmitVertex();
+            gl_Position = f(p3); EmitVertex();
+            gl_Position = f(p2); EmitVertex();
+        }
         EndPrimitive();
     }
-    {
+    else { }
-    }
 }

src/Dodge/Creature/Inanimate.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE TupleSections #-}
 {-
 Inanimate objects such as lamps, barrels, etc
 -}
@@ -17,6 +18,8 @@ import Dodge.Creature.Update hiding (CRUpdate)
 import Picture
 import qualified IntMapHelp as IM
 import Geometry
+import Geometry.Vector3D
+import Polyhedra
 
 import Control.Lens
 
@@ -33,15 +36,15 @@ lamp = defaultInanimate
     }
 lampPic :: Picture
 lampPic = pictures
-    [ setDepth (0.049) $ color white $ polygon $ rectNSEW 5 (-5) 5 (-5)
+    [ pictures . map (Poly3D 0 . map ((, blue) . (-.-.- (2.5,2.5,0)))) $ boxXYZ 5 5 99
-    , setDepth (0) $ color white $ circleSolid 3
+    , setDepth (100) $ color white $ circleSolid 3
     ]
 
 initialiseLamp :: CRUpdate
 initialiseLamp w (f,g) cr = ( (addLS . f , g), Just $ cr & crUpdate .~ updateLamp i)
   where
     i = IM.newKey $ _lightSources $ f w -- to give different lights different keys
-    addLS = over lightSources (IM.insert i (lightAt (x,y,100) i))
+    addLS = over lightSources (IM.insert i (lightAt (x,y,20) i))
     (x,y) = _crPos cr
 
 updateLamp :: Int -> CRUpdate
@@ -53,7 +56,7 @@ updateLamp i = unrandUpdate handleLS internalUpdate
         | otherwise    = w & lightSources . ix i . lsPos .~ f cPos
       where
         cPos = _crPos cr
-        f (x,y) = (x,y,100)
+        f (x,y) = (x,y,120)
     internalUpdate cr 
         | _crHP cr < 0 = Nothing
         | otherwise    = Just $ doDamage cr

src/Dodge/LightSources.hs

@@ -14,7 +14,7 @@ lightAt (x,y,z) i =
     LS {_lsID = i
        ,_lsPos = (x,y,z)
        ,_lsDir = 0
-       ,_lsRad = 300
+       ,_lsRad = 500
        ,_lsIntensity = 0.75
        }
 basicLS :: PSType

src/Dodge/Room/Start.hs

@@ -23,8 +23,10 @@ startRoom = do
     w <- state $ randomR (100,400)
     h <- state $ randomR (200,400)
     let fground = sPS (0,0) 0 $ PutForeground $ 
-            highPipe 80 (0,h/3) (w, 2*h/3)
+            highPipe 80 (0,h/3) (w, h/2)
-            ++ highPipe 20 (0,2*h/3) (w, h/3)
+            ++ highPipe 40 (0,h/2) (w, h/3)
+            ++ highPipe 60 (w/3,0) (w/3, h)
+            -- ++ highPipe 20 (0,2*h/3) (w, h/3)
 --            , girderV cola 10 (0,3*h/4) (w, 3*h/4)
 --            , girder colb 5 (0,5*h/8) (w, 5*h/8)
     treeFromPost [Left rezBox, Left door] . Right <$> randomiseOutLinks (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h & rmPS %~ (fground :))

src/Geometry/Vector3D.hs

@@ -26,13 +26,13 @@ infixl 7 *.*.*
     !z = z1 - z2
   in (x, y, z)
 {- | 3D scalar multiplication.  -}
-(*.*.*) :: Point3 -> Point3 -> Point3
+(*.*.*) :: Float -> Point3 -> Point3
 {-# INLINE (*.*.*) #-}
-(x1, y1, z1) *.*.* (x2, y2, z2) =
+a *.*.* (x2, y2, z2) =
   let
-    !x = x1 * x2
+    !x = a * x2
-    !y = y1 * y2
+    !y = a * y2
-    !z = z1 * z2
+    !z = a * z2
   in (x, y, z)
 
 crossProd :: Point3 -> Point3 -> Point3
@@ -48,3 +48,11 @@ rotate3 a (x,y,z) = (x',y',z)
   where 
     (x',y') = rotateV a (x,y)
 
+magV3 :: Point3 -> Float
+magV3 (x,y,z) = sqrt $ x^i + y^i + z^i
+  where
+    i = 2 :: Int
+
+normalizeV3 :: Point3 -> Point3
+normalizeV3 (0,0,0) = (0,0,0)
+normalizeV3 p = (1 / magV3 p) *.*.* p

src/Render.hs

@@ -6,7 +6,7 @@ import Shader.Poke
 --import MatrixHelper
 import Data.Preload.Render
 import Picture.Data
-import Picture.Tree
+--import Picture.Tree
 --import Geometry
 import Geometry.Data
 import Polyhedra.Data