├── .gitignore ├── README.md ├── res ├── audio │ └── Example.ogg ├── objects │ ├── capsule │ │ ├── capsule.mtl │ │ ├── capsule.obj │ │ └── capsule0.bmp │ ├── cube │ │ └── cube.obj │ ├── ibanez │ │ ├── ibanez.mtl │ │ ├── ibanez.obj │ │ ├── ibanez.obj.dat │ │ ├── texture0.bmp │ │ ├── texture0.jpg │ │ └── texture0.png │ ├── isengard │ │ ├── isengard.mtl │ │ ├── isengard.obj │ │ ├── texture0.jpg │ │ └── texture1.jpg │ ├── space │ │ ├── space.mtl │ │ ├── space.obj │ │ ├── space.obj.dat │ │ └── texture0.jpg │ ├── tests │ │ ├── Crate.bmp │ │ ├── Ibanez.mtl │ │ ├── car.obj │ │ ├── cube.bmp │ │ ├── mud.bmp │ │ └── teapot.obj │ ├── trunk │ │ ├── Material1noCulling.jpg │ │ ├── Material3noCulling.jpg │ │ ├── Material97noCulling.jpg │ │ ├── trunk.mtl │ │ └── trunk.obj │ ├── wow │ │ ├── texture0.jpg │ │ ├── texture1.jpg │ │ ├── texture2.jpg │ │ ├── texture3.jpg │ │ ├── wow.mtl │ │ ├── wow.obj │ │ └── wow.obj.dat │ └── wow_old │ │ ├── texture0.bmp │ │ ├── texture1.bmp │ │ ├── texture2.bmp │ │ ├── texture3.bmp │ │ ├── tim.bmp │ │ ├── wow.mtl │ │ └── wow.obj ├── shaders │ ├── correct_f.glsl │ ├── correct_v.glsl │ ├── old │ │ ├── max_f.glsl │ │ ├── max_v.glsl │ │ ├── min_f.glsl │ │ ├── min_v.glsl │ │ ├── pixelTexture_f.glsl │ │ └── pixelTexture_v.glsl │ ├── postprocessing │ │ ├── blur │ │ │ ├── blur_f.glsl │ │ │ └── blur_v.glsl │ │ ├── bumpy │ │ │ ├── bumpy_f.glsl │ │ │ └── bumpy_v.glsl │ │ ├── dof │ │ │ ├── dof_f.glsl │ │ │ └── dof_v.glsl │ │ ├── fisheye │ │ │ ├── fisheye_f.glsl │ │ │ └── fisheye_v.glsl │ │ ├── fxaa │ │ │ ├── fxaa_f.glsl │ │ │ └── fxaa_v.glsl │ │ ├── invert │ │ │ ├── invert_f.glsl │ │ │ └── invert_v.glsl │ │ ├── passthrough │ │ │ ├── passthrough_f.glsl │ │ │ └── passthrough_v.glsl │ │ ├── pixelate │ │ │ ├── pixelate_f.glsl │ │ │ └── pixelate_v.glsl │ │ ├── poster │ │ │ ├── poster_f.glsl │ │ │ └── poster_v.glsl │ │ └── sobel │ │ │ ├── sobel_f.glsl │ │ │ └── sobel_v.glsl │ ├── shadow │ │ ├── shadow2_f.glsl │ │ ├── shadow2_v.glsl │ │ ├── shadow_f.glsl │ │ └── shadow_v.glsl │ ├── tesselation │ │ ├── pass_f.glsl │ │ ├── pass_v.glsl │ │ ├── test_gs.glsl │ │ ├── test_te.glsl │ │ └── test_ts.glsl │ └── toon │ │ ├── toon_f.glsl │ │ └── toon_v.glsl └── textures │ └── grass.jpg └── src ├── Engine ├── Audio │ ├── Audio.hs │ └── Types.hs ├── Bullet │ └── Bullet.hs ├── Core │ ├── HasPosition.hs │ ├── NewTypes.hs │ ├── Types.hs │ ├── Util.hs │ ├── World.hs │ └── WorldCreator.hs ├── FRP │ ├── FRP │ └── FRP.hs ├── Graphics │ ├── Framebuffer.hs │ ├── GLSL.hs │ ├── Graphics.hs │ ├── GraphicsUtils.hs │ ├── NewGraphics.hs │ ├── Primitive.hs │ ├── Shaders.hs │ ├── Shadows.hs │ ├── Textures.hs │ ├── Types.hs │ └── Window.hs ├── Matrix │ ├── Matrix.hs │ └── NewMatrix.hs ├── Mesh │ ├── AABB.hs │ ├── DatLoader.hs │ ├── Material.hs │ ├── Mesh.hs │ └── ObjLoader.hs ├── Object │ ├── GameObject.hs │ ├── Intersect.hs │ ├── Octree.hs │ └── Player.hs ├── Save │ └── Save.hs └── Terrain │ ├── Generator.hs │ └── Noise.hs ├── Haskell-OpenGL.cb ├── Main.hs ├── Main.prof ├── Main.ticky ├── Main.trace ├── Setup.hs └── TAGS /.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | *.hi 3 | *.swp 4 | *.html 5 | *.ll 6 | *.dump* 7 | Main 8 | *.sock 9 | *.eventlog 10 | *.tix 11 | *.mix 12 | *.html 13 | *.dyn_hi 14 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 |

Haskell-OpenGL

2 |

Features

3 | - Full support for loading .obj + .mtl files. 4 | - Multipass postprocessing. 5 | - Simplex procedurally generated terrain. 6 | - GLSL 4+. 7 | - Loading and displaying of textures in a variety of formats. 8 | - Collision detection via AABBs, using Octrees for speed. 9 | - Bullet physics integration. 10 | - Uses own matrices, according to the OpenGL 2.1+ spec. 11 |

Screenshots

12 |

Simplex procedurally generated terrain.

