How to draw triangle with OpenGL and Haskell -

How to draw triangle with OpenGL and Haskell -

i'm reading tutorial http://www.arcsynthesis.org/gltut. write test haskell program. want see triangle interpolating colors on center of window, on window 1 color.

module shaders import graphics.ui.glut import foreign.marshal.array import foreign.ptr import foreign.storable() import foreign.c.types() import qualified data.bytestring bs import system.io import control.monad info state = state { vertexbuffer :: bufferobject, gpuprogram :: programme } 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 = (progname, args) <- getargsandinitialize initialdisplaymode $= [ doublebuffered, rgbamode, withalphacomponent, withdepthbuffer ] _ <- createwindow progname state <- initializestate displaycallback $= display state reshapecallback $= (reshape state) mainloop fragmentshaderfilepath :: filepath fragmentshaderfilepath = "shader.frag" vertexshaderfilepath :: filepath vertexshaderfilepath = "shader.vert" createvertexbuffer :: [glfloat] -> io bufferobject createvertexbuffer vertexes = bufferobject <- genobjectname bindbuffer arraybuffer $= 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)) homecoming bufferobject vertexnumcomponents :: numcomponents vertexnumcomponents = 4 colornumcomponents :: numcomponents colornumcomponents = 4 initializestate :: io state initializestate = bufferobject <- createvertexbuffer trianglevertexes programme <- initgpuprogram homecoming $ state { vertexbuffer = bufferobject, gpuprogram = programme } loadshader :: shadertype -> filepath -> io shader loadshader t path = shader <- createshader t source <- bs.readfile path shadersourcebs shader $= source compileshader shader status <- (compilestatus shader) unless status $ hputstrln stdout . (("message" ++ " log: ") ++) =<< (shaderinfolog shader) homecoming shader initgpuprogram :: io programme initgpuprogram = vertexshader <- loadshader vertexshader vertexshaderfilepath fragmentshader <- loadshader fragmentshader fragmentshaderfilepath allow shaders = [vertexshader, fragmentshader] programme <- createprogram attachshader programme vertexshader attachshader programme fragmentshader linkprogram programme mapm_ (detachshader program) shaders homecoming programme display :: state -> displaycallback display state = clearcolor $= color4 1.0 0.0 1.0 1.0 clear [ colorbuffer ] bindbuffer arraybuffer $= (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 = viewport $= (position 0 0, size) checkerror :: string -> io () checkerror functionname = errors >>= mapm_ reporterror 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) in tutorial author utilize gluseprogram function. in haskell binding opengl function missing. analog of gluseprogram?

2) doing wrong?

the problem realy gluseprogram. haskell analog currentprogram. code error:

witharraylen vertexes $ \count arr -> bufferdata arraybuffer $= (fromintegral count, arr, staticdraw)

must be

witharraylen vertexes $ \count arr -> bufferdata arraybuffer $= (fromintegral count * 4, arr, staticdraw)

it's working!

opengl haskell