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
128
129
|
{-# LANGUAGE PackageImports, LambdaCase, OverloadedStrings #-}
import Control.Concurrent
-- import "GLFW-b" Graphics.UI.GLFW as GLFW
import qualified Graphics.UI.GLUT as GLFW -- lie
import qualified Graphics.UI.GLUT as GLUT -- truth
import Graphics.UI.GLUT (Window)
import qualified Data.Map as Map
import qualified Data.Vector as V
import LambdaCube.GL as LambdaCubeGL -- renderer
import LambdaCube.GL.Mesh as LambdaCubeGL
import Codec.Picture as Juicy
import Data.Aeson
import qualified Data.ByteString as SB
----------------------------------------------------
-- See: http://lambdacube3d.com/getting-started
----------------------------------------------------
main :: IO ()
main = do
Just pipelineDesc <- decodeStrict <$> SB.readFile "hello.json"
win <- initWindow "LambdaCube 3D DSL Hello World" 640 640
-- setup render data
let inputSchema = makeSchema $ do
defObjectArray "objects" Triangles $ do
"position" @: Attribute_V2F
"uv" @: Attribute_V2F
defUniforms $ do
"time" @: Float
"diffuseTexture" @: FTexture2D
storage <- LambdaCubeGL.allocStorage inputSchema
-- upload geometry to GPU and add to pipeline input
LambdaCubeGL.uploadMeshToGPU triangleA >>= LambdaCubeGL.addMeshToObjectArray storage "objects" []
LambdaCubeGL.uploadMeshToGPU triangleB >>= LambdaCubeGL.addMeshToObjectArray storage "objects" []
-- load image and upload texture
Right img <- Juicy.readImage "logo.png"
textureData <- LambdaCubeGL.uploadTexture2DToGPU img
-- allocate GL pipeline
renderer <- LambdaCubeGL.allocRenderer pipelineDesc
LambdaCubeGL.setStorage renderer storage >>= \case -- check schema compatibility
Just err -> putStrLn err
Nothing -> do qsig <- newMVar False
GLUT.keyboardMouseCallback GLUT.$= Just (keyCB qsig)
loop qsig
where loop qsig = do
-- update graphics input
-- GLFW.getWindowSize win >>= \(w,h) -> LambdaCubeGL.setScreenSize storage (fromIntegral w) (fromIntegral h)
GLUT.get GLUT.windowSize >>= \(GLUT.Size w h) -> LambdaCubeGL.setScreenSize storage (fromIntegral w) (fromIntegral h)
LambdaCubeGL.updateUniforms storage $ do
"diffuseTexture" @= return textureData
"time" @= do
-- Just t <- GLFW.getTime
Just t <- Just . (/ (1000.0 :: Double)) . fromIntegral <$> GLUT.elapsedTime
return (realToFrac t :: Float)
-- render
LambdaCubeGL.renderFrame renderer
-- GLFW.swapBuffers win
GLUT.swapBuffers
-- GLFW.pollEvents
GLUT.mainLoopEvent
-- let keyIsPressed k = fmap (==KeyState'Pressed) $ GLFW.getKey win k
-- escape <- keyIsPressed Key'Escape
escape <- withMVar qsig return
if escape then return () else loop qsig
keyCB :: MVar Bool -> GLUT.KeyboardMouseCallback
keyCB qsig key keyState mods pos= do
cw <- GLUT.get GLUT.currentWindow
case (keyState,key,cw) of
(GLUT.Down,GLUT.Char 'q',Just cw) -> do
modifyMVar_ qsig (const $ return True)
GLUT.destroyWindow cw
(GLUT.Down,_,_)-> GLUT.postRedisplay Nothing
_ -> return ()
LambdaCubeGL.disposeRenderer renderer
LambdaCubeGL.disposeStorage storage
GLFW.destroyWindow win
-- GLFW.terminate
-- geometry data: triangles
triangleA :: LambdaCubeGL.Mesh
triangleA = Mesh
{ mAttributes = Map.fromList
[ ("position", A_V2F $ V.fromList [V2 1 1, V2 1 (-1), V2 (-1) (-1)])
, ("uv", A_V2F $ V.fromList [V2 1 1, V2 0 1, V2 0 0])
]
, mPrimitive = P_Triangles
}
triangleB :: LambdaCubeGL.Mesh
triangleB = Mesh
{ mAttributes = Map.fromList
[ ("position", A_V2F $ V.fromList [V2 1 1, V2 (-1) (-1), V2 (-1) 1])
, ("uv", A_V2F $ V.fromList [V2 1 1, V2 0 0, V2 1 0])
]
, mPrimitive = P_Triangles
}
initWindow :: String -> Int -> Int -> IO Window
initWindow title width height = do
{-
GLFW.init
GLFW.defaultWindowHints
mapM_ GLFW.windowHint
[ WindowHint'ContextVersionMajor 3
, WindowHint'ContextVersionMinor 3
, WindowHint'OpenGLProfile OpenGLProfile'Core
, WindowHint'OpenGLForwardCompat True
]
Just win <- GLFW.createWindow width height title Nothing Nothing
GLFW.makeContextCurrent $ Just win
-}
(progname,args) <- GLUT.getArgsAndInitialize
win <- GLUT.createWindow title
GLUT.actionOnWindowClose GLUT.$=! GLUT.MainLoopReturns
return win
|
