Michelangelo (empty) → 0.1.0.0

raw patch · 10 files changed

+823/−0 lines, 10 filesdep +GLUtildep +OpenGLdep +OpenGLRaw

Dependencies added: GLUtil, OpenGL, OpenGLRaw, WaveFront, base, bytestring, containers, lens, linear

Files

LICENSE.md +20/−0
Michelangelo.cabal +75/−0
src/Graphics/Michelangelo/Camera.hs +33/−0
src/Graphics/Michelangelo/Entity.hs +41/−0
src/Graphics/Michelangelo/Mesh.hs +156/−0
src/Graphics/Michelangelo/Scene.hs +45/−0
src/Graphics/Michelangelo/Shaders.hs +256/−0
src/Graphics/Michelangelo/Shapes.hs +33/−0
src/Graphics/Michelangelo/Transformations.hs +59/−0
src/Graphics/Michelangelo/Utils.hs +105/−0

+ LICENSE.md view

@@ -0,0 +1,20 @@+Copyright (c) 2015 Jonatan H Sundqvist
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ Michelangelo.cabal view

@@ -0,0 +1,75 @@+-- Initial Michelangelo.cabal generated by cabal init.  For further
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+-- The name of the package.
+name:                Michelangelo
+
+-- The package version.  See the Haskell package versioning policy (PVP)
+-- for standards guiding when and how versions should be incremented.
+-- http://www.haskell.org/haskellwiki/Package_versioning_policy
+-- PVP summary:      +-+------- breaking API changes
+--                   | | +----- non-breaking API additions
+--                   | | | +--- code changes with no API change
+version:             0.1.0.0
+
+-- A short (one-line) description of the package.
+synopsis:            OpenGL for dummies
+
+-- A longer description of the package.
+-- description:
+
+-- The license under which the package is released.
+license:             MIT
+
+-- The file containing the license text.
+license-file:        LICENSE.md
+
+-- The package author(s).
+author:              Jonatan H Sundqvist
+
+-- An email address to which users can send suggestions, bug reports, and
+-- patches.
+maintainer:          jonatanhsundqvist@gmail.com
+
+-- A copyright notice.
+-- copyright:
+
+category:            Graphics
+
+build-type:          Simple
+
+-- Extra files to be distributed with the package, such as examples or a
+-- README.
+-- extra-source-files:
+
+-- Constraint on the version of Cabal needed to build this package.
+cabal-version:       >=1.10
+
+
+library
+  -- Modules exported by the library.
+  exposed-modules:     Graphics.Michelangelo.Utils, Graphics.Michelangelo.Transformations, Graphics.Michelangelo.Shapes, Graphics.Michelangelo.Shaders,
+                       Graphics.Michelangelo.Scene, Graphics.Michelangelo.Mesh,            Graphics.Michelangelo.Entity, Graphics.Michelangelo.Camera
+
+  -- Modules included in this library but not exported.
+  -- other-modules:
+
+  -- LANGUAGE extensions used by modules in this package.
+  other-extensions:    TypeSynonymInstances, FlexibleInstances
+
+  -- Other library packages from which modules are imported.
+  build-depends:       base <= 4.8.1.0,
+                       lens <= 4.13.0.0,
+                       bytestring,
+                       linear,
+                       OpenGL,
+                       GLUtil,
+                       OpenGLRaw,
+                       containers,
+                       WaveFront
+
+  -- Directories containing source files.
+  hs-source-dirs:      src
+
+  -- Base language which the package is written in.
+  default-language:    Haskell2010

+ src/Graphics/Michelangelo/Camera.hs view

@@ -0,0 +1,33 @@+-- |
+-- Module      : Graphics.Michelangelo.Camera
+-- Description :
+-- Copyright   : (c) Jonatan H Sundqvist, 2015
+-- License     : MIT
+-- Maintainer  : Jonatan H Sundqvist
+-- Stability   : experimental|stable
+-- Portability : POSIX (not sure)
+--
+
+-- Created July 30 2015
+
+-- TODO | -
+--        -
+
+-- SPEC | -
+--        -
+
+
+
+module Graphics.Michelangelo.Camera where
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- We'll need these
+--------------------------------------------------------------------------------------------------------------------------------------------
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Functions
+--------------------------------------------------------------------------------------------------------------------------------------------

