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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
{-# 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 Numeric.LinearAlgebra hiding ((<>))
import System.Environment
import System.IO
import System.IO.Error
import GLWidget
import LambdaCube.GL.HMatrix
import LambdaCubeWidget
import TimeKeeper
import LoadMesh
import InfinitePlane
import MtlParser (ObjMaterial(..))
import Matrix
-- State created by uploadState.
data State = State
{ stTimeKeeper :: TimeKeeper
, stTickCallback :: 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 xzplane >>= addMeshToObjectArray storage "plane" []
-- setup FrameClock
tm <- newTimeKeeper
tickcb <- widgetAddTickCallback glarea (tick tm)
return State
{ stTimeKeeper = tm
, stTickCallback = tickcb
}
destroyState :: GLArea -> State -> IO ()
destroyState glarea st = do
widgetRemoveTickCallback glarea (stTickCallback st)
deg30 :: Float
deg30 = pi/6
setUniforms :: glctx -> GLStorage -> State -> IO ()
setUniforms gl storage st = do
t <- (/ 10.0) <$> getSeconds (stTimeKeeper st)
let tf = realToFrac t :: Float
rot = rotMatrixZ (-tf) <> rotMatrixX (-tf)
pos = rot #> fromList [2,2,10]
up = rot #> fromList [0,1,0]
cam = lookat pos 0 up
aspect = 1
proj = perspective 0.1 100 deg30 aspect
mvp = proj <> cam
LC.updateUniforms storage $ do
"CameraPosition" @= return (pos :: Vector Float)
"ViewProjection" @= return (mvp :: Matrix 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
"CameraPosition" @: V3F
"ViewProjection" @: M44F
"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"
}
|
