From 4026bea0ec0e2604ebcac6e31ae9ba79a85a034a Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Tue, 23 Jul 2019 00:19:18 -0400 Subject: Implement 3 distinct lighting models. --- LoadMesh.hs | 43 +++++++++++++++++-------- MeshSketch.hs | 11 ++++++- hello_obj2.lc | 101 +++++++++++++++++++++++++++++++++++++++++++++++++++++----- 3 files changed, 133 insertions(+), 22 deletions(-) diff --git a/LoadMesh.hs b/LoadMesh.hs index cda6349..d8ce42b 100644 --- a/LoadMesh.hs +++ b/LoadMesh.hs @@ -126,8 +126,6 @@ uploadOBJToGPU :: Maybe BoundingBox -> MeshData -> IO ([MaterialMesh GPUMesh],Ma uploadOBJToGPU scalebb (subModels,(mtlLib,objpath)) = do let meshbb = foldMap (attribBoundingBox . mAttributes . materialMesh) subModels :: BoundingBox m = maybe (ident 4) (scaleWithin meshbb) scalebb - -- BoundingBox {minX = -6.44698, maxX = 6.44698, minY = 0.0, maxY = 1.0e9, minZ = -0.768655, maxZ = 1.0e8} - -- BoundingBox {minX = -6.44698, maxX = 6.44698, minY = 0.0, maxY = 18.2027, minZ = -0.768655, maxZ = 2.238049} putStrLn $ show meshbb gpuSubModels <- forM subModels $ \matmesh -> do a <- LambdaCubeGL.uploadMeshToGPU (transformMesh m (materialMesh matmesh)) @@ -204,25 +202,44 @@ objSpan obj = case Map.elems (objAttributes obj) of _ -> Mask [(0,1)] -searchMaterial :: V.Vector (Map Text (ObjMaterial, TextureData)) - -> (Int, Text) - -> Maybe (ObjMaterial, TextureData) +searchMaterial + :: V.Vector (Map Text (ObjMaterial, TextureData)) -- ^ Some tail end of this vector will be searched. + -> (Int, Text) -- ^ Size of tail and material name to search for. + -> Maybe (ObjMaterial, TextureData) searchMaterial mtlLib (count,name) = foldr go id (V.drop (V.length mtlLib - count) mtlLib) Nothing where go m f r = case Map.lookup name m of Nothing -> f r x -> x :: Maybe (ObjMaterial,TextureData) -addOBJToObjectArray :: GLStorage -> String -> [MaterialMesh GPUMesh] -> V.Vector (Map Text (ObjMaterial,TextureData)) +addOBJToObjectArray :: GLStorage -> String + -> [MaterialMesh GPUMesh] + -> V.Vector (Map Text (ObjMaterial,TextureData)) -> IO [MaskableObject] addOBJToObjectArray storage slotName objMesh mtlLib = forM objMesh $ \matmesh -> do - obj <- LambdaCubeGL.addMeshToObjectArray storage slotName ["diffuseTexture","diffuseColor"] (materialMesh matmesh) - -- diffuseTexture and diffuseColor values can change on each model - case materialName matmesh >>= searchMaterial mtlLib of - Nothing -> return () - Just (ObjMaterial{..},t) -> LC.updateObjectUniforms obj $ do - "diffuseTexture" @= return t -- set model's diffuse texture - "diffuseColor" @= let (r,g,b) = mtl_Kd in return (V4 r g b mtl_Tr) + obj <- case materialName matmesh >>= searchMaterial mtlLib of + Nothing -> do + let slotnm = slotName ++ "0" + obj <- LambdaCubeGL.addMeshToObjectArray storage + slotnm + [ "diffuseTexture" + , "diffuseColor" + , "specularReflectivity"] + (materialMesh matmesh) + return obj + Just (ObjMaterial{..},t) -> do + let slotnm = slotName ++ show (if 0 <= mtl_illum && mtl_illum <= 2 then mtl_illum else 2) + obj <- LambdaCubeGL.addMeshToObjectArray storage + slotnm + [ "diffuseTexture" + , "diffuseColor" + , "specularReflectivity"] + (materialMesh matmesh) + LC.updateObjectUniforms obj $ do + "diffuseTexture" @= return t -- set model's diffuse texture + "diffuseColor" @= let (r,g,b) = mtl_Kd in return (V4 r g b mtl_Tr) + "specularReflectivity" @= let (r,g,b) = mtl_Ks in return (V4 r g b mtl_Ns) + return obj let matmask = maybe Map.empty (`Map.singleton` objSpan obj) (fmap (\(c,n) -> "m:" <> pack (show c) <> ":" <> n) $ materialName matmesh) return $ MaskableObject obj (matmask `Map.union` materialMasks matmesh) diff --git a/MeshSketch.hs b/MeshSketch.hs index 56bbdaa..a51cd3d 100644 --- a/MeshSketch.hs +++ b/MeshSketch.hs @@ -333,7 +333,15 @@ new = do mpipeline <- loadPipeline ppath $ do defObjectArray "SkyCube" Triangles $ do "position" @: Attribute_V3F - defObjectArray "objects" Triangles $ do + defObjectArray "objects0" Triangles $ do + "position" @: Attribute_V4F + "normal" @: Attribute_V3F + "uvw" @: Attribute_V3F + defObjectArray "objects1" Triangles $ do + "position" @: Attribute_V4F + "normal" @: Attribute_V3F + "uvw" @: Attribute_V3F + defObjectArray "objects2" Triangles $ do "position" @: Attribute_V4F "normal" @: Attribute_V3F "uvw" @: Attribute_V3F @@ -355,6 +363,7 @@ new = do "PointsStart" @: Int "diffuseTexture" @: FTexture2D "diffuseColor" @: V4F + "specularReflectivity" @: V4F return mpipeline either (\e _ -> hPutStrLn stderr e >> throwIO (userError e)) (&) m $ \pipeline -> do mapM_ (putStrLn . ppShow) (targets $ dynamicPipeline pipeline) 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")) -- cgit v1.2.3