initial commit

1 files changed, 129 insertions, 0 deletions

diff --git a/Hello-glut.hs b/Hello-glut.hs
new file mode 100644
index 0000000..9ffa92c
--- /dev/null
+++ b/Hello-glut.hs
@@ -0,0 +1,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
+