starting tesselation shader

10 files changed, 130 insertions, 27 deletions

diff --git a/Final.hs b/Final.hs
index 96c826a..cba5784 100644
--- a/Final.hs
+++ b/Final.hs
@@ -9,6 +9,7 @@ import Graphics.UI.SDL.Image as SDLImg
 import Graphics.UI.SDL as SDL
 import Graphics.SDL.SDLHelp
 import Graphics.Glyph.Util
+import Graphics.Glyph.ExtendedGL
 import Control.Monad
 
 import Graphics.Glyph.BufferBuilder
@@ -102,11 +103,19 @@ getWaterQuads marr arr = do
     let (_,(w,h)) = bounds marr
     let elevationCacheIO :: IO (Map.Map Int (Int,Int,Int,Int,Int))
         elevationCacheIO = do
-            let tup = (max,max,max,min,min)
+            let tup = (min,max,max,min,min)
             foldM (\themap (x,y) -> do
                     bodyID <- readArray arr (x,y)
                     if bodyID == 0 then return themap else do
-                        let elev = elevation $ marr ! (x,y) :: Int
+                        let valid (x,y) = x >= 0 && x <= w && y >= 0 && y <= h
+                        let neighbors (x,y) = P.filter valid $ map (zipWithT2 (+) (x,y))
+                                                [      (1,0),       
+                                                 (0,1),      (0,-1),
+                                                       (-1,0)      ]
+                        let toelev x = 
+                             let tile = marr ! x in
+                             (tileType tile == Water) ? 1000000000000 $ elevation tile
+                        let elev = minimum $ map toelev (neighbors (x,y))
                         let newmap = Map.insertWith (\old->
                                             zipWithT5 (P.$) (zipWithT5 (P.$) tup old)
                                         ) bodyID (elev,x,y,x,y) themap
@@ -115,16 +124,16 @@ getWaterQuads marr arr = do
 
     dat <- (liftM Map.toList elevationCacheIO)
     return . sequence_ $ for dat $ \(_, (elev,maxx,maxy,minx,miny)) -> do
-        let relev = (fromIntegral elev) / 10
-            mxx = fromIntegral maxx
-            mnx = fromIntegral minx
-            mxy = fromIntegral maxy
-            mny = fromIntegral miny
-        mapM_ bVertex3 $ trianglesFromQuads
-            [(mxx,relev,mxy),
-             (mxx,relev,mny),
-             (mnx,relev,mny),
-             (mnx,relev,mxy)] 
+        let mxx = fromIntegral maxx + 1
+            mnx = fromIntegral minx - 1
+            mxy = fromIntegral maxy + 1
+            mny = fromIntegral miny - 1
+            relev = fromIntegral elev / 10 in
+            mapM_ bVertex3 $ trianglesFromQuads
+                [(mxx,relev,mxy),
+                 (mxx,relev,mny),
+                 (mnx,relev,mny),
+                 (mnx,relev,mxy)] 
 
 
 printArray :: Array (Int,Int) Tile -> IO ()
@@ -263,6 +272,7 @@ main = do
     surface <- simpleStartup "Spectical" (640,480)
     stgen <- newStdGen
     stgen2 <- newStdGen
+
 --    (log',file) <- loadObjFile "tree.obj"
 --    mapM_ putStrLn log'
 
diff --git a/Graphics/Glyph/ExtendedGL.hs b/Graphics/Glyph/ExtendedGL.hs
index d42e973..7742ba8 100644
--- a/Graphics/Glyph/ExtendedGL.hs
+++ b/Graphics/Glyph/ExtendedGL.hs
@@ -4,6 +4,14 @@ import Graphics.Rendering.OpenGL
 import Graphics.Rendering.OpenGL.Raw.Core31
 import Graphics.Rendering.OpenGL.Raw.ARB
 
+import Foreign.Marshal.Alloc
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.Types
+
+import System.IO.Unsafe
+import Control.Monad
+
 marshalPrimitiveMode :: PrimitiveMode -> GLenum
 marshalPrimitiveMode x = case x of
    Points -> 0x0
@@ -24,3 +32,25 @@ vertexAttributeDivisor :: AttribLocation -> SettableStateVar GLuint
 vertexAttributeDivisor (AttribLocation loc) =
     makeSettableStateVar $ \val ->
         glVertexAttribDivisor loc val
+
+patchVertices :: (Integral a) => SettableStateVar a
+patchVertices = 
+    makeSettableStateVar $ \val ->
+        glPatchParameteri gl_PATCH_VERTICES $ fromIntegral val
+
+maxPatchVertices :: IO CInt
+maxPatchVertices =
+        alloca $ \ptr -> do
+            glGetIntegerv gl_MAX_PATCH_VERTICES ptr
+            peek ptr
+
+getGLVersion :: IO String
+getGLVersion =
+    let lift2 (a,b) = do
+            x <- a ; y <- b ; return (x,y)
+             in
+    alloca $ \ptr1 -> alloca $ \ptr2 -> do
+        glGetIntegerv gl_MAJOR_VERSION ptr1
+        glGetIntegerv gl_MINOR_VERSION ptr2
+        (v1,v2) <- lift2 (peek ptr1, peek ptr2)
+        return ("OpenGL " ++ show v1 ++ "." ++ show v2)
diff --git a/Graphics/Glyph/Shaders.hs b/Graphics/Glyph/Shaders.hs
index 01f27b6..c11886d 100644
--- a/Graphics/Glyph/Shaders.hs
+++ b/Graphics/Glyph/Shaders.hs
@@ -89,21 +89,31 @@ getUniformLocation name =
     get currentProgram >>= maybe (return Nothing) (\prog ->
         liftM Just (get $ uniformLocation prog name) )
 
-loadProgramSafe ::
-    (IsShaderSource a,
-     IsShaderSource b,
-     IsShaderSource c) =>
-        a -> b -> Maybe c -> IO (Maybe Program)
-loadProgramSafe vert frag geom = do
+loadProgramFullSafe ::
+    (IsShaderSource tc,
+     IsShaderSource te,
+     IsShaderSource g,
+     IsShaderSource v,
+     IsShaderSource f) => Maybe (tc,te) -> Maybe g -> v -> f -> IO (Maybe Program)
+loadProgramFullSafe tess geometry vert frag = do
+    let (ts1,ts2) = distribMaybe tess
     shaders <- sequence $ catMaybes [
-        Just $ loadShader VertexShader vert,
-        Just $ loadShader FragmentShader frag,
-        liftM (loadShader GeometryShader) geom]
-    -- mapM_ (putStrLn . fst) shaders
-    (linklog, maybeProg) <- createShaderProgramSafe shaders
-
+            Just $ loadShader VertexShader vert,
+            Just $ loadShader FragmentShader frag,
+            liftM (loadShader GeometryShader) geometry,
+            liftM (loadShader TessControlShader) ts1,
+            liftM (loadShader TessEvaluationShader) ts2]
+    (linklog,maybeProg) <- createShaderProgramSafe shaders
     if isNothing maybeProg then do
         putStrLn "Failed to link program"
         putStrLn linklog
         return Nothing
         else return maybeProg
+
+
+loadProgramSafe ::
+    (IsShaderSource a,
+     IsShaderSource b,
+     IsShaderSource c) =>
+        a -> b -> Maybe c -> IO (Maybe Program)
+loadProgramSafe vert frag geom = loadProgramFullSafe (Nothing::Maybe(String,String)) geom vert frag
diff --git a/Graphics/Glyph/Util.hs b/Graphics/Glyph/Util.hs
index 61cd3f0..78fd053 100644
--- a/Graphics/Glyph/Util.hs
+++ b/Graphics/Glyph/Util.hs
@@ -306,3 +306,7 @@ untilM2 cond ini bod = do
 
 for :: [a] -> (a -> b) -> [b]
 for = flip map
+
+distribMaybe :: Maybe (a,b) -> (Maybe a, Maybe b)
+distribMaybe Nothing = (Nothing,Nothing)
+distribMaybe (Just (a,b)) = (Just a, Just b)
diff --git a/Resources.hs b/Resources.hs
index 24154e0..c32de5f 100644
--- a/Resources.hs
+++ b/Resources.hs
@@ -198,6 +198,7 @@ displayHandle resources = do
         uniform (UniformLocation 4) $= pMatrix resources
         uniform (UniformLocation 5) $= l_mvMatrix
         uniform (UniformLocation 7) $= normalMatrix
+        uniform (UniformLocation 8) $= l_mvMatrix `glslMatMul` lightPos
         return ()
 
     SDL.glSwapBuffers
@@ -303,6 +304,8 @@ makeResources surf builder forestB jungleB water = do
     let pMatrix' = perspectiveMatrix 50 1.8 0.1 100
     waterProg <- loadProgramSafe' 
         "shaders/water.vert" "shaders/water.frag" (Nothing::Maybe String)
+    waterTexture <- load "textures/water.jpg" >>= textureFromSurface
+    location <- get (uniformLocation waterProg "texture")
     Resources 
         <$> pure surf
         <*> do CameraPosition
@@ -320,6 +323,7 @@ makeResources surf builder forestB jungleB water = do
         <*> buildForestObject jungleB "jungletree.obj" "textures/jungle_tree.png"
         <*> (newDefaultGlyphObjectWithClosure water () $ \_ -> do
                 currentProgram $= Just waterProg
+                setupTexturing waterTexture location 0
                 )
         <*> pure 0
         <*> pure 1
diff --git a/shaders/.basic.frag.swp b/shaders/.basic.frag.swp
deleted file mode 100644
index 66aabb3..0000000
--- a/shaders/.basic.frag.swp
+++ /dev/null
diff --git a/shaders/.water.frag.swp b/shaders/.water.frag.swp
deleted file mode 100644
index 73b3be2..0000000
--- a/shaders/.water.frag.swp
+++ /dev/null
diff --git a/shaders/basic.frag b/shaders/basic.frag
index 4d7683c..719137d 100644
--- a/shaders/basic.frag
+++ b/shaders/basic.frag
@@ -4,8 +4,8 @@
 
 layout(location = 0) out vec4 frag_color ;
 layout(location = 6) uniform vec4 lightPos ;
-
 layout(location = 8) uniform vec4 globalAmbient ;
+
 uniform float dX ;
 uniform float dY ;
 
diff --git a/shaders/water.frag b/shaders/water.frag
index 8a0dd0b..9298d15 100644
--- a/shaders/water.frag
+++ b/shaders/water.frag
@@ -3,7 +3,45 @@
 #extension GL_ARB_explicit_uniform_location : enable
 
 layout(location = 0) out vec4 frag_color ;
+layout(location = 8) uniform vec4 lightPos ;
+ uniform sampler2D texture ;
+
+in vec3 normal ;
+in vec4 position ;
+in vec2 texpos ;
+
+float dX = 1 / 512.0 ;
+float dY = 1 / 512.0 ;
+vec4 sample(float xc,float yc) {
+   return texture2D(texture,texpos + vec2(xc,yc));
+}
+
+vec3 calNormChange( vec3 norm, vec3 down, vec3 right ) {
+    float x00 = 1 - length(sample(-dX, dY)) ; 
+    float x01 = 1 - length(sample(  0, dY)) ; 
+    float x02 = 1 - length(sample( dX, dY)) ; 
+
+    float x10 = 1 - length(sample(-dX, 0)) ; 
+    float x11 = 1 - length(sample(  0, 0)) ; 
+    float x12 = 1 - length(sample( dX, 0)) ; 
+
+    float x20 = 1 - length(sample(-dX,-dY)) ; 
+    float x21 = 1 - length(sample(  0,-dY)) ; 
+    float x22 = 1 - length(sample( dX,-dY)) ; 
+
+    down = ((x11 - x00) + (x11 - x01) + (x11 - x02) - (x11 - x20) - (x11 - x21) - (x11 - x22)) * down ;
+    right = ((x11 - x00) + (x11 - x10) + (x11 - x20) - (x11 - x02) - (x11 - x12) - (x11 - x22)) * right ;
+    
+    return (right*2 + down*2 + norm) / 5.0 ;
+}
 
 void main() {
-    frag_color = vec4(0.0,0.3,0.7,0.5) ;
+    vec3 down = vec3( 0, -1, 0 ) ;
+    vec3 right = normalize(cross( normal, down )) ;
+    down = normalize(cross( normal, right ) );
+    vec3 newNorm = calNormChange( normal, down, right ) ;
+
+    float coef = dot( normalize(vec3(lightPos) - vec3(position)), normalize(newNorm) ) ;
+    vec4 color = texture2D(texture,texpos) ;
+    frag_color = vec4(color.xyz * vec3(0.0,0.4,0.7) * coef,0.8);
 }
diff --git a/shaders/water.vert b/shaders/water.vert
index 1db6dc5..765c1df 100644
--- a/shaders/water.vert
+++ b/shaders/water.vert
@@ -11,6 +11,13 @@ layout(location = 4) uniform mat4 pjMatrix ;
 layout(location = 5) uniform mat4 mvMatrix ;
 layout(location = 7) uniform mat3 normalMatrix ;
 
+out vec3 lightPos ;
+out vec3 normal ;
+out vec4 position ;
+out vec2 texpos ;
+
 void main() {
-    gl_Position = pjMatrix * mvMatrix * vec4( in_position, 1.0 );
+    gl_Position = pjMatrix * (position = mvMatrix * vec4( in_position, 1.0 ));
+    normal = normalMatrix * vec3(0,1,0) ;
+    texpos = in_position.xz / 20.0;
 }