Haskell opengl纹理只有平均颜色

时间:2014-06-09 06:28:46

标签: opengl haskell textures fragment-shader vertex-shader

而不是渲染完整的纹理,它只是渲染平均颜色。没有opengl错误或其他错误。我正在检查着色器错误,但没有出现任何错误。

import qualified Graphics.UI.GLFW as G
import Graphics.Rendering.OpenGL.GL
import Control.Applicative
import System.Exit
import System.IO
import Control.Monad (unless, when)
import Graphics.GLUtil
import Foreign.Storable

main :: IO ()
main = do
    let errorCallback err description = hPutStrLn stderr description
    G.setErrorCallback (Just errorCallback)
    successfulInit <- G.init
    if not successfulInit
        then exitFailure
        else do
          mw <- G.createWindow 1000 700 "Simple example, haskell style" Nothing Nothing
          case mw of Nothing -> (G.terminate >> exitFailure)
                     Just window -> do
                                    G.makeContextCurrent mw
                                    preMainLoop window
                                    G.destroyWindow window
                                    G.terminate
                                    exitSuccess

loadTex :: FilePath -> IO TextureObject
loadTex f = do t <- either error id <$> readTexture f
               textureFilter Texture2D $= ((Linear', Nothing), Linear')
               texture2DWrap $= (Repeated, Repeat)
               return t

mesh :: [GLfloat]
mesh =  [  0.0,  0.5, 0, 1, 0.0, 0.5,
          -0.5, -0.5, 0, 1, 0.0, 1.0,
           0.5, -0.5, 0, 1, 1.0, 1.0]

preMainLoop window = do
    clearColor $= Color4 0.2 0.1243 0.5 1.0
    blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
    p <- loadShaderProgram [(VertexShader, "vert4.vs"), (FragmentShader, "frag4.fs")]
    currentProgram $= Just (program p)
    printErrorMsg "program"
    vao <- makeVAO $ 
        let meshVad  = VertexArrayDescriptor 4 Float (stride 6) offset0
            texCoord = VertexArrayDescriptor 2 Float (stride 6) (offsetPtr 3)
            stride n = fromIntegral $ sizeOf (undefined::GLfloat) * n
            mPos     = getAttrib p "position"
            tc       = getAttrib p "tc"
        in do
            buffer <- makeBuffer ArrayBuffer mesh
            vertexAttribArray mPos $= Enabled
            vertexAttribPointer mPos $= (ToFloat, meshVad)

            vertexAttribArray tc $= Enabled
            vertexAttribPointer tc $= (ToFloat, texCoord)
    tex <- loadTex "fail texture.png"
    textureBinding Texture2D $= Nothing
    activeTexture $= TextureUnit 0
    textureBinding Texture2D $= Just tex
    setUniform p "tex" (TextureUnit 0)
    mainLoop window vao p

mainLoop window vao p = do
    action <- (G.windowShouldClose window)
    unless action $ do
        (width, height) <- G.getFramebufferSize window
        viewport $= (Position 0 0, Size (fromIntegral width) (fromIntegral height))
        printErrorMsg "start of loop"
        Just t <- G.getTime
        clear [ColorBuffer, DepthBuffer]
        withVAO vao $ drawArrays Triangles 0 3
        G.swapBuffers window
        G.pollEvents
        mainLoop window vao p

片段着色器

#version 430 core
uniform sampler2D tex;

in VS_OUT
{
    vec2 tc;
} fs_in;

out vec4 color;

void main (void)
{
    color = texture(tex, fs_in.tc);
}

顶点着色器

#version 430 core

in vec4 position;
in vec2 tc;

out VS_OUT
{
    vec2 tc;
} vs_out;

void main (void)
{
    gl_Position = position;
    vs_out.tc = tc;
}

1 个答案:

答案 0 :(得分:2)

问题是抵消,因为它没有考虑GLfloat的大小。导致opengl使用负值。