Question

我正在阅读http://www.arcsynthesis.org/gltut的教程。我写测试haskell程序。我希望在窗口中心看到带有插值颜色的三角形，但是在窗口一种颜色上。

module Shaders where

import Graphics.UI.GLUT
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable()
import Foreign.C.Types()
import qualified Data.ByteString as BS
import System.IO
import Control.Monad

data State = State 
    {
        vertexBuffer :: BufferObject,
        gpuProgram :: Program
    }

triangleVertexes :: [GLfloat]
triangleVertexes = [
     0.0,  0.5,   0.0, 1.0,
     0.5, -0.366, 0.0, 1.0,
    -0.5, -0.366, 0.0, 1.0,
     1.0,  0.0,   0.0, 1.0,
     0.0,  1.0,   0.0, 1.0,
     0.0,  0.0,   1.0, 1.0
    ]

main :: IO ()
main = do
   (progName, args) <- getArgsAndInitialize
   initialDisplayMode $= [ DoubleBuffered, RGBAMode, WithAlphaComponent, WithDepthBuffer ]
   _ <- createWindow progName
   state <- initializeState
   displayCallback $= display state
   reshapeCallback $= Just (reshape state)
   mainLoop

fragmentShaderFilePath :: FilePath
fragmentShaderFilePath = "shader.frag"

vertexShaderFilePath :: FilePath
vertexShaderFilePath = "shader.vert"

createVertexBuffer :: [GLfloat] -> IO BufferObject
createVertexBuffer vertexes = do
    bufferObject <- genObjectName
    bindBuffer ArrayBuffer $= Just bufferObject
    withArrayLen vertexes $ \count arr ->
        bufferData ArrayBuffer $= (fromIntegral count, arr, StaticDraw)
    vertexAttribArray (AttribLocation 0) $= Enabled
    vertexAttribArray (AttribLocation 1) $= Enabled
    vertexAttribPointer (AttribLocation 0) $= (ToFloat, VertexArrayDescriptor vertexNumComponents Float 0 nullPtr)
    vertexAttribPointer (AttribLocation 1) $= (ToFloat, VertexArrayDescriptor colorNumComponents Float 0 (plusPtr nullPtr 48))
    return bufferObject

vertexNumComponents :: NumComponents
vertexNumComponents = 4

colorNumComponents :: NumComponents
colorNumComponents = 4

initializeState :: IO State
initializeState = do
    bufferObject <- createVertexBuffer triangleVertexes
    program <- initGPUProgram
    return $ State 
        {
            vertexBuffer = bufferObject,
            gpuProgram = program
        }

loadShader :: ShaderType -> FilePath -> IO Shader
loadShader t path = do
    shader <- createShader t
    source <- BS.readFile path
    shaderSourceBS shader $= source
    compileShader shader
    status <- get (compileStatus shader)
    unless status $ hPutStrLn stdout . (("message" ++ " log: ") ++) =<< get (shaderInfoLog shader)
    return shader

initGPUProgram :: IO Program
initGPUProgram = do
    vertexShader <- loadShader VertexShader vertexShaderFilePath
    fragmentShader <- loadShader FragmentShader fragmentShaderFilePath
    let shaders = [vertexShader, fragmentShader]
    program <- createProgram
    attachShader program vertexShader
    attachShader program fragmentShader
    linkProgram program
    mapM_ (detachShader program) shaders
    return program

display :: State -> DisplayCallback
display state = do
    clearColor $= Color4 1.0 0.0 1.0 1.0
    clear [ ColorBuffer ]
    bindBuffer ArrayBuffer $= Just (vertexBuffer state)
    vertexAttribArray (AttribLocation 0) $= Enabled
    vertexAttribArray (AttribLocation 1) $= Enabled
    vertexAttribPointer (AttribLocation 0) $= (ToFloat, VertexArrayDescriptor vertexNumComponents Float 0 nullPtr)
    vertexAttribPointer (AttribLocation 1) $= (ToFloat, VertexArrayDescriptor colorNumComponents Float 0 (plusPtr nullPtr 48))
    drawArrays Triangles 0 3
    vertexAttribArray (AttribLocation 0) $= Disabled
    vertexAttribArray (AttribLocation 1) $= Disabled
    swapBuffers
    checkError "display"

reshape :: State -> ReshapeCallback
reshape state size = do
     viewport $= (Position 0 0, size)

checkError :: String -> IO ()
checkError functionName = get errors >>= mapM_ reportError
    where reportError e = 
             hPutStrLn stdout (showError e ++ " detected in " ++ functionName)
         showError (Error category message) =
            "GL error " ++ show category ++ " (" ++ message ++ ")"

-- shader.frag
#version 330

smooth in vec4 theColor;

out vec4 outputColor;

void main()
{
    outputColor = theColor;
}

-- shader.vert
#version 330

layout (location = 0) in vec4 position;
layout (location = 1) in vec4 color;

smooth out vec4 theColor;

void main()
{
    gl_Position = position + vec4(0.5, 0.5, 0.0, 1.0);
    theColor = color;
}

1）在教程作者中使用glUseProgram函数。在Haskell绑定到OpenGL时，缺少此功能。什么类似的glUseProgram？

2）我做错了什么？

Answer 1

问题在于glUseProgram。 Haskell模拟是currentProgram。另一个代码错误：

withArrayLen vertexes $ \count arr ->
    bufferData ArrayBuffer $= (fromIntegral count, arr, StaticDraw)

必须

withArrayLen vertexes $ \count arr ->
    bufferData ArrayBuffer $= (fromIntegral count * 4, arr, StaticDraw)

它在工作！

Answer 2

这篇关于haskell.org的教程对我来说效果更好：https://www.haskell.org/haskellwiki/OpenGLTutorial1

它位于Haskell.org维基上，因此对库的任何API更改都进行了更新。

如何使用OpenGL和Haskell绘制三角形

2 个答案: