diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +# 0.7 + +- Changed the Texture to use HDR formats. +- Updated luminance dependency to include the latest version and break compatibility with older + versions. + ### 0.6.0.1 - Updated UBO sample to fix issues with Generic. 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.6.0.1 +version: 0.7 synopsis: Luminance samples description: Luminance samples used as tutorial help homepage: https://github.com/phaazon/luminance-samples @@ -31,7 +31,7 @@ , FlexibleContexts build-depends: base >= 4.8 && < 4.9 - , luminance >= 0.6 && < 0.7 + , luminance >= 0.6 && < 0.8 , GLFW-b >= 1.4 && < 1.5 , mtl >= 2.2 && < 2.3 , resourcet >= 1.1 && < 1.2 @@ -53,7 +53,7 @@ , ScopedTypeVariables build-depends: base >= 4.8 && < 4.9 - , luminance >= 0.6 && < 0.7 + , luminance >= 0.6 && < 0.8 , GLFW-b >= 1.4 && < 1.5 , mtl >= 2.2 && < 2.3 , resourcet >= 1.1 && < 1.2 @@ -76,7 +76,7 @@ build-depends: base >= 4.8 && < 4.9 , contravariant >= 1.3 && < 1.4 - , luminance >= 0.6 && < 0.7 + , luminance >= 0.6 && < 0.8 , GLFW-b >= 1.4 && < 1.5 , mtl >= 2.2 && < 2.3 , resourcet >= 1.1 && < 1.2 @@ -99,7 +99,7 @@ build-depends: base >= 4.8 && < 4.9 , contravariant >= 1.3 && < 1.4 - , luminance >= 0.6 && < 0.7 + , luminance >= 0.6 && < 0.8 , GLFW-b >= 1.4 && < 1.5 , mtl >= 2.2 && < 2.3 , resourcet >= 1.1 && < 1.2 @@ -123,7 +123,7 @@ build-depends: base >= 4.8 && < 4.9 , contravariant >= 1.3 && < 1.4 , JuicyPixels >= 3.2 && < 3.4 - , luminance >= 0.6 && < 0.7 + , luminance >= 0.6 && < 0.8 , GLFW-b >= 1.4 && < 1.5 , mtl >= 2.2 && < 2.3 , resourcet >= 1.1 && < 1.2 @@ -146,7 +146,7 @@ build-depends: base >= 4.8 && < 4.9 , contravariant >= 1.3 && < 1.4 - , luminance >= 0.6 && < 0.7 + , luminance >= 0.6 && < 0.8 , GLFW-b >= 1.4 && < 1.5 , mtl >= 2.2 && < 2.3 , resourcet >= 1.1 && < 1.2 @@ -171,7 +171,7 @@ build-depends: base >= 4.8 && < 4.9 , contravariant >= 1.3 && < 1.4 , linear >= 1.20 && < 1.21 - , luminance >= 0.6 && < 0.7 + , luminance >= 0.6 && < 0.8 , 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 @@ -14,15 +14,15 @@ import Graphics.UI.GLFW main :: IO () -main = startup $ \window -> do +main = startup $ \window mainLoop -> do triangle <- createGeometry vertices Nothing Triangle - vs <- createVertexShader vsSource - fs <- createFragmentShader fsSource + vs <- createStage VertexShader vsSource + fs <- createStage FragmentShader fsSource (program,colorOffsetU) <- createProgram [vs,fs] $ \uni _ -> do colorU <- uni $ Left "color" offsetU <- uni $ Left "offset" pure $ divided colorU offsetU - untilM (liftIO $ windowShouldClose window) $ do + mainLoop $ do void . runCmd . draw $ framebufferBatch defaultFramebuffer [anySPBatch . shaderProgramBatch_ program $ [ diff --git a/src/Blit.hs b/src/Blit.hs --- a/src/Blit.hs +++ b/src/Blit.hs @@ -14,13 +14,13 @@ import Graphics.UI.GLFW main :: IO () -main = startup $ \window -> do +main = startup $ \window mainLoop -> do triangle <- createGeometry vertices Nothing Triangle - vs <- createVertexShader vsSource - fs <- createFragmentShader fsSource + vs <- createStage VertexShader vsSource + fs <- createStage FragmentShader fsSource fb :: Framebuffer RW RGBA32F () <- createFramebuffer windowW windowH 1 program <- createProgram_ [vs,fs] - untilM (liftIO $ windowShouldClose window) $ do + mainLoop $ do _ <- runCmd $ do _ <- draw $ framebufferBatch fb [anySPBatch $ shaderProgramBatch_ program [stdRenderCmd_ triangle]] diff --git a/src/Common.hs b/src/Common.hs --- a/src/Common.hs +++ b/src/Common.hs @@ -5,6 +5,7 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Except import Control.Monad.Trans.Resource +import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) import Graphics.Luminance.Framebuffer import Graphics.Luminance.Shader.Program import Graphics.Luminance.Shader.Stage @@ -17,6 +18,7 @@ data AppError = AppIncompleteFramebuffer String | AppStageCompilationFailed String + | AppUnsupportedStage StageType | AppProgramLinkFailed String | AppInactiveUniform String | AppInactiveUniformBlock String @@ -28,7 +30,9 @@ fromFramebufferError (IncompleteFramebuffer s) = AppIncompleteFramebuffer s instance HasStageError AppError where - fromStageError (CompilationFailed s) = AppStageCompilationFailed s + fromStageError e = case e of + CompilationFailed s -> AppStageCompilationFailed s + UnsupportedStage s -> AppUnsupportedStage s instance HasProgramError AppError where fromProgramError e = case e of @@ -43,20 +47,23 @@ windowTitle :: String windowTitle = "luminance-sample" -startup :: (Window -> App ()) -> IO () +startup :: (Window -> (App a -> App ()) -> App ()) -> IO () startup app = do _ <- init windowHint (WindowHint'Resizable False) - windowHint (WindowHint'ContextVersionMajor 4) - windowHint (WindowHint'ContextVersionMinor 5) - windowHint (WindowHint'OpenGLForwardCompat False) + windowHint (WindowHint'ContextVersionMajor 3) + windowHint (WindowHint'ContextVersionMinor 2) windowHint (WindowHint'OpenGLProfile OpenGLProfile'Core) window <- createWindow windowW windowH windowTitle Nothing Nothing + escapeKey <- newIORef False makeContextCurrent window case window of Just window' -> do swapInterval 1 - (runResourceT . runExceptT . app) window' >>= either print (const $ pure ()) + setKeyCallback window' . Just $ \_ k _ ks _ -> case (k,ks) of + (Key'Escape,KeyState'Released) -> writeIORef escapeKey True + _ -> pure () + (runResourceT . runExceptT $ app window' (mainLoop window' escapeKey)) >>= either print (const $ pure ()) destroyWindow window' Nothing -> hPutStrLn stderr "unable to create window; please check your hardware support OpenGL4.5" terminate @@ -66,6 +73,11 @@ pollEvents swapBuffers window threadDelay 50000 + +mainLoop :: Window -> IORef Bool -> App a -> App () +mainLoop window escapeKey = untilM $ liftIO $ do + escaped <- readIORef escapeKey + if escaped then setWindowShouldClose window True >> pure True else windowShouldClose window untilM :: (Monad m) => m Bool -> m b -> m () untilM predicate a = go diff --git a/src/DepthTest.hs b/src/DepthTest.hs --- a/src/DepthTest.hs +++ b/src/DepthTest.hs @@ -13,15 +13,15 @@ import Graphics.UI.GLFW main :: IO () -main = startup $ \window -> do +main = startup $ \window mainLoop -> do triangle <- createGeometry vertices Nothing Triangle - vs <- createVertexShader vsSource - fs <- createFragmentShader fsSource + vs <- createStage VertexShader vsSource + fs <- createStage FragmentShader fsSource (program,colorOffsetU) <- createProgram [vs,fs] $ \uni _ -> do colorU <- uni $ Left "color" offsetU <- uni $ Left "offset" pure $ divided colorU offsetU - untilM (liftIO $ windowShouldClose window) $ do + mainLoop $ do void . runCmd . draw $ framebufferBatch defaultFramebuffer [anySPBatch . shaderProgramBatch_ program $ [ diff --git a/src/HelloWorld.hs b/src/HelloWorld.hs --- a/src/HelloWorld.hs +++ b/src/HelloWorld.hs @@ -12,10 +12,10 @@ import Graphics.UI.GLFW main :: IO () -main = startup $ \window -> do +main = startup $ \window mainLoop -> do triangle <- createGeometry vertices Nothing Triangle - program <- sequenceA [createVertexShader vsSource,createFragmentShader fsSource] >>= createProgram_ - untilM (liftIO $ windowShouldClose window) $ do + program <- sequenceA [createStage VertexShader vsSource,createStage FragmentShader fsSource] >>= createProgram_ + mainLoop $ do void . runCmd . draw $ framebufferBatch defaultFramebuffer [anySPBatch $ shaderProgramBatch_ program [stdRenderCmd_ triangle]] endFrame window diff --git a/src/HelloWorldUniform.hs b/src/HelloWorldUniform.hs --- a/src/HelloWorldUniform.hs +++ b/src/HelloWorldUniform.hs @@ -1,25 +1,17 @@ import Common import Control.Monad import Control.Monad.IO.Class -import Graphics.Luminance.Batch -import Graphics.Luminance.Cmd -import Graphics.Luminance.Framebuffer -import Graphics.Luminance.Geometry -import Graphics.Luminance.RenderCmd -import Graphics.Luminance.Shader.Program -import Graphics.Luminance.Shader.Stage -import Graphics.Luminance.Shader.Uniform -import Graphics.Luminance.Vertex +import Graphics.Luminance import Graphics.UI.GLFW main :: IO () -main = startup $ \window -> do +main = startup $ \window mainLoop -> do triangle <- createGeometry vertices Nothing Triangle - vs <- createVertexShader vsSource - fs <- createFragmentShader fsSource + vs <- createStage VertexShader vsSource + fs <- createStage FragmentShader fsSource (program,colorsU :: U [(Float,Float,Float)]) <- createProgram [vs,fs] $ \uni _ -> uni (Left "colors") - untilM (liftIO $ windowShouldClose window) $ do + mainLoop $ 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 @@ -5,30 +5,20 @@ import Control.Monad.Except ( MonadError(..) ) import Control.Monad.IO.Class import Control.Monad.Trans.Resource -import Graphics.Luminance.Batch -import Graphics.Luminance.Cmd -import Graphics.Luminance.Framebuffer -import Graphics.Luminance.Geometry -import Graphics.Luminance.RenderCmd -import Graphics.Luminance.Pixel as L -import Graphics.Luminance.Shader.Program -import Graphics.Luminance.Shader.Stage -import Graphics.Luminance.Texture -import Graphics.Luminance.Vertex +import Graphics.Luminance import Graphics.UI.GLFW import System.Environment ( getArgs ) main :: IO () -main = startup $ \window -> do +main = startup $ \window mainLoop -> do args <- liftIO getArgs 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 - uni $ Left "srcTex" - untilM (liftIO $ windowShouldClose window) $ do + vs <- createStage VertexShader vsSource + fs <- createStage FragmentShader fsSource + (program,texU) <- createProgram [vs,fs] $ \uni _ -> uni $ Left "srcTex" + mainLoop $ do void . runCmd . draw $ framebufferBatch defaultFramebuffer [anySPBatch $ shaderProgramBatch program texU tex [stdRenderCmd_ quad]] endFrame window @@ -59,25 +49,24 @@ [ "out vec4 frag;" - , "layout (bindless_sampler) uniform usampler2D srcTex;" + , "uniform sampler2D srcTex;" , "void main() {" , " vec2 uv = gl_FragCoord.xy;" , " uv.y = " ++ show (windowH :: Int) ++ " - uv.y;" - , " vec3 sampled = vec3(texture(srcTex, uv / vec2(" ++ show (windowW :: Int) ++ "," ++ show (windowH :: Int) ++ "), 0).rgb) / 255;" - , " frag = vec4(sampled, 1.);" + , " frag = texture(srcTex, uv / vec2(" ++ show (windowW :: Int) ++ "," ++ show (windowH :: Int) ++ "), 0);" , "}" ] -loadTexture :: (MonadError AppError m,MonadIO m,MonadResource m) => String -> m (Texture2D RGBA8UI) +loadTexture :: (MonadError AppError m,MonadIO m,MonadResource m) => String -> m (Texture2D RGB32F) 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)) + ImageRGBA8 img -> createTexture_ (promoteImage $ dropAlphaLayer img) + ImageYCbCr8 img -> createTexture_ (promoteImage (convertImage img :: Image PixelRGB8)) _ -> throwError (TextureLoadFailed "unsupported image format") -createTexture_ :: (MonadIO m,MonadResource m) => Image PixelRGBA8 -> m (Texture2D RGBA8UI) +createTexture_ :: (MonadIO m,MonadResource m) => Image PixelRGBF -> m (Texture2D RGB32F) createTexture_ img = do let w = fromIntegral $ imageWidth img h = fromIntegral $ imageHeight img diff --git a/src/UBO.hs b/src/UBO.hs --- a/src/UBO.hs +++ b/src/UBO.hs @@ -7,20 +7,20 @@ import Linear main :: IO () -main = startup $ \window -> do +main = startup $ \window mainLoop -> do triangle <- createGeometry vertices Nothing Triangle - vs <- createVertexShader vsSource - fs <- createFragmentShader fsSource + vs <- createStage VertexShader vsSource + fs <- createStage FragmentShader fsSource colorBuffer :: Region RW (UB Color) <- createBuffer (newRegion 3) writeWhole colorBuffer (map UB colors) (program,colorsU) <- createProgram [vs,fs] $ \_ uniBlock -> uniBlock "Colors" - untilM (liftIO $ windowShouldClose window) $ do + mainLoop $ do void . runCmd . draw $ framebufferBatch defaultFramebuffer [anySPBatch $ shaderProgramBatch program colorsU colorBuffer [stdRenderCmd_ triangle]] endFrame window data Color = Color { - colorsRGB :: V3 Float - , colorsK :: Float + colorsK :: Float + , colorsRGB :: V3 Float } deriving (Eq,Generic,Show) instance UniformBlock Color where @@ -30,15 +30,15 @@ [ Color { colorsRGB = V3 1 0 0 - , colorsK = 0.75 + , colorsK = 1 } , Color { colorsRGB = V3 0 1 0 - , colorsK = 0.3 + , colorsK = 1 } , Color { colorsRGB = V3 0 0 1 - , colorsK = 0.5 + , colorsK = 1 } ] @@ -58,8 +58,8 @@ , "out vec4 vertexColor;" , "struct Color {" - , " vec3 colorsRGB;" , " float colorsK;" + , " vec3 colorsRGB;" , "};" , "layout (std140) uniform Colors {"