diff --git a/improviz.yaml b/improviz.yaml index 3b74bcb..e7748b6 100644 --- a/improviz.yaml +++ b/improviz.yaml @@ -8,7 +8,7 @@ font: assetsDirectory: "./assets" textureDirectories: - "./textures" -# - "./hellocatfood/gifs" + - "./hellocatfood/gifs" geometryDirectories: - "./geometries" # - "./hellocatfood/geometries" diff --git a/src/Gfx/Commands.hs b/src/Gfx/Commands.hs index 1afd94d..15fc1fd 100644 --- a/src/Gfx/Commands.hs +++ b/src/Gfx/Commands.hs @@ -18,33 +18,33 @@ module Gfx.Commands , renderCode , renderCodeToBuffer ) -where + where import Foreign.Ptr ( castPtr ) import Foreign.Marshal.Utils ( with - , fromBool + , fromBool ) import Control.Monad.Trans ( liftIO ) import Control.Monad.State.Strict ( modify' ) import Lens.Simple ( use - , assign - , view + , assign + , view ) import qualified Data.Map.Strict as M import Linear.Matrix ( M44 - , (!*!) + , (!*!) ) import Language.Ast (Value(..)) import qualified Graphics.GL as GLRaw import qualified Graphics.Rendering.OpenGL as GL import Graphics.Rendering.OpenGL ( ($=) - , GLfloat - , TextureUnit(..) - , TextureTarget2D(Texture2D) - , UniformLocation(..) - , currentProgram + , GLfloat + , TextureUnit(..) + , TextureTarget2D(Texture2D) + , UniformLocation(..) + , currentProgram ) import Graphics.Rendering.OpenGL.GL.Shaders.Attribs as GLS @@ -65,6 +65,10 @@ import Gfx.TextRendering ( renderText ) import Gfx.OpenGL ( printErrors , colToGLCol + , valueToGLfloat + , valueToGLfloatVec2 + , valueToGLfloatVec3 + , valueToGLfloatVec4 ) import Logging ( logError ) @@ -104,15 +108,13 @@ setUniform ("Pmatrix", _, UniformLocation uniformLoc) = do setUniform ("FillColour", _, uniformLoc) = do gfxFillStyle <- use (fillStyle . GS.value) liftIO $ case gfxFillStyle of - (GFXFillColour fillColour) -> - GL.uniform uniformLoc $= colToGLCol fillColour - GFXNoFill -> GL.uniform uniformLoc $= colToGLCol (Colour 0 0 0 (-1)) + (GFXFillColour fillColour) -> GL.uniform uniformLoc $= colToGLCol fillColour + GFXNoFill -> GL.uniform uniformLoc $= colToGLCol (Colour 0 0 0 (-1)) setUniform ("StrokeColour", _, uniformLoc) = do gfxStrokeStyle <- use (strokeStyle . GS.value) liftIO $ case gfxStrokeStyle of - (GFXStrokeColour strokeColour) -> - GL.uniform uniformLoc $= colToGLCol strokeColour - GFXNoStroke -> GL.uniform uniformLoc $= colToGLCol (Colour 0 0 0 (-1)) + (GFXStrokeColour strokeColour) -> GL.uniform uniformLoc $= colToGLCol strokeColour + GFXNoStroke -> GL.uniform uniformLoc $= colToGLCol (Colour 0 0 0 (-1)) setUniform ("Texture", _, uniformLoc) = do (GFXTextureStyling textName textFrame) <- use (textureStyle . GS.value) textureLib <- use textureLibrary @@ -124,32 +126,29 @@ setUniform ("Texture", _, uniformLoc) = do setUniform (name, uniformType, uniformLoc) = do matVar <- use (materialVars . GSM.value name) liftIO $ case matVar of - Nothing -> logError $ name ++ " is not a known uniform" - Just v -> valueToUniform v uniformType uniformLoc + Nothing -> logError $ name ++ " is not a known uniform" + Just v -> valueToUniform v uniformType uniformLoc + valueToUniform :: Value -> GL.VariableType -> GL.UniformLocation -> IO () valueToUniform value utype uniformLoc = - case valueToList value of - Left err -> logError err - Right v -> case utype of - GLS.Float' -> GL.uniform uniformLoc $= (v !! 0) - GLS.FloatVec2 -> GL.uniform uniformLoc $= (GL.Vector2 (v !! 0) (v !! 1)) - GLS.FloatVec3 -> GL.uniform uniformLoc $= (GL.Vector3 (v !! 0) (v !! 1) (v !! 2) ) - GLS.FloatVec4 -> GL.uniform uniformLoc $= (GL.Vector4 (v !! 0) (v !! 1) (v !! 2) (v !! 3) ) - -valueToList :: Value -> Either String [Float] -valueToList (Number v) = Right $ replicate 4 v -valueToList (VList valList) = case valsToFloats valList of - Just [] -> Right $ replicate 4 0 - Just vals -> Right $ (vals ++ [1, 1, 1, 1]) - Nothing -> Left "Invalid list for material variable" -valueToList _ = Left "Invalid list for material variable" - -valsToFloats :: [Value] -> Maybe [Float] -valsToFloats vals = mapM valToFloat vals - where - valToFloat (Number n) = Just n - valToFloat _ = Nothing + case utype of + GLS.Float' -> valueToGLfloatUniform value uniformLoc + GLS.FloatVec2 -> valueToVec2Uniform value uniformLoc + GLS.FloatVec3 -> valueToVec3Uniform value uniformLoc + GLS.FloatVec4 -> valueToVec4Uniform value uniformLoc + +valueToGLfloatUniform :: Value -> GL.UniformLocation -> IO () +valueToGLfloatUniform value uniformLoc = either logError (GL.uniform uniformLoc $=) (valueToGLfloat value) + +valueToVec2Uniform :: Value -> GL.UniformLocation -> IO () +valueToVec2Uniform value uniformLoc = either logError (GL.uniform uniformLoc $=) (valueToGLfloatVec2 value) + +valueToVec3Uniform :: Value -> GL.UniformLocation -> IO () +valueToVec3Uniform value uniformLoc = either logError (GL.uniform uniformLoc $=) (valueToGLfloatVec3 value) + +valueToVec4Uniform :: Value -> GL.UniformLocation -> IO () +valueToVec4Uniform value uniformLoc = either logError (GL.uniform uniformLoc $=) (valueToGLfloatVec4 value) drawTriangles :: GeometryBuffers -> GraphicsEngine () diff --git a/src/Gfx/OpenGL.hs b/src/Gfx/OpenGL.hs index 79f4f23..cbde72f 100644 --- a/src/Gfx/OpenGL.hs +++ b/src/Gfx/OpenGL.hs @@ -1,8 +1,12 @@ module Gfx.OpenGL where +import Language.Ast ( Value(..) ) import Gfx.Types ( Colour(..) ) import Graphics.Rendering.OpenGL ( Color4(..) , GLfloat + , Vector2(..) + , Vector3(..) + , Vector4(..) , get , errors ) @@ -11,6 +15,46 @@ import System.IO ( hPutStrLn , stderr ) +valueGetFloat :: Value -> Either String GLfloat +valueGetFloat (Number v) = Right v +valueGetFloat _ = Left "Expected number" + +valueToGLfloat :: Value -> Either String GLfloat +valueToGLfloat (Number v) = Right v +valueToGLfloat (VList valList) = case valList of + x:_ -> valueGetFloat x + [] -> Left "Empty List" +valueToGLfloat _ = Left "Invalid value" + +valueToGLfloatVec2 :: Value -> Either String (Vector2 GLfloat) +valueToGLfloatVec2 (Number v) = Right $ Vector2 v v +valueToGLfloatVec2 (VList valList) = case valList of + x:y:_ -> Vector2 <$> (valueGetFloat x) <*> (valueGetFloat y) + x:_ -> Vector2 <$> (valueGetFloat x) <*> (valueGetFloat x) + [] -> Left "Empty List" +valueToGLfloatVec2 _ = Left "Invalid value" + +valueToGLfloatVec3 :: Value -> Either String (Vector3 GLfloat) +valueToGLfloatVec3 (Number v) = Right $ Vector3 v v v +valueToGLfloatVec3 (VList valList) = case valList of + x:y:z:_ -> Vector3 <$> (valueGetFloat x) <*> (valueGetFloat y) <*> (valueGetFloat z) + x:y:_ -> Vector3 <$> (valueGetFloat x) <*> (valueGetFloat y) <*> (valueGetFloat y) + x:_ -> Vector3 <$> (valueGetFloat x) <*> (valueGetFloat x) <*> (valueGetFloat x) + [] -> Left "Empty List" +valueToGLfloatVec3 _ = Left "Invalid value" + +valueToGLfloatVec4 :: Value -> Either String (Vector4 GLfloat) +valueToGLfloatVec4 (Number v) = Right $ Vector4 v v v v +valueToGLfloatVec4 (VList valList) = case valList of + x:y:z:w:_ -> Vector4 <$> (valueGetFloat x) <*> (valueGetFloat y) <*> (valueGetFloat z) <*> (valueGetFloat w) + x:y:z:_ -> Vector4 <$> (valueGetFloat x) <*> (valueGetFloat y) <*> (valueGetFloat z) <*> (pure 1) + x:y:_ -> Vector4 <$> (valueGetFloat x) <*> (valueGetFloat y) <*> (valueGetFloat y) <*> (pure 1) + x:_ -> Vector4 <$> (valueGetFloat x) <*> (valueGetFloat x) <*> (valueGetFloat x) <*> (pure 1) + [] -> Left "Empty List" +valueToGLfloatVec4 _ = Left "Invalid value" + + + colToGLCol :: Colour -> Color4 GLfloat colToGLCol (Colour r g b a) = Color4 r g b a