added stuff for sun

4 files changed, 68 insertions, 0 deletions

diff --git a/Graphics/Glyph/BufferBuilder.hs b/Graphics/Glyph/BufferBuilder.hs
index 809312e..43447a1 100644
--- a/Graphics/Glyph/BufferBuilder.hs
+++ b/Graphics/Glyph/BufferBuilder.hs
@@ -35,6 +35,39 @@ nelem (Plot _ _ _ l) = l
 sizeofGLfloat :: Int
 sizeofGLfloat = 4
 
+simpleCube :: Num a => [(a,a,a)]
+simpleCube = trianglesFromQuads [
+      (-1, 1,-1)
+    , ( 1, 1,-1)
+    , ( 1,-1,-1)
+    , (-1,-1,-1)
+
+    , (-1, 1, 1)
+    , ( 1, 1, 1)
+    , ( 1,-1, 1)
+    , (-1,-1, 1)
+
+    , (-1, 1, 1)
+    , ( 1, 1, 1)
+    , ( 1, 1,-1)
+    , (-1, 1,-1)
+
+    , (-1,-1, 1)
+    , ( 1,-1, 1)
+    , ( 1,-1,-1)
+    , (-1,-1,-1)
+
+    , (-1,-1, 1)
+    , (-1, 1, 1)
+    , (-1, 1,-1)
+    , (-1,-1,-1)
+
+    , ( 1,-1, 1)
+    , ( 1, 1, 1)
+    , ( 1, 1,-1)
+    , ( 1,-1,-1)
+    ]
+
 class Monad a => IsModelBuilder b a where
     plotVertex3 :: b -> b -> b -> a ()
     plotNormal  :: b -> b -> b -> a ()
diff --git a/Graphics/Glyph/GLMath.hs b/Graphics/Glyph/GLMath.hs
index 7b454e2..cd0fd53 100644
--- a/Graphics/Glyph/GLMath.hs
+++ b/Graphics/Glyph/GLMath.hs
@@ -92,6 +92,12 @@ module Graphics.Glyph.GLMath where
                        sz, uz, -fz, 0,
                        -(s<.>e) , -(u'<.>e),  (f<.>e),  1 )
 
+    orthoMatrix :: GLfloat -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> Mat4 GLfloat
+    orthoMatrix top bot right left near far =
+        Matrix4 (2 / (right-left), 0, 0, - (right + left) / (right - left),
+                 0, 2 / (top-bot), 0, - (top+bot) / (top-bot),
+                 0, 0, -2 / (far-near), - (far+near) / (far - near),
+                 0, 0, 0, 1)
     perspectiveMatrix :: GLfloat -> GLfloat -> GLfloat -> GLfloat -> Mat4 GLfloat
     {- as close to copied from glm as possible -}
     perspectiveMatrix fov asp zn zf =
diff --git a/Graphics/Glyph/Shaders.hs b/Graphics/Glyph/Shaders.hs
index 296e4a8..99a0cfd 100644
--- a/Graphics/Glyph/Shaders.hs
+++ b/Graphics/Glyph/Shaders.hs
@@ -27,6 +27,9 @@ instance IsShaderSource BSL.ByteString where
     loadShader typ = loadShader typ . toStrict
         where toStrict = BS.concat . BSL.toChunks
 
+noShader :: Maybe String
+noShader = Nothing
+
 loadShaderBS :: String -> ShaderType -> BS.ByteString -> IO (String, Maybe Shader)
 loadShaderBS ctx typ src = do
     shader <- createShader typ
diff --git a/Graphics/SDL/SDLHelp.hs b/Graphics/SDL/SDLHelp.hs
index 8b09484..75806b2 100644
--- a/Graphics/SDL/SDLHelp.hs
+++ b/Graphics/SDL/SDLHelp.hs
@@ -21,6 +21,11 @@ data TextureData = TextureData {
     textureSize :: (Int,Int),
     textureObject :: TextureObject } deriving Show
 
+data TextureData3D = TextureData3D {
+    textureSize3D :: (Int,Int,Int),
+    textureObject3D :: TextureObject } deriving Show
+
+
 bindSurfaceToTexture :: SDL.Surface -> TextureObject -> IO TextureData
 bindSurfaceToTexture surf to = do
     textureBinding Texture2D $= Just to
@@ -35,9 +40,23 @@ bindSurfaceToTexture surf to = do
           h :: (Integral a) => SDL.Surface -> a
           h = fromIntegral . surfaceGetHeight
 
+textureFromPointer3D :: Ptr Word8 -> (Int,Int,Int) -> TextureObject -> IO TextureData3D
+textureFromPointer3D ptr (w,h,d) to = do
+        textureBinding Texture3D $= Just to
+        glTexImage3D gl_TEXTURE_3D 0 3 (f w) (f h) (f d) 0 gl_RGB gl_UNSIGNED_BYTE ptr
+        return $ TextureData3D (w,h,d) to
+    where f = fromIntegral
+
 textureFromSurface :: SDL.Surface -> IO TextureData
 textureFromSurface surf = makeTexture >>= (bindSurfaceToTexture surf >=> return)
 
+makeTexture3D :: IO TextureObject
+makeTexture3D = do
+    texobj <- liftM head $ genObjectNames 1
+    textureBinding Texture3D $= Just texobj
+    textureFilter Texture3D $= ((Linear', Nothing), Linear')
+    return texobj
+
 makeTexture :: IO TextureObject
 makeTexture = do
     texobj <- liftM head $ genObjectNames 1
@@ -124,3 +143,10 @@ setupTexturing (TextureData _ to) tu unit = do
     activeTexture $= TextureUnit (fromIntegral unit)
     textureBinding Texture2D $= Just to
     uniform tu $= Index1 (fromIntegral unit::GLint)
+
+setupTexturing3D :: TextureData3D -> UniformLocation -> Int -> IO ()
+setupTexturing3D (TextureData3D _ to) tu unit = do
+    texture Texture3D $= Enabled
+    activeTexture $= TextureUnit (fromIntegral unit)
+    textureBinding Texture3D $= Just to
+    uniform tu $= Index1 (fromIntegral unit::GLint)