diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2015, Dimitri Sabadie + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Dimitri Sabadie nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/luminance-samples.cabal b/luminance-samples.cabal new file mode 100644 --- /dev/null +++ b/luminance-samples.cabal @@ -0,0 +1,146 @@ +name: luminance-samples +version: 0.1 +synopsis: Luminance samples +description: Luminance samples used as tutorial help +homepage: https://github.com/phaazon/luminance-samples +bug-reports: https://github.com/phaazon/luminance-samples/issues +license: BSD3 +license-file: LICENSE +author: Dimitri Sabadie +maintainer: Dimitri Sabadie +copyright: Dimitri Sabadie +category: Graphics + +build-type: Simple +extra-source-files: CHANGELOG.md +cabal-version: >= 1.10 + +source-repository head + type: git + location: git://github.com/phaazon/luminance-samples.git + +executable HelloWorld + ghc-options: -W -Wall -O2 + + main-is: HelloWorld.hs + + default-extensions: DataKinds + , FlexibleContexts + + build-depends: base >= 4.8 && < 4.9 + , luminance >= 0.1 && < 0.2 + , 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 HelloWorldUniform + ghc-options: -W -Wall -O2 + + main-is: HelloWorldUniform.hs + + default-extensions: DataKinds + , FlexibleContexts + , ScopedTypeVariables + + build-depends: base >= 4.8 && < 4.9 + , luminance >= 0.1 && < 0.2 + , 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 DepthTest + ghc-options: -W -Wall -O2 + + main-is: DepthTest.hs + + default-extensions: DataKinds + , FlexibleContexts + , ScopedTypeVariables + + build-depends: base >= 4.8 && < 4.9 + , contravariant >= 1.3 && < 1.4 + , luminance >= 0.1 && < 0.2 + , 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 Blending + ghc-options: -W -Wall -O2 + + main-is: Blending.hs + + default-extensions: DataKinds + , FlexibleContexts + , ScopedTypeVariables + + build-depends: base >= 4.8 && < 4.9 + , contravariant >= 1.3 && < 1.4 + , luminance >= 0.1 && < 0.2 + , 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 Texture + ghc-options: -W -Wall -O2 + + main-is: Texture.hs + + default-extensions: DataKinds + , FlexibleContexts + , ScopedTypeVariables + + build-depends: base >= 4.8 && < 4.9 + , contravariant >= 1.3 && < 1.4 + , JuicyPixels >= 3.2 && < 3.4 + , luminance >= 0.1 && < 0.2 + , GLFW-b >= 1.4 && < 1.5 + , mtl >= 2.2 && < 2.3 + , resourcet >= 1.1 && < 1.2 + , transformers >= 0.4 && < 0.5 + , vector >= 0.11 && < 0.12 + + hs-source-dirs: src + + default-language: Haskell2010 + +executable Blit + ghc-options: -W -Wall -O2 + + main-is: Blit.hs + + default-extensions: DataKinds + , FlexibleContexts + , ScopedTypeVariables + + build-depends: base >= 4.8 && < 4.9 + , contravariant >= 1.3 && < 1.4 + , luminance >= 0.1 && < 0.2 + , GLFW-b >= 1.4 && < 1.5 + , mtl >= 2.2 && < 2.3 + , resourcet >= 1.1 && < 1.2 + , transformers >= 0.4 && < 0.5 + , vector >= 0.11 && < 0.12 + + hs-source-dirs: src + + default-language: Haskell2010 diff --git a/src/Blending.hs b/src/Blending.hs new file mode 100644 --- /dev/null +++ b/src/Blending.hs @@ -0,0 +1,83 @@ +import Common +import Control.Monad +import Control.Monad.IO.Class +import Data.Functor.Contravariant.Divisible +import Graphics.Luminance.Batch +import Graphics.Luminance.Cmd +import Graphics.Luminance.Blending +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.Vertex +import Graphics.UI.GLFW + +main :: IO () +main = startup $ \window -> do + triangle <- createGeometry vertices Nothing Triangle + vs <- createVertexShader vsSource + fs <- createFragmentShader 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 + void . runCmd . draw $ framebufferBatch defaultFramebuffer + [anySPBatch . shaderProgramBatch program mempty () $ + [ + renderCmd blending False colorOffsetU (color0,offset0) triangle + , renderCmd blending False colorOffsetU (color1,offset1) triangle + , renderCmd blending False colorOffsetU (color2,offset2) triangle + ] + ] + endFrame window + +color0,color1,color2 :: (Float,Float,Float) +color0 = (1,0,0) +color1 = (0,1,0) +color2 = (0,0,1) + +offset0,offset1,offset2 :: (Float,Float) +offset0 = (-0.25,0) +offset1 = (0.25,0) +offset2 = (0,0.25) + +vertices :: [V 2 Float] +vertices = + [ + V2 (-0.5) (-0.5) + , V2 0 0.5 + , V2 0.5 (-0.5) + ] + +blending :: Maybe (BlendingMode,BlendingFactor,BlendingFactor) +blending = Just (Additive,One,One) + +vsSource :: String +vsSource = unlines + [ + "#version 450 core" + + , "in vec2 co;" + + , "uniform vec2 offset;" + + , "void main() {" + , " gl_Position = vec4(co + offset, 0., 1.);" + , "}" + ] + +fsSource :: String +fsSource = unlines + [ + "#version 450 core" + + , "out vec4 frag;" + + , "uniform vec3 color;" + + , "void main() {" + , " frag = vec4(color, 1.);" + , "}" + ] diff --git a/src/Blit.hs b/src/Blit.hs new file mode 100644 --- /dev/null +++ b/src/Blit.hs @@ -0,0 +1,60 @@ +import Common +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.Pixel as L +import Graphics.Luminance.RW +import Graphics.Luminance.Shader.Program +import Graphics.Luminance.Shader.Stage +import Graphics.Luminance.Texture +import Graphics.Luminance.Vertex +import Graphics.UI.GLFW + +main :: IO () +main = startup $ \window -> do + triangle <- createGeometry vertices Nothing Triangle + vs <- createVertexShader vsSource + fs <- createFragmentShader fsSource + fb :: Framebuffer RW RGBA32F () <- createFramebuffer windowW windowH 1 + program <- createProgram_ [vs,fs] + untilM (liftIO $ windowShouldClose window) $ do + _ <- runCmd $ do + _ <- draw $ framebufferBatch fb + [anySPBatch $ shaderProgramBatch program mempty () [renderCmd Nothing True mempty () triangle]] + blit fb defaultFramebuffer 0 0 windowW windowH 0 0 windowW windowH BlitColor Linear + endFrame window + +vertices :: [V 2 Float] +vertices = + [ + V2 (-0.5) (-0.5) + , V2 0 0.5 + , V2 0.5 (-0.5) + ] + +vsSource :: String +vsSource = unlines + [ + "#version 450 core" + + , "in vec2 co;" + + , "void main() {" + , " gl_Position = vec4(co, 0., 1.);" + , "}" + ] + +fsSource :: String +fsSource = unlines + [ + "#version 450 core" + + , "out vec4 frag;" + + , "void main() {" + , " frag = vec4(1., 0., 0., 1.);" + , "}" + ] diff --git a/src/DepthTest.hs b/src/DepthTest.hs new file mode 100644 --- /dev/null +++ b/src/DepthTest.hs @@ -0,0 +1,79 @@ +import Common +import Control.Monad +import Control.Monad.IO.Class +import Data.Functor.Contravariant.Divisible +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.Vertex +import Graphics.UI.GLFW + +main :: IO () +main = startup $ \window -> do + triangle <- createGeometry vertices Nothing Triangle + vs <- createVertexShader vsSource + fs <- createFragmentShader 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 + void . runCmd . draw $ framebufferBatch defaultFramebuffer + [anySPBatch . shaderProgramBatch program mempty () $ + [ + renderCmd Nothing True colorOffsetU (color0,offset0) triangle + , renderCmd Nothing True colorOffsetU (color1,offset1) triangle + , renderCmd Nothing True colorOffsetU (color2,offset2) triangle + ] + ] + endFrame window + +color0,color1,color2 :: (Float,Float,Float) +color0 = (1,0,0) +color1 = (0,1,0) +color2 = (0,0,1) + +offset0,offset1,offset2 :: (Float,Float) +offset0 = (-0.25,0) +offset1 = (0.25,0) +offset2 = (0,0.25) + +vertices :: [V 2 Float] +vertices = + [ + V2 (-0.5) (-0.5) + , V2 0 0.5 + , V2 0.5 (-0.5) + ] + +vsSource :: String +vsSource = unlines + [ + "#version 450 core" + + , "in vec2 co;" + + , "uniform vec2 offset;" + + , "void main() {" + , " gl_Position = vec4(co + offset, 0., 1.);" + , "}" + ] + +fsSource :: String +fsSource = unlines + [ + "#version 450 core" + + , "out vec4 frag;" + + , "uniform vec3 color;" + + , "void main() {" + , " frag = vec4(color, 1.);" + , "}" + ] diff --git a/src/HelloWorld.hs b/src/HelloWorld.hs new file mode 100644 --- /dev/null +++ b/src/HelloWorld.hs @@ -0,0 +1,65 @@ +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.Vertex +import Graphics.UI.GLFW + +main :: IO () +main = startup $ \window -> do + triangle <- createGeometry vertices Nothing Triangle + vs <- createVertexShader vsSource + fs <- createFragmentShader fsSource + program <- createProgram_ [vs,fs] + untilM (liftIO $ windowShouldClose window) $ do + void . runCmd . draw $ framebufferBatch defaultFramebuffer [anySPBatch . shaderProgramBatch program mempty () $ [stdRenderCmd mempty () triangle]] + endFrame window + +vertices :: [V 2 Float] +vertices = + [ + V2 (-0.5) (-0.5) + , V2 0 0.5 + , V2 0.5 (-0.5) + ] + +vsSource :: String +vsSource = unlines + [ + "#version 450 core" + + , "in vec2 co;" + , "out vec4 vertexColor;" + + , "vec4 color[3] = vec4[](" + , " vec4(1., 0., 0., 1.)" + , " , vec4(0., 1., 0., 1.)" + , " , vec4(0., 0., 1., 1.)" + , " );" + + , "void main() {" + , " gl_Position = vec4(co, 0., 1.);" + , " vertexColor = color[gl_VertexID];" + , "}" + ] + +fsSource :: String +fsSource = unlines + [ + "#version 450 core" + + , "in vec4 vertexColor;" + , "out vec4 frag;" + + + , "void main() {" + , " frag = vertexColor;" + , "}" + ] + diff --git a/src/HelloWorldUniform.hs b/src/HelloWorldUniform.hs new file mode 100644 --- /dev/null +++ b/src/HelloWorldUniform.hs @@ -0,0 +1,70 @@ +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.UI.GLFW + +main :: IO () +main = startup $ \window -> do + triangle <- createGeometry vertices Nothing Triangle + vs <- createVertexShader vsSource + fs <- createFragmentShader fsSource + (program,colorsU :: U [(Float,Float,Float)]) <- createProgram [vs,fs] (\f -> f $ Left "colors") + untilM (liftIO $ windowShouldClose window) $ do + void . runCmd . draw $ framebufferBatch defaultFramebuffer [anySPBatch . shaderProgramBatch program colorsU colors $ [stdRenderCmd mempty () triangle]] + endFrame window + +colors :: [(Float,Float,Float)] +colors = [(1,0,0),(0,1,0),(0,0,1)] + +vertices :: [V 2 Float] +vertices = + [ + V2 (-0.5) (-0.5) + , V2 0 0.5 + , V2 0.5 (-0.5) + ] + +vsSource :: String +vsSource = unlines + [ + "#version 450 core" + + , "in vec2 co;" + , "out vec4 vertexColor;" + + , "uniform vec3[] colors;" + + , "vec3 color[3] = vec3[](" + , " colors[0]" + , " , colors[1]" + , " , colors[2]" + , " );" + + , "void main() {" + , " gl_Position = vec4(co, 0., 1.);" + , " vertexColor = vec4(color[gl_VertexID], 1.);" + , "}" + ] + +fsSource :: String +fsSource = unlines + [ + "#version 450 core" + + , "in vec4 vertexColor;" + , "out vec4 frag;" + + + , "void main() {" + , " frag = vertexColor;" + , "}" + ] diff --git a/src/Texture.hs b/src/Texture.hs new file mode 100644 --- /dev/null +++ b/src/Texture.hs @@ -0,0 +1,95 @@ +import Codec.Picture +import Codec.Picture.Types +import Common +import Control.Monad +import Control.Monad.Except ( MonadError(..) ) +import Control.Monad.IO.Class +import Control.Monad.Trans.Resource +import Data.Vector ( Vector, convert ) +import qualified Data.Vector.Storable as S ( Vector ) +import Foreign.Storable ( Storable ) +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.UI.GLFW +import System.Environment ( getArgs ) + +main :: IO () +main = startup $ \window -> do + args <- liftIO getArgs + when (null args) . throwError $ AppError "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 + void . runCmd . draw $ framebufferBatch defaultFramebuffer + [anySPBatch $ shaderProgramBatch program texU tex [renderCmd Nothing True mempty () quad]] + endFrame window + +vertices :: [V 2 Float] +vertices = + [ + V2 (-1) 1 + , V2 1 1 + , V2 (-1) (-1) + , V2 (-1) (-1) + , V2 1 1 + , V2 1 (-1) + ] + +vsSource :: String +vsSource = unlines + [ + "#version 450 core" + + , "in vec2 co;" + + , "void main() {" + , " gl_Position = vec4(co, 0., 1.);" + , "}" + ] + +fsSource :: String +fsSource = unlines + [ + "#version 450 core" + , "#extension GL_ARB_bindless_texture : require" + + , "out vec4 frag;" + + , "layout (bindless_sampler) uniform usampler2D 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.);" + , "}" + ] + +loadTexture :: (MonadError AppError m,MonadIO m,MonadResource m) => String -> m (Texture2D RGBA8UI) +loadTexture path = liftIO (readImage path) >>= either (throwError . AppError) 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" + +createTexture_ :: (MonadIO m,MonadResource m) => Image PixelRGBA8 -> m (Texture2D RGBA8UI) +createTexture_ img = do + tex <- createTexture (fromIntegral $ imageWidth img) (fromIntegral $ imageHeight img) 1 defaultSampling + uploadWhole tex False (convertV $ imageData img) + pure tex + +convertV :: (Storable a) => S.Vector a -> Vector a +convertV = convert