luminance-samples (empty) → 0.1
raw patch · 10 files changed
+630/−0 lines, 10 filesdep +GLFW-bdep +JuicyPixelsdep +basesetup-changed
Dependencies added: GLFW-b, JuicyPixels, base, contravariant, luminance, mtl, resourcet, transformers, vector
Files
- CHANGELOG.md +0/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- luminance-samples.cabal +146/−0
- src/Blending.hs +83/−0
- src/Blit.hs +60/−0
- src/DepthTest.hs +79/−0
- src/HelloWorld.hs +65/−0
- src/HelloWorldUniform.hs +70/−0
- src/Texture.hs +95/−0
+ CHANGELOG.md view
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Dimitri Sabadie <dimitri.sabadie@gmail.com>++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 <dimitri.sabadie@gmail.com> 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ luminance-samples.cabal view
@@ -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 <dimitri.sabadie@gmail.com>+maintainer: Dimitri Sabadie <dimitri.sabadie@gmail.com>+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
+ src/Blending.hs view
@@ -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.);"+ , "}"+ ]
+ src/Blit.hs view
@@ -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.);"+ , "}"+ ]
+ src/DepthTest.hs view
@@ -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.);"+ , "}"+ ]
+ src/HelloWorld.hs view
@@ -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;"+ , "}"+ ]+
+ src/HelloWorldUniform.hs view
@@ -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;"+ , "}"+ ]
+ src/Texture.hs view
@@ -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