summaryrefslogtreecommitdiff
path: root/examples/Hello.hs
diff options
context:
space:
mode:
authorCsaba Hruska <csaba.hruska@gmail.com>2016-01-10 22:58:12 +0100
committerCsaba Hruska <csaba.hruska@gmail.com>2016-01-10 22:58:12 +0100
commit2344d2af7eb3e5515408d134a074b989e7b5efde (patch)
tree01b905a55d0b8e0560097241dd2cd277f6bfab46 /examples/Hello.hs
parente936d3c32c17c0d00939893fa85996c3807ed3e7 (diff)
update example
Diffstat (limited to 'examples/Hello.hs')
-rw-r--r--examples/Hello.hs43
1 files changed, 5 insertions, 38 deletions
diff --git a/examples/Hello.hs b/examples/Hello.hs
index cfe1053..5918d88 100644
--- a/examples/Hello.hs
+++ b/examples/Hello.hs
@@ -1,4 +1,4 @@
1{-# LANGUAGE PackageImports, LambdaCase #-} 1{-# LANGUAGE PackageImports, LambdaCase, OverloadedStrings #-}
2{-# LANGUAGE FlexibleContexts #-} 2{-# LANGUAGE FlexibleContexts #-}
3import "GLFW-b" Graphics.UI.GLFW as GLFW 3import "GLFW-b" Graphics.UI.GLFW as GLFW
4import qualified Data.Map as Map 4import qualified Data.Map as Map
@@ -11,39 +11,6 @@ import Codec.Picture as Juicy
11 11
12import LambdaCube.Compiler.Driver as LambdaCube -- compiler 12import LambdaCube.Compiler.Driver as LambdaCube -- compiler
13 13
14----
15import Control.Monad.Writer
16
17{-
18data ObjectArraySchema
19 = ObjectArraySchema
20 { primitive :: FetchPrimitive
21 , attributes :: Map String StreamType
22 }
23 deriving Show
24
25data PipelineSchema
26 = PipelineSchema
27 { objectArrays :: Map String ObjectArraySchema
28 , uniforms :: Map String InputType
29 }
30-}
31
32
33a @: b = tell [(a,b)]
34defObjectArray n p m = tell [PipelineSchema (Map.singleton n $ ObjectArraySchema p $ Map.fromList $ execWriter m) mempty]
35defUniforms m = tell [PipelineSchema mempty $ Map.fromList $ execWriter m]
36makeSchema a = head $ execWriter a :: PipelineSchema
37
38sch = makeSchema $ do
39 defObjectArray "objects" Triangles $ do
40 "position" @: Attribute_V4F
41 "uv" @: Attribute_V2F
42 defUniforms $ do
43 "time" @: Float
44 "diffuseTexture" @: FTexture2D
45
46-----
47main :: IO () 14main :: IO ()
48main = do 15main = do
49 -- compile hello.lc to graphics pipeline description 16 -- compile hello.lc to graphics pipeline description
@@ -56,7 +23,7 @@ main = do
56 -- setup render data 23 -- setup render data
57 let inputSchema = makeSchema $ do 24 let inputSchema = makeSchema $ do
58 defObjectArray "objects" Triangles $ do 25 defObjectArray "objects" Triangles $ do
59 "position" @: Attribute_V4F 26 "position" @: Attribute_V2F
60 "uv" @: Attribute_V2F 27 "uv" @: Attribute_V2F
61 defUniforms $ do 28 defUniforms $ do
62 "time" @: Float 29 "time" @: Float
@@ -80,11 +47,11 @@ main = do
80 where loop = do 47 where loop = do
81 -- update graphics input 48 -- update graphics input
82 GLFW.getWindowSize win >>= \(w,h) -> LambdaCubeGL.setScreenSize storage (fromIntegral w) (fromIntegral h) 49 GLFW.getWindowSize win >>= \(w,h) -> LambdaCubeGL.setScreenSize storage (fromIntegral w) (fromIntegral h)
83 {-
84 LambdaCubeGL.updateUniforms storage $ do 50 LambdaCubeGL.updateUniforms storage $ do
85 "time" @= fromJust <$> GLFW.getTime
86 "diffuseTexture" @= return textureData 51 "diffuseTexture" @= return textureData
87 -} 52 "time" @= do
53 Just t <- GLFW.getTime
54 return (realToFrac t :: Float)
88 -- render 55 -- render
89 LambdaCubeGL.renderFrame renderer 56 LambdaCubeGL.renderFrame renderer
90 GLFW.swapBuffers win 57 GLFW.swapBuffers win