■ [Haskell] HaskellでOpenGL (16)

描画するたびに頂点属性をメモリからGPUのメモリに転送するのを避けるには頂点バッファオブジェクトを使います。頂点バッファオブジェクトを使うと、頂点属性をGPUのメモリに置きっぱなしにできます。

作成するには、genObjectNamesで名前を作り、bindBufferでバインドし、bufferDataでデータを書き込みます。

使用するときには、bindBufferでバインドした状態で、VertexArrayDescriptorの最後の引数にバッファへのポインタの代わりに頂点バッファオブジェクト内でのオフセットを指定します。オフセットの指定には、IntPtrが使えます。

前回と変わったところだけ。

main =
  do (progName, _) <- getArgsAndInitialize
     initialDisplayMode $= [RGBAMode]
     window <- createWindow "Window"
     clearColor $= Color4 1.0 1.0 1.0 0.0
     program <- join $ liftM2 createProgram (createShader vertexShaderSource) 
                                            (createShader fragmentShaderSource)
     positionLoc <- get $ attribLocation program "a_position"
     colorLoc <- get $ attribLocation program "a_color"
     buffer <- createBuffer ([ 0.0,  0.9, 1.0, 0.0, 0.0,
                              -0.9, -0.9, 0.0, 1.0, 0.0,
                               0.9, -0.9, 0.0, 0.0, 1.0] :: [GLfloat])
     displayCallback $= display program positionLoc colorLoc buffer
     mainLoop

display program positionLoc colorLoc buffer =
  do clear [ColorBuffer]
     currentProgram $= Just program
     bindBuffer ArrayBuffer $= Just buffer
     vertexAttribPointer positionLoc $= (ToFloat, VertexArrayDescriptor 2 Float (toEnum (5*sizeOf(0 :: GLfloat))) (intPtrToPtr 0))
     vertexAttribArray positionLoc $= Enabled
     vertexAttribPointer colorLoc $= (ToFloat, VertexArrayDescriptor 3 Float (toEnum (5*sizeOf(0 :: GLfloat))) (intPtrToPtr (toEnum (2*sizeOf(0 :: GLfloat)))))
     vertexAttribArray colorLoc $= Enabled
     drawArrays Triangles 0 3
     flush

createBuffer l =
  do [buffer] <- genObjectNames 1
     bindBuffer ArrayBuffer $= Just buffer
     arr <- newListArray (0, length l - 1) l
     withStorableArray arr $ \ptr ->
       bufferData ArrayBuffer $= (toEnum (length l*sizeOf(head l)), ptr, StaticDraw)
     bindBuffer ArrayBuffer $= Nothing
     return buffer