1 files changed, 93 insertions, 8 deletions

diff --git a/hello_obj2.lc b/hello_obj2.lc
index 7e7defc..a6df7b7 100644
--- a/hello_obj2.lc
+++ b/hello_obj2.lc
@@ -10,6 +10,88 @@ blendplane = -- NoBlending -- BlendLogicOp Xor
 point :: Vec 3 Float -> Vec 4 Float
 point p = V4 p%x p%y p%z 1
 
+homoproj :: Vec 4 Float -> Vec 3 Float
+homoproj v = v%xyz *! (1 / v%w)
+
+type Position = Vec 4 Float
+type TextureCoord = Vec 3 Float
+type Normal = Vec 3 Float
+type Overlay = ( (FragmentOperation Depth, FragmentOperation (Color (VecScalar 4 Float)))
+               , FragmentStream 1 ((Vec 4 Float)) )
+
+-- This lighting model ignores the normal vector and simply applies
+-- ambient lighting and a texture map.
+--
+-- "Color on and Ambient off"
+-- inputs: Kd, map_Kd
+--
+-- illum 0 -- color = Kd
+ambientOnly :: Mat 4 4 Float -> Vec 4 Float -> Texture -> PrimitiveStream Triangle (Position,TextureCoord,Normal)
+                                                       -> Overlay
+ambientOnly cam color texture prims = prims
+    & mapPrimitives (\(p,n,uvw) -> ( coordmap cam p, V2 uvw%x (1 - uvw%y) ))
+    & rasterizePrimitives (TriangleCtx CullBack PolygonFill NoOffset LastVertex) ((Smooth))
+    & mapFragments (\((uv)) -> ((color * texture2D (Sampler PointFilter MirroredRepeat texture) uv )))
+    & accumulateWith (DepthOp Less True, ColorOp NoBlending (V4 True True True True))
+
+-- ½ ambient + ½ lambertian reflectance
+-- lambertian reflectance = (light ∙ normal) * diffuse * intensity
+-- I_d = (L ∙ N) C_d I_L
+--
+-- "Color on and Ambient on"
+-- Chrome example indicates: Ka, Kd, Ks, refl
+--
+-- illum 1 -- color = KaIa + Kd { SUM j=1..ls, (N ∙ Lj)Ij }
+--
+-- The illum 0 can be implemented using illum 1 code by setting
+--   KaIa = Kd
+--   Ij = 0 forall j
+lambertianReflectance cam lightpos color texture prims = prims
+    & mapPrimitives (\(p,n,uvw) ->
+        let light_vector = normalize $ -- light direction from surface
+                            if lightpos%w == 0
+                                then lightpos%xyz
+                                else homoproj lightpos - homoproj p
+            lambertian = dot light_vector (normalize n)
+          in ( coordmap cam p, V2 uvw%x (1 - uvw%y), lambertian ))
+    & rasterizePrimitives (TriangleCtx CullBack PolygonFill NoOffset LastVertex) (Smooth,Smooth)
+    & mapFragments (\(uv,lambertian) -> ((color * texture2D (Sampler PointFilter MirroredRepeat texture) uv *! (0.5 + 0.5*lambertian) )))
+    & accumulateWith (DepthOp Less True, ColorOp NoBlending (V4 True True True True))
+
+
+-- Blinn-Phong
+--
+-- illum 0 -- color = Kd
+-- illum 1 -- color = KaIa + Kd { SUM j=1..ls, (N ∙ Lj)Ij }
+-- illum 2 -- color = KaIa + Kd { SUM j=1..ls, (N ∙ Lj)Ij } + Ks { SUM j=1..ls, ((H∙Hj)^Ns)Ij }
+--
+-- The illum 1 can be implemented using illum2 code by setting
+--   Ks = 0 (specular reflectance)
+--
+-- TODO: Add (H∙Hj)^Ns term
+--
+-- Okay, I don't understand why the spec says H∙Hj.  I think it means N∙Hj.
+-- So i'm implementing that.
+blinnPhong cam lightpos color texture specular prims = prims
+    & mapPrimitives (\(p,n,uvw) ->
+        let light_vector = normalize $ -- light direction from surface
+                            if lightpos%w == 0
+                                then lightpos%xyz
+                                else homoproj lightpos - homoproj p
+            campos = cam *. V4 0 0 0 1
+            view_vector = normalize $ homoproj campos - homoproj p
+            h = normalize $ light_vector + view_vector
+            refl = dot h (normalize n)
+            lambertian = dot light_vector (normalize n)
+          in ( coordmap cam p, V2 uvw%x (1 - uvw%y), lambertian, refl ))
+    & rasterizePrimitives (TriangleCtx CullBack PolygonFill NoOffset LastVertex) (Smooth,Smooth,Smooth)
+    & mapFragments (\(uv,lambertian, refl) ->
+        let ct = texture2D (Sampler PointFilter MirroredRepeat texture) uv
+            ns = specular%w
+            ks = point $ specular%xyz
+        in (( color * ct *! (0.5 + 0.5*lambertian) + if refl>0 then ks *! pow refl ns else zero )) )
+    & accumulateWith (DepthOp Less True, ColorOp NoBlending (V4 True True True True))
+
 
 makeFrame (cubemap :: TextureCube)
           (skybox :: PrimitiveStream Triangle ((Vec 3 Float)))
