added stuff for sun

9 files changed, 153 insertions, 11 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)
diff --git a/Resources.hs b/Resources.hs
index 6754742..79681ca 100644
--- a/Resources.hs
+++ b/Resources.hs
@@ -28,6 +28,8 @@ import Control.Monad
 import Data.Angle
 import Data.Function
 import Data.Setters
+import Data.Word
+import qualified Data.Array.Storable as SA
 import qualified Data.Sequence as Seq
 import Data.Sequence ((><),(|>),(<|))
 import qualified Data.Foldable as Fold
@@ -35,9 +37,11 @@ import Data.Maybe
 import Debug.Trace
 
 import Foreign.Marshal.Array
+import Foreign.Marshal.Alloc
 
 import System.Exit
 import System.FilePath
+import System.Random
 
 import Models
 import Debug.Trace
@@ -80,6 +84,7 @@ data ResourcesClosure = ResourcesClosure {
     , rcNormalMatrix  :: Mat3 GLfloat
     , rcGlobalAmbient :: Vec4 GLfloat
     , rcCameraPos :: CameraPosition
+    , rcCameraLocation :: Vec3 GLfloat
 }
 
 $(declareSetters ''Resources)
@@ -142,7 +147,7 @@ eventHandle event res = do
 
 displayHandle :: Resources -> IO Resources
 displayHandle resources = do
-    let cameraPos@(CameraPosition _ th ph) = rPosition resources
+    let cameraPos@(CameraPosition r th ph) = rPosition resources
     let lighty = ((/10) . fromIntegral . time) resources
     let logist c =  (1 / (1 + 2.71828**(-c*x))) * 0.9 + 0.1
             where x = sine $ Degrees (lighty)
@@ -168,6 +173,7 @@ displayHandle resources = do
                 (normalMatrix)
                 (Vec4 globalAmbient)
                 cameraPos
+                (Vec3 $ toEuclidian (r,th,ph))
                 in mapM_ (Prelude.$rc) $ routines resources
 
     SDL.glSwapBuffers
@@ -240,6 +246,40 @@ buildTerrainObject builder = do
             uniform (UniformLocation 7) $= rcNormalMatrix rc
             uniform (UniformLocation 8) $= rcGlobalAmbient rc
 
+cloudProgram :: IO (ResourcesClosure -> IO ())
+cloudProgram = do
+    let randarray ptr n stgen =
+            if n == 0 then return () else do
+                let (tmp,stgen') = next stgen
+                putStrLn $ "TMP: " ++! (tmp `mod` 256)
+                poke ptr (fromIntegral $ tmp `mod` 256)
+                randarray (advancePtr ptr 1) (n - 1) stgen'
+    let builder =
+            forM_ simpleCube $ \(x,y,z) -> do
+                bColor4 (x,y,z,0)
+                bVertex3 (x,y+20,z)
+    program <- loadProgramSafe' "shaders/clouds.vert" "shaders/clouds.frag" noShader
+
+    stgen <- newStdGen
+    array3D <- SA.newListArray ((0,0,0,0),(3,64,64,64)) (map (fromIntegral . (`mod`256)) $ (randoms stgen::[Int]))
+
+    SA.withStorableArray array3D $ \ptr3D -> do
+        density <- makeTexture3D >>= textureFromPointer3D ptr3D (64,64,64)
+
+        obj' <- newDefaultGlyphObjectWithClosure builder () $ \_ -> do
+                    currentProgram $= Just program
+        [mvMatU, pMatU, densityU, globalAmbientU,lightposU] <- mapM (get . uniformLocation program)
+            ["mvMatrix","pMatrix","density","globalAmbient","lightpos"]
+        return $ \rc -> do
+            draw $ prepare obj' $ \_ -> do
+                cullFace $= Nothing
+                uniform mvMatU $= rcMVMatrix rc
+                uniform pMatU $= rcPMatrix rc
+                uniform globalAmbientU $= rcGlobalAmbient rc
+                uniform lightposU $= rcLightPos rc
+                setupTexturing3D density densityU 0
+            
+
 buildForestObject :: Seq.Seq GLfloat -> String -> String -> IO (ResourcesClosure -> IO ())
 buildForestObject seq obj tex =
     if Seq.null seq then return ((const.return) ()) else do
@@ -252,7 +292,7 @@ buildForestObject seq obj tex =
     let !treeF = trace "build tree" $ (basicBuildObject file :: BuilderM GLfloat ())
 
     forestProg <- loadProgramSafe' 
-        "shaders/forest.vert" "shaders/forest.frag" (Nothing::Maybe String)
+        "shaders/forest.vert" "shaders/forest.frag" noShader
 
     woodTexture <- load tex >>= textureFromSurface
     let (dx,dy) = (mapT2 $ (1/).fromIntegral) (textureSize woodTexture)
@@ -297,7 +337,7 @@ buildWaterObject :: BuilderM GLfloat a -> IO (ResourcesClosure -> IO ())
 buildWaterObject builder = do
     waterProg <- loadProgramFullSafe' 
          (Just ("shaders/water.tcs","shaders/water.tes"))
-         (Nothing::Maybe String) "shaders/water.vert" "shaders/water.frag"
+         noShader "shaders/water.vert" "shaders/water.frag"
     waterTexture <- load "textures/water.jpg" >>= textureFromSurface
     skyTexture <- load "textures/skybox_top.png" >>= textureFromSurface
     skyNightTexture <- load "textures/skybox_top_night.png" >>= textureFromSurface
@@ -341,6 +381,7 @@ makeResources surf builder forestB jungleB water = do
             buildForestObject forestB "tree.obj" "textures/wood_low.png",
             buildForestObject jungleB "jungletree.obj" "textures/jungle_tree.png",
             buildWaterObject water
+            -- cloudProgram
          ]
     Resources 
         <$> pure surf
