summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--examples/HelloOBJ.hs154
-rw-r--r--examples/MtlParser.hs74
-rw-r--r--examples/cube.mtl13
-rw-r--r--examples/cube.obj47
-rw-r--r--examples/hello_obj.json1
-rw-r--r--examples/hello_obj.lc16
6 files changed, 305 insertions, 0 deletions
diff --git a/examples/HelloOBJ.hs b/examples/HelloOBJ.hs
new file mode 100644
index 0000000..10bf248
--- /dev/null
+++ b/examples/HelloOBJ.hs
@@ -0,0 +1,154 @@
1{-# LANGUAGE PackageImports, LambdaCase, OverloadedStrings, RecordWildCards #-}
2import System.Environment
3import "GLFW-b" Graphics.UI.GLFW as GLFW
4import Data.Text (unpack,Text)
5import Data.List (groupBy,nub)
6import Data.Maybe
7import Control.Monad
8import Data.Map (Map)
9import qualified Data.Map as Map
10import qualified Data.Vector as V
11import qualified Data.ByteString as SB
12
13import LambdaCube.GL as LambdaCubeGL -- renderer
14import LambdaCube.GL.Mesh as LambdaCubeGL
15
16import Codec.Picture as Juicy
17import Data.Aeson
18import Codec.Wavefront
19
20import MtlParser
21
22----------------------------------------------------
23-- See: http://lambdacube3d.com/getting-started
24----------------------------------------------------
25
26objToMesh :: WavefrontOBJ -> [(Mesh,Maybe Text)]
27objToMesh WavefrontOBJ{..} = [(toMesh faceGroup, elMtl . head $ faceGroup) | faceGroup <- faces] where
28 faces = groupBy (\a b -> elMtl a == elMtl b) (V.toList objFaces)
29 toMesh l = Mesh
30 { mAttributes = Map.fromList
31 [ ("position", A_V4F position)
32 , ("normal", A_V3F normal)
33 , ("uvw", A_V3F texcoord)
34 ]
35 , mPrimitive = P_Triangles
36 } where
37 triangulate (Triangle a b c) = [a,b,c]
38 triangulate (Quad a b c d) = [a,b,c, c,d,a]
39 triangulate _ = []
40 defaultPosition = Location 0 0 0 0
41 defaultNormal = Normal 0 0 0
42 defaultTexCoord = TexCoord 0 0 0
43 v !- i = v V.!? (i-1)
44 toVertex FaceIndex{..} = ( let Location x y z w = fromMaybe defaultPosition (objLocations !- faceLocIndex) in V4 x y z w
45 , let Normal x y z = fromMaybe defaultNormal ((objNormals !-) =<< faceNorIndex) in V3 x y z
46 , let TexCoord x y z = fromMaybe defaultTexCoord ((objTexCoords !-) =<< faceTexCoordIndex) in V3 x y z
47 )
48 (position,normal,texcoord) = V.unzip3 . V.concat . map (V.fromList . map toVertex . triangulate . elValue) $ l
49
50
51loadOBJ :: String -> IO (Either String ([(Mesh,Maybe Text)],MtlLib))
52loadOBJ fname = fromFile fname >>= \case -- load geometry
53 Left err -> putStrLn err >> return (Left err)
54 Right obj@WavefrontOBJ{..} -> do
55 -- load materials
56 mtlLib <- mconcat . V.toList <$> mapM (readMtl . unpack) objMtlLibs
57 return $ Right (objToMesh obj,mtlLib)
58
59loadOBJToGPU :: String -> IO (Either String ([(GPUMesh, Maybe Text)], MtlLib))
60loadOBJToGPU fname = loadOBJ fname >>= \case
61 Left err -> return $ Left err
62 Right (subModels,mtlLib) -> do
63 gpuSubModels <- forM subModels $ \(mesh,mat) -> LambdaCubeGL.uploadMeshToGPU mesh >>= \a -> return (a,mat)
64 return $ Right (gpuSubModels,mtlLib)
65
66uploadMtlLib :: MtlLib -> IO (Map Text TextureData)
67uploadMtlLib mtlLib = do
68 -- collect used textures
69 let usedTextures = nub . concatMap (maybeToList . mtl_map_Kd) $ Map.elems mtlLib
70 whiteImage = Juicy.ImageRGB8 $ Juicy.generateImage (\_ _ -> Juicy.PixelRGB8 255 255 255) 1 1
71 checkerImage = Juicy.ImageRGB8 $ Juicy.generateImage (\x y -> if mod (x + y) 2 == 0 then Juicy.PixelRGB8 0 0 0 else Juicy.PixelRGB8 255 255 0) 2 2
72 checkerTex <- LambdaCubeGL.uploadTexture2DToGPU checkerImage
73 -- load images and upload to gpu
74 textureLib <- forM (Map.fromList $ zip usedTextures usedTextures) $ \fname -> Juicy.readImage fname >>= \case
75 Left err -> putStrLn err >> return checkerTex
76 Right img -> LambdaCubeGL.uploadTexture2DToGPU img
77 whiteTex <- LambdaCubeGL.uploadTexture2DToGPU whiteImage
78 -- pair textures and materials
79 return $ maybe whiteTex (fromMaybe checkerTex . flip Map.lookup textureLib) . mtl_map_Kd <$> mtlLib
80
81addOBJToObjectArray :: GLStorage -> String -> [(GPUMesh, Maybe Text)] -> Map Text TextureData -> IO [LambdaCubeGL.Object]
82addOBJToObjectArray storage slotName objMesh mtlLib = forM objMesh $ \(mesh,mat) -> do
83 obj <- LambdaCubeGL.addMeshToObjectArray storage slotName ["diffuseTexture"] mesh -- diffuseTexture value can change on each model
84 case mat >>= flip Map.lookup mtlLib of
85 Nothing -> return ()
86 Just t -> LambdaCubeGL.updateObjectUniforms obj $ do
87 "diffuseTexture" @= return t -- set model's diffuse texture
88 return obj
89
90main :: IO ()
91main = do
92 Just pipelineDesc <- decodeStrict <$> SB.readFile "hello_obj.json"
93
94 win <- initWindow "LambdaCube 3D DSL OBJ viewer" 640 640
95
96 -- setup render data
97 let inputSchema = makeSchema $ do
98 defObjectArray "objects" Triangles $ do
99 "position" @: Attribute_V4F
100 "normal" @: Attribute_V3F
101 "uvw" @: Attribute_V3F
102 defUniforms $ do
103 "time" @: Float
104 "diffuseTexture" @: FTexture2D
105
106 storage <- LambdaCubeGL.allocStorage inputSchema
107
108 objName <- head . (++ ["cube.obj"]) <$> getArgs
109 -- load OBJ geometry and material descriptions
110 Right (objMesh,mtlLib) <- loadOBJToGPU objName
111 -- load materials textures
112 gpuMtlLib <- uploadMtlLib mtlLib
113 -- add OBJ to pipeline input
114 addOBJToObjectArray storage "objects" objMesh gpuMtlLib
115
116 -- allocate GL pipeline
117 renderer <- LambdaCubeGL.allocRenderer pipelineDesc
118 LambdaCubeGL.setStorage renderer storage >>= \case -- check schema compatibility
119 Just err -> putStrLn err
120 Nothing -> loop
121 where loop = do
122 -- update graphics input
123 GLFW.getWindowSize win >>= \(w,h) -> LambdaCubeGL.setScreenSize storage (fromIntegral w) (fromIntegral h)
124 LambdaCubeGL.updateUniforms storage $ do
125 "time" @= do
126 Just t <- GLFW.getTime
127 return (realToFrac t :: Float)
128 -- render
129 LambdaCubeGL.renderFrame renderer
130 GLFW.swapBuffers win
131 GLFW.pollEvents
132
133 let keyIsPressed k = fmap (==KeyState'Pressed) $ GLFW.getKey win k
134 escape <- keyIsPressed Key'Escape
135 if escape then return () else loop
136
137 LambdaCubeGL.disposeRenderer renderer
138 LambdaCubeGL.disposeStorage storage
139 GLFW.destroyWindow win
140 GLFW.terminate
141
142initWindow :: String -> Int -> Int -> IO Window
143initWindow title width height = do
144 GLFW.init
145 GLFW.defaultWindowHints
146 mapM_ GLFW.windowHint
147 [ WindowHint'ContextVersionMajor 3
148 , WindowHint'ContextVersionMinor 3
149 , WindowHint'OpenGLProfile OpenGLProfile'Core
150 , WindowHint'OpenGLForwardCompat True
151 ]
152 Just win <- GLFW.createWindow width height title Nothing Nothing
153 GLFW.makeContextCurrent $ Just win
154 return win
diff --git a/examples/MtlParser.hs b/examples/MtlParser.hs
new file mode 100644
index 0000000..b57a7f0
--- /dev/null
+++ b/examples/MtlParser.hs
@@ -0,0 +1,74 @@
1module MtlParser
2 ( ObjMaterial (..)
3 , MtlLib
4 , parseMtl
5 , readMtl
6 ) where
7
8import Data.Map (Map)
9import qualified Data.Map as Map
10import Data.Maybe
11import Control.Monad.State.Strict
12import Control.Monad.Writer
13import Data.Text (pack,Text)
14
15type Vec3 = (Float,Float,Float)
16
17type MtlLib = Map Text ObjMaterial
18
19data ObjMaterial
20 = ObjMaterial
21 { mtl_Name :: Text
22 , mtl_Ka :: Vec3 -- ambient color
23 , mtl_Kd :: Vec3 -- diffuse color
24 , mtl_Ks :: Vec3 -- specular color
25 , mtl_illum :: Int
26 , mtl_Tr :: Float -- transparency
27 , mtl_Ns :: Float -- specular exponent
28 , mtl_map_Kd :: Maybe String -- diffuse texture file name
29 }
30 deriving (Eq,Show)
31
32newMaterial name = ObjMaterial
33 { mtl_Name = name
34 , mtl_Ka = (1, 1, 1)
35 , mtl_Kd = (1, 1, 1)
36 , mtl_Ks = (0, 0, 0)
37 , mtl_illum = 1
38 , mtl_Tr = 1
39 , mtl_Ns = 0
40 , mtl_map_Kd = Nothing
41 }
42
43type Mtl = WriterT [ObjMaterial] (State (Maybe ObjMaterial))
44
45readMaybe :: Read a => String -> Maybe a
46readMaybe s = case reads s of
47 [(val, "")] -> Just val
48 _ -> Nothing
49
50readVec3 :: String -> String -> String -> Maybe Vec3
51readVec3 r g b = (,,) <$> readMaybe r <*> readMaybe g <*> readMaybe b
52
53setAttr = modify' . fmap
54addMaterial = gets maybeToList >>= tell
55
56parseLine :: String -> Mtl ()
57parseLine s = case words $ takeWhile (/='#') s of
58 ["newmtl",name] -> do
59 addMaterial
60 put $ Just $ newMaterial $ pack name
61 ["map_Kd",textureName] -> setAttr (\s -> s {mtl_map_Kd = Just textureName})
62 ["Ka",r,g,b] | Just rgb <- readVec3 r g b -> setAttr (\s -> s {mtl_Ka = rgb})
63 ["Kd",r,g,b] | Just rgb <- readVec3 r g b -> setAttr (\s -> s {mtl_Kd = rgb})
64 ["Ks",r,g,b] | Just rgb <- readVec3 r g b -> setAttr (\s -> s {mtl_Ks = rgb})
65 ["illum",a] | Just v <- readMaybe a -> setAttr (\s -> s {mtl_illum = v})
66 ["Tr",a] | Just v <- readMaybe a -> setAttr (\s -> s {mtl_Tr = v})
67 ["Ns",a] | Just v <- readMaybe a -> setAttr (\s -> s {mtl_Ns = v})
68 _ -> return ()
69
70parseMtl :: String -> MtlLib
71parseMtl src = Map.fromList [(mtl_Name m,m) | m <- evalState (execWriterT (mapM_ parseLine (lines src) >> addMaterial)) Nothing]
72
73readMtl :: String -> IO MtlLib
74readMtl fname = parseMtl <$> readFile fname
diff --git a/examples/cube.mtl b/examples/cube.mtl
new file mode 100644
index 0000000..92bd13c
--- /dev/null
+++ b/examples/cube.mtl
@@ -0,0 +1,13 @@
1newmtl material0
2 Ns 10.0000
3 Ni 1.5000
4 d 1.0000
5 Tr 0.0000
6 Tf 1.0000 1.0000 1.0000
7 illum 2
8 Ka 0.0000 0.0000 0.0000
9 Kd 0.5880 0.5880 0.5880
10 Ks 0.0000 0.0000 0.0000
11 Ke 0.0000 0.0000 0.0000
12 map_Ka logo.png
13 map_Kd logo.png
diff --git a/examples/cube.obj b/examples/cube.obj
new file mode 100644
index 0000000..9b0cb54
--- /dev/null
+++ b/examples/cube.obj
@@ -0,0 +1,47 @@
1# cube.obj
2#
3
4o cube
5mtllib cube.mtl
6
7v -0.500000 -0.500000 0.500000
8v 0.500000 -0.500000 0.500000
9v -0.500000 0.500000 0.500000
10v 0.500000 0.500000 0.500000
11v -0.500000 0.500000 -0.500000
12v 0.500000 0.500000 -0.500000
13v -0.500000 -0.500000 -0.500000
14v 0.500000 -0.500000 -0.500000
15
16vt 0.000000 0.000000
17vt 1.000000 0.000000
18vt 0.000000 1.000000
19vt 1.000000 1.000000
20
21vn 0.000000 0.000000 1.000000
22vn 0.000000 1.000000 0.000000
23vn 0.000000 0.000000 -1.000000
24vn 0.000000 -1.000000 0.000000
25vn 1.000000 0.000000 0.000000
26vn -1.000000 0.000000 0.000000
27
28g cube
29usemtl material0
30s 1
31f 1/1/1 2/2/1 3/3/1
32f 3/3/1 2/2/1 4/4/1
33s 2
34f 3/1/2 4/2/2 5/3/2
35f 5/3/2 4/2/2 6/4/2
36s 3
37f 5/4/3 6/3/3 7/2/3
38f 7/2/3 6/3/3 8/1/3
39s 4
40f 7/1/4 8/2/4 1/3/4
41f 1/3/4 8/2/4 2/4/4
42s 5
43f 2/1/5 8/2/5 4/3/5
44f 4/3/5 8/2/5 6/4/5
45s 6
46f 7/1/6 1/2/6 5/3/6
47f 5/3/6 1/2/6 3/4/6
diff --git a/examples/hello_obj.json b/examples/hello_obj.json
new file mode 100644
index 0000000..9c3e98f
--- /dev/null
+++ b/examples/hello_obj.json
@@ -0,0 +1 @@
{"textures":[],"commands":[{"tag":"SetRenderTarget","arg0":0},{"tag":"ClearRenderTarget","arg0":[{"tag":"ClearImage","clearValue":{"tag":"VFloat","arg0":1},"imageSemantic":{"tag":"Depth"}},{"tag":"ClearImage","clearValue":{"tag":"VV4F","arg0":{"w":1,"z":0.4,"x":0.0,"y":0.0}},"imageSemantic":{"tag":"Color"}}]},{"tag":"SetProgram","arg0":0},{"tag":"SetSamplerUniform","arg0":"diffuseTexture","arg1":0},{"tag":"SetRasterContext","arg0":{"arg3":{"tag":"LastVertex"},"tag":"TriangleCtx","arg0":{"tag":"CullBack","arg0":{"tag":"CCW"}},"arg1":{"tag":"PolygonFill"},"arg2":{"tag":"NoOffset"}}},{"tag":"SetAccumulationContext","arg0":{"accViewportName":null,"tag":"AccumulationContext","accOperations":[{"tag":"DepthOp","arg0":{"tag":"Less"},"arg1":true},{"tag":"ColorOp","arg0":{"tag":"NoBlending"},"arg1":{"tag":"VV4B","arg0":{"w":true,"z":true,"x":true,"y":true}}}]}},{"tag":"RenderSlot","arg0":0}],"slots":[{"tag":"Slot","slotPrimitive":{"tag":"Triangles"},"slotStreams":{"normal":{"tag":"V3F"},"uvw":{"tag":"V3F"},"position":{"tag":"V4F"}},"slotName":"objects","slotUniforms":{"time":{"tag":"Float"},"diffuseTexture":{"tag":"FTexture2D"}},"slotPrograms":[0]}],"programs":[{"programInTextures":{"diffuseTexture":{"tag":"FTexture2D"}},"tag":"Program","programOutput":[{"tag":"Parameter","ty":{"tag":"V4F"},"name":"f0"}],"programStreams":{"vi3":{"tag":"Parameter","ty":{"tag":"V3F"},"name":"uvw"},"vi2":{"tag":"Parameter","ty":{"tag":"V3F"},"name":"normal"},"vi1":{"tag":"Parameter","ty":{"tag":"V4F"},"name":"position"}},"fragmentShader":"#version 330 core\nvec4 texture2D(sampler2D s,vec2 uv) {\n return texture(s,uv);\n}\nuniform sampler2D diffuseTexture;\nsmooth in vec2 vo1;\nout vec4 f0;\nvoid main() {\n f0 = texture2D (diffuseTexture,vo1);\n}","vertexShader":"#version 330 core\nvec4 texture2D(sampler2D s,vec2 uv) {\n return texture(s,uv);\n}\nuniform float time;\nin vec4 vi1;\nin vec3 vi2;\nin vec3 vi3;\nsmooth out vec2 vo1;\nvec4 ext0_Float_3(vec3 z0) {\n return vec4 ((z0).x,(z0).y,(z0).z,0.0);\n}\nvec3 neg_VecSFloat3(vec3 z0) {\n return - (z0);\n}\nmat4 translateBefore4(vec3 z0) {\n return mat4 (vec4 (1.0,0.0,0.0,0.0)\n ,vec4 (0.0,1.0,0.0,0.0)\n ,vec4 (0.0,0.0,1.0,0.0)\n ,vec4 ((z0).x,(z0).y,(z0).z,1.0));\n}\nmat4 lookat(vec3 z0,vec3 z1,vec3 z2) {\n return (transpose (mat4 (ext0_Float_3 (normalize (cross (z2\n ,normalize ((z0) - (z1)))))\n ,ext0_Float_3 (cross (normalize ((z0) - (z1))\n ,normalize (cross (z2,normalize ((z0) - (z1))))))\n ,ext0_Float_3 (normalize ((z0) - (z1)))\n ,vec4 (0.0,0.0,0.0,1.0)))) * (translateBefore4 (neg_VecSFloat3 (z0)));\n}\nmat4 perspective(float z0,float z1,float z2,float z3) {\n return mat4 (vec4 (((2.0) * (z0)) / (((z3) * ((z0) * (tan\n ((z2) / (2.0))))) - ((0.0) - ((z3) * ((z0) * (tan ((z2) / (2.0)))))))\n ,0.0\n ,0.0\n ,0.0)\n ,vec4 (0.0\n ,((2.0) * (z0)) / (((z0) * (tan ((z2) / (2.0)))) - ((0.0) - ((z0) * (tan\n ((z2) / (2.0))))))\n ,0.0\n ,0.0)\n ,vec4 ((((z3) * ((z0) * (tan ((z2) / (2.0))))) + ((0.0) - ((z3) * ((z0) * (tan\n ((z2) / (2.0))))))) / (((z3) * ((z0) * (tan\n ((z2) / (2.0))))) - ((0.0) - ((z3) * ((z0) * (tan ((z2) / (2.0)))))))\n ,(((z0) * (tan ((z2) / (2.0)))) + ((0.0) - ((z0) * (tan\n ((z2) / (2.0)))))) / (((z0) * (tan ((z2) / (2.0)))) - ((0.0) - ((z0) * (tan\n ((z2) / (2.0))))))\n ,(0.0) - (((z1) + (z0)) / ((z1) - (z0)))\n ,-1.0)\n ,vec4 (0.0,0.0,(0.0) - ((((2.0) * (z1)) * (z0)) / ((z1) - (z0))),0.0));\n}\nmat4 rotMatrixX(float z0) {\n return mat4 (vec4 (1.0,0.0,0.0,0.0)\n ,vec4 (0.0,cos (z0),sin (z0),0.0)\n ,vec4 (0.0,(0.0) - (sin (z0)),cos (z0),0.0)\n ,vec4 (0.0,0.0,0.0,1.0));\n}\nmat4 rotMatrixZ(float z0) {\n return mat4 (vec4 (cos (z0),sin (z0),0.0,0.0)\n ,vec4 ((0.0) - (sin (z0)),cos (z0),0.0,0.0)\n ,vec4 (0.0,0.0,1.0,0.0)\n ,vec4 (0.0,0.0,0.0,1.0));\n}\nvoid main() {\n gl_Position = (perspective (0.1,100.0,45.0,1.0)) * ((lookat (vec3 (0.0,0.0,5.0)\n ,vec3 (0.0,0.0,0.0)\n ,vec3 (0.0,1.0,0.0))) * ((rotMatrixX (time)) * ((rotMatrixZ (time)) * (vi1))));\n vo1 = vec2 ((vi3).x,(1.0) - ((vi3).y));\n}","geometryShader":null,"programUniforms":{"time":{"tag":"Float"},"diffuseTexture":{"tag":"FTexture2D"}}}],"samplers":[],"tag":"Pipeline","backend":{"tag":"OpenGL33"},"streams":[],"targets":[{"tag":"RenderTarget","renderTargets":[{"tag":"TargetItem","targetSemantic":{"tag":"Depth"},"targetRef":{"tag":"Framebuffer","arg0":{"tag":"Depth"}}},{"tag":"TargetItem","targetSemantic":{"tag":"Color"},"targetRef":{"tag":"Framebuffer","arg0":{"tag":"Color"}}}]}],"info":"generated by lambdacube-compiler 0.6.0.0"} \ No newline at end of file
diff --git a/examples/hello_obj.lc b/examples/hello_obj.lc
new file mode 100644
index 0000000..e2d7caa
--- /dev/null
+++ b/examples/hello_obj.lc
@@ -0,0 +1,16 @@
1makeFrame (time :: Float)
2 (texture :: Texture)
3 (prims :: PrimitiveStream Triangle (Vec 4 Float, Vec 3 Float, Vec 3 Float))
4
5 = imageFrame (emptyDepthImage 1, emptyColorImage (V4 0 0 0.4 1))
6 `overlay`
7 prims
8 & mapPrimitives (\(p,n,uvw) -> (perspective 0.1 100 45 1 *. lookat (V3 0 0 5) (V3 0 0 0) (V3 0 1 0) *. rotMatrixX time *. rotMatrixZ time *. p, V2 uvw%x (1 - uvw%y) ))
9 & rasterizePrimitives (TriangleCtx CullBack PolygonFill NoOffset LastVertex) ((Smooth))
10 & mapFragments (\((uv)) -> ((texture2D (Sampler PointFilter MirroredRepeat texture) uv )))
11 & accumulateWith (DepthOp Less True, ColorOp NoBlending (V4 True True True True))
12
13main = renderFrame $
14 makeFrame (Uniform "time")
15 (Texture2DSlot "diffuseTexture")
16 (fetch "objects" (Attribute "position", Attribute "normal", Attribute "uvw"))
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-05 16:38:58 +0000