aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Graphics/Glyph/BufferBuilder.hs33
-rw-r--r--Graphics/Glyph/GLMath.hs6
-rw-r--r--Graphics/Glyph/Shaders.hs3
-rw-r--r--Graphics/SDL/SDLHelp.hs26
-rw-r--r--Resources.hs50
-rw-r--r--shaders/sky.frag14
-rw-r--r--shaders/sky.vert3
-rw-r--r--shaders/water.frag20
-rw-r--r--shaders/water.tes9
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));
generated by cgit (git 2.34.1) at 2025-07-01 10:52:33 +0000