@@ -422,6 +463,8 @@ skyboxObject = do
     glTexParameteri gl_TEXTURE_2D gl_TEXTURE_WRAP_T $ fromIntegral gl_CLAMP_TO_EDGE
     textureTopNight <- load "textures/skybox_top_night.png" >>= textureFromSurface
 
+    [lightposU] <- mapM (get . uniformLocation prog) 
+                    ["lightpos"]
     topObj <- newDefaultGlyphObjectWithClosure (skyboxTop 1) () $ \_ -> do
         setupTexturing textureTop texLoc 2
         setupTexturing textureTopNight texLocNight 3
@@ -440,6 +483,7 @@ skyboxObject = do
         draw $ prepare obj' $ \this -> do
             let (matLoc,pmatLoc) = getResources this
             let (CameraPosition _ th ph) = rcCameraPos rc
+            uniform lightposU $= rcLightPos rc
             uniform pmatLoc $= rcPMatrix rc
             uniform matLoc $= buildMVMatrix (CameraPosition (Vec3 (0,0,0)) th ph)
             uniform (UniformLocation 1) $= rcGlobalAmbient rc
diff --git a/shaders/sky.frag b/shaders/sky.frag
index a2c2ecd..c81c8b0 100644
--- a/shaders/sky.frag
+++ b/shaders/sky.frag
@@ -5,13 +5,25 @@
 layout(location = 0) out vec4 frag_color ;
 layout(location = 1) uniform vec4 globalAmbient ;
 
+uniform vec4 lightpos ;
+
 uniform sampler2D texture ;
 uniform sampler2D night_tex ;
+
 in vec2 texcoord;
+in vec4 position ;
 
