1
votes

Rather then rendering the full texture it just renders the average colour. There are no opengl errors or another errors. I am checking for shader errors however no errors have come through.

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

fragment shader

#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);
}

vertex Shader

#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
Where's your actual drawing code? Also where are nx and nl defined? Also why those short, untelling names? It's good style, especially for Haskell to make things easy to understand and give things proper names.datenwolf
This is most likely not your main problem, but you are setting WRAP_S twice. You probably meant to use WRAP_T for the second one. My best guess is that you don't have valid texture coordinates in your buffer, or that there's something wrong with the nx/nl values that @datenwolf is asking about.Reto Koradi
How can you have invalid texture coordinates and still have no errorsJoelWaterworth

1 Answers

2
votes

The problem was the offset as it was not accounting for the size of a GLfloat. Causing opengl to use negative values.