+ src/Graphics/Michelangelo/Entity.hs view

@@ -0,0 +1,41 @@+-- |
+-- Module      : Graphics.Michelangelo.Entity
+-- Description :
+-- Copyright   : (c) Jonatan H Sundqvist, 2015
+-- License     : MIT
+-- Maintainer  : Jonatan H Sundqvist
+-- Stability   : experimental|stable
+-- Portability : POSIX (not sure)
+--
+
+-- Created July 30 2015
+
+-- TODO | -
+--        -
+
+-- SPEC | -
+--        -
+
+
+
+module Graphics.Michelangelo.Entity where
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- We'll need these
+--------------------------------------------------------------------------------------------------------------------------------------------
+import Control.Lens --
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Types
+--------------------------------------------------------------------------------------------------------------------------------------------
+data Entity = Entity {}
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Functions
+--------------------------------------------------------------------------------------------------------------------------------------------

+ src/Graphics/Michelangelo/Mesh.hs view

@@ -0,0 +1,156 @@+-- |
+-- Module      : Graphics.Michelangelo.Mesh
+-- Description :
+-- Copyright   : (c) Jonatan H Sundqvist, 2015
+-- License     : MIT
+-- Maintainer  : Jonatan H Sundqvist
+-- Stability   : experimental|stable
+-- Portability : POSIX (not sure)
+--
+
+-- Created July 29 2015
+
+-- TODO | - Index buffers
+--        - Use lenses (?)
+--        - Move shader-specific stuff to Shader module
+
+-- SPEC | -
+--        -
+
+
+
+module Graphics.Michelangelo.Mesh where
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- We'll need these
+--------------------------------------------------------------------------------------------------------------------------------------------
+import Linear.Matrix --
+import Linear.V3     --
+
+import qualified Data.Map.Strict as Map --
+
+import Control.Monad (liftM2, liftM) --
+import Control.Applicative ((<*>))   --
+
+import           Graphics.Rendering.OpenGL (($=))                        --
+import qualified Graphics.Rendering.OpenGL            as GL              --
+import qualified Graphics.Rendering.OpenGL.GL.Shaders as GLS             --
+import qualified Graphics.Rendering.OpenGL.GL.Shaders.Uniform as Uniform --
+import           Graphics.GLUtil.JuicyTextures                           --
+
+import qualified Graphics.GLUtil as GLUtil --
+
+import Graphics.WaveFront.Load       as WFL   --
+import Graphics.WaveFront.Parsers    as WF    --
+
+import Graphics.Michelangelo.Shaders as Shade --
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Types
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- |
+-- TODO: Include shader program, attributes, uniforms, etc. (?)
+-- TODO: Store render function (?)
+-- TODO: Restructure (?)
+-- TODO: Metadata (?)
+data Mesh = Mesh { texture    :: Maybe GL.TextureObject,   -- TODO: Allow more than one texture (?)
+                   primitive  :: GL.PrimitiveMode,         --
+                   attributes :: Map.Map String Attribute, --
+                   uniforms   :: Map.Map String (GL.UniformLocation, UniformValue),   --
+                   shader     :: GL.Program,               --
+                   prepare    :: Maybe (Mesh -> IO ()),    -- Optional rendering setup function
+                   centre     :: V3 Float,                 --
+                   bounds     :: WF.BoundingBox Float,     --
+                   size       :: Int                       --
+                 } --deriving (Show)
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Functions
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- |
+-- renderMesh :: Mesh -> IO ()
+renderMesh :: Mesh -> IO ()
+renderMesh mesh = do
+	GLUtil.printErrorMsg "Entering renderMesh"
+	-- return $ (prepare mesh) <*> Just mesh
+	case prepare mesh of
+		Just action -> action mesh
+		_           -> return ()
+	GLUtil.printErrorMsg "Shader program set"
+
+	withAttributes mesh $ \ _ -> do
+		GLUtil.printErrorMsg "Entering withAttributes action"
+		Shade.setShaderUniforms (shader mesh) (Map.elems $ uniforms mesh) --
+		GLUtil.printErrorMsg "Uniforms set"
+		GL.drawArrays (primitive mesh) 0 (fromIntegral $ size mesh)       --
+		GLUtil.printErrorMsg "Arrays drawn"
+
+
+-- |
+-- uniform :: GL.UniformComponent u => GL.UniformLocation -> u -> IO ()
+-- uniform loc u = GL.uniform loc u
+
+
+-- |
+-- TODO: Are there any attributes that are NOT buffers (?)
+bufferAttribute :: GL.BufferObject -> GL.AttribLocation -> Int -> IO ()
+bufferAttribute buffer loc count = do
+	GL.vertexAttribArray loc     $= GL.Enabled                                                                            --
+	GL.bindBuffer GL.ArrayBuffer $= Just buffer                                                                           --
+	GL.vertexAttribPointer loc   $= (GL.ToFloat, GL.VertexArrayDescriptor (fromIntegral count) GL.Float 0 GLUtil.offset0) --
+
+
+-- |
+attribute :: GL.Program -> String -> GL.BufferObject -> Int -> IO ()
+attribute program name buffer count = do
+	loc <- GL.get $ GL.attribLocation program name
+	bufferAttribute buffer loc count
+
+
+-- |
+bindAttributes :: Mesh -> IO ()
+bindAttributes mesh = do
+	-- GLS.currentProgram $= Just (shader mesh)
+	Map.foldrWithKey reduce nothing (attributes mesh) -- TODO: Use Traversable instead (?)
+	where
+	   reduce key (loc, buff, count) acc = acc >> bufferAttribute buff loc count --
+	   nothing                           = return ()                             --
+
+
+-- |
+unbindAttributes :: Mesh -> IO ()
+unbindAttributes mesh = Map.foldrWithKey reduce nothing (attributes mesh)
+	where
+	   reduce key (loc, buff, count) acc = acc >> (GL.vertexAttribArray loc $= GL.Enabled) --
+	   nothing                           = return ()                                       --
+
+
+-- |
+withAttributes :: Mesh -> (Mesh -> IO ()) -> IO ()
+withAttributes mesh action = do
+	bindAttributes mesh
+	action mesh
+	unbindAttributes mesh
+
+
+-- |
+-- withUniforms :: Mesh -> IO ()
+
+
+-- |
+{-
+prepareTextured :: state -> IO ()
+prepareTextured _ = do
+	maybe
+	  (return ())
+	  (\(tex, coords) -> do
+	  	GL.bindBuffer GL.ArrayBuffer $= Just coords
+	  	GL.vertexAttribPointer (texattrib) $= (GL.ToFloat, GL.VertexArrayDescriptor 2 GL.Float 0 GLUtil.offset0))
+	  (liftM2 (,) (texture mesh) (texcoords mesh))
+-}

