diff options
Diffstat (limited to 'GtkHello.hs')
-rw-r--r-- | GtkHello.hs | 52 |
1 files changed, 50 insertions, 2 deletions
diff --git a/GtkHello.hs b/GtkHello.hs index 9b29ba7..bf83378 100644 --- a/GtkHello.hs +++ b/GtkHello.hs | |||
@@ -6,6 +6,7 @@ module Main where | |||
6 | import qualified GI.Gtk as Gtk | 6 | import qualified GI.Gtk as Gtk |
7 | import GI.Gtk.Declarative | 7 | import GI.Gtk.Declarative |
8 | import GI.Gtk.Declarative.App.Simple | 8 | import GI.Gtk.Declarative.App.Simple |
9 | import GI.Gdk.Objects.GLContext | ||
9 | 10 | ||
10 | import qualified Data.Map as Map | 11 | import qualified Data.Map as Map |
11 | import qualified Data.Vector as V | 12 | import qualified Data.Vector as V |
@@ -20,7 +21,7 @@ import qualified Data.ByteString as SB | |||
20 | 21 | ||
21 | type State = () | 22 | type State = () |
22 | 23 | ||
23 | data Event = Closed | 24 | data Event = Closed | Ignored |
24 | 25 | ||
25 | view' :: State -> AppView Gtk.Window Event | 26 | view' :: State -> AppView Gtk.Window Event |
26 | view' _ = bin | 27 | view' _ = bin |
@@ -28,15 +29,62 @@ view' _ = bin | |||
28 | [ #title := "LambdaCube 3D DSL Hello World" | 29 | [ #title := "LambdaCube 3D DSL Hello World" |
29 | , on #deleteEvent $ {- GI.Gdk.Unions.Event.Event -> (Bool, Event) -} \_ -> (True,Closed) | 30 | , on #deleteEvent $ {- GI.Gdk.Unions.Event.Event -> (Bool, Event) -} \_ -> (True,Closed) |
30 | ] | 31 | ] |
31 | $ widget Gtk.Label [#label := "Hello, World!"] | 32 | $ widget Gtk.GLArea [onM #render render] |
33 | |||
32 | 34 | ||
33 | update' :: State -> Event -> Transition State Event | 35 | update' :: State -> Event -> Transition State Event |
34 | update' _ Closed = Exit | 36 | update' _ Closed = Exit |
35 | 37 | ||
38 | -- geometry data: triangles | ||
39 | triangleA :: LambdaCubeGL.Mesh | ||
40 | triangleA = Mesh | ||
41 | { mAttributes = Map.fromList | ||
42 | [ ("position", A_V2F $ V.fromList [V2 1 1, V2 1 (-1), V2 (-1) (-1)]) | ||
43 | , ("uv", A_V2F $ V.fromList [V2 1 1, V2 0 1, V2 0 0]) | ||
44 | ] | ||
45 | , mPrimitive = P_Triangles | ||
46 | } | ||
47 | |||
48 | triangleB :: LambdaCubeGL.Mesh | ||
49 | triangleB = Mesh | ||
50 | { mAttributes = Map.fromList | ||
51 | [ ("position", A_V2F $ V.fromList [V2 1 1, V2 (-1) (-1), V2 (-1) 1]) | ||
52 | , ("uv", A_V2F $ V.fromList [V2 1 1, V2 0 0, V2 1 0]) | ||
53 | ] | ||
54 | , mPrimitive = P_Triangles | ||
55 | } | ||
56 | |||
57 | render :: GLContext -> Gtk.GLArea -> IO (Bool, Event) | ||
58 | render _ _ = do | ||
59 | putStrLn "render!" | ||
60 | return (True,Ignored) | ||
61 | |||
36 | main :: IO () | 62 | main :: IO () |
37 | main = do | 63 | main = do |
38 | Just pipelineDesc <- decodeStrict <$> SB.readFile "hello.json" | 64 | Just pipelineDesc <- decodeStrict <$> SB.readFile "hello.json" |
39 | 65 | ||
66 | -- setup render data | ||
67 | let inputSchema = makeSchema $ do | ||
68 | defObjectArray "objects" Triangles $ do | ||
69 | "position" @: Attribute_V2F | ||
70 | "uv" @: Attribute_V2F | ||
71 | defUniforms $ do | ||
72 | "time" @: Float | ||
73 | "diffuseTexture" @: FTexture2D | ||
74 | |||
75 | storage <- LambdaCubeGL.allocStorage inputSchema | ||
76 | |||
77 | -- upload geometry to GPU and add to pipeline input | ||
78 | LambdaCubeGL.uploadMeshToGPU triangleA >>= LambdaCubeGL.addMeshToObjectArray storage "objects" [] | ||
79 | LambdaCubeGL.uploadMeshToGPU triangleB >>= LambdaCubeGL.addMeshToObjectArray storage "objects" [] | ||
80 | |||
81 | -- load image and upload texture | ||
82 | Right img <- Juicy.readImage "logo.png" | ||
83 | textureData <- LambdaCubeGL.uploadTexture2DToGPU img | ||
84 | |||
85 | -- allocate GL pipeline | ||
86 | renderer <- LambdaCubeGL.allocRenderer pipelineDesc | ||
87 | |||
40 | run App | 88 | run App |
41 | -- :: App Gtk.Window State Event | 89 | -- :: App Gtk.Window State Event |
42 | { view = view' | 90 | { view = view' |