Added GLArea widget.

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
 import qualified GI.Gtk                        as Gtk
 import           GI.Gtk.Declarative
 import           GI.Gtk.Declarative.App.Simple
+import           GI.Gdk.Objects.GLContext
 
 import qualified Data.Map as Map
 import qualified Data.Vector as V
@@ -20,7 +21,7 @@ import qualified Data.ByteString as SB
 
 type State = ()
 
-data Event = Closed
+data Event = Closed | Ignored
 
 view' :: State -> AppView Gtk.Window Event
 view' _ = bin
@@ -28,15 +29,62 @@ view' _ = bin
     [ #title := "LambdaCube 3D DSL Hello World"
     , on #deleteEvent $ {- GI.Gdk.Unions.Event.Event -> (Bool, Event) -} \_ -> (True,Closed)
     ]
-    $ widget Gtk.Label [#label := "Hello, World!"]
+    $ widget Gtk.GLArea [onM #render render]
+
 
 update' :: State -> Event -> Transition State Event
 update' _ Closed = Exit
 
+-- 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
+    }
+
+render :: GLContext -> Gtk.GLArea -> IO (Bool, Event)
+render _ _ = do
+    putStrLn "render!"
+    return (True,Ignored)
+
 main :: IO ()
 main = do
     Just pipelineDesc <- decodeStrict <$> SB.readFile "hello.json"
 
+    -- 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
+
     run App
         -- :: App Gtk.Window State Event
         { view         = view'