diff options
-rw-r--r-- | InfinitePlane.hs | 18 | ||||
-rw-r--r-- | hello_obj2.lc | 17 | ||||
-rw-r--r-- | mainObj.hs | 12 |
3 files changed, 31 insertions, 16 deletions
diff --git a/InfinitePlane.hs b/InfinitePlane.hs index 9dd3a59..f353932 100644 --- a/InfinitePlane.hs +++ b/InfinitePlane.hs | |||
@@ -32,6 +32,9 @@ xyplane_inf = Mesh | |||
32 | ] | 32 | ] |
33 | } | 33 | } |
34 | 34 | ||
35 | times1000 (V4 a b c d) = V4 (f a) (f b) (f c) d where f = (* 10000.0) | ||
36 | |||
37 | |||
35 | -- | This represents the xy-plane as a large triangle. This makes it easier | 38 | -- | This represents the xy-plane as a large triangle. This makes it easier |
36 | -- to interpolate 3d world coordinates in the fragment. | 39 | -- to interpolate 3d world coordinates in the fragment. |
37 | xyplane :: LambdaCubeGL.Mesh | 40 | xyplane :: LambdaCubeGL.Mesh |
@@ -45,5 +48,18 @@ xyplane = Mesh | |||
45 | [ 0, 1, 2 | 48 | [ 0, 1, 2 |
46 | ] | 49 | ] |
47 | } | 50 | } |
48 | where times1000 (V4 a b c d) = V4 (f a) (f b) (f c) d where f = (* 10000.0) | 51 | |
52 | -- | This represents the xz-plane as a large triangle. This makes it easier | ||
53 | -- to interpolate 3d world coordinates in the fragment. | ||
54 | xzplane :: LambdaCubeGL.Mesh | ||
55 | xzplane = Mesh | ||
56 | { mAttributes = Map.singleton "position" $ A_V4F $ V.fromList $ map times1000 | ||
57 | [ V4 0 0 1 1 | ||
58 | , V4 (1/sqrt 2) 0 ((-1)/sqrt 2) 1 | ||
59 | , V4 ((-1)/sqrt 2) 0 ((-1)/sqrt 2) 1 | ||
60 | ] | ||
61 | , mPrimitive = P_TrianglesI $ V.fromList | ||
62 | [ 0, 1, 2 | ||
63 | ] | ||
64 | } | ||
49 | 65 | ||
diff --git a/hello_obj2.lc b/hello_obj2.lc index 5a95ad7..d0fc35b 100644 --- a/hello_obj2.lc +++ b/hello_obj2.lc | |||
@@ -7,7 +7,8 @@ blendplane = -- NoBlending -- BlendLogicOp Xor | |||
7 | ((OneBF,SrcAlpha),(DstAlpha,DstAlpha)) | 7 | ((OneBF,SrcAlpha),(DstAlpha,DstAlpha)) |
8 | (V4 0 0 0 0) | 8 | (V4 0 0 0 0) |
9 | 9 | ||
10 | makeFrame (cam :: Mat 4 4 Float) | 10 | makeFrame (cameraPosition :: Vec 3 Float) |
11 | (cam :: Mat 4 4 Float) | ||
11 | (color :: Vec 4 Float) | 12 | (color :: Vec 4 Float) |
12 | (texture :: Texture) | 13 | (texture :: Texture) |
13 | (prims :: PrimitiveStream Triangle (Vec 4 Float, Vec 3 Float, Vec 3 Float)) | 14 | (prims :: PrimitiveStream Triangle (Vec 4 Float, Vec 3 Float, Vec 3 Float)) |
@@ -22,21 +23,17 @@ makeFrame (cam :: Mat 4 4 Float) | |||
22 | & accumulateWith (DepthOp Less True, ColorOp NoBlending (V4 True True True True)) | 23 | & accumulateWith (DepthOp Less True, ColorOp NoBlending (V4 True True True True)) |
23 | `overlay` | 24 | `overlay` |
24 | plane | 25 | plane |
25 | & mapPrimitives (\((p)) -> (coordmap cam p, p%xy )) | 26 | & mapPrimitives (\((p)) -> let p' = coordmap cam p in (p', p%xz)) |
26 | & rasterizePrimitives (TriangleCtx CullNone PolygonFill NoOffset LastVertex) ((Smooth)) | 27 | & rasterizePrimitives (TriangleCtx CullNone PolygonFill NoOffset LastVertex) ((Smooth)) |
27 | -- & mapFragments (\((uv)) -> ((texture2D (Sampler PointFilter MirroredRepeat texture) uv ))) | 28 | & mapFragments (\((uv)) -> let c = mixB zero one (fract uv >= (one *! (0.95::Float))) |
28 | -- & mapFragments (\((uv)) -> ((V4 uv%x uv%y 0 1))) -- ((rgb 1 0 0))) | 29 | r = V4 1 1 1 0 *! (max c%x c%y) |
29 | & mapFragments (\((uv)) -> let k=cos(g *! (8 * pi / 4)) | ||
30 | g=uv -- *! (1 + sqrt (abs (t%x * t%y))) | ||
31 | t=normalize uv | ||
32 | c=k -- *! ( t%x * t%y) -- /! ((k%x + k%y) / k%x) | ||
33 | r = V4 1 1 1 0 *! smoothstepS 0.99 1.0 (max c%x c%y) | ||
34 | in ((r + V4 0 0 0 (0.8)))) | 30 | in ((r + V4 0 0 0 (0.8)))) |
35 | & accumulateWith (DepthOp Less True, ColorOp blendplane (V4 True True True True)) | 31 | & accumulateWith (DepthOp Less True, ColorOp blendplane (V4 True True True True)) |
36 | 32 | ||
37 | 33 | ||
38 | main = renderFrame $ | 34 | main = renderFrame $ |
39 | makeFrame (Uniform "cam") | 35 | makeFrame (Uniform "CameraPosition") |
36 | (Uniform "ViewProjection") | ||
40 | (Uniform "diffuseColor") | 37 | (Uniform "diffuseColor") |
41 | (Texture2DSlot "diffuseTexture") | 38 | (Texture2DSlot "diffuseTexture") |
42 | (fetch "objects" (Attribute "position", Attribute "normal", Attribute "uvw")) | 39 | (fetch "objects" (Attribute "position", Attribute "normal", Attribute "uvw")) |
@@ -59,7 +59,7 @@ uploadState obj glarea storage = do | |||
59 | -- add OBJ to pipeline input | 59 | -- add OBJ to pipeline input |
60 | addOBJToObjectArray storage "objects" objMesh gpuMtlLib | 60 | addOBJToObjectArray storage "objects" objMesh gpuMtlLib |
61 | -- grid plane | 61 | -- grid plane |
62 | uploadMeshToGPU xyplane >>= addMeshToObjectArray storage "plane" [] | 62 | uploadMeshToGPU xzplane >>= addMeshToObjectArray storage "plane" [] |
63 | 63 | ||
64 | -- setup FrameClock | 64 | -- setup FrameClock |
65 | tm <- newTimeKeeper | 65 | tm <- newTimeKeeper |
@@ -79,10 +79,10 @@ deg30 = pi/6 | |||
79 | 79 | ||
80 | setUniforms :: glctx -> GLStorage -> State -> IO () | 80 | setUniforms :: glctx -> GLStorage -> State -> IO () |
81 | setUniforms gl storage st = do | 81 | setUniforms gl storage st = do |
82 | t <- getSeconds $ stTimeKeeper st | 82 | t <- (/ 10.0) <$> getSeconds (stTimeKeeper st) |
83 | let tf = realToFrac t :: Float | 83 | let tf = realToFrac t :: Float |
84 | rot = rotMatrixZ (-tf) <> rotMatrixX (-tf) | 84 | rot = rotMatrixZ (-tf) <> rotMatrixX (-tf) |
85 | pos = rot #> fromList [0,0,10] | 85 | pos = rot #> fromList [2,2,10] |
86 | up = rot #> fromList [0,1,0] | 86 | up = rot #> fromList [0,1,0] |
87 | cam = lookat pos 0 up | 87 | cam = lookat pos 0 up |
88 | aspect = 1 | 88 | aspect = 1 |
@@ -90,7 +90,8 @@ setUniforms gl storage st = do | |||
90 | mvp = proj <> cam | 90 | mvp = proj <> cam |
91 | 91 | ||
92 | LC.updateUniforms storage $ do | 92 | LC.updateUniforms storage $ do |
93 | "cam" @= return (mvp :: Matrix Float) | 93 | "CameraPosition" @= return (pos :: Vector Float) |
94 | "ViewProjection" @= return (mvp :: Matrix Float) | ||
94 | 95 | ||
95 | main :: IO () | 96 | main :: IO () |
96 | main = do | 97 | main = do |
@@ -105,7 +106,8 @@ main = do | |||
105 | defObjectArray "plane" Triangles $ do | 106 | defObjectArray "plane" Triangles $ do |
106 | "position" @: Attribute_V4F | 107 | "position" @: Attribute_V4F |
107 | defUniforms $ do | 108 | defUniforms $ do |
108 | "cam" @: M44F | 109 | "CameraPosition" @: V3F |
110 | "ViewProjection" @: M44F | ||
109 | "diffuseTexture" @: FTexture2D | 111 | "diffuseTexture" @: FTexture2D |
110 | "diffuseColor" @: V4F | 112 | "diffuseColor" @: V4F |
111 | return $ (,) <$> mobj <*> mpipeline | 113 | return $ (,) <$> mobj <*> mpipeline |