1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
module Main where
import Codec.Picture as Juicy
import Control.Concurrent
import Control.Monad
import Data.Word
import Data.Function
import Data.Text (Text)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.Vector as V
import GI.Gdk.Objects
import GI.GLib.Constants
import GI.Gtk as Gtk hiding (main)
import LambdaCube.GL as LC
import LambdaCube.GL.Mesh as LC
import System.Environment
import System.IO
import System.IO.Error
import GLWidget
import LambdaCubeWidget
import TimeKeeper
import LoadMesh
import InfinitePlane
import MtlParser (ObjMaterial(..))
type State = (TimeKeeper, TickCallbackHandle)
addOBJToObjectArray :: GLStorage -> String -> [(GPUMesh, Maybe Text)] -> Map Text (ObjMaterial,TextureData) -> IO [LC.Object]
addOBJToObjectArray storage slotName objMesh mtlLib = forM objMesh $ \(mesh,mat) -> do
obj <- LC.addMeshToObjectArray storage slotName ["diffuseTexture","diffuseColor"] mesh
-- diffuseTexture and diffuseColor values can change on each model
case mat >>= flip Map.lookup 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)
return obj
uploadState :: IsWidget glarea => MeshData -> glarea -> GLStorage -> IO State
uploadState obj glarea storage = do
-- load OBJ geometry and material descriptions
(objMesh,mtlLib) <- uploadOBJToGPU obj
-- load materials textures
gpuMtlLib <- uploadMtlLib mtlLib
-- add OBJ to pipeline input
addOBJToObjectArray storage "objects" objMesh gpuMtlLib
-- grid plane
uploadMeshToGPU xyplane >>= addMeshToObjectArray storage "plane" []
-- setup FrameClock
tm <- newTimeKeeper
tickcb <- widgetAddTickCallback glarea (tick tm)
return (tm,tickcb)
destroyState :: GLArea -> State -> IO ()
destroyState glarea (tm,tickcb) = do
widgetRemoveTickCallback glarea tickcb
setUniforms :: glctx -> GLStorage -> State -> IO ()
setUniforms gl storage (tm,_) = do
t <- withMVar (tmSeconds tm) return
LC.updateUniforms storage $ do
"time" @= return (realToFrac t :: Float)
main :: IO ()
main = do
m <- do
objName <- head . (++ ["cube.obj"]) <$> getArgs
mobj <- loadOBJ objName
mpipeline <- loadPipeline "hello_obj2.json" $ do
defObjectArray "objects" Triangles $ do
"position" @: Attribute_V4F
"normal" @: Attribute_V3F
"uvw" @: Attribute_V3F
defObjectArray "plane" Triangles $ do
"position" @: Attribute_V4F
defUniforms $ do
"time" @: Float
"diffuseTexture" @: FTexture2D
"diffuseColor" @: V4F
return $ (,) <$> mobj <*> mpipeline
either (\e _ -> hPutStrLn stderr e) (&) m $ \(obj,pipeline) -> do
app <- do
mvar <- newEmptyMVar
return $ \glarea -> LCMethods
{ lcRealized = mvar
, lcUploadState = uploadState obj glarea
, lcDestroyState = destroyState glarea
, lcSetUniforms = setUniforms
, lcPipeline = pipeline
}
runGLApp return (lambdaRender app glmethods)
{ glTitle = "LambdaCube 3D DSL OBJ viewer"
}
|