@@ -17,7 +99,10 @@ makeFrame (cubemap :: TextureCube)
           (cam ::  Mat 4 4 Float)
           (color :: Vec 4 Float)
           (texture :: Texture)
-          (prims :: PrimitiveStream Triangle (Vec 4 Float, Vec 3 Float, Vec 3 Float))
+          (specular :: Vec 4 Float)
+          (prims0 :: PrimitiveStream Triangle (Vec 4 Float, Vec 3 Float, Vec 3 Float))
+          (prims1 :: PrimitiveStream Triangle (Vec 4 Float, Vec 3 Float, Vec 3 Float))
+          (prims2 :: PrimitiveStream Triangle (Vec 4 Float, Vec 3 Float, Vec 3 Float))
           (plane :: PrimitiveStream Triangle ((Vec 4 Float)))
           (lines :: PrimitiveStream Line (Vec 3 Float, Vec 3 Float))
           (points :: PrimitiveStream Point (Vec 3 Float, Vec 3 Float))
@@ -32,12 +117,9 @@ makeFrame (cubemap :: TextureCube)
     & rasterizePrimitives (TriangleCtx CullNone PolygonFill NoOffset LastVertex) ((Smooth))
     & mapFragments (\((d)) -> (( textureCube cubemap d )))
     & accumulateWith (DepthOp Always False, ColorOp NoBlending (V4 True True True True))
-  `overlay`
-      prims
-    & mapPrimitives (\(p,n,uvw) -> ( coordmap cam p, V2 uvw%x (1 - uvw%y) ))
-    & rasterizePrimitives (TriangleCtx CullBack PolygonFill NoOffset LastVertex) ((Smooth))
-    & mapFragments (\((uv)) -> ((color * texture2D (Sampler PointFilter MirroredRepeat texture) uv )))
-    & accumulateWith (DepthOp Less True, ColorOp NoBlending (V4 True True True True))
+  `overlay` ambientOnly           cam color texture prims0
+  `overlay` lambertianReflectance cam (V4 0 20 10 1) color texture prims1
+  `overlay` blinnPhong            cam (V4 0 20 10 1) color texture specular prims2
   `overlay`
       plane
     & mapPrimitives (\((p)) -> let p' = coordmap cam $ plane_mat *. p in (p', p%xz))
@@ -89,7 +171,10 @@ main = renderFrame $
              (Uniform "ViewProjection")
              (Uniform "diffuseColor")
              (Texture2DSlot "diffuseTexture")
-             (fetch "objects" (Attribute "position", Attribute "normal", Attribute "uvw"))
+             (Uniform "specularReflectivity")
+             (fetch "objects0" (Attribute "position", Attribute "normal", Attribute "uvw"))
+             (fetch "objects1" (Attribute "position", Attribute "normal", Attribute "uvw"))
+             (fetch "objects2" (Attribute "position", Attribute "normal", Attribute "uvw"))
              (fetch "plane"   ((Attribute "position")))
              (fetch "Curve" (Attribute "position", Attribute "color"))
              (fetch "Points" (Attribute "position", Attribute "color"))