diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,13 @@ +# 0.6 + +- Updated luminance dependency to include the latest version and break compatibility with older + versions. + +# 0.5 + +- Updated luminance dependency to include the latest version and break compatibility with older + versions. + # 0.4 - Updated luminance dependency to include the latest version and break compatibility with older diff --git a/luminance-samples.cabal b/luminance-samples.cabal --- a/luminance-samples.cabal +++ b/luminance-samples.cabal @@ -1,5 +1,5 @@ name: luminance-samples -version: 0.5 +version: 0.6 synopsis: Luminance samples description: Luminance samples used as tutorial help homepage: https://github.com/phaazon/luminance-samples @@ -25,11 +25,13 @@ main-is: HelloWorld.hs + other-modules: Common + default-extensions: DataKinds , FlexibleContexts build-depends: base >= 4.8 && < 4.9 - , luminance >= 0.5 && < 0.6 + , luminance >= 0.6 && < 0.7 , GLFW-b >= 1.4 && < 1.5 , mtl >= 2.2 && < 2.3 , resourcet >= 1.1 && < 1.2 @@ -44,12 +46,14 @@ main-is: HelloWorldUniform.hs + other-modules: Common + default-extensions: DataKinds , FlexibleContexts , ScopedTypeVariables build-depends: base >= 4.8 && < 4.9 - , luminance >= 0.5 && < 0.6 + , luminance >= 0.6 && < 0.7 , GLFW-b >= 1.4 && < 1.5 , mtl >= 2.2 && < 2.3 , resourcet >= 1.1 && < 1.2 @@ -59,18 +63,20 @@ default-language: Haskell2010 -executable DepthTest +executable DepthTest ghc-options: -W -Wall -O2 main-is: DepthTest.hs + other-modules: Common + default-extensions: DataKinds , FlexibleContexts , ScopedTypeVariables build-depends: base >= 4.8 && < 4.9 , contravariant >= 1.3 && < 1.4 - , luminance >= 0.5 && < 0.6 + , luminance >= 0.6 && < 0.7 , GLFW-b >= 1.4 && < 1.5 , mtl >= 2.2 && < 2.3 , resourcet >= 1.1 && < 1.2 @@ -85,13 +91,15 @@ main-is: Blending.hs + other-modules: Common + default-extensions: DataKinds , FlexibleContexts , ScopedTypeVariables build-depends: base >= 4.8 && < 4.9 , contravariant >= 1.3 && < 1.4 - , luminance >= 0.5 && < 0.6 + , luminance >= 0.6 && < 0.7 , GLFW-b >= 1.4 && < 1.5 , mtl >= 2.2 && < 2.3 , resourcet >= 1.1 && < 1.2 @@ -101,11 +109,13 @@ default-language: Haskell2010 -executable Texture +executable Texture ghc-options: -W -Wall -O2 main-is: Texture.hs + other-modules: Common + default-extensions: DataKinds , FlexibleContexts , ScopedTypeVariables @@ -113,7 +123,7 @@ build-depends: base >= 4.8 && < 4.9 , contravariant >= 1.3 && < 1.4 , JuicyPixels >= 3.2 && < 3.4 - , luminance >= 0.5 && < 0.6 + , luminance >= 0.6 && < 0.7 , GLFW-b >= 1.4 && < 1.5 , mtl >= 2.2 && < 2.3 , resourcet >= 1.1 && < 1.2 @@ -123,18 +133,44 @@ default-language: Haskell2010 -executable Blit +executable Blit ghc-options: -W -Wall -O2 main-is: Blit.hs + other-modules: Common + default-extensions: DataKinds , FlexibleContexts , ScopedTypeVariables build-depends: base >= 4.8 && < 4.9 , contravariant >= 1.3 && < 1.4 - , luminance >= 0.5 && < 0.6 + , luminance >= 0.6 && < 0.7 + , GLFW-b >= 1.4 && < 1.5 + , mtl >= 2.2 && < 2.3 + , resourcet >= 1.1 && < 1.2 + , transformers >= 0.4 && < 0.5 + + hs-source-dirs: src + + default-language: Haskell2010 + +executable UBO + ghc-options: -W -Wall -O2 + + main-is: UBO.hs + + other-modules: Common + + default-extensions: DataKinds + , FlexibleContexts + , ScopedTypeVariables + + build-depends: base >= 4.8 && < 4.9 + , contravariant >= 1.3 && < 1.4 + , linear >= 1.20 && < 1.21 + , luminance >= 0.6 && < 0.7 , GLFW-b >= 1.4 && < 1.5 , mtl >= 2.2 && < 2.3 , resourcet >= 1.1 && < 1.2 diff --git a/src/Blending.hs b/src/Blending.hs --- a/src/Blending.hs +++ b/src/Blending.hs @@ -18,7 +18,7 @@ triangle <- createGeometry vertices Nothing Triangle vs <- createVertexShader vsSource fs <- createFragmentShader fsSource - (program,colorOffsetU) <- createProgram [vs,fs] $ \uni -> do + (program,colorOffsetU) <- createProgram [vs,fs] $ \uni _ -> do colorU <- uni $ Left "color" offsetU <- uni $ Left "offset" pure $ divided colorU offsetU diff --git a/src/Common.hs b/src/Common.hs --- a/src/Common.hs +++ b/src/Common.hs @@ -14,18 +14,27 @@ type App = ExceptT AppError (ResourceT IO) -newtype AppError = AppError String deriving (Eq,Show) +data AppError + = AppIncompleteFramebuffer String + | AppStageCompilationFailed String + | AppProgramLinkFailed String + | AppInactiveUniform String + | AppInactiveUniformBlock String + | TextureLoadFailed String + | CLIUsage String + deriving (Eq,Show) instance HasFramebufferError AppError where - fromFramebufferError (IncompleteFramebuffer s) = AppError s + fromFramebufferError (IncompleteFramebuffer s) = AppIncompleteFramebuffer s instance HasStageError AppError where - fromStageError (CompilationFailed s) = AppError s + fromStageError (CompilationFailed s) = AppStageCompilationFailed s instance HasProgramError AppError where fromProgramError e = case e of - LinkFailed s -> AppError s - InactiveUniform u -> AppError (show u) + LinkFailed s -> AppProgramLinkFailed s + InactiveUniform u -> AppInactiveUniform (show u) + InactiveUniformBlock s -> AppInactiveUniformBlock s windowW,windowH :: (Num a) => a windowW = 800 diff --git a/src/DepthTest.hs b/src/DepthTest.hs --- a/src/DepthTest.hs +++ b/src/DepthTest.hs @@ -17,7 +17,7 @@ triangle <- createGeometry vertices Nothing Triangle vs <- createVertexShader vsSource fs <- createFragmentShader fsSource - (program,colorOffsetU) <- createProgram [vs,fs] $ \uni -> do + (program,colorOffsetU) <- createProgram [vs,fs] $ \uni _ -> do colorU <- uni $ Left "color" offsetU <- uni $ Left "offset" pure $ divided colorU offsetU diff --git a/src/HelloWorldUniform.hs b/src/HelloWorldUniform.hs --- a/src/HelloWorldUniform.hs +++ b/src/HelloWorldUniform.hs @@ -17,7 +17,8 @@ triangle <- createGeometry vertices Nothing Triangle vs <- createVertexShader vsSource fs <- createFragmentShader fsSource - (program,colorsU :: U [(Float,Float,Float)]) <- createProgram [vs,fs] (\f -> f $ Left "colors") + (program,colorsU :: U [(Float,Float,Float)]) <- createProgram [vs,fs] $ \uni _ -> + uni (Left "colors") untilM (liftIO $ windowShouldClose window) $ do void . runCmd . draw $ framebufferBatch defaultFramebuffer [anySPBatch $ shaderProgramBatch program colorsU colors [stdRenderCmd_ triangle]] endFrame window diff --git a/src/Texture.hs b/src/Texture.hs --- a/src/Texture.hs +++ b/src/Texture.hs @@ -21,12 +21,12 @@ main :: IO () main = startup $ \window -> do args <- liftIO getArgs - when (null args) . throwError $ AppError "expecting a texture path as argument!" + when (null args) . throwError $ CLIUsage "expecting a texture path as argument!" tex <- loadTexture (head args) quad <- createGeometry vertices Nothing Triangle vs <- createVertexShader vsSource fs <- createFragmentShader fsSource - (program,texU) <- createProgram [vs,fs] $ \uni -> do + (program,texU) <- createProgram [vs,fs] $ \uni _ -> do uni $ Left "srcTex" untilM (liftIO $ windowShouldClose window) $ do void . runCmd . draw $ framebufferBatch defaultFramebuffer @@ -70,12 +70,12 @@ ] loadTexture :: (MonadError AppError m,MonadIO m,MonadResource m) => String -> m (Texture2D RGBA8UI) -loadTexture path = liftIO (readImage path) >>= either (throwError . AppError) treatDynamicImage +loadTexture path = liftIO (readImage path) >>= either (throwError . TextureLoadFailed) treatDynamicImage where treatDynamicImage image = case image of ImageRGBA8 img -> liftIO (putStrLn "ImageRGBA8") >> createTexture_ img ImageYCbCr8 img -> liftIO (putStrLn "ImageYCbCr8") >> createTexture_ (promoteImage (convertImage img :: Image PixelRGB8)) - _ -> throwError (AppError "unsupported image format") + _ -> throwError (TextureLoadFailed "unsupported image format") createTexture_ :: (MonadIO m,MonadResource m) => Image PixelRGBA8 -> m (Texture2D RGBA8UI) createTexture_ img = do diff --git a/src/UBO.hs b/src/UBO.hs new file mode 100644 --- /dev/null +++ b/src/UBO.hs @@ -0,0 +1,56 @@ +import Common +import Control.Monad +import Control.Monad.IO.Class +import Graphics.Luminance +import Graphics.UI.GLFW +import Linear + +main :: IO () +main = startup $ \window -> do + triangle <- createGeometry vertices Nothing Triangle + vs <- createVertexShader vsSource + fs <- createFragmentShader fsSource + colorBuffer :: Region RW (UB (V3 Float)) <- createBuffer (newRegion 3) + writeWhole colorBuffer (map UB colors) + (program,colorsU) <- createProgram [vs,fs] $ \_ uniBlock -> uniBlock "Colors" + untilM (liftIO $ windowShouldClose window) $ do + void . runCmd . draw $ framebufferBatch defaultFramebuffer [anySPBatch $ shaderProgramBatch program colorsU colorBuffer [stdRenderCmd_ triangle]] + endFrame window + +colors :: [V3 Float] +colors = [V3 1 0 0,V3 0 1 0,V3 0 0 1] + +vertices :: [V 2 Float] +vertices = + [ + vec2 (-0.5) (-0.5) + , vec2 0 0.5 + , vec2 0.5 (-0.5) + ] + +vsSource :: String +vsSource = unlines + [ + "in vec2 co;" + , "out vec4 vertexColor;" + + , "uniform Colors {" + , " vec3 colors[3];" + , "};" + + , "void main() {" + , " gl_Position = vec4(co, 0., 1.);" + , " vertexColor = vec4(colors[gl_VertexID], 1.);" + , "}" + ] + +fsSource :: String +fsSource = unlines + [ + "in vec4 vertexColor;" + , "out vec4 frag;" + + , "void main() {" + , " frag = vertexColor;" + , "}" + ]