如何用OpenGL和Haskell绘制三角形

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更改库更新。