luminance-samples 0.6.0.1 → 0.7
raw patch · 10 files changed
+74/−75 lines, 10 filesdep ~luminance
Dependency ranges changed: luminance
Files
- CHANGELOG.md +6/−0
- luminance-samples.cabal +8/−8
- src/Blending.hs +4/−4
- src/Blit.hs +4/−4
- src/Common.hs +18/−6
- src/DepthTest.hs +4/−4
- src/HelloWorld.hs +3/−3
- src/HelloWorldUniform.hs +5/−13
- src/Texture.hs +12/−23
- src/UBO.hs +10/−10
CHANGELOG.md view
@@ -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.
luminance-samples.cabal view
@@ -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
src/Blending.hs view
@@ -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 $ [
src/Blit.hs view
@@ -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]]
src/Common.hs view
@@ -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
src/DepthTest.hs view
@@ -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 $ [
src/HelloWorld.hs view
@@ -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
src/HelloWorldUniform.hs view
@@ -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
src/Texture.hs view
@@ -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
src/UBO.hs view
@@ -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 {"