├── .travis.yml ├── Boilerplate ├── Main.hs ├── NGL │ └── LoadShaders.hs ├── README.md ├── Shaders │ ├── shader.frag │ └── shader.vert ├── output.png └── test.png ├── HelloWindow ├── HelloWindow.cabal ├── LICENSE ├── README.md ├── Setup.hs ├── app │ └── Main.hs ├── output.png └── stack.yaml ├── Mandelbrot-FRP-cabalized ├── CHANGELOG.md ├── LICENSE ├── Mandelbrot-FRP-cabalized.cabal ├── README.md ├── Shaders │ ├── shader.frag │ └── shader.vert ├── app │ └── Main.hs ├── output.png ├── src │ ├── Graphics │ │ └── RedViz │ │ │ ├── GLUtil.hs │ │ │ └── GLUtil │ │ │ ├── JuicyTextures.hs │ │ │ ├── Textures.hs │ │ │ └── TypeMapping.hs │ └── NGL │ │ └── LoadShaders.hs └── test.png ├── Mandelbrot-FRP-io-sdl2-cabalized ├── CHANGELOG.md ├── LICENSE ├── Makefile ├── Mandelbrot-FRP-io-sdl2-cabalized.cabal ├── README.md ├── Shaders │ ├── shader.frag │ └── shader.vert ├── app │ └── Main.hs ├── output.png └── src │ ├── Input.hs │ ├── NGL │ └── LoadShaders.hs │ └── Types.hs ├── Mandelbrot-FRP-io-sdl2 ├── Input.hs ├── Main.hs ├── Makefile ├── NGL │ └── LoadShaders.hs ├── README.md ├── Shaders │ ├── shader.frag │ └── shader.vert ├── Types.hs └── output.png ├── Mandelbrot-FRP ├── Main.hs ├── Makefile ├── NGL │ └── LoadShaders.hs ├── README.md ├── Shaders │ ├── shader.frag │ └── shader.vert └── output.png ├── Mandelbrot.make ├── Main.hs ├── Makefile ├── NGL │ ├── Linear.hs │ ├── LoadShaders.hs │ ├── Rendering.hs │ ├── Shape.hs │ ├── Texture.hs │ ├── Utils.hs │ ├── clean │ └── test.png ├── README.md ├── Shaders │ ├── shader.frag │ └── shader.vert ├── TinyMath │ ├── README.md │ ├── TinyMath.hs │ └── drawing.svg └── output.png ├── Mandelbrot ├── LICENSE ├── Mandelbrot.cabal ├── README.md ├── Setup.hs ├── Shaders │ ├── shader.frag │ └── shader.vert ├── app │ └── Main.hs ├── output.png ├── run.sh ├── src │ └── LoadShaders.hs └── stack.yaml ├── MandelbrotViewer ├── LICENSE ├── MandelbrotYampa.cabal ├── README.md ├── Setup.hs ├── Shaders │ ├── shader.frag │ └── shader.vert ├── app │ ├── Main.hs │ ├── Test.hs │ └── scratch ├── output.gif ├── run.sh ├── src │ ├── Input.hs │ └── LoadShaders.hs ├── stack.yaml └── test │ └── Spec.hs ├── MandelbrotViewerDIG ├── LICENSE ├── MandelbrotYampa.cabal ├── README.md ├── Setup.hs ├── Shaders │ ├── shader.frag │ └── shader.vert ├── app │ ├── Main.hs │ ├── MainDIG.hs │ ├── Test.hs │ └── scratch ├── mat │ └── share │ │ ├── hg_sdf.glsl │ │ └── lib.glsl ├── output.gif ├── output.png ├── src │ ├── Graphics │ │ ├── RedViz.hs │ │ └── RedViz │ │ │ ├── Backend.hs │ │ │ ├── Camera.hs │ │ │ ├── Controllable.hs │ │ │ ├── Descriptor.hs │ │ │ ├── Drawable.hs │ │ │ ├── FromVector.hs │ │ │ ├── GLUtil.hs │ │ │ ├── GLUtil │ │ │ ├── JuicyTextures.hs │ │ │ ├── Textures.hs │ │ │ └── TypeMapping.hs │ │ │ ├── Input.hs │ │ │ ├── Input │ │ │ ├── FRP │ │ │ │ ├── Yampa.hs │ │ │ │ └── Yampa │ │ │ │ │ ├── AppInput.hs │ │ │ │ │ ├── Update.hs │ │ │ │ │ └── Update │ │ │ │ │ ├── Keyboard.hs │ │ │ │ │ └── Mouse.hs │ │ │ ├── Keyboard.hs │ │ │ └── Mouse.hs │ │ │ ├── LoadShaders.hs │ │ │ ├── Material.hs │ │ │ ├── Object.hs │ │ │ ├── PGeo.hs │ │ │ ├── Primitives.hs │ │ │ ├── Project.hs │ │ │ ├── Project │ │ │ ├── GUI.hs │ │ │ ├── Model.hs │ │ │ ├── Project.hs │ │ │ └── Utils.hs │ │ │ ├── Rendering.hs │ │ │ ├── Texture.hs │ │ │ ├── Utils.hs │ │ │ ├── VAO.hs │ │ │ └── Widget.hs │ ├── Input.hs │ └── LoadShaders.hs └── test │ └── Spec.hs ├── MandelbrotViewerDIGRes ├── LICENSE ├── MandelbrotYampa.cabal ├── README.md ├── Setup.hs ├── Shaders │ ├── shader.frag │ └── shader.vert ├── app │ ├── Main.hs │ ├── MainDIG.hs │ └── Test.hs ├── imgui.ini ├── mat │ └── share │ │ ├── hg_sdf.glsl │ │ └── lib.glsl ├── output.gif ├── output.png ├── src │ ├── Graphics │ │ ├── RedViz.hs │ │ └── RedViz │ │ │ ├── Backend.hs │ │ │ ├── Camera.hs │ │ │ ├── Controllable.hs │ │ │ ├── Descriptor.hs │ │ │ ├── Drawable.hs │ │ │ ├── FromVector.hs │ │ │ ├── GLUtil.hs │ │ │ ├── GLUtil │ │ │ ├── JuicyTextures.hs │ │ │ ├── Textures.hs │ │ │ └── TypeMapping.hs │ │ │ ├── Input.hs │ │ │ ├── Input │ │ │ ├── FRP │ │ │ │ ├── Yampa.hs │ │ │ │ └── Yampa │ │ │ │ │ ├── AppInput.hs │ │ │ │ │ ├── Update.hs │ │ │ │ │ └── Update │ │ │ │ │ ├── Keyboard.hs │ │ │ │ │ └── Mouse.hs │ │ │ ├── Keyboard.hs │ │ │ └── Mouse.hs │ │ │ ├── LoadShaders.hs │ │ │ ├── Material.hs │ │ │ ├── Object.hs │ │ │ ├── PGeo.hs │ │ │ ├── Primitives.hs │ │ │ ├── Project.hs │ │ │ ├── Project │ │ │ ├── GUI.hs │ │ │ ├── Model.hs │ │ │ ├── Project.hs │ │ │ └── Utils.hs │ │ │ ├── Rendering.hs │ │ │ ├── Texture.hs │ │ │ ├── Utils.hs │ │ │ ├── VAO.hs │ │ │ └── Widget.hs │ ├── Input.hs │ └── LoadShaders.hs ├── stack.yaml └── test │ └── Spec.hs ├── MandelbrotYampa ├── LICENSE ├── MandelbrotYampa.cabal ├── README.md ├── Setup.hs ├── Shaders │ ├── shader.frag │ └── shader.vert ├── app │ ├── Main.hs │ └── scratch ├── output.gif ├── output.png ├── run.sh ├── src │ ├── Input.hs │ └── LoadShaders.hs ├── stack.yaml └── test │ └── Spec.hs ├── README.md ├── Read_Model-FRP-io-sdl2 ├── Main.hs ├── Makefile ├── README.md └── geoParser.py ├── Transformations ├── LICENSE ├── README.md ├── Resources │ └── Textures │ │ ├── awesomeface.png │ │ └── container.jpg ├── Setup.hs ├── Shaders │ ├── shader.frag │ └── shader.vert ├── Transformations.cabal ├── app │ └── Main.hs ├── output.png ├── run.sh ├── src │ └── LoadShaders.hs └── stack.yaml ├── dynamic_transformation ├── Main.hs ├── Makefile ├── NGL │ ├── Linear.hs │ ├── LoadShaders.hs │ ├── Rendering.hs │ ├── Shape.hs │ ├── Texture.hs │ ├── TinyMath │ ├── Utils.hs │ ├── clean │ └── test.png ├── Object.hs ├── README.md ├── Resources │ └── Textures │ │ ├── awesomeface.png │ │ └── container.jpg ├── Shaders │ ├── shader.frag │ └── shader.vert └── output.png ├── element_buffer ├── Main.hs ├── Makefile ├── NGL │ ├── Linear.hs │ ├── LoadShaders.hs │ ├── Rendering.hs │ ├── Shape.hs │ ├── Texture.hs │ ├── TinyMath │ ├── Utils.hs │ ├── clean │ └── test.png ├── Object.hs ├── README.md ├── Shaders │ ├── shader.frag │ └── shader.vert ├── junk.hs ├── junk2.hs ├── output.png └── test.png ├── minimumBoilerplate ├── Main.hs ├── NGL │ └── LoadShaders.hs ├── README.md ├── Shaders │ ├── shader.frag │ └── shader.vert └── output.png ├── rectangle_with_texture_blending ├── Main.hs ├── Makefile ├── NGL │ ├── Linear.hs │ ├── LoadShaders.hs │ ├── Rendering.hs │ ├── Shape.hs │ ├── Texture.hs │ ├── Utils.hs │ ├── clean │ └── test.png ├── Object.hs ├── README.md ├── Resources │ └── Textures │ │ ├── awesomeface.png │ │ └── container.jpg ├── Shaders │ ├── shader.frag │ └── shader.vert ├── output.png └── test.png ├── tutorial00-cabalized ├── CHANGELOG.md ├── LICENSE ├── README.md ├── app │ └── Main.hs ├── tutorial00-cabalized.cabal └── tutorial01.png ├── tutorial00 ├── Main.hs ├── README.md └── tutorial01.png ├── tutorial01 ├── Main.hs ├── README.md └── tutorial01.png ├── tutorial02 ├── LoadShaders.hs ├── LoadShaders.o ├── Main.hs ├── Makefile ├── README.md ├── output.png ├── shader.frag └── shader.vert ├── tutorial03 ├── LoadShaders.hs ├── Main.hs ├── Makefile ├── README.md ├── output.png ├── shader.frag ├── shader.vert └── test.png ├── tutorial04 ├── Main.hs ├── NGL │ ├── LoadShaders.hs │ ├── Rendering.hs │ ├── Shape.hs │ └── Utils.hs ├── README.md ├── Shaders │ ├── triangles.frac │ └── triangles.vert ├── tutorial04_error_in_the_code.png └── tutorial04_fixed.png ├── tutorial05 ├── Main.hs ├── NGL │ ├── Linear.hs │ ├── LoadShaders.hs │ ├── Rendering.hs │ ├── Shape.hs │ └── Utils.hs ├── README.md ├── Shaders │ ├── triangles.frac │ └── triangles.vert └── tutorial05.png ├── tutorial06 ├── Main.hs ├── NGL │ ├── Linear.hs │ ├── LoadShaders.hs │ ├── Rendering.hs │ ├── Shape.hs │ └── Utils.hs ├── README.md ├── Riemans_spiral.png └── TinyMath ├── tutorial07 ├── Main.hs ├── NGL ├── README.md └── TinyMath ├── tutorial08 ├── Main.hs ├── README.md ├── soon.png ├── soon.svg └── tutorial_08.png ├── tutorial09 ├── Main.hs ├── NGL └── README.md ├── tutorial10 ├── Main.hs ├── NGL │ ├── Linear.hs │ ├── LoadShaders.hs │ ├── NGL │ ├── Notes.org │ ├── Rendering.hs │ ├── Shape.hs │ ├── Texture.hs │ ├── TinyMath │ ├── Utils.hs │ └── test.png ├── README.md ├── Shaders │ ├── shader.frag │ └── shader.vert └── output.png ├── tutorial11 ├── Main.hs ├── NGL │ ├── Rendering.hs │ └── Shape.hs ├── README.md ├── TinyMath │ ├── README.md │ ├── TinyMath.hs │ └── drawing.svg └── main.png └── tutorial12 ├── Main.hs ├── NGL ├── NGL ├── Rendering.hs ├── Shape.hs └── TinyMath ├── README.md ├── Shaders ├── triangles.frac └── triangles.vert └── opengl.png /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | 3 | sudo: false 4 | cache: 5 | directories: 6 | - $HOME/.stack/ 7 | 8 | matrix: 9 | include: 10 | - env: CABALVER=1.24.0.2 GHCVER=8.0.2 11 | addons: {apt: {packages: [libxi-dev,libxrandr-dev,libxcursor-dev,libxinerama-dev,cabal-install,ghc],sources: [hvr-ghc]}} 12 | 13 | before_install: 14 | - mkdir -p ~/.local/bin 15 | - export PATH=~/.local/bin:$PATH 16 | - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar -xzO --wildcards '*/stack' > ~/.local/bin/stack 17 | - chmod a+x ~/.local/bin/stack 18 | - sudo dpkg -l 19 | - wget https://www.libsdl.org/release/SDL2-2.0.4.tar.gz 20 | - tar xvzf SDL2-2.0.4.tar.gz 21 | - pushd SDL2-2.0.4 && ./configure --prefix=/usr && make && sudo make install && popd 22 | - cabal update 23 | 24 | install: 25 | - pwd 26 | - ls -lah 27 | - cd /home/travis/build/madjestic/Haskell-OpenGL-Tutorial/MandelbrotYampa && stack -j 4 setup --no-terminal 28 | - cd /home/travis/build/madjestic/Haskell-OpenGL-Tutorial/MandelbrotYampa && stack -j 4 build --only-snapshot --no-terminal 29 | 30 | script: 31 | - cabal list sdl2 32 | - cd /home/travis/build/madjestic/Haskell-OpenGL-Tutorial/MandelbrotYampa && stack -j 4 build --no-terminal 33 | -------------------------------------------------------------------------------- /Boilerplate/README.md: -------------------------------------------------------------------------------- 1 | This is an attempt to create a modern, consize OpenGL template in 2 | haskell. It's mainly meant for experimenting with OpenGL. 3 | 4 | This works well with OpenGL 4.4.0 NVIDIA 361.18 5 | Lenovo E431 (2014) laptop, running nVidia GeForce GT 740M/PCIe/SSE2 6 | 7 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/Boilerplate/output.png) 8 | 9 | TODO: Needs a bit of cleanup, in accordance to the [minimumBoilerplate](https://github.com/madjestic/Haskell-OpenGL-Tutorial/tree/master/minimumBoilerplate) -------------------------------------------------------------------------------- /Boilerplate/Shaders/shader.frag: -------------------------------------------------------------------------------- 1 | #version 150 2 | 3 | // Created by inigo quilez - iq/2013 4 | // License Creative Commons Attribution-NonCommercial-ShareAlike 3.0 Unported License. 5 | 6 | 7 | // This shader computes the distance to the Mandelbrot Set for everypixel, and colorizes 8 | // it accoringly. 9 | // 10 | // Z -> Z²+c, Z0 = 0. 11 | // therefore Z' -> 2·Z·Z' + 1 12 | // 13 | // The Hubbard-Douady potential G(c) is G(c) = log Z/2^n 14 | // G'(c) = Z'/Z/2^n 15 | // 16 | // So the distance is |G(c)|/|G'(c)| = |Z|·log|Z|/|Z'| 17 | // 18 | // More info here: http://www.iquilezles.org/www/articles/distancefractals/distancefractals.htm 19 | 20 | in vec2 fragCoord; 21 | out vec4 fragColor; 22 | 23 | void main() 24 | { 25 | vec3 iResolution = vec3(1024, 1024, 1.0); 26 | float iGlobalTime = 5.0; 27 | vec2 p = -3.0 + 5000.0 * fragCoord.xy / iResolution.xy; 28 | p.x *= iResolution.x/iResolution.y; 29 | 30 | // animation 31 | float tz = 0.5 - 0.5*cos(0.225*iGlobalTime); 32 | float zoo = pow( 0.5, 13.0*tz ); 33 | vec2 c = vec2(-0.05,.6805) + p*zoo; 34 | 35 | // iterate 36 | vec2 z = vec2(0.0); 37 | float m2 = 0.0; 38 | vec2 dz = vec2(0.0); 39 | for( int i=0; i<256; i++ ) 40 | { 41 | if( m2>1024.0 ) continue; 42 | 43 | // Z' -> 2·Z·Z' + 1 44 | dz = 2.0*vec2(z.x*dz.x-z.y*dz.y, z.x*dz.y + z.y*dz.x) + vec2(1.0,0.0); 45 | 46 | // Z -> Z² + c 47 | z = vec2( z.x*z.x - z.y*z.y, 2.0*z.x*z.y ) + c; 48 | 49 | m2 = dot(z,z); 50 | } 51 | 52 | // distance 53 | // d(c) = |Z|·log|Z|/|Z'| 54 | float d = 0.5*sqrt(dot(z,z)/dot(dz,dz))*log(dot(z,z)); 55 | 56 | 57 | // do some soft coloring based on distance 58 | d = clamp( 8.0*d/zoo, 0.0, 1.0 ); 59 | d = pow( d, 0.25 ); 60 | vec3 col = vec3( d ); 61 | 62 | // fragColor = vec4( vec3(fragCoord.x,fragCoord.y,0.0), 1.0 ); 63 | fragColor = vec4( col, 1.0 ); 64 | } 65 | -------------------------------------------------------------------------------- /Boilerplate/Shaders/shader.vert: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec4 vPosition; 4 | layout(location = 2) in vec2 uvCoords; 5 | 6 | // Output data ; will be interpolated for each fragment. 7 | out vec2 fragCoord; 8 | 9 | void main() 10 | { 11 | gl_Position = vPosition; 12 | 13 | // The color of each vertex will be interpolated 14 | // to produce the color of each fragment 15 | fragCoord = uvCoords; 16 | } 17 | -------------------------------------------------------------------------------- /Boilerplate/output.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/Boilerplate/output.png -------------------------------------------------------------------------------- /Boilerplate/test.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/Boilerplate/test.png -------------------------------------------------------------------------------- /HelloWindow/HelloWindow.cabal: -------------------------------------------------------------------------------- 1 | name: HelloWindow 2 | version: 0.1.0.0 3 | -- synopsis: 4 | -- description: 5 | homepage: https://github.com/madjestic/HelloWindow#readme 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Vladimir Lopatin 9 | maintainer: madjestic13@gmail.com 10 | copyright: Vladimir Lopatin 11 | category: graphics 12 | build-type: Simple 13 | extra-source-files: README.md 14 | cabal-version: >=1.10 15 | 16 | executable HelloWindow 17 | hs-source-dirs: app 18 | main-is: Main.hs 19 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 20 | build-depends: base 21 | , OpenGL >= 3.0 && < 4 22 | , GLFW-b 23 | default-language: Haskell2010 24 | -------------------------------------------------------------------------------- /HelloWindow/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Vladimir Lopatin (c) 2017 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Vladimir Lopatin nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /HelloWindow/README.md: -------------------------------------------------------------------------------- 1 | # HelloWindow 2 | 3 | A Hello Window [OpenGL](https://github.com/haskell-opengl) application with [stack](https://docs.haskellstack.org/en/stable/README/) as a build system. 4 | 5 | ## Prerequisits: 6 | Hardware, supporting OpenGL >= 4.5 (because that's what my hardware is). 7 | Most likely the code will run with lesser OpenGL versions, but you will 8 | have to mess with the code. 9 | 10 | ## In order to run: 11 | ``` 12 | stack build 13 | stack exec HelloWindow 14 | 15 | ``` 16 | 17 | ## Output: 18 | ![](https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/master/HelloWindow/output.png) 19 | -------------------------------------------------------------------------------- /HelloWindow/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /HelloWindow/app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Graphics.Rendering.OpenGL as GL 4 | import Graphics.UI.GLFW as GLFW 5 | import Control.Monad (forever) 6 | import System.Exit (exitSuccess) 7 | 8 | keyPressed :: GLFW.KeyCallback 9 | keyPressed win GLFW.Key'Escape _ GLFW.KeyState'Pressed _ = shutdown win 10 | keyPressed _ _ _ _ _ = return () 11 | 12 | shutdown :: GLFW.WindowCloseCallback 13 | shutdown win = 14 | do 15 | GLFW.destroyWindow win 16 | GLFW.terminate 17 | _ <- exitSuccess 18 | return () 19 | 20 | resizeWindow :: GLFW.WindowSizeCallback 21 | resizeWindow _ w h = 22 | do 23 | GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h)) 24 | GL.matrixMode $= GL.Projection 25 | GL.loadIdentity 26 | GL.ortho2D 0 (realToFrac w) (realToFrac h) 0 27 | 28 | openWindow :: String -> (Int, Int) -> IO GLFW.Window 29 | openWindow title (sizex,sizey) = 30 | do 31 | GLFW.init 32 | GLFW.defaultWindowHints 33 | GLFW.windowHint (GLFW.WindowHint'ContextVersionMajor 4) 34 | GLFW.windowHint (GLFW.WindowHint'ContextVersionMinor 5) 35 | GLFW.windowHint (GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Core) 36 | GLFW.windowHint (GLFW.WindowHint'Resizable False) 37 | Just win <- GLFW.createWindow sizex sizey title Nothing Nothing 38 | GLFW.makeContextCurrent (Just win) 39 | GLFW.setWindowSizeCallback win (Just resizeWindow) 40 | GLFW.setKeyCallback win (Just keyPressed) 41 | GLFW.setWindowCloseCallback win (Just shutdown) 42 | return win 43 | 44 | closeWindow :: GLFW.Window -> IO () 45 | closeWindow win = 46 | do 47 | GLFW.destroyWindow win 48 | GLFW.terminate 49 | 50 | display :: IO () 51 | display = 52 | do 53 | inWindow <- openWindow "Hello Window!" (512,512) 54 | onDisplay inWindow 55 | closeWindow inWindow 56 | 57 | onDisplay :: GLFW.Window -> IO () 58 | onDisplay win = 59 | do 60 | GL.clearColor $= Color4 1 0 0 1 61 | GL.clear [ColorBuffer] 62 | GLFW.swapBuffers win 63 | 64 | forever $ do 65 | GLFW.pollEvents 66 | onDisplay win 67 | 68 | --------------------------------------------------------------------------- 69 | 70 | main :: IO () 71 | main = 72 | do 73 | display 74 | -------------------------------------------------------------------------------- /HelloWindow/output.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/HelloWindow/output.png -------------------------------------------------------------------------------- /HelloWindow/stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-9.13 2 | 3 | packages: 4 | - . 5 | 6 | extra-deps: 7 | - OpenGL-3.0.2.0 8 | - GLFW-b-1.4.8.1 9 | 10 | flags: {} -------------------------------------------------------------------------------- /Mandelbrot-FRP-cabalized/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for Mandelbrot-FRP-cabalized 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /Mandelbrot-FRP-cabalized/LICENSE: -------------------------------------------------------------------------------- 1 | BSD 3-Clause License 2 | 3 | Copyright (c) 2022, Vladimir Lopatin 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | 1. Redistributions of source code must retain the above copyright notice, this 10 | list of conditions and the following disclaimer. 11 | 12 | 2. Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | 3. Neither the name of the copyright holder nor the names of its 17 | contributors may be used to endorse or promote products derived from 18 | this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 21 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 22 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 24 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 25 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 26 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 27 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 28 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 29 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /Mandelbrot-FRP-cabalized/Mandelbrot-FRP-cabalized.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: Mandelbrot-FRP-cabalized 3 | version: 0.2.0.0 4 | license: BSD-3-Clause 5 | license-file: LICENSE 6 | author: madiestic 7 | maintainer: madjestic13@gmail.com 8 | copyright: Vladimir Lopatin 9 | extra-source-files: CHANGELOG.md 10 | 11 | executable Mandelbrot 12 | main-is: Main.hs 13 | other-modules: 14 | Graphics.RedViz.GLUtil 15 | Graphics.RedViz.GLUtil.JuicyTextures 16 | Graphics.RedViz.GLUtil.Textures 17 | Graphics.RedViz.GLUtil.TypeMapping 18 | NGL.LoadShaders 19 | build-depends: base ^>=4.16.4.0 20 | , OpenGL 21 | , linear 22 | , array 23 | , bytestring 24 | , vector 25 | , JuicyPixels 26 | , text 27 | , Yampa 28 | , GLFW-b 29 | hs-source-dirs: app 30 | , src 31 | default-language: Haskell2010 32 | -------------------------------------------------------------------------------- /Mandelbrot-FRP-cabalized/README.md: -------------------------------------------------------------------------------- 1 | An animated Mandelbrot example, using [FRP.Yampa](https://github.com/ivanperez-keera/Yampa) to handle animation loop, GLFW-b is used for windows and event callbacks. 2 | Shader-loading is handled by [Sven Panne's code](https://github.com/haskell-opengl/GLUT/blob/master/examples/RedBook8/common/LoadShaders.hs). 3 | 4 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/Mandelbrot/output.png) 5 | 6 | in order to run: 7 | 8 | ```bash 9 | $ make 10 | $ optirun -b primus ./Main 11 | ``` -------------------------------------------------------------------------------- /Mandelbrot-FRP-cabalized/Shaders/shader.frag: -------------------------------------------------------------------------------- 1 | #version 450 2 | 3 | // Created by inigo quilez - iq/2013 4 | // License Creative Commons Attribution-NonCommercial-ShareAlike 3.0 Unported License. 5 | 6 | 7 | // This shader computes the distance to the Mandelbrot Set for everypixel, and colorizes 8 | // it accoringly. 9 | // 10 | // Z -> Z²+c, Z0 = 0. 11 | // therefore Z' -> 2·Z·Z' + 1 12 | // 13 | // The Hubbard-Douady potential G(c) is G(c) = log Z/2^n 14 | // G'(c) = Z'/Z/2^n 15 | // 16 | // So the distance is |G(c)|/|G'(c)| = |Z|·log|Z|/|Z'| 17 | // 18 | // More info here: http://www.iquilezles.org/www/articles/distancefractals/distancefractals.htm 19 | 20 | in vec2 fragCoord; 21 | // in float time; 22 | out vec4 fragColor; 23 | 24 | uniform float fTime; 25 | 26 | void main() 27 | { 28 | vec3 iResolution = vec3(1024, 1024, 1.0); 29 | float iGlobalTime = fTime; 30 | vec2 p = -3.0 + 5000.0 * fragCoord.xy / iResolution.xy; 31 | p.x *= iResolution.x/iResolution.y; 32 | 33 | // animation 34 | float tz = 0.5 - 0.5*cos(0.225*iGlobalTime); 35 | float zoo = pow( 0.5, 13.0*tz ); 36 | vec2 c = vec2(-0.05,.6805) + p*zoo; 37 | 38 | // iterate 39 | vec2 z = vec2(0.0); 40 | float m2 = 0.0; 41 | vec2 dz = vec2(0.0); 42 | for( int i=0; i<256; i++ ) 43 | { 44 | if( m2>1024.0 ) continue; 45 | 46 | // Z' -> 2·Z·Z' + 1 47 | dz = 2.0*vec2(z.x*dz.x-z.y*dz.y, z.x*dz.y + z.y*dz.x) + vec2(1.0,0.0); 48 | 49 | // Z -> Z² + c 50 | z = vec2( z.x*z.x - z.y*z.y, 2.0*z.x*z.y ) + c; 51 | 52 | m2 = dot(z,z); 53 | } 54 | 55 | // distance 56 | // d(c) = |Z|·log|Z|/|Z'| 57 | float d = 0.5*sqrt(dot(z,z)/dot(dz,dz))*log(dot(z,z)); 58 | 59 | 60 | // do some soft coloring based on distance 61 | d = clamp( 8.0*d/zoo, 0.0, 1.0 ); 62 | d = pow( d, 0.25 ); 63 | vec3 col = vec3( d ); 64 | 65 | // fragColor = vec4( vec3(fragCoord.x,fragCoord.y,0.0), 1.0 ); 66 | fragColor = vec4( col, 1.0 ); 67 | } 68 | -------------------------------------------------------------------------------- /Mandelbrot-FRP-cabalized/Shaders/shader.vert: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec4 vPosition; 4 | layout(location = 1) in vec2 uvCoords; 5 | uniform float fTime; 6 | 7 | // Output data ; will be interpolated for each fragment. 8 | out vec2 fragCoord; 9 | out float time; 10 | 11 | void main() 12 | { 13 | gl_Position = vPosition; 14 | 15 | // The color of each vertex will be interpolated 16 | // to produce the color of each fragment 17 | fragCoord = uvCoords; 18 | time = fTime; 19 | } 20 | -------------------------------------------------------------------------------- /Mandelbrot-FRP-cabalized/output.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/Mandelbrot-FRP-cabalized/output.png -------------------------------------------------------------------------------- /Mandelbrot-FRP-cabalized/src/Graphics/RedViz/GLUtil.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Rendering 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD-3-Clause 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- Utilities for handling OpenGL buffers and rendering. 12 | -- 13 | -------------------------------------------------------------------------------- 14 | 15 | module Graphics.RedViz.GLUtil 16 | ( readTexture 17 | , texture2DWrap 18 | ) where 19 | 20 | import Graphics.RedViz.GLUtil.JuicyTextures (readTexture) 21 | import Graphics.RedViz.GLUtil.Textures (texture2DWrap) 22 | -------------------------------------------------------------------------------- /Mandelbrot-FRP-cabalized/src/Graphics/RedViz/GLUtil/JuicyTextures.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright: (c) 2012,2013 Anthony Cowley 3 | -------------------------------------------------------------------------------- 4 | 5 | {-# LANGUAGE CPP, RankNTypes #-} 6 | -- | Uses the @JuicyPixels@ package to load images that are then used 7 | -- to create OpenGL textuers. 8 | module Graphics.RedViz.GLUtil.JuicyTextures where 9 | 10 | import Codec.Picture (readImage, DynamicImage(..), Image(..)) 11 | import Codec.Picture.Types (convertImage) 12 | #if __GLASGOW_HASKELL__ < 710 13 | import Control.Applicative ((<$>)) 14 | #endif 15 | import Graphics.RedViz.GLUtil.Textures 16 | import Graphics.Rendering.OpenGL (TextureObject) 17 | 18 | -- | Load a 'TexInfo' value from an image file, and supply it to a 19 | -- user-provided function. Supported image formats include @png@, 20 | -- @jpeg@, @bmp@, and @gif@. See 'readTexture' for most uses. 21 | readTexInfo :: FilePath 22 | -> (forall a. IsPixelData a => TexInfo a -> IO b) 23 | -> IO (Either String b) 24 | readTexInfo f k = readImage f >>= either (return . Left) aux 25 | where aux (ImageY8 (Image w h p)) = Right <$> k (texInfo w h TexMono p) 26 | aux (ImageYF (Image w h p)) = Right <$> k (texInfo w h TexMono p) 27 | aux (ImageYA8 _) = return $ Left "YA format not supported" 28 | aux (ImageRGB8 (Image w h p)) = Right <$> k (texInfo w h TexRGB p) 29 | aux (ImageRGBF (Image w h p)) = Right <$> k (texInfo w h TexRGB p) 30 | aux (ImageRGBA8 (Image w h p)) = Right <$> k (texInfo w h TexRGBA p) 31 | aux (ImageYCbCr8 img) = aux . ImageRGB8 $ convertImage img 32 | aux _ = return $ Left "Unsupported image format" 33 | 34 | -- | Load a 'TextureObject' from an image file. Supported formats 35 | -- include @png@, @jpeg@, @bmp@, and @gif@. 36 | readTexture :: FilePath -> IO (Either String TextureObject) 37 | readTexture f = readTexInfo f loadTexture 38 | -------------------------------------------------------------------------------- /Mandelbrot-FRP-cabalized/test.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/Mandelbrot-FRP-cabalized/test.png -------------------------------------------------------------------------------- /Mandelbrot-FRP-io-sdl2-cabalized/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for Mandelbrot-FRP-io-sdl2-cabalized 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /Mandelbrot-FRP-io-sdl2-cabalized/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Vladimir Lopatin (c) 2017 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Vladimir Lopatin nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /Mandelbrot-FRP-io-sdl2-cabalized/Makefile: -------------------------------------------------------------------------------- 1 | default: 2 | ghc ./Main.hs -o Main 3 | 4 | run: 5 | make all 6 | gpu ./Main 7 | 8 | all: 9 | rm ./Main 10 | rm ./Main.o 11 | rm ./Main.hi 12 | ghc ./Main.hs -o Main 13 | -------------------------------------------------------------------------------- /Mandelbrot-FRP-io-sdl2-cabalized/Mandelbrot-FRP-io-sdl2-cabalized.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | name: Mandelbrot-FRP-io-sdl2-cabalized 3 | version: 0.1.0.0 4 | license: BSD-3-Clause 5 | license-file: LICENSE 6 | author: madiestic 7 | maintainer: madjestic13@gmail.com 8 | copyright: Vladimir Lopatin 9 | extra-source-files: CHANGELOG.md 10 | 11 | executable Mandelbrot 12 | main-is: Main.hs 13 | other-modules: 14 | Input 15 | , NGL.LoadShaders 16 | , Types 17 | -- Graphics.RedViz.GLUtil 18 | build-depends: base ^>=4.16.4.0 19 | , OpenGL 20 | , linear 21 | , array 22 | , bytestring 23 | , vector 24 | , JuicyPixels 25 | , text 26 | , Yampa 27 | , sdl2 28 | hs-source-dirs: app 29 | , src 30 | default-language: Haskell2010 31 | -------------------------------------------------------------------------------- /Mandelbrot-FRP-io-sdl2-cabalized/README.md: -------------------------------------------------------------------------------- 1 | An animated Mandelbrot example, using [FRP.Yampa](https://github.com/ivanperez-keera/Yampa) to handle animation loop and events, SDL2 is used for windows and input, OpenGL (NGL is Not a Graphics Library) is used for rendering. 2 | Shader-loading is handled by [Sven Panne's code](https://github.com/haskell-opengl/GLUT/blob/master/examples/RedBook8/common/LoadShaders.hs). 3 | Input handling is inspired and based on [Konstantin Zudov, Yampy Cube](https://github.com/zudov) presentation at Helsinki User Group. 4 | 5 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/Mandelbrot-FRP-io-sdl2/output.png) 6 | 7 | in order to run: 8 | 9 | ```bash 10 | $ make 11 | $ optirun -b primus ./Main 12 | ``` 13 | 14 | Controls: 15 | ``` 16 | space - zoom in 17 | q - reset 18 | ``` -------------------------------------------------------------------------------- /Mandelbrot-FRP-io-sdl2-cabalized/Shaders/shader.frag: -------------------------------------------------------------------------------- 1 | #version 450 2 | 3 | // Created by inigo quilez - iq/2013 4 | // License Creative Commons Attribution-NonCommercial-ShareAlike 3.0 Unported License. 5 | 6 | 7 | // This shader computes the distance to the Mandelbrot Set for everypixel, and colorizes 8 | // it accoringly. 9 | // 10 | // Z -> Z²+c, Z0 = 0. 11 | // therefore Z' -> 2·Z·Z' + 1 12 | // 13 | // The Hubbard-Douady potential G(c) is G(c) = log Z/2^n 14 | // G'(c) = Z'/Z/2^n 15 | // 16 | // So the distance is |G(c)|/|G'(c)| = |Z|·log|Z|/|Z'| 17 | // 18 | // More info here: http://www.iquilezles.org/www/articles/distancefractals/distancefractals.htm 19 | 20 | in vec2 fragCoord; 21 | // in float time; 22 | out vec4 fragColor; 23 | 24 | uniform float fTime; 25 | 26 | void main() 27 | { 28 | vec3 iResolution = vec3(1024, 1024, 1.0); 29 | float iGlobalTime = fTime; 30 | vec2 p = -3.0 + 5000.0 * fragCoord.xy / iResolution.xy; 31 | p.x *= iResolution.x/iResolution.y; 32 | 33 | // animation 34 | float tz = 0.5 + 0.5*(0.225*iGlobalTime); 35 | float zoo = pow( 0.5, 13.0*tz ); 36 | vec2 c = vec2(-0.05,.6805) + p*zoo; 37 | 38 | // iterate 39 | vec2 z = vec2(0.0); 40 | float m2 = 0.0; 41 | vec2 dz = vec2(0.0); 42 | for( int i=0; i<256; i++ ) 43 | { 44 | if( m2>1024.0 ) continue; 45 | 46 | // Z' -> 2·Z·Z' + 1 47 | dz = 2.0*vec2(z.x*dz.x-z.y*dz.y, z.x*dz.y + z.y*dz.x) + vec2(1.0,0.0); 48 | 49 | // Z -> Z² + c 50 | z = vec2( z.x*z.x - z.y*z.y, 2.0*z.x*z.y ) + c; 51 | 52 | m2 = dot(z,z); 53 | } 54 | 55 | // distance 56 | // d(c) = |Z|·log|Z|/|Z'| 57 | float d = 0.5*sqrt(dot(z,z)/dot(dz,dz))*log(dot(z,z)); 58 | 59 | 60 | // do some soft coloring based on distance 61 | d = clamp( 8.0*d/zoo, 0.0, 1.0 ); 62 | d = pow( d, 0.25 ); 63 | vec3 col = vec3( d ); 64 | 65 | // fragColor = vec4( vec3(fragCoord.x,fragCoord.y,0.0), 1.0 ); 66 | fragColor = vec4( col, 1.0 ); 67 | } 68 | -------------------------------------------------------------------------------- /Mandelbrot-FRP-io-sdl2-cabalized/Shaders/shader.vert: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec4 vPosition; 4 | layout(location = 1) in vec2 uvCoords; 5 | uniform float fTime; 6 | 7 | // Output data ; will be interpolated for each fragment. 8 | out vec2 fragCoord; 9 | out float time; 10 | 11 | void main() 12 | { 13 | gl_Position = vPosition; 14 | 15 | // The color of each vertex will be interpolated 16 | // to produce the color of each fragment 17 | fragCoord = uvCoords; 18 | time = fTime; 19 | } 20 | -------------------------------------------------------------------------------- /Mandelbrot-FRP-io-sdl2-cabalized/output.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/Mandelbrot-FRP-io-sdl2-cabalized/output.png -------------------------------------------------------------------------------- /Mandelbrot-FRP-io-sdl2-cabalized/src/Types.hs: -------------------------------------------------------------------------------- 1 | module Types where 2 | 3 | import FRP.Yampa 4 | 5 | import qualified SDL 6 | 7 | type WinInput = Event SDL.EventPayload 8 | -------------------------------------------------------------------------------- /Mandelbrot-FRP-io-sdl2/Makefile: -------------------------------------------------------------------------------- 1 | default: 2 | ghc ./Main.hs -o Main 3 | 4 | run: 5 | make all 6 | gpu ./Main 7 | 8 | all: 9 | rm ./Main 10 | rm ./Main.o 11 | rm ./Main.hi 12 | ghc ./Main.hs -o Main 13 | -------------------------------------------------------------------------------- /Mandelbrot-FRP-io-sdl2/README.md: -------------------------------------------------------------------------------- 1 | An animated Mandelbrot example, using [FRP.Yampa](https://github.com/ivanperez-keera/Yampa) to handle animation loop and events, SDL2 is used for windows and input, OpenGL (NGL is Not a Graphics Library) is used for rendering. 2 | Shader-loading is handled by [Sven Panne's code](https://github.com/haskell-opengl/GLUT/blob/master/examples/RedBook8/common/LoadShaders.hs). 3 | Input handling is inspired and based on [Konstantin Zudov, Yampy Cube](https://github.com/zudov) presentation at Helsinki User Group. 4 | 5 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/Mandelbrot-FRP-io-sdl2/output.png) 6 | 7 | in order to run: 8 | 9 | ```bash 10 | $ make 11 | $ optirun -b primus ./Main 12 | ``` 13 | 14 | Controls: 15 | ``` 16 | space - zoom in 17 | q - reset 18 | ``` -------------------------------------------------------------------------------- /Mandelbrot-FRP-io-sdl2/Shaders/shader.frag: -------------------------------------------------------------------------------- 1 | #version 450 2 | 3 | // Created by inigo quilez - iq/2013 4 | // License Creative Commons Attribution-NonCommercial-ShareAlike 3.0 Unported License. 5 | 6 | 7 | // This shader computes the distance to the Mandelbrot Set for everypixel, and colorizes 8 | // it accoringly. 9 | // 10 | // Z -> Z²+c, Z0 = 0. 11 | // therefore Z' -> 2·Z·Z' + 1 12 | // 13 | // The Hubbard-Douady potential G(c) is G(c) = log Z/2^n 14 | // G'(c) = Z'/Z/2^n 15 | // 16 | // So the distance is |G(c)|/|G'(c)| = |Z|·log|Z|/|Z'| 17 | // 18 | // More info here: http://www.iquilezles.org/www/articles/distancefractals/distancefractals.htm 19 | 20 | in vec2 fragCoord; 21 | // in float time; 22 | out vec4 fragColor; 23 | 24 | uniform float fTime; 25 | 26 | void main() 27 | { 28 | vec3 iResolution = vec3(1024, 1024, 1.0); 29 | float iGlobalTime = fTime; 30 | vec2 p = -3.0 + 5000.0 * fragCoord.xy / iResolution.xy; 31 | p.x *= iResolution.x/iResolution.y; 32 | 33 | // animation 34 | float tz = 0.5 + 0.5*(0.225*iGlobalTime); 35 | float zoo = pow( 0.5, 13.0*tz ); 36 | vec2 c = vec2(-0.05,.6805) + p*zoo; 37 | 38 | // iterate 39 | vec2 z = vec2(0.0); 40 | float m2 = 0.0; 41 | vec2 dz = vec2(0.0); 42 | for( int i=0; i<256; i++ ) 43 | { 44 | if( m2>1024.0 ) continue; 45 | 46 | // Z' -> 2·Z·Z' + 1 47 | dz = 2.0*vec2(z.x*dz.x-z.y*dz.y, z.x*dz.y + z.y*dz.x) + vec2(1.0,0.0); 48 | 49 | // Z -> Z² + c 50 | z = vec2( z.x*z.x - z.y*z.y, 2.0*z.x*z.y ) + c; 51 | 52 | m2 = dot(z,z); 53 | } 54 | 55 | // distance 56 | // d(c) = |Z|·log|Z|/|Z'| 57 | float d = 0.5*sqrt(dot(z,z)/dot(dz,dz))*log(dot(z,z)); 58 | 59 | 60 | // do some soft coloring based on distance 61 | d = clamp( 8.0*d/zoo, 0.0, 1.0 ); 62 | d = pow( d, 0.25 ); 63 | vec3 col = vec3( d ); 64 | 65 | // fragColor = vec4( vec3(fragCoord.x,fragCoord.y,0.0), 1.0 ); 66 | fragColor = vec4( col, 1.0 ); 67 | } 68 | -------------------------------------------------------------------------------- /Mandelbrot-FRP-io-sdl2/Shaders/shader.vert: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec4 vPosition; 4 | layout(location = 1) in vec2 uvCoords; 5 | uniform float fTime; 6 | 7 | // Output data ; will be interpolated for each fragment. 8 | out vec2 fragCoord; 9 | out float time; 10 | 11 | void main() 12 | { 13 | gl_Position = vPosition; 14 | 15 | // The color of each vertex will be interpolated 16 | // to produce the color of each fragment 17 | fragCoord = uvCoords; 18 | time = fTime; 19 | } 20 | -------------------------------------------------------------------------------- /Mandelbrot-FRP-io-sdl2/Types.hs: -------------------------------------------------------------------------------- 1 | module Types where 2 | 3 | import FRP.Yampa 4 | 5 | import qualified SDL 6 | 7 | type WinInput = Event SDL.EventPayload 8 | -------------------------------------------------------------------------------- /Mandelbrot-FRP-io-sdl2/output.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/Mandelbrot-FRP-io-sdl2/output.png -------------------------------------------------------------------------------- /Mandelbrot-FRP/Makefile: -------------------------------------------------------------------------------- 1 | default: 2 | ghc ./Main.hs -o Main 3 | 4 | run: 5 | make all 6 | gpu ./Main 7 | 8 | all: 9 | rm ./Main 10 | rm ./Main.o 11 | rm ./Main.hi 12 | ghc ./Main.hs -o Main 13 | -------------------------------------------------------------------------------- /Mandelbrot-FRP/README.md: -------------------------------------------------------------------------------- 1 | An animated Mandelbrot example, using [FRP.Yampa](https://github.com/ivanperez-keera/Yampa) to handle animation loop, GLFW-b is used for windows and event callbacks. 2 | Shader-loading is handled by [Sven Panne's code](https://github.com/haskell-opengl/GLUT/blob/master/examples/RedBook8/common/LoadShaders.hs). 3 | 4 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/Mandelbrot/output.png) 5 | 6 | in order to run: 7 | 8 | ```bash 9 | $ make 10 | $ optirun -b primus ./Main 11 | ``` -------------------------------------------------------------------------------- /Mandelbrot-FRP/Shaders/shader.frag: -------------------------------------------------------------------------------- 1 | #version 450 2 | 3 | // Created by inigo quilez - iq/2013 4 | // License Creative Commons Attribution-NonCommercial-ShareAlike 3.0 Unported License. 5 | 6 | 7 | // This shader computes the distance to the Mandelbrot Set for everypixel, and colorizes 8 | // it accoringly. 9 | // 10 | // Z -> Z²+c, Z0 = 0. 11 | // therefore Z' -> 2·Z·Z' + 1 12 | // 13 | // The Hubbard-Douady potential G(c) is G(c) = log Z/2^n 14 | // G'(c) = Z'/Z/2^n 15 | // 16 | // So the distance is |G(c)|/|G'(c)| = |Z|·log|Z|/|Z'| 17 | // 18 | // More info here: http://www.iquilezles.org/www/articles/distancefractals/distancefractals.htm 19 | 20 | in vec2 fragCoord; 21 | // in float time; 22 | out vec4 fragColor; 23 | 24 | uniform float fTime; 25 | 26 | void main() 27 | { 28 | vec3 iResolution = vec3(1024, 1024, 1.0); 29 | float iGlobalTime = fTime; 30 | vec2 p = -3.0 + 5000.0 * fragCoord.xy / iResolution.xy; 31 | p.x *= iResolution.x/iResolution.y; 32 | 33 | // animation 34 | float tz = 0.5 - 0.5*cos(0.225*iGlobalTime); 35 | float zoo = pow( 0.5, 13.0*tz ); 36 | vec2 c = vec2(-0.05,.6805) + p*zoo; 37 | 38 | // iterate 39 | vec2 z = vec2(0.0); 40 | float m2 = 0.0; 41 | vec2 dz = vec2(0.0); 42 | for( int i=0; i<256; i++ ) 43 | { 44 | if( m2>1024.0 ) continue; 45 | 46 | // Z' -> 2·Z·Z' + 1 47 | dz = 2.0*vec2(z.x*dz.x-z.y*dz.y, z.x*dz.y + z.y*dz.x) + vec2(1.0,0.0); 48 | 49 | // Z -> Z² + c 50 | z = vec2( z.x*z.x - z.y*z.y, 2.0*z.x*z.y ) + c; 51 | 52 | m2 = dot(z,z); 53 | } 54 | 55 | // distance 56 | // d(c) = |Z|·log|Z|/|Z'| 57 | float d = 0.5*sqrt(dot(z,z)/dot(dz,dz))*log(dot(z,z)); 58 | 59 | 60 | // do some soft coloring based on distance 61 | d = clamp( 8.0*d/zoo, 0.0, 1.0 ); 62 | d = pow( d, 0.25 ); 63 | vec3 col = vec3( d ); 64 | 65 | // fragColor = vec4( vec3(fragCoord.x,fragCoord.y,0.0), 1.0 ); 66 | fragColor = vec4( col, 1.0 ); 67 | } 68 | -------------------------------------------------------------------------------- /Mandelbrot-FRP/Shaders/shader.vert: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec4 vPosition; 4 | layout(location = 1) in vec2 uvCoords; 5 | uniform float fTime; 6 | 7 | // Output data ; will be interpolated for each fragment. 8 | out vec2 fragCoord; 9 | out float time; 10 | 11 | void main() 12 | { 13 | gl_Position = vPosition; 14 | 15 | // The color of each vertex will be interpolated 16 | // to produce the color of each fragment 17 | fragCoord = uvCoords; 18 | time = fTime; 19 | } 20 | -------------------------------------------------------------------------------- /Mandelbrot-FRP/output.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/Mandelbrot-FRP/output.png -------------------------------------------------------------------------------- /Mandelbrot.make/Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | make clean 3 | ghc ./Main.hs -o Main 4 | 5 | run: 6 | make all 7 | gpu ./Main 8 | 9 | clean: 10 | @if [ -f ./Main ];\ 11 | then\ 12 | rm ./Main 2> /dev/null;\ 13 | else\ 14 | echo "./Main already clean";\ 15 | fi 16 | -------------------------------------------------------------------------------- /Mandelbrot.make/NGL/Shape.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE InstanceSigs #-} 3 | 4 | module NGL.Shape where 5 | 6 | import Graphics.Rendering.OpenGL (Vertex4(..), 7 | TexCoord2(..), 8 | GLclampf(..)) 9 | 10 | 11 | data Shape = Square Point Side 12 | deriving Show 13 | 14 | type VertexArray =[Vertex4 Float] 15 | type UV =[TexCoord2 Float] 16 | type Point =(Float, Float) 17 | type Points =[Point] 18 | type Radius = Float 19 | type Side = Float 20 | type Divisions = Int 21 | type Texture = String 22 | 23 | type Drawable = ([Vertex4 Float],[TexCoord2 Float],String) 24 | 25 | toDrawable :: Shape -> Drawable 26 | toDrawable x = (vs, uv, tex) 27 | where 28 | vs' = toPoints x 29 | uv = map toTexCoord2 vs' 30 | vs = map toVertex4 $ vs' 31 | tex = "test.png" 32 | 33 | toPoints :: Shape -> [Point] 34 | toPoints (Square pos side) = square pos side 35 | 36 | toVertexArray :: [Point] -> VertexArray 37 | toVertexArray xs = map toVertex4 xs 38 | 39 | toVertex4 :: Point -> Vertex4 Float 40 | toVertex4 p = (\(k,l) -> Vertex4 k l 0 1) p 41 | 42 | toTextureCoord2 :: [Point] -> UV 43 | toTextureCoord2 xs = map (\(k,l) -> TexCoord2 k l) xs 44 | 45 | toTexCoord2 :: (a, a) -> TexCoord2 a 46 | toTexCoord2 p = (\(k,l) -> TexCoord2 k l) p 47 | 48 | data Projection = Planar 49 | deriving Show 50 | 51 | toUV :: Projection -> UV 52 | toUV Planar = toTextureCoord2 ps 53 | where ps = [(1.0, 1.0),( 0.0, 1.0),( 0.0, 0.0) 54 | ,(1.0, 1.0),( 0.0, 0.0),( 1.0, 0.0)]::Points 55 | 56 | square :: Point -> Float -> [Point] 57 | square pos side = [p1, p2, p3, 58 | p1, p3, p4] 59 | where 60 | x = fst pos 61 | y = snd pos 62 | r = side/2 63 | p1 = (x + r, y + r) 64 | p2 = (x - r, y + r) 65 | p3 = (x - r, y - r) 66 | p4 = (x + r, y - r) 67 | -------------------------------------------------------------------------------- /Mandelbrot.make/NGL/Texture.hs: -------------------------------------------------------------------------------- 1 | module Texture 2 | ( 3 | loadGLTextureFromFile, 4 | 5 | ) where 6 | 7 | import Graphics.Rendering.OpenGL 8 | import Graphics.GLUtil 9 | import Codec.Picture 10 | import qualified Graphics.Rendering.OpenGL as GL 11 | import qualified Graphics.GLUtil as GLU 12 | import qualified Codec.Picture as Pic 13 | 14 | loadGLTextureFromFile :: FilePath -> IO GL.TextureObject 15 | loadGLTextureFromFile f = do t <- either error id <$> readTexture f 16 | textureFilter Texture2D $= ((Linear', Nothing), Linear') 17 | texture2DWrap $= (Mirrored, ClampToEdge) 18 | return t 19 | -------------------------------------------------------------------------------- /Mandelbrot.make/NGL/Utils.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- | Module : Data 4 | -- | Copyright : (c) Vladimir Lopatin 2014 5 | -- | License : BSD3 6 | -- | 7 | -- | Maintainer : Vladimir Lopatin 8 | -- | Stability : experimental 9 | -- | Portability : untested 10 | -- | 11 | -- | Utils : utilities, helper functions 12 | -- | 13 | -------------------------------------------------------------------------------- 14 | 15 | module NGL.Utils where 16 | 17 | 18 | -- | Group list into indevidual pairs: [1,2,3,4] => [(1,2),(3,4)]. 19 | -- Works only with even number of elements 20 | pairs :: [t] -> [(t, t)] 21 | pairs [] = [] 22 | pairs [x] = error "Non-even list for pair function" 23 | pairs (x:y:xs) = (x,y):pairs xs 24 | 25 | -- | Undo pairs function 26 | fromPairs :: [(a, a)] -> [a] 27 | fromPairs [] = [] 28 | fromPairs ((x,y):xs) = x:y:fromPairs xs 29 | 30 | -- implement/bind delaunay somewhere here 31 | -------------------------------------------------------------------------------- /Mandelbrot.make/NGL/clean: -------------------------------------------------------------------------------- 1 | rm -rf ./*.hs~ 2 | rm -rf ./*.hi 3 | rm -rf ./*.o -------------------------------------------------------------------------------- /Mandelbrot.make/NGL/test.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/Mandelbrot.make/NGL/test.png -------------------------------------------------------------------------------- /Mandelbrot.make/README.md: -------------------------------------------------------------------------------- 1 | # Mandelbrot 2 | 3 | A simple [OpenGL](https://github.com/haskell-opengl) application, drawing a Mandebrot fractal, using make as a build system. 4 | 5 | ## Prerequisits: 6 | Hardware, supporting OpenGL >= 4.5 (because that's what my hardware is). 7 | Most likely the code will run with lesser OpenGL versions, but you will 8 | have to mess with the code. 9 | 10 | ## In order to run: 11 | ``` 12 | make 13 | ./Main 14 | # or, in case you are running a hybrid graphics like myself: 15 | make run # optirun -b primus ./Main 16 | 17 | ``` 18 | 19 | ## Output: 20 | ![](https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/master/Mandelbrot.make/output.png) -------------------------------------------------------------------------------- /Mandelbrot.make/Shaders/shader.frag: -------------------------------------------------------------------------------- 1 | #version 150 2 | 3 | // Created by inigo quilez - iq/2013 4 | // License Creative Commons Attribution-NonCommercial-ShareAlike 3.0 Unported License. 5 | 6 | 7 | // This shader computes the distance to the Mandelbrot Set for everypixel, and colorizes 8 | // it accoringly. 9 | // 10 | // Z -> Z²+c, Z0 = 0. 11 | // therefore Z' -> 2·Z·Z' + 1 12 | // 13 | // The Hubbard-Douady potential G(c) is G(c) = log Z/2^n 14 | // G'(c) = Z'/Z/2^n 15 | // 16 | // So the distance is |G(c)|/|G'(c)| = |Z|·log|Z|/|Z'| 17 | // 18 | // More info here: http://www.iquilezles.org/www/articles/distancefractals/distancefractals.htm 19 | 20 | in vec2 fragCoord; 21 | in float time; 22 | out vec4 fragColor; 23 | 24 | void main() 25 | { 26 | vec3 iResolution = vec3(1024, 1024, 1.0); 27 | float iGlobalTime = time; 28 | vec2 p = -3.0 + 5000.0 * fragCoord.xy / iResolution.xy; 29 | p.x *= iResolution.x/iResolution.y; 30 | 31 | // animation 32 | float tz = 0.5 - 0.5*cos(0.225*iGlobalTime); 33 | float zoo = pow( 0.5, 13.0*tz ); 34 | vec2 c = vec2(-0.05,.6805) + p*zoo; 35 | 36 | // iterate 37 | vec2 z = vec2(0.0); 38 | float m2 = 0.0; 39 | vec2 dz = vec2(0.0); 40 | for( int i=0; i<256; i++ ) 41 | { 42 | if( m2>1024.0 ) continue; 43 | 44 | // Z' -> 2·Z·Z' + 1 45 | dz = 2.0*vec2(z.x*dz.x-z.y*dz.y, z.x*dz.y + z.y*dz.x) + vec2(1.0,0.0); 46 | 47 | // Z -> Z² + c 48 | z = vec2( z.x*z.x - z.y*z.y, 2.0*z.x*z.y ) + c; 49 | 50 | m2 = dot(z,z); 51 | } 52 | 53 | // distance 54 | // d(c) = |Z|·log|Z|/|Z'| 55 | float d = 0.5*sqrt(dot(z,z)/dot(dz,dz))*log(dot(z,z)); 56 | 57 | 58 | // do some soft coloring based on distance 59 | d = clamp( 8.0*d/zoo, 0.0, 1.0 ); 60 | d = pow( d, 0.25 ); 61 | vec3 col = vec3( d ); 62 | 63 | // fragColor = vec4( vec3(fragCoord.x,fragCoord.y,0.0), 1.0 ); 64 | fragColor = vec4( col, 1.0 ); 65 | } 66 | -------------------------------------------------------------------------------- /Mandelbrot.make/Shaders/shader.vert: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec4 vPosition; 4 | layout(location = 1) in vec2 uvCoords; 5 | uniform float fTime; 6 | 7 | // Output data ; will be interpolated for each fragment. 8 | out vec2 fragCoord; 9 | out float time; 10 | 11 | void main() 12 | { 13 | gl_Position = vPosition; 14 | 15 | // The color of each vertex will be interpolated 16 | // to produce the color of each fragment 17 | fragCoord = uvCoords; 18 | time = fTime; 19 | } 20 | -------------------------------------------------------------------------------- /Mandelbrot.make/TinyMath/README.md: -------------------------------------------------------------------------------- 1 | TinyMath 2 | ======== 3 | 4 | A collection of mathematical hacks that I pick up in various ways, 5 | such as along MST124 course. 6 | -------------------------------------------------------------------------------- /Mandelbrot.make/output.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/Mandelbrot.make/output.png -------------------------------------------------------------------------------- /Mandelbrot/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Vladimir Lopatin (c) 2017 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Vladimir Lopatin nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /Mandelbrot/Mandelbrot.cabal: -------------------------------------------------------------------------------- 1 | name: Mandelbrot 2 | version: 0.1.0.0 3 | synopsis: A simple OpenGL application 4 | homepage: https://github.com/madjestic/Mandelbrot#readme 5 | license: BSD3 6 | license-file: LICENSE 7 | author: Vladimir Lopatin 8 | maintainer: madjestic13@gmail.com 9 | copyright: Vladimir Lopatin 10 | category: graphics 11 | build-type: Simple 12 | extra-source-files: README.md 13 | cabal-version: >=1.10 14 | 15 | -- To avoid duplicated efforts in documentation and dealing with the 16 | -- complications of embedding Haddock markup inside cabal files, it is 17 | -- common to point users to the README.md file. 18 | description: Please see the README on Github at 19 | 20 | library 21 | hs-source-dirs: src 22 | exposed-modules: LoadShaders 23 | build-depends: base >= 4.7 && < 5 24 | , bytestring >= 0.10.8.1 25 | , OpenGL >= 3.0 && < 4 26 | default-language: Haskell2010 27 | 28 | executable Mandelbrot 29 | hs-source-dirs: app 30 | main-is: Main.hs 31 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 32 | build-depends: base 33 | , GLFW-b 34 | , OpenGL >= 3.0 && < 4 35 | -- , GLUtil >= 0.9.2 36 | , GLUT >= 2.7.0.12 37 | , Mandelbrot 38 | default-language: Haskell2010 39 | 40 | test-suite Mandelbrot-test 41 | type: exitcode-stdio-1.0 42 | hs-source-dirs: test 43 | main-is: Spec.hs 44 | build-depends: base 45 | , Mandelbrot 46 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 47 | default-language: Haskell2010 48 | 49 | source-repository head 50 | type: git 51 | location: https://github.com/madjestic/Mandelbrot 52 | -------------------------------------------------------------------------------- /Mandelbrot/README.md: -------------------------------------------------------------------------------- 1 | # Mandelbrot 2 | 3 | A simple [OpenGL](https://github.com/haskell-opengl) application, drawing a Mandebrot fractal, using [stack](https://docs.haskellstack.org/en/stable/README/) as a build system. 4 | 5 | ## Prerequisits: 6 | Hardware, supporting OpenGL >= 4.5 (because that's what my hardware is). 7 | Most likely the code will run with lesser OpenGL versions, but you will 8 | have to mess with the code. 9 | 10 | ## In order to run: 11 | ``` 12 | stack build 13 | stack exec Mandelbrot 14 | # or, in case you are running a hybrid graphics like myself, use a launch script, e.g.: 15 | gpu ./run.sh 16 | 17 | ``` 18 | 19 | ## Output: 20 | ![](https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/master/Mandelbrot/output.png) 21 | -------------------------------------------------------------------------------- /Mandelbrot/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /Mandelbrot/Shaders/shader.frag: -------------------------------------------------------------------------------- 1 | #version 150 2 | 3 | // Created by inigo quilez - iq/2013 4 | // License Creative Commons Attribution-NonCommercial-ShareAlike 3.0 Unported License. 5 | 6 | 7 | // This shader computes the distance to the Mandelbrot Set for everypixel, and colorizes 8 | // it accoringly. 9 | // 10 | // Z -> Z²+c, Z0 = 0. 11 | // therefore Z' -> 2·Z·Z' + 1 12 | // 13 | // The Hubbard-Douady potential G(c) is G(c) = log Z/2^n 14 | // G'(c) = Z'/Z/2^n 15 | // 16 | // So the distance is |G(c)|/|G'(c)| = |Z|·log|Z|/|Z'| 17 | // 18 | // More info here: http://www.iquilezles.org/www/articles/distancefractals/distancefractals.htm 19 | 20 | in vec2 fragCoord; 21 | in float time; 22 | out vec4 fragColor; 23 | 24 | void main() 25 | { 26 | vec3 iResolution = vec3(1024, 1024, 1.0); 27 | float iGlobalTime = time; 28 | vec2 p = -3.0 + 5000.0 * fragCoord.xy / iResolution.xy; 29 | p.x *= iResolution.x/iResolution.y; 30 | 31 | // animation 32 | float tz = 0.5 - 0.5*cos(0.225*iGlobalTime); 33 | float zoo = pow( 0.5, 13.0*tz ); 34 | vec2 c = vec2(-0.05,.6805) + p*zoo; 35 | 36 | // iterate 37 | vec2 z = vec2(0.0); 38 | float m2 = 0.0; 39 | vec2 dz = vec2(0.0); 40 | for( int i=0; i<256; i++ ) 41 | { 42 | if( m2>1024.0 ) continue; 43 | 44 | // Z' -> 2·Z·Z' + 1 45 | dz = 2.0*vec2(z.x*dz.x-z.y*dz.y, z.x*dz.y + z.y*dz.x) + vec2(1.0,0.0); 46 | 47 | // Z -> Z² + c 48 | z = vec2( z.x*z.x - z.y*z.y, 2.0*z.x*z.y ) + c; 49 | 50 | m2 = dot(z,z); 51 | } 52 | 53 | // distance 54 | // d(c) = |Z|·log|Z|/|Z'| 55 | float d = 0.5*sqrt(dot(z,z)/dot(dz,dz))*log(dot(z,z)); 56 | 57 | 58 | // do some soft coloring based on distance 59 | d = clamp( 8.0*d/zoo, 0.0, 1.0 ); 60 | d = pow( d, 0.25 ); 61 | vec3 col = vec3( d ); 62 | 63 | // fragColor = vec4( vec3(fragCoord.x,fragCoord.y,0.0), 1.0 ); 64 | fragColor = vec4( col, 1.0 ); 65 | } 66 | -------------------------------------------------------------------------------- /Mandelbrot/Shaders/shader.vert: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec4 vPosition; 4 | layout(location = 1) in vec2 uvCoords; 5 | uniform float fTime; 6 | 7 | // Output data ; will be interpolated for each fragment. 8 | out vec2 fragCoord; 9 | out float time; 10 | 11 | void main() 12 | { 13 | gl_Position = vPosition; 14 | 15 | // The color of each vertex will be interpolated 16 | // to produce the color of each fragment 17 | fragCoord = uvCoords; 18 | time = fTime; 19 | } 20 | -------------------------------------------------------------------------------- /Mandelbrot/output.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/Mandelbrot/output.png -------------------------------------------------------------------------------- /Mandelbrot/run.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | stack exec Mandelbrot 4 | -------------------------------------------------------------------------------- /Mandelbrot/stack.yaml: -------------------------------------------------------------------------------- 1 | flags: {} 2 | packages: 3 | - . 4 | extra-deps: 5 | - GLFW-b-1.4.8.1 6 | - OpenGL-3.0.2.0 7 | - GLUtil-0.9.2 8 | - bytestring-0.10.8.1 9 | - GLUT-2.7.0.12 10 | resolver: lts-9.13 11 | -------------------------------------------------------------------------------- /MandelbrotViewer/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Vladimir Lopatin (c) 2017 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Vladimir Lopatin nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /MandelbrotViewer/MandelbrotYampa.cabal: -------------------------------------------------------------------------------- 1 | name: MandelbrotYampa 2 | version: 0.1.0.0 3 | synopsis: Short description of your package 4 | homepage: https://github.com/madjestic/MandelbrotYampa#readme 5 | license: BSD3 6 | license-file: LICENSE 7 | author: Vladimir Lopatin 8 | maintainer: madjestic13@gmail.com 9 | copyright: Vladimir Lopatin 10 | category: graphics 11 | build-type: Simple 12 | extra-source-files: README.md 13 | cabal-version: >=1.10 14 | 15 | -- To avoid duplicated efforts in documentation and dealing with the 16 | -- complications of embedding Haddock markup inside cabal files, it is 17 | -- common to point users to the README.md file. 18 | description: Please see the README on Github at 19 | 20 | library 21 | hs-source-dirs: src 22 | exposed-modules: LoadShaders 23 | , Input 24 | build-depends: base 25 | , bytestring 26 | , OpenGL 27 | , linear 28 | , sdl2 29 | , Yampa 30 | default-language: Haskell2010 31 | 32 | executable MandelbrotYampa 33 | hs-source-dirs: app 34 | main-is: Main.hs 35 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 36 | build-depends: base 37 | , linear 38 | , OpenGL 39 | , sdl2 40 | , text 41 | , Yampa 42 | , MandelbrotYampa 43 | default-language: Haskell2010 44 | 45 | test-suite MandelbrotYampa-test 46 | type: exitcode-stdio-1.0 47 | hs-source-dirs: test 48 | main-is: Spec.hs 49 | build-depends: base 50 | , MandelbrotYampa 51 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 52 | default-language: Haskell2010 53 | 54 | source-repository head 55 | type: git 56 | location: https://github.com/madjestic/MandelbrotYampa 57 | -------------------------------------------------------------------------------- /MandelbrotViewer/README.md: -------------------------------------------------------------------------------- 1 | # MandelbrotViewer 2 | 3 | A further development of [MandelbrotYampa](https://github.com/madjestic/Haskell-OpenGL-Tutorial/tree/master/MandelbrotYampa) with extended IO. 4 | 5 | ## Prerequisites: 6 | Hardware, supporting OpenGL >= 4.5 (because that's what my hardware is). 7 | Most likely the code will run with lesser OpenGL versions, but you will 8 | have to mess with the code. 9 | 10 | ## In order to run: 11 | ``` 12 | stack build 13 | stack exec Mandelbrot 14 | # or, in case you are running a hybrid graphics like myself, use a launch script, e.g.: 15 | gpu ./run.sh 16 | ( stack build && gpu ./run.sh ) 17 | 18 | ``` 19 | 20 | ## Controls: 21 | ``` 22 | Q - zoom in 23 | R - zoom out 24 | A,D,W,S - Left, Right, Up, Down 25 | Space - reset 26 | Escape - quit 27 | ``` 28 | 29 | ## Output: 30 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/MandelbrotYampa/output.png) 31 | 32 | ## Animated Output: 33 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/MandelbrotYampa/output.gif) 34 | -------------------------------------------------------------------------------- /MandelbrotViewer/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /MandelbrotViewer/Shaders/shader.frag: -------------------------------------------------------------------------------- 1 | #version 450 2 | 3 | // Created by inigo quilez - iq/2013 4 | // License Creative Commons Attribution-NonCommercial-ShareAlike 3.0 Unported License. 5 | 6 | 7 | // This shader computes the distance to the Mandelbrot Set for everypixel, and colorizes 8 | // it accoringly. 9 | // 10 | // Z -> Z²+c, Z0 = 0. 11 | // therefore Z' -> 2·Z·Z' + 1 12 | // 13 | // The Hubbard-Douady potential G(c) is G(c) = log Z/2^n 14 | // G'(c) = Z'/Z/2^n 15 | // 16 | // So the distance is |G(c)|/|G'(c)| = |Z|·log|Z|/|Z'| 17 | // 18 | // More info here: http://www.iquilezles.org/www/articles/distancefractals/distancefractals.htm 19 | 20 | in vec2 uv; 21 | // in float time; 22 | out vec4 fColor; 23 | 24 | uniform float fTime; 25 | 26 | void main() 27 | { 28 | vec3 iResolution = vec3(1024, 1024, 1.0); 29 | float iGlobalTime = fTime; 30 | vec2 p = -3.0 + 5000.0 * uv.xy / iResolution.xy; 31 | p.x *= iResolution.x/iResolution.y; 32 | 33 | // animation 34 | float tz = 0.5 + 0.5*(0.225*iGlobalTime); 35 | float zoo = pow( 0.5, 13.0*tz ); 36 | vec2 c = vec2(-0.05,.6805) + p*zoo; 37 | 38 | // iterate 39 | vec2 z = vec2(0.0); 40 | float m2 = 0.0; 41 | vec2 dz = vec2(0.0); 42 | for( int i=0; i<256; i++ ) 43 | { 44 | if( m2>1024.0 ) continue; 45 | 46 | // Z' -> 2·Z·Z' + 1 47 | dz = 2.0*vec2(z.x*dz.x-z.y*dz.y, z.x*dz.y + z.y*dz.x) + vec2(1.0,0.0); 48 | 49 | // Z -> Z² + c 50 | z = vec2( z.x*z.x - z.y*z.y, 2.0*z.x*z.y ) + c; 51 | 52 | m2 = dot(z,z); 53 | } 54 | 55 | // distance 56 | // d(c) = |Z|·log|Z|/|Z'| 57 | float d = 0.5*sqrt(dot(z,z)/dot(dz,dz))*log(dot(z,z)); 58 | 59 | 60 | // do some soft coloring based on distance 61 | d = clamp( 8.0*d/zoo, 0.0, 1.0 ); 62 | d = pow( d, 0.25 ); 63 | vec3 col = vec3( d ); 64 | 65 | fColor = vec4( col, 1.0 ); 66 | } 67 | -------------------------------------------------------------------------------- /MandelbrotViewer/Shaders/shader.vert: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec3 vPosition; 4 | layout(location = 1) in vec2 uvCoords; 5 | 6 | uniform float fTime; 7 | uniform mat4 transform; 8 | 9 | // Output data ; will be interpolated for each fragment. 10 | out vec2 uv; 11 | out float time; 12 | 13 | void main() 14 | { 15 | gl_Position = transform * vec4(vPosition, 1.0); 16 | 17 | // The color of each vertex will be interpolated 18 | // to produce the color of each fragment 19 | uv = uvCoords; 20 | time = fTime; 21 | } 22 | -------------------------------------------------------------------------------- /MandelbrotViewer/output.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/MandelbrotViewer/output.gif -------------------------------------------------------------------------------- /MandelbrotViewer/run.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | stack exec MandelbrotYampa 4 | -------------------------------------------------------------------------------- /MandelbrotViewer/stack.yaml: -------------------------------------------------------------------------------- 1 | flags: {} 2 | packages: 3 | - . 4 | extra-deps: 5 | - bytestring-0.10.8.1 6 | - linear-1.20.7 7 | - OpenGL-3.0.2.0 8 | - sdl2-2.3.0 9 | - text-1.2.2.2 10 | - Yampa-0.10.6 11 | resolver: lts-9.13 12 | -------------------------------------------------------------------------------- /MandelbrotViewer/test/Spec.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Test suite not yet implemented" 3 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Vladimir Lopatin (c) 2017 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Vladimir Lopatin nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /MandelbrotViewerDIG/README.md: -------------------------------------------------------------------------------- 1 | # MandelbrotViewer 2 | 3 | A further development of [MandelbrotYampa](https://github.com/madjestic/Haskell-OpenGL-Tutorial/tree/master/MandelbrotYampa) with extended IO. 4 | 5 | ## Prerequisites: 6 | Hardware, supporting OpenGL >= 4.5 (because that's what my hardware is). 7 | Most likely the code will run with lesser OpenGL versions, but you will 8 | have to mess with the code. 9 | 10 | ## In order to run: 11 | ``` 12 | stack build 13 | stack exec Mandelbrot 14 | # or, in case you are running a hybrid graphics like myself, use a launch script, e.g.: 15 | gpu ./run.sh 16 | ( stack build && gpu ./run.sh ) 17 | 18 | ``` 19 | 20 | ## Controls: 21 | ``` 22 | Q - zoom in 23 | R - zoom out 24 | A,D,W,S - Left, Right, Up, Down 25 | Space - reset 26 | Escape - quit 27 | ``` 28 | 29 | ## Output: 30 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/MandelbrotViewerDIG/output.png) 31 | 32 | ## Animated Output: 33 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/MandelbrotViewerDIG/output.gif) 34 | 35 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/Shaders/shader.frag: -------------------------------------------------------------------------------- 1 | #version 450 2 | 3 | // Created by inigo quilez - iq/2013 4 | // License Creative Commons Attribution-NonCommercial-ShareAlike 3.0 Unported License. 5 | 6 | 7 | // This shader computes the distance to the Mandelbrot Set for everypixel, and colorizes 8 | // it accoringly. 9 | // 10 | // Z -> Z²+c, Z0 = 0. 11 | // therefore Z' -> 2·Z·Z' + 1 12 | // 13 | // The Hubbard-Douady potential G(c) is G(c) = log Z/2^n 14 | // G'(c) = Z'/Z/2^n 15 | // 16 | // So the distance is |G(c)|/|G'(c)| = |Z|·log|Z|/|Z'| 17 | // 18 | // More info here: http://www.iquilezles.org/www/articles/distancefractals/distancefractals.htm 19 | 20 | in vec2 uv; 21 | // in float time; 22 | out vec4 fColor; 23 | 24 | uniform float fTime; 25 | 26 | void main() 27 | { 28 | vec3 iResolution = vec3(1024, 1024, 1.0); 29 | float iGlobalTime = fTime; 30 | vec2 p = -3.0 + 5000.0 * uv.xy / iResolution.xy; 31 | p.x *= iResolution.x/iResolution.y; 32 | 33 | // animation 34 | float tz = 0.5 + 0.5*(0.225*iGlobalTime); 35 | float zoo = pow( 0.5, 13.0*tz ); 36 | vec2 c = vec2(-0.05,.6805) + p*zoo; 37 | 38 | // iterate 39 | vec2 z = vec2(0.0); 40 | float m2 = 0.0; 41 | vec2 dz = vec2(0.0); 42 | for( int i=0; i<256; i++ ) 43 | { 44 | if( m2>1024.0 ) continue; 45 | 46 | // Z' -> 2·Z·Z' + 1 47 | dz = 2.0*vec2(z.x*dz.x-z.y*dz.y, z.x*dz.y + z.y*dz.x) + vec2(1.0,0.0); 48 | 49 | // Z -> Z² + c 50 | z = vec2( z.x*z.x - z.y*z.y, 2.0*z.x*z.y ) + c; 51 | 52 | m2 = dot(z,z); 53 | } 54 | 55 | // distance 56 | // d(c) = |Z|·log|Z|/|Z'| 57 | float d = 0.5*sqrt(dot(z,z)/dot(dz,dz))*log(dot(z,z)); 58 | 59 | 60 | // do some soft coloring based on distance 61 | d = clamp( 8.0*d/zoo, 0.0, 1.0 ); 62 | d = pow( d, 0.25 ); 63 | vec3 col = vec3( d ); 64 | 65 | fColor = vec4( col, 1.0 ); 66 | } 67 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/Shaders/shader.vert: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec3 vPosition; 4 | layout(location = 1) in vec2 uvCoords; 5 | 6 | uniform float fTime; 7 | uniform mat4 transform; 8 | 9 | // Output data ; will be interpolated for each fragment. 10 | out vec2 uv; 11 | out float time; 12 | 13 | void main() 14 | { 15 | gl_Position = transform * vec4(vPosition, 1.0); 16 | 17 | // The color of each vertex will be interpolated 18 | // to produce the color of each fragment 19 | uv = uvCoords; 20 | time = fTime; 21 | } 22 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/output.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/MandelbrotViewerDIG/output.gif -------------------------------------------------------------------------------- /MandelbrotViewerDIG/output.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/MandelbrotViewerDIG/output.png -------------------------------------------------------------------------------- /MandelbrotViewerDIG/src/Graphics/RedViz.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : RedViz 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD-3-Clause 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- The outermost library interface layer. 12 | -- 13 | -------------------------------------------------------------------------------- 14 | 15 | {-# LANGUAGE CPP #-} 16 | 17 | module Graphics.RedViz 18 | 19 | ( 20 | module Graphics.RedViz.Camera 21 | , module Graphics.RedViz.Controllable 22 | , module Graphics.RedViz.Descriptor 23 | , module Graphics.RedViz.Input.Keyboard 24 | , module Graphics.RedViz.Input.Mouse 25 | , module Graphics.RedViz.LoadShaders 26 | , module Graphics.RedViz.PGeo 27 | , module Graphics.RedViz.Project.Project 28 | , module Graphics.RedViz.Project.Model 29 | , module Graphics.RedViz.Project.Utils 30 | , module Graphics.RedViz.Rendering 31 | , module Graphics.RedViz.Utils 32 | , module Graphics.RedViz.VAO 33 | , module Graphics.RedViz.FromVector 34 | ) where 35 | 36 | import Graphics.RedViz.Camera 37 | import Graphics.RedViz.Controllable 38 | import Graphics.RedViz.Descriptor 39 | import Graphics.RedViz.Input.Keyboard 40 | import Graphics.RedViz.Input.Mouse 41 | import Graphics.RedViz.LoadShaders 42 | import Graphics.RedViz.PGeo 43 | import qualified Graphics.RedViz.Project.Project 44 | import Graphics.RedViz.Project.Model 45 | import Graphics.RedViz.Project.Utils 46 | import Graphics.RedViz.Rendering 47 | import Graphics.RedViz.Utils 48 | import Graphics.RedViz.VAO 49 | import Graphics.RedViz.FromVector 50 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/src/Graphics/RedViz/Controllable.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Camera 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD-3-Clause 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- A structure for a user-controllable object. 12 | -- 13 | -------------------------------------------------------------------------------- 14 | 15 | 16 | {-# LANGUAGE TemplateHaskell #-} 17 | {-# LANGUAGE FlexibleInstances #-} 18 | {-# LANGUAGE MultiParamTypeClasses #-} 19 | {-# LANGUAGE Arrows #-} 20 | {-# LANGUAGE LambdaCase #-} 21 | 22 | module Graphics.RedViz.Controllable 23 | ( Controllable (..) 24 | , Device (..) 25 | , Keyboard (..) 26 | , Mouse (..) 27 | , transform 28 | , ypr 29 | , yprS 30 | , vel 31 | , device 32 | , device' 33 | -- , mouse 34 | , keyboard 35 | ) where 36 | 37 | import Linear.Matrix 38 | import Linear.V3 39 | import Control.Lens hiding (transform) 40 | 41 | import Graphics.RedViz.Input.Keyboard 42 | import Graphics.RedViz.Input.Mouse 43 | import Graphics.RedViz.Utils () 44 | 45 | -- import Debug.Trace as DT 46 | 47 | data Controllable 48 | = Controller 49 | { 50 | _debug :: (Int, Int) 51 | , _transform :: M44 Double 52 | , _vel :: V3 Double -- velocity 53 | , _ypr :: V3 Double -- yaw/pitch/roll 54 | , _yprS :: V3 Double -- yaw/pitch/roll Sum 55 | , _device :: Device -- store as index in the proj file: 0 - keyboard, 1 - mouse, etc. 56 | } 57 | deriving Show 58 | 59 | data Device 60 | = Device 61 | { 62 | _keyboard :: Keyboard 63 | --, _mouse :: Mouse 64 | } deriving Show 65 | 66 | device' :: Lens' Controllable Device 67 | device' = lens _device (\controllable newDevice -> controllable { _device = newDevice }) 68 | 69 | $(makeLenses ''Device) 70 | $(makeLenses ''Controllable) 71 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/src/Graphics/RedViz/Descriptor.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Descriptor 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD-3-Clause 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- A basic structure for passing to graphics driver. 12 | -- 13 | -------------------------------------------------------------------------------- 14 | 15 | module Graphics.RedViz.Descriptor 16 | (Descriptor (..)) where 17 | 18 | import Graphics.Rendering.OpenGL (VertexArrayObject, NumArrayIndices) 19 | 20 | data Descriptor = 21 | Descriptor VertexArrayObject NumArrayIndices 22 | deriving Show 23 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/src/Graphics/RedViz/FromVector.hs: -------------------------------------------------------------------------------- 1 | module Graphics.RedViz.FromVector 2 | ( FromVector(..) 3 | ) where 4 | 5 | import Graphics.Rendering.OpenGL as GL hiding (Size, Position, Point, position) 6 | 7 | class FromVector a where 8 | toVertex4 :: a -> Vertex4 Double 9 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/src/Graphics/RedViz/GLUtil.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Rendering 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD-3-Clause 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- Utilities for handling OpenGL buffers and rendering. 12 | -- 13 | -------------------------------------------------------------------------------- 14 | 15 | module Graphics.RedViz.GLUtil 16 | ( readTexture 17 | , texture2DWrap 18 | ) where 19 | 20 | import Graphics.RedViz.GLUtil.JuicyTextures (readTexture) 21 | import Graphics.RedViz.GLUtil.Textures (texture2DWrap) 22 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/src/Graphics/RedViz/GLUtil/JuicyTextures.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright: (c) 2012,2013 Anthony Cowley 3 | -------------------------------------------------------------------------------- 4 | 5 | {-# LANGUAGE CPP, RankNTypes #-} 6 | -- | Uses the @JuicyPixels@ package to load images that are then used 7 | -- to create OpenGL textuers. 8 | module Graphics.RedViz.GLUtil.JuicyTextures where 9 | 10 | import Codec.Picture (readImage, DynamicImage(..), Image(..)) 11 | import Codec.Picture.Types (convertImage) 12 | #if __GLASGOW_HASKELL__ < 710 13 | import Control.Applicative ((<$>)) 14 | #endif 15 | import Graphics.RedViz.GLUtil.Textures 16 | import Graphics.Rendering.OpenGL (TextureObject) 17 | 18 | -- | Load a 'TexInfo' value from an image file, and supply it to a 19 | -- user-provided function. Supported image formats include @png@, 20 | -- @jpeg@, @bmp@, and @gif@. See 'readTexture' for most uses. 21 | readTexInfo :: FilePath 22 | -> (forall a. IsPixelData a => TexInfo a -> IO b) 23 | -> IO (Either String b) 24 | readTexInfo f k = readImage f >>= either (return . Left) aux 25 | where aux (ImageY8 (Image w h p)) = Right <$> k (texInfo w h TexMono p) 26 | aux (ImageYF (Image w h p)) = Right <$> k (texInfo w h TexMono p) 27 | aux (ImageYA8 _) = return $ Left "YA format not supported" 28 | aux (ImageRGB8 (Image w h p)) = Right <$> k (texInfo w h TexRGB p) 29 | aux (ImageRGBF (Image w h p)) = Right <$> k (texInfo w h TexRGB p) 30 | aux (ImageRGBA8 (Image w h p)) = Right <$> k (texInfo w h TexRGBA p) 31 | aux (ImageYCbCr8 img) = aux . ImageRGB8 $ convertImage img 32 | aux _ = return $ Left "Unsupported image format" 33 | 34 | -- | Load a 'TextureObject' from an image file. Supported formats 35 | -- include @png@, @jpeg@, @bmp@, and @gif@. 36 | readTexture :: FilePath -> IO (Either String TextureObject) 37 | readTexture f = readTexInfo f loadTexture 38 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/src/Graphics/RedViz/Input.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : RedViz 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD-3-Clause 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- The user input interface layer. 12 | -- 13 | -------------------------------------------------------------------------------- 14 | 15 | {-# LANGUAGE CPP #-} 16 | 17 | module Graphics.RedViz.Input 18 | ( 19 | module Graphics.RedViz.Input.FRP.Yampa 20 | , module Graphics.RedViz.Input.Mouse 21 | , module Graphics.RedViz.Input.Keyboard 22 | 23 | ) where 24 | 25 | import Graphics.RedViz.Input.Mouse 26 | import Graphics.RedViz.Input.Keyboard 27 | import Graphics.RedViz.Input.FRP.Yampa 28 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/src/Graphics/RedViz/Input/FRP/Yampa.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : RedViz 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD-3-Clause 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- The user input interface Yampa layer. 12 | -- 13 | -------------------------------------------------------------------------------- 14 | 15 | {-# LANGUAGE CPP #-} 16 | 17 | module Graphics.RedViz.Input.FRP.Yampa 18 | ( 19 | module Graphics.RedViz.Input.FRP.Yampa.AppInput 20 | ) where 21 | 22 | import Graphics.RedViz.Input.FRP.Yampa.AppInput 23 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/src/Graphics/RedViz/Input/FRP/Yampa/Update.hs: -------------------------------------------------------------------------------- 1 | module Graphics.RedViz.Input.FRP.Yampa.Update 2 | ( updateMouse 3 | , updateKeyboard 4 | ) where 5 | 6 | import Graphics.RedViz.Input.FRP.Yampa.Update.Mouse 7 | import Graphics.RedViz.Input.FRP.Yampa.Update.Keyboard 8 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/src/Graphics/RedViz/Input/FRP/Yampa/Update/Mouse.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | module Graphics.RedViz.Input.FRP.Yampa.Update.Mouse 4 | ( updateMouse 5 | ) where 6 | 7 | import FRP.Yampa 8 | 9 | import Graphics.RedViz.Input.FRP.Yampa.AppInput 10 | import Graphics.RedViz.Input.Mouse 11 | 12 | -- import Debug.Trace as DT 13 | 14 | updateMouse :: SF AppInput (Mouse, Event [(Int, Int)]) 15 | updateMouse = 16 | proc input -> do 17 | lmbE <- lbpPos -< input 18 | rmbE <- rbpPos -< input 19 | mmovE <- mouseMoving -< input 20 | 21 | mpos' <- mousePos -< input 22 | rpos' <- mouseRelPos -< input 23 | 24 | let 25 | events = catEvents [lmbE, rmbE, mmovE] 26 | mouse' = 27 | Mouse 28 | (case isEvent lmbE of 29 | True -> Just $ fromEvent lmbE 30 | _ -> Nothing) 31 | (case isEvent rmbE of 32 | True -> Just $ fromEvent rmbE 33 | _ -> Nothing) 34 | mpos' 35 | --(DT.trace ("mpos' : " ++ show mpos') mpos') 36 | rpos' 37 | (isEvent mmovE) 38 | [] 39 | returnA -< (mouse', events) 40 | 41 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/src/Graphics/RedViz/Input/Keyboard.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Keyboard 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD-3-Clause 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- A basic keyboard control structure. 12 | -- 13 | -------------------------------------------------------------------------------- 14 | module Graphics.RedViz.Input.Keyboard 15 | ( Keyboard (..) 16 | , Keys (..) 17 | ) where 18 | 19 | import Linear.V3 20 | 21 | data Keyboard 22 | = Keyboard 23 | { -- | Keyboard State 24 | keys :: Keys 25 | , keyVecs :: [V3 Double] 26 | } deriving Show 27 | 28 | data Keys = 29 | Keys 30 | { keyW :: Bool 31 | , keyS :: Bool 32 | , keyA :: Bool 33 | , keyD :: Bool 34 | , keyQ :: Bool 35 | , keyE :: Bool 36 | , keyZ :: Bool 37 | , keyC :: Bool 38 | , keyUp :: Bool 39 | , keyDown :: Bool 40 | , keyLeft :: Bool 41 | , keyRight :: Bool 42 | , keyPageUp :: Bool 43 | , keyPageDown :: Bool 44 | , keyLShift :: Bool 45 | , keyLCtrl :: Bool 46 | , keyLAlt :: Bool 47 | } deriving Show 48 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/src/Graphics/RedViz/Input/Mouse.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Mouse 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD-3-Clause 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- A basic mouse control structure. 12 | -- 13 | -------------------------------------------------------------------------------- 14 | 15 | 16 | {-# LANGUAGE TemplateHaskell, Arrows #-} 17 | 18 | module Graphics.RedViz.Input.Mouse 19 | ( Mouse (..) 20 | , pos 21 | , rpos 22 | , mmov 23 | ) where 24 | 25 | import Control.Lens 26 | 27 | import Linear.V3 28 | 29 | data Mouse 30 | = Mouse 31 | { -- | Mouse State 32 | _lmb :: Maybe (Int, Int) 33 | , _rmb :: Maybe (Int, Int) 34 | , _pos :: (Int, Int) 35 | , _rpos :: (Int, Int) 36 | , _mmov :: Bool 37 | , mVecs :: [V3 Int] 38 | } deriving Show 39 | 40 | $(makeLenses ''Mouse) 41 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/src/Graphics/RedViz/Object.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | module Graphics.RedViz.Object 4 | ( Object' (..) 5 | , descriptors 6 | , materials 7 | , programs 8 | , transforms 9 | , transform0 10 | , transform1 11 | , ypr0 12 | , ypr 13 | , time 14 | , options 15 | , defaultObject' 16 | , name 17 | ) where 18 | 19 | import Control.Lens hiding (transform, pre) 20 | import Graphics.Rendering.OpenGL (Program) 21 | import Linear.Matrix 22 | import Linear.V3 23 | 24 | import Graphics.RedViz.Descriptor 25 | import Graphics.RedViz.Material hiding (name, _name) 26 | import Graphics.RedViz.Backend 27 | 28 | data Object' 29 | = Object' 30 | { 31 | _name :: String 32 | , _descriptors :: [Descriptor] -- | Material is bound in Descriptor, but we also use this data for draw-call separation per material. 33 | -- data Descriptor = 34 | -- Descriptor VertexArrayObject NumArrayIndices 35 | , _materials :: [Material] -- | hence [Material] is present on the Object level too, we use that value, instead of looking it up from respective VGeo. 36 | , _programs :: [Program] -- | Shader Programs 37 | , _transforms :: ![M44 Double] -- | transforms for parts (object fragments) 38 | , _transform0 :: !(M44 Double) -- | initial basis (position/orientation in world space) 39 | , _transform1 :: !(M44 Double) -- | basis (position/orientation in world space) 40 | , _ypr0 :: !(V3 Double) 41 | , _ypr :: !(V3 Double) 42 | , _time :: Double 43 | , _options :: BackendOptions 44 | } deriving Show 45 | $(makeLenses ''Object') 46 | 47 | zeroV3 :: V3 Double 48 | zeroV3 = V3 0 0 0 49 | 50 | -- defaultObject' :: Object' 51 | -- defaultObject' = Object' [] [] [] [] (identity::M44 Double) zeroV3 zeroV3 0.0 52 | defaultObject' :: Object' 53 | defaultObject' = 54 | Object' 55 | { 56 | _descriptors = [] 57 | , _materials = [] 58 | , _programs = [] 59 | , _transforms = [] 60 | , _transform0 = identity :: M44 Double 61 | , _transform1 = identity :: M44 Double 62 | , _ypr0 = zeroV3 63 | , _ypr = zeroV3 64 | , _time = 0.0 65 | , _options = defaultBackendOptions 66 | , _name = "defaultObject'" 67 | } 68 | 69 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/src/Graphics/RedViz/Primitives.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Primitives 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD-3-Clause 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- Primitive drawable structures. 12 | -- 13 | -------------------------------------------------------------------------------- 14 | 15 | {-# LANGUAGE TemplateHaskell #-} 16 | 17 | module Graphics.RedViz.Primitives where 18 | 19 | --import Linear.V3 as LV3 20 | 21 | data Primitive = 22 | Curve 23 | deriving Show 24 | 25 | -- polyline :: [V3 Double] -> Float -> [V3 Double] 26 | -- polyline ps w = concatMap (\(x,y) -> line x y w) $ pairs $ abbcca ps 27 | 28 | -- line :: V3 Double -> V3 Double -> Float -> [V3 Double] 29 | -- line (x1,y1) (x2,y2) w = map (addVectors (x1,y1)) $ rotate2D' theta $ rect (0.0,-w/2) (len,w/2) -- rotation is wrong 30 | -- where 31 | -- (x,y) = normalize $ ((x2-x1),(y2-y1)) 32 | -- theta = signum y * acos x -- | angle in radians 33 | -- len = sqrt((x2-x1)^2+ (y2-y1)^2) 34 | 35 | -- abbcca :: [a] -> [a] 36 | -- abbcca (x:xs) = [x] ++ (concat $ map (\(x,y) -> [x,y]) $ map (\x -> (x, x)) (init xs)) ++ [last xs] 37 | 38 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/src/Graphics/RedViz/Project.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module Graphics.RedViz.Project 3 | ( module Graphics.RedViz.Project.Project 4 | , module Graphics.RedViz.Project.Model 5 | ) where 6 | 7 | import Graphics.RedViz.Project.Project 8 | import Graphics.RedViz.Project.Model 9 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/src/Graphics/RedViz/Project/GUI.hs: -------------------------------------------------------------------------------- 1 | -- {-# LANGUAGE TemplateHaskell #-} 2 | 3 | -- module Graphics.RedViz.Project.GUI 4 | -- ( GUI (..) 5 | -- ) where 6 | 7 | -- data GUI = 8 | -- GUI 9 | -- { 10 | -- -- _fonts :: [Object] 11 | -- -- , _icons :: [Object] 12 | -- -- , _widgets :: [Widget] 13 | -- -- , _widgets :: [Object] -- TODO: think about a widget set? 14 | -- } deriving Show 15 | -- $(makeLenses ''GUI) 16 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/src/Graphics/RedViz/Project/Model.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | module Graphics.RedViz.Project.Model 4 | ( Model (..) 5 | , path 6 | ) where 7 | 8 | import Control.Lens 9 | import Data.Aeson 10 | import Data.Aeson.TH 11 | 12 | 13 | data Model 14 | = Model 15 | { 16 | _path :: String 17 | } deriving Show 18 | 19 | $(makeLenses ''Model) 20 | deriveJSON defaultOptions {fieldLabelModifier = drop 1} ''Model 21 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/src/Graphics/RedViz/Project/Utils.hs: -------------------------------------------------------------------------------- 1 | module Graphics.RedViz.Project.Utils 2 | ( fromProjectCamera 3 | ) where 4 | 5 | import Linear.V3 6 | 7 | import Graphics.RedViz.Project.Project 8 | import Graphics.RedViz.Camera 9 | import Graphics.RedViz.Controllable 10 | import Graphics.RedViz.Utils 11 | 12 | 13 | -- TODO: pass prj resolution to camera 14 | fromProjectCamera :: Project -> ProjectCamera -> Camera 15 | fromProjectCamera prj0 pcam = 16 | defaultCam 17 | { 18 | _apt = _pApt pcam 19 | , _foc = _pFoc pcam 20 | , _controller = 21 | defaultCamController 22 | { _transform = fromList ( Just $ _pTransform pcam) } 23 | , _mouseS = pure $ _pMouseS pcam :: V3 Double 24 | , _keyboardRS = pure $ _pKeyboardRS pcam :: V3 Double 25 | , _keyboardTS = pure $ _pKeyboardTS pcam :: V3 Double 26 | , _res = (_resx prj0, _resy prj0) 27 | , _scale = 1.0 :: Double 28 | } 29 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/src/Graphics/RedViz/Texture.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Texture 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD3 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- Utilities for texture handling. 12 | -- 13 | -------------------------------------------------------------------------------- 14 | 15 | {-# LANGUAGE TemplateHaskell #-} 16 | 17 | module Graphics.RedViz.Texture 18 | ( Texture (..) 19 | , name 20 | , path 21 | , uuid 22 | , defaultTexture 23 | ) where 24 | 25 | import Control.Lens 26 | import Data.Aeson 27 | import Data.Aeson.Encode.Pretty 28 | import Data.Aeson.TH 29 | import Data.UUID 30 | import Data.Text hiding (drop) 31 | 32 | import Graphics.RedViz.Utils (encodeStringUUID) 33 | 34 | data Texture 35 | = Texture 36 | { -- | Binding name in a shader. 37 | _name :: String 38 | -- | A filepath to an image file location on disk, relative to project root. 39 | , _path :: FilePath -- TODO: replace with Maybe FilePath or Either (FilePath or Generated, maybe a formula?) 40 | -- | A unique object (texture) ID. 41 | , _uuid :: UUID 42 | } deriving Show 43 | $(makeLenses ''Texture) 44 | deriveJSON defaultOptions {fieldLabelModifier = drop 1} ''Texture 45 | 46 | instance Eq Texture where 47 | t0 == t1 = view uuid t0 == view uuid t1 48 | 49 | instance Ord Texture where 50 | compare t0 t1 = compare (view uuid t0) (view uuid t1) 51 | 52 | -- | A default Texture type constructor. 53 | defaultTexture :: Texture 54 | defaultTexture 55 | = Texture 56 | "checkerboard" 57 | "./textures/checkerboard.png" 58 | (encodeStringUUID "./textures/checkerboard.png") 59 | 60 | comp :: Text -> Text -> Ordering 61 | comp = keyOrder . fmap pack $ ["name", "path", "uuid"] 62 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/src/Graphics/RedViz/VAO.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : RedViz 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD-3-Clause 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- The tooling around Vertex Array Objects 12 | -- 13 | -------------------------------------------------------------------------------- 14 | 15 | module Graphics.RedViz.VAO 16 | ( 17 | VAO 18 | , toVAO 19 | , VAO' 20 | , SVAO' 21 | , toVAO' 22 | , toVAO'' 23 | ) where 24 | 25 | import Data.Massiv.Array as A 26 | import GHC.Float 27 | 28 | import Graphics.RedViz.Utils 29 | 30 | -- import Debug.Trace as DT 31 | 32 | type VAO = [[[Float]]] 33 | 34 | toVAO 35 | :: [[Int]] 36 | -> [Float] 37 | -> [(Double, Double, Double)] 38 | -> [(Double, Double, Double)] 39 | -> [(Double, Double, Double)] 40 | -> [(Double, Double, Double)] 41 | -> VAO 42 | 43 | toVAO idxs as cds ns ts ps = vaos 44 | where 45 | as' = fmap (\a -> [a]) as :: [[Float]] 46 | cds' = fmap (\(r,g,b) -> fmap double2Float [r,g,b]) cds :: [[Float]] 47 | ns' = fmap (\(x,y,z) -> fmap double2Float [x,y,z]) ns 48 | ts' = fmap (\(u,v,w) -> fmap double2Float [u,v,w]) ts 49 | ps' = fmap (\(x,y,z) -> fmap double2Float [x,y,z]) ps 50 | 51 | indices = fromLists' Par idxs :: (Array U Ix2 Int) 52 | as'' = fromLists' Par as' :: (Array U Ix2 Float) 53 | cds''= fromLists' Par cds' :: (Array U Ix2 Float) 54 | ns'' = fromLists' Par ns' :: (Array U Ix2 Float) 55 | ts'' = fromLists' Par ts' :: (Array U Ix2 Float) 56 | ps'' = fromLists' Par ps' :: (Array U Ix2 Float) 57 | 58 | cList' = toLists2 . computeAs U $ concat' 1 [as'', cds'', ns'', ts'', ps''] :: [[Float]] 59 | 60 | ar = fromLists' Par cList' :: (Array U Ix2 Float) 61 | cListOpt = 62 | toLists2 . computeAs P <$> 63 | fmap (\row -> backpermute' (Sz (Prelude.length (idxs !! row) :. 13)) (\(i :. j) -> ((indices !> row) ! i) :. j) ar) [0 .. div (elemsCount indices) (elemsCount (indices !> 0))-1] 64 | --vaos = (DT.trace ("cListOpt" ++ show cListOpt) $ cListOpt) 65 | vaos = cListOpt 66 | 67 | type VAO' = [([Int], Int, [Float])] 68 | type SVAO' = ([Int], Int, [Float]) 69 | 70 | toVAO' :: [[Int]] -> [Int] -> [[Float]] -> VAO' 71 | toVAO' is_ st_ vs_ = (,,) <$.> is_ <*.> st_ <*.> vs_ 72 | 73 | toVAO'' :: [Int] -> Int -> [Float] -> SVAO' 74 | toVAO'' = (,,) 75 | 76 | -------------------------------------------------------------------------------- /MandelbrotViewerDIG/test/Spec.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Test suite not yet implemented" 3 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Vladimir Lopatin (c) 2017 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Vladimir Lopatin nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/README.md: -------------------------------------------------------------------------------- 1 | # MandelbrotViewer 2 | 3 | A further development of [MandelbrotYampa](https://github.com/madjestic/Haskell-OpenGL-Tutorial/tree/master/MandelbrotYampa) with extended IO. 4 | 5 | ## Prerequisites: 6 | Hardware, supporting OpenGL >= 4.5 (because that's what my hardware is). 7 | Most likely the code will run with lesser OpenGL versions, but you will 8 | have to mess with the code. 9 | 10 | ## In order to run: 11 | ``` 12 | stack build 13 | stack exec Mandelbrot 14 | # or, in case you are running a hybrid graphics like myself, use a launch script, e.g.: 15 | gpu ./run.sh 16 | ( stack build && gpu ./run.sh ) 17 | 18 | ``` 19 | 20 | ## Controls: 21 | ``` 22 | Q - zoom in 23 | R - zoom out 24 | A,D,W,S - Left, Right, Up, Down 25 | Space - reset 26 | Escape - quit 27 | ``` 28 | 29 | ## Output: 30 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/MandelbrotViewerDIG/output.png) 31 | 32 | ## Animated Output: 33 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/MandelbrotViewerDIG/output.gif) 34 | 35 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/Shaders/shader.frag: -------------------------------------------------------------------------------- 1 | #version 450 2 | 3 | // Created by inigo quilez - iq/2013 4 | // License Creative Commons Attribution-NonCommercial-ShareAlike 3.0 Unported License. 5 | 6 | 7 | // This shader computes the distance to the Mandelbrot Set for everypixel, and colorizes 8 | // it accoringly. 9 | // 10 | // Z -> Z²+c, Z0 = 0. 11 | // therefore Z' -> 2·Z·Z' + 1 12 | // 13 | // The Hubbard-Douady potential G(c) is G(c) = log Z/2^n 14 | // G'(c) = Z'/Z/2^n 15 | // 16 | // So the distance is |G(c)|/|G'(c)| = |Z|·log|Z|/|Z'| 17 | // 18 | // More info here: http://www.iquilezles.org/www/articles/distancefractals/distancefractals.htm 19 | 20 | in vec2 uv; 21 | // in float time; 22 | out vec4 fColor; 23 | 24 | uniform float fTime; 25 | 26 | void main() 27 | { 28 | vec3 iResolution = vec3(1024, 1024, 1.0); 29 | float iGlobalTime = fTime; 30 | vec2 p = -3.0 + 5000.0 * uv.xy / iResolution.xy; 31 | p.x *= iResolution.x/iResolution.y; 32 | 33 | // animation 34 | float tz = 0.5 + 0.5*(0.225*iGlobalTime); 35 | float zoo = pow( 0.5, 13.0*tz ); 36 | vec2 c = vec2(-0.05,.6805) + p*zoo; 37 | 38 | // iterate 39 | vec2 z = vec2(0.0); 40 | float m2 = 0.0; 41 | vec2 dz = vec2(0.0); 42 | for( int i=0; i<256; i++ ) 43 | { 44 | if( m2>1024.0 ) continue; 45 | 46 | // Z' -> 2·Z·Z' + 1 47 | dz = 2.0*vec2(z.x*dz.x-z.y*dz.y, z.x*dz.y + z.y*dz.x) + vec2(1.0,0.0); 48 | 49 | // Z -> Z² + c 50 | z = vec2( z.x*z.x - z.y*z.y, 2.0*z.x*z.y ) + c; 51 | 52 | m2 = dot(z,z); 53 | } 54 | 55 | // distance 56 | // d(c) = |Z|·log|Z|/|Z'| 57 | float d = 0.5*sqrt(dot(z,z)/dot(dz,dz))*log(dot(z,z)); 58 | 59 | 60 | // do some soft coloring based on distance 61 | d = clamp( 8.0*d/zoo, 0.0, 1.0 ); 62 | d = pow( d, 0.25 ); 63 | vec3 col = vec3( d ); 64 | 65 | fColor = vec4( col, 1.0 ); 66 | } 67 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/Shaders/shader.vert: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec3 vPosition; 4 | layout(location = 1) in vec2 uvCoords; 5 | 6 | uniform float fTime; 7 | uniform mat4 transform; 8 | 9 | // Output data ; will be interpolated for each fragment. 10 | out vec2 uv; 11 | out float time; 12 | 13 | void main() 14 | { 15 | gl_Position = transform * vec4(vPosition, 1.0); 16 | 17 | // The color of each vertex will be interpolated 18 | // to produce the color of each fragment 19 | uv = uvCoords; 20 | time = fTime; 21 | } 22 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/imgui.ini: -------------------------------------------------------------------------------- 1 | [Window][Debug##Default] 2 | Pos=60,60 3 | Size=400,400 4 | Collapsed=0 5 | 6 | [Window][Hello, ImGui!] 7 | Pos=60,60 8 | Size=122,71 9 | Collapsed=0 10 | 11 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/output.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/MandelbrotViewerDIGRes/output.gif -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/output.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/MandelbrotViewerDIGRes/output.png -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/src/Graphics/RedViz.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : RedViz 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD-3-Clause 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- The outermost library interface layer. 12 | -- 13 | -------------------------------------------------------------------------------- 14 | 15 | {-# LANGUAGE CPP #-} 16 | 17 | module Graphics.RedViz 18 | 19 | ( 20 | module Graphics.RedViz.Camera 21 | , module Graphics.RedViz.Controllable 22 | , module Graphics.RedViz.Descriptor 23 | , module Graphics.RedViz.Input.Keyboard 24 | , module Graphics.RedViz.Input.Mouse 25 | , module Graphics.RedViz.LoadShaders 26 | , module Graphics.RedViz.PGeo 27 | , module Graphics.RedViz.Project.Project 28 | , module Graphics.RedViz.Project.Model 29 | , module Graphics.RedViz.Project.Utils 30 | , module Graphics.RedViz.Rendering 31 | , module Graphics.RedViz.Utils 32 | , module Graphics.RedViz.VAO 33 | , module Graphics.RedViz.FromVector 34 | ) where 35 | 36 | import Graphics.RedViz.Camera 37 | import Graphics.RedViz.Controllable 38 | import Graphics.RedViz.Descriptor 39 | import Graphics.RedViz.Input.Keyboard 40 | import Graphics.RedViz.Input.Mouse 41 | import Graphics.RedViz.LoadShaders 42 | import Graphics.RedViz.PGeo 43 | import qualified Graphics.RedViz.Project.Project 44 | import Graphics.RedViz.Project.Model 45 | import Graphics.RedViz.Project.Utils 46 | import Graphics.RedViz.Rendering 47 | import Graphics.RedViz.Utils 48 | import Graphics.RedViz.VAO 49 | import Graphics.RedViz.FromVector 50 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/src/Graphics/RedViz/Controllable.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Camera 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD-3-Clause 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- A structure for a user-controllable object. 12 | -- 13 | -------------------------------------------------------------------------------- 14 | 15 | 16 | {-# LANGUAGE TemplateHaskell #-} 17 | {-# LANGUAGE FlexibleInstances #-} 18 | {-# LANGUAGE MultiParamTypeClasses #-} 19 | {-# LANGUAGE Arrows #-} 20 | {-# LANGUAGE LambdaCase #-} 21 | 22 | module Graphics.RedViz.Controllable 23 | ( Controllable (..) 24 | , Device (..) 25 | , Keyboard (..) 26 | , Mouse (..) 27 | , transform 28 | , ypr 29 | , yprS 30 | , vel 31 | , device 32 | , device' 33 | -- , mouse 34 | , keyboard 35 | ) where 36 | 37 | import Linear.Matrix 38 | import Linear.V3 39 | import Control.Lens hiding (transform) 40 | 41 | import Graphics.RedViz.Input.Keyboard 42 | import Graphics.RedViz.Input.Mouse 43 | import Graphics.RedViz.Utils () 44 | 45 | -- import Debug.Trace as DT 46 | 47 | data Controllable 48 | = Controller 49 | { 50 | _debug :: (Int, Int) 51 | , _transform :: M44 Double 52 | , _vel :: V3 Double -- velocity 53 | , _ypr :: V3 Double -- yaw/pitch/roll 54 | , _yprS :: V3 Double -- yaw/pitch/roll Sum 55 | , _device :: Device -- store as index in the proj file: 0 - keyboard, 1 - mouse, etc. 56 | } 57 | deriving Show 58 | 59 | data Device 60 | = Device 61 | { 62 | _keyboard :: Keyboard 63 | --, _mouse :: Mouse 64 | } deriving Show 65 | 66 | device' :: Lens' Controllable Device 67 | device' = lens _device (\controllable newDevice -> controllable { _device = newDevice }) 68 | 69 | $(makeLenses ''Device) 70 | $(makeLenses ''Controllable) 71 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/src/Graphics/RedViz/Descriptor.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Descriptor 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD-3-Clause 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- A basic structure for passing to graphics driver. 12 | -- 13 | -------------------------------------------------------------------------------- 14 | 15 | module Graphics.RedViz.Descriptor 16 | (Descriptor (..)) where 17 | 18 | import Graphics.Rendering.OpenGL (VertexArrayObject, NumArrayIndices) 19 | 20 | data Descriptor = 21 | Descriptor VertexArrayObject NumArrayIndices 22 | deriving Show 23 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/src/Graphics/RedViz/FromVector.hs: -------------------------------------------------------------------------------- 1 | module Graphics.RedViz.FromVector 2 | ( FromVector(..) 3 | ) where 4 | 5 | import Graphics.Rendering.OpenGL as GL hiding (Size, Position, Point, position) 6 | 7 | class FromVector a where 8 | toVertex4 :: a -> Vertex4 Double 9 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/src/Graphics/RedViz/GLUtil.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Rendering 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD-3-Clause 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- Utilities for handling OpenGL buffers and rendering. 12 | -- 13 | -------------------------------------------------------------------------------- 14 | 15 | module Graphics.RedViz.GLUtil 16 | ( readTexture 17 | , texture2DWrap 18 | ) where 19 | 20 | import Graphics.RedViz.GLUtil.JuicyTextures (readTexture) 21 | import Graphics.RedViz.GLUtil.Textures (texture2DWrap) 22 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/src/Graphics/RedViz/GLUtil/JuicyTextures.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright: (c) 2012,2013 Anthony Cowley 3 | -------------------------------------------------------------------------------- 4 | 5 | {-# LANGUAGE CPP, RankNTypes #-} 6 | -- | Uses the @JuicyPixels@ package to load images that are then used 7 | -- to create OpenGL textuers. 8 | module Graphics.RedViz.GLUtil.JuicyTextures where 9 | 10 | import Codec.Picture (readImage, DynamicImage(..), Image(..)) 11 | import Codec.Picture.Types (convertImage) 12 | #if __GLASGOW_HASKELL__ < 710 13 | import Control.Applicative ((<$>)) 14 | #endif 15 | import Graphics.RedViz.GLUtil.Textures 16 | import Graphics.Rendering.OpenGL (TextureObject) 17 | 18 | -- | Load a 'TexInfo' value from an image file, and supply it to a 19 | -- user-provided function. Supported image formats include @png@, 20 | -- @jpeg@, @bmp@, and @gif@. See 'readTexture' for most uses. 21 | readTexInfo :: FilePath 22 | -> (forall a. IsPixelData a => TexInfo a -> IO b) 23 | -> IO (Either String b) 24 | readTexInfo f k = readImage f >>= either (return . Left) aux 25 | where aux (ImageY8 (Image w h p)) = Right <$> k (texInfo w h TexMono p) 26 | aux (ImageYF (Image w h p)) = Right <$> k (texInfo w h TexMono p) 27 | aux (ImageYA8 _) = return $ Left "YA format not supported" 28 | aux (ImageRGB8 (Image w h p)) = Right <$> k (texInfo w h TexRGB p) 29 | aux (ImageRGBF (Image w h p)) = Right <$> k (texInfo w h TexRGB p) 30 | aux (ImageRGBA8 (Image w h p)) = Right <$> k (texInfo w h TexRGBA p) 31 | aux (ImageYCbCr8 img) = aux . ImageRGB8 $ convertImage img 32 | aux _ = return $ Left "Unsupported image format" 33 | 34 | -- | Load a 'TextureObject' from an image file. Supported formats 35 | -- include @png@, @jpeg@, @bmp@, and @gif@. 36 | readTexture :: FilePath -> IO (Either String TextureObject) 37 | readTexture f = readTexInfo f loadTexture 38 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/src/Graphics/RedViz/Input.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : RedViz 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD-3-Clause 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- The user input interface layer. 12 | -- 13 | -------------------------------------------------------------------------------- 14 | 15 | {-# LANGUAGE CPP #-} 16 | 17 | module Graphics.RedViz.Input 18 | ( 19 | module Graphics.RedViz.Input.FRP.Yampa 20 | , module Graphics.RedViz.Input.Mouse 21 | , module Graphics.RedViz.Input.Keyboard 22 | 23 | ) where 24 | 25 | import Graphics.RedViz.Input.Mouse 26 | import Graphics.RedViz.Input.Keyboard 27 | import Graphics.RedViz.Input.FRP.Yampa 28 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/src/Graphics/RedViz/Input/FRP/Yampa.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : RedViz 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD-3-Clause 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- The user input interface Yampa layer. 12 | -- 13 | -------------------------------------------------------------------------------- 14 | 15 | {-# LANGUAGE CPP #-} 16 | 17 | module Graphics.RedViz.Input.FRP.Yampa 18 | ( 19 | module Graphics.RedViz.Input.FRP.Yampa.AppInput 20 | ) where 21 | 22 | import Graphics.RedViz.Input.FRP.Yampa.AppInput 23 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/src/Graphics/RedViz/Input/FRP/Yampa/Update.hs: -------------------------------------------------------------------------------- 1 | module Graphics.RedViz.Input.FRP.Yampa.Update 2 | ( updateMouse 3 | , updateKeyboard 4 | ) where 5 | 6 | import Graphics.RedViz.Input.FRP.Yampa.Update.Mouse 7 | import Graphics.RedViz.Input.FRP.Yampa.Update.Keyboard 8 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/src/Graphics/RedViz/Input/FRP/Yampa/Update/Mouse.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | module Graphics.RedViz.Input.FRP.Yampa.Update.Mouse 4 | ( updateMouse 5 | ) where 6 | 7 | import FRP.Yampa 8 | 9 | import Graphics.RedViz.Input.FRP.Yampa.AppInput 10 | import Graphics.RedViz.Input.Mouse 11 | 12 | -- import Debug.Trace as DT 13 | 14 | updateMouse :: SF AppInput (Mouse, Event [(Int, Int)]) 15 | updateMouse = 16 | proc input -> do 17 | lmbE <- lbpPos -< input 18 | rmbE <- rbpPos -< input 19 | mmovE <- mouseMoving -< input 20 | 21 | mpos' <- mousePos -< input 22 | rpos' <- mouseRelPos -< input 23 | 24 | let 25 | events = catEvents [lmbE, rmbE, mmovE] 26 | mouse' = 27 | Mouse 28 | (case isEvent lmbE of 29 | True -> Just $ fromEvent lmbE 30 | _ -> Nothing) 31 | (case isEvent rmbE of 32 | True -> Just $ fromEvent rmbE 33 | _ -> Nothing) 34 | mpos' 35 | --(DT.trace ("mpos' : " ++ show mpos') mpos') 36 | rpos' 37 | (isEvent mmovE) 38 | [] 39 | returnA -< (mouse', events) 40 | 41 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/src/Graphics/RedViz/Input/Keyboard.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Keyboard 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD-3-Clause 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- A basic keyboard control structure. 12 | -- 13 | -------------------------------------------------------------------------------- 14 | module Graphics.RedViz.Input.Keyboard 15 | ( Keyboard (..) 16 | , Keys (..) 17 | ) where 18 | 19 | import Linear.V3 20 | 21 | data Keyboard 22 | = Keyboard 23 | { -- | Keyboard State 24 | keys :: Keys 25 | , keyVecs :: [V3 Double] 26 | } deriving Show 27 | 28 | data Keys = 29 | Keys 30 | { keyW :: Bool 31 | , keyS :: Bool 32 | , keyA :: Bool 33 | , keyD :: Bool 34 | , keyQ :: Bool 35 | , keyE :: Bool 36 | , keyZ :: Bool 37 | , keyC :: Bool 38 | , keyUp :: Bool 39 | , keyDown :: Bool 40 | , keyLeft :: Bool 41 | , keyRight :: Bool 42 | , keyPageUp :: Bool 43 | , keyPageDown :: Bool 44 | , keyLShift :: Bool 45 | , keyLCtrl :: Bool 46 | , keyLAlt :: Bool 47 | } deriving Show 48 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/src/Graphics/RedViz/Input/Mouse.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Mouse 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD-3-Clause 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- A basic mouse control structure. 12 | -- 13 | -------------------------------------------------------------------------------- 14 | 15 | 16 | {-# LANGUAGE TemplateHaskell, Arrows #-} 17 | 18 | module Graphics.RedViz.Input.Mouse 19 | ( Mouse (..) 20 | , pos 21 | , rpos 22 | , mmov 23 | ) where 24 | 25 | import Control.Lens 26 | 27 | import Linear.V3 28 | 29 | data Mouse 30 | = Mouse 31 | { -- | Mouse State 32 | _lmb :: Maybe (Int, Int) 33 | , _rmb :: Maybe (Int, Int) 34 | , _pos :: (Int, Int) 35 | , _rpos :: (Int, Int) 36 | , _mmov :: Bool 37 | , mVecs :: [V3 Int] 38 | } deriving Show 39 | 40 | $(makeLenses ''Mouse) 41 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/src/Graphics/RedViz/Object.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | module Graphics.RedViz.Object 4 | ( Object' (..) 5 | , descriptors 6 | , materials 7 | , programs 8 | , transforms 9 | , transform0 10 | , transform1 11 | , ypr0 12 | , ypr 13 | , time 14 | , options 15 | , defaultObject' 16 | , name 17 | ) where 18 | 19 | import Control.Lens hiding (transform, pre) 20 | import Graphics.Rendering.OpenGL (Program) 21 | import Linear.Matrix 22 | import Linear.V3 23 | 24 | import Graphics.RedViz.Descriptor 25 | import Graphics.RedViz.Material hiding (name, _name) 26 | import Graphics.RedViz.Backend 27 | 28 | data Object' 29 | = Object' 30 | { 31 | _name :: String 32 | , _descriptors :: [Descriptor] -- | Material is bound in Descriptor, but we also use this data for draw-call separation per material. 33 | -- data Descriptor = 34 | -- Descriptor VertexArrayObject NumArrayIndices 35 | , _materials :: [Material] -- | hence [Material] is present on the Object level too, we use that value, instead of looking it up from respective VGeo. 36 | , _programs :: [Program] -- | Shader Programs 37 | , _transforms :: ![M44 Double] -- | transforms for parts (object fragments) 38 | , _transform0 :: !(M44 Double) -- | initial basis (position/orientation in world space) 39 | , _transform1 :: !(M44 Double) -- | basis (position/orientation in world space) 40 | , _ypr0 :: !(V3 Double) 41 | , _ypr :: !(V3 Double) 42 | , _time :: Double 43 | , _options :: BackendOptions 44 | } deriving Show 45 | $(makeLenses ''Object') 46 | 47 | zeroV3 :: V3 Double 48 | zeroV3 = V3 0 0 0 49 | 50 | -- defaultObject' :: Object' 51 | -- defaultObject' = Object' [] [] [] [] (identity::M44 Double) zeroV3 zeroV3 0.0 52 | defaultObject' :: Object' 53 | defaultObject' = 54 | Object' 55 | { 56 | _descriptors = [] 57 | , _materials = [] 58 | , _programs = [] 59 | , _transforms = [] 60 | , _transform0 = identity :: M44 Double 61 | , _transform1 = identity :: M44 Double 62 | , _ypr0 = zeroV3 63 | , _ypr = zeroV3 64 | , _time = 0.0 65 | , _options = defaultBackendOptions 66 | , _name = "defaultObject'" 67 | } 68 | 69 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/src/Graphics/RedViz/Primitives.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Primitives 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD-3-Clause 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- Primitive drawable structures. 12 | -- 13 | -------------------------------------------------------------------------------- 14 | 15 | {-# LANGUAGE TemplateHaskell #-} 16 | 17 | module Graphics.RedViz.Primitives where 18 | 19 | --import Linear.V3 as LV3 20 | 21 | data Primitive = 22 | Curve 23 | deriving Show 24 | 25 | -- polyline :: [V3 Double] -> Float -> [V3 Double] 26 | -- polyline ps w = concatMap (\(x,y) -> line x y w) $ pairs $ abbcca ps 27 | 28 | -- line :: V3 Double -> V3 Double -> Float -> [V3 Double] 29 | -- line (x1,y1) (x2,y2) w = map (addVectors (x1,y1)) $ rotate2D' theta $ rect (0.0,-w/2) (len,w/2) -- rotation is wrong 30 | -- where 31 | -- (x,y) = normalize $ ((x2-x1),(y2-y1)) 32 | -- theta = signum y * acos x -- | angle in radians 33 | -- len = sqrt((x2-x1)^2+ (y2-y1)^2) 34 | 35 | -- abbcca :: [a] -> [a] 36 | -- abbcca (x:xs) = [x] ++ (concat $ map (\(x,y) -> [x,y]) $ map (\x -> (x, x)) (init xs)) ++ [last xs] 37 | 38 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/src/Graphics/RedViz/Project.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module Graphics.RedViz.Project 3 | ( module Graphics.RedViz.Project.Project 4 | , module Graphics.RedViz.Project.Model 5 | ) where 6 | 7 | import Graphics.RedViz.Project.Project 8 | import Graphics.RedViz.Project.Model 9 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/src/Graphics/RedViz/Project/GUI.hs: -------------------------------------------------------------------------------- 1 | -- {-# LANGUAGE TemplateHaskell #-} 2 | 3 | -- module Graphics.RedViz.Project.GUI 4 | -- ( GUI (..) 5 | -- ) where 6 | 7 | -- data GUI = 8 | -- GUI 9 | -- { 10 | -- -- _fonts :: [Object] 11 | -- -- , _icons :: [Object] 12 | -- -- , _widgets :: [Widget] 13 | -- -- , _widgets :: [Object] -- TODO: think about a widget set? 14 | -- } deriving Show 15 | -- $(makeLenses ''GUI) 16 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/src/Graphics/RedViz/Project/Model.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | module Graphics.RedViz.Project.Model 4 | ( Model (..) 5 | , path 6 | ) where 7 | 8 | import Control.Lens 9 | import Data.Aeson 10 | import Data.Aeson.TH 11 | 12 | 13 | data Model 14 | = Model 15 | { 16 | _path :: String 17 | } deriving Show 18 | 19 | $(makeLenses ''Model) 20 | deriveJSON defaultOptions {fieldLabelModifier = drop 1} ''Model 21 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/src/Graphics/RedViz/Project/Utils.hs: -------------------------------------------------------------------------------- 1 | module Graphics.RedViz.Project.Utils 2 | ( fromProjectCamera 3 | ) where 4 | 5 | import Linear.V3 6 | 7 | import Graphics.RedViz.Project.Project 8 | import Graphics.RedViz.Camera 9 | import Graphics.RedViz.Controllable 10 | import Graphics.RedViz.Utils 11 | 12 | 13 | -- TODO: pass prj resolution to camera 14 | fromProjectCamera :: Project -> ProjectCamera -> Camera 15 | fromProjectCamera prj0 pcam = 16 | defaultCam 17 | { 18 | _apt = _pApt pcam 19 | , _foc = _pFoc pcam 20 | , _controller = 21 | defaultCamController 22 | { _transform = fromList ( Just $ _pTransform pcam) } 23 | , _mouseS = pure $ _pMouseS pcam :: V3 Double 24 | , _keyboardRS = pure $ _pKeyboardRS pcam :: V3 Double 25 | , _keyboardTS = pure $ _pKeyboardTS pcam :: V3 Double 26 | , _res = (_resx prj0, _resy prj0) 27 | , _scale = 1.0 :: Double 28 | } 29 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/src/Graphics/RedViz/Texture.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Texture 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD3 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- Utilities for texture handling. 12 | -- 13 | -------------------------------------------------------------------------------- 14 | 15 | {-# LANGUAGE TemplateHaskell #-} 16 | 17 | module Graphics.RedViz.Texture 18 | ( Texture (..) 19 | , name 20 | , path 21 | , uuid 22 | , defaultTexture 23 | ) where 24 | 25 | import Control.Lens 26 | import Data.Aeson 27 | import Data.Aeson.Encode.Pretty 28 | import Data.Aeson.TH 29 | import Data.UUID 30 | import Data.Text hiding (drop) 31 | 32 | import Graphics.RedViz.Utils (encodeStringUUID) 33 | 34 | data Texture 35 | = Texture 36 | { -- | Binding name in a shader. 37 | _name :: String 38 | -- | A filepath to an image file location on disk, relative to project root. 39 | , _path :: FilePath -- TODO: replace with Maybe FilePath or Either (FilePath or Generated, maybe a formula?) 40 | -- | A unique object (texture) ID. 41 | , _uuid :: UUID 42 | } deriving Show 43 | $(makeLenses ''Texture) 44 | deriveJSON defaultOptions {fieldLabelModifier = drop 1} ''Texture 45 | 46 | instance Eq Texture where 47 | t0 == t1 = view uuid t0 == view uuid t1 48 | 49 | instance Ord Texture where 50 | compare t0 t1 = compare (view uuid t0) (view uuid t1) 51 | 52 | -- | A default Texture type constructor. 53 | defaultTexture :: Texture 54 | defaultTexture 55 | = Texture 56 | "checkerboard" 57 | "./textures/checkerboard.png" 58 | (encodeStringUUID "./textures/checkerboard.png") 59 | 60 | comp :: Text -> Text -> Ordering 61 | comp = keyOrder . fmap pack $ ["name", "path", "uuid"] 62 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/src/Graphics/RedViz/VAO.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : RedViz 4 | -- Copyright : (c) Vladimir Lopatin 2022 5 | -- License : BSD-3-Clause 6 | -- 7 | -- Maintainer : Vladimir Lopatin 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- The tooling around Vertex Array Objects 12 | -- 13 | -------------------------------------------------------------------------------- 14 | 15 | module Graphics.RedViz.VAO 16 | ( 17 | VAO 18 | , toVAO 19 | , VAO' 20 | , SVAO' 21 | , toVAO' 22 | , toVAO'' 23 | ) where 24 | 25 | import Data.Massiv.Array as A 26 | import GHC.Float 27 | 28 | import Graphics.RedViz.Utils 29 | 30 | -- import Debug.Trace as DT 31 | 32 | type VAO = [[[Float]]] 33 | 34 | toVAO 35 | :: [[Int]] 36 | -> [Float] 37 | -> [(Double, Double, Double)] 38 | -> [(Double, Double, Double)] 39 | -> [(Double, Double, Double)] 40 | -> [(Double, Double, Double)] 41 | -> VAO 42 | 43 | toVAO idxs as cds ns ts ps = vaos 44 | where 45 | as' = fmap (\a -> [a]) as :: [[Float]] 46 | cds' = fmap (\(r,g,b) -> fmap double2Float [r,g,b]) cds :: [[Float]] 47 | ns' = fmap (\(x,y,z) -> fmap double2Float [x,y,z]) ns 48 | ts' = fmap (\(u,v,w) -> fmap double2Float [u,v,w]) ts 49 | ps' = fmap (\(x,y,z) -> fmap double2Float [x,y,z]) ps 50 | 51 | indices = fromLists' Par idxs :: (Array U Ix2 Int) 52 | as'' = fromLists' Par as' :: (Array U Ix2 Float) 53 | cds''= fromLists' Par cds' :: (Array U Ix2 Float) 54 | ns'' = fromLists' Par ns' :: (Array U Ix2 Float) 55 | ts'' = fromLists' Par ts' :: (Array U Ix2 Float) 56 | ps'' = fromLists' Par ps' :: (Array U Ix2 Float) 57 | 58 | cList' = toLists2 . computeAs U $ concat' 1 [as'', cds'', ns'', ts'', ps''] :: [[Float]] 59 | 60 | ar = fromLists' Par cList' :: (Array U Ix2 Float) 61 | cListOpt = 62 | toLists2 . computeAs P <$> 63 | fmap (\row -> backpermute' (Sz (Prelude.length (idxs !! row) :. 13)) (\(i :. j) -> ((indices !> row) ! i) :. j) ar) [0 .. div (elemsCount indices) (elemsCount (indices !> 0))-1] 64 | --vaos = (DT.trace ("cListOpt" ++ show cListOpt) $ cListOpt) 65 | vaos = cListOpt 66 | 67 | type VAO' = [([Int], Int, [Float])] 68 | type SVAO' = ([Int], Int, [Float]) 69 | 70 | toVAO' :: [[Int]] -> [Int] -> [[Float]] -> VAO' 71 | toVAO' is_ st_ vs_ = (,,) <$.> is_ <*.> st_ <*.> vs_ 72 | 73 | toVAO'' :: [Int] -> Int -> [Float] -> SVAO' 74 | toVAO'' = (,,) 75 | 76 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/stack.yaml: -------------------------------------------------------------------------------- 1 | flags: {} 2 | packages: 3 | - . 4 | extra-deps: 5 | - bytestring-0.10.8.1 6 | - linear-1.20.7 7 | - OpenGL-3.0.2.0 8 | - sdl2-2.3.0 9 | - text-1.2.2.2 10 | - Yampa-0.10.6 11 | resolver: lts-9.13 12 | -------------------------------------------------------------------------------- /MandelbrotViewerDIGRes/test/Spec.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Test suite not yet implemented" 3 | -------------------------------------------------------------------------------- /MandelbrotYampa/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Vladimir Lopatin (c) 2017 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Vladimir Lopatin nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /MandelbrotYampa/MandelbrotYampa.cabal: -------------------------------------------------------------------------------- 1 | name: MandelbrotYampa 2 | version: 0.1.0.0 3 | synopsis: Short description of your package 4 | homepage: https://github.com/madjestic/MandelbrotYampa#readme 5 | license: BSD3 6 | license-file: LICENSE 7 | author: Vladimir Lopatin 8 | maintainer: madjestic13@gmail.com 9 | copyright: Vladimir Lopatin 10 | category: graphics 11 | build-type: Simple 12 | extra-source-files: README.md 13 | cabal-version: >=1.10 14 | 15 | -- To avoid duplicated efforts in documentation and dealing with the 16 | -- complications of embedding Haddock markup inside cabal files, it is 17 | -- common to point users to the README.md file. 18 | description: Please see the README on Github at 19 | 20 | library 21 | hs-source-dirs: src 22 | exposed-modules: LoadShaders 23 | , Input 24 | build-depends: base >= 4.7 && < 5 25 | , bytestring >= 0.10.8.1 26 | , OpenGL >= 3.0 && < 4 27 | , linear >= 1.20.7 28 | , sdl2 >= 2.3.0 29 | , Yampa >= 0.10.6 30 | default-language: Haskell2010 31 | 32 | executable MandelbrotYampa 33 | hs-source-dirs: app 34 | main-is: Main.hs 35 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 36 | build-depends: base 37 | , linear >= 1.20.7 38 | , OpenGL >= 3.0 && < 4 39 | , sdl2 >= 2.3.0 40 | , text >= 1.2.2.2 41 | , Yampa >= 0.10.6 42 | , MandelbrotYampa 43 | default-language: Haskell2010 44 | 45 | test-suite MandelbrotYampa-test 46 | type: exitcode-stdio-1.0 47 | hs-source-dirs: test 48 | main-is: Spec.hs 49 | build-depends: base 50 | , MandelbrotYampa 51 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 52 | default-language: Haskell2010 53 | 54 | source-repository head 55 | type: git 56 | location: https://github.com/madjestic/MandelbrotYampa 57 | -------------------------------------------------------------------------------- /MandelbrotYampa/README.md: -------------------------------------------------------------------------------- 1 | # MandelbrotYampa 2 | 3 | A simple [OpenGL](https://github.com/haskell-opengl) application, using [FRP.Yampa](https://github.com/ivanperez-keera/Yampa) to handle animation and user events, SDL2 for managing windows and input, [stack](https://docs.haskellstack.org/en/stable/README/) as a build system. 4 | Shader-loading is handled by [Sven Panne's code](https://github.com/haskell-opengl/GLUT/blob/master/examples/RedBook8/common/LoadShaders.hs). 5 | Input handling is inspired and based on [Konstantin Zudov, Yampy Cube](https://github.com/zudov) presentation at Helsinki User Group. 6 | 7 | ## Prerequisites: 8 | Hardware, supporting OpenGL >= 4.5 (because that's what my hardware is). 9 | Most likely the code will run with lesser OpenGL versions, but you will 10 | have to mess with the code. 11 | 12 | ## In order to run: 13 | ``` 14 | stack build 15 | stack exec Mandelbrot 16 | # or, in case you are running a hybrid graphics like myself, use a launch script, e.g.: 17 | gpu ./run.sh 18 | ( stack build && gpu ./run.sh ) 19 | 20 | ``` 21 | 22 | ## Controls: 23 | ``` 24 | Up - zoom in 25 | Down - zoom out 26 | q - reset 27 | Escape - quit 28 | ``` 29 | 30 | ## Output: 31 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/MandelbrotYampa/output.png) 32 | 33 | ## Animated Output: 34 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/MandelbrotYampa/output.gif) 35 | -------------------------------------------------------------------------------- /MandelbrotYampa/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /MandelbrotYampa/Shaders/shader.frag: -------------------------------------------------------------------------------- 1 | #version 450 2 | 3 | // Created by inigo quilez - iq/2013 4 | // License Creative Commons Attribution-NonCommercial-ShareAlike 3.0 Unported License. 5 | 6 | 7 | // This shader computes the distance to the Mandelbrot Set for everypixel, and colorizes 8 | // it accoringly. 9 | // 10 | // Z -> Z²+c, Z0 = 0. 11 | // therefore Z' -> 2·Z·Z' + 1 12 | // 13 | // The Hubbard-Douady potential G(c) is G(c) = log Z/2^n 14 | // G'(c) = Z'/Z/2^n 15 | // 16 | // So the distance is |G(c)|/|G'(c)| = |Z|·log|Z|/|Z'| 17 | // 18 | // More info here: http://www.iquilezles.org/www/articles/distancefractals/distancefractals.htm 19 | 20 | in vec2 uv; 21 | // in float time; 22 | out vec4 fColor; 23 | 24 | uniform float fTime; 25 | 26 | void main() 27 | { 28 | vec3 iResolution = vec3(1024, 1024, 1.0); 29 | float iGlobalTime = fTime; 30 | vec2 p = -3.0 + 5000.0 * uv.xy / iResolution.xy; 31 | p.x *= iResolution.x/iResolution.y; 32 | 33 | // animation 34 | float tz = 0.5 + 0.5*(0.225*iGlobalTime); 35 | float zoo = pow( 0.5, 13.0*tz ); 36 | vec2 c = vec2(-0.05,.6805) + p*zoo; 37 | 38 | // iterate 39 | vec2 z = vec2(0.0); 40 | float m2 = 0.0; 41 | vec2 dz = vec2(0.0); 42 | for( int i=0; i<256; i++ ) 43 | { 44 | if( m2>1024.0 ) continue; 45 | 46 | // Z' -> 2·Z·Z' + 1 47 | dz = 2.0*vec2(z.x*dz.x-z.y*dz.y, z.x*dz.y + z.y*dz.x) + vec2(1.0,0.0); 48 | 49 | // Z -> Z² + c 50 | z = vec2( z.x*z.x - z.y*z.y, 2.0*z.x*z.y ) + c; 51 | 52 | m2 = dot(z,z); 53 | } 54 | 55 | // distance 56 | // d(c) = |Z|·log|Z|/|Z'| 57 | float d = 0.5*sqrt(dot(z,z)/dot(dz,dz))*log(dot(z,z)); 58 | 59 | 60 | // do some soft coloring based on distance 61 | d = clamp( 8.0*d/zoo, 0.0, 1.0 ); 62 | d = pow( d, 0.25 ); 63 | vec3 col = vec3( d ); 64 | 65 | fColor = vec4( col, 1.0 ); 66 | } 67 | -------------------------------------------------------------------------------- /MandelbrotYampa/Shaders/shader.vert: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec3 vPosition; 4 | layout(location = 1) in vec2 uvCoords; 5 | 6 | uniform float fTime; 7 | uniform mat4 transform; 8 | 9 | // Output data ; will be interpolated for each fragment. 10 | out vec2 uv; 11 | out float time; 12 | 13 | void main() 14 | { 15 | gl_Position = transform * vec4(vPosition, 1.0); 16 | 17 | // The color of each vertex will be interpolated 18 | // to produce the color of each fragment 19 | uv = uvCoords; 20 | time = fTime; 21 | } 22 | -------------------------------------------------------------------------------- /MandelbrotYampa/output.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/MandelbrotYampa/output.gif -------------------------------------------------------------------------------- /MandelbrotYampa/output.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/MandelbrotYampa/output.png -------------------------------------------------------------------------------- /MandelbrotYampa/run.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | stack exec MandelbrotYampa 4 | -------------------------------------------------------------------------------- /MandelbrotYampa/stack.yaml: -------------------------------------------------------------------------------- 1 | flags: {} 2 | packages: 3 | - . 4 | extra-deps: 5 | - bytestring-0.10.8.1 6 | - linear-1.20.7 7 | - OpenGL-3.0.2.0 8 | - sdl2-2.3.0 9 | - text-1.2.2.2 10 | - Yampa-0.10.6 11 | resolver: lts-9.13 12 | -------------------------------------------------------------------------------- /MandelbrotYampa/test/Spec.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Test suite not yet implemented" 3 | -------------------------------------------------------------------------------- /Read_Model-FRP-io-sdl2/Makefile: -------------------------------------------------------------------------------- 1 | default: 2 | ghc ./Main.hs -o Main 3 | 4 | runall: 5 | make all 6 | python geoParser.py 7 | gpu ./Main 8 | 9 | run: 10 | make all 11 | gpu ./Main 12 | 13 | all: 14 | rm ./Main 15 | rm ./Main.o 16 | rm ./Main.hi 17 | ghc ./Main.hs -o Main 18 | -------------------------------------------------------------------------------- /Read_Model-FRP-io-sdl2/README.md: -------------------------------------------------------------------------------- 1 | An animated Mandelbrot example, using [FRP.Yampa](https://github.com/ivanperez-keera/Yampa) to handle animation loop and events, SDL2 is used for windows and input, OpenGL (NGL is Not a Graphics Library) is used for rendering. 2 | Shader-loading is handled by [Sven Panne's code](https://github.com/haskell-opengl/GLUT/blob/master/examples/RedBook8/common/LoadShaders.hs). 3 | Input handling is inspired and based on [Konstantin Zudov, Yampy Cube](https://github.com/zudov) presentation at Helsinki User Group. 4 | 5 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/Mandelbrot-FRP-io-sdl2/output.png) 6 | 7 | in order to run: 8 | 9 | ```bash 10 | $ make 11 | $ optirun -b primus ./Main 12 | ``` 13 | 14 | Controls: 15 | ``` 16 | space - zoom in 17 | q - reset 18 | ``` -------------------------------------------------------------------------------- /Read_Model-FRP-io-sdl2/geoParser.py: -------------------------------------------------------------------------------- 1 | /home/madjestic/Projects/Parser/geoParser.py -------------------------------------------------------------------------------- /Transformations/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Vladimir Lopatin (c) 2017 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Vladimir Lopatin nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /Transformations/README.md: -------------------------------------------------------------------------------- 1 | # Transformations 2 | 3 | A simple OpenGL application, drawing a rectangle with texture blending, using element buffer. [OpenGL](https://github.com/haskell-opengl) application with [stack](https://docs.haskellstack.org/en/stable/README/) as a build system. 4 | 5 | ## Prerequisits: 6 | Hardware, supporting OpenGL >= 4.5 (because that's what my hardware is). 7 | Most likely the code will run with lesser OpenGL versions, but you will 8 | have to mess with the code. 9 | 10 | ## In order to run: 11 | ``` 12 | stack build 13 | stack exec Transformations 14 | # or, in case you are running a hybrid graphics like myself, use a launch script, e.g.: 15 | gpu ./run.sh 16 | 17 | ``` 18 | 19 | ## Output: 20 | ![](https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/master/Transformations/output.png) -------------------------------------------------------------------------------- /Transformations/Resources/Textures/awesomeface.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/Transformations/Resources/Textures/awesomeface.png -------------------------------------------------------------------------------- /Transformations/Resources/Textures/container.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/Transformations/Resources/Textures/container.jpg -------------------------------------------------------------------------------- /Transformations/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /Transformations/Shaders/shader.frag: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | // Interpolated values from the vertex shaders 4 | in vec3 clr; 5 | in vec2 uv; 6 | uniform sampler2D tex_00; 7 | uniform sampler2D tex_01; 8 | 9 | // Ouput data 10 | out vec4 fColor; 11 | 12 | void main() 13 | { 14 | fColor = vec4( mix( texture(tex_00, uv).rgb, 15 | texture(tex_01, uv).rgb, 0.5 ) * clr 16 | , 1.0 ); 17 | } 18 | -------------------------------------------------------------------------------- /Transformations/Shaders/shader.vert: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec3 vPosition; 4 | layout(location = 1) in vec3 vColor; 5 | layout(location = 2) in vec2 uvCoords; 6 | 7 | // Output data ; will be interpolated for each fragment. 8 | out vec3 clr; 9 | out vec2 uv; 10 | 11 | uniform mat4 transform; 12 | 13 | void main() 14 | { 15 | gl_Position = transform * vec4(vPosition, 1.0); 16 | 17 | // The color of each vertex will be interpolated 18 | // to produce the color of each fragment 19 | clr = vColor; 20 | uv = uvCoords; 21 | } 22 | -------------------------------------------------------------------------------- /Transformations/Transformations.cabal: -------------------------------------------------------------------------------- 1 | name: Transformations 2 | version: 0.1.0.0 3 | synopsis: A simple OpenGL application 4 | -- description: 5 | homepage: https://github.com/madjestic/Transformations#readme 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Vladimir Lopatin 9 | maintainer: madjestic13@gmail.com 10 | copyright: Vladimir Lopatin 11 | category: graphics 12 | build-type: Simple 13 | extra-source-files: README.md 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: LoadShaders 19 | build-depends: base >= 4.7 && < 5 20 | , bytestring >= 0.10.8.1 21 | , OpenGL >= 3.0 && < 4 22 | default-language: Haskell2010 23 | 24 | executable Transformations 25 | hs-source-dirs: app 26 | main-is: Main.hs 27 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 28 | build-depends: base 29 | , GLFW-b 30 | , OpenGL >= 3.0 && < 4 31 | , GLUtil >= 0.9.2 32 | , Transformations 33 | default-language: Haskell2010 34 | 35 | test-suite Transformations-test 36 | type: exitcode-stdio-1.0 37 | hs-source-dirs: test 38 | main-is: Spec.hs 39 | build-depends: base 40 | , Transformations 41 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 42 | default-language: Haskell2010 43 | 44 | source-repository head 45 | type: git 46 | location: https://github.com/madjestic/Transformations 47 | -------------------------------------------------------------------------------- /Transformations/output.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/Transformations/output.png -------------------------------------------------------------------------------- /Transformations/run.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | stack exec Transformations 4 | -------------------------------------------------------------------------------- /Transformations/stack.yaml: -------------------------------------------------------------------------------- 1 | flags: {} 2 | packages: 3 | - . 4 | extra-deps: 5 | - GLFW-b-1.4.8.1 6 | - OpenGL-3.0.2.0 7 | - GLUtil-0.9.2 8 | - bytestring-0.10.8.1 9 | resolver: lts-9.13 10 | -------------------------------------------------------------------------------- /dynamic_transformation/Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | make clean 3 | ghc ./Main.hs -o Main 4 | 5 | clean: 6 | @if [ -f ./Main ];\ 7 | then\ 8 | rm ./Main 2> /dev/null;\ 9 | else\ 10 | echo "./Main already clean";\ 11 | fi 12 | 13 | @if [ -f ./Main.o ];\ 14 | then\ 15 | rm ./Main.o 2> /dev/null;\ 16 | else\ 17 | echo "./Main.o already clean";\ 18 | fi 19 | 20 | run: 21 | make clean && make && gpu ./Main 22 | -------------------------------------------------------------------------------- /dynamic_transformation/NGL/Shape.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE InstanceSigs #-} 3 | 4 | module NGL.Shape where 5 | 6 | import Graphics.Rendering.OpenGL (Vertex4(..), 7 | TexCoord2(..), 8 | GLclampf(..)) 9 | 10 | 11 | data Shape = Square Point Side 12 | deriving Show 13 | 14 | type VertexArray =[Vertex4 Float] 15 | type UV =[TexCoord2 Float] 16 | type Point =(Float, Float) 17 | type Points =[Point] 18 | type Radius = Float 19 | type Side = Float 20 | type Divisions = Int 21 | type Texture = String 22 | 23 | type Drawable = ([Vertex4 Float],[TexCoord2 Float],String) 24 | 25 | toDrawable :: Shape -> Drawable 26 | toDrawable x = (vs, uv, tex) 27 | where 28 | vs' = toPoints x 29 | uv = map toTexCoord2 vs' 30 | vs = map toVertex4 $ vs' 31 | tex = "test.png" 32 | 33 | toPoints :: Shape -> [Point] 34 | toPoints (Square pos side) = square pos side 35 | 36 | toVertexArray :: [Point] -> VertexArray 37 | toVertexArray xs = map toVertex4 xs 38 | 39 | toVertex4 :: Point -> Vertex4 Float 40 | toVertex4 p = (\(k,l) -> Vertex4 k l 0 1) p 41 | 42 | toTextureCoord2 :: [Point] -> UV 43 | toTextureCoord2 xs = map (\(k,l) -> TexCoord2 k l) xs 44 | 45 | toTexCoord2 :: (a, a) -> TexCoord2 a 46 | toTexCoord2 p = (\(k,l) -> TexCoord2 k l) p 47 | 48 | data Projection = Planar 49 | deriving Show 50 | 51 | toUV :: Projection -> UV 52 | toUV Planar = toTextureCoord2 ps 53 | where ps = [(1.0, 1.0),( 0.0, 1.0),( 0.0, 0.0) 54 | ,(1.0, 1.0),( 0.0, 0.0),( 1.0, 0.0)]::Points 55 | 56 | square :: Point -> Float -> [Point] 57 | square pos side = [p1, p2, p3, 58 | p1, p3, p4] 59 | where 60 | x = fst pos 61 | y = snd pos 62 | r = side/2 63 | p1 = (x + r, y + r) 64 | p2 = (x - r, y + r) 65 | p3 = (x - r, y - r) 66 | p4 = (x + r, y - r) 67 | -------------------------------------------------------------------------------- /dynamic_transformation/NGL/Texture.hs: -------------------------------------------------------------------------------- 1 | module Texture 2 | ( 3 | loadGLTextureFromFile, 4 | 5 | ) where 6 | 7 | import Graphics.Rendering.OpenGL 8 | import Graphics.GLUtil 9 | import Codec.Picture 10 | import qualified Graphics.Rendering.OpenGL as GL 11 | import qualified Graphics.GLUtil as GLU 12 | import qualified Codec.Picture as Pic 13 | 14 | loadGLTextureFromFile :: FilePath -> IO GL.TextureObject 15 | loadGLTextureFromFile f = do t <- either error id <$> readTexture f 16 | textureFilter Texture2D $= ((Linear', Nothing), Linear') 17 | texture2DWrap $= (Mirrored, ClampToEdge) 18 | return t 19 | -------------------------------------------------------------------------------- /dynamic_transformation/NGL/TinyMath: -------------------------------------------------------------------------------- 1 | /home/madjestic/Projects/Haskell/TinyMath -------------------------------------------------------------------------------- /dynamic_transformation/NGL/Utils.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- | Module : Data 4 | -- | Copyright : (c) Vladimir Lopatin 2014 5 | -- | License : BSD3 6 | -- | 7 | -- | Maintainer : Vladimir Lopatin 8 | -- | Stability : experimental 9 | -- | Portability : untested 10 | -- | 11 | -- | Utils : utilities, helper functions 12 | -- | 13 | -------------------------------------------------------------------------------- 14 | 15 | module NGL.Utils where 16 | 17 | 18 | -- | Group list into indevidual pairs: [1,2,3,4] => [(1,2),(3,4)]. 19 | -- Works only with even number of elements 20 | pairs :: [t] -> [(t, t)] 21 | pairs [] = [] 22 | pairs [x] = error "Non-even list for pair function" 23 | pairs (x:y:xs) = (x,y):pairs xs 24 | 25 | -- | Undo pairs function 26 | fromPairs :: [(a, a)] -> [a] 27 | fromPairs [] = [] 28 | fromPairs ((x,y):xs) = x:y:fromPairs xs 29 | 30 | -- implement/bind delaunay somewhere here 31 | -------------------------------------------------------------------------------- /dynamic_transformation/NGL/clean: -------------------------------------------------------------------------------- 1 | rm -rf ./*.hs~ 2 | rm -rf ./*.hi 3 | rm -rf ./*.o -------------------------------------------------------------------------------- /dynamic_transformation/NGL/test.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/dynamic_transformation/NGL/test.png -------------------------------------------------------------------------------- /dynamic_transformation/README.md: -------------------------------------------------------------------------------- 1 | Tutorial 10, 2 | 3 | ... were we are drawing a textured rectangle: 4 | 5 | This tutorial has a goal to use minimum unrelated code structures, 6 | while keeping the basic boilerplate, developed in previous tutorials. 7 | 8 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/tutorial10/output.png) -------------------------------------------------------------------------------- /dynamic_transformation/Resources/Textures/awesomeface.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/dynamic_transformation/Resources/Textures/awesomeface.png -------------------------------------------------------------------------------- /dynamic_transformation/Resources/Textures/container.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/dynamic_transformation/Resources/Textures/container.jpg -------------------------------------------------------------------------------- /dynamic_transformation/Shaders/shader.frag: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | // Interpolated values from the vertex shaders 4 | in vec3 clr; 5 | in vec2 uv; 6 | uniform sampler2D tex_00; 7 | uniform sampler2D tex_01; 8 | 9 | // Ouput data 10 | out vec4 fColor; 11 | 12 | void main() 13 | { 14 | fColor = vec4( mix( texture(tex_00, uv).rgb, 15 | texture(tex_01, uv).rgb, 0.5 ) * clr 16 | , 1.0 ); 17 | } 18 | -------------------------------------------------------------------------------- /dynamic_transformation/Shaders/shader.vert: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec3 vPosition; 4 | layout(location = 1) in vec3 vColor; 5 | layout(location = 2) in vec2 uvCoords; 6 | 7 | // Output data ; will be interpolated for each fragment. 8 | out vec3 clr; 9 | out vec2 uv; 10 | 11 | uniform mat4 transform; 12 | 13 | void main() 14 | { 15 | gl_Position = transform * vec4(vPosition, 1.0); 16 | 17 | // The color of each vertex will be interpolated 18 | // to produce the color of each fragment 19 | clr = vColor; 20 | uv = uvCoords; 21 | } 22 | -------------------------------------------------------------------------------- /dynamic_transformation/output.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/dynamic_transformation/output.png -------------------------------------------------------------------------------- /element_buffer/Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | make clean 3 | ghc ./Main.hs -o Main 4 | 5 | clean: 6 | @if [ -f ./Main ];\ 7 | then\ 8 | rm ./Main 2> /dev/null;\ 9 | else\ 10 | echo "./Main already clean";\ 11 | fi 12 | 13 | @if [ -f ./Main.o ];\ 14 | then\ 15 | rm ./Main.o 2> /dev/null;\ 16 | else\ 17 | echo "./Main.o already clean";\ 18 | fi 19 | 20 | run: 21 | make clean && make && gpu ./Main 22 | -------------------------------------------------------------------------------- /element_buffer/NGL/Shape.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE InstanceSigs #-} 3 | 4 | module NGL.Shape where 5 | 6 | import Graphics.Rendering.OpenGL (Vertex4(..), 7 | TexCoord2(..), 8 | GLclampf(..)) 9 | 10 | 11 | data Shape = Square Point Side 12 | deriving Show 13 | 14 | type VertexArray =[Vertex4 Float] 15 | type UV =[TexCoord2 Float] 16 | type Point =(Float, Float) 17 | type Points =[Point] 18 | type Radius = Float 19 | type Side = Float 20 | type Divisions = Int 21 | type Texture = String 22 | 23 | type Drawable = ([Vertex4 Float],[TexCoord2 Float],String) 24 | 25 | toDrawable :: Shape -> Drawable 26 | toDrawable x = (vs, uv, tex) 27 | where 28 | vs' = toPoints x 29 | uv = map toTexCoord2 vs' 30 | vs = map toVertex4 $ vs' 31 | tex = "test.png" 32 | 33 | toPoints :: Shape -> [Point] 34 | toPoints (Square pos side) = square pos side 35 | 36 | toVertexArray :: [Point] -> VertexArray 37 | toVertexArray xs = map toVertex4 xs 38 | 39 | toVertex4 :: Point -> Vertex4 Float 40 | toVertex4 p = (\(k,l) -> Vertex4 k l 0 1) p 41 | 42 | toTextureCoord2 :: [Point] -> UV 43 | toTextureCoord2 xs = map (\(k,l) -> TexCoord2 k l) xs 44 | 45 | toTexCoord2 :: (a, a) -> TexCoord2 a 46 | toTexCoord2 p = (\(k,l) -> TexCoord2 k l) p 47 | 48 | data Projection = Planar 49 | deriving Show 50 | 51 | toUV :: Projection -> UV 52 | toUV Planar = toTextureCoord2 ps 53 | where ps = [(1.0, 1.0),( 0.0, 1.0),( 0.0, 0.0) 54 | ,(1.0, 1.0),( 0.0, 0.0),( 1.0, 0.0)]::Points 55 | 56 | square :: Point -> Float -> [Point] 57 | square pos side = [p1, p2, p3, 58 | p1, p3, p4] 59 | where 60 | x = fst pos 61 | y = snd pos 62 | r = side/2 63 | p1 = (x + r, y + r) 64 | p2 = (x - r, y + r) 65 | p3 = (x - r, y - r) 66 | p4 = (x + r, y - r) 67 | -------------------------------------------------------------------------------- /element_buffer/NGL/Texture.hs: -------------------------------------------------------------------------------- 1 | module Texture 2 | ( 3 | loadGLTextureFromFile, 4 | 5 | ) where 6 | 7 | import Graphics.Rendering.OpenGL 8 | import Graphics.GLUtil 9 | import Codec.Picture 10 | import qualified Graphics.Rendering.OpenGL as GL 11 | import qualified Graphics.GLUtil as GLU 12 | import qualified Codec.Picture as Pic 13 | 14 | loadGLTextureFromFile :: FilePath -> IO GL.TextureObject 15 | loadGLTextureFromFile f = do t <- either error id <$> readTexture f 16 | textureFilter Texture2D $= ((Linear', Nothing), Linear') 17 | texture2DWrap $= (Mirrored, ClampToEdge) 18 | return t 19 | -------------------------------------------------------------------------------- /element_buffer/NGL/TinyMath: -------------------------------------------------------------------------------- 1 | /home/madjestic/Projects/Haskell/TinyMath -------------------------------------------------------------------------------- /element_buffer/NGL/Utils.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- | Module : Data 4 | -- | Copyright : (c) Vladimir Lopatin 2014 5 | -- | License : BSD3 6 | -- | 7 | -- | Maintainer : Vladimir Lopatin 8 | -- | Stability : experimental 9 | -- | Portability : untested 10 | -- | 11 | -- | Utils : utilities, helper functions 12 | -- | 13 | -------------------------------------------------------------------------------- 14 | 15 | module NGL.Utils where 16 | 17 | 18 | -- | Group list into indevidual pairs: [1,2,3,4] => [(1,2),(3,4)]. 19 | -- Works only with even number of elements 20 | pairs :: [t] -> [(t, t)] 21 | pairs [] = [] 22 | pairs [x] = error "Non-even list for pair function" 23 | pairs (x:y:xs) = (x,y):pairs xs 24 | 25 | -- | Undo pairs function 26 | fromPairs :: [(a, a)] -> [a] 27 | fromPairs [] = [] 28 | fromPairs ((x,y):xs) = x:y:fromPairs xs 29 | 30 | -- implement/bind delaunay somewhere here 31 | -------------------------------------------------------------------------------- /element_buffer/NGL/clean: -------------------------------------------------------------------------------- 1 | rm -rf ./*.hs~ 2 | rm -rf ./*.hi 3 | rm -rf ./*.o -------------------------------------------------------------------------------- /element_buffer/NGL/test.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/element_buffer/NGL/test.png -------------------------------------------------------------------------------- /element_buffer/README.md: -------------------------------------------------------------------------------- 1 | Tutorial 10, 2 | 3 | ... were we are drawing a textured rectangle: 4 | 5 | This tutorial has a goal to use minimum unrelated code structures, 6 | while keeping the basic boilerplate, developed in previous tutorials. 7 | 8 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/tutorial10/output.png) -------------------------------------------------------------------------------- /element_buffer/Shaders/shader.frag: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | // Interpolated values from the vertex shaders 4 | in vec2 uv; 5 | uniform sampler2D tex; 6 | 7 | // Ouput data 8 | out vec4 fColor; 9 | 10 | void main() 11 | { 12 | fColor = vec4(texture(tex, uv).rgb, 1.0); 13 | } 14 | -------------------------------------------------------------------------------- /element_buffer/Shaders/shader.vert: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec4 vPosition; 4 | layout(location = 1) in vec2 uvCoords; 5 | 6 | // Output data ; will be interpolated for each fragment. 7 | out vec2 uv; 8 | 9 | void main() 10 | { 11 | gl_Position = vPosition; 12 | 13 | // The color of each vertex will be interpolated 14 | // to produce the color of each fragment 15 | uv = uvCoords; 16 | } 17 | -------------------------------------------------------------------------------- /element_buffer/junk.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ExistentialQuantification #-} 2 | {-# LANGUAGE GADTs #-} 3 | 4 | module Main where 5 | 6 | import Data.Dynamic 7 | 8 | foo = [1,2,3] 9 | 10 | data T 11 | = ConsInt Int 12 | | ConsString String 13 | | ConsChar Char 14 | deriving Show 15 | 16 | hlist :: [Dynamic] 17 | hlist = [ toDyn "string" 18 | , toDyn (7 :: Int) 19 | , toDyn 'x' 20 | ] 21 | 22 | data Showable 23 | where 24 | ToShowable :: Show a => a -> Showable 25 | 26 | 27 | -- data Showable = forall a . Show a => ToShowable a 28 | 29 | hlist' :: [Showable] 30 | hlist' = [ pack "string" 31 | , pack (7 :: Int) 32 | , pack 'x' 33 | , pack (Just ()) 34 | ] 35 | 36 | pack :: Show a => a -> Showable 37 | pack = ToShowable 38 | 39 | main :: IO () 40 | main = print $ map f hlist' 41 | where 42 | f (ToShowable a) = show a 43 | -------------------------------------------------------------------------------- /element_buffer/junk2.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ExistentialQuantification #-} 2 | -- 3 | -- An existential type encapsulating types that can be Shown 4 | -- The interface to the type is held in the show method dictionary 5 | -- 6 | -- Create your own typeclass for packing up other interfaces 7 | -- 8 | data Showable = forall a . Show a => ToShowable a 9 | 10 | -- 11 | -- And a nice existential builder 12 | -- 13 | pack :: Show a => a -> Showable 14 | pack = ToShowable 15 | 16 | -- 17 | -- A heteoregenous list of Showable values 18 | -- 19 | hlist :: [Showable] 20 | hlist = [ pack 3 21 | , pack 'x' 22 | , pack pi 23 | , pack "string" 24 | , pack (Just ()) ] 25 | 26 | -- 27 | -- The only thing we can do to Showable values is show them 28 | -- 29 | main :: IO () 30 | main = print $ map f hlist 31 | where 32 | f (ToShowable a) = show a 33 | -------------------------------------------------------------------------------- /element_buffer/output.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/element_buffer/output.png -------------------------------------------------------------------------------- /element_buffer/test.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/element_buffer/test.png -------------------------------------------------------------------------------- /minimumBoilerplate/README.md: -------------------------------------------------------------------------------- 1 | This is a bare-bones version OpenGL template in haskell. 2 | 3 | This works well with OpenGL 4.4.0 NVIDIA 361.18 4 | Lenovo E431 (2014) laptop, running nVidia GeForce GT 740M/PCIe/SSE2 5 | 6 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/minimumBoilerplate/output.png) -------------------------------------------------------------------------------- /minimumBoilerplate/Shaders/shader.frag: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | // Interpolated values from the vertex shaders 4 | uniform sampler2D tex; 5 | 6 | // Ouput data 7 | out vec4 fColor; 8 | 9 | void main() 10 | { 11 | fColor = vec4(0.0, 0.0, 1.0, 1.0); 12 | } 13 | -------------------------------------------------------------------------------- /minimumBoilerplate/Shaders/shader.vert: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec4 vPosition; 4 | 5 | void main() 6 | { 7 | gl_Position = vPosition; 8 | } 9 | -------------------------------------------------------------------------------- /minimumBoilerplate/output.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/minimumBoilerplate/output.png -------------------------------------------------------------------------------- /rectangle_with_texture_blending/Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | make clean 3 | ghc ./Main.hs -o Main 4 | 5 | clean: 6 | @if [ -f ./Main ];\ 7 | then\ 8 | rm ./Main 2> /dev/null;\ 9 | else\ 10 | echo "./Main already clean";\ 11 | fi 12 | 13 | @if [ -f ./Main.o ];\ 14 | then\ 15 | rm ./Main.o 2> /dev/null;\ 16 | else\ 17 | echo "./Main.o already clean";\ 18 | fi 19 | 20 | run: 21 | make clean && make && gpu ./Main 22 | -------------------------------------------------------------------------------- /rectangle_with_texture_blending/NGL/Shape.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE InstanceSigs #-} 3 | 4 | module NGL.Shape where 5 | 6 | import Graphics.Rendering.OpenGL (Vertex4(..), 7 | TexCoord2(..), 8 | GLclampf(..)) 9 | 10 | 11 | data Shape = Square Point Side 12 | deriving Show 13 | 14 | type VertexArray =[Vertex4 Float] 15 | type UV =[TexCoord2 Float] 16 | type Point =(Float, Float) 17 | type Points =[Point] 18 | type Radius = Float 19 | type Side = Float 20 | type Divisions = Int 21 | type Texture = String 22 | 23 | type Drawable = ([Vertex4 Float],[TexCoord2 Float],String) 24 | 25 | toDrawable :: Shape -> Drawable 26 | toDrawable x = (vs, uv, tex) 27 | where 28 | vs' = toPoints x 29 | uv = map toTexCoord2 vs' 30 | vs = map toVertex4 $ vs' 31 | tex = "test.png" 32 | 33 | toPoints :: Shape -> [Point] 34 | toPoints (Square pos side) = square pos side 35 | 36 | toVertexArray :: [Point] -> VertexArray 37 | toVertexArray xs = map toVertex4 xs 38 | 39 | toVertex4 :: Point -> Vertex4 Float 40 | toVertex4 p = (\(k,l) -> Vertex4 k l 0 1) p 41 | 42 | toTextureCoord2 :: [Point] -> UV 43 | toTextureCoord2 xs = map (\(k,l) -> TexCoord2 k l) xs 44 | 45 | toTexCoord2 :: (a, a) -> TexCoord2 a 46 | toTexCoord2 p = (\(k,l) -> TexCoord2 k l) p 47 | 48 | data Projection = Planar 49 | deriving Show 50 | 51 | toUV :: Projection -> UV 52 | toUV Planar = toTextureCoord2 ps 53 | where ps = [(1.0, 1.0),( 0.0, 1.0),( 0.0, 0.0) 54 | ,(1.0, 1.0),( 0.0, 0.0),( 1.0, 0.0)]::Points 55 | 56 | square :: Point -> Float -> [Point] 57 | square pos side = [p1, p2, p3, 58 | p1, p3, p4] 59 | where 60 | x = fst pos 61 | y = snd pos 62 | r = side/2 63 | p1 = (x + r, y + r) 64 | p2 = (x - r, y + r) 65 | p3 = (x - r, y - r) 66 | p4 = (x + r, y - r) 67 | -------------------------------------------------------------------------------- /rectangle_with_texture_blending/NGL/Texture.hs: -------------------------------------------------------------------------------- 1 | module Texture 2 | ( 3 | loadGLTextureFromFile, 4 | 5 | ) where 6 | 7 | import Graphics.Rendering.OpenGL 8 | import Graphics.GLUtil 9 | import Codec.Picture 10 | import qualified Graphics.Rendering.OpenGL as GL 11 | import qualified Graphics.GLUtil as GLU 12 | import qualified Codec.Picture as Pic 13 | 14 | loadGLTextureFromFile :: FilePath -> IO GL.TextureObject 15 | loadGLTextureFromFile f = do t <- either error id <$> readTexture f 16 | textureFilter Texture2D $= ((Linear', Nothing), Linear') 17 | texture2DWrap $= (Mirrored, ClampToEdge) 18 | return t 19 | -------------------------------------------------------------------------------- /rectangle_with_texture_blending/NGL/Utils.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- | Module : Data 4 | -- | Copyright : (c) Vladimir Lopatin 2014 5 | -- | License : BSD3 6 | -- | 7 | -- | Maintainer : Vladimir Lopatin 8 | -- | Stability : experimental 9 | -- | Portability : untested 10 | -- | 11 | -- | Utils : utilities, helper functions 12 | -- | 13 | -------------------------------------------------------------------------------- 14 | 15 | module NGL.Utils where 16 | 17 | 18 | -- | Group list into indevidual pairs: [1,2,3,4] => [(1,2),(3,4)]. 19 | -- Works only with even number of elements 20 | pairs :: [t] -> [(t, t)] 21 | pairs [] = [] 22 | pairs [x] = error "Non-even list for pair function" 23 | pairs (x:y:xs) = (x,y):pairs xs 24 | 25 | -- | Undo pairs function 26 | fromPairs :: [(a, a)] -> [a] 27 | fromPairs [] = [] 28 | fromPairs ((x,y):xs) = x:y:fromPairs xs 29 | 30 | -- implement/bind delaunay somewhere here 31 | -------------------------------------------------------------------------------- /rectangle_with_texture_blending/NGL/clean: -------------------------------------------------------------------------------- 1 | rm -rf ./*.hs~ 2 | rm -rf ./*.hi 3 | rm -rf ./*.o -------------------------------------------------------------------------------- /rectangle_with_texture_blending/NGL/test.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/rectangle_with_texture_blending/NGL/test.png -------------------------------------------------------------------------------- /rectangle_with_texture_blending/README.md: -------------------------------------------------------------------------------- 1 | Tutorial 10, 2 | 3 | ... were we are drawing a textured rectangle: 4 | 5 | This tutorial has a goal to use minimum unrelated code structures, 6 | while keeping the basic boilerplate, developed in previous tutorials. 7 | 8 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/tutorial10/output.png) -------------------------------------------------------------------------------- /rectangle_with_texture_blending/Resources/Textures/awesomeface.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/rectangle_with_texture_blending/Resources/Textures/awesomeface.png -------------------------------------------------------------------------------- /rectangle_with_texture_blending/Resources/Textures/container.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/rectangle_with_texture_blending/Resources/Textures/container.jpg -------------------------------------------------------------------------------- /rectangle_with_texture_blending/Shaders/shader.frag: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | // Interpolated values from the vertex shaders 4 | in vec3 clr; 5 | in vec2 uv; 6 | uniform sampler2D tex_00; 7 | uniform sampler2D tex_01; 8 | 9 | // Ouput data 10 | out vec4 fColor; 11 | 12 | void main() 13 | { 14 | fColor = vec4(((texture(tex_00, uv).rgb) * 0.5 + 15 | (texture(tex_01, uv).rgb) * 0.5) * clr, 16 | 1.0); 17 | //fColor = vec4(uv, 1.0, 1.0); 18 | } 19 | -------------------------------------------------------------------------------- /rectangle_with_texture_blending/Shaders/shader.vert: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec3 vPosition; 4 | layout(location = 1) in vec3 vColor; 5 | layout(location = 2) in vec2 uvCoords; 6 | 7 | // Output data ; will be interpolated for each fragment. 8 | out vec3 clr; 9 | out vec2 uv; 10 | 11 | void main() 12 | { 13 | gl_Position = vec4(vPosition, 1.0); 14 | 15 | // The color of each vertex will be interpolated 16 | // to produce the color of each fragment 17 | clr = vColor; 18 | uv = uvCoords; 19 | } 20 | -------------------------------------------------------------------------------- /rectangle_with_texture_blending/output.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/rectangle_with_texture_blending/output.png -------------------------------------------------------------------------------- /rectangle_with_texture_blending/test.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/rectangle_with_texture_blending/test.png -------------------------------------------------------------------------------- /tutorial00-cabalized/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for tutorial00-cabalized 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /tutorial00-cabalized/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Vladimir Lopatin (c) 2017 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Vladimir Lopatin nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /tutorial00-cabalized/README.md: -------------------------------------------------------------------------------- 1 | A basic OpenGL Haskell application. A "Hello World" of Haskell OpenGL. 2 | 3 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/tutorial00/tutorial01.png) 4 | -------------------------------------------------------------------------------- /tutorial00-cabalized/app/Main.hs: -------------------------------------------------------------------------------- 1 | import Graphics.Rendering.OpenGL as GL 2 | import Graphics.UI.GLFW as GLFW 3 | 4 | main :: IO () 5 | main = do 6 | GLFW.init 7 | GLFW.defaultWindowHints 8 | Just win <- GLFW.createWindow 640 480 "GLFW Demo" Nothing Nothing 9 | GLFW.makeContextCurrent (Just win) 10 | onDisplay win 11 | GLFW.destroyWindow win 12 | GLFW.terminate 13 | 14 | onDisplay :: Window -> IO () 15 | onDisplay win = do 16 | GL.clearColor $= Color4 1 0 0 1 17 | GL.clear [ColorBuffer] 18 | GLFW.swapBuffers win 19 | onDisplay win 20 | -------------------------------------------------------------------------------- /tutorial00-cabalized/tutorial00-cabalized.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: tutorial00-cabalized 3 | version: 0.2.0.0 4 | license: BSD-3-Clause 5 | license-file: LICENSE 6 | author: madiestic 7 | maintainer: madjestic13@gmail.com 8 | copyright: Vladimir Lopatin 9 | extra-source-files: CHANGELOG.md 10 | 11 | executable tutorial00 12 | main-is: Main.hs 13 | build-depends: base ^>=4.16.4.0 14 | , GLFW-b 15 | , OpenGL 16 | hs-source-dirs: app 17 | default-language: Haskell2010 18 | -------------------------------------------------------------------------------- /tutorial00-cabalized/tutorial01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/tutorial00-cabalized/tutorial01.png -------------------------------------------------------------------------------- /tutorial00/Main.hs: -------------------------------------------------------------------------------- 1 | import Graphics.Rendering.OpenGL as GL 2 | import Graphics.UI.GLFW as GLFW 3 | 4 | main :: IO () 5 | main = do 6 | GLFW.init 7 | GLFW.defaultWindowHints 8 | Just win <- GLFW.createWindow 640 480 "GLFW Demo" Nothing Nothing 9 | GLFW.makeContextCurrent (Just win) 10 | onDisplay win 11 | GLFW.destroyWindow win 12 | GLFW.terminate 13 | 14 | onDisplay :: Window -> IO () 15 | onDisplay win = do 16 | GL.clearColor $= Color4 1 0 0 1 17 | GL.clear [ColorBuffer] 18 | GLFW.swapBuffers win 19 | onDisplay win 20 | -------------------------------------------------------------------------------- /tutorial00/README.md: -------------------------------------------------------------------------------- 1 | A basic OpenGL Haskell application. A "Hello World" of Haskell OpenGL. 2 | 3 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/tutorial00/tutorial01.png) 4 | -------------------------------------------------------------------------------- /tutorial00/tutorial01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/tutorial00/tutorial01.png -------------------------------------------------------------------------------- /tutorial01/Main.hs: -------------------------------------------------------------------------------- 1 | import Graphics.Rendering.OpenGL as GL 2 | import Graphics.UI.GLFW as GLFW 3 | import Control.Monad 4 | import System.Exit ( exitWith, ExitCode(..) ) 5 | 6 | 7 | resizeWindow :: GLFW.WindowSizeCallback 8 | resizeWindow win w h = 9 | do 10 | GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h)) 11 | GL.matrixMode $= GL.Projection 12 | GL.loadIdentity 13 | GL.ortho2D 0 (realToFrac w) (realToFrac h) 0 14 | 15 | 16 | keyPressed :: GLFW.KeyCallback 17 | keyPressed win GLFW.Key'Escape _ GLFW.KeyState'Pressed _ = shutdown win 18 | keyPressed _ _ _ _ _ = return () 19 | 20 | 21 | shutdown :: GLFW.WindowCloseCallback 22 | shutdown win = do 23 | GLFW.destroyWindow win 24 | GLFW.terminate 25 | _ <- exitWith ExitSuccess 26 | return () 27 | 28 | 29 | main :: IO () 30 | main = do 31 | GLFW.init 32 | GLFW.defaultWindowHints 33 | Just win <- GLFW.createWindow 640 480 "GLFW Demo" Nothing Nothing 34 | GLFW.makeContextCurrent (Just win) 35 | GLFW.setWindowSizeCallback win (Just resizeWindow) 36 | GLFW.setKeyCallback win (Just keyPressed) 37 | GLFW.setWindowCloseCallback win (Just shutdown) 38 | onDisplay win 39 | GLFW.destroyWindow win 40 | GLFW.terminate 41 | 42 | 43 | onDisplay :: Window -> IO () 44 | onDisplay win = do 45 | GL.clearColor $= Color4 1 0 0 1 46 | GL.clear [ColorBuffer] 47 | GLFW.swapBuffers win 48 | 49 | forever $ do 50 | GLFW.pollEvents 51 | onDisplay win 52 | 53 | 54 | -------------------------------------------------------------------------------- /tutorial01/README.md: -------------------------------------------------------------------------------- 1 | A basic OpenGL Haskell application. A "Hello World" of Haskell OpenGL. 2 | Extended with basic callbacks: 3 | 1) ESC to close the window 4 | 2) Resize call back to redraw the opengl context when the application window is resized. 5 | 6 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/tutorial00/tutorial01.png) 7 | -------------------------------------------------------------------------------- /tutorial01/tutorial01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/tutorial01/tutorial01.png -------------------------------------------------------------------------------- /tutorial02/LoadShaders.hs: -------------------------------------------------------------------------------- 1 | module LoadShaders ( 2 | ShaderSource(..), ShaderInfo(..), loadShaders 3 | ) where 4 | 5 | import Control.Exception 6 | import Control.Monad 7 | import qualified Data.ByteString as B 8 | import Graphics.Rendering.OpenGL 9 | 10 | -------------------------------------------------------------------------------- 11 | 12 | -- | The source of the shader source code. 13 | 14 | data ShaderSource = 15 | ByteStringSource B.ByteString 16 | -- ^ The shader source code is directly given as a 'B.ByteString'. 17 | | StringSource String 18 | -- ^ The shader source code is directly given as a 'String'. 19 | | FileSource FilePath 20 | -- ^ The shader source code is located in the file at the given 'FilePath'. 21 | deriving ( Eq, Ord, Show ) 22 | 23 | getSource :: ShaderSource -> IO B.ByteString 24 | getSource (ByteStringSource bs) = return bs 25 | getSource (StringSource str) = return $ packUtf8 str 26 | getSource (FileSource path) = B.readFile path 27 | 28 | -------------------------------------------------------------------------------- 29 | 30 | -- | A description of a shader: The type of the shader plus its source code. 31 | 32 | data ShaderInfo = ShaderInfo ShaderType ShaderSource 33 | deriving ( Eq, Ord, Show ) 34 | 35 | -------------------------------------------------------------------------------- 36 | 37 | -- | Create a new program object from the given shaders, throwing an 38 | -- 'IOException' if something goes wrong. 39 | 40 | loadShaders :: [ShaderInfo] -> IO Program 41 | loadShaders infos = 42 | createProgram `bracketOnError` deleteObjectName $ \program -> do 43 | loadCompileAttach program infos 44 | linkAndCheck program 45 | return program 46 | 47 | linkAndCheck :: Program -> IO () 48 | linkAndCheck = checked linkProgram linkStatus programInfoLog "link" 49 | 50 | loadCompileAttach :: Program -> [ShaderInfo] -> IO () 51 | loadCompileAttach _ [] = return () 52 | loadCompileAttach program (ShaderInfo shType source : infos) = 53 | createShader shType `bracketOnError` deleteObjectName $ \shader -> do 54 | src <- getSource source 55 | shaderSourceBS shader $= src 56 | compileAndCheck shader 57 | attachShader program shader 58 | loadCompileAttach program infos 59 | 60 | compileAndCheck :: Shader -> IO () 61 | compileAndCheck = checked compileShader compileStatus shaderInfoLog "compile" 62 | 63 | checked :: (t -> IO ()) 64 | -> (t -> GettableStateVar Bool) 65 | -> (t -> GettableStateVar String) 66 | -> String 67 | -> t 68 | -> IO () 69 | checked action getStatus getInfoLog message object = do 70 | action object 71 | ok <- get (getStatus object) 72 | unless ok $ do 73 | infoLog <- get (getInfoLog object) 74 | fail (message ++ " log: " ++ infoLog) 75 | -------------------------------------------------------------------------------- /tutorial02/LoadShaders.o: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/tutorial02/LoadShaders.o -------------------------------------------------------------------------------- /tutorial02/Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | make clean 3 | ghc ./Main.hs -o Main 4 | 5 | clean: 6 | @if [ -f ./Main ];\ 7 | then\ 8 | rm ./Main 2> /dev/null;\ 9 | else\ 10 | echo "./Main already clean";\ 11 | fi 12 | -------------------------------------------------------------------------------- /tutorial02/README.md: -------------------------------------------------------------------------------- 1 | A basic OpenGL Haskell application. A "Hello World" of Haskell OpenGL. 2 | Extended with basic callbacks and drawing functions. 3 | 1) ESC to close the window 4 | 2) Resize call back to redraw the opengl context when the application window is resized. 5 | 3) Draws 2 triangles with red background 6 | 7 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/tutorial02/output.png) 8 | -------------------------------------------------------------------------------- /tutorial02/output.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/tutorial02/output.png -------------------------------------------------------------------------------- /tutorial02/shader.frag: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | out vec4 fColor; 4 | void 5 | main() 6 | { 7 | fColor = vec4(0.0, 0.0, 1.0, 1.0); 8 | } -------------------------------------------------------------------------------- /tutorial02/shader.vert: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec4 vPosition; 4 | 5 | void 6 | main() 7 | { 8 | gl_Position = vPosition; 9 | } -------------------------------------------------------------------------------- /tutorial03/Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | make clean 3 | ghc ./Main.hs -o Main 4 | 5 | clean: 6 | @if [ -f ./Main ];\ 7 | then\ 8 | rm ./Main 2> /dev/null;\ 9 | else\ 10 | echo "./Main already clean";\ 11 | fi 12 | -------------------------------------------------------------------------------- /tutorial03/README.md: -------------------------------------------------------------------------------- 1 | A basic OpenGL Haskell application. A "Hello World" of Haskell OpenGL. 2 | Extended with basic callbacks and frawing functions. 3 | 4 | 1. ESC to close the window. 5 | 2. Resize call back to redraw the opengl context when the application window is resized. 6 | 3. Draws 2 triangles with red background. 7 | 4. Triangles are textured. 8 | 9 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/tutorial03/output.png) 10 | -------------------------------------------------------------------------------- /tutorial03/output.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/tutorial03/output.png -------------------------------------------------------------------------------- /tutorial03/shader.frag: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | // Interpolated values from the vertex shaders 4 | in vec2 uv; 5 | uniform sampler2D tex; 6 | 7 | // Ouput data 8 | out vec4 fColor; 9 | 10 | void main() 11 | { 12 | fColor = vec4(texture(tex, uv).rgb, 1.0); 13 | } 14 | -------------------------------------------------------------------------------- /tutorial03/shader.vert: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec4 vPosition; 4 | layout(location = 2) in vec2 uvCoords; 5 | 6 | // Output data ; will be interpolated for each fragment. 7 | out vec2 uv; 8 | 9 | void main() 10 | { 11 | gl_Position = vPosition; 12 | 13 | // The color of each vertex will be interpolated 14 | // to produce the color of each fragment 15 | uv = uvCoords; 16 | } -------------------------------------------------------------------------------- /tutorial03/test.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/tutorial03/test.png -------------------------------------------------------------------------------- /tutorial04/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import NGL.Shape 4 | import NGL.Rendering 5 | 6 | main :: IO () 7 | main = do 8 | let prims = [ shape $ Triangle (0.0,1.0) (-1.0,-1.0) (1.0,-1.0) 9 | ] 10 | win <- createWindow "My First Window" (512,512) 11 | drawInWindow win prims 12 | closeWindow win 13 | -------------------------------------------------------------------------------- /tutorial04/NGL/Utils.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- | Module : Data 4 | -- | Copyright : (c) Vladimir Lopatin 2014 5 | -- | License : BSD3 6 | -- | 7 | -- | Maintainer : Vladimir Lopatin 8 | -- | Stability : experimental 9 | -- | Portability : untested 10 | -- | 11 | -- | TinyMath library - a set of basic mathematical functions from: 12 | -- | trigonometry 13 | -- | 14 | -- | basic shapes types should be of 2 kinds: 15 | -- | Shapes positioned by center 16 | -- | Shapes' positioned by bottom-left corner-- 17 | -------------------------------------------------------------------------------- 18 | 19 | module NGL.Utils where 20 | 21 | type Matrix2D = (Float, Float, 22 | Float, Float) 23 | 24 | 25 | -- | converts degrees to radians 26 | toRadians :: Float -> Float 27 | toRadians x = x*pi/180 28 | 29 | 30 | -- | converts radians to degrees 31 | fromRadians :: Float -> Float 32 | fromRadians x = x/pi*180 33 | 34 | rotate2D' :: Float -> [(Float, Float)] -> [(Float, Float)] 35 | rotate2D' a = map (rotate2D a) 36 | 37 | rotate2D :: Float -> (Float, Float) -> (Float, Float) 38 | rotate2D theta (x,y) = (x',y') 39 | where 40 | x' = x * cos theta - y * sin theta 41 | y' = x * sin theta + y * cos theta 42 | 43 | 44 | normalize :: (Float, Float) -> (Float, Float) 45 | normalize v@(x,y) = (x*len', y*len') 46 | where 47 | len' = 1.0/len v 48 | 49 | len :: (Float, Float) -> Float 50 | len (x,y) = sqrt(x*x+y*y) 51 | 52 | 53 | -- | multiply matrix by vector 54 | mulMatrVect :: Matrix2D -> (Float, Float) -> (Float, Float) 55 | mulMatrVect (x1,x2,y1,y2) (x,y) = ((x1+x2)*x,(y1+y2)*y) 56 | 57 | 58 | addVectors :: (Float, Float) -> (Float, Float) -> (Float, Float) 59 | addVectors (x1,y1) (x2,y2) = (x1+x2, y1+y2) 60 | 61 | 62 | -- | Group list into indevidual pairs: [1,2,3,4] => [(1,2),(3,4)]. 63 | -- Works only with even number of elements 64 | pairs :: [t] -> [(t, t)] 65 | pairs [] = [] 66 | pairs [x] = error "Non-even list for pair function" 67 | pairs (x:y:xs) = (x,y):pairs xs 68 | 69 | -- | Undo pairs function 70 | fromPairs :: [(a, a)] -> [a] 71 | fromPairs [] = [] 72 | fromPairs ((x,y):xs) = x:y:fromPairs xs 73 | 74 | 75 | -------------------------------------------------------------------------------- /tutorial04/README.md: -------------------------------------------------------------------------------- 1 | In this tutorial we are looking at Vertex Colors support: 2 | 3 | Credits: 4 | 5 | I would like to thank [Sven Panne](https://github.com/svenpanne ) 6 | for providing valuable advice on OpenGL statefulness 7 | as well as creating a great set of [examples](https://github.com/haskell-opengl/GLUT/blob/master/examples/RedBook8/Chapter01/Triangles.hs). 8 | Without his work, this set of tutorials may not be possible, 9 | parts and bits of ios source code is used in various shapes and forms throught these pages. 10 | 11 | Sven has recently uploaded a bare-bones [vertex-color triangle example](https://github.com/haskell-opengl/GLUT/tree/master/examples/Misc/ColorTriangle) 12 | Somebody may find it more useful to follow, because in this tutorial the code related to vertex colors is coupled with NGL. 13 | 14 | 15 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/tutorial04/tutorial04_fixed.png) 16 | -------------------------------------------------------------------------------- /tutorial04/Shaders/triangles.frac: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | // Interpolated values from the vertex shaders 4 | in vec4 fragmentColor; 5 | 6 | // Ouput data 7 | out vec4 fColor; 8 | 9 | void 10 | main() 11 | { 12 | fColor = fragmentColor; 13 | } -------------------------------------------------------------------------------- /tutorial04/Shaders/triangles.vert: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec4 vPosition; 4 | layout(location = 1) in vec4 vertexColor; 5 | 6 | // Output data ; will be interpolated for each fragment. 7 | out vec4 fragmentColor; 8 | 9 | void 10 | main() 11 | { 12 | gl_Position = vPosition; 13 | 14 | // The color of each vertex will be interpolated 15 | // to produce the color of each fragment 16 | fragmentColor = vertexColor; 17 | } -------------------------------------------------------------------------------- /tutorial04/tutorial04_error_in_the_code.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/tutorial04/tutorial04_error_in_the_code.png -------------------------------------------------------------------------------- /tutorial04/tutorial04_fixed.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/tutorial04/tutorial04_fixed.png -------------------------------------------------------------------------------- /tutorial05/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import NGL.Shape 4 | import NGL.Rendering 5 | 6 | main :: IO () 7 | main = do 8 | let drawables = 9 | [toDrawable Red $ Square (-0.5, -0.5) 1.0, 10 | toDrawable Green $ Circle (0.5, 0.5) 0.5 100, 11 | toDrawable Blue $ Rect (-1.0,0.33) (0.0,0.66), 12 | toDrawable White $ Polyline [ (0.0,-0.66) 13 | ,(0.33,-0.33) 14 | ,(0.66,-0.66) 15 | ,(1.0,-0.33)] 16 | 0.01 17 | ] 18 | 19 | window <- createWindow "NGL is Not GLoss" (512,512) 20 | drawIn Default window drawables 21 | closeWindow window 22 | 23 | -------------------------------------------------------------------------------- /tutorial05/NGL/Utils.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- | Module : Data 4 | -- | Copyright : (c) Vladimir Lopatin 2014 5 | -- | License : BSD3 6 | -- | 7 | -- | Maintainer : Vladimir Lopatin 8 | -- | Stability : experimental 9 | -- | Portability : untested 10 | -- | 11 | -- | TinyMath library - a set of basic mathematical functions from: 12 | -- | trigonometry 13 | -- | 14 | -- | basic shapes types should be of 2 kinds: 15 | -- | Shapes positioned by center 16 | -- | Shapes' positioned by bottom-left corner-- 17 | -------------------------------------------------------------------------------- 18 | 19 | module NGL.Utils where 20 | 21 | type Matrix2D = (Float, Float, 22 | Float, Float) 23 | 24 | 25 | -- | converts degrees to radians 26 | toRadians :: Float -> Float 27 | toRadians x = x*pi/180 28 | 29 | 30 | -- | converts radians to degrees 31 | fromRadians :: Float -> Float 32 | fromRadians x = x/pi*180 33 | 34 | rotate2D' :: Float -> [(Float, Float)] -> [(Float, Float)] 35 | rotate2D' a = map (rotate2D a) 36 | 37 | rotate2D :: Float -> (Float, Float) -> (Float, Float) 38 | rotate2D theta (x,y) = (x',y') 39 | where 40 | x' = x * cos theta - y * sin theta 41 | y' = x * sin theta + y * cos theta 42 | 43 | 44 | normalize :: (Float, Float) -> (Float, Float) 45 | normalize v@(x,y) = (x*len', y*len') 46 | where 47 | len' = 1.0/len v 48 | 49 | len :: (Float, Float) -> Float 50 | len (x,y) = sqrt(x*x+y*y) 51 | 52 | 53 | -- | multiply matrix by vector 54 | mulMatrVect :: Matrix2D -> (Float, Float) -> (Float, Float) 55 | mulMatrVect (x1,x2,y1,y2) (x,y) = ((x1+x2)*x,(y1+y2)*y) 56 | 57 | 58 | addVectors :: (Float, Float) -> (Float, Float) -> (Float, Float) 59 | addVectors (x1,y1) (x2,y2) = (x1+x2, y1+y2) 60 | 61 | 62 | -- | Group list into indevidual pairs: [1,2,3,4] => [(1,2),(3,4)]. 63 | -- Works only with even number of elements 64 | pairs :: [t] -> [(t, t)] 65 | pairs [] = [] 66 | pairs [x] = error "Non-even list for pair function" 67 | pairs (x:y:xs) = (x,y):pairs xs 68 | 69 | -- | Undo pairs function 70 | fromPairs :: [(a, a)] -> [a] 71 | fromPairs [] = [] 72 | fromPairs ((x,y):xs) = x:y:fromPairs xs 73 | 74 | 75 | -------------------------------------------------------------------------------- /tutorial05/README.md: -------------------------------------------------------------------------------- 1 | Haskell-OpenGL-Tutorial 2 | ======================= 3 | 4 | In this tutorial we sugarise the interface to NGL with polymorphic functions. 5 | 6 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/tutorial05/tutorial05.png) 7 | 8 | ```haskell 9 | module Main where 10 | 11 | import NGL.Shape 12 | import NGL.Rendering 13 | 14 | main :: IO () 15 | main = do 16 | let drawables = [toDrawable Red $ Square (-0.5, -0.5) 1.0, 17 | toDrawable Green $ Circle (0.5, 0.5) 0.5 100, 18 | toDrawable Blue $ Rect (-1.0,0.33) (0.0,0.66), 19 | toDrawable White $ Polyline [ (0.0,-0.66) 20 | ,(0.33,-0.33) 21 | ,(0.66,-0.66) 22 | ,(1.0,-0.33)] 23 | 0.01 24 | ] 25 | 26 | window <- createWindow "NGL is Not GLoss" (512,512) 27 | drawIn Default window drawables 28 | closeWindow window 29 | ``` 30 | 31 | 32 | -------------------------------------------------------------------------------- /tutorial05/Shaders/triangles.frac: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | // Interpolated values from the vertex shaders 4 | in vec4 fragmentColor; 5 | 6 | // Ouput data 7 | out vec4 fColor; 8 | 9 | void 10 | main() 11 | { 12 | fColor = fragmentColor; 13 | } -------------------------------------------------------------------------------- /tutorial05/Shaders/triangles.vert: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec4 vPosition; 4 | layout(location = 1) in vec4 vertexColor; 5 | 6 | // Output data ; will be interpolated for each fragment. 7 | out vec4 fragmentColor; 8 | 9 | void 10 | main() 11 | { 12 | gl_Position = vPosition; 13 | 14 | // The color of each vertex will be interpolated 15 | // to produce the color of each fragment 16 | fragmentColor = vertexColor; 17 | } -------------------------------------------------------------------------------- /tutorial05/tutorial05.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/tutorial05/tutorial05.png -------------------------------------------------------------------------------- /tutorial06/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import NGL.Shape 4 | import NGL.Rendering 5 | import TinyMath.TinyMath 6 | import Data.Numbers.Primes 7 | 8 | scale :: Float 9 | scale = 0.008 10 | 11 | fromSpiral :: (Float, Float, Int) -> Drawable 12 | fromSpiral (x,y,k) 13 | | isPrime k = toDrawable Red $ Square (x, y) scale 14 | | otherwise = toDrawable Blue $ Square (x, y) scale 15 | 16 | main :: IO () 17 | main = do 18 | let scaledSpiral = map (\(a,b,c) -> (scale*a,scale*b,c)) $ walkSpiral (0,0) (round $ 1/scale) 19 | let primeSpiral = map fromSpiral scaledSpiral 20 | 21 | window <- createWindow "NGL is Not GLoss" (900,900) 22 | drawIn Default window primeSpiral 23 | closeWindow window 24 | -------------------------------------------------------------------------------- /tutorial06/NGL/Utils.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- | Module : Data 4 | -- | Copyright : (c) Vladimir Lopatin 2014 5 | -- | License : BSD3 6 | -- | 7 | -- | Maintainer : Vladimir Lopatin 8 | -- | Stability : experimental 9 | -- | Portability : untested 10 | -- | 11 | -- | TinyMath library - a set of basic mathematical functions from: 12 | -- | trigonometry 13 | -- | 14 | -- | basic shapes types should be of 2 kinds: 15 | -- | Shapes positioned by center 16 | -- | Shapes' positioned by bottom-left corner-- 17 | -------------------------------------------------------------------------------- 18 | 19 | module NGL.Utils where 20 | 21 | type Matrix2D = (Float, Float, 22 | Float, Float) 23 | 24 | 25 | -- | converts degrees to radians 26 | toRadians :: Float -> Float 27 | toRadians x = x*pi/180 28 | 29 | 30 | -- | converts radians to degrees 31 | fromRadians :: Float -> Float 32 | fromRadians x = x/pi*180 33 | 34 | rotate2D' :: Float -> [(Float, Float)] -> [(Float, Float)] 35 | rotate2D' a = map (rotate2D a) 36 | 37 | rotate2D :: Float -> (Float, Float) -> (Float, Float) 38 | rotate2D theta (x,y) = (x',y') 39 | where 40 | x' = x * cos theta - y * sin theta 41 | y' = x * sin theta + y * cos theta 42 | 43 | 44 | normalize :: (Float, Float) -> (Float, Float) 45 | normalize v@(x,y) = (x*len', y*len') 46 | where 47 | len' = 1.0/len v 48 | 49 | len :: (Float, Float) -> Float 50 | len (x,y) = sqrt(x*x+y*y) 51 | 52 | 53 | -- | multiply matrix by vector 54 | mulMatrVect :: Matrix2D -> (Float, Float) -> (Float, Float) 55 | mulMatrVect (x1,x2,y1,y2) (x,y) = ((x1+x2)*x,(y1+y2)*y) 56 | 57 | 58 | addVectors :: (Float, Float) -> (Float, Float) -> (Float, Float) 59 | addVectors (x1,y1) (x2,y2) = (x1+x2, y1+y2) 60 | 61 | 62 | -- | Group list into indevidual pairs: [1,2,3,4] => [(1,2),(3,4)]. 63 | -- Works only with even number of elements 64 | pairs :: [t] -> [(t, t)] 65 | pairs [] = [] 66 | pairs [x] = error "Non-even list for pair function" 67 | pairs (x:y:xs) = (x,y):pairs xs 68 | 69 | -- | Undo pairs function 70 | fromPairs :: [(a, a)] -> [a] 71 | fromPairs [] = [] 72 | fromPairs ((x,y):xs) = x:y:fromPairs xs 73 | 74 | 75 | -------------------------------------------------------------------------------- /tutorial06/README.md: -------------------------------------------------------------------------------- 1 | Ulam Spiral 2 | 3 | It shows the distribution of Primes in in the first 10 000+ numbers. 4 | 5 | Warning: inefficient prime-test algorithm is very slow. You should replace the prime-test with a standard library function, in which case the execution time my go down by factor of 200. 6 | The visialization part and vertex arrays seems to run fast enough. Eny clues on that? 7 | 8 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/tutorial06/Riemans_spiral.png) 9 | -------------------------------------------------------------------------------- /tutorial06/Riemans_spiral.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/tutorial06/Riemans_spiral.png -------------------------------------------------------------------------------- /tutorial06/TinyMath: -------------------------------------------------------------------------------- 1 | ../../TinyMath -------------------------------------------------------------------------------- /tutorial07/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import NGL.Shape 4 | import NGL.Rendering 5 | import NGL.Utils 6 | -- import NGL.Patterns 7 | import Data.Numbers.Primes 8 | 9 | -- | p2 10 | -- | | \ 11 | -- | p3- p1 12 | serpinsky :: [Shape] -> [Shape] 13 | serpinsky [] = [] 14 | serpinsky ((Triangle p1 p2 p3):xs) = (Triangle p1 p2 p3) : serpinsky xs 15 | 16 | midPoint :: Point -> Point -> Point 17 | midPoint p1 p2 = (p2-p1)/2 + p1 -- I need to define (/) for Point and a Float 18 | 19 | copy :: Shape -> Float -> Point -> [Point] 20 | copy name s p = offset p $ scale s $ shape name 21 | 22 | main :: IO () 23 | main = do 24 | 25 | let picture = [ toDrawable Red $ Triangle (1.0,-1.0) (-1.0,1.0) (-1.0,-1.0) ] 26 | window <- createWindow "NGL is Not GLoss" (900,900) 27 | drawIn Default window picture 28 | closeWindow window 29 | 30 | -------------------------------------------------------------------------------- /tutorial07/NGL: -------------------------------------------------------------------------------- 1 | ../../NGL -------------------------------------------------------------------------------- /tutorial07/README.md: -------------------------------------------------------------------------------- 1 | WIP: Here I plan to make a Sierpinki-Triangle 2 | 3 | 4 | -------------------------------------------------------------------------------- /tutorial07/TinyMath: -------------------------------------------------------------------------------- 1 | ../../TinyMath -------------------------------------------------------------------------------- /tutorial08/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Rank2Types #-} 2 | 3 | module Main where 4 | 5 | import NGL.Shape 6 | import NGL.Rendering 7 | 8 | import Control.Applicative 9 | import Control.Monad 10 | import Graphics.UI.GLFW (pollEvents, getTime, Window) 11 | import Reactive.Banana 12 | import Reactive.Banana.Frameworks 13 | import Reactive.Banana.GLFW 14 | 15 | 16 | main :: IO () 17 | main = do 18 | let drawables = [ toDrawable White $ Circle (0.0, 0.0) 0.5 3 ] 19 | 20 | window <- createWindow "NGL is Not GLoss" (512,512) 21 | drawIn Default window drawables 22 | withEventsIn window drawables 23 | closeWindow window 24 | 25 | 26 | withEventsIn :: Window -> [Drawable] -> IO () 27 | withEventsIn window ds = do 28 | handle <- windowHandler window 29 | network <- compile $ do 30 | 31 | -- | Keyboard events 32 | keyE <- keyEvent handle 33 | reactimate $ exit window <$ filterE (match Key'Escape) keyE 34 | reactimate $ print <$> keyE 35 | 36 | let ecount = accumE 0 $ ((+1) <$ filterE (match Key'Up) keyE) `union` ((subtract 1) <$ filterE (match Key'Down) keyE) 37 | reactimate $ fmap (\x-> ( drawIn Default window [ toDrawable White $ Circle (0.0, 0.0) 1.0 (x+3)] ) ) ecount 38 | --t <- maybe 0 id <$> getTime 39 | -- let t = getTime 40 | -- reactimate $ putStrLn (maybe t) <$ filterE (match Key'T) keyE 41 | 42 | -- | Mouse events: 43 | c <- cursor handle TopLeft 44 | reactimate $ putStrLn . ("Cursor: " ++) . show <$> cursorMove c 45 | 46 | actuate network 47 | forever pollEvents 48 | -------------------------------------------------------------------------------- /tutorial08/README.md: -------------------------------------------------------------------------------- 1 | Work in Progress :: It's not finieshed yet! 2 | 3 | User Interaction 4 | 5 | Where we use [reactive-banana](https://github.com/HeinrichApfelmus/reactive-banana) as an FRP library and a brilliant [reactive-banana-glfw](https://github.com/cdxr/reactive-banana-glfw) as a glue, for interacting with the program. 6 | The number of subdivisions of a circle is controlled by Up and Down arrow keys. 7 | 8 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/tutorial08/tutorial_08.png) 9 | 10 | Future work: Next we'll combine it with animation. -------------------------------------------------------------------------------- /tutorial08/soon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/tutorial08/soon.png -------------------------------------------------------------------------------- /tutorial08/tutorial_08.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/tutorial08/tutorial_08.png -------------------------------------------------------------------------------- /tutorial09/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Rank2Types #-} 2 | 3 | module Main where 4 | 5 | import NGL.Shape 6 | import NGL.Rendering 7 | 8 | import Control.Applicative 9 | import Control.Monad 10 | import Graphics.UI.GLFW (pollEvents, Window) 11 | import Reactive.Banana 12 | import Reactive.Banana.Frameworks 13 | import Reactive.Banana.GLFW 14 | import System.Clock 15 | 16 | 17 | main :: IO () 18 | main = do 19 | let drawables = [ toDrawable White $ Circle (0.0, 0.0) 0.5 3 ] 20 | 21 | window <- createWindow "NGL is Not GLoss" (512,512) 22 | drawIn Default window drawables 23 | withEventsIn window drawables 24 | closeWindow window 25 | 26 | 27 | withEventsIn :: Window -> [Drawable] -> IO () 28 | withEventsIn window ds = do 29 | handle <- windowHandler window 30 | -- time <- getTime Realtime 31 | network <- compile $ do 32 | 33 | -- | Keyboard events 34 | keyE <- keyEvent handle 35 | reactimate $ exit window <$ filterE (match Key'Escape) keyE 36 | reactimate $ print <$> keyE 37 | 38 | let ecount = accumE 0 $ ((+1) <$ filterE (match Key'Up) keyE) `union` ((subtract 1) <$ filterE (match Key'Down) keyE) 39 | reactimate $ fmap (\x-> ( drawIn Default window [ toDrawable White $ Circle (0.0, 0.0) 1.0 (x+3)] ) ) ecount 40 | let ecount' = accumE 0 $ ((+1) <$ filterE (match Key'Up) keyE) 41 | reactimate $ (getTime Realtime >>= \x -> print (sec x)) <$ filterE (match Key'T) keyE 42 | --t <- maybe 0 id <$> getTime 43 | -- let t = getTime 44 | -- reactimate $ putStrLn (maybe t) <$ filterE (match Key'T) keyE 45 | 46 | -- | Mouse events: 47 | c <- cursor handle TopLeft 48 | reactimate $ putStrLn . ("Cursor: " ++) . show <$> cursorMove c 49 | 50 | actuate network 51 | forever pollEvents 52 | 53 | fromMaybe :: Maybe Double -> Double 54 | fromMaybe a = case a of 55 | Just a -> a 56 | Nothing -> (-1.0) 57 | -------------------------------------------------------------------------------- /tutorial09/NGL: -------------------------------------------------------------------------------- 1 | ../../NGL -------------------------------------------------------------------------------- /tutorial09/README.md: -------------------------------------------------------------------------------- 1 | Work in Progress :: It's not finieshed yet! 2 | 3 | Here we are creating a Game Loop with animation update. 4 | -------------------------------------------------------------------------------- /tutorial10/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import NGL.Shape 4 | import NGL.Rendering 5 | 6 | draw' :: Drawable -> IO () 7 | draw' drawable = do 8 | inWindow <- createWindow "NGL is Not GLoss" (512,512) 9 | draw inWindow drawable 10 | closeWindow inWindow 11 | 12 | main :: IO () 13 | main = do 14 | let drawable = toDrawable $ Square (-0.0, -0.0) 1.0 15 | draw' drawable 16 | -------------------------------------------------------------------------------- /tutorial10/NGL/NGL: -------------------------------------------------------------------------------- 1 | ../NGL/ -------------------------------------------------------------------------------- /tutorial10/NGL/Notes.org: -------------------------------------------------------------------------------- 1 | data Drawable = Shape | Picture 2 | data Picture = Shape Texture 3 | toPicture :: Shape -> Texture -> Picture 4 | data Texture = String 5 | draw :: Drawable -> IO () 6 | 7 | data Animation = Drawable -> AnimationResource 8 | data AnimationResource = [(Parameter -> Time)] 9 | Animation = Drawable -> [(Parameters -> Time)] 10 | animate :: Animation -> IO () 11 | -------------------------------------------------------------------------------- /tutorial10/NGL/Shape.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE InstanceSigs #-} 3 | 4 | module NGL.Shape where 5 | 6 | import Graphics.Rendering.OpenGL (Vertex4(..), 7 | TexCoord2(..), 8 | GLclampf(..)) 9 | 10 | 11 | data Shape = Square Point Side 12 | deriving Show 13 | 14 | type VertexArray =[Vertex4 Float] 15 | type UV =[TexCoord2 Float] 16 | type Point =(Float, Float) 17 | type Points =[Point] 18 | type Radius = Float 19 | type Side = Float 20 | type Divisions = Int 21 | type Texture = String 22 | 23 | type Drawable = ([Vertex4 Float],[TexCoord2 Float],String) 24 | 25 | toDrawable :: Shape -> Drawable 26 | toDrawable x = (vs, uv, tex) 27 | where 28 | vs' = toPoints x 29 | uv = map toTexCoord2 vs' 30 | vs = map toVertex4 $ vs' 31 | tex = "test.png" 32 | 33 | toPoints :: Shape -> [Point] 34 | toPoints (Square pos side) = square pos side 35 | 36 | toVertexArray :: [Point] -> VertexArray 37 | toVertexArray xs = map toVertex4 xs 38 | 39 | toVertex4 :: Point -> Vertex4 Float 40 | toVertex4 p = (\(k,l) -> Vertex4 k l 0 1) p 41 | 42 | toTextureCoord2 :: [Point] -> UV 43 | toTextureCoord2 xs = map (\(k,l) -> TexCoord2 k l) xs 44 | 45 | toTexCoord2 :: (a, a) -> TexCoord2 a 46 | toTexCoord2 p = (\(k,l) -> TexCoord2 k l) p 47 | 48 | data Projection = Planar 49 | deriving Show 50 | 51 | toUV :: Projection -> UV 52 | toUV Planar = toTextureCoord2 ps 53 | where ps = [(1.0, 1.0),( 0.0, 1.0),( 0.0, 0.0) 54 | ,(1.0, 1.0),( 0.0, 0.0),( 1.0, 0.0)]::Points 55 | 56 | square :: Point -> Float -> [Point] 57 | square pos side = [p1, p2, p3, 58 | p1, p3, p4] 59 | where 60 | x = fst pos 61 | y = snd pos 62 | r = side/2 63 | p1 = (x + r, y + r) 64 | p2 = (x - r, y + r) 65 | p3 = (x - r, y - r) 66 | p4 = (x + r, y - r) 67 | -------------------------------------------------------------------------------- /tutorial10/NGL/Texture.hs: -------------------------------------------------------------------------------- 1 | module Texture 2 | ( 3 | loadGLTextureFromFile, 4 | 5 | ) where 6 | 7 | import Graphics.Rendering.OpenGL 8 | import Graphics.GLUtil 9 | import Codec.Picture 10 | import qualified Graphics.Rendering.OpenGL as GL 11 | import qualified Graphics.GLUtil as GLU 12 | import qualified Codec.Picture as Pic 13 | 14 | loadGLTextureFromFile :: FilePath -> IO GL.TextureObject 15 | loadGLTextureFromFile f = do t <- either error id <$> readTexture f 16 | textureFilter Texture2D $= ((Linear', Nothing), Linear') 17 | texture2DWrap $= (Mirrored, ClampToEdge) 18 | return t 19 | -------------------------------------------------------------------------------- /tutorial10/NGL/TinyMath: -------------------------------------------------------------------------------- 1 | /home/madjestic/Projects/Haskell/TinyMath -------------------------------------------------------------------------------- /tutorial10/NGL/Utils.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- | Module : Data 4 | -- | Copyright : (c) Vladimir Lopatin 2014 5 | -- | License : BSD3 6 | -- | 7 | -- | Maintainer : Vladimir Lopatin 8 | -- | Stability : experimental 9 | -- | Portability : untested 10 | -- | 11 | -- | Utils : utilities, helper functions 12 | -- | 13 | -------------------------------------------------------------------------------- 14 | 15 | module NGL.Utils where 16 | 17 | 18 | -- | Group list into indevidual pairs: [1,2,3,4] => [(1,2),(3,4)]. 19 | -- Works only with even number of elements 20 | pairs :: [t] -> [(t, t)] 21 | pairs [] = [] 22 | pairs [x] = error "Non-even list for pair function" 23 | pairs (x:y:xs) = (x,y):pairs xs 24 | 25 | -- | Undo pairs function 26 | fromPairs :: [(a, a)] -> [a] 27 | fromPairs [] = [] 28 | fromPairs ((x,y):xs) = x:y:fromPairs xs 29 | 30 | -- implement/bind delaunay somewhere here 31 | -------------------------------------------------------------------------------- /tutorial10/NGL/test.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/tutorial10/NGL/test.png -------------------------------------------------------------------------------- /tutorial10/README.md: -------------------------------------------------------------------------------- 1 | Tutorial 10, 2 | 3 | ... were we are drawing a textured rectangle: 4 | 5 | This tutorial has a goal to use minimum unrelated code structures, 6 | while keeping the basic boilerplate, developed in previous tutorials. 7 | 8 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/tutorial10/output.png) -------------------------------------------------------------------------------- /tutorial10/Shaders/shader.frag: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | // Interpolated values from the vertex shaders 4 | in vec2 uv; 5 | uniform sampler2D tex; 6 | 7 | // Ouput data 8 | out vec4 fColor; 9 | 10 | void main() 11 | { 12 | fColor = vec4(texture(tex, uv).rgb, 1.0); 13 | } 14 | -------------------------------------------------------------------------------- /tutorial10/Shaders/shader.vert: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec4 vPosition; 4 | layout(location = 2) in vec2 uvCoords; 5 | 6 | // Output data ; will be interpolated for each fragment. 7 | out vec2 uv; 8 | 9 | void main() 10 | { 11 | gl_Position = vPosition; 12 | 13 | // The color of each vertex will be interpolated 14 | // to produce the color of each fragment 15 | uv = uvCoords; 16 | } -------------------------------------------------------------------------------- /tutorial10/output.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/tutorial10/output.png -------------------------------------------------------------------------------- /tutorial11/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import NGL.Shape 4 | import NGL.Rendering 5 | 6 | draw' :: Drawable -> IO () 7 | draw' drawable = do 8 | window <- createWindow "NGL is Not GLoss" (512,512) 9 | drawIn Default window drawable 10 | closeWindow window 11 | 12 | picture :: Picture 13 | picture = (Square (-0.0, -0.0) 1.0, "test.png") 14 | 15 | main :: IO () 16 | main = do 17 | let drawable = toDrawable Default $ picture 18 | draw' drawable 19 | -------------------------------------------------------------------------------- /tutorial11/README.md: -------------------------------------------------------------------------------- 1 | Tutorial 11. 2 | 3 | Where the usage of typeclasses is being explored. 4 | 5 | The program defines: 6 | 7 | class Primitive a where 8 | toDrawable :: Property -> a -> Drawable 9 | toPoints :: a -> Points 10 | 11 | where the variable 'a' can be both type 'Shape' and type 'Picture'. 12 | 13 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/tutorial11/main.png) -------------------------------------------------------------------------------- /tutorial11/TinyMath/README.md: -------------------------------------------------------------------------------- 1 | TinyMath 2 | ======== 3 | 4 | A collection of mathematical hacks that I pick up in various ways, 5 | such as along MST124 course. 6 | -------------------------------------------------------------------------------- /tutorial11/main.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/tutorial11/main.png -------------------------------------------------------------------------------- /tutorial12/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import NGL.Shape 4 | import NGL.Rendering 5 | 6 | draw' :: Drawable -> IO () 7 | draw' drawable = do 8 | window <- createWindow "NGL is Not GLoss" (512,512) 9 | drawIn Default window drawable 10 | closeWindow window 11 | 12 | main :: IO () 13 | main = do 14 | let drawable = toDrawable Red $ Square (-0.0, -0.0) 1.0 15 | draw' drawable 16 | -------------------------------------------------------------------------------- /tutorial12/NGL/NGL: -------------------------------------------------------------------------------- 1 | ../NGL/ -------------------------------------------------------------------------------- /tutorial12/NGL/TinyMath: -------------------------------------------------------------------------------- 1 | /home/madjestic/Projects/Haskell/TinyMath -------------------------------------------------------------------------------- /tutorial12/README.md: -------------------------------------------------------------------------------- 1 | A fork of cleaned-up Tutorial 10, maybe a decent boilerplate candidate. 2 | 3 | ... were we are drawing a textured rectangle: 4 | 5 | ![](https://raw.github.com/madjestic/Haskell-OpenGL-Tutorial/master/tutorial10/opengl.png) -------------------------------------------------------------------------------- /tutorial12/Shaders/triangles.frac: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | // Interpolated values from the vertex shaders 4 | in vec4 fragmentColor; 5 | in vec2 uv; 6 | uniform sampler2D tex; 7 | 8 | // Ouput data 9 | out vec4 fColor; 10 | 11 | void main() 12 | { 13 | fColor = fragmentColor; 14 | // fColor = uv; 15 | fColor = vec4(texture(tex, uv).rgb, 1.0); 16 | } 17 | -------------------------------------------------------------------------------- /tutorial12/Shaders/triangles.vert: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec4 vPosition; 4 | layout(location = 1) in vec4 vertexColor; 5 | layout(location = 2) in vec2 uvCoords; 6 | 7 | // Output data ; will be interpolated for each fragment. 8 | out vec4 fragmentColor; 9 | out vec2 uv; 10 | 11 | void main() 12 | { 13 | gl_Position = vPosition; 14 | 15 | // The color of each vertex will be interpolated 16 | // to produce the color of each fragment 17 | fragmentColor = vertexColor; 18 | uv = uvCoords; 19 | } -------------------------------------------------------------------------------- /tutorial12/opengl.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/madjestic/Haskell-OpenGL-Tutorial/b93d3a92e45a1dcf4c8182c4ddcf0259d198a410/tutorial12/opengl.png --------------------------------------------------------------------------------