-void main() {
+void main() {  
+    // the sun
+    
+    vec3 lighttofrag = vec3(position*10000000 - lightpos) ;
+    vec3 lighttocamera = vec3(lightpos) ;
+    vec4 mul = vec4(vec3( sqrt(0.001 / (1 - dot(normalize(lighttocamera), normalize(lighttofrag))))), 1) ;
+    mul *= vec4(1.0,0.95,0.8,1.0) ;
     frag_color = 
         mix(texture2D(night_tex,texcoord) * (1-globalAmbient.a),
             texture2D(texture,texcoord) * vec4(normalize(globalAmbient.xyz),1),
             (globalAmbient.a + 1) / 2) ;
+    frag_color += mul ;
+
 }
diff --git a/shaders/sky.vert b/shaders/sky.vert
index 87d919b..5609bec 100644
--- a/shaders/sky.vert
+++ b/shaders/sky.vert
@@ -11,8 +11,9 @@ uniform mat4 mvMatrix ;
 uniform mat4 pjMatrix ;
 
 out vec2 texcoord ;
+out vec4 position ;
 
 void main() {
-    gl_Position = pjMatrix * mvMatrix * vec4(in_position,1.0);
+    gl_Position = pjMatrix * (position = mvMatrix * vec4(in_position,1.0));
     texcoord = in_texcoord ;
 }
diff --git a/shaders/water.frag b/shaders/water.frag
index 2d6b7da..6c2aa2b 100644
--- a/shaders/water.frag
+++ b/shaders/water.frag
@@ -6,10 +6,12 @@ layout(location = 0) out vec4 frag_color ;
 layout(location = 8) uniform vec4 lightPos ;
 layout(location = 9) uniform float time ;
 layout(location = 10) uniform vec4 globalAmbient ;
+layout(location = 5) uniform mat4 mvMatrix ;
 
- uniform sampler2D texture ;
- uniform sampler2D skytex ;
- uniform sampler2D skynight ;
+uniform sampler2D texture ;
+uniform sampler2D skytex ;
+uniform sampler2D skynight ;
+uniform vec4 lightpos ;
 
 in vec3 normal ;
 in vec4 position ;
@@ -42,6 +44,16 @@ vec3 calNormChange( vec3 norm, vec3 down, vec3 right ) {
 
 in vec3 original_x ;
 in vec3 original_z ;
+in vec3 tmpnormal ;
+
+vec4 specular( vec3 a_normal ) {
+    vec3 difpos = -normalize(vec3(0,0,0) - vec3(position)) ;
+    difpos = reflect( difpos, a_normal ) ;
+    vec3 lightpos2 = reflect( reflect( vec3(lightPos), original_x ), original_z );
+    vec3 diflight = normalize(vec3(lightpos2) - vec3(position)) ;
+    float d = pow(max(dot( normalize(difpos), -normalize(diflight) ), 0.0 ),100.0);
+    return vec4(vec3(d),1) ;
+}
 void main() {
     vec3 down = vec3( 0, -1, 0 ) ;
     vec3 right = normalize(cross( normal, down )) ;
@@ -59,6 +71,8 @@ void main() {
         mix(texture2D(skynight,tmpcoord) * (1-globalAmbient.a),
             texture2D(skytex,tmpcoord) * vec4(normalize(globalAmbient.xyz),1),
             (globalAmbient.a + 1) / 2) ;
+    vec3 nlightpos = reflect( vec3(lightPos), vec3(mvMatrix * vec4(0,1,0,1)) ) ;
+    refcolor += specular( newNorm ) ;
     float coef = dot( normalize(vec3(lightPos) - vec3(position)), normalize(normal) ) * 0.5 + 0.5 ;
 
 
diff --git a/shaders/water.tes b/shaders/water.tes
index 0c5c1a5..56f998a 100644
--- a/shaders/water.tes
+++ b/shaders/water.tes
@@ -23,13 +23,14 @@ out vec2 texpos ;
 
 out vec3 original_x ;
 out vec3 original_z ;
+out vec3 tmpnormal ;
 
 vec2 skew( float t ) {
     return vec2(0.8*sin(t-time)+t,sin(t-time) / 5) ;
 }
 
 vec2 dskew( float t ) {
-    return vec2(0.8*(cos( time - t )+ 1), cos(time - t) / 5) ;
+    return vec2(-cos(time-t),5*(0.8*cos(time-t)+1)) ;
 }
 
 vec2 xripple( float t ) {
@@ -37,7 +38,7 @@ vec2 xripple( float t ) {
 }
 
 vec2 dxripple( float t ) {
-    return vec2(1,-cos(time-t)/5.0) ;
+    return vec2(cos(time-t)/5.0,-1);
 }
  
 void main () {
@@ -56,10 +57,12 @@ void main () {
     vec2 xr = xripple(pos.x) ;
     vec2 dxr = dxripple(pos.x) ;
     pos = vec3( xr.x, pos.y + sk.y + xr.y, sk.x);
-    vec3 normal_ = vec3(dxr.x, dsk.y+dxr.y, dsk.x) ;
+    vec3 normal_ = vec3(dxr.x, (dsk.y+dxr.y)/2, dsk.x) ;
     normal = - normalMatrix * normal_;  // cross( p0 - p1, p0 - p2 );
+    tmpnormal = normalize(normal_) ;
   } else {
     normal = - normalMatrix * vec3(0,1,0) ;
+    tmpnormal = vec3(0,1,0);
   }
   texpos = pos.xz / 20.0 ;
   gl_Position = pjMatrix * (position = mvMatrix * vec4(pos, 1.0));