13 | 14 | ![](http://i.imgur.com/SBSaObn.png) 15 | 16 |

Loading of models, including textures.

17 | 18 | ![](http://i.imgur.com/URxxELT.png) 19 | 20 |

Performance

21 | Benchmark was done with a procedurally generated terrain, `200x200 vertices`, with collision detection per face and an `Octree` with a max size (per leaf) of `64`. Test was performed by walking around the terrain. Benchmarked on `4/11/14` with `ghc 7.6.3`. 22 | 23 | Tested on `Arch Linux 64 bit` with 24 | - `16GB RAM` 25 | - `i5-3470 Quad-Core CPU @ 3.20GHz` 26 | 27 | Performance by GHC/GHCI command: 28 | - `ghc -O2 -funfolding-use-threshold=16` 29 | - CPU: `1-2%` 30 | - RAM: `403 MiB` 31 | - `ghc -O2 -fllvm -funfolding-use-threshold=16` 32 | - CPU: `1-2%` 33 | - RAM: `403 MiB` 34 | 35 |

Todo

36 | 37 |

Changes to Graphics API

38 | - Remove Proxies from data types; use `-XScopedTypeVariables` 39 | - Use `Data.Proxy` instead of `NatProxy` and `SymbolProxy`. (Needs `-XPolyKinds`) 40 | - Rename `HasBString` to something more clear, like `HasGLSL`. 41 | - Remove `Assignment` constructor; use `Action` instead. 42 | 43 |

Top

44 | - Possibly create a fast, polymorphic matrix library; I dont like any of the ones currently available. 45 | - Something similar to [hmatrix](https://hackage.haskell.org/package/hmatrix), but polymorphic (Not constrained to use `Double`). 46 | - Pure Haskell. 47 | - Row-major or Column-major (type-level flag variable). 48 | - Use [STVectors](https://hackage.haskell.org/package/vector-0.10.0.1/docs/Data-Vector-Mutable.html) for efficiency (Check out [bed-and-breakfast](https://hackage.haskell.org/package/bed-and-breakfast) for ideas). 49 | - Type-level width and height 50 | - May also need to define Vec type, to keep things consistent (like hmatrix). 51 | - Update performance info. 52 | - Redo Mesh AABB generation, so that it works better with Bullet physics. (Don't make an AABB for every face.) 53 | - Decrease GPU usage. 54 | - General code cleanup, make it easier to use and clearer. 55 | - More utility functions. 56 | - Better documentation / comments. 57 | - Try using criterion, QuickCheck, and SmallCheck. 58 | - Add shadow support to graphics API. 59 | - Use State Monads more. Convert functions with types like `World t -> GameObject t -> a` to `GameObject t -> Game a` 60 | - Create a FRP module, making it optional (Elerea and/or Netwire). 61 | 62 |

Fixes

63 | - Make walking more stable and efficient. 64 | 65 |

Additions

66 | - Use [mvc](https://hackage.haskell.org/package/mvc)? 67 | - Normal mapping. 68 | - AI / Pathfinding (A\*?). 69 | - Chunks or other methods to allow for infinite terrain. 70 | - When the time comes to add animations, large changes will probably need to be made, but use the [ST monad](https://hackage.haskell.org/package/base-4.7.0.0/docs/Control-Monad-ST.html) for performance, probably [STVectors](https://hackage.haskell.org/package/vector-0.10.0.1/docs/Data-Vector-Mutable.html). 71 | - Normal mapping / normal textures. 72 | - Text / GUI. 73 | - Audio support using a library. 74 | - Save files. 75 | 76 |

Performance increases

77 | - Use more parallelism. 78 | 79 |

Organization

80 | - Define classes to constrain functions, instead of forcing the use of `GameObjects`? 81 | - Better documentation / comments. 82 | 83 |

Copyright

84 | All source code in this repository is provided under the WTFPL Version 2. 85 | ``` 86 | DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE 87 | Version 2, December 2004 88 | 89 | Copyright (C) 2004 Sam Hocevar 90 | 91 | Everyone is permitted to copy and distribute verbatim or modified 92 | copies of this license document, and changing it is allowed as long 93 | as the name is changed. 94 | 95 | DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE 96 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 97 | 98 | 0. You just DO WHAT THE FUCK YOU WANT TO. 99 | ``` 100 | -------------------------------------------------------------------------------- /res/audio/Example.ogg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/audio/Example.ogg -------------------------------------------------------------------------------- /res/objects/capsule/capsule.mtl: -------------------------------------------------------------------------------- 1 | # Create as many materials as desired 2 | # Each is referenced by name before the faces it applies to in the obj file 3 | 4 | newmtl material0 5 | Ka 1.000000 1.000000 1.000000 6 | Kd 1.000000 1.000000 1.000000 7 | Ks 0.000000 0.000000 0.000000 8 | Tr 1.000000 9 | illum 1 10 | Ns 0.000000 11 | map_Kd res/objects/capsule/capsule0.bmp 12 | -------------------------------------------------------------------------------- /res/objects/capsule/capsule0.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/capsule/capsule0.bmp -------------------------------------------------------------------------------- /res/objects/cube/cube.obj: -------------------------------------------------------------------------------- 1 | # cube 2 | 3 | v 0.0 0.0 0.0 4 | v 0.0 0.0 1.0 5 | v 0.0 1.0 0.0 6 | v 0.0 1.0 1.0 7 | v 1.0 0.0 0.0 8 | v 1.0 0.0 1.0 9 | v 1.0 1.0 0.0 10 | v 1.0 1.0 1.0 11 | 12 | vn 0.0 0.0 1.0 13 | vn 0.0 0.0 -1.0 14 | vn 0.0 1.0 0.0 15 | vn 0.0 -1.0 0.0 16 | vn 1.0 0.0 0.0 17 | vn -1.0 0.0 0.0 18 | vn -1.0 0.0 0.0 19 | vn -1.0 0.0 0.0 20 | 21 | 22 | f 1//2 7//2 5//2 23 | f 1//2 3//2 7//2 24 | f 1//6 4//6 3//6 25 | f 1//6 2//6 4//6 26 | f 3//3 8//3 7//3 27 | 28 | f 3//3 4//3 8//3 29 | f 5//5 7//5 8//5 30 | f 5//5 8//5 6//5 31 | f 1//4 5//4 6//4 32 | f 1//4 6//4 2//4 33 | f 2//1 6//1 8//1 34 | 35 | f 2//1 8//1 4//1 36 | 37 | -------------------------------------------------------------------------------- /res/objects/ibanez/ibanez.mtl: -------------------------------------------------------------------------------- 1 | # Blender MTL File: 'None' 2 | # Material Count: 10 3 | 4 | newmtl FrontColorNoCulling 5 | Ns 37.254902 6 | Ka 0.000000 0.000000 0.000000 7 | Kd 0.800000 0.800000 0.800000 8 | Ks 0.165000 0.165000 0.165000 9 | Ni 1.000000 10 | d 1.000000 11 | illum 2 12 | 13 | newmtl material0 14 | Ns 37.254902 15 | Ka 0.000000 0.000000 0.000000 16 | Kd 0.709020 0.709020 0.709020 17 | Ks 0.165000 0.165000 0.165000 18 | Ni 1.000000 19 | d 1.000000 20 | illum 2 21 | 22 | newmtl material1 23 | Ns 37.254902 24 | Ka 0.000000 0.000000 0.000000 25 | Kd 0.181961 0.181961 0.181961 26 | Ks 0.165000 0.165000 0.165000 27 | Ni 1.000000 28 | d 1.000000 29 | illum 2 30 | 31 | newmtl material2 32 | Ns 37.254902 33 | Ka 0.000000 0.000000 0.000000 34 | Kd 0.683922 0.517647 0.100392 35 | Ks 0.165000 0.165000 0.165000 36 | Ni 1.000000 37 | d 1.000000 38 | illum 2 39 | 40 | newmtl material3 41 | Ns 37.254902 42 | Ka 0.000000 0.000000 0.000000 43 | Kd 0.577255 0.420392 0.034510 44 | Ks 0.165000 0.165000 0.165000 45 | Ni 1.000000 46 | d 1.000000 47 | illum 2 48 | 49 | newmtl material4 50 | Ns 37.254902 51 | Ka 0.000000 0.000000 0.000000 52 | Kd 0.094118 0.094118 0.094118 53 | Ks 0.165000 0.165000 0.165000 54 | Ni 1.000000 55 | d 1.000000 56 | illum 2 57 | 58 | newmtl material5 59 | Ns 37.254902 60 | Ka 0.000000 0.000000 0.000000 61 | Kd 0.000000 0.000000 0.401569 62 | Ks 0.165000 0.165000 0.165000 63 | Ni 1.000000 64 | d 1.000000 65 | illum 2 66 | 67 | newmtl material6 68 | Ns 37.254902 69 | Ka 0.000000 0.000000 0.000000 70 | Kd 0.191373 0.191373 0.480000 71 | Ks 0.165000 0.165000 0.165000 72 | Ni 1.000000 73 | d 1.000000 74 | illum 2 75 | 76 | newmtl material7 77 | Ns 37.254902 78 | Ka 0.000000 0.000000 0.000000 79 | Kd 0.000000 0.000000 0.000000 80 | Ks 0.165000 0.165000 0.165000 81 | Ni 1.000000 82 | d 1.000000 83 | illum 2 84 | 85 | newmtl material8 86 | Ns 37.254902 87 | Ka 0.000000 0.000000 0.000000 88 | Kd 0.640000 0.640000 0.640000 89 | Ks 0.165000 0.165000 0.165000 90 | Ni 1.000000 91 | d 1.000000 92 | illum 2 93 | map_Kd texture0.jpg 94 | -------------------------------------------------------------------------------- /res/objects/ibanez/ibanez.obj.dat: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/ibanez/ibanez.obj.dat -------------------------------------------------------------------------------- /res/objects/ibanez/texture0.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/ibanez/texture0.bmp -------------------------------------------------------------------------------- /res/objects/ibanez/texture0.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/ibanez/texture0.jpg -------------------------------------------------------------------------------- /res/objects/ibanez/texture0.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/ibanez/texture0.png -------------------------------------------------------------------------------- /res/objects/isengard/isengard.mtl: -------------------------------------------------------------------------------- 1 | # Blender MTL File: 'None' 2 | # Material Count: 5 3 | 4 | newmtl Material.001 5 | Ns 96.078431 6 | Ka 0.000000 0.000000 0.000000 7 | Kd 0.512000 0.512000 0.512000 8 | Ks 0.250000 0.250000 0.250000 9 | Ni 1.000000 10 | d 1.000000 11 | illum 2 12 | 13 | newmtl material_0_1_0 14 | Ns 96.078431 15 | Ka 0.000000 0.000000 0.000000 16 | Kd 0.640000 0.640000 0.640000 17 | Ks 0.500000 0.500000 0.500000 18 | Ni 1.000000 19 | d 1.000000 20 | illum 2 21 | map_Kd res/objects/isengard/texture0.jpg 22 | 23 | newmtl material_0_1_8 24 | Ns 96.078431 25 | Ka 0.000000 0.000000 0.000000 26 | Kd 0.640000 0.640000 0.640000 27 | Ks 0.500000 0.500000 0.500000 28 | Ni 1.000000 29 | d 1.000000 30 | illum 2 31 | map_Kd res/objects/isengard/texture0.jpg 32 | 33 | newmtl material_1_16 34 | Ns 96.078431 35 | Ka 0.000000 0.000000 0.000000 36 | Kd 0.800000 0.800000 0.800000 37 | Ks 0.500000 0.500000 0.500000 38 | Ni 1.000000 39 | d 1.000000 40 | illum 2 41 | 42 | newmtl material_2_2_8 43 | Ns 96.078431 44 | Ka 0.000000 0.000000 0.000000 45 | Kd 0.640000 0.640000 0.640000 46 | Ks 0.500000 0.500000 0.500000 47 | Ni 1.000000 48 | d 1.000000 49 | illum 2 50 | map_Kd res/objects/isengard/texture1.jpg 51 | -------------------------------------------------------------------------------- /res/objects/isengard/texture0.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/isengard/texture0.jpg -------------------------------------------------------------------------------- /res/objects/isengard/texture1.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/isengard/texture1.jpg -------------------------------------------------------------------------------- /res/objects/space/space.mtl: -------------------------------------------------------------------------------- 1 | # Blender MTL File: 'None' 2 | # Material Count: 14 3 | 4 | newmtl material_0_16.001 5 | Ns 96.078431 6 | Ka 0.000000 0.000000 0.000000 7 | Kd 0.514510 0.451765 0.332549 8 | Ks 0.500000 0.500000 0.500000 9 | Ni 1.000000 10 | d 1.000000 11 | illum 2 12 | 13 | newmtl material_0_24.001 14 | Ns 96.078431 15 | Ka 0.000000 0.000000 0.000000 16 | Kd 0.514510 0.451765 0.332549 17 | Ks 0.500000 0.500000 0.500000 18 | Ni 1.000000 19 | d 1.000000 20 | illum 2 21 | 22 | newmtl material_1_16.001 23 | Ns 96.078431 24 | Ka 0.000000 0.000000 0.000000 25 | Kd 0.269804 0.269804 0.269804 26 | Ks 0.500000 0.500000 0.500000 27 | Ni 1.000000 28 | d 1.000000 29 | illum 2 30 | 31 | newmtl material_1_24.001 32 | Ns 96.078431 33 | Ka 0.000000 0.000000 0.000000 34 | Kd 0.269804 0.269804 0.269804 35 | Ks 0.500000 0.500000 0.500000 36 | Ni 1.000000 37 | d 1.000000 38 | illum 2 39 | 40 | newmtl material_2_16.001 41 | Ns 96.078431 42 | Ka 0.000000 0.000000 0.000000 43 | Kd 0.320000 0.269804 0.254118 44 | Ks 0.500000 0.500000 0.500000 45 | Ni 1.000000 46 | d 1.000000 47 | illum 2 48 | 49 | newmtl material_2_24.001 50 | Ns 96.078431 51 | Ka 0.000000 0.000000 0.000000 52 | Kd 0.320000 0.269804 0.254118 53 | Ks 0.500000 0.500000 0.500000 54 | Ni 1.000000 55 | d 1.000000 56 | illum 2 57 | 58 | newmtl material_3_16.001 59 | Ns 96.078431 60 | Ka 0.000000 0.000000 0.000000 61 | Kd 0.480000 0.407843 0.382745 62 | Ks 0.500000 0.500000 0.500000 63 | Ni 1.000000 64 | d 1.000000 65 | illum 2 66 | 67 | newmtl material_3_24.001 68 | Ns 96.078431 69 | Ka 0.000000 0.000000 0.000000 70 | Kd 0.480000 0.407843 0.382745 71 | Ks 0.500000 0.500000 0.500000 72 | Ni 1.000000 73 | d 1.000000 74 | illum 2 75 | 76 | newmtl material_5_16.001 77 | Ns 96.078431 78 | Ka 0.000000 0.000000 0.000000 79 | Kd 0.800000 0.800000 0.800000 80 | Ks 0.500000 0.500000 0.500000 81 | Ni 1.000000 82 | d 1.000000 83 | illum 2 84 | 85 | newmtl material_6_16.001 86 | Ns 96.078431 87 | Ka 0.000000 0.000000 0.000000 88 | Kd 0.480000 0.000000 0.000000 89 | Ks 0.500000 0.500000 0.500000 90 | Ni 1.000000 91 | d 1.000000 92 | illum 2 93 | 94 | newmtl material_7_16.001 95 | Ns 96.078431 96 | Ka 0.000000 0.000000 0.000000 97 | Kd 0.000000 0.000000 0.000000 98 | Ks 0.500000 0.500000 0.500000 99 | Ni 1.000000 100 | d 1.000000 101 | illum 2 102 | 103 | newmtl material_7_24.001 104 | Ns 96.078431 105 | Ka 0.000000 0.000000 0.000000 106 | Kd 0.000000 0.000000 0.000000 107 | Ks 0.500000 0.500000 0.500000 108 | Ni 1.000000 109 | d 1.000000 110 | illum 2 111 | 112 | newmtl material_8_1_0.001 113 | Ns 96.078431 114 | Ka 0.000000 0.000000 0.000000 115 | Kd 0.640000 0.640000 0.640000 116 | Ks 0.500000 0.500000 0.500000 117 | Ni 1.000000 118 | d 1.000000 119 | illum 2 120 | map_Kd res/objects/space/texture0.jpg 121 | 122 | newmtl material_8_1_8.001 123 | Ns 96.078431 124 | Ka 0.000000 0.000000 0.000000 125 | Kd 0.640000 0.640000 0.640000 126 | Ks 0.500000 0.500000 0.500000 127 | Ni 1.000000 128 | d 1.000000 129 | illum 2 130 | map_Kd res/objects/space/texture0.jpg 131 | -------------------------------------------------------------------------------- /res/objects/space/texture0.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/space/texture0.jpg -------------------------------------------------------------------------------- /res/objects/tests/Crate.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/tests/Crate.bmp -------------------------------------------------------------------------------- /res/objects/tests/Ibanez.mtl: -------------------------------------------------------------------------------- 1 | # Blender MTL File: 'None' 2 | # Material Count: 10 3 | 4 | newmtl test1 5 | Kd 1 0 0 6 | map_Kd res/cube.bmp 7 | 8 | newmtl test2 9 | Kd 0 1 0 10 | map_Kd res/Crate.bmp 11 | 12 | newmtl test3 13 | Kd 0 0 1 14 | map_Kd res/mud.bmp 15 | 16 | newmtl FrontColorNoCulling 17 | Ns 37.254902 18 | Ka 0.000000 0.000000 0.000000 19 | Kd 0.800000 0.800000 0.800000 20 | Ks 0.165000 0.165000 0.165000 21 | Ni 1.000000 22 | d 0.000000 23 | illum 2 24 | 25 | newmtl material0 26 | Ns 37.254902 27 | Ka 0.000000 0.000000 0.000000 28 | Kd 0.709020 0.709020 0.709020 29 | Ks 0.165000 0.165000 0.165000 30 | Ni 1.000000 31 | d 0.000000 32 | illum 2 33 | 34 | newmtl material1 35 | Ns 37.254902 36 | Ka 0.000000 0.000000 0.000000 37 | Kd 0.181961 0.181961 0.181961 38 | Ks 0.165000 0.165000 0.165000 39 | Ni 1.000000 40 | d 0.000000 41 | illum 2 42 | 43 | newmtl material2 44 | Ns 37.254902 45 | Ka 0.000000 0.000000 0.000000 46 | Kd 0.683922 0.517647 0.100392 47 | Ks 0.165000 0.165000 0.165000 48 | Ni 1.000000 49 | d 0.000000 50 | illum 2 51 | 52 | newmtl material3 53 | Ns 37.254902 54 | Ka 0.000000 0.000000 0.000000 55 | Kd 0.577255 0.420392 0.034510 56 | Ks 0.165000 0.165000 0.165000 57 | Ni 1.000000 58 | d 0.000000 59 | illum 2 60 | 61 | newmtl material4 62 | Ns 37.254902 63 | Ka 0.000000 0.000000 0.000000 64 | Kd 0.094118 0.094118 0.094118 65 | Ks 0.165000 0.165000 0.165000 66 | Ni 1.000000 67 | d 0.000000 68 | illum 2 69 | 70 | newmtl material5 71 | Ns 37.254902 72 | Ka 0.000000 0.000000 0.000000 73 | Kd 0.000000 0.000000 0.401569 74 | Ks 0.165000 0.165000 0.165000 75 | Ni 1.000000 76 | d 0.000000 77 | illum 2 78 | 79 | newmtl material6 80 | Ns 37.254902 81 | Ka 0.000000 0.000000 0.000000 82 | Kd 0.191373 0.191373 0.480000 83 | Ks 0.165000 0.165000 0.165000 84 | Ni 1.000000 85 | d 0.000000 86 | illum 2 87 | 88 | newmtl material7 89 | Ns 37.254902 90 | Ka 0.000000 0.000000 0.000000 91 | Kd 0.000000 0.000000 0.000000 92 | Ks 0.165000 0.165000 0.165000 93 | Ni 1.000000 94 | d 0.000000 95 | illum 2 96 | 97 | newmtl material8 98 | Ns 37.254902 99 | Ka 0.000000 0.000000 0.000000 100 | Kd 0.640000 0.640000 0.640000 101 | Ks 0.165000 0.165000 0.165000 102 | Ni 1.000000 103 | d 0.000000 104 | illum 2 105 | map_Kd res/ibanez/texture0.png 106 | -------------------------------------------------------------------------------- /res/objects/tests/cube.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/tests/cube.bmp -------------------------------------------------------------------------------- /res/objects/tests/mud.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/tests/mud.bmp -------------------------------------------------------------------------------- /res/objects/trunk/Material1noCulling.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/trunk/Material1noCulling.jpg -------------------------------------------------------------------------------- /res/objects/trunk/Material3noCulling.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/trunk/Material3noCulling.jpg -------------------------------------------------------------------------------- /res/objects/trunk/Material97noCulling.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/trunk/Material97noCulling.jpg -------------------------------------------------------------------------------- /res/objects/trunk/trunk.mtl: -------------------------------------------------------------------------------- 1 | # Blender MTL File: 'None' 2 | # Material Count: 5 3 | 4 | newmtl Material1noCulling 5 | Ns 37.254902 6 | Ka 0.000000 0.000000 0.000000 7 | Kd 0.640000 0.640000 0.640000 8 | Ks 0.165000 0.165000 0.165000 9 | Ni 1.000000 10 | d 0.000000 11 | illum 2 12 | map_Kd res/objects/trunk/Material1noCulling.jpg 13 | 14 | newmtl Material3noCulling 15 | Ns 37.254902 16 | Ka 0.000000 0.000000 0.000000 17 | Kd 0.640000 0.640000 0.640000 18 | Ks 0.165000 0.165000 0.165000 19 | Ni 1.000000 20 | d 0.000000 21 | illum 2 22 | map_Kd res/objects/trunk/Material3noCulling.jpg 23 | 24 | newmtl Material3noCulling_Material97noCulling.jpg 25 | Ns 37.254902 26 | Ka 0.000000 0.000000 0.000000 27 | Kd 0.640000 0.640000 0.640000 28 | Ks 0.165000 0.165000 0.165000 29 | Ni 1.000000 30 | d 0.000000 31 | illum 2 32 | map_Kd res/objects/trunk/Material97noCulling.jpg 33 | 34 | newmtl Material97noCulling 35 | Ns 37.254902 36 | Ka 0.000000 0.000000 0.000000 37 | Kd 0.640000 0.640000 0.640000 38 | Ks 0.165000 0.165000 0.165000 39 | Ni 1.000000 40 | d 0.000000 41 | illum 2 42 | map_Kd res/objects/trunk/Material97noCulling.jpg 43 | 44 | newmtl Material97noCulling_Material3noCulling.jpg 45 | Ns 37.254902 46 | Ka 0.000000 0.000000 0.000000 47 | Kd 0.640000 0.640000 0.640000 48 | Ks 0.165000 0.165000 0.165000 49 | Ni 1.000000 50 | d 0.000000 51 | illum 2 52 | map_Kd res/objects/trunk/Material3noCulling.jpg 53 | -------------------------------------------------------------------------------- /res/objects/wow/texture0.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/wow/texture0.jpg -------------------------------------------------------------------------------- /res/objects/wow/texture1.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/wow/texture1.jpg -------------------------------------------------------------------------------- /res/objects/wow/texture2.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/wow/texture2.jpg -------------------------------------------------------------------------------- /res/objects/wow/texture3.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/wow/texture3.jpg -------------------------------------------------------------------------------- /res/objects/wow/wow.mtl: -------------------------------------------------------------------------------- 1 | # Blender MTL File: 'None' 2 | # Material Count: 5 3 | 4 | newmtl material_0_2_0 5 | Ns 96.078431 6 | Ka 0.000000 0.000000 0.000000 7 | Kd 0.640000 0.640000 0.640000 8 | Ks 0.500000 0.500000 0.500000 9 | Ni 1.000000 10 | d 0.000000 11 | illum 2 12 | map_Kd texture0.jpg 13 | 14 | newmtl material_0_2_8 15 | Ns 96.078431 16 | Ka 0.000000 0.000000 0.000000 17 | Kd 0.640000 0.640000 0.640000 18 | Ks 0.500000 0.500000 0.500000 19 | Ni 1.000000 20 | d 0.000000 21 | illum 2 22 | map_Kd texture0.jpg 23 | 24 | newmtl material_1_3_0 25 | Ns 96.078431 26 | Ka 0.000000 0.000000 0.000000 27 | Kd 0.640000 0.640000 0.640000 28 | Ks 0.500000 0.500000 0.500000 29 | Ni 1.000000 30 | d 0.000000 31 | illum 2 32 | map_Kd texture1.jpg 33 | 34 | newmtl material_2_1_0 35 | Ns 96.078431 36 | Ka 0.000000 0.000000 0.000000 37 | Kd 0.640000 0.640000 0.640000 38 | Ks 0.500000 0.500000 0.500000 39 | Ni 1.000000 40 | d 0.000000 41 | illum 2 42 | map_Kd texture2.jpg 43 | 44 | newmtl material_3_4_0 45 | Ns 96.078431 46 | Ka 0.000000 0.000000 0.000000 47 | Kd 0.640000 0.640000 0.640000 48 | Ks 0.500000 0.500000 0.500000 49 | Ni 1.000000 50 | d 0.000000 51 | illum 2 52 | map_Kd texture3.jpg 53 | -------------------------------------------------------------------------------- /res/objects/wow/wow.obj.dat: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/wow/wow.obj.dat -------------------------------------------------------------------------------- /res/objects/wow_old/texture0.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/wow_old/texture0.bmp -------------------------------------------------------------------------------- /res/objects/wow_old/texture1.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/wow_old/texture1.bmp -------------------------------------------------------------------------------- /res/objects/wow_old/texture2.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/wow_old/texture2.bmp -------------------------------------------------------------------------------- /res/objects/wow_old/texture3.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/wow_old/texture3.bmp -------------------------------------------------------------------------------- /res/objects/wow_old/tim.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/objects/wow_old/tim.bmp -------------------------------------------------------------------------------- /res/objects/wow_old/wow.mtl: -------------------------------------------------------------------------------- 1 | # Blender MTL File: 'None' 2 | # Material Count: 5 3 | 4 | newmtl material_0_2_0 5 | Ns 96.078431 6 | Ka 0.000000 0.000000 0.000000 7 | Kd 0.640000 0.640000 0.640000 8 | Ks 0.500000 0.500000 0.500000 9 | Ni 1.000000 10 | d 1.000000 11 | illum 2 12 | map_Kd res/texture0.bmp 13 | 14 | newmtl material_0_2_8 15 | Ns 96.078431 16 | Ka 0.000000 0.000000 0.000000 17 | Kd 0.640000 0.640000 0.640000 18 | Ks 0.500000 0.500000 0.500000 19 | Ni 1.000000 20 | d 1.000000 21 | illum 2 22 | map_Kd res/Crate.bmp 23 | 24 | newmtl material_1_3_0 25 | Ns 96.078431 26 | Ka 0.000000 0.000000 0.000000 27 | Kd 0.640000 0.640000 0.640000 28 | Ks 0.500000 0.500000 0.500000 29 | Ni 1.000000 30 | d 1.000000 31 | illum 2 32 | #map_Kd res/texture1.bmp 33 | 34 | newmtl material_2_1_0 35 | Ns 96.078431 36 | Ka 0.000000 0.000000 0.000000 37 | Kd 0.640000 0.640000 0.640000 38 | Ks 0.500000 0.500000 0.500000 39 | Ni 1.000000 40 | d 1.000000 41 | illum 2 42 | #map_Kd res/texture2.bmp 43 | 44 | newmtl material_3_4_0 45 | Ns 96.078431 46 | Ka 0.000000 0.000000 0.000000 47 | Kd 0.640000 0.640000 0.640000 48 | Ks 0.500000 0.500000 0.500000 49 | Ni 1.000000 50 | d 1.000000 51 | illum 2 52 | #map_Kd res/texture3.bmp 53 | -------------------------------------------------------------------------------- /res/shaders/correct_f.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | //#define AMBIENT_LIGHT (vec3(0.01, 0.01, 0.01)) 4 | #define AMBIENT_LIGHT (vec3(0.4, 0.4, 0.4)) 5 | #define FOG_COLOR (vec4(0.01, 0.01, 0.01, 0.075)) 6 | #define SHININESS (20.0) 7 | 8 | in vec3 positionCS; 9 | in vec3 positionMS; 10 | in vec3 normalCS; 11 | in vec3 fragColor; 12 | in vec2 textureCoord; 13 | in flat int texId; 14 | in float fogFactor; 15 | 16 | layout(location = 6) uniform mat4 viewMatrix; 17 | layout(location = 9) uniform vec3 lightPos; 18 | layout(location = 10) uniform sampler2D textures[7]; 19 | 20 | layout(location = 0) out vec4 outColor; 21 | 22 | void main() 23 | { 24 | //Normalize per fragment to make it smooth. 25 | vec3 realNormCS = normalize(normalCS); 26 | 27 | //Calculate light position in camera space. Model matrix 28 | //is ommited because it is identity. 29 | vec3 lightPosCS = (viewMatrix * vec4(lightPos, 1.0)).xyz; 30 | //Calculate the direction the light travels 31 | //to get to fragment. 32 | vec3 lightDir = normalize(lightPosCS - positionCS); 33 | 34 | //Calculate the reflection direction. 35 | vec3 reflectionDirection = normalize(reflect(-lightDir, realNormCS)); 36 | 37 | //Distance from light to fragment. 38 | float lightDist = length(lightPos - positionMS); 39 | float attenuation = 1;//1.0 / max(lightDist * lightDist * 0.001, 1.0); 40 | 41 | //Calculate the intensity of diffuse light. 42 | float diffuse = max(0.0, dot(realNormCS, lightDir)); 43 | 44 | //Calculate intensity of specular light. 45 | vec3 eyeDir = normalize(-positionCS); 46 | float rawSpec = max(0.0, dot(reflectionDirection, eyeDir)); 47 | float specular = pow(rawSpec, SHININESS); 48 | 49 | //Calculate "scattered" light (basically diffuse). 50 | vec3 scatteredLight = AMBIENT_LIGHT + diffuse * attenuation; 51 | 52 | //Specular value. 53 | vec3 reflectedLight = vec3(specular) * attenuation; 54 | 55 | vec3 rgb; 56 | if(texId == -1) 57 | rgb = min(fragColor * scatteredLight + reflectedLight, vec3(1.0)); 58 | else 59 | rgb = min( 60 | texture(textures[texId], textureCoord).rgb * 61 | scatteredLight + reflectedLight, 62 | vec3(1.0)); 63 | 64 | outColor = vec4(rgb, 1.0); 65 | //outColor = mix(FOG_COLOR, outColor, fogFactor); 66 | } 67 | -------------------------------------------------------------------------------- /res/shaders/correct_v.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | #define LOG2 (1.442695) 4 | #define FOG_DENSITY (0.03) 5 | 6 | layout(location = 0) in vec3 position; 7 | layout(location = 1) in vec3 normal; 8 | layout(location = 2) in vec2 texCoord; 9 | layout(location = 3) in vec3 color; 10 | layout(location = 4) in float textureId; 11 | layout(location = 5) uniform mat4 projectionMatrix; 12 | layout(location = 6) uniform mat4 viewMatrix; 13 | layout(location = 7) uniform mat4 modelMatrix; 14 | layout(location = 8) uniform mat4 mvpMatrix; 15 | 16 | out vec3 positionCS; 17 | out vec3 positionMS; 18 | out vec3 normalCS; 19 | out vec3 fragColor; 20 | out vec2 textureCoord; 21 | out flat int texId; 22 | out float fogFactor; 23 | 24 | void main() 25 | { 26 | //Pass color info. 27 | fragColor = color; 28 | 29 | //Calculate normal matrix and translate the in normal 30 | //from model space to camera space. 31 | mat4 normalMatrix = transpose(inverse(viewMatrix * modelMatrix)); 32 | normalCS = (normalMatrix * vec4(normal, 0.0)).xyz; 33 | 34 | positionMS = position; 35 | 36 | //Translate vertex position from model space to camera space. 37 | positionCS = ((viewMatrix * modelMatrix) * vec4(position, 1.0)).xyz; 38 | 39 | //Pass texture info. 40 | textureCoord = texCoord; 41 | texId = int(textureId); 42 | 43 | //Set gl_Position (clip space). 44 | gl_Position = mvpMatrix * vec4(position, 1.0); 45 | 46 | //Set fogCoord 47 | float fogCoord = length(gl_Position); 48 | 49 | //exp2(x) -same as- pow(2, x) 50 | fogFactor = exp2( 51 | -FOG_DENSITY * 52 | FOG_DENSITY * 53 | fogCoord * 54 | fogCoord * 55 | LOG2 56 | ); 57 | 58 | //Make sure the value is between 0 and 1 59 | fogFactor = clamp(fogFactor, 0.0, 1.0); 60 | } 61 | -------------------------------------------------------------------------------- /res/shaders/old/max_f.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | #define PI (3.14159265359) 4 | 5 | layout(location = 2) uniform float time; 6 | 7 | in vec3 vertex; 8 | in vec3 norm; 9 | 10 | out vec4 fragmentColor; 11 | 12 | void main() 13 | { 14 | //fragmentColor = vec4(1, 0, 0, 1); 15 | 16 | //vec3 fragColor = vec3(0.396078, 0.26274509, 0.12941176); 17 | float newTime = time * 2; 18 | float rColor = sin(newTime) + 0.5; 19 | float gColor = sin(newTime + PI) + 0.5; 20 | float bColor = cos(newTime) + 0.5; 21 | vec3 fragColor = vec3(rColor, gColor, bColor); 22 | vec3 lightPos = vec3(0, 40, 0); 23 | 24 | vec3 lightPosTrans = vec3(gl_ModelViewMatrix * vec4(lightPos, 1.0)); 25 | 26 | vec3 vertexPosition = vec3(gl_ModelViewMatrix * vec4(vertex, 1.0)); 27 | 28 | //Surface normal of current vertex 29 | vec3 surfaceNormal = normalize(vec3(gl_NormalMatrix * norm)); 30 | 31 | //Direction light has traveled to get to vertexPosition 32 | vec3 lightDirection = normalize(lightPosTrans - vertexPosition); 33 | 34 | //Basically how much light is hitting the vertex 35 | float diffuseLightIntensity = clamp(dot(surfaceNormal, lightDirection), 0.0, 1.0); 36 | 37 | //"Main color"(diffuse) of vertex 38 | vec3 diffColor = diffuseLightIntensity * fragColor * 0.7; 39 | //diffColor = fragColor; 40 | 41 | fragmentColor = vec4(diffColor, 1.0); 42 | } 43 | -------------------------------------------------------------------------------- /res/shaders/old/max_v.glsl: -------------------------------------------------------------------------------- 1 | #version 430 2 | 3 | layout(location = 0) in vec3 position; 4 | layout(location = 1) in vec3 normal; 5 | 6 | out vec3 vertex; 7 | out vec3 norm; 8 | 9 | void main() 10 | { 11 | vertex = position; 12 | norm = normal; 13 | gl_Position = gl_ModelViewProjectionMatrix * vec4(position, 1.0); 14 | } 15 | -------------------------------------------------------------------------------- /res/shaders/old/min_f.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | //#define lightAttenuation(dist) (dist * dist / 1000.0) 4 | #define fogColor (vec4(0.01, 0.01, 0.01, 0.075)) 5 | #define ambColor (vec3(0.01, 0.01, 0.01)) 6 | #define maxSpec (0.8) 7 | #define shininess (8.0) 8 | 9 | in vec3 vColor; 10 | in vec3 vVertex; 11 | in vec3 vNormal; 12 | in vec2 vTextureCoord; 13 | in flat int vTextureId; 14 | in mat4 vModelMatrix; 15 | in mat4 vViewMatrix; 16 | in float vFogFactor; 17 | 18 | in vec3 positionWS; 19 | in vec3 normalCS; 20 | in vec3 eyeDirCS; 21 | in vec3 lightDirCS; 22 | 23 | in mat4 normalMatrix; 24 | 25 | layout(location = 9) uniform vec3 cameraPosition; 26 | layout(location = 10) uniform vec3 lightPos; 27 | layout(location = 11) uniform float time; 28 | layout(location = 12) uniform sampler2D textures[7]; 29 | 30 | layout(location = 0) out vec4 outColor; 31 | 32 | void main() 33 | { 34 | mat4 mv = vModelMatrix * vViewMatrix; 35 | 36 | //mat4 normalMatrix = transpose(inverse(mv)); 37 | //mat4 normalMatrix = mv; 38 | 39 | //Position of vertex in modelview space. 40 | vec3 vertexPosition = vec3(mv * vec4(vVertex, 1.0)); 41 | 42 | //Surface normal of current vertex. 43 | //vec3 surfaceNormal = normalize(vec3(normalMatrix * vec4(vNormal, 0.0))); 44 | vec3 surfaceNormal = normalize(normalCS); 45 | //vec3 surfaceNormal = normalCS; 46 | 47 | //Light pos in model space. 48 | vec3 lightPosTrans = vec3(mv * vec4(lightPos, 1.0)); 49 | 50 | //Direction light has traveled to get to vertexPosition. 51 | vec3 lightDirection = normalize(lightPosTrans - vertexPosition); 52 | 53 | //Basically how much light is hitting the vertex. 54 | float diffuseLightIntensity = clamp( 55 | dot(surfaceNormal, lightDirection), 0.0, 1.0); 56 | 57 | //Distance from vertex to light. 58 | float dist = length(lightPos - vVertex); 59 | 60 | float lightAttenuation = max(dist*dist / 1000.0, 1.0); 61 | 62 | //"View vector". 63 | vec3 viewVec = normalize(-vertexPosition); 64 | 65 | //Direction light is reflected off of surface normal. 66 | vec3 reflectionDirection = normalize(reflect(-lightDirection, surfaceNormal)); 67 | 68 | //The intensity of reflection (specular). 69 | float specular = max(0.0, dot(reflectionDirection, viewVec)); 70 | 71 | float totalSpec = clamp(pow(specular, shininess), 0.0, maxSpec) / 72 | lightAttenuation; 73 | 74 | vec3 specColor = vec3(totalSpec, totalSpec, totalSpec); 75 | 76 | if(vTextureId != -1) 77 | { 78 | vec4 textureColor = 3.0 * diffuseLightIntensity * texture(textures[vTextureId], vTextureCoord);// / 79 | //lightAttenuation; 80 | 81 | outColor = vec4(ambColor, 1.0) + 82 | vec4(specColor, 1.0) + 83 | textureColor; 84 | } 85 | else 86 | { 87 | //"Main color"(diffuse) of vertex. 88 | vec3 diffColor = diffuseLightIntensity * vColor / 89 | lightAttenuation; 90 | 91 | outColor = vec4(ambColor, 1.0) + 92 | vec4(specColor, 1.0) + 93 | vec4(diffColor, 1.0); 94 | } 95 | 96 | outColor = mix(fogColor, outColor, vFogFactor); 97 | } 98 | -------------------------------------------------------------------------------- /res/shaders/old/min_v.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | #define LOG2 1.442695 4 | #define FOG_DENSITY 0.03 5 | 6 | layout(location = 0) in vec3 position; 7 | layout(location = 1) in vec3 normal; 8 | layout(location = 2) in vec2 texCoord; 9 | layout(location = 3) in vec3 color; 10 | layout(location = 4) in float textureId; 11 | layout(location = 5) uniform mat4 projectionMatrix; 12 | layout(location = 6) uniform mat4 viewMatrix; 13 | layout(location = 7) uniform mat4 modelMatrix; 14 | layout(location = 8) uniform mat4 mvpMatrix; 15 | layout(location = 10) uniform vec3 lightPos; 16 | 17 | out vec3 vColor; 18 | out vec3 vVertex; 19 | out vec2 vTextureCoord; 20 | out vec3 vNormal; 21 | out flat int vTextureId; 22 | out mat4 vModelMatrix; 23 | out mat4 vViewMatrix; 24 | out float vFogFactor; 25 | 26 | out vec3 positionWS; 27 | out vec3 normalCS; 28 | out vec3 eyeDirCS; 29 | out vec3 lightDirCS; 30 | 31 | out mat4 normalMatrix; 32 | 33 | void main() 34 | { 35 | gl_Position = mvpMatrix * vec4(position, 1.0); 36 | positionWS = (modelMatrix * vec4(position, 1.0)).xyz; 37 | vec3 vertPosCS = ((viewMatrix * modelMatrix) * vec4(vVertex, 1.0)).xyz; 38 | eyeDirCS = -vertPosCS; 39 | vec3 lightPosCS = (viewMatrix * vec4(lightPos, 1.0)).xyz; 40 | lightDirCS = lightPosCS + eyeDirCS; 41 | 42 | normalMatrix = transpose(inverse(viewMatrix * modelMatrix)); 43 | normalCS = (normalMatrix * vec4(normal, 0.0)).xyz; 44 | 45 | vVertex = position; 46 | vTextureCoord = texCoord; 47 | vNormal = normal; 48 | vColor = color; 49 | vTextureId = int(textureId); 50 | 51 | vModelMatrix = modelMatrix; 52 | vViewMatrix = viewMatrix; 53 | 54 | //Set fogCoord 55 | float fogCoord = length(gl_Position); 56 | 57 | //exp2(x) -same as- pow(2, x) 58 | vFogFactor = exp2( 59 | -FOG_DENSITY * 60 | FOG_DENSITY * 61 | fogCoord * 62 | fogCoord * 63 | LOG2 64 | ); 65 | 66 | //Make sure the value is between 0 and 1 67 | vFogFactor = clamp(vFogFactor, 0.0, 1.0); 68 | } 69 | -------------------------------------------------------------------------------- /res/shaders/old/pixelTexture_f.glsl: -------------------------------------------------------------------------------- 1 | #version 330 core 2 | 3 | uniform sampler2D[10] textures; 4 | uniform samplerCube skybox; 5 | 6 | in vec4 varyingColour; 7 | in vec3 varyingNormal; 8 | in vec4 varyingVertex; 9 | 10 | in float fogFactor; 11 | in float isLit; 12 | 13 | in int texID; 14 | 15 | out vec4 fragColor; 16 | 17 | void main() 18 | { 19 | //Position of vertex in modelview space 20 | vec3 vertexPosition = (gl_ModelViewMatrix * varyingVertex).xyz; 21 | 22 | //Surface normal of current vertex 23 | vec3 surfaceNormal = normalize((gl_NormalMatrix * varyingNormal).xyz); 24 | 25 | //Direction light has traveled to get to vertexPosition 26 | vec3 lightDirection = normalize(gl_LightSource[0].position.xyz - vertexPosition); 27 | 28 | //Basically how much light is hitting the vertex 29 | float diffuseLightIntensity = max(0.0, dot(surfaceNormal, lightDirection)); 30 | 31 | //"Main color"(diffuse) of vertex 32 | vec3 diffColor = diffuseLightIntensity * varyingColour.rgb; 33 | 34 | //Adjust color depending upon distance from light 35 | diffColor /= max(distance(gl_LightSource[0].position.xyz, vertexPosition)/10, 1); 36 | 37 | //Lowest light level possible 38 | vec3 ambColor = gl_LightModel.ambient; 39 | 40 | //"View vector" 41 | vec3 viewVec = normalize(-vertexPosition); 42 | 43 | 44 | //// SPEC LIGHTING /// 45 | 46 | /// WARNING: Do not use this shader with models with a shininess of 0 //// 47 | 48 | //Direction light is reflected off of surface normal 49 | vec3 reflectionDirection = normalize(reflect(-lightDirection, surfaceNormal)); 50 | 51 | //The intensity of reflection (specular) 52 | float specular = max(0.0, dot(reflectionDirection, viewVec)); 53 | 54 | //Raise specular to exponent of shininess 55 | float fspecular = pow(specular, gl_FrontMaterial.shininess); 56 | 57 | fspecular /= max(distance(gl_LightSource[0].position.xyz, vertexPosition)/4, 1); 58 | 59 | vec3 specColor = fspecular; 60 | 61 | /// END SPEC LIGHTING /// 62 | 63 | if(texID == -1) 64 | { 65 | //Does not have a texture, just use diffuse, specular, and ambient colors 66 | fragColor = vec4(ambColor, 1.0) + vec4(diffColor + specColor, varyingColour.w); 67 | } 68 | else 69 | { 70 | //Fragment has texture, use the texture's color, and diffuse, specular, and ambient colors 71 | fragColor = vec4(ambColor, 1.0) + vec4(diffColor * vec3(texture(textures[texID], gl_TexCoord[0].st)) + specColor, varyingColour.w); 72 | } 73 | 74 | if(isLit!=1) 75 | { 76 | fragColor.xyz = 0; 77 | } 78 | 79 | fragColor = mix(gl_Fog.color, fragColor, fogFactor); 80 | } -------------------------------------------------------------------------------- /res/shaders/old/pixelTexture_v.glsl: -------------------------------------------------------------------------------- 1 | #version 330 core 2 | 3 | in int textureID; 4 | in float lit; 5 | 6 | out vec4 varyingColour; 7 | out vec4 varyingVertex; 8 | out vec3 varyingNormal; 9 | 10 | out float fogFactor; 11 | out float isLit; 12 | 13 | out int texID; 14 | 15 | void main() 16 | { 17 | //Pass the in variables to fragment 18 | //shader through out variables 19 | isLit = lit; 20 | texID = textureID; 21 | 22 | // Pass the vertex colour attribute to the fragment shader. 23 | varyingColour = gl_Color; 24 | 25 | // Pass the vertex normal attribute to the fragment shader. 26 | varyingNormal = gl_Normal; 27 | 28 | // Pass the vertex position attribute to the fragment shader. 29 | varyingVertex = gl_Vertex; 30 | 31 | //Set gl_Position 32 | gl_Position = gl_ModelViewProjectionMatrix * gl_Vertex; 33 | 34 | //Set texture coords 35 | gl_TexCoord[0] = gl_MultiTexCoord0; 36 | 37 | /// FOG STUFF /// 38 | //Log 2 39 | const float LOG2 = 1.442695; 40 | 41 | //Set fogCoord 42 | gl_FogFragCoord = length(gl_Position); 43 | 44 | //exp2(x) -same as- pow(2, x) 45 | fogFactor = exp2( 46 | -gl_Fog.density * 47 | gl_Fog.density * 48 | gl_FogFragCoord * 49 | gl_FogFragCoord * 50 | LOG2 51 | ); 52 | 53 | //Make sure the value is between 0 and 1 54 | fogFactor = clamp(fogFactor, 0.0, 1.0); 55 | } -------------------------------------------------------------------------------- /res/shaders/postprocessing/blur/blur_f.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | #define blurSize (0.00290625) 4 | 5 | #define blurSizeH (0.3 * 0.00333333333) 6 | #define blurSizeV (0.3 * 0.005) 7 | 8 | in vec2 textureCoord; 9 | 10 | out vec4 color; 11 | 12 | layout(location = 1) uniform sampler2D renderedTexture; 13 | layout(location = 2) uniform float time; 14 | 15 | void main() 16 | { 17 | vec4 sum = vec4(0.0); 18 | 19 | for (int x = -4; x <= 4; x++) 20 | for (int y = -4; y <= 4; y++) 21 | sum += texture( 22 | renderedTexture, 23 | vec2(textureCoord.x + x * blurSizeH, textureCoord.y + y * blurSizeV) 24 | ) / 81.0; 25 | color = sum; 26 | } 27 | -------------------------------------------------------------------------------- /res/shaders/postprocessing/blur/blur_v.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec3 position; 4 | 5 | out vec2 textureCoord; 6 | 7 | void main() 8 | { 9 | gl_Position = vec4(position, 1.0); 10 | textureCoord = (position.xy+vec2(1,1))/2.0; 11 | } 12 | -------------------------------------------------------------------------------- /res/shaders/postprocessing/bumpy/bumpy_f.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | in vec2 textureCoord; 4 | 5 | out vec4 color; 6 | 7 | layout(location = 1) uniform sampler2D renderedTexture; 8 | layout(location = 2) uniform float time; 9 | 10 | void main() 11 | { 12 | vec4 c = texture(renderedTexture, textureCoord); 13 | vec4 u = texture(renderedTexture, textureCoord + vec2(0.0, -1.0)); 14 | vec4 d = texture(renderedTexture, textureCoord + vec2(0.0, 1.0)); 15 | vec4 l = texture(renderedTexture, textureCoord + vec2(-1.0, 0.0)); 16 | vec4 r = texture(renderedTexture, textureCoord + vec2(1.0, 0.0)); 17 | 18 | vec4 nc = normalize(c); 19 | vec4 nu = normalize(u); 20 | vec4 nd = normalize(d); 21 | vec4 nl = normalize(l); 22 | vec4 nr = normalize(r); 23 | 24 | float du = dot(nc, nu); 25 | float dd = dot(nc, nd); 26 | float dl = dot(nc, nl); 27 | float dr = dot(nc, nr); 28 | 29 | float i = 64.0; 30 | 31 | float f = 1.0; 32 | f += (du * i) - (dd * i); 33 | f += (dr * i) - (dl * i); 34 | 35 | vec4 colorA = c * clamp(f, 0.5, 2.0); 36 | color = vec4(colorA.rgb, c.a); 37 | } 38 | -------------------------------------------------------------------------------- /res/shaders/postprocessing/bumpy/bumpy_v.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec3 position; 4 | 5 | out vec2 textureCoord; 6 | 7 | void main() 8 | { 9 | gl_Position = vec4(position, 1); 10 | textureCoord = (position.xy+vec2(1,1))/2.0; 11 | } 12 | -------------------------------------------------------------------------------- /res/shaders/postprocessing/dof/dof_f.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | #define BIAS (0.02) 4 | #define BLUR_CLAMP (0.2) 5 | 6 | in vec2 textureCoord; 7 | 8 | out vec4 color; 9 | 10 | layout(location = 1) uniform sampler2D renderedTexture; 11 | layout(location = 2) uniform float time; 12 | 13 | layout(location = 0) out vec4 outColor; 14 | 15 | void main() 16 | { 17 | float focus = 0.1; 18 | float aspectratio = 800.0/600.0; 19 | vec2 aspectcorrect = vec2(1.0,aspectratio); 20 | 21 | float factor = cos((textureCoord.y) * 2 + 0.5); 22 | 23 | vec2 dofblur = vec2 (clamp(factor * BIAS, -BLUR_CLAMP, BLUR_CLAMP)); 24 | 25 | 26 | vec4 col = vec4(0.0); 27 | 28 | col += texture(renderedTexture, textureCoord); 29 | col += texture(renderedTexture, textureCoord + (vec2( 0.0,0.4 )*aspectcorrect) * dofblur); 30 | col += texture(renderedTexture, textureCoord + (vec2( 0.15,0.37 )*aspectcorrect) * dofblur); 31 | col += texture(renderedTexture, textureCoord + (vec2( 0.29,0.29 )*aspectcorrect) * dofblur); 32 | col += texture(renderedTexture, textureCoord + (vec2( -0.37,0.15 )*aspectcorrect) * dofblur); 33 | col += texture(renderedTexture, textureCoord + (vec2( 0.4,0.0 )*aspectcorrect) * dofblur); 34 | col += texture(renderedTexture, textureCoord + (vec2( 0.37,-0.15 )*aspectcorrect) * dofblur); 35 | col += texture(renderedTexture, textureCoord + (vec2( 0.29,-0.29 )*aspectcorrect) * dofblur); 36 | col += texture(renderedTexture, textureCoord + (vec2( -0.15,-0.37 )*aspectcorrect) * dofblur); 37 | col += texture(renderedTexture, textureCoord + (vec2( 0.0,-0.4 )*aspectcorrect) * dofblur); 38 | col += texture(renderedTexture, textureCoord + (vec2( -0.15,0.37 )*aspectcorrect) * dofblur); 39 | col += texture(renderedTexture, textureCoord + (vec2( -0.29,0.29 )*aspectcorrect) * dofblur); 40 | col += texture(renderedTexture, textureCoord + (vec2( 0.37,0.15 )*aspectcorrect) * dofblur); 41 | col += texture(renderedTexture, textureCoord + (vec2( -0.4,0.0 )*aspectcorrect) * dofblur); 42 | col += texture(renderedTexture, textureCoord + (vec2( -0.37,-0.15 )*aspectcorrect) * dofblur); 43 | col += texture(renderedTexture, textureCoord + (vec2( -0.29,-0.29 )*aspectcorrect) * dofblur); 44 | col += texture(renderedTexture, textureCoord + (vec2( 0.15,-0.37 )*aspectcorrect) * dofblur); 45 | 46 | col += texture(renderedTexture, textureCoord + (vec2( 0.15,0.37 )*aspectcorrect) * dofblur*0.9); 47 | col += texture(renderedTexture, textureCoord + (vec2( -0.37,0.15 )*aspectcorrect) * dofblur*0.9); 48 | col += texture(renderedTexture, textureCoord + (vec2( 0.37,-0.15 )*aspectcorrect) * dofblur*0.9); 49 | col += texture(renderedTexture, textureCoord + (vec2( -0.15,-0.37 )*aspectcorrect) * dofblur*0.9); 50 | col += texture(renderedTexture, textureCoord + (vec2( -0.15,0.37 )*aspectcorrect) * dofblur*0.9); 51 | col += texture(renderedTexture, textureCoord + (vec2( 0.37,0.15 )*aspectcorrect) * dofblur*0.9); 52 | col += texture(renderedTexture, textureCoord + (vec2( -0.37,-0.15 )*aspectcorrect) * dofblur*0.9); 53 | col += texture(renderedTexture, textureCoord + (vec2( 0.15,-0.37 )*aspectcorrect) * dofblur*0.9); 54 | 55 | col += texture(renderedTexture, textureCoord + (vec2( 0.29,0.29 )*aspectcorrect) * dofblur*0.7); 56 | col += texture(renderedTexture, textureCoord + (vec2( 0.4,0.0 )*aspectcorrect) * dofblur*0.7); 57 | col += texture(renderedTexture, textureCoord + (vec2( 0.29,-0.29 )*aspectcorrect) * dofblur*0.7); 58 | col += texture(renderedTexture, textureCoord + (vec2( 0.0,-0.4 )*aspectcorrect) * dofblur*0.7); 59 | col += texture(renderedTexture, textureCoord + (vec2( -0.29,0.29 )*aspectcorrect) * dofblur*0.7); 60 | col += texture(renderedTexture, textureCoord + (vec2( -0.4,0.0 )*aspectcorrect) * dofblur*0.7); 61 | col += texture(renderedTexture, textureCoord + (vec2( -0.29,-0.29 )*aspectcorrect) * dofblur*0.7); 62 | col += texture(renderedTexture, textureCoord + (vec2( 0.0,0.4 )*aspectcorrect) * dofblur*0.7); 63 | 64 | col += texture(renderedTexture, textureCoord + (vec2( 0.29,0.29 )*aspectcorrect) * dofblur*0.4); 65 | col += texture(renderedTexture, textureCoord + (vec2( 0.4,0.0 )*aspectcorrect) * dofblur*0.4); 66 | col += texture(renderedTexture, textureCoord + (vec2( 0.29,-0.29 )*aspectcorrect) * dofblur*0.4); 67 | col += texture(renderedTexture, textureCoord + (vec2( 0.0,-0.4 )*aspectcorrect) * dofblur*0.4); 68 | col += texture(renderedTexture, textureCoord + (vec2( -0.29,0.29 )*aspectcorrect) * dofblur*0.4); 69 | col += texture(renderedTexture, textureCoord + (vec2( -0.4,0.0 )*aspectcorrect) * dofblur*0.4); 70 | col += texture(renderedTexture, textureCoord + (vec2( -0.29,-0.29 )*aspectcorrect) * dofblur*0.4); 71 | col += texture(renderedTexture, textureCoord + (vec2( 0.0,0.4 )*aspectcorrect) * dofblur*0.4); 72 | 73 | outColor = col/41.0; 74 | outColor.a = 1.0; 75 | } 76 | -------------------------------------------------------------------------------- /res/shaders/postprocessing/dof/dof_v.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec3 position; 4 | 5 | out vec2 textureCoord; 6 | 7 | void main() 8 | { 9 | gl_Position = vec4(position, 1); 10 | textureCoord = (position.xy+vec2(1,1))/2.0; 11 | } 12 | -------------------------------------------------------------------------------- /res/shaders/postprocessing/fisheye/fisheye_f.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | #define PI (3.1415926535) 4 | #define aperture (178.0) 5 | 6 | in vec2 textureCoord; 7 | 8 | out vec4 color; 9 | 10 | layout(location = 1) uniform sampler2D renderedTexture; 11 | layout(location = 2) uniform float time; 12 | 13 | void main() 14 | { 15 | float apertureHalf = 0.5 * aperture * (PI / 180.0); 16 | float maxFactor = sin(apertureHalf); 17 | 18 | vec2 uv; 19 | vec2 xy = 2.0 * textureCoord - 1.0; 20 | float d = length(xy); 21 | if (d < (2.0-maxFactor)) 22 | { 23 | d = length(xy * maxFactor); 24 | float z = sqrt(1.0 - d * d); 25 | float r = atan(d, z) / PI; 26 | float phi = atan(xy.y, xy.x); 27 | 28 | uv.x = r * cos(phi) + 0.5; 29 | uv.y = r * sin(phi) + 0.5; 30 | } 31 | else 32 | { 33 | uv = textureCoord; 34 | } 35 | vec4 c = texture(renderedTexture, uv); 36 | color = c; 37 | } 38 | -------------------------------------------------------------------------------- /res/shaders/postprocessing/fisheye/fisheye_v.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec3 position; 4 | 5 | out vec2 textureCoord; 6 | 7 | void main() 8 | { 9 | gl_Position = vec4(position, 1); 10 | textureCoord = (position.xy+vec2(1,1))/2.0; 11 | } 12 | -------------------------------------------------------------------------------- /res/shaders/postprocessing/fxaa/fxaa_f.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | #define FRAME_BUF_SIZE (vec2(800, 600)) 4 | #define SPAN_MAX (8.0) 5 | //#define REDUCE_MUL (0.125) 6 | #define REDUCE_MUL (0) 7 | #define REDUCE_MIN (0.0078125) 8 | 9 | in vec2 textureCoord; 10 | 11 | layout(location = 1) uniform sampler2D renderedTexture; 12 | layout(location = 2) uniform float time; 13 | 14 | layout(location = 0) out vec4 outColor; 15 | 16 | void main() 17 | { 18 | vec3 rgbNW = texture(renderedTexture, textureCoord+(vec2(-1.0,-1.0)/FRAME_BUF_SIZE)).xyz; 19 | vec3 rgbNE = texture(renderedTexture, textureCoord+(vec2(1.0,-1.0)/FRAME_BUF_SIZE)).xyz; 20 | vec3 rgbSW = texture(renderedTexture, textureCoord+(vec2(-1.0,1.0)/FRAME_BUF_SIZE)).xyz; 21 | vec3 rgbSE = texture(renderedTexture, textureCoord+(vec2(1.0,1.0)/FRAME_BUF_SIZE)).xyz; 22 | vec3 rgbM = texture(renderedTexture, textureCoord).xyz; 23 | 24 | vec3 luma = vec3(0.299, 0.587, 0.114); 25 | float lumaNW = dot(rgbNW, luma); 26 | float lumaNE = dot(rgbNE, luma); 27 | float lumaSW = dot(rgbSW, luma); 28 | float lumaSE = dot(rgbSE, luma); 29 | float lumaM = dot(rgbM, luma); 30 | 31 | float lumaMin = min(lumaM, min(min(lumaNW, lumaNE), min(lumaSW, lumaSE))); 32 | float lumaMax = max(lumaM, max(max(lumaNW, lumaNE), max(lumaSW, lumaSE))); 33 | 34 | vec2 dir; 35 | dir.x = -((lumaNW + lumaNE) - (lumaSW + lumaSE)); 36 | dir.y = ((lumaNW + lumaSW) - (lumaNE + lumaSE)); 37 | 38 | float dirReduce = max( 39 | (lumaNW + lumaNE + lumaSW + lumaSE) * (0.25 * REDUCE_MUL), 40 | REDUCE_MIN); 41 | 42 | float rcpDirMin = 1.0/(min(abs(dir.x), abs(dir.y)) + dirReduce); 43 | 44 | dir = min(vec2(SPAN_MAX, SPAN_MAX), 45 | max(vec2(-SPAN_MAX, -SPAN_MAX), 46 | dir * rcpDirMin)) / FRAME_BUF_SIZE; 47 | 48 | vec3 rgbA = (1.0/2.0) * ( 49 | texture(renderedTexture, textureCoord + dir * (1.0/3.0 - 0.5)).xyz + 50 | texture(renderedTexture, textureCoord + dir * (2.0/3.0 - 0.5)).xyz); 51 | vec3 rgbB = rgbA * (1.0/2.0) + (1.0/4.0) * ( 52 | texture(renderedTexture, textureCoord + dir * (0.0/3.0 - 0.5)).xyz + 53 | texture(renderedTexture, textureCoord + dir * (3.0/3.0 - 0.5)).xyz); 54 | float lumaB = dot(rgbB, luma); 55 | 56 | if((lumaB < lumaMin) || (lumaB > lumaMax)) 57 | { 58 | outColor = vec4(rgbA, 1.0); 59 | } 60 | else 61 | { 62 | outColor = vec4(rgbB, 1.0); 63 | } 64 | } 65 | -------------------------------------------------------------------------------- /res/shaders/postprocessing/fxaa/fxaa_v.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec3 position; 4 | 5 | out vec2 textureCoord; 6 | 7 | void main() 8 | { 9 | gl_Position = vec4(position, 1); 10 | textureCoord = (position.xy+vec2(1,1))/2.0; 11 | } 12 | -------------------------------------------------------------------------------- /res/shaders/postprocessing/invert/invert_f.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | 4 | in vec2 textureCoord; 5 | 6 | out vec4 color; 7 | 8 | layout(location = 1) uniform sampler2D renderedTexture; 9 | layout(location = 2) uniform float time; 10 | 11 | vec3 invert(vec3 start) 12 | { 13 | return vec3(1.0-start.x, 1.0-start.y, 1.0-start.z); 14 | } 15 | 16 | void main() 17 | { 18 | vec4 realColor = texture(renderedTexture, textureCoord); 19 | color = vec4(invert(realColor.xyz), realColor.w); 20 | } 21 | -------------------------------------------------------------------------------- /res/shaders/postprocessing/invert/invert_v.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec3 position; 4 | 5 | out vec2 textureCoord; 6 | 7 | void main() 8 | { 9 | gl_Position = vec4(position, 1); 10 | textureCoord = (position.xy+vec2(1,1))/2.0; 11 | } 12 | -------------------------------------------------------------------------------- /res/shaders/postprocessing/passthrough/passthrough_f.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | /* 4 | #define screenWidth (800) 5 | #define screenHeight (600) 6 | 7 | #define waveIntensity (0.005) 8 | #define waveSpeed (5) 9 | */ 10 | 11 | /* 12 | #define waveSpeed (5) 13 | */ 14 | 15 | #define blurSize (0.00390625) 16 | 17 | in vec2 textureCoord; 18 | 19 | out vec4 color; 20 | 21 | layout(location = 1) uniform sampler2D renderedTexture; 22 | layout(location = 2) uniform float time; 23 | 24 | void main() 25 | { 26 | /* 27 | color = texture(renderedTexture, 28 | textureCoord + 0.001 * vec2(sin(time+800*textureCoord.x), 29 | cos(time+600*textureCoord.y))).xyz; 30 | */ 31 | /* 32 | color = texture(renderedTexture, 33 | textureCoord + waveIntensity * 34 | vec2( 35 | sin(time * waveSpeed + screenWidth * textureCoord.x), 36 | cos(time * waveSpeed + screenHeight * textureCoord.y) 37 | ) 38 | ).xyz; 39 | */ 40 | 41 | /* 42 | float offset = time / 1 * 2*3.14159 * 0.3; 43 | vec2 newTexCoord = vec2(textureCoord.x + sin(textureCoord.y * 1*2*3.14159 + offset) / 100, textureCoord.y); 44 | color = texture(renderedTexture, newTexCoord); 45 | */ 46 | /* 47 | vec4 sum = vec4(0.0); 48 | sum += texture(renderedTexture, vec2(textureCoord.x - 4.0*blurSize, textureCoord.y)) * 0.05; 49 | sum += texture(renderedTexture, vec2(textureCoord.x - 3.0*blurSize, textureCoord.y)) * 0.09; 50 | sum += texture(renderedTexture, vec2(textureCoord.x - 2.0*blurSize, textureCoord.y)) * 0.12; 51 | sum += texture(renderedTexture, vec2(textureCoord.x - blurSize, textureCoord.y)) * 0.15; 52 | sum += texture(renderedTexture, vec2(textureCoord.x, textureCoord.y)) * 0.16; 53 | sum += texture(renderedTexture, vec2(textureCoord.x + blurSize, textureCoord.y)) * 0.15; 54 | sum += texture(renderedTexture, vec2(textureCoord.x + 2.0*blurSize, textureCoord.y)) * 0.12; 55 | sum += texture(renderedTexture, vec2(textureCoord.x + 3.0*blurSize, textureCoord.y)) * 0.09; 56 | sum += texture(renderedTexture, vec2(textureCoord.x + 4.0*blurSize, textureCoord.y)) * 0.05; 57 | */ 58 | color = texture(renderedTexture, textureCoord); 59 | } 60 | -------------------------------------------------------------------------------- /res/shaders/postprocessing/passthrough/passthrough_v.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec3 position; 4 | 5 | out vec2 textureCoord; 6 | 7 | void main() 8 | { 9 | gl_Position = vec4(position, 1); 10 | textureCoord = (position.xy+vec2(1,1))/2.0; 11 | } 12 | -------------------------------------------------------------------------------- /res/shaders/postprocessing/pixelate/pixelate_f.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | #define pixelWidth (10) 4 | #define pixelHeight (10) 5 | 6 | #define screenWidth (800) 7 | #define screenHeight (600) 8 | 9 | in vec2 textureCoord; 10 | 11 | out vec4 color; 12 | 13 | layout(location = 1) uniform sampler2D renderedTexture; 14 | layout(location = 2) uniform float time; 15 | 16 | void main(void) 17 | { 18 | vec2 uv = gl_TexCoord[0].xy; 19 | 20 | float dx = pixelWidth * (1.0 / screenWidth); 21 | float dy = pixelHeight * (1.0 / screenHeight); 22 | 23 | vec2 coord = vec2(dx*floor(textureCoord.x/dx), 24 | dy*floor(textureCoord.y/dy)); 25 | 26 | vec3 tc = texture(renderedTexture, coord).rgb; 27 | color = vec4(tc, 1.0); 28 | } 29 | -------------------------------------------------------------------------------- /res/shaders/postprocessing/pixelate/pixelate_v.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec3 position; 4 | 5 | out vec2 textureCoord; 6 | 7 | void main() 8 | { 9 | gl_Position = vec4(position, 1); 10 | textureCoord = (position.xy+vec2(1,1))/2.0; 11 | } 12 | -------------------------------------------------------------------------------- /res/shaders/postprocessing/poster/poster_f.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | #define gamma (0.6) 4 | #define numColors (8.0) 5 | 6 | in vec2 textureCoord; 7 | 8 | out vec4 color; 9 | 10 | layout(location = 1) uniform sampler2D renderedTexture; 11 | layout(location = 2) uniform float time; 12 | 13 | void main() 14 | { 15 | vec3 c = texture(renderedTexture, textureCoord).rgb; 16 | c = pow(c, vec3(gamma, gamma, gamma)); 17 | c = c * numColors; 18 | c = floor(c); 19 | c = c / numColors; 20 | c = pow(c, vec3(1.0/gamma)); 21 | color = vec4(c, 1.0); 22 | } 23 | -------------------------------------------------------------------------------- /res/shaders/postprocessing/poster/poster_v.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec3 position; 4 | 5 | out vec2 textureCoord; 6 | 7 | void main() 8 | { 9 | gl_Position = vec4(position, 1); 10 | textureCoord = (position.xy+vec2(1,1))/2.0; 11 | } 12 | -------------------------------------------------------------------------------- /res/shaders/postprocessing/sobel/sobel_f.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | #define radius (3) 4 | 5 | in vec2 textureCoord; 6 | 7 | out vec4 color; 8 | 9 | layout(location = 1) uniform sampler2D renderedTexture; 10 | layout(location = 2) uniform float time; 11 | 12 | float intensity(in vec4 color) 13 | { 14 | return sqrt((color.x*color.x)+(color.y*color.y)+(color.z*color.z)); 15 | } 16 | 17 | vec3 radial_edge_detection(float s, vec2 center) 18 | { 19 | vec4 centerColor = texture(renderedTexture, center); 20 | // let's learn more about our center pixel 21 | float center_intensity = intensity(centerColor); 22 | // counters we need 23 | int darker_count = 0; 24 | float max_intensity = center_intensity; 25 | // let's look at our neighbouring points 26 | for(int i = -radius; i <= radius; i++) 27 | { 28 | for(int j = -radius; j<= radius; j++) 29 | { 30 | vec2 current_location = center + vec2(i*s, j*s); 31 | float current_intensity = intensity(texture(renderedTexture, current_location)); 32 | if(current_intensity < center_intensity) 33 | { 34 | darker_count++; 35 | } 36 | if(current_intensity > max_intensity) 37 | { 38 | max_intensity = current_intensity; 39 | } 40 | } 41 | } 42 | // do we have a valley pixel? 43 | if((max_intensity - center_intensity) > 0.01*radius) 44 | { 45 | if(darker_count/(radius*radius) < (1-(1/radius))) 46 | { 47 | return centerColor.xyz; // yep, it's a valley pixel. 48 | } 49 | } 50 | return vec3(0.1,0.1,0.1); // no, it's not. 51 | 52 | } 53 | 54 | void main() 55 | { 56 | vec4 sum = vec4(0.0); 57 | vec4 s0 = texture(renderedTexture, textureCoord); 58 | vec4 s1 = texture(renderedTexture, textureCoord - 1.0 / 300.0 - 1.0 / 200.0); 59 | vec4 s2 = texture(renderedTexture, textureCoord + 1.0 / 300.0 - 1.0 / 200.0); 60 | vec4 s3 = texture(renderedTexture, textureCoord - 1.0 / 300.0 + 1.0 / 200.0); 61 | vec4 s4 = texture(renderedTexture, textureCoord + 1.0 / 300.0 + 1.0 / 200.0); 62 | 63 | //vec4 sx = 4.0 * ((s4 + s3) - (s2 + s1)); 64 | //vec4 sy = 4.0 * ((s2 + s4) - (s1 + s3)); 65 | //vec4 sobel = sqrt(sx * sx + sy * sy); 66 | //color = sobel; 67 | 68 | vec4 d1 = s0 - s1; 69 | vec4 d2 = s0 - s2; 70 | vec4 d3 = s0 - s3; 71 | vec4 d4 = s0 - s4; 72 | 73 | vec4 sobel = clamp(d1 + d2 + d3 + d4, 0.0, 1.0); 74 | color = sobel; 75 | /* 76 | float s = 1.0 / 800.0; 77 | vec2 center_color = textureCoord; 78 | color = vec4(radial_edge_detection(s,center_color), 1.0); 79 | */ 80 | /* 81 | vec4 center = texture(DiffuseSampler, texCoord); 82 | vec4 left = texture(DiffuseSampler, texCoord - vec2(oneTexel.x, 0.0)); 83 | vec4 right = texture(DiffuseSampler, texCoord + vec2(oneTexel.x, 0.0)); 84 | vec4 up = texture(DiffuseSampler, texCoord - vec2(0.0, oneTexel.y)); 85 | vec4 down = texture(DiffuseSampler, texCoord + vec2(0.0, oneTexel.y)); 86 | vec4 leftDiff = s1 - left; 87 | vec4 rightDiff = center - right; 88 | vec4 upDiff = center - up; 89 | vec4 downDiff = center - down; 90 | vec4 total = clamp(leftDiff + rightDiff + upDiff + downDiff, 0.0, 1.0); 91 | color = vec4(total.rgb, center.a); 92 | */ 93 | } 94 | -------------------------------------------------------------------------------- /res/shaders/postprocessing/sobel/sobel_v.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(location = 0) in vec3 position; 4 | 5 | out vec2 textureCoord; 6 | 7 | void main() 8 | { 9 | gl_Position = vec4(position, 1); 10 | textureCoord = (position.xy+vec2(1,1))/2.0; 11 | } 12 | -------------------------------------------------------------------------------- /res/shaders/shadow/shadow2_f.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | #define AMBIENT_LIGHT (vec3(0.01, 0.01, 0.01)) 4 | #define FOG_COLOR (vec4(0.01, 0.01, 0.01, 0.075)) 5 | #define SHININESS (40.0) 6 | #define MIN_SPEC (0.01) 7 | #define MAX_SPEC (0.8) 8 | 9 | in vec3 positionCS; 10 | in vec3 positionMS; 11 | in vec3 normalCS; 12 | in vec3 fragColor; 13 | in vec2 textureCoord; 14 | in flat int texId; 15 | in float fogFactor; 16 | in vec4 shadowCoord; 17 | 18 | layout(location = 5) uniform mat4 viewMatrix; 19 | layout(location = 9) uniform vec3 lightPos; 20 | layout(location = 10) uniform sampler2D textures[7]; 21 | layout(location = 17) uniform sampler2DShadow shadowMap; 22 | layout(location = 18) uniform float time; 23 | 24 | layout(location = 0) out vec4 outColor; 25 | 26 | const vec2 poissonDisk[16] = vec2[]( 27 | vec2(-0.94201624, -0.39906216), 28 | vec2(0.94558609, -0.76890725), 29 | vec2(-0.094184101, -0.92938870), 30 | vec2(0.34495938, 0.29387760), 31 | vec2(-0.91588581, 0.45771432), 32 | vec2(-0.81544232, -0.87912464), 33 | vec2(-0.38277543, 0.27676845), 34 | vec2(0.97484398, 0.75648379), 35 | vec2(0.44323325, -0.97511554), 36 | vec2(0.53742981, -0.47373420), 37 | vec2(-0.26496911, -0.41893023), 38 | vec2(0.79197514, 0.19090188), 39 | vec2(-0.24188840, 0.99706507), 40 | vec2(-0.81409955, 0.91437590), 41 | vec2(0.19984126, 0.78641367), 42 | vec2(0.14383161, -0.14100790) 43 | ); 44 | 45 | void main() 46 | { 47 | //Normalize per fragment to make it smooth. 48 | vec3 realNormCS = normalize(normalCS); 49 | 50 | //Calculate light position in camera space. Model matrix 51 | //is ommited because it is identity. 52 | vec3 lightPosCS = (viewMatrix * vec4(lightPos, 1.0)).xyz; 53 | //Calculate the direction the light travels 54 | //to get to fragment. 55 | vec3 lightDir = normalize(lightPosCS - positionCS); 56 | 57 | //Calculate the reflection direction. 58 | vec3 reflectionDirection = normalize(reflect(-lightDir, realNormCS)); 59 | 60 | //Distance from light to fragment. 61 | float lightDist = length(lightPos - positionMS); 62 | float attenuation = 1.0;//1.0 / max(lightDist * lightDist * 0.001, 1.0); 63 | 64 | //Calculate the intensity of diffuse light. 65 | float diffuse = max(0.0, dot(realNormCS, lightDir)); 66 | 67 | //Calculate intensity of specular light. 68 | vec3 eyeDir = normalize(-positionCS); 69 | float rawSpec = max(0.0, dot(reflectionDirection, eyeDir)); 70 | float specular = pow(rawSpec, SHININESS); 71 | //Make specular have a minimum val. 72 | specular = specular < MIN_SPEC ? 0 : specular; 73 | 74 | //Calculate "scattered" light (basically diffuse). 75 | vec3 scatteredLight = AMBIENT_LIGHT + diffuse * attenuation; 76 | 77 | //Specular value. 78 | vec3 reflectedLight = vec3(specular) * attenuation; 79 | 80 | vec3 totalColor; 81 | if(texId == -1) 82 | totalColor = min(fragColor * scatteredLight + reflectedLight, vec3(1.0)); 83 | else 84 | totalColor = min( 85 | texture(textures[texId], textureCoord).rgb * 86 | scatteredLight + reflectedLight, 87 | vec3(1.0)); 88 | 89 | // Light emission properties 90 | vec3 lightColor = vec3(1.0, 1.0, 1.0); 91 | 92 | float visibility=1.0; 93 | 94 | //Variable bias. 95 | float bias = 0.005 * tan(acos(diffuse)); 96 | bias = clamp(bias, 0.0, 0.01); 97 | 98 | // Sample the shadow map 4 times 99 | for (int index=0;index<10;index++) 100 | { 101 | //int realIndex = genRandom(index); 102 | visibility -= 0.2*(1.0 - 103 | texture(shadowMap, 104 | vec3(shadowCoord.xy + poissonDisk[index]/700.0, 105 | (shadowCoord.z-bias)/shadowCoord.w))); 106 | } 107 | 108 | outColor = vec4(visibility * totalColor * lightColor, 1.0); 109 | } 110 | -------------------------------------------------------------------------------- /res/shaders/shadow/shadow2_v.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | #define LOG2 (1.442695) 4 | #define FOG_DENSITY (0.03) 5 | 6 | layout(location = 0) in vec3 position; 7 | layout(location = 1) in vec3 normal; 8 | layout(location = 2) in vec2 texCoord; 9 | layout(location = 3) in vec3 color; 10 | layout(location = 4) in float textureId; 11 | layout(location = 5) uniform mat4 viewMatrix; 12 | layout(location = 6) uniform mat4 modelMatrix; 13 | layout(location = 7) uniform mat4 mvpMatrix; 14 | layout(location = 8) uniform mat4 mvpBiasMatrix; 15 | 16 | out vec3 positionCS; 17 | out vec3 positionMS; 18 | out vec3 normalCS; 19 | out vec3 fragColor; 20 | out vec2 textureCoord; 21 | out flat int texId; 22 | out float fogFactor; 23 | out vec4 shadowCoord; 24 | 25 | void main() 26 | { 27 | //Pass color info. 28 | fragColor = color; 29 | 30 | //Calculate normal matrix and translate the in normal 31 | //from model space to camera space. 32 | mat4 normalMatrix = transpose(inverse(viewMatrix * modelMatrix)); 33 | normalCS = (normalMatrix * vec4(normal, 0.0)).xyz; 34 | 35 | positionMS = position; 36 | 37 | //Translate vertex position from model space to camera space. 38 | positionCS = ((viewMatrix * modelMatrix) * vec4(position, 1.0)).xyz; 39 | 40 | //Pass texture info. 41 | textureCoord = texCoord; 42 | texId = int(textureId); 43 | 44 | //Set gl_Position (clip space). 45 | gl_Position = mvpMatrix * vec4(position, 1.0); 46 | 47 | //Set fogCoord 48 | float fogCoord = length(gl_Position); 49 | 50 | //exp2(x) -same as- pow(2, x) 51 | fogFactor = exp2( 52 | -FOG_DENSITY * 53 | FOG_DENSITY * 54 | fogCoord * 55 | fogCoord * 56 | LOG2 57 | ); 58 | 59 | //Make sure the value is between 0 and 1 60 | fogFactor = clamp(fogFactor, 0.0, 1.0); 61 | 62 | shadowCoord = mvpBiasMatrix * vec4(position, 1.0); 63 | } 64 | -------------------------------------------------------------------------------- /res/shaders/shadow/shadow_f.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | // Ouput data 4 | layout(location = 0) out float fragmentdepth; 5 | 6 | void main(){ 7 | // Not really needed, OpenGL does it anyway 8 | fragmentdepth = gl_FragCoord.z; 9 | } 10 | -------------------------------------------------------------------------------- /res/shaders/shadow/shadow_v.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | // Input vertex data, different for all executions of this shader. 4 | layout(location = 0) in vec3 position; 5 | 6 | // Values that stay constant for the whole mesh. 7 | uniform mat4 mvpMatrix; 8 | 9 | void main(){ 10 | gl_Position = mvpMatrix * vec4(position, 1.0); 11 | } 12 | -------------------------------------------------------------------------------- /res/shaders/tesselation/pass_f.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | #define LightPosition (vec3(0.0, 40.0, 0.0)) 4 | #define DiffuseMaterial (vec3(0.0, 0.0, 1.0)) 5 | #define AmbientMaterial (vec3(0.01, 0.01, 0.01)) 6 | 7 | out vec4 FragColor; 8 | in vec3 gFacetNormal; 9 | in vec3 gTriDistance; 10 | in vec3 gPatchDistance; 11 | in float gPrimitive; 12 | 13 | float amplify(float d, float scale, float offset) 14 | { 15 | d = scale * d + offset; 16 | d = clamp(d, 0, 1); 17 | d = 1 - exp2(-2*d*d); 18 | return d; 19 | } 20 | 21 | void main() 22 | { 23 | vec3 N = normalize(gFacetNormal); 24 | vec3 L = LightPosition; 25 | float df = abs(dot(N, L)); 26 | vec3 color = AmbientMaterial + df * DiffuseMaterial; 27 | 28 | float d1 = min(min(gTriDistance.x, gTriDistance.y), gTriDistance.z); 29 | float d2 = min(min(gPatchDistance.x, gPatchDistance.y), gPatchDistance.z); 30 | color = amplify(d1, 40, -0.5) * amplify(d2, 60, -0.5) * color; 31 | 32 | FragColor = vec4(color, 1.0); 33 | } 34 | -------------------------------------------------------------------------------- /res/shaders/tesselation/pass_v.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | in vec3 position; 4 | out vec3 vPosition; 5 | 6 | void main() 7 | { 8 | vPosition = position; 9 | } 10 | -------------------------------------------------------------------------------- /res/shaders/tesselation/test_gs.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | uniform mat4 viewMatrix; 4 | uniform mat4 modelMatrix; 5 | 6 | layout(triangles) in; 7 | layout(triangle_strip, max_vertices = 3) out; 8 | in vec3 tePosition[3]; 9 | in vec3 tePatchDistance[3]; 10 | out vec3 gFacetNormal; 11 | out vec3 gPatchDistance; 12 | out vec3 gTriDistance; 13 | 14 | void main() 15 | { 16 | mat4 normalMatrix = transpose(inverse(viewMatrix * modelMatrix)); 17 | 18 | vec3 A = tePosition[2] - tePosition[0]; 19 | vec3 B = tePosition[1] - tePosition[0]; 20 | gFacetNormal = (normalMatrix * vec4(normalize(cross(A, B)), 1.0)).xyz; 21 | 22 | gPatchDistance = tePatchDistance[0]; 23 | gTriDistance = vec3(1, 0, 0); 24 | gl_Position = gl_in[0].gl_Position; EmitVertex(); 25 | 26 | gPatchDistance = tePatchDistance[1]; 27 | gTriDistance = vec3(0, 1, 0); 28 | gl_Position = gl_in[1].gl_Position; EmitVertex(); 29 | 30 | gPatchDistance = tePatchDistance[2]; 31 | gTriDistance = vec3(0, 0, 1); 32 | gl_Position = gl_in[2].gl_Position; EmitVertex(); 33 | 34 | EndPrimitive(); 35 | } 36 | -------------------------------------------------------------------------------- /res/shaders/tesselation/test_te.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | layout(triangles, equal_spacing, ccw) in; 4 | in vec3 tcPosition[]; 5 | out vec3 tePosition; 6 | out vec3 tePatchDistance; 7 | uniform mat4 mvpMatrix; 8 | 9 | void main() 10 | { 11 | vec3 p0 = gl_TessCoord.x * tcPosition[0]; 12 | vec3 p1 = gl_TessCoord.y * tcPosition[1]; 13 | vec3 p2 = gl_TessCoord.z * tcPosition[2]; 14 | tePatchDistance = gl_TessCoord; 15 | tePosition = p0 + p1 + p2; 16 | //tePosition = mix(p0, p1, 0.5); 17 | //tePosition = mix(tePosition, p2, 0.5); 18 | gl_Position = mvpMatrix * vec4(tePosition, 1.0); 19 | } 20 | -------------------------------------------------------------------------------- /res/shaders/tesselation/test_ts.glsl: -------------------------------------------------------------------------------- 1 | #version 430 core 2 | 3 | #define tessLevelInner 3 4 | #define tessLevelOuter 3 5 | 6 | layout(vertices = 3) out; 7 | in vec3 vPosition[]; 8 | out vec3 tcPosition[]; 9 | 10 | void main() 11 | { 12 | tcPosition[gl_InvocationID] = vPosition[gl_InvocationID]; 13 | if (gl_InvocationID == 0) 14 | { 15 | gl_TessLevelInner[0] = tessLevelInner; 16 | gl_TessLevelOuter[0] = tessLevelOuter; 17 | gl_TessLevelOuter[1] = tessLevelOuter; 18 | gl_TessLevelOuter[2] = tessLevelOuter; 19 | } 20 | } 21 | -------------------------------------------------------------------------------- /res/shaders/toon/toon_f.glsl: -------------------------------------------------------------------------------- 1 | #version 430 2 | 3 | in vec3 fragColor; 4 | in vec3 vertex; 5 | in vec3 norm; 6 | in vec2 textureCoord; 7 | in flat int texId; 8 | in mat4 modelMat; 9 | in mat4 viewMat; 10 | 11 | layout(location = 8) uniform vec3 cameraPosition; 12 | layout(location = 9) uniform vec3 lightPos; 13 | layout(location = 10) uniform float time; 14 | layout(location = 11) uniform sampler2D textures[7]; 15 | 16 | layout(location = 0) out vec4 outColor; 17 | 18 | void main() 19 | { 20 | outColor = vec4(1, 0, 0, 1); 21 | } 22 | -------------------------------------------------------------------------------- /res/shaders/toon/toon_v.glsl: -------------------------------------------------------------------------------- 1 | #version 430 2 | 3 | layout(location = 0) in vec3 position; 4 | layout(location = 1) in vec3 normal; 5 | layout(location = 2) in vec2 texCoord; 6 | layout(location = 3) in vec3 color; 7 | layout(location = 4) in float textureId; 8 | layout(location = 5) uniform mat4 projectionMatrix; 9 | layout(location = 6) uniform mat4 viewMatrix; 10 | layout(location = 7) uniform mat4 modelMatrix; 11 | layout(location = 8) uniform mat4 mvpMatrix; 12 | 13 | out vec3 fragColor; 14 | out vec3 vertex; 15 | out vec2 textureCoord; 16 | out vec3 norm; 17 | out flat int texId; 18 | 19 | void main() 20 | { 21 | vertex = position; 22 | textureCoord = texCoord; 23 | norm = normal; 24 | fragColor = color; 25 | texId = int(textureId); 26 | 27 | gl_Position = mvpMatrix * vec4(position, 1.0); 28 | } 29 | -------------------------------------------------------------------------------- /res/textures/grass.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/res/textures/grass.jpg -------------------------------------------------------------------------------- /src/Engine/Audio/Audio.hs: -------------------------------------------------------------------------------- 1 | module Engine.Audio.Audio ( 2 | setAudioMainVolume, Audio(..), 3 | loadAudio, playAudio, pauseAudio, 4 | stopAudio, setAudioVolume, setAudioLoop, 5 | destroyAudio 6 | ) where 7 | 8 | import Control.Applicative ((<$>)) 9 | 10 | import SFML.Audio 11 | 12 | import Engine.Audio.Types (Audio(..)) 13 | 14 | setAudioMainVolume :: Float -> IO () 15 | setAudioMainVolume = setGlobalVolume 16 | 17 | loadAudio :: FilePath -> IO Audio 18 | loadAudio file = Audio file 100 <$> err (musicFromFile file) 19 | 20 | playAudio :: Audio -> IO () 21 | playAudio = play . audioInner 22 | 23 | pauseAudio :: Audio -> IO () 24 | pauseAudio = pause . audioInner 25 | 26 | stopAudio :: Audio -> IO () 27 | stopAudio = stop . audioInner 28 | 29 | setAudioVolume :: Audio -> Float -> IO () 30 | setAudioVolume = setVolume . audioInner 31 | 32 | setAudioLoop :: Audio -> Bool -> IO () 33 | setAudioLoop = setLoop . audioInner 34 | 35 | destroyAudio :: Audio -> IO () 36 | destroyAudio = destroy . audioInner 37 | -------------------------------------------------------------------------------- /src/Engine/Audio/Types.hs: -------------------------------------------------------------------------------- 1 | module Engine.Audio.Types where 2 | 3 | import SFML.Audio 4 | 5 | data Audio = Audio { 6 | audioFile :: FilePath, 7 | audioVolume :: Float, 8 | audioInner :: Music 9 | } 10 | -------------------------------------------------------------------------------- /src/Engine/Bullet/Bullet.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ExistentialQuantification #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | module Engine.Bullet.Bullet where 4 | 5 | import Control.Monad (forM_, void) 6 | import Unsafe.Coerce (unsafeCoerce) 7 | import Control.Applicative ((<$>)) 8 | import Data.Default (Default(..)) 9 | 10 | import Data.Vec ((:.)(..), Mat44) 11 | import qualified Data.Vec as Vec (Vec3) 12 | 13 | import Physics.Bullet.Raw 14 | import Physics.Bullet.Raw.Types 15 | import Physics.Bullet.Raw.Class 16 | 17 | import Graphics.Rendering.OpenGL.Raw (GLfloat) 18 | 19 | import Engine.Mesh.AABB (AABB(..)) 20 | 21 | newtype Physics = Physics { 22 | physicsWorld :: BtDiscreteDynamicsWorld 23 | } deriving (Show, Eq, Ord) 24 | 25 | data RigidBodyInfo = RigidBodyInfo { 26 | rigidBodyMass :: Float, 27 | rigidBodyRestitution :: Float, 28 | rigidBodyFriction :: Float, 29 | rigidBodyStatic :: Bool, 30 | rigidBodyOtherMods :: BtRigidBody_btRigidBodyConstructionInfo -> IO () 31 | } 32 | instance Default RigidBodyInfo where 33 | def = RigidBodyInfo 0 0 1.5 True (const $ return ()) 34 | 35 | mkPhysics :: IO Physics 36 | mkPhysics = do 37 | -- Broadphase collision detector. 38 | hc <- btHashedOverlappingPairCache 39 | broadphase <- btDbvtBroadphase hc 40 | 41 | -- Collision config (default). 42 | collisionInfo <- btDefaultCollisionConstructionInfo 43 | collisionConfig <- btDefaultCollisionConfiguration collisionInfo 44 | 45 | -- Collision Dispatcher. 46 | dispatcher <- btCollisionDispatcher collisionConfig 47 | 48 | -- Constraint solver (how to get out of intersection). 49 | solver <- btSequentialImpulseConstraintSolver 50 | 51 | -- Physics world. 52 | dynamicsWorld <- btDiscreteDynamicsWorld 53 | dispatcher broadphase solver collisionConfig 54 | -- Set gravity. 55 | void $ set dynamicsWorld [worldGravity := Vec3 0 (-10) 0] 56 | 57 | return $ Physics dynamicsWorld 58 | 59 | addShape :: BtCollisionShapeClass o => o -> RigidBodyInfo -> Physics -> IO BtRigidBody 60 | addShape shape info physics = do 61 | -- Calculate inertia of shape. 62 | inertia <- btCollisionShape_calculateLocalInertia 63 | shape (rigidBodyMass info) nullVec3 64 | 65 | -- Initial state of shape 66 | motionSt <- btDefaultMotionState 67 | (Transform idmtx $ Vec3 0 0 0) 68 | nullTransform 69 | 70 | -- Rigid body constructor info. 71 | constrInfo <- btRigidBody_btRigidBodyConstructionInfo 72 | (rigidBodyMass info) 73 | motionSt 74 | shape 75 | inertia 76 | -- Set restitution. 77 | btRigidBody_btRigidBodyConstructionInfo_m_restitution_set 78 | constrInfo (rigidBodyRestitution info) 79 | -- Set friction. 80 | btRigidBody_btRigidBodyConstructionInfo_m_friction_set 81 | constrInfo (rigidBodyFriction info) 82 | 83 | -- Create a rigid body for shape. 84 | rigidBody <- btRigidBody0 constrInfo 85 | 86 | -- Add rigid body to world. 87 | btDynamicsWorld_addRigidBody (physicsWorld physics) rigidBody 88 | 89 | return rigidBody 90 | 91 | addAABBs :: [AABB] -> RigidBodyInfo -> Physics -> IO BtRigidBody 92 | addAABBs xs info physics = do 93 | shape <- btCompoundShape False 94 | mapM_ (addAABB shape) xs 95 | addShape shape info physics 96 | 97 | 98 | addAABB :: BtCompoundShape -> AABB -> IO () 99 | addAABB shape (AABB (lx :. ly :. lz :. ()) (hx :. hy :. hz :. ())) = do 100 | let halfVec = Vec3 ((/2) $ uC hx - uC lx) 101 | ((/2) $ uC hy - uC ly) 102 | ((/2) $ uC hz - uC lz) 103 | lowVec = Vec3 (uC lx) (uC ly) (uC lz) 104 | box <- btBoxShape halfVec 105 | void $ 106 | btCompoundShape_addChildShape shape 107 | (Transform idmtx lowVec) box 108 | 109 | addStaticTriangleMesh :: [Vec.Vec3 GLfloat] -> RigidBodyInfo -> Physics -> IO BtRigidBody 110 | addStaticTriangleMesh triangles info physics 111 | | not (null triangles) = do 112 | -- Create a mesh and add triangles to it. 113 | mesh <- btTriangleMesh True True 114 | addTrianglesToMesh triangles mesh 115 | 116 | shape <- btBvhTriangleMeshShape0 mesh True True 117 | 118 | addShape shape info physics 119 | | otherwise = error "Engine.Bullet.Bullet.addStaticTriangleMesh" 120 | 121 | 122 | 123 | addTriangleMesh :: [Vec.Vec3 GLfloat] -> RigidBodyInfo -> Physics -> IO BtRigidBody 124 | addTriangleMesh triangles info physics = do 125 | -- Create a mesh and add triangles to it. 126 | mesh <- btTriangleMesh True True 127 | addTrianglesToMesh triangles mesh 128 | 129 | -- Create a shape from the triangles 130 | -- TODO: This is the slowest shape possible. 131 | -- 132 | -- It should only be used if: 133 | -- * Mesh is concave. 134 | -- AND 135 | -- * Mesh is dynamic. 136 | -- 137 | -- * If mesh is convex, use "btConvexTriangleMeshShape" 138 | -- * If mesh is static, use "btBvhTriangleMeshShape" (?) 139 | -- 140 | -- And even for concave meshes, 141 | -- they can be converted into (many??) convex ones 142 | -- (https://code.google.com/p/bullet/source/browse/trunk/Demos/ConvexDecompositionDemo/ConvexDecompositionDemo.cpp) 143 | shape <- btGImpactMeshShape mesh 144 | btGImpactShapeInterface_updateBound shape 145 | btGImpactShapeInterface_postUpdate shape 146 | 147 | addShape shape info physics 148 | 149 | addTrianglesToMesh :: [Vec.Vec3 GLfloat] -> BtTriangleMesh -> IO () 150 | addTrianglesToMesh ( 151 | (x1:.y1:.z1:.()):(x2:.y2:.z2:.()):(x3:.y3:.z3:.()):others) mesh = 152 | let v1 = Vec3 (uC x1) (uC y1) (uC z1) 153 | v2 = Vec3 (uC x2) (uC y2) (uC z2) 154 | v3 = Vec3 (uC x3) (uC y3) (uC z3) 155 | in btTriangleMesh_addTriangle mesh v1 v2 v3 True >> 156 | addTrianglesToMesh others mesh 157 | addTrianglesToMesh [] _ = return () 158 | addTrianglesToMesh _ _ = error "Engine.Bullet.Bullet.addTrianglesToMesh" 159 | 160 | ---------------- 161 | -- Attr types -- 162 | ---------------- 163 | 164 | data Attr o a = forall x. Attr (o -> IO a) (o -> a -> IO x) 165 | 166 | data AttrOp o = 167 | forall a. Attr o a := a 168 | | forall a. Attr o a :~ (a -> a) 169 | | forall a. Attr o a :!= IO a 170 | | forall a. Attr o a :!~ (a -> IO a) 171 | infixr 0 :=, :~, :!=, :!~ 172 | 173 | --------------------- 174 | -- Attr primitives -- 175 | --------------------- 176 | 177 | set :: o -> [AttrOp o] -> IO o 178 | set obj attrs = (>> return obj) $ forM_ attrs $ \case 179 | Attr _ setter := x -> void $ setter obj x 180 | Attr getter setter :~ f -> void $ getter obj >>= setter obj . f 181 | Attr _ setter :!= x -> void $ x >>= setter obj 182 | Attr getter setter :!~ f -> void $ getter obj >>= f >>= setter obj 183 | 184 | get :: o -> Attr o a -> IO a 185 | get obj (Attr getter _) = getter obj 186 | 187 | make :: IO o -> [AttrOp o] -> IO o 188 | make act flags = do 189 | obj <- act 190 | void $ set obj flags 191 | return obj 192 | 193 | ------------------ 194 | -- Bullet Attrs -- 195 | ------------------ 196 | 197 | worldTransform :: BtCollisionObjectClass o => Attr o Transform 198 | worldTransform = Attr btCollisionObject_getWorldTransform 199 | btCollisionObject_setWorldTransform 200 | 201 | worldGravity :: BtDiscreteDynamicsWorldClass o => Attr o Vec3 202 | worldGravity = Attr btDiscreteDynamicsWorld_getGravity 203 | btDiscreteDynamicsWorld_setGravity 204 | 205 | motionState :: BtRigidBodyClass o => Attr o BtMotionState 206 | motionState = Attr btRigidBody_getMotionState 207 | btRigidBody_setMotionState 208 | 209 | linearVelocity :: BtRigidBodyClass o => Attr o Vec3 210 | linearVelocity = Attr btRigidBody_getLinearVelocity 211 | btRigidBody_setLinearVelocity 212 | 213 | angularVelocity :: BtRigidBodyClass o => Attr o Vec3 214 | angularVelocity = Attr btRigidBody_getAngularVelocity 215 | btRigidBody_setAngularVelocity 216 | 217 | linearFactor :: BtRigidBodyClass o => Attr o Vec3 218 | linearFactor = Attr btRigidBody_getLinearFactor 219 | btRigidBody_setLinearFactor 220 | 221 | angularFactor :: BtRigidBodyClass o => Attr o Vec3 222 | angularFactor = Attr btRigidBody_getAngularFactor 223 | btRigidBody_setAngularFactor 224 | 225 | linearSleepingThreshold :: BtRigidBodyClass o => Attr o Float 226 | linearSleepingThreshold = 227 | Attr btRigidBody_getLinearSleepingThreshold 228 | (\rigidBody linearST -> do 229 | angularST <- btRigidBody_getAngularSleepingThreshold rigidBody 230 | btRigidBody_setSleepingThresholds rigidBody linearST angularST) 231 | 232 | --------------- 233 | -- Utilities -- 234 | --------------- 235 | 236 | getVecMat :: BtCollisionObjectClass o => o -> IO (Mat44 GLfloat) 237 | getVecMat collisionObj = mkVecMat <$> collisionObj `get` worldTransform 238 | 239 | mkVecMat :: Transform -> Mat44 GLfloat 240 | mkVecMat (Transform 241 | (Mat3 (Vec3 a1 a2 a3) (Vec3 b1 b2 b3) 242 | (Vec3 c1 c2 c3)) 243 | (Vec3 p1 p2 p3)) = 244 | (uC a1 :. uC a2 :. uC a3 :. uC p1) :. 245 | (uC b1 :. uC b2 :. uC b3 :. uC p2) :. 246 | (uC c1 :. uC c2 :. uC c3 :. uC p3) :. 247 | (0 :. 0 :. 0 :. 1 ) :. () 248 | {- 249 | column-major (Vec uses row-major) 250 | (uC a1 :. uC b1 :. uC c1 :. 0) :. 251 | (uC a2 :. uC b2 :. uC c2 :. 0) :. 252 | (uC a3 :. uC b3 :. uC c3 :. 0) :. 253 | (uC p1 :. uC p2 :. uC p3 :. 1) :. () 254 | -} 255 | 256 | uC :: a -> b 257 | uC = unsafeCoerce 258 | 259 | nullTransform :: Transform 260 | nullTransform = Transform idmtx nullVec3 261 | 262 | nullVec3 :: Vec3 263 | nullVec3 = Vec3 0 0 0 264 | 265 | ---------------------------------- 266 | -- Creation of AABBs for meshes -- 267 | ---------------------------------- 268 | 269 | bulletize :: [GLfloat] -> [AABB] 270 | bulletize points = undefined 271 | -------------------------------------------------------------------------------- /src/Engine/Core/HasPosition.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeSynonymInstances #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | module Engine.Core.HasPosition ( 4 | HasPosition(..), 5 | HasRotation(..), 6 | HasVelocity(..) 7 | ) where 8 | 9 | import Data.Vec 10 | import Graphics.Rendering.OpenGL.Raw (GLfloat) 11 | 12 | -- | A class for types that have a position 13 | -- that can be retrieved and set. 14 | class HasPosition p where 15 | getPos :: p -> Vec3 GLfloat 16 | setPos :: p -> Vec3 GLfloat -> p 17 | movePos :: p -> Vec3 GLfloat -> p 18 | movePos hp movement = 19 | setPos hp (getPos hp + movement) 20 | {-# MINIMAL getPos, setPos #-} 21 | 22 | -- | A class for types that have a rotation 23 | -- that can be retrieved and set. 24 | class HasRotation r where 25 | getRot :: r -> Vec3 GLfloat 26 | setRot :: r -> Vec3 GLfloat -> r 27 | rotate :: r -> Vec3 GLfloat -> r 28 | rotate r deltaR = 29 | setRot r (getRot r + deltaR) 30 | {-# MINIMAL getRot, setRot #-} 31 | 32 | -- | A class for types that have a velocity 33 | -- that can be retrieved and set. 34 | class HasVelocity v where 35 | getVel :: v -> Vec3 GLfloat 36 | setVel :: v -> Vec3 GLfloat -> v 37 | applyVel :: v -> Vec3 GLfloat -> v 38 | applyVel v deltaV = 39 | setVel v (getVel v + deltaV) 40 | {-# MINIMAL getVel, setVel #-} 41 | 42 | instance HasPosition (Vec3 GLfloat) where 43 | getPos = id 44 | setPos _ = id 45 | 46 | instance HasRotation (Vec3 GLfloat) where 47 | getRot = id 48 | setRot _ = id 49 | 50 | instance HasVelocity (Vec3 GLfloat) where 51 | getVel = id 52 | setVel _ = id 53 | -------------------------------------------------------------------------------- /src/Engine/Core/NewTypes.hs: -------------------------------------------------------------------------------- 1 | module Engine.Core.NewTypes where 2 | -------------------------------------------------------------------------------- /src/Engine/Core/Util.hs: -------------------------------------------------------------------------------- 1 | module Engine.Core.Util ( 2 | toRadians, sinDeg, cosDeg 3 | ) where 4 | 5 | {-# INLINE toRadians #-} 6 | toRadians :: Floating a => a -> a 7 | toRadians degrees = degrees * (pi/180) 8 | 9 | {-# INLINE sinDeg #-} 10 | sinDeg :: Float -> Float 11 | sinDeg = sin . toRadians 12 | {-# INLINE cosDeg #-} 13 | cosDeg :: Float -> Float 14 | cosDeg = cos . toRadians 15 | -------------------------------------------------------------------------------- /src/Engine/Core/World.hs: -------------------------------------------------------------------------------- 1 | module Engine.Core.World ( 2 | setWorldPlayer, 3 | getWorldDelta, 4 | getWorldTime 5 | ) where 6 | 7 | import Data.Time (getCurrentTime, utctDayTime) 8 | import Control.Applicative ((<$>)) 9 | 10 | import Graphics.Rendering.OpenGL.Raw (GLfloat) 11 | 12 | import Engine.Core.Types 13 | (World(..), WorldState(..), Graphics(..), 14 | Player(..)) 15 | import Engine.Graphics.Shaders (Shader(..), setUniformsAndRemember) 16 | 17 | setWorldPlayer :: Player t -> World t -> World t 18 | setWorldPlayer player world = world{worldPlayer = player} 19 | 20 | {- 21 | -- | Set a world's uniforms to given shader. 22 | setWorldUniforms :: World t -> Shader -> IO Shader 23 | setWorldUniforms world shader = 24 | setUniformsAndRemember shader $ graphicsUniforms $ worldGraphics world 25 | -} 26 | 27 | getWorldDelta :: World t -> GLfloat 28 | getWorldDelta = stateDelta . worldState 29 | 30 | -- | Call "Data.Time.getCurrentTime", convert to fractional. 31 | getWorldTime :: Fractional a => IO a 32 | getWorldTime = realToFrac . utctDayTime <$> getCurrentTime 33 | -------------------------------------------------------------------------------- /src/Engine/Core/WorldCreator.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | module Engine.Core.WorldCreator ( 4 | Proto(..), 5 | fromObj, modify, 6 | createFromProto, 7 | defaultWorld, createWorld, 8 | defaultSettings 9 | ) where 10 | 11 | import Control.Monad.State hiding (modify) 12 | import System.FilePath (()) 13 | import Data.Vec ((:.)(..)) 14 | 15 | import Unsafe.Coerce (unsafeCoerce) 16 | 17 | import Physics.Bullet.Raw.Types 18 | (Vec3(..), Transform(..), idmtx) 19 | 20 | import Graphics.Rendering.OpenGL.Raw (GLfloat) 21 | import qualified Graphics.UI.GLFW as GLFW 22 | 23 | import Engine.Core.Types 24 | (World(..), WorldState(..), 25 | Entity(..), GameIO(..), io, 26 | emptyWorldState, 27 | lWorldShaderUniverse, (%=)) 28 | import Engine.Object.Player (mkPlayer) 29 | import Engine.Core.World (getWorldTime) 30 | import Engine.Mesh.ObjLoader (loadObjObject) 31 | import Engine.Terrain.Noise (Simplex(..)) 32 | import Engine.Mesh.AABB (AABB(..)) 33 | import Engine.Bullet.Bullet 34 | (AttrOp(..), mkPhysics, set, worldTransform) 35 | import Engine.Graphics.Primitive 36 | 37 | data family Proto a 38 | 39 | data instance Proto (World t) = 40 | ProtoWorld { 41 | settingsSimplex :: Maybe Simplex, 42 | settingsTerrainShaders :: (FilePath, FilePath), 43 | settingsTerrainTexture :: Maybe FilePath, 44 | settingsObjs :: [Proto (Entity t)], 45 | settingsWholeAABB :: AABB, 46 | settingsWindow :: GLFW.Window, 47 | settingsPostShaders :: [(FilePath, FilePath)], 48 | settingsShadowShader :: (FilePath, FilePath), 49 | settingsShaderAttribs :: [(String, IO [GLfloat])] 50 | } 51 | 52 | data instance Proto (Entity t) = 53 | FromObj FilePath [Entity t -> Entity t] t 54 | 55 | -- | Create a "ProtoObject" that contains 56 | -- instructions to parse a file and create 57 | -- a "GameObject". 58 | fromObj :: FilePath -> t -> Proto (Entity t) 59 | fromObj file attr = FromObj file [] attr 60 | 61 | -- | Add a function that will modify the 62 | -- GameObject after it is loaded. 63 | modify :: (Entity t -> Entity t) -> 64 | Proto (Entity t) -> 65 | Proto (Entity t) 66 | modify f (FromObj file mods attr) = 67 | FromObj file (f:mods) attr 68 | 69 | createFromProto :: Proto (Entity t) -> GameIO t (Entity t) 70 | createFromProto (FromObj file mods attr) = do 71 | ent <- loadObjObject attr file 72 | 73 | let (prog, entity) = (\(prg, obj) -> (prg, foldr (\f o -> f o) obj mods)) ent 74 | world <- get 75 | 76 | let shaderGalaxy = PureGalaxy prog id (world, entity) 77 | lWorldShaderUniverse %= (`addGalaxy` shaderGalaxy) 78 | 79 | let x :. y :. z :. () = entityPosition entity 80 | pos = Vec3 (uC x) (uC y) (uC z) 81 | trans = Transform idmtx pos 82 | io . void $ set (entityRigidBody entity) [worldTransform := trans] 83 | return entity 84 | where 85 | uC = unsafeCoerce 86 | 87 | defaultSettings :: GLFW.Window -> Proto (World ()) 88 | defaultSettings win = 89 | ProtoWorld 90 | (Just $ Simplex 0 (200, 200) (0, 0) 1 1 20 10 undefined) 91 | (".." "res" "shaders" "correct_v.glsl", 92 | ".." "res" "shaders" "correct_f.glsl") 93 | (Just $ ".." "res" "textures" "grass.jpg") 94 | [ 95 | {-fromObj (".." "res" "objects" "wow" "wow.obj") 96 | (".." "res" "shaders" "correct_v.glsl") 97 | (".." "res" "shaders" "correct_f.glsl") (),-} 98 | modify (\x -> x{entityPosition = (-20) :. (-20) :. (-5) :. ()}) $ 99 | fromObj (".." "res" "objects" "ibanez" "ibanez.obj") 100 | ()] 101 | (AABB (-100) 200) 102 | (win) 103 | {-[(".." "res" "shaders" "postprocessing" 104 | "passthrough" "passthrough_v.glsl", 105 | ".." "res" "shaders" "postprocessing" 106 | "passthrough" "passthrough_f.glsl")]-} 107 | [(".." "res" "shaders" "postprocessing" "dof" "dof_v.glsl", 108 | ".." "res" "shaders" "postprocessing" "dof" "dof_f.glsl"), 109 | (".." "res" "shaders" "postprocessing" "fxaa" "fxaa_v.glsl", 110 | ".." "res" "shaders" "postprocessing" "fxaa" "fxaa_f.glsl")] 111 | (".." "res" "shaders" "shadow" "shadow_v.glsl", 112 | ".." "res" "shaders" "shadow" "shadow_f.glsl") 113 | [("lightPos", return [0.0, 10.0, 0.0])] 114 | 115 | defaultWorld :: World t 116 | defaultWorld = 117 | World undefined 118 | ([] -|> []) 119 | undefined 120 | emptyWorldState 121 | 122 | createWorld :: (GLFW.Window -> Proto (World ())) -> IO (World ()) 123 | createWorld settings' = do 124 | window <- openWindow 125 | initGL window 126 | 127 | let settings = settings' window 128 | 129 | physics <- mkPhysics 130 | 131 | player <- mkPlayer physics 132 | t <- getWorldTime 133 | 134 | let wstate = WorldState t 0 False window 135 | let world = defaultWorld{ 136 | worldPhysics = physics, 137 | worldPlayer = player, 138 | worldState = wstate} 139 | 140 | world' <- createAllObjects world $ settingsObjs settings 141 | 142 | return world' 143 | 144 | createAllObjects :: World t -> [Proto (Entity t)] -> IO (World t) 145 | createAllObjects world (x:xs) = do 146 | world' <- execStateT (gameIoState $ createFromProto x) world 147 | createAllObjects world' xs 148 | createAllObjects world [] = return world 149 | 150 | {- 151 | createTerrain :: Physics -> Proto (World t) -> IO (Maybe (Entity ())) 152 | createTerrain phys settings = 153 | let msimplex = settingsSimplex settings 154 | (vert, frag) = settingsTerrainShaders settings 155 | in if isJust msimplex 156 | then 157 | let simplex = fromJust msimplex 158 | (w, _) = simpDimensions simplex 159 | in Just <$> 160 | generateTerrain phys vert frag 161 | (fromIntegral w) (simpSpacing simplex) 162 | (simpOctaves simplex) 163 | (simpWavelength simplex) 164 | (simpIntensity simplex) 165 | (settingsTerrainTexture settings) 166 | else return Nothing 167 | -} 168 | -------------------------------------------------------------------------------- /src/Engine/FRP/FRP: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/src/Engine/FRP/FRP -------------------------------------------------------------------------------- /src/Engine/FRP/FRP.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecursiveDo #-} 2 | {-# LANGUAGE NoMonomorphismRestriction #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE PackageImports #-} 5 | module Engine.FRP.FRP where 6 | 7 | import Prelude hiding ((.)) 8 | import Data.Monoid (Monoid) 9 | import "mtl" Control.Monad.Identity 10 | import Control.Applicative 11 | import Data.Time (NominalDiffTime) 12 | import Control.Monad.IO.Class 13 | import System.IO 14 | import Control.Parallel.Strategies 15 | --import Control.Arrow hiding (loop) 16 | 17 | import Debug.Trace (trace) 18 | 19 | import qualified FRP.Netwire as N 20 | import FRP.Netwire ((-->), (&>)) 21 | import qualified Control.Wire.Core as C 22 | import qualified Control.Wire.Session as S 23 | import FRP.Netwire (Wire, HasTime, (.)) 24 | 25 | import qualified FRP.Elerea.Simple as E 26 | import FRP.Elerea.Simple (SignalGen, Signal) 27 | 28 | -- = Elerea 29 | 30 | mainE :: IO () 31 | mainE = loop $ networkMove recieveInput 32 | 33 | driveNetwork :: Show a => SignalGen (Signal a) -> IO () 34 | driveNetwork = forever . (\x -> join x >>= print) . E.start 35 | 36 | driveFor :: Show a => Int -> SignalGen (Signal a) -> IO () 37 | driveFor i x = 38 | E.start x >>= replicateM i >>= print 39 | 40 | loop :: Show a => SignalGen (Signal a) -> IO () 41 | loop signal = 42 | E.start signal >>= fix ((>>) <$> (>>= print) <*>) 43 | 44 | recieveInput :: SignalGen (Signal Bool) 45 | recieveInput = E.effectful $ do 46 | putStr "Continue? " 47 | ln <- getLine 48 | if ln == "yes" 49 | then putStrLn "True" >> return True 50 | else putStrLn "False" >> return False 51 | 52 | networkMove :: SignalGen (Signal Bool) -> SignalGen (Signal Integer) 53 | networkMove tBool = do 54 | rec let final = do 55 | b <- tBool >>= E.snapshot 56 | E.delay 1 =<< 57 | if b 58 | then trace "true" $ foldp (const (+1)) 1 $ return first 59 | else trace "false" $ foldp (const (subtract 1)) 1 $ return first 60 | first <- final >>= E.delay 1 :: SignalGen (Signal Integer) 61 | final 62 | 63 | networkFib :: SignalGen (Signal Integer) 64 | networkFib = do 65 | rec let fib'' = (+) <$> fib' <*> fib 66 | fib' <- E.delay 1 fib'' 67 | fib <- E.delay 1 fib' 68 | return fib 69 | 70 | -- Elerea utils. 71 | 72 | -- | Create a signal that never changes. 73 | constant :: a -> SignalGen (Signal a) 74 | constant = return . return 75 | 76 | -- | Applies a function to a signal producing a new signal. 77 | (<~) :: (a -> b) -> SignalGen (Signal a) -> SignalGen (Signal b) 78 | (<~) = fmap . fmap 79 | 80 | infixl 4 <~ 81 | 82 | -- | Applies a function within a signal to a signal. 83 | (~~) :: SignalGen (Signal (a -> b)) -> 84 | SignalGen (Signal a) -> 85 | SignalGen (Signal b) 86 | (~~) = (<*>) . fmap (<*>) 87 | 88 | infixl 4 ~~ 89 | 90 | -- | Creates a past-dependent signal that depends on another signal. 91 | -- This is a wrapper around the 'transfer' function that 92 | -- automatically binds the input signal out of the signal 93 | -- generator. 94 | foldp :: (a -> b -> b) -> b -> SignalGen (Signal a) -> SignalGen (Signal b) 95 | foldp f ini = (>>= E.transfer ini f) 96 | 97 | -- | Creates a signal that counts the amount of 98 | -- times it has been sampled. 99 | count :: SignalGen (Signal Int) 100 | count = E.stateful 0 (+1) 101 | 102 | -- | Creates a signal that counts the amount of times an 103 | -- input signal has passed a predicate when sampled. 104 | countIf :: (a -> Bool) -> SignalGen (Signal a) -> SignalGen (Signal Int) 105 | countIf f = foldp (\v c -> c + fromEnum (f v)) 0 106 | 107 | ------------- 108 | -- Netwire -- 109 | ------------- 110 | 111 | control :: (Monoid e, Show b, Show e) => 112 | (e -> IO ()) -> 113 | (b -> IO ()) -> 114 | Wire (S.Timed NominalDiffTime ()) e Identity () b -> 115 | IO b1 116 | control whenInhibited whenProduced = 117 | loopN N.clockSession_ 118 | where 119 | loopN session' wire' = do 120 | (ds, s) <- S.stepSession session' 121 | let Identity (mx, w) = C.stepWire wire' ds (Right ()) 122 | 123 | putChar '\r' 124 | case mx of 125 | Left ex -> whenInhibited ex 126 | Right x -> whenProduced x 127 | putStr "\027" 128 | hFlush stdout 129 | 130 | loopN s w 131 | 132 | controlIO :: (MonadIO m, Applicative m) => 133 | (e -> m ()) -> 134 | (a -> m ()) -> 135 | Wire (S.Timed NominalDiffTime ()) e m a a -> 136 | a -> 137 | m () 138 | controlIO whenInhibited whenProduced = 139 | loopN N.clockSession_ 140 | where 141 | loopN session wire val = do 142 | (ds, s) <- S.stepSession session 143 | (mx, w) <- C.stepWire wire ds (Right val) 144 | case mx of 145 | Left ex -> whenInhibited ex 146 | Right x -> do 147 | whenProduced x 148 | loopN s w x 149 | 150 | controlIO_ :: (MonadIO m, Applicative m) => 151 | (e -> m ()) -> 152 | (b -> m ()) -> 153 | Wire (S.Timed NominalDiffTime ()) e m () b -> 154 | m () 155 | controlIO_ whenInhibited whenProduced = 156 | loopN N.clockSession_ 157 | where 158 | loopN session wire = do 159 | (ds, s) <- S.stepSession session 160 | (mx, w) <- C.stepWire wire ds (Right ()) 161 | case mx of 162 | Left ex -> whenInhibited ex 163 | Right x -> whenProduced x 164 | loopN s w 165 | 166 | inputWire :: Monoid s => Wire s e IO (Int, Int) (Int, Int) 167 | inputWire = C.mkGenN trans 168 | where 169 | trans (x, y) = do 170 | input <- hGetChar stdin 171 | let newCoord = 172 | case input of 173 | 'a' -> (x-1, y) 174 | 'd' -> (x+1, y) 175 | 'w' -> (x, y+1) 176 | 's' -> (x, y-1) 177 | _ -> (x, y) 178 | return (Right newCoord, inputWire) 179 | 180 | keyPress :: Wire s e IO () (N.Event Char) 181 | keyPress = keyCheck . getKey 182 | 183 | keyCheck :: Wire s e m Char (N.Event Char) 184 | keyCheck = N.became (`elem` keys) 185 | where 186 | keys = ['a', 'd', 'w', 's'] 187 | 188 | getKey :: Wire s e IO a Char 189 | getKey = C.mkGen_ trans 190 | where 191 | trans _ = Right <$> hGetChar stdin 192 | 193 | playerWire :: HasTime t s => Wire s () IO () (Int, Int) 194 | playerWire = N.holdFor 1 . playerEvent 195 | 196 | playerEvent :: Wire s () IO () (N.Event (Int, Int)) 197 | playerEvent = N.accumE move (0, 0) . keyPress 198 | where 199 | move (x, y) key = 200 | case key of 201 | 'a' -> (x-1, y) 202 | 'd' -> (x+1, y) 203 | 'w' -> (x, y+1) 204 | 's' -> (x, y-1) 205 | _ -> (x, y) 206 | 207 | gameWire :: (HasTime t s) => Wire s () IO () String 208 | gameWire = monster . playerWire 209 | 210 | monster :: (HasTime t s, Monoid e, Monoid s) => Wire s e IO (Int, Int) String 211 | monster = "Roar!!!" . N.holdFor 1 . atMonster -- <|> "Snore..." 212 | 213 | atMonster :: Wire s e m (Int, Int) (N.Event (Int, Int)) 214 | atMonster = N.became (==(0,1)) 215 | 216 | liftIOToWire :: Monoid s => (a -> IO b) -> Wire s e IO a b 217 | liftIOToWire f = C.mkGen trans 218 | where 219 | trans _ value = do 220 | x <- f value 221 | return (Right x, liftIOToWire f) 222 | 223 | printWire :: Monoid s => Wire s e IO Int Int 224 | printWire = C.mkGen trans 225 | where 226 | trans _ a = do 227 | putStrLn $ "Hello" ++ show a 228 | return (Right (a+1), printWire) 229 | 230 | countN :: (Monad m, HasTime t s) => Wire s () m () Double 231 | countN = N.integral 0 . 1 232 | 233 | sequenced :: HasTime t s => Wire s () Identity () String 234 | sequenced = N.for 3 . "First" --> "Second" 235 | 236 | events :: (HasTime t s, Monad m) => Wire s () m () t 237 | events = N.asSoonAs . (N.at 2 &> N.at 3) . N.time 238 | 239 | inParallel :: Wire s e m a a 240 | inParallel = N.evalWith rpar 241 | 242 | createPlayer :: (Int, Int) -> String 243 | createPlayer (x, y) = 244 | replicate (max 0 y) '\n' ++ 245 | replicate (max 0 x) ' ' ++ "X" 246 | 247 | mainN :: IO () 248 | mainN = control 249 | (const $ putStr "Inhibited") 250 | (\p -> putStr $ "Produced: " ++ show p) 251 | -- sequenced 252 | countN 253 | 254 | mainN' :: IO () 255 | mainN' = controlIO 256 | (const $ putStrLn "Inhibited") 257 | (\p -> putStrLn $ createPlayer p) 258 | inputWire 259 | (0, 0) 260 | -------------------------------------------------------------------------------- /src/Engine/Graphics/Framebuffer.hs: -------------------------------------------------------------------------------- 1 | module Engine.Graphics.Framebuffer ( 2 | Framebuffer(..), mkScreenFramebuffer 3 | ) where 4 | 5 | import qualified Graphics.UI.GLFW as GLFW 6 | 7 | import Graphics.Rendering.OpenGL.Raw 8 | (GLuint, GLint) 9 | 10 | -- | All OpenGL handles for a Framebuffer and 11 | -- Renderbuffer. 12 | data Framebuffer = Framebuffer { 13 | fbufName :: GLuint, 14 | fbufTexture :: GLuint, 15 | fbufDimensions :: (GLint, GLint), 16 | fbufVBO :: GLuint, 17 | fbufRenderBuffer :: GLuint 18 | } deriving (Show, Eq) 19 | mkScreenFramebuffer :: GLFW.Window -> IO Framebuffer 20 | mkScreenFramebuffer win = do 21 | (w, h) <- GLFW.getFramebufferSize win 22 | return $ Framebuffer 0 0 (fromIntegral w, fromIntegral h) 0 0 23 | -------------------------------------------------------------------------------- /src/Engine/Graphics/Graphics.hs: -------------------------------------------------------------------------------- 1 | module Engine.Graphics.Graphics ( 2 | {- 3 | initGL, resizeScene, 4 | cleanupObjects, renderWorld, 5 | cleanupWorld, renderObjects, 6 | renderAllPasses, makeFrameBuffer, 7 | renderWorldWithPostprocessing 8 | -} 9 | ) where 10 | 11 | import Foreign (alloca, peek, new, withArray) 12 | import Foreign.Marshal (with) 13 | import Foreign.C (withCString) 14 | import Data.Bits ((.|.)) 15 | import Data.Maybe (fromJust) 16 | import Data.Vec hiding (map) 17 | 18 | import qualified Graphics.UI.GLFW as GLFW 19 | 20 | import Graphics.Rendering.OpenGL.Raw 21 | 22 | import Engine.Core.Types 23 | (World(..), WorldState(..), Entity(..), 24 | Graphics(..)) 25 | import Engine.Graphics.Shaders 26 | (Shader(..), ShaderAttrib(..), setShaderAttribs, 27 | bindTextures, disableShaderAttribs, setUniforms) 28 | import Engine.Graphics.Framebuffer (Framebuffer(..)) 29 | import Engine.Graphics.GraphicsUtils (offset0, fillNewBuffer) 30 | import Engine.Core.HasPosition (HasPosition(..), HasRotation(..)) 31 | import Engine.Matrix.Matrix 32 | (WorldMatrices(..), calculateMatricesFromPlayer, 33 | setMatrixUniforms) 34 | import Engine.Graphics.Window (Window(..)) 35 | import Engine.Mesh.Mesh (Mesh(..)) 36 | 37 | {- 38 | renderWorld :: World t -> IO (World t) 39 | renderWorld world = do 40 | glClear $ gl_COLOR_BUFFER_BIT .|. gl_DEPTH_BUFFER_BIT 41 | 42 | -- Get window dimensions from GLFW 43 | dimensions <- GLFW.getWindowSize 44 | (fromJust $ windowInner $ stateWindow $ worldState world) 45 | 46 | -- Update matrices. 47 | let worldMats = calculateMatricesFromPlayer 48 | (worldPlayer world) dimensions 49 | 50 | -- Render world with matrices. 51 | newEntites <- renderObjects world worldMats (worldEntities world) 52 | return world{worldEntities = newEntites} 53 | 54 | renderObjects :: World t -> WorldMatrices -> [Entity t] -> IO [Entity t] 55 | renderObjects world wm (object:rest) = do 56 | let model = getModel object 57 | objx :. objy :. objz :. () = getPos object 58 | objrx :. objry :. objrz :. () = getRot object 59 | mShader = meshShader model 60 | 61 | -- Move Object 62 | modelMat = translate (objx :. objy :. objz :. ()) $ 63 | rotationEuler (objrx :. objry :. objrz :. ()) 64 | 65 | -- Use object's shader 66 | glUseProgram $ shaderId mShader 67 | 68 | -- Set uniforms. (World uniforms and Matrices). 69 | newShader <- 70 | setMatrixUniforms mShader wm{matrixModel = modelMat} 71 | 72 | -- Bind buffers to variable names in shader. 73 | setShaderAttribs $ meshShaderVars model 74 | bindTextures (meshTextures model) $ shaderId newShader 75 | 76 | -- Do the drawing. 77 | glDrawArrays gl_TRIANGLES 0 (meshVertCount model) 78 | 79 | -- TODO: Remove if not necessary. 80 | -- Disable textures. 81 | --unBindTextures (fromIntegral . length . modelTextures $ model) 82 | 83 | -- Turn off VBO/VAO 84 | disableShaderAttribs $ meshShaderVars model 85 | 86 | -- Disable the object's shader. 87 | glUseProgram 0 88 | 89 | -- Update the object's shader 90 | let newObject = object{entityModel = 91 | (entityModel object){meshShader = newShader}} 92 | 93 | restObjects <- renderObjects world wm rest 94 | 95 | return $ newObject : restObjects 96 | renderObjects _ _ [] = return [] 97 | 98 | ------------------------------- 99 | -- UTILITY / SETUP FUNCTIONS -- 100 | ------------------------------- 101 | 102 | initGL :: GLFW.Window -> IO () 103 | initGL win = do 104 | -- Enables smooth color shading. 105 | --glShadeModel gl_SMOOTH 106 | 107 | -- Set "background color" to black 108 | glClearColor 0 0 0 0 109 | 110 | -- Enables clearing of the depth buffer 111 | glClearDepth 1 112 | -- Allow depth testing (3D) 113 | glEnable gl_DEPTH_TEST 114 | -- Tells OpenGL how to deal with overlapping shapes 115 | glDepthFunc gl_LESS 116 | --glDepthFunc gl_LEQUAL 117 | 118 | -- Tell OpenGL to use the nicest perspective correction. 119 | -- The other choices are gl_FASTEST and gl_DONT_CARE. 120 | glHint gl_PERSPECTIVE_CORRECTION_HINT gl_NICEST 121 | 122 | -- Enable culling of faces. 123 | glEnable gl_CULL_FACE 124 | -- Do not render the backs of faces. Increases performance. 125 | glCullFace gl_BACK 126 | 127 | -- Enable textures. 128 | --glEnable gl_TEXTURE 129 | glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER 130 | (fromIntegral gl_LINEAR) 131 | glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER 132 | (fromIntegral gl_LINEAR_MIPMAP_LINEAR) 133 | glTexParameteri gl_TEXTURE_2D gl_TEXTURE_WRAP_S 134 | (fromIntegral gl_CLAMP_TO_EDGE) 135 | glTexParameteri gl_TEXTURE_2D gl_TEXTURE_WRAP_T 136 | (fromIntegral gl_CLAMP_TO_EDGE) 137 | 138 | -- Call resize function. 139 | (w,h) <- GLFW.getFramebufferSize win 140 | resizeScene win w h 141 | 142 | resizeScene :: GLFW.WindowSizeCallback 143 | -- Prevent divide by 0 144 | resizeScene win w 0 = resizeScene win w 1 145 | resizeScene _ width height = 146 | -- Make viewport the same size as the window. 147 | glViewport 0 0 (fromIntegral width) (fromIntegral height) 148 | 149 | cleanupWorld :: World t -> IO () 150 | cleanupWorld world = do 151 | let fb = fst $ graphicsPostProcessors $ worldGraphics world 152 | shaders = snd $ graphicsPostProcessors $ worldGraphics world 153 | with (fbufName fb) $ glDeleteFramebuffers 1 154 | with (fbufTexture fb) $ glDeleteTextures 1 155 | with (fbufVBO fb) $ glDeleteVertexArrays 1 156 | mapM_ glDeleteProgram shaders 157 | with (fbufRenderBuffer fb) $ glDeleteRenderbuffers 1 158 | 159 | cleanupObjects :: [Entity t] -> IO () 160 | cleanupObjects (object:rest) = do 161 | -- Delete buffers. 162 | let shaderVarAttrIds = map (\(ShaderAttrib attrId _ _) -> attrId) 163 | (meshShaderVars $ getModel object) 164 | shaderVarBufIds = map (\(ShaderAttrib _ bufId _) -> bufId) 165 | (meshShaderVars $ getModel object) 166 | mapM_ (\x -> with x $ glDeleteBuffers 1) shaderVarBufIds 167 | 168 | -- Delete shader. 169 | glDeleteProgram (shaderId $ meshShader $ getModel object) 170 | 171 | -- Delete textures. 172 | let model = getModel object 173 | textures = map fst $ meshTextures model 174 | mapM_ (\x -> with x $ glDeleteTextures 1) textures 175 | 176 | -- Delete vertex arrays. 177 | mapM_ (\x -> with x $ glDeleteVertexArrays 1) shaderVarAttrIds 178 | 179 | print "cleanup" 180 | 181 | cleanupObjects rest 182 | cleanupObjects [] = return () 183 | 184 | -- = Framebuffer 185 | 186 | -- | Render world with all postprocessing shaders defined by 187 | -- worldFramebuffer. 188 | renderWorldWithPostprocessing :: World t -> IO (World t) 189 | renderWorldWithPostprocessing world = do 190 | let effects = snd $ graphicsPostProcessors $ worldGraphics world 191 | glBindFramebuffer gl_FRAMEBUFFER $ 192 | fbufName $ fst $ graphicsPostProcessors $ worldGraphics world 193 | ret <- renderWorld world 194 | 195 | renderAllPasses ret effects 196 | return ret 197 | 198 | renderAllPasses :: World t -> [GLuint] -> IO () 199 | renderAllPasses world (shader:otherShader:rest) = do 200 | -- Render to FB. 201 | renderPostPass (fst $ graphicsPostProcessors $ worldGraphics world) 202 | (worldState world) shader 203 | 204 | -- Make framebuffer use the new rendered image. 205 | glTexParameteri gl_TEXTURE_2D (fromIntegral gl_TEXTURE_MAG_FILTER) 206 | (fromIntegral gl_NEAREST) 207 | glTexParameteri gl_TEXTURE_2D (fromIntegral gl_TEXTURE_MIN_FILTER) 208 | (fromIntegral gl_NEAREST) 209 | 210 | -- Continue with other shaders. 211 | renderAllPasses world $ otherShader:rest 212 | 213 | renderAllPasses world (shader:[]) = 214 | let fb = fst $ graphicsPostProcessors $ worldGraphics world 215 | -- If this is the last postprocessing shader, 216 | -- render it to the screen. 217 | in do 218 | glBindFramebuffer gl_FRAMEBUFFER 0 219 | uncurry (glViewport 0 0) $ fbufDimensions fb 220 | glClear $ gl_COLOR_BUFFER_BIT .|. gl_DEPTH_BUFFER_BIT 221 | renderPostPass fb (worldState world) shader 222 | renderAllPasses _ [] = return () 223 | 224 | renderPostPass :: Framebuffer -> WorldState -> GLuint -> IO () 225 | renderPostPass fb wState shader = do 226 | let quadVB = fbufVBO fb 227 | 228 | -- Activate the shader 229 | glUseProgram shader 230 | 231 | glActiveTexture gl_TEXTURE0 232 | glBindTexture gl_TEXTURE_2D $ fbufTexture fb 233 | texId <- withCString "renderedTexture" $ glGetUniformLocation shader 234 | glUniform1i texId 0 235 | 236 | let dayTime = stateTime wState 237 | 238 | setUniforms shader [("time", return [dayTime])] 239 | 240 | -- Enable the attribute buffer. 241 | glEnableVertexAttribArray 0 242 | -- Give OpenGL the information. 243 | glBindBuffer gl_ARRAY_BUFFER quadVB 244 | -- Tell OpenGL about the info. 245 | glVertexAttribPointer 0 3 gl_FLOAT 0 0 offset0 246 | 247 | glDrawArrays gl_TRIANGLES 0 6 248 | 249 | glDisableVertexAttribArray 0 250 | 251 | makeFrameBuffer :: (GLint, GLint) -> IO Framebuffer 252 | makeFrameBuffer (winW, winH) = do 253 | -- Create framebuffer and bind it. 254 | fbName <- alloca (\p -> glGenFramebuffers 1 p >> peek p) 255 | glBindFramebuffer gl_FRAMEBUFFER fbName 256 | 257 | -- Create a texture id. 258 | fbTexPtr <- new 0 259 | glGenTextures 1 fbTexPtr 260 | fbTex <- peek fbTexPtr 261 | glBindTexture gl_TEXTURE_2D fbTex 262 | 263 | -- Create an image. 264 | glTexImage2D gl_TEXTURE_2D 0 265 | (fromIntegral gl_RGB) 266 | winW winH 267 | 0 gl_RGB gl_UNSIGNED_BYTE offset0 268 | 269 | -- Give texture paramenters. 270 | glTexParameteri gl_TEXTURE_2D (fromIntegral gl_TEXTURE_MAG_FILTER) 271 | (fromIntegral gl_NEAREST) 272 | glTexParameteri gl_TEXTURE_2D (fromIntegral gl_TEXTURE_MIN_FILTER) 273 | (fromIntegral gl_NEAREST) 274 | glTexParameteri gl_TEXTURE_2D gl_TEXTURE_WRAP_S 275 | $ fromIntegral gl_CLAMP_TO_EDGE 276 | glTexParameteri gl_TEXTURE_2D gl_TEXTURE_WRAP_T 277 | $ fromIntegral gl_CLAMP_TO_EDGE 278 | 279 | depthRenderBuffer <- alloca (\p -> glGenRenderbuffers 1 p >> peek p) 280 | 281 | glBindRenderbuffer gl_RENDERBUFFER depthRenderBuffer 282 | 283 | glRenderbufferStorage gl_RENDERBUFFER gl_DEPTH_COMPONENT 284 | winW winH 285 | 286 | glFramebufferRenderbuffer gl_FRAMEBUFFER gl_DEPTH_ATTACHMENT 287 | gl_RENDERBUFFER depthRenderBuffer 288 | 289 | glFramebufferTexture gl_FRAMEBUFFER 290 | gl_COLOR_ATTACHMENT0 fbTex 0 291 | 292 | withArray [gl_COLOR_ATTACHMENT0] $ glDrawBuffers 1 293 | 294 | glCheckFramebufferStatus gl_FRAMEBUFFER >>= 295 | (\x -> putStrLn $ if x == gl_FRAMEBUFFER_COMPLETE 296 | then "Framebuffer successfully created" 297 | else "Framebuffer error") 298 | 299 | glBindFramebuffer gl_FRAMEBUFFER 0 300 | 301 | quadVB <- fillNewBuffer quadBufferData 302 | 303 | return $ Framebuffer fbName fbTex (winW, winH) 304 | quadVB depthRenderBuffer 305 | 306 | quadBufferData :: [GLfloat] 307 | quadBufferData = 308 | [-1.0, -1.0, 0.0, 309 | 1.0, -1.0, 0.0, 310 | -1.0, 1.0, 0.0, 311 | -1.0, 1.0, 0.0, 312 | 1.0, -1.0, 0.0, 313 | 1.0, 1.0, 0.0] 314 | {-# INLINE quadBufferData #-} 315 | -} 316 | -------------------------------------------------------------------------------- /src/Engine/Graphics/GraphicsUtils.hs: -------------------------------------------------------------------------------- 1 | module Engine.Graphics.GraphicsUtils ( 2 | createBufferIdAll, createBufferId, 3 | fillNewBuffer, withNewPtr, withNewPtrArray, 4 | useNewPtr, offsetPtr, offset0 5 | ) where 6 | 7 | import Foreign 8 | (Ptr, Storable, withArrayLen, sizeOf, 9 | alloca, peek, peekArray, wordPtrToPtr) 10 | 11 | import Graphics.Rendering.OpenGL.Raw 12 | (GLuint, GLfloat, glGenVertexArrays, 13 | glBindVertexArray, glGenBuffers, 14 | glBindBuffer, gl_ARRAY_BUFFER, 15 | glBufferData, gl_STATIC_DRAW) 16 | 17 | -- | Create an id for each buffer data. 18 | createBufferIdAll :: [[GLfloat]] -> IO [GLuint] 19 | createBufferIdAll (cur:others) = do 20 | currentId <- createBufferId cur 21 | otherId <- createBufferIdAll others 22 | return $ currentId:otherId 23 | createBufferIdAll [] = return [] 24 | 25 | -- | Create a buffer id for the information. 26 | createBufferId :: [GLfloat] -> IO GLuint 27 | createBufferId info = do 28 | vertexArrayId <- withNewPtr (glGenVertexArrays 1) 29 | glBindVertexArray vertexArrayId 30 | fillNewBuffer info 31 | 32 | -- | Fill buffer with data. 33 | fillNewBuffer :: [GLfloat] -> IO GLuint 34 | fillNewBuffer list = do 35 | bufId <- withNewPtr (glGenBuffers 1) 36 | glBindBuffer gl_ARRAY_BUFFER bufId 37 | withArrayLen list $ \len ptr -> 38 | glBufferData gl_ARRAY_BUFFER 39 | (fromIntegral (len * sizeOf (undefined :: GLfloat))) 40 | (ptr :: Ptr GLfloat) gl_STATIC_DRAW 41 | return bufId 42 | 43 | -- | Perform IO action with a new pointer, returning the 44 | -- value in the pointer. 45 | withNewPtr :: Storable b => (Ptr b -> IO a) -> IO b 46 | withNewPtr f = alloca (\p -> f p >> peek p) 47 | 48 | -- | Perform IO action with a new pointer array, returning the 49 | -- value in the pointer. 50 | withNewPtrArray :: Storable b => (Ptr b -> IO a) -> Int -> IO [b] 51 | withNewPtrArray f size = alloca (\p -> f p >> peekArray size p) 52 | 53 | -- | Perform IO action with a new pointer, returning the 54 | -- pointer itself. 55 | useNewPtr :: Storable a => (Ptr a -> IO a1) -> IO (Ptr a) 56 | useNewPtr f = alloca (\p -> f p >> return p) 57 | 58 | -- | Produce a 'Ptr' value to be used as an offset of the given number 59 | -- of bytes. 60 | offsetPtr :: Int -> Ptr a 61 | offsetPtr = wordPtrToPtr . fromIntegral 62 | 63 | -- | A zero-offset 'Ptr'. 64 | offset0 :: Ptr a 65 | offset0 = offsetPtr 0 66 | -------------------------------------------------------------------------------- /src/Engine/Graphics/NewGraphics.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses #-} 2 | module Engine.Graphics.NewGraphics ( 3 | RenderInfo(..), emptyInfo, Renderable(..), 4 | totalRender, renderToFramebuffer, renderAllToFramebuffer, 5 | renderWorldNewPost, renderWorldNew, withFramebuffer, 6 | screenFramebuffer, bindFramebuffer, unbindFrameBuffer 7 | ) where 8 | 9 | import Data.Bits ((.|.)) 10 | 11 | import Graphics.Rendering.OpenGL.Raw 12 | (GLint, glUseProgram, glDrawArrays, gl_TRIANGLES, 13 | glClear, gl_COLOR_BUFFER_BIT, gl_DEPTH_BUFFER_BIT, 14 | glBindFramebuffer, gl_FRAMEBUFFER) 15 | 16 | import Engine.Core.Types 17 | (World(..), WorldState(..), 18 | Entity(..), 19 | Graphics(..)) 20 | import Engine.Core.World (setWorldUniforms) 21 | import Engine.Graphics.Shaders 22 | (setShaderAttribs, disableShaderAttribs, 23 | bindTextures) 24 | import Engine.Object.GameObject (getModel) 25 | import Engine.Matrix.Matrix 26 | (WorldMatrices(..), emptyMatrices, 27 | setMatrixUniforms, calculateMatricesFromPlayer, 28 | calculateModelMatrix) 29 | import Engine.Graphics.Window (Window(..)) 30 | import Engine.Graphics.Shaders (Shader(..)) 31 | import Engine.Graphics.Framebuffer (Framebuffer(..)) 32 | import Engine.Graphics.Graphics (renderAllPasses) 33 | import Engine.Mesh.Mesh (Mesh(..)) 34 | 35 | -- | The data passed around through the stages of 36 | -- rendering. 37 | data RenderInfo = RenderInfo { 38 | renderInfoShader :: Shader, 39 | renderInfoMatrices :: WorldMatrices 40 | } deriving (Show, Eq) 41 | emptyInfo :: RenderInfo 42 | emptyInfo = RenderInfo (Shader (-1) []) emptyMatrices 43 | 44 | -- | A class for things that can be rendered to 45 | -- the screen &| Framebuffers. 46 | -- Contains 3 functions: 47 | -- 48 | -- * Bind: This is usually where 49 | -- shaders are set, or the currently 50 | -- bound shader is modified. 51 | -- * Draw: This is the draw action. A Framebuffer 52 | -- is bound before calling this, so there is 53 | -- no need to bind your own. 54 | -- * Cleanup: Any cleanup necessary. 55 | class Renderable t g where 56 | renderBind :: t -> g -> IO g 57 | renderBind _ = return 58 | renderDraw :: t -> g -> IO g 59 | renderDraw _ = return 60 | renderCleanup :: t -> g -> IO g 61 | renderCleanup _ = return 62 | defaultGlobal :: t -> g 63 | 64 | instance Renderable (Entity t) RenderInfo where 65 | renderBind obj info = 66 | let shader = meshShader $ getModel obj 67 | in do 68 | glUseProgram $ shaderId shader 69 | return info{renderInfoShader = shader} 70 | 71 | renderDraw object info = do 72 | let model = getModel object 73 | mShader = renderInfoShader info 74 | 75 | -- Move Object 76 | modelMat = calculateModelMatrix object 77 | 78 | newMatrices = (renderInfoMatrices info){matrixModel = modelMat} 79 | -- Set uniforms. (World uniforms and Matrices). 80 | newShader <- 81 | setMatrixUniforms mShader newMatrices 82 | 83 | -- Bind buffers to variable names in shader. 84 | setShaderAttribs $ meshShaderVars model 85 | bindTextures (meshTextures model) $ shaderId newShader 86 | 87 | glDrawArrays gl_TRIANGLES 0 (meshVertCount model) 88 | 89 | return $ RenderInfo newShader newMatrices 90 | 91 | renderCleanup object _ = do 92 | let model = getModel object 93 | -- Necessary? 94 | disableShaderAttribs $ meshShaderVars model 95 | -- Disable the object's shader. 96 | glUseProgram 0 97 | return emptyInfo 98 | defaultGlobal _ = emptyInfo 99 | 100 | {- 101 | instance Renderable Terrain RenderInfo where 102 | renderBind obj info = 103 | let shader = terrainShader obj 104 | in do 105 | glUseProgram $ shaderId shader 106 | return info{renderInfoShader = shader} 107 | 108 | renderDraw object info = do 109 | let mShader = renderInfoShader info 110 | 111 | -- Move Object 112 | modelMat = identity 113 | newMatrices = (renderInfoMatrices info){matrixModel = modelMat} 114 | 115 | -- Set uniforms. (World uniforms and Matrices). 116 | newShader <- 117 | setMatrixUniforms mShader newMatrices 118 | 119 | -- Bind buffers to variable names in shader. 120 | setShaderAttribs $ terrainShaderVars object 121 | bindTextures (terrainTextures object) $ shaderId newShader 122 | 123 | glDrawArrays gl_TRIANGLES 0 (terrainVertCount object) 124 | 125 | return $ RenderInfo newShader newMatrices 126 | 127 | renderCleanup object _ = do 128 | -- Necessary? 129 | disableShaderAttribs $ terrainShaderVars object 130 | -- Disable the object's shader. 131 | glUseProgram 0 132 | return emptyInfo 133 | defaultGlobal _ = emptyInfo 134 | -} 135 | 136 | 137 | instance Renderable (World t) RenderInfo where 138 | renderBind world info = do 139 | let (winW, winH) = windowSize $ stateWindow $ worldState world 140 | worldMats = calculateMatricesFromPlayer 141 | (worldPlayer world) 142 | (fromIntegral winW, fromIntegral winH) 143 | newShader <- 144 | setWorldUniforms world (renderInfoShader info) 145 | return info{renderInfoShader = newShader, 146 | renderInfoMatrices = worldMats} 147 | defaultGlobal _ = emptyInfo 148 | 149 | -- | Call all 3 stages of the "Renderable". 150 | totalRender :: Renderable t g => t -> g -> IO g 151 | totalRender r s = 152 | renderBind r s >>= 153 | renderDraw r >>= 154 | renderCleanup r 155 | 156 | -- | Call all 3 stages of the "Renderable" after 157 | -- binding the "Framebuffer". 158 | renderToFramebuffer :: Renderable t g => Framebuffer -> t -> IO g 159 | renderToFramebuffer fbuf rend = 160 | withFramebuffer fbuf $ totalRender rend (defaultGlobal rend) 161 | 162 | -- | Call all 3 stages of each "Renderable" 163 | -- after binding the "Framebuffer". 164 | renderAllToFramebuffer :: Renderable t g => Framebuffer -> [t] -> IO g 165 | renderAllToFramebuffer fbuf xs = 166 | withFramebuffer fbuf $ 167 | renderAll xs (defaultGlobal $ head xs) 168 | where 169 | renderAll :: Renderable t g => [t] -> g -> IO g 170 | renderAll (x:xs') info = 171 | totalRender x info >>= renderAll xs' 172 | renderAll [] info = return info 173 | 174 | -- | Call all 3 stages of each "Renderable" 175 | -- with the global renderable. 176 | renderAllWithGlobal :: (Renderable t1 g, Renderable t2 g) => 177 | Framebuffer -> t1 -> [t2] -> IO g 178 | renderAllWithGlobal fbuf g = 179 | renderAllWithGlobal' (defaultGlobal g) fbuf g 180 | 181 | renderAllWithGlobal' :: (Renderable t1 g, Renderable t2 g) => 182 | g -> Framebuffer -> t1 -> [t2] -> IO g 183 | renderAllWithGlobal' info fbuf global (x:xs) = do 184 | bindFramebuffer fbuf 185 | 186 | -- This order could be changed... 187 | newinfo <- 188 | renderBind x info >>= 189 | renderBind global >>= 190 | renderDraw global >>= 191 | renderDraw x >>= 192 | renderCleanup x >>= 193 | renderCleanup global 194 | 195 | unbindFrameBuffer 196 | 197 | renderAllWithGlobal' newinfo fbuf global xs 198 | renderAllWithGlobal' info _ _ _ = return info 199 | 200 | -- | Render World with new API. 201 | renderWorldNew :: World t -> IO (World t) 202 | renderWorldNew world = do 203 | glClear $ gl_COLOR_BUFFER_BIT .|. gl_DEPTH_BUFFER_BIT 204 | let (width, height) = windowSize $ stateWindow $ worldState world 205 | fbuf = screenFramebuffer (fromIntegral width, fromIntegral height) 206 | _ <- renderAllWithGlobal fbuf world (worldEntities world) :: IO RenderInfo 207 | 208 | return world 209 | 210 | -- | Render World with new API after binding 211 | -- the Framebuffer. 212 | renderWorldNewWithFramebuffer :: World t -> Framebuffer -> IO (World t) 213 | renderWorldNewWithFramebuffer world fbuf = do 214 | glClear $ gl_COLOR_BUFFER_BIT .|. gl_DEPTH_BUFFER_BIT 215 | _ <- renderAllWithGlobal fbuf world (worldEntities world) :: IO RenderInfo 216 | return world 217 | 218 | -- | Render world with all postprocessing shaders defined by 219 | -- worldFramebuffer. 220 | renderWorldNewPost :: World t -> IO (World t) 221 | renderWorldNewPost world = do 222 | let effects = snd $ graphicsPostProcessors $ worldGraphics world 223 | fb = fst $ graphicsPostProcessors $ worldGraphics world 224 | 225 | bindFramebuffer fb 226 | ret <- renderWorldNewWithFramebuffer world fb 227 | 228 | bindFramebuffer fb 229 | renderAllPasses ret effects 230 | return ret 231 | 232 | -- | An "Empty" Framebuffer, just renders 233 | -- to the screen. 234 | screenFramebuffer :: (GLint, GLint) -> Framebuffer 235 | screenFramebuffer dimensions = 236 | Framebuffer 0 0 dimensions 0 0 237 | 238 | -- | Perform action with Framebuffer binded. 239 | withFramebuffer :: Framebuffer -> IO a -> IO a 240 | withFramebuffer fbuf func = do 241 | bindFramebuffer fbuf 242 | ret <- func 243 | unbindFrameBuffer 244 | return ret 245 | 246 | bindFramebuffer :: Framebuffer -> IO () 247 | bindFramebuffer = glBindFramebuffer gl_FRAMEBUFFER . fbufName 248 | 249 | unbindFrameBuffer :: IO () 250 | unbindFrameBuffer = glBindFramebuffer gl_FRAMEBUFFER 0 251 | -------------------------------------------------------------------------------- /src/Engine/Graphics/Shaders.hs: -------------------------------------------------------------------------------- 1 | module Engine.Graphics.Shaders ( 2 | ShaderAttrib(..), ShaderUniform, Shader(..), 3 | createShaderAttribs, loadProgram, bindTextures, unBindTextures, 4 | setShaderAttribs, disableShaderAttribs, setUniforms, 5 | getMatrixFromGL, quickGetUniform, getAttrLocs, 6 | printMatrix, setUniform, setUniformAndRemember, 7 | setUniformsAndRemember, findUniformLocation, 8 | findMaybeUniformLocation, findUniformLocationAndRemember, 9 | loadShadersProgram, emptyShader, 10 | wrapShader, loadShaderCode 11 | ) where 12 | 13 | import Control.Monad (when) 14 | import Data.Maybe (fromJust, isJust) 15 | import Control.Applicative ((<$>)) 16 | import Foreign 17 | (with, nullPtr, Ptr, Storable, toBool, allocaArray0) 18 | import Foreign.C.String (withCString, peekCString) 19 | import Foreign.C.Types (CChar) 20 | 21 | import Graphics.Rendering.OpenGL.Raw 22 | 23 | import Engine.Graphics.GraphicsUtils 24 | (withNewPtr, withNewPtrArray, offset0) 25 | import Engine.Graphics.Textures (Texture) 26 | 27 | -- | An OpenGL program id and some uniform 28 | -- ids so that glUniform* doesn't have to be 29 | -- called more than once. 30 | data Shader = Shader { 31 | shaderId :: GLuint, 32 | shaderUniforms :: [(String, GLint)] 33 | } deriving (Show, Eq) 34 | 35 | -- | Attrib id, Buffer id, size of attrib. 36 | data ShaderAttrib = ShaderAttrib !GLuint !GLuint !GLuint 37 | deriving (Show, Eq) 38 | -- | Name, Values 39 | type ShaderUniform = (String, IO [GLfloat]) 40 | 41 | emptyShader :: Shader 42 | emptyShader = Shader (-1) [] 43 | {-# INLINE emptyShader #-} 44 | 45 | wrapShader :: GLuint -> Shader 46 | wrapShader program = Shader program [] 47 | {-# INLINE wrapShader #-} 48 | 49 | -- | Simply pack the arguments together into a list of 50 | -- ShaderAttribs. 51 | createShaderAttribs :: [GLuint] -> [GLuint] -> [GLuint] -> [ShaderAttrib] 52 | createShaderAttribs (attr:attrs) (buff:buffs) (size:sizes) = 53 | ShaderAttrib attr buff size : createShaderAttribs attrs buffs sizes 54 | createShaderAttribs [] [] [] = [] 55 | createShaderAttribs _ _ _ = 56 | error $ "Model.createShaderAttribs: " 57 | ++ "given lists are not the same length." 58 | 59 | -- | Loads a pair of vertex and fragment shaders 60 | -- given the two FilePaths. 61 | loadProgram :: FilePath -> FilePath -> IO GLuint 62 | loadProgram vertFP fragFP = 63 | loadShadersProgram 64 | [(gl_VERTEX_SHADER, vertFP), 65 | (gl_FRAGMENT_SHADER, fragFP)] 66 | 67 | -- | Loads a list of (shader type, shader files). 68 | loadShadersProgram :: [(GLuint, FilePath)] -> IO GLuint 69 | loadShadersProgram shaders = do 70 | shaderIds <- mapM (uncurry loadShader) shaders 71 | progId <- glCreateProgram 72 | mapM_ (glAttachShader progId) shaderIds 73 | glLinkProgram progId 74 | mapM_ glDeleteShader shaderIds 75 | return progId 76 | 77 | -- | Loads a single shader of given type, 78 | -- usually either gl_VERTEX_SHADER or 79 | -- gl_FRAGMENT_SHADER. 80 | -- Uses given FilePath as shader. 81 | loadShader :: GLenum -> FilePath -> IO GLuint 82 | loadShader shaderTypeFlag filePath = 83 | readFile filePath >>= loadShaderCode shaderTypeFlag 84 | 85 | 86 | loadShaderCode :: GLenum -> String -> IO GLuint 87 | loadShaderCode shaderTypeFlag code = do 88 | sid <- glCreateShader shaderTypeFlag 89 | withCString code $ \codePtr -> 90 | with codePtr $ \codePtrPtr -> 91 | glShaderSource sid 1 codePtrPtr nullPtr 92 | glCompileShader sid 93 | 94 | _ <- checkStatus gl_COMPILE_STATUS glGetShaderiv glGetShaderInfoLog sid 95 | 96 | return sid 97 | 98 | -- | Gets status from OpenGL. Supply flag to check, 99 | -- function to get status with, infoLog function, 100 | -- and shader id. 101 | checkStatus :: (Storable a1, Num a1, Eq a1, Ord a1, Integral a1) => 102 | GLenum -> 103 | (t -> GLenum -> Ptr a1 -> IO a) -> 104 | (t -> a1 -> Ptr a3 -> Ptr CChar -> IO a2) -> 105 | t -> 106 | IO Bool 107 | checkStatus statusFlag glGetFn glInfoLogFn idT = do 108 | let fetch info = withNewPtr (glGetFn idT info) 109 | status <- toBool <$> fetch statusFlag 110 | logLength <- fetch gl_INFO_LOG_LENGTH 111 | when (logLength > 0) $ 112 | allocaArray0 (fromIntegral logLength) $ \msgPtr -> do 113 | _ <- glInfoLogFn idT logLength nullPtr msgPtr 114 | peekCString msgPtr >>= 115 | if status 116 | then \t -> do 117 | putStr "Successfully loaded shader: " 118 | print t 119 | else \t -> do 120 | putStr "Error loading shader: " 121 | print t 122 | return status 123 | 124 | -- | Binds textures to prepare for being sent to the 125 | -- shader. Calls glBindTexture and sets the "textures[]" 126 | -- uniform in shader. 127 | bindTextures :: [Texture] -> GLuint -> IO () 128 | bindTextures textures shader = 129 | bindTexturesi shader textures 0 130 | 131 | where 132 | bindTexturesi :: GLuint -> [Texture] -> GLuint -> IO () 133 | bindTexturesi s ((tid, _):ts) i = do 134 | glActiveTexture $ gl_TEXTURE0 + i 135 | glBindTexture gl_TEXTURE_2D tid 136 | 137 | loc <- quickGetUniform s $ "textures[" ++ show i ++ "]" 138 | glUniform1i loc (fromIntegral i) 139 | bindTexturesi s ts (i+1) 140 | bindTexturesi _ [] _ = return () 141 | 142 | -- | Clear out active textures. Call after drawing? 143 | unBindTextures :: GLuint -> IO () 144 | unBindTextures = 145 | unBindTexturesi 0 146 | 147 | where 148 | unBindTexturesi :: GLuint -> GLuint -> IO () 149 | unBindTexturesi i amt = 150 | when (i < amt) $ do 151 | glActiveTexture $ gl_TEXTURE0 + fromIntegral i 152 | glBindTexture gl_TEXTURE_2D 0 153 | 154 | -- | Binds a list of ShaderAttribs. 155 | setShaderAttribs :: [ShaderAttrib] -> IO () 156 | setShaderAttribs (ShaderAttrib attr buf len : rest) = do 157 | -- Enable the attribute buffer. 158 | glEnableVertexAttribArray attr 159 | -- Give OpenGL the information. 160 | glBindBuffer gl_ARRAY_BUFFER buf 161 | -- Tell OpenGL about the info. 162 | glVertexAttribPointer attr (fromIntegral len) gl_FLOAT 0 0 offset0 163 | setShaderAttribs rest 164 | setShaderAttribs [] = return () 165 | 166 | -- | Disables a list of ShaderAttribs. Call after drawing? 167 | disableShaderAttribs :: [ShaderAttrib] -> IO () 168 | disableShaderAttribs (ShaderAttrib attr _ _ : rest) = do 169 | -- Disable the attribute buffer. 170 | glDisableVertexAttribArray attr 171 | disableShaderAttribs rest 172 | disableShaderAttribs [] = return () 173 | 174 | setUniformsAndRemember :: Shader -> [ShaderUniform] -> IO Shader 175 | setUniformsAndRemember shader ((name, valsIo):rest) = do 176 | vals <- valsIo 177 | let len = length vals 178 | let uniloc = findMaybeUniformLocation shader name 179 | loc <- maybe 180 | (withCString name $ glGetUniformLocation $ shaderId shader) 181 | return uniloc 182 | 183 | case len of 184 | 1 -> glUniform1f loc $ head vals 185 | 2 -> glUniform2f loc (head vals) $ vals !! 1 186 | 3 -> glUniform3f loc (head vals) (vals !! 1) (vals !! 2) 187 | 4 -> glUniform4f loc (head vals) (vals !! 1) (vals !! 2) (vals !! 3) 188 | _ -> putStrLn $ "Bad length value in ShaderUniform " 189 | ++ name ++ ": " ++ show len 190 | 191 | if isJust uniloc 192 | then 193 | let newShader = shader{shaderUniforms = 194 | (name, loc) : shaderUniforms shader} 195 | in setUniformsAndRemember newShader rest 196 | else setUniformsAndRemember shader rest 197 | setUniformsAndRemember shader _ = return shader 198 | 199 | setUniformAndRemember :: Shader -> ShaderUniform -> IO Shader 200 | setUniformAndRemember shader (name, valsIo) = do 201 | vals <- valsIo 202 | let len = length vals 203 | 204 | loc <- let uniloc = findMaybeUniformLocation shader name 205 | in maybe (withCString name $ glGetUniformLocation $ shaderId shader) 206 | return uniloc 207 | 208 | case len of 209 | 1 -> glUniform1f loc $ head vals 210 | 2 -> glUniform2f loc (head vals) $ vals !! 1 211 | 3 -> glUniform3f loc (head vals) (vals !! 1) (vals !! 2) 212 | 4 -> glUniform4f loc (head vals) (vals !! 1) (vals !! 2) (vals !! 3) 213 | _ -> putStrLn $ "Bad length value in ShaderUniform " 214 | ++ name ++ ": " ++ show len 215 | 216 | return $ shader{shaderUniforms = (name, loc) : shaderUniforms shader} 217 | 218 | findUniformLocationAndRemember :: Shader -> String -> IO (Shader, GLint) 219 | findUniformLocationAndRemember shader name = 220 | let found = findMaybeUniformLocation shader name 221 | in if isJust found 222 | then return (shader, fromJust found) 223 | else do 224 | loc <- quickGetUniform (shaderId shader) name 225 | return (shader{ 226 | shaderUniforms = 227 | (name, loc) : shaderUniforms shader 228 | }, loc) 229 | 230 | findUniformLocation :: Shader -> String -> IO GLint 231 | findUniformLocation shader name = 232 | let found = findMaybeUniformLocation shader name 233 | in maybe (quickGetUniform (shaderId shader) name) return found 234 | 235 | findMaybeUniformLocation :: Shader -> String -> Maybe GLint 236 | findMaybeUniformLocation shader = 237 | findUniformLocation' (shaderUniforms shader) 238 | where 239 | findUniformLocation' ((curName, curId):rest) searchName = 240 | if curName == searchName 241 | then Just curId 242 | else findUniformLocation' rest searchName 243 | findUniformLocation' _ _ = Nothing 244 | 245 | -- | Calls glUniformxf on all Uniforms, given the 246 | -- shader. 247 | setUniforms :: GLuint -> [ShaderUniform] -> IO () 248 | setUniforms = mapM_ . setUniform 249 | 250 | setUniform :: GLuint -> ShaderUniform -> IO () 251 | setUniform shader (name, valsIo) = do 252 | vals <- valsIo 253 | let len = length vals 254 | 255 | loc <- withCString name $ glGetUniformLocation shader 256 | 257 | case len of 258 | 1 -> glUniform1f loc $ head vals 259 | 2 -> glUniform2f loc (head vals) $ vals !! 1 260 | 3 -> glUniform3f loc (head vals) (vals !! 1) (vals !! 2) 261 | 4 -> glUniform4f loc (head vals) (vals !! 1) (vals !! 2) (vals !! 3) 262 | _ -> putStrLn $ "Bad length value in ShaderUniform " 263 | ++ name ++ ": " ++ show len 264 | 265 | -- | Retrieve location of each shader attrib 266 | -- in the given program. 267 | getAttrLocs :: GLuint -> [String] -> IO [GLuint] 268 | getAttrLocs prog (attrName:xs) = do 269 | curN <- withCString attrName $ glGetAttribLocation prog 270 | let cur = fromIntegral curN 271 | rest <- getAttrLocs prog xs 272 | return $ cur:rest 273 | getAttrLocs _ [] = return [] 274 | 275 | -- | Get a matrix from OpenGL. 276 | getMatrixFromGL :: GLenum -> IO [GLfloat] 277 | getMatrixFromGL mat = withNewPtrArray (glGetFloatv mat) 16 278 | 279 | printMatrix :: [GLfloat] -> IO () 280 | printMatrix (a:b:c:d:xs) = do 281 | print [a, b, c, d] 282 | printMatrix xs 283 | printMatrix _ = return () 284 | 285 | -- | Utility function to get a uniform location from a shader. 286 | quickGetUniform :: GLuint -> String -> IO GLint 287 | quickGetUniform shader name = 288 | withCString name $ glGetUniformLocation shader 289 | -------------------------------------------------------------------------------- /src/Engine/Graphics/Shadows.hs: -------------------------------------------------------------------------------- 1 | module Engine.Graphics.Shadows ( 2 | {- 3 | makeShadowFrameBuffer, renderWorldWithShadows, 4 | setMatrixUniformsBias 5 | -} 6 | ) where 7 | 8 | {- 9 | import Data.Bits ((.|.)) 10 | import Data.Vec 11 | 12 | import Graphics.Rendering.OpenGL.Raw 13 | import Foreign (alloca, peek, withArray) 14 | 15 | import Engine.Core.Types 16 | (World(..), 17 | Graphics(..), WorldState(..), 18 | Entity(..)) 19 | import Engine.Matrix.Matrix 20 | (WorldMatrices(..), 21 | calculateMatricesFromPlayer, 22 | toGLFormat) 23 | import Engine.Object.GameObject (getModel) 24 | import Engine.Core.HasPosition (getPos) 25 | import Engine.Core.World (setWorldUniforms) 26 | import Engine.Graphics.Shaders 27 | (Shader(..), quickGetUniform, 28 | bindTextures, setShaderAttribs, 29 | findUniformLocationAndRemember) 30 | import Engine.Graphics.Graphics 31 | (renderAllPasses) 32 | import Engine.Graphics.GraphicsUtils (offset0) 33 | import Engine.Graphics.Window (Window(..)) 34 | import Engine.Graphics.Framebuffer (Framebuffer(..)) 35 | import Engine.Mesh.Mesh (Mesh(..)) 36 | 37 | -- | Create a Framebuffer. 38 | makeShadowFrameBuffer :: (GLint, GLint) -> IO Framebuffer 39 | makeShadowFrameBuffer (width, height) = do 40 | fbName <- alloca (\p -> glGenFramebuffers 1 p >> peek p) 41 | glBindFramebuffer gl_FRAMEBUFFER fbName 42 | 43 | depthTexture <- alloca (\p -> glGenTextures 1 p >> peek p) 44 | glBindTexture gl_TEXTURE_2D depthTexture 45 | 46 | glTexImage2D gl_TEXTURE_2D 0 47 | (fromIntegral gl_DEPTH_COMPONENT16) 48 | width height 49 | 0 gl_DEPTH_COMPONENT gl_FLOAT offset0 50 | 51 | -- Give texture paramenters. 52 | glTexParameteri gl_TEXTURE_2D (fromIntegral gl_TEXTURE_MAG_FILTER) 53 | (fromIntegral gl_LINEAR) 54 | glTexParameteri gl_TEXTURE_2D (fromIntegral gl_TEXTURE_MIN_FILTER) 55 | (fromIntegral gl_LINEAR) 56 | glTexParameteri gl_TEXTURE_2D gl_TEXTURE_WRAP_S 57 | $ fromIntegral gl_CLAMP_TO_EDGE 58 | glTexParameteri gl_TEXTURE_2D gl_TEXTURE_WRAP_T 59 | $ fromIntegral gl_CLAMP_TO_EDGE 60 | glTexParameteri gl_TEXTURE_2D gl_TEXTURE_COMPARE_FUNC 61 | $ fromIntegral gl_LEQUAL 62 | glTexParameteri gl_TEXTURE_2D gl_TEXTURE_COMPARE_MODE 63 | $ fromIntegral gl_COMPARE_R_TO_TEXTURE 64 | 65 | glFramebufferTexture gl_FRAMEBUFFER gl_DEPTH_ATTACHMENT depthTexture 0 66 | 67 | glDrawBuffer gl_NONE 68 | 69 | glCheckFramebufferStatus gl_FRAMEBUFFER >>= 70 | (\x -> putStrLn $ if x == gl_FRAMEBUFFER_COMPLETE 71 | then "Framebuffer successfully created" 72 | else "Framebuffer error") 73 | 74 | return $ Framebuffer fbName depthTexture 75 | (width, height) 76 | (-1) 77 | (-1) 78 | 79 | -- | Render the world, with shadows! 80 | renderWorldWithShadows :: World t -> IO (World t) 81 | renderWorldWithShadows world = do 82 | let fbuf = fst $ graphicsShadowInfo $ worldGraphics world 83 | depthShader = snd $ graphicsShadowInfo $ worldGraphics world 84 | (w, h) = fbufDimensions fbuf 85 | glBindFramebuffer gl_FRAMEBUFFER $ fbufName fbuf 86 | glViewport 0 0 w h 87 | 88 | glEnable gl_CULL_FACE 89 | glCullFace gl_FRONT 90 | 91 | glClear $ gl_COLOR_BUFFER_BIT .|. gl_DEPTH_BUFFER_BIT 92 | 93 | glUseProgram depthShader 94 | 95 | let lightInvDir = 0.5 :. 2.0 :. 2.0 :. () 96 | -- XXX: idk if this is correct. 97 | depthProjMat = orthogonal (-50) 100 (50 :. 50 :. ()) 98 | --depthProjMat = gorthoMatrix (-50) 50 (-50) 50 (-50) 100 99 | depthViewMat = rotationLookAt (0 :. 1 :. 0 :. ()) (0 :. 0 :. 0 :. ()) lightInvDir 100 | depthModelMat = identity 101 | 102 | worldMats = 103 | WorldMatrices depthModelMat depthViewMat depthProjMat 104 | 105 | mvpMatrix <- quickGetUniform depthShader "mvpMatrix" 106 | 107 | let depthMVP = depthProjMat `multmm` depthViewMat `multmm` depthModelMat 108 | 109 | renderInitialShadows (worldEntities world) 110 | worldMats 111 | mvpMatrix 112 | 113 | let win = stateWindow $ worldState world 114 | (width, height) = windowSize win 115 | 116 | glBindFramebuffer gl_FRAMEBUFFER 117 | (fbufName . fst . graphicsPostProcessors . worldGraphics $ world) 118 | glViewport 0 0 (fromIntegral width) (fromIntegral height) 119 | 120 | glEnable gl_CULL_FACE 121 | glCullFace gl_BACK 122 | 123 | glClear $ gl_COLOR_BUFFER_BIT .|. gl_DEPTH_BUFFER_BIT 124 | 125 | renderObjectsWithShadows world 126 | (calculateMatricesFromPlayer (worldPlayer world) (fromIntegral width, fromIntegral height)) 127 | depthMVP 128 | fbuf 129 | (worldEntities world) 130 | 131 | let newDepthUniform = ("depthTexture", return [20]) 132 | newWorldUniforms = newDepthUniform : 133 | graphicsUniforms (worldGraphics world) 134 | 135 | newWorldGraphics = (worldGraphics world){ 136 | graphicsUniforms = newWorldUniforms} 137 | renderAllPasses world{worldGraphics = newWorldGraphics} 138 | (snd $ graphicsPostProcessors $ worldGraphics world) 139 | 140 | return world 141 | 142 | renderObjectsWithShadows :: 143 | World t -> WorldMatrices -> Mat44 GLfloat -> 144 | Framebuffer -> [Entity t] -> IO () 145 | renderObjectsWithShadows world wm depthMVP fbuf (cur : rest) = do 146 | let curModel = getModel cur 147 | mShader = meshShader curModel 148 | modelMat = translation $ getPos cur 149 | glUseProgram $ shaderId mShader 150 | 151 | _ <- setMatrixUniformsBias mShader wm{matrixModel = modelMat} depthMVP 152 | 153 | _ <- setWorldUniforms world mShader 154 | 155 | bindTextures (meshTextures curModel) $ shaderId mShader 156 | 157 | let textureOffset = 20 158 | glActiveTexture $ gl_TEXTURE0 + textureOffset 159 | glBindTexture gl_TEXTURE_2D $ fbufTexture fbuf 160 | quickGetUniform (shaderId mShader) "shadowMap" >>= 161 | (`glUniform1i` fromIntegral textureOffset) 162 | 163 | setShaderAttribs $ meshShaderVars curModel 164 | glDrawArrays gl_TRIANGLES 0 (meshVertCount curModel) 165 | 166 | renderObjectsWithShadows world wm depthMVP fbuf rest 167 | renderObjectsWithShadows _ _ _ _ _ = return () 168 | 169 | renderInitialShadows :: [Entity t] -> WorldMatrices -> GLint -> IO () 170 | renderInitialShadows (cur : rest) wm mvpUniform = do 171 | setShaderAttribs $ meshShaderVars $ getModel cur 172 | 173 | let modelMat = translation $ getPos cur 174 | 175 | mvp = matrixProjection wm `multmm` matrixView wm `multmm` modelMat 176 | 177 | withArray 178 | (toGLFormat mvp) 179 | $ glUniformMatrix4fv mvpUniform 1 (fromIntegral gl_FALSE) 180 | 181 | glDrawArrays gl_TRIANGLES 0 182 | (meshVertCount $ getModel cur) 183 | glDisableVertexAttribArray 0 184 | renderInitialShadows rest wm mvpUniform 185 | renderInitialShadows _ _ _ = return () 186 | 187 | -- TODO: Make this function cause the shader to remember 188 | -- uniform locations. 189 | setMatrixUniformsBias :: Shader -> WorldMatrices -> Mat44 GLfloat -> IO Shader 190 | setMatrixUniformsBias shader wm depthMVP = do 191 | (shader', modelMatrix) <- findUniformLocationAndRemember shader "modelMatrix" 192 | withArray (toGLFormat $ matrixModel wm) 193 | $ glUniformMatrix4fv modelMatrix 1 (fromIntegral gl_FALSE) 194 | 195 | (shader'', projectionMatrix) <- findUniformLocationAndRemember shader' 196 | "projectionMatrix" 197 | withArray (toGLFormat $ matrixProjection wm) 198 | $ glUniformMatrix4fv projectionMatrix 1 (fromIntegral gl_FALSE) 199 | 200 | (shader''', viewMatrix) <- findUniformLocationAndRemember 201 | shader'' "viewMatrix" 202 | withArray (toGLFormat $ matrixView wm) 203 | $ glUniformMatrix4fv viewMatrix 1 (fromIntegral gl_FALSE) 204 | 205 | (shader'''', mvpMatrix) <- findUniformLocationAndRemember 206 | shader''' "mvpMatrix" 207 | withArray 208 | (toGLFormat $ matrixProjection wm `multmm` matrixView wm `multmm` matrixModel wm) 209 | $ glUniformMatrix4fv mvpMatrix 1 (fromIntegral gl_FALSE) 210 | 211 | let biasMatrix = matFromLists 212 | [[0.5, 0.0, 0.0, 0.0], 213 | [0.0, 0.5, 0.0, 0.0], 214 | [0.0, 0.0, 0.5, 0.0], 215 | [0.5, 0.5, 0.5, 1.0]] :: Mat44 GLfloat 216 | 217 | (shader''''', mvpBiasMatrix) <- findUniformLocationAndRemember 218 | shader'''' "mvpBiasMatrix" 219 | withArray 220 | (toGLFormat $ biasMatrix `multmm` depthMVP) 221 | $ glUniformMatrix4fv mvpBiasMatrix 1 (fromIntegral gl_FALSE) 222 | 223 | return shader''''' 224 | -} 225 | -------------------------------------------------------------------------------- /src/Engine/Graphics/Textures.hs: -------------------------------------------------------------------------------- 1 | module Engine.Graphics.Textures ( 2 | Image(..), Texture, 3 | juicyLoadImageRaw, juicyLoadTexture 4 | ) where 5 | 6 | import Foreign (Ptr, Word8, alloca, peek) 7 | import qualified Data.Vector.Storable as V 8 | 9 | import qualified Codec.Picture as Juicy 10 | import qualified Codec.Picture.Types as JTypes 11 | 12 | import Graphics.Rendering.OpenGL.Raw 13 | (GLuint, GLint, 14 | glTexParameteri, gl_TEXTURE_2D, 15 | gl_TEXTURE_MIN_FILTER, gl_NEAREST, 16 | gl_TEXTURE_MAG_FILTER, 17 | glBindTexture, glGenTextures, 18 | glTexImage2D, gl_RGB, gl_UNSIGNED_BYTE) 19 | 20 | --import Engine.Core.Types (Image(..)) 21 | 22 | data Image = Image (GLint, GLint) (Ptr Word8) 23 | deriving (Show) 24 | 25 | type Texture = (GLuint, GLint) 26 | 27 | -- | Load an image and turn it into something OpenGL can use. 28 | juicyLoadTexture :: FilePath -> IO GLuint 29 | juicyLoadTexture file = do 30 | (Image (w, h) pd) <- juicyLoadImageRaw file 31 | texName <- alloca $ \buf -> do 32 | glGenTextures 1 buf 33 | peek buf 34 | 35 | glBindTexture gl_TEXTURE_2D texName 36 | 37 | glTexParameteri gl_TEXTURE_2D 38 | gl_TEXTURE_MIN_FILTER (fromIntegral gl_NEAREST) 39 | glTexParameteri gl_TEXTURE_2D 40 | gl_TEXTURE_MAG_FILTER (fromIntegral gl_NEAREST) 41 | 42 | glTexImage2D gl_TEXTURE_2D 0 (fromIntegral gl_RGB) 43 | w h 0 (fromIntegral gl_RGB) gl_UNSIGNED_BYTE pd 44 | 45 | return texName 46 | 47 | -- TODO: add support for all (most) colorspaces / formats. 48 | juicyLoadImageRaw :: FilePath -> IO Image 49 | juicyLoadImageRaw file = do 50 | image <- Juicy.readImage file 51 | 52 | case image of 53 | Left err -> error err 54 | 55 | Right (Juicy.ImageRGB8 (Juicy.Image w h dat)) -> 56 | V.unsafeWith dat $ \ptr -> 57 | return $ Image (fromIntegral w, fromIntegral h) ptr 58 | Right (Juicy.ImageYCbCr8 img) -> 59 | let (Juicy.Image w h dat) = 60 | JTypes.convertImage img :: Juicy.Image Juicy.PixelRGB8 61 | in V.unsafeWith dat $ \ptr -> 62 | return $ Image (fromIntegral w, fromIntegral h) ptr 63 | Right (Juicy.ImageCMYK8 img) -> 64 | let (Juicy.Image w h dat) = 65 | JTypes.convertImage img :: Juicy.Image Juicy.PixelRGB8 66 | in V.unsafeWith dat $ \ptr -> 67 | return $ Image (fromIntegral w, fromIntegral h) ptr 68 | _ -> error $ 69 | "Engine.Graphics.Texture.juicyLoadImage:" 70 | ++ "bad image colorspace or format." 71 | -------------------------------------------------------------------------------- /src/Engine/Graphics/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses #-} 2 | module Engine.Graphics.Types where 3 | 4 | import Graphics.Rendering.OpenGL.Raw 5 | (GLfloat, GLuint, GLint) 6 | 7 | import Foreign (Ptr, Word8) 8 | 9 | import Engine.Core.Vec 10 | import Engine.Matrix.Types 11 | 12 | -- | The type used to contain global values relating to 13 | -- graphics / shaders. 14 | data Graphics t = Graphics { 15 | graphicsUniforms :: [ShaderUniform], 16 | graphicsPostProcessors :: (Framebuffer, [GLuint]), 17 | graphicsShadowInfo :: (Framebuffer, GLuint) 18 | } 19 | 20 | emptyGraphics :: Graphics t 21 | emptyGraphics = Graphics [] (undefined, []) (undefined, 0) 22 | 23 | data RenderInfo = RenderInfo { 24 | renderInfoShader :: Shader, 25 | renderInfoMatrices :: WorldMatrices 26 | } deriving (Show) 27 | 28 | emptyInfo :: RenderInfo 29 | emptyInfo = RenderInfo emptyShader emptyMatrices 30 | 31 | 32 | -- | All OpenGL handles for a Framebuffer and 33 | -- Renderbuffer. 34 | data Framebuffer = FB { 35 | fbufName :: GLuint, 36 | fbufTexture :: GLuint, 37 | fbufDimensions :: (GLint, GLint), 38 | fbufVBO :: GLuint, 39 | fbufRenderBuffer :: GLuint 40 | } deriving (Show) 41 | 42 | -- | An OpenGL program id and some uniform 43 | -- ids so that glUniform* doesn't have to be 44 | -- called more than once. 45 | data Shader = Shader { 46 | shaderId :: GLuint, 47 | shaderUniforms :: [(String, GLint)] 48 | } deriving (Show) 49 | 50 | emptyShader :: Shader 51 | emptyShader = Shader (-1) [] 52 | 53 | -- | Attrib id, Buffer id, size of attrib. 54 | type ShaderAttrib = Vec3 GLuint 55 | 56 | -- | Name, Values 57 | type ShaderUniform = (String, IO [GLfloat]) 58 | 59 | data Image = Image (GLint, GLint) (Ptr Word8) 60 | deriving (Show) 61 | 62 | type Texture = (GLuint, GLint) 63 | 64 | class Renderable t g where 65 | renderBind :: t -> g -> IO g 66 | renderBind _ = return 67 | renderDraw :: t -> g -> IO g 68 | renderDraw _ = return 69 | renderCleanup :: t -> g -> IO g 70 | renderCleanup _ = return 71 | defaultGlobal :: t -> g 72 | -------------------------------------------------------------------------------- /src/Engine/Graphics/Window.hs: -------------------------------------------------------------------------------- 1 | module Engine.Graphics.Window ( 2 | defaultWindow, Window(..), 3 | openWindow, shutdown 4 | ) where 5 | 6 | import Data.Default 7 | import System.Exit (exitSuccess) 8 | 9 | import qualified Graphics.UI.GLFW as GLFW 10 | import Graphics.Rendering.OpenGL.Raw (GLint) 11 | 12 | data Window = Window { 13 | windowHints :: [GLFW.WindowHint], 14 | windowTitle :: String, 15 | windowSize :: (GLint, GLint), 16 | windowInner :: Maybe GLFW.Window 17 | } deriving (Show) 18 | 19 | instance Default Window where 20 | def = defaultWindow 21 | 22 | defaultWindow :: Window 23 | defaultWindow = 24 | Window 25 | [GLFW.WindowHint'RefreshRate 60, 26 | GLFW.WindowHint'Samples 4] 27 | "GLFW Window" 28 | (800, 600) 29 | Nothing 30 | 31 | openWindow :: Window -> IO Window 32 | openWindow window = do 33 | let (w, h) = windowSize window 34 | 35 | _ <- GLFW.init 36 | 37 | -- Apply window hints. 38 | mapM_ GLFW.windowHint $ windowHints window 39 | 40 | Just win <- GLFW.createWindow 41 | (fromIntegral w) 42 | (fromIntegral h) 43 | (windowTitle window) Nothing Nothing 44 | GLFW.setWindowPos win 100 50 45 | GLFW.makeContextCurrent (Just win) 46 | 47 | -- Enable VSync 48 | GLFW.swapInterval 1 49 | 50 | return $ window{windowInner = Just win} 51 | 52 | shutdown :: GLFW.WindowCloseCallback 53 | shutdown win = do 54 | GLFW.destroyWindow win 55 | GLFW.terminate 56 | _ <- exitSuccess 57 | return () 58 | -------------------------------------------------------------------------------- /src/Engine/Matrix/Matrix.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NoMonomorphismRestriction #-} 2 | module Engine.Matrix.Matrix where 3 | 4 | import Data.Vec 5 | 6 | import Foreign.Marshal.Array (withArray) 7 | import Graphics.Rendering.OpenGL.Raw 8 | (GLfloat, glUniformMatrix4fv, gl_FALSE) 9 | 10 | import Engine.Core.Types (Player(..)) 11 | import Engine.Core.HasPosition (HasPosition(..), HasRotation(..)) 12 | import Engine.Graphics.Shaders (Shader, findUniformLocationAndRemember) 13 | 14 | data WorldMatrices = WorldMatrices { 15 | matrixModel :: Mat44 GLfloat, 16 | matrixView :: Mat44 GLfloat, 17 | matrixProjection :: Mat44 GLfloat 18 | } deriving (Show, Eq) 19 | emptyMatrices :: WorldMatrices 20 | emptyMatrices = WorldMatrices 1 1 1 21 | 22 | -- | Pass matrices to OpenGL shader. 23 | setMatrixUniforms :: Shader -> WorldMatrices -> IO Shader 24 | setMatrixUniforms shader wm = do 25 | -- Set model matrix. 26 | (shader', modelMatrix) <- findUniformLocationAndRemember shader "modelMatrix" 27 | withArray (toGLFormat $ matrixModel wm) 28 | $ glUniformMatrix4fv modelMatrix 1 (fromIntegral gl_FALSE) 29 | 30 | -- Set projection matrix. 31 | (shader'', projectionMatrix) <- findUniformLocationAndRemember shader' 32 | "projectionMatrix" 33 | withArray (toGLFormat $ matrixProjection wm) 34 | $ glUniformMatrix4fv projectionMatrix 1 (fromIntegral gl_FALSE) 35 | 36 | -- Set view matrix. 37 | (shader''', viewMatrix) <- findUniformLocationAndRemember shader'' "viewMatrix" 38 | withArray (toGLFormat $ matrixView wm) 39 | $ glUniformMatrix4fv viewMatrix 1 (fromIntegral gl_FALSE) 40 | 41 | -- Set mvp matrix. 42 | (shader'''', mvpMatrix) <- findUniformLocationAndRemember shader''' "mvpMatrix" 43 | withArray 44 | (toGLFormat $ matrixProjection wm `multmm` matrixView wm `multmm` matrixModel wm) 45 | $ glUniformMatrix4fv mvpMatrix 1 (fromIntegral gl_FALSE) 46 | 47 | return shader'''' 48 | 49 | -- | Calculate the "WorldMatrices" from Player 50 | -- and dimensions of the window. 51 | calculateMatricesFromPlayer :: Player a -> (Int, Int) -> WorldMatrices 52 | calculateMatricesFromPlayer p (width, height) = 53 | let px :. py :. pz :. () = playerPosition p 54 | rx :. ry :. rz :. () = playerRotation p 55 | -- Calculate projection matrix. 56 | projMat = perspective 0.1 100 45 (fromIntegral width / fromIntegral height) 57 | -- Calculate view matrix. 58 | rotatedX = rotationX $ -radians rx 59 | rotatedY = rotationY $ -radians ry 60 | rotatedZ = rotationZ $ -radians rz 61 | rotatedMat = rotatedX `multmm` rotatedY `multmm` rotatedZ 62 | viewMat = rotatedMat `multmm` translation ((-px) :. (-py) :. (-pz) :. ()) 63 | -- Model matrix is identity. 64 | modelMat = identity 65 | in WorldMatrices modelMat viewMat projMat 66 | where 67 | radians = (*(pi/180)) 68 | 69 | -- | Calculate the model matrix of something 70 | -- with position and rotation. 71 | calculateModelMatrix :: (HasPosition a, HasRotation a) => a -> Mat44 GLfloat 72 | calculateModelMatrix object = 73 | let rx :. ry :. rz :. () = getRot object 74 | x :. y :. z :. () = getPos object 75 | in translate (x :. y :. z :. ()) $ rotationEuler (rx :. ry :. rz :. ()) 76 | 77 | -- | Translate from Vec's format (row-major) to 78 | -- OpenGL format (column-major). 79 | toGLFormat :: Mat44 GLfloat -> [GLfloat] 80 | toGLFormat = toRowMajor . matToLists 81 | where 82 | toRowMajor [(a:as), (b:bs), (c:cs), (d:ds)] = 83 | a : b : c : d : toRowMajor [as, bs, cs, ds] 84 | toRowMajor [[],[],[],[]] = [] 85 | toRowMajor _ = error "Engine.Matrix.NewMatrix.toGLFormat" 86 | -------------------------------------------------------------------------------- /src/Engine/Matrix/NewMatrix.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE NoMonomorphismRestriction #-} 3 | {-# LANGUAGE TypeOperators #-} 4 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 5 | {-# LANGUAGE FlexibleInstances #-} 6 | {-# LANGUAGE FlexibleContexts #-} 7 | {-# LANGUAGE MultiParamTypeClasses #-} 8 | module Engine.Matrix.NewMatrix where 9 | 10 | import Foreign.Storable (Storable(..)) 11 | import qualified Data.Vector.Storable as V 12 | 13 | import GHC.TypeLits 14 | import Numeric.LinearAlgebra.Static 15 | 16 | newtype Matrix w h t = Matrix (L w h) 17 | deriving (Num, Fractional, Floating) 18 | 19 | newtype Vector l t = Vector (R l) 20 | deriving (Num, Fractional, Floating) 21 | 22 | 23 | instance (Sized t (R l) V.Vector) => Sized t (Vector l t) V.Vector where 24 | konst = Vector . konst 25 | unwrap (Vector r) = unwrap r 26 | 27 | (<&>) :: (KnownNat w1, KnownNat w2, KnownNat h) => 28 | Matrix w1 h t -> Matrix w2 h t -> Matrix (w1+w2) h t 29 | (<&>) (Matrix l1) (Matrix l2) = Matrix $ l1 —— l2 30 | -------------------------------------------------------------------------------- /src/Engine/Mesh/AABB.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverlappingInstances #-} 4 | module Engine.Mesh.AABB ( 5 | AABB(..), HasAABB(..), 6 | AABBSet(..), 7 | aabbFromPoints, aabbByFace, 8 | objectsIntersectInclusive, 9 | intersectingInclusive, 10 | anyIntersectInclusive 11 | ) where 12 | 13 | import Data.Maybe (isJust, fromJust) 14 | import Data.Vec ((:.)(..), Vec3) 15 | import Graphics.Rendering.OpenGL.Raw (GLfloat) 16 | 17 | import Engine.Core.HasPosition (HasPosition(..)) 18 | 19 | -- | AABB (min corner) (max corner) 20 | data AABB = AABB (Vec3 GLfloat) (Vec3 GLfloat) deriving (Show, Eq) 21 | 22 | -- | Data type for holding a single (optional) 23 | -- surrounding AABB, and a list of specific 24 | -- AABBs. 25 | data AABBSet = AABBSet { 26 | aabbSetWhole :: (Maybe AABB), 27 | aabbSetAll :: [AABB] 28 | } deriving (Show, Eq) 29 | 30 | -- | A class for types that have an 31 | -- Axis-Aligned Bounding Box (AABB). Type must 32 | -- also have a position for this to make sense. 33 | class HasPosition a => HasAABB a where 34 | getAABBs :: a -> [AABB] 35 | transformedAABBs :: a -> [AABB] 36 | getWholeAABB :: a -> Maybe AABB 37 | transformedWholeAABB :: a -> Maybe AABB 38 | {-# MINIMAL getAABBs, transformedAABBs, 39 | getWholeAABB, transformedWholeAABB #-} 40 | 41 | instance HasPosition AABB where 42 | getPos (AABB minV _) = minV 43 | setPos (AABB minV maxV) pos = 44 | AABB pos ((maxV - minV) + pos) 45 | 46 | instance HasAABB AABB where 47 | getWholeAABB (AABB low high) = Just (AABB 0 (high - low)) 48 | getAABBs (AABB low high) = [AABB 0 (high - low)] 49 | transformedAABBs aabb = [aabb] 50 | transformedWholeAABB = Just 51 | 52 | instance HasPosition AABBSet where 53 | getPos _ = 0 :. 0 :. 0 :. () 54 | setPos = const 55 | 56 | instance HasAABB AABBSet where 57 | getWholeAABB (AABBSet whole _) = whole 58 | getAABBs (AABBSet _ aabbs) = aabbs 59 | transformedAABBs (AABBSet _ aabbs) = 60 | concatMap transformedAABBs aabbs 61 | transformedWholeAABB (AABBSet whole _) 62 | | isJust whole = 63 | transformedWholeAABB $ fromJust whole 64 | | otherwise = Nothing 65 | 66 | -- | Calculate an AABB for all the points. 67 | aabbFromPoints :: [GLfloat] -> AABB 68 | aabbFromPoints points@(x:y:z:_) = 69 | aabbFromPointsAccum points (x :. y :. z :. ()) (x :. y :. z :. ()) 70 | aabbFromPoints _ = 71 | error "AABB.aabbFromPoints: given list is too short." 72 | 73 | -- | Called by aabbFromPoints. 74 | aabbFromPointsAccum :: [GLfloat] -> (Vec3 GLfloat) -> (Vec3 GLfloat) -> AABB 75 | aabbFromPointsAccum (x:y:z:rest) (miX :. miY :. miZ :. ()) 76 | (maX :. maY :. maZ :. ()) = 77 | aabbFromPointsAccum rest 78 | (min miX x :. min miY y :. min miZ z :. ()) 79 | (max maX x :. max maY y :. max maZ z :. ()) 80 | aabbFromPointsAccum _ abMin abMax = AABB abMin abMax 81 | 82 | -- | Calculate an AABB for each triangulated 83 | -- face. 84 | aabbByFace :: [GLfloat] -> [AABB] 85 | aabbByFace (x1:y1:z1:x2:y2:z2:x3:y3:z3:rest) = 86 | let minVec = min3 x1 x2 x3 :. min3 y1 y2 y3 :. min3 z1 z2 z3 :. () 87 | maxVec = max3 x1 x2 x3 :. max3 y1 y2 y3 :. max3 z1 z2 z3 :. () 88 | in AABB minVec maxVec : aabbByFace rest 89 | aabbByFace [] = [] 90 | aabbByFace _ = 91 | error "AABB.aabbByFace: given list is not formatted properly." 92 | 93 | min3 :: Ord a => a -> a -> a -> a 94 | min3 a b c = min c $ min a b 95 | {-# INLINE min3 #-} 96 | 97 | max3 :: Ord a => a -> a -> a -> a 98 | max3 a b c = max c $ max a b 99 | {-# INLINE max3 #-} 100 | 101 | -- = Inclusive "AABB" collision detection. 102 | 103 | -- | Test if two objects intersect. 104 | objectsIntersectInclusive :: (HasAABB a, HasAABB b) => a -> b -> Bool 105 | objectsIntersectInclusive l r 106 | | isJust (getWholeAABB l) && 107 | isJust (getWholeAABB r) = 108 | let Just wholeabl = transformedWholeAABB l 109 | Just wholeabr = transformedWholeAABB r 110 | in intersectingInclusive wholeabl wholeabr && 111 | (null (getAABBs l) && (not . null) (getAABBs r) || 112 | let newl = transformedAABBs l 113 | newr = transformedAABBs r 114 | in anyIntersectInclusive (head newl) newr) 115 | | otherwise = 116 | null (getAABBs l) && (not . null) (getAABBs r) || 117 | let newl = transformedAABBs l 118 | newr = transformedAABBs r 119 | in anyIntersectInclusive (head newl) newr 120 | 121 | intersectingInclusive :: AABB -> AABB -> Bool 122 | intersectingInclusive 123 | (AABB (min1x :. min1y :. min1z :. ()) 124 | (max1x :. max1y :. max1z :. ())) 125 | (AABB (min2x :. min2y :. min2z :. ()) 126 | (max2x :. max2y :. max2z :. ())) = 127 | max1x >= min2x && 128 | min1x <= max2x && 129 | max1y >= min2y && 130 | min1y <= max2y && 131 | max1z >= min2z && 132 | min1z <= max2z 133 | {-# INLINE intersectingInclusive #-} 134 | 135 | anyIntersectInclusive :: AABB -> [AABB] -> Bool 136 | anyIntersectInclusive l (r:rs) = 137 | intersectingInclusive l r || anyIntersectInclusive l rs 138 | anyIntersectInclusive _ _ = False 139 | -------------------------------------------------------------------------------- /src/Engine/Mesh/DatLoader.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Engine.Mesh.DatLoader ( 3 | writeDataToFile, loadData, 4 | loadDatModel, loadDatModelKeepVerts 5 | ) where 6 | 7 | import Debug.Trace (trace) 8 | import Control.Applicative ((<$>)) 9 | import Control.Monad (forM) 10 | import Data.List (intercalate) 11 | import Data.List.Split (splitOn) 12 | 13 | import Unsafe.Coerce (unsafeCoerce) 14 | 15 | import Data.Binary 16 | import Data.Binary.Put 17 | import Data.Binary.Get 18 | 19 | import qualified Data.ByteString.Char8 as B 20 | (length, ByteString) 21 | 22 | import qualified Data.ByteString.Lazy as BL 23 | (writeFile, readFile) 24 | 25 | import Graphics.Rendering.OpenGL.Raw (GLfloat, GLint) 26 | 27 | import Engine.Mesh.Mesh (Mesh(..), createMesh) 28 | import Engine.Graphics.Textures (juicyLoadTexture) 29 | 30 | loadDatModel :: FilePath -> FilePath -> FilePath -> IO Mesh 31 | loadDatModel f vert frag = 32 | let attrNames = ["position", "texCoord", "normal", "color", "textureId"] 33 | in do 34 | (totalDat, images) <- loadData f 35 | textures <- mapM juicyLoadTexture images 36 | 37 | tmp <- createMesh vert frag 38 | attrNames 39 | totalDat 40 | [3, 2, 3, 3, 1] 41 | (fromIntegral (length . head $ totalDat) `div` 3) 42 | 43 | let mTexIds = replicate (length textures) 0 :: [GLint] 44 | return tmp{meshTextures = 45 | zip textures mTexIds} 46 | 47 | loadDatModelKeepVerts :: FilePath -> FilePath -> FilePath -> IO (Mesh, [GLfloat]) 48 | loadDatModelKeepVerts f vert frag = 49 | let attrNames = ["position", "texCoord", "normal", "color", "textureId"] 50 | in do 51 | (totalDat, images) <- loadData f 52 | textures <- mapM juicyLoadTexture images 53 | 54 | tmp <- createMesh vert frag 55 | attrNames 56 | totalDat 57 | [3, 2, 3, 3, 1] 58 | (fromIntegral (length . head $ totalDat) `div` 3) 59 | 60 | let mTexIds = replicate (length textures) 0 :: [GLint] 61 | return (tmp{meshTextures = 62 | zip textures mTexIds}, head totalDat) 63 | 64 | writeDataToFile :: FilePath -> [[GLfloat]] -> [B.ByteString] -> IO () 65 | writeDataToFile datFile [verts, coords, norms, colors, tids] images = 66 | BL.writeFile datFile . runPut $ 67 | putBinaryFromInfo (verts, norms, coords, tids) colors images 68 | writeDataToFile _ _ _ = 69 | error $ "DatLoader.writeDataToFile:" ++ 70 | "arguments not properly formatted." 71 | 72 | putBinaryFromInfo :: 73 | ([GLfloat], [GLfloat], [GLfloat], [GLfloat]) -> 74 | [GLfloat] -> [B.ByteString] -> Put 75 | putBinaryFromInfo (verts, norms, texCoords, texIds) colors images = do 76 | put $ length verts 77 | writeBinaryDat verts 78 | put $ length norms 79 | writeBinaryDat norms 80 | put $ length texCoords 81 | writeBinaryDat texCoords 82 | put $ length texIds 83 | writeBinaryDat texIds 84 | put $ length colors 85 | writeBinaryDat colors 86 | mapM_ (\i -> put (B.length i) >> putByteString i) images 87 | 88 | loadData :: FilePath -> IO ([[GLfloat]], [FilePath]) 89 | loadData f = do 90 | let directory = (intercalate "/" . init $ splitOn "/" f) ++ "/" 91 | (dat, images) <- runGet getBinaryFromInfo <$> BL.readFile f 92 | print images 93 | return (dat, map ((directory++) . bsToString) images) 94 | 95 | bsToString :: B.ByteString -> String 96 | bsToString = init . tail . show 97 | 98 | getBinaryFromInfo :: Get ([[GLfloat]], [B.ByteString]) 99 | getBinaryFromInfo = do 100 | lenV <- get 101 | verts <- getBinaryDat lenV 102 | lenN <- get 103 | norms <- getBinaryDat lenN 104 | lenTC <- get 105 | texCoords <- getBinaryDat lenTC 106 | lenTI <- get 107 | texIds <- getBinaryDat lenTI 108 | lenC <- get 109 | colors <- getBinaryDat lenC 110 | images <- getImages 111 | return ([verts, texCoords, norms, colors, texIds], images) 112 | 113 | getImages :: Get [B.ByteString] 114 | getImages = do 115 | done <- isEmpty 116 | if not done 117 | then do 118 | len <- get 119 | img <- trace (show len) $ getByteString len 120 | (img:) <$> getImages 121 | else return [] 122 | 123 | writeBinaryDat :: [GLfloat] -> Put 124 | writeBinaryDat = mapM_ (put . toFloat) 125 | 126 | getBinaryDat :: Int -> Get [GLfloat] 127 | getBinaryDat i = 128 | fmap (map toGL) <$> forM [1..i] $ const (get :: Get Float) 129 | 130 | toFloat :: GLfloat -> Float 131 | toFloat = unsafeCoerce 132 | 133 | toGL :: Float -> GLfloat 134 | toGL = unsafeCoerce 135 | -------------------------------------------------------------------------------- /src/Engine/Mesh/Material.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Engine.Mesh.Material ( 3 | Material(..), loadMtlFile, emptyMaterial 4 | ) where 5 | 6 | import System.IO (IOMode (ReadMode), Handle, 7 | openFile, hIsEOF, hClose) 8 | import Data.List (intercalate) 9 | import Data.Maybe (isNothing, isJust) 10 | import Data.List.Split (splitOn) 11 | import Control.Monad (liftM) 12 | --import Control.DeepSeq (NFData(..), deepseq) 13 | import Data.Vec ((:.)(..), Vec3) 14 | 15 | import qualified Data.ByteString.Char8 as B 16 | 17 | import Graphics.Rendering.OpenGL.Raw (GLfloat, GLuint, GLint) 18 | 19 | import Engine.Graphics.Textures (juicyLoadTexture) 20 | 21 | data Material = Material { 22 | matName :: B.ByteString, 23 | matAmbientColor :: Maybe (Vec3 GLfloat), 24 | matDiffuseColor :: Maybe (Vec3 GLfloat), 25 | matSpecularColor :: Maybe (Vec3 GLfloat), 26 | matTexture :: Maybe GLuint, 27 | matTexId :: Maybe GLint, 28 | matTexturePaths :: [B.ByteString] 29 | } deriving (Show) 30 | 31 | {- 32 | instance NFData Material where 33 | rnf (Material n ac dc sc t ti tps) = 34 | n `deepseq` ac `deepseq` dc 35 | `deepseq` sc `deepseq` t `seq` ti `seq` tps `deepseq` () 36 | -} 37 | 38 | loadMtlFile :: FilePath -> IO [Material] 39 | loadMtlFile file = do 40 | let directory = (intercalate "/" . init $ splitOn "/" file) ++ "/" 41 | openFile file ReadMode >>= loadMtlMaterials directory 42 | 43 | loadMtlMaterials :: FilePath -> Handle -> IO [Material] 44 | loadMtlMaterials directory handle = 45 | liftM (map applyDefualtMtl . tail) 46 | (loadMtlMaterialsRec directory 0 handle emptyMaterial) 47 | 48 | -- | Apply defualt values to attributes set to 49 | -- Nothing according to spec at 50 | -- http://people.sc.fsu.edu/~jburkardt/data/mtl/mtl.html 51 | applyDefualtMtl :: Material -> Material 52 | applyDefualtMtl mat@(Material _ amb diff spec _ texId _) = 53 | let newAmb = if isNothing amb 54 | then Just $ 0.2 :. 0.2 :. 0.2 :. () 55 | else amb 56 | newDiff = if isNothing diff 57 | then Just $ 0.8 :. 0.8 :. 0.8 :. () 58 | else diff 59 | newSpec = if isNothing spec 60 | then Just $ 1.0 :. 1.0 :. 1.0 :. () 61 | else spec 62 | newTexId = if isNothing texId 63 | then Just (-1) 64 | else texId 65 | in mat{matAmbientColor = newAmb, 66 | matDiffuseColor = newDiff, 67 | matSpecularColor = newSpec, 68 | matTexId = newTexId} 69 | 70 | -- | UNSAFE!! Use loadMtlMaterials instead. 71 | loadMtlMaterialsRec :: FilePath -> GLuint -> Handle -> Material -> IO [Material] 72 | loadMtlMaterialsRec directory textureCount handle start = do 73 | eof <- hIsEOF handle 74 | if not eof 75 | then do 76 | line <- B.hGetLine handle 77 | -- If there is a declaration of a new Material, 78 | -- "add the current mat to the list" and start 79 | -- on a new Material. 80 | if "newmtl " `B.isPrefixOf` line 81 | then do 82 | let name = head $ rawMtlLine line 83 | rest <- loadMtlMaterialsRec directory textureCount handle 84 | (Material name Nothing Nothing Nothing Nothing Nothing []) 85 | return $ start : rest 86 | else if not $ B.null line 87 | -- Call executeCommand on current line and Material 88 | -- and then continue adding attributes to that Material. 89 | then 90 | let origTex = matTexture start 91 | in do 92 | newMat <- executeCommand directory line start textureCount 93 | if matTexture newMat == origTex 94 | then loadMtlMaterialsRec directory textureCount handle newMat 95 | else loadMtlMaterialsRec directory (textureCount+1) handle newMat 96 | else loadMtlMaterialsRec directory textureCount handle start 97 | -- If it is End Of File, close the file and 98 | -- return the last Material. 99 | else hClose handle >> return [start] 100 | 101 | executeCommand :: FilePath -> B.ByteString -> Material -> GLuint -> IO Material 102 | executeCommand directory command mat textureCount 103 | | "Ka " `B.isPrefixOf` command = 104 | return mat{matAmbientColor = Just $ readMtlLineTriplet command} 105 | | "Kd " `B.isPrefixOf` command = 106 | return mat{matDiffuseColor = Just $ readMtlLineTriplet command} 107 | | "Ks " `B.isPrefixOf` command = 108 | return mat{matSpecularColor = Just $ readMtlLineTriplet command} 109 | | "map_Kd " `B.isPrefixOf` command = do 110 | texture <- juicyLoadTexture $ directory ++ B.unpack (head $ rawMtlLine command) 111 | return mat{matTexture = Just texture, 112 | matTexId = Just $ fromIntegral textureCount, 113 | matTexturePaths = head (rawMtlLine command) : matTexturePaths mat} 114 | | otherwise = return mat 115 | 116 | {- 117 | allImagesInFile :: String -> [FilePath] 118 | allImagesInFile = 119 | map (last . filter (not . null) . splitOn " ") . filter (isPrefixOf "map_Kd ") . lines 120 | -} 121 | 122 | readMtlLineTriplet :: B.ByteString -> Vec3 GLfloat 123 | readMtlLineTriplet = toTripletMtl . readMtlLine 124 | 125 | readMtlLine :: B.ByteString -> [GLfloat] 126 | readMtlLine = map parseBsFloat . tail . filter (not . B.null) . B.split ' ' 127 | 128 | rawMtlLine :: B.ByteString -> [B.ByteString] 129 | rawMtlLine = tail . filter (not . B.null) . B.split ' ' 130 | 131 | toTripletMtl :: [GLfloat] -> Vec3 GLfloat 132 | toTripletMtl xs 133 | | length xs == 3 = head xs :. (xs !! 1) :. (xs !! 2) :. () 134 | | otherwise = error "Material.toTripletMtl" 135 | 136 | emptyMaterial :: Material 137 | emptyMaterial = Material "" Nothing Nothing Nothing Nothing Nothing [] 138 | 139 | parseBsFloat :: B.ByteString -> GLfloat 140 | parseBsFloat = fst . parseBsFloat' 141 | 142 | parseBsFloat' :: B.ByteString -> (GLfloat, B.ByteString) 143 | parseBsFloat' bs 144 | | isJust ('e' `B.elemIndex` bs) = 145 | let [baseBs, expBs] = B.splitWith (=='e') bs 146 | (base, _) = parseBsFloat' baseBs 147 | (expon, rest) = parseBsFloat' expBs 148 | in (base * (10.0 ** expon), rest) 149 | 150 | | isJust ('.' `B.elemIndex` bs) = 151 | let negative = B.head bs == '-' 152 | Just (whole, decimalBS) = B.readInt $ 153 | if negative 154 | then B.tail bs 155 | else bs 156 | Just (decimal, rest) = B.readInt $ B.tail decimalBS 157 | in if negative 158 | then (negate $ fromIntegral whole + 159 | (fromIntegral decimal / 10 ^ (B.length decimalBS - 1)), rest) 160 | else (fromIntegral whole + 161 | (fromIntegral decimal / 10 ^ (B.length decimalBS - 1)), rest) 162 | 163 | | otherwise = 164 | let Just (val, rest) = B.readInt bs 165 | in (fromIntegral val, rest) 166 | -------------------------------------------------------------------------------- /src/Engine/Mesh/Mesh.hs: -------------------------------------------------------------------------------- 1 | module Engine.Mesh.Mesh ( 2 | Mesh(..), createMesh, createMeshWithProgram, 3 | emptyMesh 4 | ) where 5 | 6 | import Graphics.Rendering.OpenGL.Raw 7 | (GLfloat, GLuint, GLint) 8 | 9 | import Engine.Mesh.AABB 10 | (AABB(..), AABBSet(..), aabbByFace, aabbFromPoints) 11 | import Engine.Graphics.Shaders 12 | (Shader(..), ShaderAttrib, loadProgram, 13 | getAttrLocs, createShaderAttribs) 14 | import Engine.Graphics.Textures (Texture) 15 | import Engine.Graphics.GraphicsUtils (createBufferIdAll) 16 | 17 | -- | A data type for representing a model 18 | -- to be rendered. 19 | data Mesh = Mesh { 20 | meshShader :: Shader, 21 | meshShaderVars :: [ShaderAttrib], 22 | meshTextures :: [Texture], 23 | meshVertCount :: GLint, 24 | meshAABBSet :: AABBSet 25 | } deriving (Show, Eq) 26 | emptyMesh :: Mesh 27 | emptyMesh = Mesh (Shader 0 []) [] [] 0 $ AABBSet (Just $ AABB 0 0) [AABB 0 0] 28 | 29 | createMesh :: 30 | FilePath -> -- Vertex Shader. 31 | FilePath -> -- Fragment Shader. 32 | [String] -> -- Attribute Variable names. 33 | [[GLfloat]] -> -- List containing all the lists of values. 34 | -- (vertices, normals, etc). 35 | [GLuint] -> -- Size of each value. 36 | GLint -> -- Number of vertices. 37 | IO Mesh 38 | createMesh vert frag attrNames buffData valLens vertCount = do 39 | program <- loadProgram vert frag 40 | attribs <- getAttrLocs program attrNames 41 | ids <- createBufferIdAll buffData 42 | 43 | let sAttribs = createShaderAttribs attribs ids valLens 44 | return $ Mesh (Shader program []) sAttribs [] vertCount $ 45 | AABBSet 46 | (Just $ aabbFromPoints (head buffData)) 47 | (aabbByFace (head buffData)) 48 | 49 | createMeshWithProgram :: 50 | GLuint -> -- Program 51 | [String] -> -- Attribute Variable names. 52 | [[GLfloat]] -> -- List containing all the lists of values. 53 | -- (vertices, normals, etc). 54 | [GLuint] -> -- Size of each value. 55 | GLint -> -- Number of vertices. 56 | IO Mesh 57 | createMeshWithProgram program attrNames buffData valLens vertCount = do 58 | attribs <- getAttrLocs program attrNames 59 | ids <- createBufferIdAll buffData 60 | 61 | let sAttribs = createShaderAttribs attribs ids valLens 62 | return $ Mesh (Shader program []) sAttribs [] vertCount $ 63 | AABBSet 64 | (Just $ aabbFromPoints (head buffData)) 65 | (aabbByFace (head buffData)) 66 | -------------------------------------------------------------------------------- /src/Engine/Object/GameObject.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | module Engine.Object.GameObject ( 3 | -- updateWorld 4 | -- getModel 5 | ) where 6 | 7 | import Control.Monad.State (get) 8 | 9 | import Engine.Core.Types 10 | (Game, World(..), Entity(..)) 11 | import Engine.Mesh.Mesh (Mesh(..)) 12 | 13 | {- 14 | updateWorld :: Game t (World t) 15 | updateWorld = do 16 | world <- get 17 | newObjs <- updateEntities 18 | return world{worldEntities = newObjs} 19 | 20 | updateEntities :: Game t [Entity t] 21 | updateEntities = do 22 | world <- get 23 | mapM (\o -> entityUpdate o o) (worldEntities world) 24 | -} 25 | 26 | --getModel :: Entity t -> Mesh 27 | --getModel pe@(Entity{}) = entityModel pe 28 | -------------------------------------------------------------------------------- /src/Engine/Object/Intersect.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverlappingInstances #-} 4 | module Engine.Object.Intersect ( 5 | Intersect(..), intersectsAny, 6 | getObjectAllIntersecters, 7 | getObjectIntersecter 8 | ) where 9 | 10 | import Data.Maybe (isJust, fromJust) 11 | import Data.Vec ((:.)(..), Vec3) 12 | 13 | import Graphics.Rendering.OpenGL.Raw (GLfloat) 14 | 15 | import Engine.Mesh.AABB 16 | 17 | -- | A type class for any two things 18 | -- that can intersect. 19 | class Intersect l r where 20 | intersecting :: l -> r -> Bool 21 | {-# MINIMAL intersecting #-} 22 | 23 | instance Intersect AABB AABB where 24 | intersecting 25 | (AABB (min1x :. min1y :. min1z :. ()) 26 | (max1x :. max1y :. max1z :. ())) 27 | (AABB (min2x :. min2y :. min2z :. ()) 28 | (max2x :. max2y :. max2z :. ())) = 29 | max1x > min2x && 30 | min1x < max2x && 31 | max1y > min2y && 32 | min1y < max2y && 33 | max1z > min2z && 34 | min1z < max2z 35 | {-# INLINE intersecting #-} 36 | 37 | instance Intersect (Vec3 GLfloat) AABB where 38 | intersecting (px :. py :. pz :. ()) 39 | (AABB (minx :. miny :. minz :. ()) 40 | (maxx :. maxy :. maxz :. ())) = 41 | px >= minx && px <= maxx && 42 | py >= miny && py <= maxy && 43 | pz >= minz && pz <= maxz 44 | {-# INLINE intersecting #-} 45 | 46 | instance (HasAABB a, HasAABB b) => Intersect a b where 47 | intersecting left right = 48 | let lwholeM = getWholeAABB left 49 | rwholeM = getWholeAABB right 50 | in if isJust lwholeM && isJust rwholeM 51 | then 52 | let lwhole = fromJust lwholeM 53 | rwhole = fromJust rwholeM 54 | in intersecting lwhole rwhole && 55 | let lall = getAABBs left 56 | rall = getAABBs right 57 | in anyIntersect lall rall 58 | else 59 | let lall = getAABBs left 60 | rall = getAABBs right 61 | in anyIntersect lall rall 62 | where 63 | anyIntersect :: Intersect a b => [a] -> [b] -> Bool 64 | anyIntersect (l:ls) (r:rs) = 65 | intersecting l r || anyIntersect ls rs 66 | anyIntersect _ _ = False 67 | 68 | intersectsAny :: Intersect a b => a -> [b] -> Bool 69 | intersectsAny needle (hay:haystack) = 70 | needle `intersecting` hay || 71 | needle `intersectsAny` haystack 72 | intersectsAny _ [] = False 73 | 74 | getObjectAllIntersecters :: (HasAABB a, HasAABB b) => 75 | a -> [b] -> [AABB] 76 | getObjectAllIntersecters collider (collidee:xs) = 77 | let intersecter = getIntersecter collider collidee 78 | in if isJust intersecter 79 | then fromJust intersecter : getObjectAllIntersecters collider xs 80 | else getObjectAllIntersecters collider xs 81 | getObjectAllIntersecters _ [] = [] 82 | 83 | -- | Check if the needle intersects with any in the haystack, 84 | -- if it does, the intersected AABB is returned. 85 | getObjectIntersecter :: (HasAABB a, HasAABB b) => a -> [b] -> Maybe AABB 86 | getObjectIntersecter collider (collidee:xs) = 87 | let intersecter = getIntersecter collider collidee 88 | in if isJust intersecter 89 | then intersecter 90 | else getObjectIntersecter collider xs 91 | getObjectIntersecter _ [] = Nothing 92 | 93 | -- | Test if two objects intersect, yeilding the 94 | -- offending AABB if they do. 95 | getIntersecter :: (HasAABB a, HasAABB b) => a -> b -> Maybe AABB 96 | getIntersecter l r 97 | | isJust (getWholeAABB l) && 98 | isJust (getWholeAABB r) = 99 | let Just wholeabl = transformedWholeAABB l 100 | Just wholeabr = transformedWholeAABB r 101 | in 102 | if intersecting wholeabl wholeabr 103 | then if null (getAABBs l) && (not . null) (getAABBs r) 104 | then Just wholeabr 105 | else 106 | let newl = transformedAABBs l 107 | newr = transformedAABBs r 108 | in anyIntersectGet (head newl) newr 109 | else Nothing 110 | | otherwise = 111 | let newl = transformedAABBs l 112 | newr = transformedAABBs r 113 | in anyIntersectGet (head newl) newr 114 | 115 | anyIntersectGet :: AABB -> [AABB] -> Maybe AABB 116 | anyIntersectGet l (r:rs) = 117 | if intersecting l r 118 | then Just r 119 | else anyIntersectGet l rs 120 | anyIntersectGet _ _ = Nothing 121 | -------------------------------------------------------------------------------- /src/Engine/Object/Player.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | module Engine.Object.Player ( 3 | mkPlayer, 4 | resetPlayerInput 5 | ) where 6 | 7 | import Prelude hiding ((.)) 8 | import Control.Category ((.)) 9 | import Control.Applicative ((<$>)) 10 | import Control.Monad (void, when) 11 | import Control.Monad.State 12 | (get, gets, liftIO, put) 13 | import Data.Default (def) 14 | import Data.Vec ((:.)(..), Vec3) 15 | import Unsafe.Coerce (unsafeCoerce) 16 | 17 | import qualified Data.Label as L (set) 18 | 19 | import Physics.Bullet.Raw 20 | (btDynamicsWorld_stepSimulation, 21 | btSphereShape, btBoxShape) 22 | import Physics.Bullet.Raw.Types (Transform(..)) 23 | import Physics.Bullet.Raw.Class (BtSphereShape) 24 | import qualified Physics.Bullet.Raw.Types as BT (Vec3(..)) 25 | 26 | import Graphics.Rendering.OpenGL.Raw (GLfloat) 27 | import qualified Graphics.UI.GLFW as GLFW 28 | 29 | import Engine.Core.Types 30 | import Engine.Core.Util (sinDeg, cosDeg) 31 | import Engine.Bullet.Bullet 32 | (Physics(..), AttrOp(..), 33 | RigidBodyInfo(..), 34 | set, worldTransform, 35 | linearVelocity, addShape, 36 | linearSleepingThreshold, 37 | angularFactor, angularVelocity) 38 | import qualified Engine.Bullet.Bullet as B (get) 39 | 40 | 41 | -------- FPS ------------------ 42 | 43 | mkPlayer :: Physics -> IO (Player t) 44 | mkPlayer physics = do 45 | let info = def{ 46 | rigidBodyMass = 1, 47 | rigidBodyFriction = 2, 48 | rigidBodyStatic = False} 49 | shape <- mkPlayerShape 50 | player <- 51 | Player (0 :. 0 :. 0 :. ()) 52 | (0 :. 0 :. 0 :. ()) 53 | (0 :. 0 :. 0 :. ()) 54 | 5 55 | pUpdate 56 | baseInput 57 | <$> addShape shape info physics 58 | void $ set (playerRigidBody player) 59 | [worldTransform :~ (\(Transform mat _) -> Transform mat $ BT.Vec3 0 60 0), 60 | linearSleepingThreshold := (-0), 61 | angularFactor := BT.Vec3 1 1 1] 62 | return player 63 | 64 | mkPlayerShape :: IO BtSphereShape 65 | mkPlayerShape = btSphereShape 1 66 | 67 | -- | Input for first person camera. 68 | baseInput :: Input t 69 | baseInput = Input 70 | [(GLFW.Key'A, GLFW.KeyState'Repeating, GLFW.KeyState'Released, aIn), 71 | (GLFW.Key'D, GLFW.KeyState'Repeating, GLFW.KeyState'Released, dIn), 72 | (GLFW.Key'W, GLFW.KeyState'Repeating, GLFW.KeyState'Released, wIn), 73 | (GLFW.Key'S, GLFW.KeyState'Repeating, GLFW.KeyState'Released, sIn), 74 | (GLFW.Key'LeftShift, GLFW.KeyState'Repeating, GLFW.KeyState'Released, shiftIn), 75 | (GLFW.Key'Space, GLFW.KeyState'Pressed, GLFW.KeyState'Released, spaceIn), 76 | (GLFW.Key'Escape, GLFW.KeyState'Pressed, GLFW.KeyState'Released, escIn)] 77 | (0 :. 0 :. ()) (0 :. 0 :. ()) 78 | 0.1 79 | 80 | aIn :: World t -> World t 81 | aIn w = 82 | let p = worldPlayer w 83 | in w{worldPlayer = 84 | setVelocityFromLook p (playerSpeed p :. 0 :. 0 :. ())} 85 | dIn :: World t -> World t 86 | dIn w = 87 | let p = worldPlayer w 88 | in w{worldPlayer = 89 | setVelocityFromLook p ((-playerSpeed p) :. 0 :. 0 :. ())} 90 | wIn :: World t -> World t 91 | wIn w = 92 | let p = worldPlayer w 93 | in w{worldPlayer = 94 | setVelocityFromLook p (0 :. 0 :. (-playerSpeed p) :. ())} 95 | sIn :: World t -> World t 96 | sIn w = 97 | let p = worldPlayer w 98 | in w{worldPlayer = 99 | setVelocityFromLook p (0 :. 0 :. (playerSpeed p) :. ())} 100 | 101 | shiftIn :: World t -> World t 102 | shiftIn w = 103 | let p = worldPlayer w 104 | in w{worldPlayer = 105 | p{playerVelocity = 106 | playerVelocity p + (0 :. (-playerSpeed p) :. 0 :. ())}} 107 | 108 | spaceIn :: World t -> World t 109 | spaceIn w = 110 | let p = worldPlayer w 111 | curVel@(_ :. vy :. _ :. ()) = playerVelocity p 112 | in 113 | if abs vy < 0.01 114 | then w{worldPlayer = 115 | p{playerVelocity = 116 | curVel + (0 :. 12 :. 0 :. ())}} 117 | else w 118 | 119 | escIn :: World t -> World t 120 | escIn w = 121 | let state = worldState w 122 | paused = statePaused state 123 | in w{ 124 | worldState = state{ 125 | statePaused = not paused 126 | } 127 | } 128 | 129 | --------------- END FPS --------------- 130 | 131 | pUpdate :: GameIO t () 132 | pUpdate = do 133 | paused <- gets (statePaused . worldState) 134 | if not paused 135 | then pUpdateNormal 136 | else hoistGame pUpdatePaused 137 | 138 | pUpdateNormal :: GameIO t () 139 | pUpdateNormal = do 140 | p <- gets worldPlayer 141 | let origSpeed = playerSpeed p 142 | state <- gets worldState 143 | -- Modify playerSpeed based on delta time. 144 | lWorldPlayer %= (lPlayerSpeed %~ (* stateDelta state)) 145 | -- Do key update. 146 | hoistGame playerKeyUpdateSafe 147 | -- Do mouse update. 148 | lWorldPlayer %= playerMouseUpdate 149 | 150 | -- Resolve velocity, moving player. 151 | (lWorldPlayer .=) =<< resolveVelocityBullet =<< gets worldPlayer 152 | -- Reset speed. 153 | lWorldPlayer %= (lPlayerSpeed .~ origSpeed) 154 | 155 | pUpdatePaused :: Game t () 156 | pUpdatePaused = do 157 | p <- gets worldPlayer 158 | -- Do mouse update. Why? 159 | lWorldPlayer .= playerMouseUpdate p 160 | -- Do key update, to change world state. 161 | playerKeyUpdateSafe 162 | -- Reset player, in case it moved. 163 | lWorldPlayer .= p 164 | 165 | resetPlayerInput :: Player t -> Player t 166 | resetPlayerInput = 167 | lPlayerInput %~ (lInputMouseDelta .~ 0 :. 0 :. ()) 168 | 169 | -- | Calculate delta movement from Player and raw input movement. 170 | calculateLookMovement :: Player t -> Vec3 GLfloat -> Vec3 GLfloat 171 | calculateLookMovement p (idx :. idy :. idz :. ()) = 172 | let _ :. rry :. _ :. () = playerRotation p 173 | dx = uC idx 174 | dz = uC idz 175 | 176 | ry = uC rry :: Float 177 | 178 | mx = dx * sinDeg (ry - 90) + dz * sinDeg ry 179 | my = idy 180 | mz = dx * cosDeg (ry - 90) + dz * cosDeg ry 181 | in uC mx :. my :. uC mz :. () 182 | where 183 | uC = unsafeCoerce 184 | 185 | -- | Calculate new velocity from current object 186 | -- and raw movement. 187 | setVelocityFromLook :: Player t -> Vec3 GLfloat -> Player t 188 | setVelocityFromLook player idVec = 189 | let movement = calculateLookMovement player idVec 190 | in lPlayerVelocity %~ (+ movement) $ player 191 | 192 | -- | Update rotation from mouse input. 193 | playerMouseUpdate :: Player t -> Player t 194 | playerMouseUpdate player = 195 | let rawdx :. rawdy :. () = inputMouseDelta $ playerInput player 196 | lastX :. lastY :. () = inputLastMousePos $ playerInput player 197 | -- TODO: adjust multipliers 198 | (dxx, dy) = (rawdx*0.1, rawdy*0.1) 199 | 200 | rx :. ry :. rz :. () = playerRotation player 201 | 202 | dx = -dxx 203 | 204 | curPos = (lastX + rawdx) :. (lastY + rawdy) :. () 205 | 206 | -- Basic calculation of degrees, 0 is minimum, 207 | -- 360 is maximum. 208 | newRy 209 | | ry + dx >= 360 = ry + dx - 360 210 | | dx + ry < 0 = 360 - ry + dx 211 | | otherwise = ry + dx 212 | 213 | -- Lowest angle player can look 214 | maxLookDown = -90 215 | -- Highest angle player can look 216 | maxLookUp = 90 217 | 218 | -- Basic calculation for x axis (looking up and down). 219 | -- Make sure that look direction stays between maxLookDown 220 | -- and maxLookUp. 221 | newRx 222 | -- If rotation is in bounds, allow rotation. 223 | | rx - dy >= maxLookDown && rx - dy <= maxLookUp = rx - dy 224 | -- If player is trying to look down too far, set rotation to maxLookDown. 225 | | rx - dy < maxLookDown = maxLookDown 226 | -- If player is trying to look up too far, set rotation to maxLookUp. 227 | | rx - dy > maxLookUp = maxLookUp 228 | -- I don't think this will ever happen. 229 | | otherwise = rx 230 | 231 | newRot = newRx :. newRy :. rz :. () 232 | -- Update rotation and lastMousePos. 233 | in L.set lPlayerRotation newRot . 234 | L.set (lInputLastMousePos . lPlayerInput) curPos $ player 235 | 236 | -- | Update player's keys. 237 | playerKeyUpdateSafe :: Game t () 238 | playerKeyUpdateSafe = do 239 | -- Get initial player info. 240 | player <- gets worldPlayer 241 | let startInput = playerInput player 242 | 243 | -- Perform key update. 244 | playerKeyUpdateTail 245 | -- Reset playerInput. 246 | lPlayerInput . lWorldPlayer .= startInput 247 | 248 | -- | Returns Player after safely applying all input functions. 249 | -- UNSAFE! Returns given player with an empty inputKeys! 250 | -- Use playerKeyUpdateSafe instead. 251 | playerKeyUpdateTail :: Game t () 252 | playerKeyUpdateTail = do 253 | w <- get 254 | Input ((_, desired, found, func):xs) mouse lm ms <- 255 | gets (playerInput . worldPlayer) 256 | -- If the recorded keystate matches desired keystate, 257 | -- apply corresponding function to player. 258 | -- Assumes KeyState'Repeating = KeyState'Repeating || KeyState'Pressed 259 | let newWorld 260 | | desired == GLFW.KeyState'Repeating = 261 | if found == desired || 262 | found == GLFW.KeyState'Pressed 263 | then func w 264 | else w 265 | | desired == found = 266 | func w 267 | | otherwise = w 268 | put newWorld 269 | -- Modify the player's keys. 270 | lPlayerInput . lWorldPlayer .= Input xs mouse lm ms 271 | -- If there are more keys to update, do it. 272 | when (not . null $ xs) playerKeyUpdateTail 273 | 274 | -- | Resolve velocity with bullet. 275 | resolveVelocityBullet :: Player t -> GameIO t (Player t) 276 | resolveVelocityBullet p = do 277 | -- Delta time. 278 | world <- get 279 | let delta = stateDelta $ worldState world 280 | 281 | let vx :. vy :. vz :. () = playerVelocity p 282 | rigidBody = playerRigidBody p 283 | 284 | -- Change velocity in bullet. 285 | void . liftIO $ set rigidBody 286 | [linearVelocity :~ (+ BT.Vec3 (uC vx) (uC vy) (uC vz))] 287 | -- Step physics. 288 | physics <- gets worldPhysics 289 | void . liftIO $ btDynamicsWorld_stepSimulation (physicsWorld physics) 290 | (uC delta) 10 (1/60) 291 | 292 | -- Ask bullet physics where the object is now. 293 | (Transform _mat (BT.Vec3 nx ny nz)) <- 294 | liftIO $ rigidBody `B.get` worldTransform 295 | 296 | --let BT.Vec3 nx ny nz = mat *. pos 297 | 298 | -- Set position to wherever bullet says it is. 299 | return $ L.set lPlayerPosition (uC nx :. uC ny :. uC nz :. ()) . 300 | -- Set velocity to 0. 301 | L.set lPlayerVelocity (0 :. 0 :. 0 :. ()) $ p 302 | 303 | where 304 | uC :: a -> b 305 | uC = unsafeCoerce 306 | -------------------------------------------------------------------------------- /src/Engine/Save/Save.hs: -------------------------------------------------------------------------------- 1 | module Save where 2 | 3 | import System.IO 4 | (openFile, IOMode(..), hGetContents, hClose) 5 | 6 | import Engine.Core.World 7 | import Engine.Core.Vec 8 | 9 | writeSaveFromWorld :: World t -> FilePath -> IO () 10 | writeSaveFromWorld world file = do 11 | fileHandle <- openFile file WriteMode 12 | hClose fileHandle 13 | return () 14 | 15 | --generateWorldSaveText :: World t -> String 16 | --generateWorldSaveText = 17 | 18 | -- e$12$12$12$res/objects/..$shader/..$shaders/.. 19 | 20 | generateGameObjectText :: GameObject t -> String 21 | generateGameObjectText pe@(PureEntity{}) = 22 | let Vec3 px py pz = pentityPosition pe 23 | model = pentityModel pe 24 | normals = model 25 | in "PureEntity$" ++ show px ++ "$" ++ show py ++ "$" ++ show pz 26 | ++ "$" ++ 27 | -------------------------------------------------------------------------------- /src/Engine/Terrain/Generator.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses #-} 2 | module Engine.Terrain.Generator ( 3 | genSimplexModel, 4 | generateTerrain 5 | ) where 6 | 7 | import Control.Applicative ((<$>), (<*>)) 8 | import Data.Default (def) 9 | import qualified Data.DList as D 10 | import System.Random (randomRIO) 11 | import Data.Vec (Vec3, (:.)(..)) 12 | 13 | import Graphics.Rendering.OpenGL.Raw (GLfloat) 14 | 15 | import Engine.Core.Types (Entity(..)) 16 | import Engine.Mesh.Mesh (Mesh(..), createMesh) 17 | import Engine.Terrain.Noise 18 | (Simplex(..), perm, getSimplexHeight) 19 | import Engine.Graphics.Textures (juicyLoadTexture) 20 | import Engine.Bullet.Bullet 21 | (Physics(..), addStaticTriangleMesh) 22 | 23 | generateTerrain :: 24 | Physics -> 25 | FilePath -> FilePath -> 26 | GLfloat -> -- Width 27 | GLfloat -> -- Spacing 28 | Int -> -- Octaves 29 | GLfloat -> -- Wavelength 30 | GLfloat -> -- Waveheight / intensity 31 | Maybe FilePath -> -- The texture (Maybe) 32 | IO (Entity ()) 33 | generateTerrain phys vert frag w spacing octaves wavelength intensity texture = do 34 | seed <- randomRIO (0, 2048) 35 | let simplex = 36 | Simplex seed (floor w, floor w) (0, 0) spacing octaves 37 | wavelength intensity (perm seed) 38 | vertices = D.toList $ createSimplexTerrain simplex 39 | -- normals = calculateNormals vertices 40 | undefined 41 | {- 42 | mesh <- maybe 43 | (loadTerrainNoTexture vert frag vertices normals) 44 | (loadTerrainWithTexture vert frag vertices normals) 45 | texture 46 | 47 | Entity 0 0 0 return 48 | <$> addStaticTriangleMesh vertices def phys <*> return () 49 | -} 50 | 51 | genSimplexModel :: FilePath -> FilePath -> 52 | GLfloat -> -- Width 53 | GLfloat -> -- Spacing 54 | Int -> -- Octaves 55 | GLfloat -> -- Wavelength 56 | GLfloat -> -- Waveheight / intensity 57 | Maybe FilePath -> -- The texture (Maybe) 58 | IO Mesh 59 | genSimplexModel vert frag w spacing octaves wavelength intensity texture = do 60 | seed <- randomRIO (0, 2048) 61 | let simplex = 62 | Simplex seed (floor w, floor w) (0, 0) spacing 63 | octaves wavelength intensity (perm seed) 64 | vertices = D.toList $ createSimplexTerrain simplex 65 | -- normals = calculateNormals vertices 66 | undefined 67 | {- 68 | maybe 69 | (loadTerrainNoTexture vert frag vertices normals) 70 | (loadTerrainWithTexture vert frag vertices normals) 71 | texture 72 | -} 73 | 74 | {- 75 | loadTerrainWithTexture :: 76 | FilePath -> FilePath -> 77 | [Vec3 GLfloat] -> [Vec3 GLfloat] -> 78 | FilePath -> 79 | IO Mesh 80 | loadTerrainWithTexture vert frag vertices normals texture = 81 | let lengthVertices = length vertices 82 | in do 83 | loadedModel <- createMesh vert frag 84 | ["position", "normal", "color", "texCoord", "textureId"] 85 | [vertices, normals, take (lengthVertices * 3) (cycle [0, 1, 0]), 86 | take (lengthVertices * 3) $ cycle [0, 0, 1, 0, 0, 1], 87 | replicate lengthVertices 0] 88 | [3, 3, 3, 2, 1] 89 | (fromIntegral $ lengthVertices `div` 3) 90 | textureData <- juicyLoadTexture texture 91 | return $ loadedModel{meshTextures = [(textureData, 1)]} 92 | 93 | loadTerrainNoTexture :: 94 | FilePath -> FilePath -> 95 | [GLfloat] -> [GLfloat] -> 96 | IO Mesh 97 | loadTerrainNoTexture vert frag vertices normals = 98 | let lengthVertices = length vertices 99 | in createMesh vert frag 100 | ["position", "normal", "color", "texCoord", "textureId"] 101 | [vertices, normals, take (lengthVertices * 3) (cycle [0, 1, 0]), 102 | replicate (lengthVertices * 3) 0, 103 | replicate lengthVertices (-1)] 104 | [3, 3, 3, 2, 1] 105 | (fromIntegral $ lengthVertices `div` 3) 106 | -} 107 | 108 | createSimplexTerrain :: Simplex -> D.DList (Vec3 GLfloat) 109 | createSimplexTerrain simplex = 110 | concatMapD 111 | (\x -> concatMapD (makeSquare simplex x) $ allYs simplex) $ 112 | allXs simplex 113 | 114 | concatMapD :: (a -> D.DList b) -> D.DList a -> D.DList b 115 | concatMapD f = D.foldr (D.append . f) D.empty 116 | 117 | allXs :: Simplex -> D.DList GLfloat 118 | allXs simplex = 119 | let first = fromIntegral $ fst $ simpStartXY simplex :: GLfloat 120 | in first `D.cons` allXs' simplex first 0 121 | where 122 | allXs' :: Simplex -> GLfloat -> Int -> D.DList GLfloat 123 | allXs' s i j 124 | | j < fst (simpDimensions s) = 125 | let cur = i + simpSpacing s 126 | in cur `D.cons` allXs' simplex cur (j+1) 127 | | otherwise = D.empty 128 | 129 | allYs :: Simplex -> D.DList GLfloat 130 | allYs simplex = 131 | let first = fromIntegral $ snd $ simpStartXY simplex :: GLfloat 132 | in first `D.cons` allYs' simplex first 0 133 | where 134 | allYs' :: Simplex -> GLfloat -> Int -> D.DList GLfloat 135 | allYs' s i j 136 | | j < snd (simpDimensions s) = 137 | let cur = i + simpSpacing s 138 | in cur `D.cons` allYs' simplex cur (j+1) 139 | | otherwise = D.empty 140 | 141 | makeSquare :: Simplex -> GLfloat -> GLfloat -> D.DList (Vec3 GLfloat) 142 | makeSquare simplex x z = 143 | let spacing = simpSpacing simplex 144 | in makePointFromXY simplex x z `D.append` 145 | makePointFromXY simplex x (z+spacing) `D.append` 146 | makePointFromXY simplex (x+spacing) z `D.append` 147 | makePointFromXY simplex (x+spacing) z `D.append` 148 | makePointFromXY simplex x (z+spacing) `D.append` 149 | makePointFromXY simplex (x+spacing) (z+spacing) 150 | 151 | makePointFromXY :: Simplex -> GLfloat -> GLfloat -> D.DList (Vec3 GLfloat) 152 | makePointFromXY simp x z = 153 | D.singleton $ x :. getSimplexHeight simp x z :. z :. () 154 | 155 | calculateNormals :: [GLfloat] -> [GLfloat] 156 | calculateNormals (x1:y1:z1:x2:y2:z2:x3:y3:z3:rest) = 157 | let (ux, uy, uz) = (x2 - x1, y2 - y1, z2 - z1) 158 | (vx, vy, vz) = (x3 - x1, y3 - y1, z3 - z1) 159 | nx = (uy * vz) - (uz * vy) 160 | ny = (uz * vx) - (ux * vz) 161 | nz = (ux * vy) - (uy * vx) 162 | -- Repeat this normal for 6 points (3 points for this half 163 | -- of the square, 3 points for the other half). Drop the next 164 | -- 3 points (9 floats) - the next triangle. 165 | in repeatList 6 [nx, if ny > 0 then ny else -ny, nz] ++ 166 | calculateNormals (drop 9 rest) 167 | where 168 | repeatList :: Int -> [a] -> [a] 169 | repeatList i list = take (i*3) $ cycle list 170 | calculateNormals _ = [] 171 | -------------------------------------------------------------------------------- /src/Engine/Terrain/Noise.hs: -------------------------------------------------------------------------------- 1 | module Engine.Terrain.Noise ( 2 | Simplex(..), getSimplexHeight, simplexNoise, 3 | perm 4 | ) where 5 | 6 | import Data.Bits ((.&.)) 7 | import System.Random.Shuffle (shuffle') 8 | import System.Random hiding (next) 9 | import Control.Parallel.Strategies 10 | import qualified Data.Vector.Unboxed as V 11 | 12 | import Graphics.Rendering.OpenGL.Raw (GLfloat) 13 | 14 | type Permutation = V.Vector Int 15 | 16 | -- | All the information needed to create and 17 | -- keep track of a Simplex procedurally 18 | -- generated terrain. 19 | data Simplex = Simplex { 20 | simpSeed :: Int, 21 | simpDimensions :: (Int, Int), 22 | simpStartXY :: (Int, Int), 23 | simpSpacing :: GLfloat, 24 | simpOctaves :: Int, 25 | simpWavelength :: GLfloat, 26 | simpIntensity :: GLfloat, 27 | simpPerm :: Permutation 28 | } deriving (Show, Eq) 29 | 30 | 31 | g3 :: Double 32 | g3 = 0.16666666666666666 -- 1/6 33 | {-# INLINE g3 #-} 34 | 35 | {-# INLINE int #-} 36 | int :: Int -> Double 37 | int = fromIntegral 38 | 39 | grad3 :: V.Vector (Double, Double, Double) 40 | grad3 = V.fromList [(1,1,0),(-1, 1,0),(1,-1, 0),(-1,-1, 0), 41 | (1,0,1),(-1, 0,1),(1, 0,-1),(-1, 0,-1), 42 | (0,1,1),( 0,-1,1),(0, 1,-1),( 0,-1,-1)] 43 | 44 | {-# INLINE dot3 #-} 45 | dot3 :: (Double, Double, Double) -> Double -> Double -> Double -> Double 46 | dot3 (a,b,c) x y z = a * x + b * y + c * z 47 | 48 | {-# INLINE fastFloor #-} 49 | fastFloor :: Double -> Int 50 | fastFloor x = truncate $ if x > 0 then x else x - 1 51 | 52 | -- | Generate a random permutation for use in the noise functions 53 | perm :: Int -> Permutation 54 | perm seed = V.fromList . concat . replicate 2 . shuffle' [0..255] 256 $ 55 | mkStdGen seed 56 | 57 | -- | Generate 3D noise between -0.5 and 0.5 58 | noise3D :: Permutation -> Double -> Double -> Double -> Double 59 | noise3D p x y z = 60 | 16 * (n gi0 (x0,y0,z0) + n gi1 xyz1 + n gi2 xyz2 + n gi3 xyz3) 61 | where 62 | (i,j,k) = (s x, s y, s z) 63 | s a = fastFloor (a + (x + y + z) / 3) 64 | (x0, y0, z0) = (x - int i + t, y - int j + t, z - int k + t) 65 | t = int (i + j + k) * g3 66 | (i1, j1, k1, i2, j2, k2) 67 | | x0 >= y0 = 68 | if y0 >= z0 69 | then (1,0,0,1,1,0) 70 | else if x0 >= z0 71 | then (1,0,0,1,0,1) 72 | else (0,0,1,1,0,1) 73 | | x0 >= y0 = 74 | if y0 >= z0 75 | then (1,0,0,1,1,0) 76 | else if x0 >= z0 77 | then (1,0,0,1,0,1) 78 | else (0,0,1,1,0,1) 79 | | y0 < z0 = (0,0,1,0,1,1) 80 | | x0 < z0 = (0,1,0,0,1,1) 81 | | otherwise = (0,1,0,1,1,0) 82 | xyz1 = (x0 - int i1 + g3, y0 - int j1 + g3, z0 - int k1 + g3) 83 | xyz2 = (x0 - int i2 + 2*g3, y0 - int j2 + 2*g3, z0 - int k2 + 2*g3) 84 | xyz3 = (x0 - 1 + 3*g3, y0 - 1 + 3*g3, z0 - 1 + 3*g3) 85 | (ii,jj,kk) = (i .&. 255, j .&. 255, k .&. 255) 86 | gi0 = rem (V.unsafeIndex p 87 | (ii + V.unsafeIndex p (jj + V.unsafeIndex p kk))) 12 88 | gi1 = rem (V.unsafeIndex p 89 | (ii + i1 + V.unsafeIndex p (jj + j1 + V.unsafeIndex p (kk + k1)))) 12 90 | gi2 = rem (V.unsafeIndex p 91 | (ii + i2 + V.unsafeIndex p (jj + j2 + V.unsafeIndex p (kk + k2)))) 12 92 | gi3 = rem (V.unsafeIndex p 93 | (ii + 1 + V.unsafeIndex p (jj + 1 + V.unsafeIndex p (kk + 1)))) 12 94 | {-# INLINE n #-} 95 | n gi (x',y',z') = (\a -> if a < 0 then 0 else 96 | a*a*a*a*dot3 (V.unsafeIndex grad3 gi) x' y' z') $ 97 | 0.6 - x'*x' - y'*y' - z'*z' 98 | 99 | harmonic :: Int -> (Double -> Double) -> Double 100 | harmonic octaves noise = f octaves / (2 - 1 / int (2 ^ (octaves - 1))) 101 | where 102 | f 0 = 0 103 | f o = let r = 2 ^^ (o - 1) in noise r / r + f (o - 1) 104 | 105 | -- | 3D simplex noise 106 | -- args - permutation number_of_octaves wavelength x y z 107 | simplex3D :: Permutation -> Int -> Double -> Double -> Double -> Double -> Double 108 | simplex3D p octaves l x y z = harmonic octaves 109 | (\f -> noise3D p (x * f / l) (y * f / l) (z * f / l)) 110 | 111 | getSimplexHeight :: Simplex -> GLfloat -> GLfloat -> GLfloat 112 | getSimplexHeight (Simplex _ _ _ _ octaves wavelength intensity permutation) x z = 113 | intensity * realToFrac 114 | (simplex3D permutation octaves (realToFrac wavelength) 115 | (realToFrac x) (realToFrac z) 0) 116 | 117 | -- | Generate a 2D list of the height returned by simplex 118 | -- for each coordinate. 119 | simplexNoise :: Int -> GLfloat -> Int -> GLfloat -> GLfloat -> IO [[GLfloat]] 120 | simplexNoise width spacing octaves wavelength intensity = do 121 | seed <- randomRIO (0, 100) 122 | let raw = map 123 | (\(x, y) -> intensity * realToFrac 124 | (simplex3D (perm seed) octaves (realToFrac wavelength) x y 0)) 125 | [(realToFrac x, realToFrac y) | 126 | x <- [0, spacing .. (fromIntegral $ width-1)], 127 | y <- [0, spacing .. (fromIntegral $ width-1)]] 128 | return (splitInterval raw width `using` parChunk (width-1)) 129 | 130 | splitInterval :: [a] -> Int -> [[a]] 131 | splitInterval xs i 132 | | not $ null xs = 133 | let (ret, rest) = splitAt i xs 134 | in ret : splitInterval rest i 135 | | otherwise = [] 136 | 137 | parChunk :: Int -> Strategy [a] 138 | parChunk len = parListChunk (len `div` 4) r0 139 | -------------------------------------------------------------------------------- /src/Haskell-OpenGL.cb: -------------------------------------------------------------------------------- 1 | -- Initial Haskell-OpenGL.cabal generated by cabal init. For further 2 | -- documentation, see http://haskell.org/cabal/users-guide/ 3 | 4 | -- The name of the package. 5 | name: Haskell-OpenGL 6 | 7 | -- The package version. See the Haskell package versioning policy (PVP) 8 | -- for standards guiding when and how versions should be incremented. 9 | -- http://www.haskell.org/haskellwiki/Package_versioning_policy 10 | -- PVP summary: +-+------- breaking API changes 11 | -- | | +----- non-breaking API additions 12 | -- | | | +--- code changes with no API change 13 | version: 0.1.0.0 14 | 15 | -- A short (one-line) description of the package. 16 | synopsis: Project with haskell and OpenGL 17 | 18 | -- A longer description of the package. 19 | -- description: 20 | 21 | -- URL for the project homepage or repository. 22 | homepage: github.com/fiendfan1/Haskell-OpenGL 23 | 24 | -- The license under which the package is released. 25 | -- license: 26 | 27 | -- The file containing the license text. 28 | --license-file: LICENSE 29 | 30 | -- The package author(s). 31 | author: fiendfan1 32 | 33 | -- An email address to which users can send suggestions, bug reports, and 34 | -- patches. 35 | maintainer: fiendfan1@yahoo.com 36 | 37 | -- A copyright notice. 38 | -- copyright: 39 | 40 | category: Game 41 | 42 | build-type: Simple 43 | 44 | -- Extra files to be distributed with the package, such as examples or a 45 | -- README. 46 | -- extra-source-files: 47 | 48 | -- Constraint on the version of Cabal needed to build this package. 49 | cabal-version: >=1.10 50 | 51 | 52 | executable Haskell-OpenGL 53 | -- .hs or .lhs file containing the Main module. 54 | main-is: Main.hs 55 | 56 | -- Modules included in this executable, other than Main. 57 | -- other-modules: 58 | 59 | -- LANGUAGE extensions used by modules in this package. 60 | other-extensions: MultiParamTypeClasses, FlexibleInstances, OverlappingInstances, FlexibleContexts, TypeSynonymInstances, OverloadedStrings, RecursiveDo, NoMonomorphismRestriction, TypeFamilies, GeneralizedNewtypeDeriving, DataKinds, TypeOperators, ConstraintKinds, TemplateHaskell 61 | 62 | -- Other library packages from which modules are imported. 63 | build-depends: 64 | base >=4.7 && <4.8, 65 | mtl >=2.1 && <2.2, 66 | GLFW-b >=1.4 && <1.5, 67 | filepath >=1.3 && <1.4, 68 | OpenGLRaw >=1.4 && <1.5, 69 | dlist >=0.7 && <0.8, 70 | OpenGL >=2.9 && <2.10, 71 | split >=0.2 && <0.3, 72 | deepseq >=1.3 && <1.4, 73 | bytestring >=0.10 && <0.11, 74 | directory >=1.2 && <1.3, 75 | containers >=0.5 && <0.6, 76 | attoparsec >=0.12 && <0.13, 77 | binary >=0.7 && <0.8, 78 | parallel >=3.2 && <3.3, 79 | vector >=0.10 && <0.11, 80 | JuicyPixels >=3.1 && <3.2, 81 | data-default >=0.5 && <0.6, 82 | time >=1.4 && <1.5, 83 | transformers >=0.3 && <0.4, 84 | netwire >=5.0 && <5.1, 85 | elerea >=2.7 && <2.8, 86 | random-shuffle >=0.0 && <0.1, 87 | random >=1.0 && <1.1, 88 | fclabels >=2.0 && <2.1, 89 | vinyl >=0.3 && <0.4, 90 | Vec >=1.0.1 && <1.2 91 | 92 | -- Directories containing source files. 93 | -- hs-source-dirs: 94 | 95 | -- Base language which the package is written in. 96 | default-language: Haskell2010 97 | 98 | -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | module Main where 3 | 4 | import Control.Monad.State (unless, execStateT) 5 | import Data.Vec ((:.)(..), Vec2) 6 | 7 | import qualified Graphics.UI.GLFW as GLFW 8 | import Graphics.Rendering.OpenGL.Raw (GLfloat) 9 | 10 | import Engine.Core.Types ( 11 | World(..), WorldState(..), 12 | Input(..), Player(..), GameIO(..), 13 | worldEntities, gameIoState) 14 | 15 | import Engine.Core.World (getWorldTime, setWorldPlayer) 16 | import Engine.Object.Player (resetPlayerInput) 17 | import Engine.Core.WorldCreator (createWorld, defaultSettings) 18 | import Engine.Graphics.Primitive (FBO(..), stepUniverse, 19 | updateUniverseGlobal) 20 | 21 | main :: IO () 22 | main = do 23 | -- Create default world. 24 | world <- createWorld defaultSettings 25 | 26 | let win = stateWindow $ worldState world 27 | 28 | -- Make cursor Hidden. 29 | GLFW.setCursorInputMode win GLFW.CursorInputMode'Disabled 30 | 31 | --fbo <- makeFramebuffer (800, 600) 32 | let fbo = undefined 33 | 34 | loop win fbo world 35 | where 36 | loop win fbo world = do 37 | world' <- updateStepComplete win fbo world 38 | shouldClose <- GLFW.windowShouldClose win 39 | unless shouldClose $ 40 | loop win fbo world' 41 | 42 | updateStepComplete :: GLFW.Window -> FBO -> World t -> IO (World t) 43 | updateStepComplete win _fbo world = do 44 | let wState = worldState world 45 | 46 | -- Set cursor as hidden or visible. 47 | GLFW.setCursorInputMode win $ if statePaused wState 48 | then GLFW.CursorInputMode'Normal 49 | else GLFW.CursorInputMode'Disabled 50 | 51 | -- Update the world time and delta. 52 | worldTime <- getWorldTime 53 | let delta = worldTime - stateTime wState 54 | newState = wState{ 55 | stateTime = worldTime, stateDelta = delta} 56 | 57 | -- Update player input. 58 | player <- updatePlayerInput win $ worldPlayer world 59 | 60 | --print $ playerRotation player 61 | --putStrLn $ "pos: " ++ show (playerPosition player) 62 | 63 | -- Update player 64 | let worldWithPlayer = world{worldPlayer = player, worldState = newState} 65 | updatedWorld <- 66 | execStateT (gameIoState $ playerUpdate player) worldWithPlayer 67 | let updatedWorldWithUpdatedPlayer = 68 | setWorldPlayer (resetPlayerInput $ worldPlayer updatedWorld) 69 | updatedWorld 70 | 71 | let universe = updateUniverseGlobal 72 | (map (\x -> (updatedWorldWithUpdatedPlayer, x)) $ 73 | worldEntities updatedWorldWithUpdatedPlayer) 74 | $ worldShaderUniverse updatedWorldWithUpdatedPlayer 75 | universe' <- stepUniverse win universe 76 | 77 | -- Update the rest of the world. 78 | return $ updatedWorldWithUpdatedPlayer{ 79 | worldShaderUniverse = universe' 80 | } 81 | 82 | updatePlayerInput :: GLFW.Window -> Player t -> IO (Player t) 83 | updatePlayerInput win player = do 84 | let input = playerInput player 85 | newIn <- updateInput win input 86 | return $ player{ 87 | playerInput = newIn 88 | } 89 | 90 | updateInput :: GLFW.Window -> Input t -> IO (Input t) 91 | updateInput win input = do 92 | let mousePos = inputLastMousePos input 93 | newKeys <- loopThrough win $ inputKeys input 94 | newMousePos <- mouseUpdate win 95 | return input { 96 | inputKeys = newKeys, 97 | inputMouseDelta = newMousePos - mousePos 98 | } 99 | 100 | where 101 | loopThrough :: 102 | GLFW.Window -> 103 | [(GLFW.Key, GLFW.KeyState, GLFW.KeyState, World t -> World t)] -> 104 | IO [(GLFW.Key, GLFW.KeyState, GLFW.KeyState, World t -> World t)] 105 | loopThrough w ((key, desired, lastState, func) : others) = do 106 | returnedState <- GLFW.getKey w key 107 | 108 | let keyState 109 | | returnedState == GLFW.KeyState'Released = 110 | GLFW.KeyState'Released 111 | | returnedState == GLFW.KeyState'Pressed && 112 | (lastState == GLFW.KeyState'Pressed || 113 | lastState == GLFW.KeyState'Repeating) = 114 | GLFW.KeyState'Repeating 115 | | otherwise = GLFW.KeyState'Pressed 116 | 117 | let curVal = (key, desired, keyState, func) 118 | restVal <- loopThrough win others 119 | return $ curVal : restVal 120 | loopThrough _ [] = return [] 121 | 122 | mouseUpdate :: GLFW.Window -> IO (Vec2 GLfloat) 123 | mouseUpdate w = do 124 | (x, y) <- GLFW.getCursorPos w 125 | return $ realToFrac x :. realToFrac y 126 | -------------------------------------------------------------------------------- /src/Main.trace: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredloomis/Haskell-OpenGL/5c7363bbc07c5064e49b608d689cda2cab99f3eb/src/Main.trace -------------------------------------------------------------------------------- /src/Setup.hs: -------------------------------------------------------------------------------- 1 | module Setup where 2 | --------------------------------------------------------------------------------