+ src/Graphics/Michelangelo/Scene.hs view

@@ -0,0 +1,45 @@+-- |
+-- Module      : Graphics.Michelangelo.Scene
+-- Description : descr
+-- Copyright   : (c) Jonatan H Sundqvist, 2015
+-- License     : MIT
+-- Maintainer  : Jonatan H Sundqvist
+-- Stability   : experimental|stable
+-- Portability : POSIX (not sure)
+--
+
+-- Created August 2 2015
+
+-- TODO | -
+--        -
+
+-- SPEC | -
+--        -
+
+
+
+module Graphics.Michelangelo.Scene where
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- We'll need these
+--------------------------------------------------------------------------------------------------------------------------------------------
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+import Graphics.Michelangelo.Camera
+import Graphics.Michelangelo.Entity
+import Graphics.Michelangelo.Mesh
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Types
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- data Scene = Scene { _camera :: Camera, _entities :: [Entity],  }
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Functions
+--------------------------------------------------------------------------------------------------------------------------------------------

+ src/Graphics/Michelangelo/Shaders.hs view

@@ -0,0 +1,256 @@+-- |
+-- Module      : Graphics.Michelangelo.Shaders
+-- Description : OpenGL shader utilities
+-- Copyright   : (c) Jonatan H Sundqvist, 2015
+-- License     : MIT
+-- Maintainer  : Jonatan H Sundqvist
+-- Stability   : experimental|stable
+-- Portability : POSIX (not sure)
+--
+
+-- Created July 27 2015
+
+-- TODO | -
+--        -
+
+-- SPEC | -
+--        -
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Pragmas
+--------------------------------------------------------------------------------------------------------------------------------------------
+{-# LANGUAGE TypeSynonymInstances #-} --
+{-# LANGUAGE FlexibleInstances    #-} --
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- API
+--------------------------------------------------------------------------------------------------------------------------------------------
+module Graphics.Michelangelo.Shaders where
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- We'll need these
+--------------------------------------------------------------------------------------------------------------------------------------------
+import qualified Graphics.Rendering.OpenGL as GL
+import Graphics.Rendering.OpenGL (($=))
+
+-- import Graphics.Rendering.OpenGL.GL.Shaders.ShaderObjects
+import Graphics.Rendering.OpenGL.GL.Shaders
+import Graphics.GLUtil hiding (loadShaderProgram)
+
+import qualified Graphics.Rendering.OpenGL.Raw as GLRaw
+
+import Linear.Matrix
+import Linear.Projection
+import Linear.Quaternion
+import Linear.V3
+import Linear.V4
+
+import           Foreign.Storable                 (Storable)
+import           Foreign.Ptr                      (castPtr, Ptr())
+import qualified Foreign.Marshal.Utils as Marshal (with)
+
+import qualified Data.Map as Map
+
+import Control.Lens
+import Control.Exception
+import Control.Monad (forM)
+
+import Text.Printf
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Types
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- |
+data ShaderProgram = ShaderProgram { _program    :: GL.Program,
+	                                   _attributes :: Map.Map String (GL.AttribLocation,  GL.VariableType),
+                                     _uniforms   :: Map.Map String (GL.UniformLocation, GL.VariableType)}
+
+
+-- |
+-- type Uniform   = (GL.UniformLocation, UniformValue)         --
+type Attribute = (GL.AttribLocation,  GL.BufferObject, Int) -- TODO: Are there any non-buffer attribute types, separate type (?)
+
+
+-- |
+-- TODO: Make polymorphic (?)
+-- TODO: Refactor
+-- TODO: Implement uniformv
+-- TODO: Find out how to read uniform value
+-- instance GL.UniformComponent a => GL.Uniform (M44 a) where
+instance GL.Uniform (M44 Float) where
+	uniform (GL.UniformLocation loc) = GL.makeStateVar (error "Not implemented") (\u -> Marshal.with (transpose u) (\ptr -> GLRaw.glUniformMatrix4fv loc 1 0 (castPtr (ptr :: Ptr (M44 Float)))))
+   -- uniformv loc count = uniform3v location count . (castPtr :: Ptr (Vertex3 b) -> Ptr b)
+
+
+instance GL.Uniform (Float) where
+	uniform (GL.UniformLocation loc) = GL.makeStateVar (error "Not implemented") (\f -> Marshal.with f (\ptr -> GLRaw.glUniform1fv loc 1 (castPtr (ptr :: Ptr (Float)))))
+   -- uniformv loc count = uniform3v location count . (castPtr :: Ptr (Vertex3 b) -> Ptr b)
+
+
+-- |
+instance GL.Uniform (Int) where
+	uniform (GL.UniformLocation loc) = GL.makeStateVar (error "Not implemented") (\i -> Marshal.with i (\ptr -> GLRaw.glUniform1iv loc 1 (castPtr (ptr :: Ptr (Int)))))
+   -- uniformv loc count = uniform3v location count . (castPtr :: Ptr (Vertex3 b) -> Ptr b)
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Functions
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- |
+-- TODO: Improve control flow
+-- TODO: Improve error checking (eg. which logs belong to which part, check errors at each stage?)
+-- TODO: Catch exceptions
+-- TODO: Program crashes when the source strings are empty
+-- TODO: Optional logging layer (?)
+-- TODO: Use Monad transformer to make 'bailing-out' easier (?)
+createShaderProgram :: String -> String -> IO (Either [String] GL.Program)
+createShaderProgram vsource psource = do
+	putStrLn "Creating shader program"
+	program <- GL.createProgram
+	vshader <- GL.createShader VertexShader
+	pshader <- GL.createShader FragmentShader
+
+	case (vsource, psource) of
+		("", _) -> return $ Left ["Empty vertex shader source"]
+		(_, "") -> return $ Left ["Empty pixel shader source"]
+		_       -> do
+			putStrLn "Setting vertex shader source"
+			shaderSourceBS vshader $= packUtf8 vsource
+
+			putStrLn "Compiling vertex shader"
+			compileShader vshader
+
+			putStrLn "Setting fragment shader source"
+			shaderSourceBS pshader $= packUtf8 psource
+			compileShader pshader
+
+			-- putStrLn "Compiling shaders..."
+
+			vstatus <- GL.get $ compileStatus vshader
+			printf "Vertex shader %s compiled successfully.\n" (if vstatus then "was" else "was not")
+			pstatus <- GL.get $ compileStatus pshader
+			printf "Vertex pixel %s compiled successfully.\n" (if pstatus then "was" else "was not")
+
+			if vstatus && pstatus
+				then do
+					putStrLn "Successfully compiled shaders. Linking program..."
+					mapM (GL.attachShader program) [vshader, pshader]
+
+					GL.linkProgram program
+					linked <- GL.get $ GL.linkStatus program
+					if linked
+						then return $ Right program
+						else mapM GL.get [GL.shaderInfoLog vshader, GL.shaderInfoLog pshader, GL.programInfoLog program] >>= return . Left
+				else mapM (GL.get . GL.shaderInfoLog) [vshader, pshader] >>= return . Left
+
+
+-- |
+-- TODO: Rename (?)
+-- TODO: Pass in uniforms by name or by location (?)
+setShaderUniforms :: GL.Program -> [(GL.UniformLocation, UniformValue)] -> IO ()
+setShaderUniforms theprogram theuniforms = do
+	-- Set uniforms
+	-- mapM ((>> printErrorMsg "Setting uniform") . uncurry uniform) theuniforms
+	-- TODO: Refactor
+	forM theuniforms $ \(loc, value) -> case value of
+		UMatrix44 mat -> uniform loc $= mat
+		UFloat    f   -> uniform loc $= f
+		UInt      i   -> uniform loc $= i
+		-- UVec vec -> uniform loc $= vec
+	return ()
+
+
+-- |
+loadShaderProgram :: String -> String -> IO (Either [String] GL.Program)
+loadShaderProgram vpath ppath = do
+	[vsource, psource] <- mapM readFile [vpath, ppath]
+	catch
+	  (createShaderProgram vsource psource)            --
+	  caught -- TODO: More elaborate exception message (?)
+	where
+	  caught :: IOException -> IO (Either [String] GL.Program)
+	  caught _ = return $ Left ["Unable to open file."]
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Uniforms
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- |
+-- TODO: Better naming conventions
+-- TOOD: All uniform types (matrices, vectors, scalars, variable length)
+data UniformValue = UMatrix44 (M44 Float) |
+                    UVec3     (V3 Float)  |
+                    UFloat     Float      |
+                    UInt       Int
+                    deriving (Show)
+
+
+-- |
+-- uniform :: GL.UniformLocation -> UniformValue -> IO ()
+-- uniform (GL.UniformLocation loc) (UMatrix44 mat) = Marshal.with mat $ \ptr -> GLRaw.glUniformMatrix4fv loc 1 0 (castPtr (ptr :: Ptr (M44 Float)))
+-- uniform (GL.UniformLocation loc) (UVec3     vec) = Marshal.with vec $ \ptr -> GLRaw.glUniform3fv       loc 1   (castPtr (ptr :: Ptr (V3 Float)))
+-- uniform (GL.UniformLocation loc) (UFloat    f)   = Marshal.with f   $ \ptr -> GLRaw.glUniform1fv       loc 1   (castPtr (ptr :: Ptr (Float)))
+-- uniform (GL.UniformLocation loc) (UInt      i)   = Marshal.with i   $ \ptr -> GLRaw.glUniform1iv       loc 1   (castPtr (ptr :: Ptr (Int)))
+
+
+-- TODO: Move instances to Instances or Uniform module (?)
+-- TODO: Transpose via OpenGL or Linear (?)
+
+-- |
+-- TODO: Better names (?)
+-- class UniformValue u where
+	-- setUniform :: (Storable u) => GL.GLint -> GL.GLsizei -> Ptr GL.GLfloat -> IO ()
+
+
+-- Scalars
+
+
+-- Vectors
+-- instance UniformValue (M44 Float) where
+	-- setUniform = GLRaw.glUniformMatrix3fv
+
+
+-- Matrices
+-- instance UniformValue (M22 Float) where
+	-- setUniform = GLRaw.glUniformMatrix2fv
+
+
+-- instance UniformValue (M33 Float) where
+	-- setUniform = GLRaw.glUniformMatrix3fv
+
+
+-- instance UniformValue (M44 Float) where
+	-- setUniform = GLRaw.glUniformMatrix4fv
+
+-- glUniform1f :: GLint -> GLfloat -> IO ()
+-- glUniform2f :: GLint -> GLfloat -> GLfloat -> IO ()
+-- glUniform3f :: GLint -> GLfloat -> GLfloat -> GLfloat -> IO ()
+-- glUniform4f :: GLint -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ()
+
+-- glUniform1i :: GLint -> GLint -> IO ()
+-- glUniform2i :: GLint -> GLint -> GLint -> IO ()
+-- glUniform3i :: GLint -> GLint -> GLint -> GLint -> IO ()
+-- glUniform4i :: GLint -> GLint -> GLint -> GLint -> GLint -> IO ()
+
+-- glUniform1fv :: GLint -> GLsizei -> Ptr GLfloat -> IO () --
+-- glUniform2fv :: GLint -> GLsizei -> Ptr GLfloat -> IO () --
+-- glUniform3fv :: GLint -> GLsizei -> Ptr GLfloat -> IO () --
+-- glUniform4fv :: GLint -> GLsizei -> Ptr GLfloat -> IO () --
+-- glUniform1iv :: GLint -> GLsizei -> Ptr GLint   -> IO () --
+-- glUniform2iv :: GLint -> GLsizei -> Ptr GLint   -> IO () --
+-- glUniform3iv :: GLint -> GLsizei -> Ptr GLint   -> IO () --
+-- glUniform4iv :: GLint -> GLsizei -> Ptr GLint   -> IO () --
+
+-- glUniformMatrix2fv :: GLint -> GLsizei -> GLboolean -> Ptr GLfloat -> IO () -- (✓)
+-- glUniformMatrix3fv :: GLint -> GLsizei -> GLboolean -> Ptr GLfloat -> IO () -- (✓)
+-- glUniformMatrix4fv :: GLint -> GLsizei -> GLboolean -> Ptr GLfloat -> IO () -- (✓)

+ src/Graphics/Michelangelo/Shapes.hs view

@@ -0,0 +1,33 @@+-- |
+-- Module      : Graphics.Michelangelo.Shapes
+-- Description : descr
+-- Copyright   : (c) Jonatan H Sundqvist, 2015
+-- License     : MIT
+-- Maintainer  : Jonatan H Sundqvist
+-- Stability   : experimental|stable
+-- Portability : POSIX (not sure)
+--
+
+-- Created July 30 2015
+
+-- TODO | -
+--        -
+
+-- SPEC | -
+--        -
+
+
+
+module Graphics.Michelangelo.Shapes where
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- We'll need these
+--------------------------------------------------------------------------------------------------------------------------------------------
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Functions
+--------------------------------------------------------------------------------------------------------------------------------------------

+ src/Graphics/Michelangelo/Transformations.hs view

@@ -0,0 +1,59 @@+-- |
+-- Module      : Graphics.Michelangelo.Transformations
+-- Description : Matrix and quaternion operations
+-- Copyright   : (c) Jonatan H Sundqvist, 2015
+-- License     : MIT
+-- Maintainer  : Jonatan H Sundqvist
+-- Stability   : experimental|stable
+-- Portability : POSIX (not sure)
+--
+
+-- Created July 31 2015
+
+-- TODO | -
+--        -
+
+-- SPEC | -
+--        -
+
+
+
+module Graphics.Michelangelo.Transformations where
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- We'll need these
+--------------------------------------------------------------------------------------------------------------------------------------------
+import Linear.Matrix
+import Linear.V3
+import Linear.Quaternion
+import Linear.Epsilon
+import Linear.Projection
+
+-- import Control.Lens
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Types
+--------------------------------------------------------------------------------------------------------------------------------------------
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Functions
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- |
+rotateX :: (Floating n, Epsilon n) => n -> M44 n
+rotateX  = m33_to_m44 . fromQuaternion . axisAngle (V3 1 0 0)
+
+
+-- |
+rotateY :: (Floating n, Epsilon n) => n -> M44 n
+rotateY  = m33_to_m44 . fromQuaternion . axisAngle (V3 0 1 0)
+
+
+-- |
+rotateZ :: (Floating n, Epsilon n) => n -> M44 n
+rotateZ  = m33_to_m44 . fromQuaternion . axisAngle (V3 0 0 1)

+ src/Graphics/Michelangelo/Utils.hs view

@@ -0,0 +1,105 @@+-- |
+-- Module      : Graphics.Michelangelo.Utils
+-- Description : Utilities for doing 3D graphics with OpenGL
+-- Copyright   : (c) Jonatan H Sundqvist, 2015
+-- License     : MIT
+-- Maintainer  : Jonatan H Sundqvist
+-- Stability   : experimental|stable
+-- Portability : POSIX (not sure)
+--
+
+-- Created July 20 2015
+-- Adapted from http://hackage.haskell.org/package/scenegraph-0.1.0.1/docs/src/Graphics-SceneGraph-Textures.html#getAndCreateTextures
+
+-- TODO | -
+--        -
+
+-- SPEC | -
+--        -
+
+
+
+module Graphics.Michelangelo.Utils where
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- We'll need these
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- import Graphics.UI.GLUT
+-- import Graphics.SceneGraph.ReadImage (readImage)
+-- import Graphics.SceneGraph.TGA
+-- JuicyTextures, JuicyPixels
+-- import Codec.Picture
+-- import Control.Monad (when)
+-- import Foreign.Marshal.Alloc
+-- import Graphics.GLUtil.JuicyTextures
+import qualified Data.ByteString as BS
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Functions
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- |
+saveImage :: FilePath -> BS.ByteString -> IO ()
+saveImage fn image = BS.writeFile fn image
+
+
+-- |
+-- createTexture :: Size -> PixelData Int -> IO (Maybe TextureObject)
+-- createTexture (Size cx cy) pixels = do
+-- 	[tex] <- genObjectNames 1 --
+-- 	textureBinding Texture2D $= Just tex --
+-- 	build2DMipmaps Texture2D RGBA' (fromIntegral cx) (fromIntegral cy) pixels
+-- 	textureFilter Texture2D $= ((Linear', Just Nearest), Linear')
+-- 	textureFunction $= Modulate
+-- 	-- free ptr
+-- 	return $ Just tex
+
+
+-- |
+-- createTextures :: [(Size, PixelData Int)] -> IO [Maybe TextureObject]
+-- createTextures fn = return
+
+
+-- -- read a list of images and returns a list of textures
+-- -- all images are assumed to be in the TGA image format
+-- getAndCreateTextures :: [String] -> IO [Maybe TextureObject]
+-- getAndCreateTextures fileNames = do
+--    fileNamesExts <- return (map (++".tga") fileNames)
+--    texData <- mapM readImageC fileNamesExts
+--    texObjs <- mapM createTexture texData
+--    return texObjs
+
+
+-- -- read a single texture
+-- getAndCreateTexture :: String -> IO (Maybe TextureObject)
+-- getAndCreateTexture fileName = do
+--    texData <- readImageC (fileName++".tga")
+--    texObj <- createTexture texData
+--    return texObj
+
+
+-- -- read the image data
+-- readImageC :: String -> IO (Maybe (Size, PixelData Word8))
+-- readImageC path = catch (readTga path) (\err -> do
+--    print ("missing texture: "++path)
+--    return Nothing)
+
+
+-- -- creates the texture
+-- createTexture :: (Maybe (Size, PixelData a)) -> IO (Maybe TextureObject)
+-- createTexture (Just ((Size x y), pixels@(PixelData t1 t2 ptr))) = do
+--    [texName] <- genObjectNames 1  -- generate our texture.
+--    --rowAlignment  Unpack $= 1
+--    textureBinding Texture2D $= Just texName  -- make our new texture the current texture.
+--    --generateMipmap Texture2D $= Enabled
+--    build2DMipmaps Texture2D RGBA' (fromIntegral x) (fromIntegral y) pixels
+--    textureFilter  Texture2D $= ((Linear', Just Nearest), Linear')
+--    --textureWrapMode Texture2D S $= (Repeated, Repeat)
+--    --textureWrapMode Texture2D T $= (Repeated, Repeat)
+--    textureFunction $= Modulate
+--    free ptr
+--    return (Just texName)
+-- createTexture Nothing = return Nothing