November 2010 - HOpenGL

draw Elements segmentation fault.
by Ben Christy 20 Nov '10

20 Nov '10

I am having a issue getting a seg fault with drawElements. Honestly I can not tell where the problem is. It seems as far as all I have read that it should work and being its written in haskell I am asking here first before asking in an opengl chat room. I init my VBOs with initModelIBO :: Int → IO BufferObject initModelIBO listLen = do print "list length" print listLen print "gen ibo bytes" print sizeOfList [ibo] ← genObjectNames 1 :: IO [BufferObject] bindBuffer ElementArrayBuffer $= Just ibo tempArray2 ← newListArray (0, listLen - 1) indexList :: IO(StorableArray Int GLuint) withStorableArray tempArray2 (λptr -> bufferData ElementArrayBuffer $= ((fromIntegral sizeOfList), ptr, StaticDraw)) bindBuffer ElementArrayBuffer $= Nothing return ibo where elementSize = 4 sizeOfList = listLen * elementSize indexList = [i | i ← [0..(fromIntegral listLen)]] :: [GLuint] initModelVBO :: [Vert] → IO BufferObject initModelVBO vertexList = do print "list length" print listLen print "gen vbo bytes" print sizeOfList [vbo] ← genObjectNames 1 :: IO [BufferObject] bindBuffer ArrayBuffer $= Just vbo tempArray ← newListArray (0, listLen - 1) vertList :: IO(StorableArray Int GLfloat) withStorableArray tempArray (λptr -> bufferData ArrayBuffer $= ((fromIntegral sizeOfList), ptr, StaticDraw)) bindBuffer ArrayBuffer $= Nothing return vbo where elementsPerVert = 10 vertList = vertsToList vertexList listLen = length vertList elementSize = 4 sizeOfList = listLen * elementSize My Vert type is data Vert = Vert { vertX ::GLfloat, vertY ::GLfloat, vertZ ::GLfloat, --normalX ::GLfloat, --normalY ::GLfloat, --normalZ ::GLfloat, colorR ::GLfloat, colorG ::GLfloat, colorB ::GLfloat, specR ::GLfloat, specG ::GLfloat, specB ::GLfloat, shiny ::GLfloat} deriving (Show) I set vertex attributes with setAttribPtr (Just program) = do print " Setting attrib pointer" --vertexAttribPointer (AttribLocation 1) $= (KeepIntegral, (VertexArrayDescriptor 3 Float ((4) *10) (plusPtr nullPtr (0*4)))) GLRaw.glVertexAttribPointer 1 3 GLRaw.gl_FLOAT 0 stride (plusPtr nullPtr (0)) vertexAttribArray (AttribLocation 1) $= Enabled --vertexAttribPointer (AttribLocation 2) $= (KeepIntegral, (VertexArrayDescriptor 3 Float ((4) *10) (plusPtr nullPtr (3*4)))) GLRaw.glVertexAttribPointer 2 3 GLRaw.gl_FLOAT 0 stride (plusPtr nullPtr (12)) vertexAttribArray (AttribLocation 2) $= Enabled --vertexAttribPointer (AttribLocation 3) $= (KeepIntegral, (VertexArrayDescriptor 3 Float ((4) *10) (plusPtr nullPtr (6*4)))) GLRaw.glVertexAttribPointer 3 3 GLRaw.gl_FLOAT 0 stride (plusPtr nullPtr (24)) vertexAttribArray (AttribLocation 3) $= Enabled --vertexAttribPointer (AttribLocation 4) $= (KeepIntegral, (VertexArrayDescriptor 1 Float ((4) *10) (plusPtr nullPtr (9*4)))) GLRaw.glVertexAttribPointer 4 1 GLRaw.gl_FLOAT 0 stride (plusPtr nullPtr (36)) vertexAttribArray (AttribLocation 4) $= Enabled return () where stride = 40 I build a shader program with buildShader vertexShader fragmentShader = do [vertObj] ← genObjectNames 1 ::IO [VertexShader] shaderSource vertObj $= [vertexShader] compileShader vertObj vsLog ← get (shaderInfoLog vertObj) print "vertex shader status" print vsLog [fragObj] ← genObjectNames 1 ::IO [FragmentShader] shaderSource fragObj $= [fragmentShader] compileShader fragObj fsLog ← get (shaderInfoLog fragObj) print "fragment shader status" print fsLog [programObj] ← genObjectNames 1 ::IO [Program] attachedShaders programObj $= ([vertObj], [fragObj]) attribLocation programObj "position" $= AttribLocation 1 attribLocation programObj "color" $= AttribLocation 2 attribLocation programObj "spec" $= AttribLocation 3 attribLocation programObj "shiny" $= AttribLocation 4 linkProgram programObj progLog ← get(programInfoLog programObj) print "Shader Program status" print progLog return (Just programObj) Finally my render function instance RenderSimpleSceneGraph Model where render matrix (ModernModel vbo ibo shader count) = do clientState VertexArray $= Enabled version ← get (majorMinor glVersion) tempVBO ← vbo tempIBO ← ibo print "Render Modern Model" program ← shader currentProgram $= program bindBuffer ArrayBuffer $= Just tempVBO setAttribPtr program bindBuffer ElementArrayBuffer $= Just tempIBO print "here" drawElements Triangles (fromIntegral count) UnsignedInt nullPtr print "here1" resetAttribPtr program bindBuffer ArrayBuffer $= Nothing clientState VertexArray $= Disabled

2 5

Basic GLUT initialization not working
by David Flemström 18 Nov '10

18 Nov '10

Hello all, I'm starting to use HOpenGL, but have hit a brick wall. Whatever I do, GLUT always fails to initialize with the following error: X Error of failed request: BadWindow (invalid Window parameter) Major opcode of failed request: 20 (X_GetProperty) Resource id in failed request: 0x1a0003e Serial number of failed request: 22 Current serial number in output stream: 22 I've tried everything I can think of; clearing the ~/.cabal and ~/.ghc dirs and compiling everything anew, reinstalling the whole Haskell platform, etc. The system I'm using is running Kubuntu x86_64 10.10 with nVidia drivers, KDE 4.5.1, kWin with the oxygen engine, on two monitors using nVidia's Xinerama replacement (forgetting the name). Every other conceivable OpenGL application, using GLUT, lwjgl, Qt, or GTK, works flawlessly, both compiled from scratch and from third parties. My GLX info string is at the end of this email. The program used for testing is trivial: module Main (main) where import Graphics.Rendering.OpenGLimport Graphics.UI.GLUT main = do _ <- getArgsAndInitialize -- Initialization fails here createWindow "OpenGL Test" displayCallback $= clear [ColorBuffer] mainLoop Using either my 32-bit Ubuntu laptop or a 32-bit Arch/KDE system, the equivalent setup works perfectly and I'm able to run the program. Any help would be greatly appreciated. Cheers, David Flemström GLX info string: name of display: :0.0 display: :0 screen: 0 direct rendering: Yes server glx vendor string: NVIDIA Corporation server glx version string: 1.4 server glx extensions: GLX_EXT_visual_info, GLX_EXT_visual_rating, GLX_SGIX_fbconfig, GLX_SGIX_pbuffer, GLX_SGI_video_sync, GLX_SGI_swap_control, GLX_EXT_swap_control, GLX_EXT_texture_from_pixmap, GLX_ARB_create_context, GLX_ARB_create_context_profile, GLX_EXT_create_context_es2_profile, GLX_ARB_create_context_robustness, GLX_ARB_multisample, GLX_NV_float_buffer, GLX_ARB_fbconfig_float, GLX_EXT_framebuffer_sRGB client glx vendor string: NVIDIA Corporation client glx version string: 1.4 client glx extensions: GLX_ARB_get_proc_address, GLX_ARB_multisample, GLX_EXT_visual_info, GLX_EXT_visual_rating, GLX_EXT_import_context, GLX_SGI_video_sync, GLX_NV_swap_group, GLX_NV_video_out, GLX_SGIX_fbconfig, GLX_SGIX_pbuffer, GLX_SGI_swap_control, GLX_EXT_swap_control, GLX_ARB_create_context, GLX_ARB_create_context_profile, GLX_NV_float_buffer, GLX_ARB_fbconfig_float, GLX_EXT_fbconfig_packed_float, GLX_EXT_texture_from_pixmap, GLX_EXT_framebuffer_sRGB, GLX_NV_present_video, GLX_NV_copy_image, GLX_NV_multisample_coverage, GLX_NV_video_capture, GLX_EXT_create_context_es2_profile, GLX_ARB_create_context_robustness GLX version: 1.4 GLX extensions: GLX_EXT_visual_info, GLX_EXT_visual_rating, GLX_SGIX_fbconfig, GLX_SGIX_pbuffer, GLX_SGI_video_sync, GLX_SGI_swap_control, GLX_EXT_swap_control, GLX_EXT_texture_from_pixmap, GLX_ARB_create_context, GLX_ARB_create_context_profile, GLX_EXT_create_context_es2_profile, GLX_ARB_create_context_robustness, GLX_ARB_multisample, GLX_NV_float_buffer, GLX_ARB_fbconfig_float, GLX_EXT_framebuffer_sRGB, GLX_ARB_get_proc_address OpenGL vendor string: NVIDIA Corporation OpenGL renderer string: GeForce 8800 GTX/PCI/SSE2 OpenGL version string: 3.3.0 NVIDIA 260.19.06 OpenGL shading language version string: 3.30 NVIDIA via Cg compiler OpenGL extensions: GL_ARB_blend_func_extended, GL_ARB_color_buffer_float, GL_ARB_compatibility, GL_ARB_copy_buffer, GL_ARB_depth_buffer_float, GL_ARB_depth_clamp, GL_ARB_depth_texture, GL_ARB_draw_buffers, GL_ARB_draw_elements_base_vertex, GL_ARB_draw_instanced, GL_ARB_ES2_compatibility, GL_ARB_explicit_attrib_location, GL_ARB_fragment_coord_conventions, GL_ARB_fragment_program, GL_ARB_fragment_program_shadow, GL_ARB_fragment_shader, GL_ARB_framebuffer_object, GL_ARB_framebuffer_sRGB, GL_ARB_geometry_shader4, GL_ARB_get_program_binary, GL_ARB_half_float_pixel, GL_ARB_half_float_vertex, GL_ARB_imaging, GL_ARB_instanced_arrays, GL_ARB_map_buffer_range, GL_ARB_multisample, GL_ARB_multitexture, GL_ARB_occlusion_query, GL_ARB_occlusion_query2, GL_ARB_pixel_buffer_object, GL_ARB_point_parameters, GL_ARB_point_sprite, GL_ARB_provoking_vertex, GL_ARB_robustness, GL_ARB_sampler_objects, GL_ARB_seamless_cube_map, GL_ARB_separate_shader_objects, GL_ARB_shader_bit_encoding, GL_ARB_shader_objects, GL_ARB_shading_language_100, GL_ARB_shadow, GL_ARB_sync, GL_ARB_texture_border_clamp, GL_ARB_texture_buffer_object, GL_ARB_texture_compression, GL_ARB_texture_compression_rgtc, GL_ARB_texture_cube_map, GL_ARB_texture_env_add, GL_ARB_texture_env_combine, GL_ARB_texture_env_crossbar, GL_ARB_texture_env_dot3, GL_ARB_texture_float, GL_ARB_texture_mirrored_repeat, GL_ARB_texture_multisample, GL_ARB_texture_non_power_of_two, GL_ARB_texture_rectangle, GL_ARB_texture_rg, GL_ARB_texture_rgb10_a2ui, GL_ARB_texture_swizzle, GL_ARB_timer_query, GL_ARB_transpose_matrix, GL_ARB_uniform_buffer_object, GL_ARB_vertex_array_bgra, GL_ARB_vertex_array_object, GL_ARB_vertex_buffer_object, GL_ARB_vertex_program, GL_ARB_vertex_shader, GL_ARB_vertex_type_2_10_10_10_rev, GL_ARB_viewport_array, GL_ARB_window_pos, GL_ATI_draw_buffers, GL_ATI_texture_float, GL_ATI_texture_mirror_once, GL_S3_s3tc, GL_EXT_texture_env_add, GL_EXT_abgr, GL_EXT_bgra, GL_EXT_bindable_uniform, GL_EXT_blend_color, GL_EXT_blend_equation_separate, GL_EXT_blend_func_separate, GL_EXT_blend_minmax, GL_EXT_blend_subtract, GL_EXT_compiled_vertex_array, GL_EXT_Cg_shader, GL_EXT_depth_bounds_test, GL_EXT_direct_state_access, GL_EXT_draw_buffers2, GL_EXT_draw_instanced, GL_EXT_draw_range_elements, GL_EXT_fog_coord, GL_EXT_framebuffer_blit, GL_EXT_framebuffer_multisample, GL_EXTX_framebuffer_mixed_formats, GL_EXT_framebuffer_object, GL_EXT_framebuffer_sRGB, GL_EXT_geometry_shader4, GL_EXT_gpu_program_parameters, GL_EXT_gpu_shader4, GL_EXT_multi_draw_arrays, GL_EXT_packed_depth_stencil, GL_EXT_packed_float, GL_EXT_packed_pixels, GL_EXT_pixel_buffer_object, GL_EXT_point_parameters, GL_EXT_provoking_vertex, GL_EXT_rescale_normal, GL_EXT_secondary_color, GL_EXT_separate_shader_objects, GL_EXT_separate_specular_color, GL_EXT_shadow_funcs, GL_EXT_stencil_two_side, GL_EXT_stencil_wrap, GL_EXT_texture3D, GL_EXT_texture_array, GL_EXT_texture_buffer_object, GL_EXT_texture_compression_latc, GL_EXT_texture_compression_rgtc, GL_EXT_texture_compression_s3tc, GL_EXT_texture_cube_map, GL_EXT_texture_edge_clamp, GL_EXT_texture_env_combine, GL_EXT_texture_env_dot3, GL_EXT_texture_filter_anisotropic, GL_EXT_texture_integer, GL_EXT_texture_lod, GL_EXT_texture_lod_bias, GL_EXT_texture_mirror_clamp, GL_EXT_texture_object, GL_EXT_texture_shared_exponent, GL_EXT_texture_sRGB, GL_EXT_texture_swizzle, GL_EXT_timer_query, GL_EXT_vertex_array, GL_EXT_vertex_array_bgra, GL_IBM_rasterpos_clip, GL_IBM_texture_mirrored_repeat, GL_KTX_buffer_region, GL_NV_blend_square, GL_NV_conditional_render, GL_NV_copy_depth_to_color, GL_NV_copy_image, GL_NV_depth_buffer_float, GL_NV_depth_clamp, GL_NV_explicit_multisample, GL_NV_fence, GL_NV_float_buffer, GL_NV_fog_distance, GL_NV_fragment_program, GL_NV_fragment_program_option, GL_NV_fragment_program2, GL_NV_framebuffer_multisample_coverage, GL_NV_geometry_shader4, GL_NV_gpu_program4, GL_NV_half_float, GL_NV_light_max_exponent, GL_NV_multisample_coverage, GL_NV_multisample_filter_hint, GL_NV_occlusion_query, GL_NV_packed_depth_stencil, GL_NV_parameter_buffer_object, GL_NV_parameter_buffer_object2, GL_NV_pixel_data_range, GL_NV_point_sprite, GL_NV_primitive_restart, GL_NV_register_combiners, GL_NV_register_combiners2, GL_NV_shader_buffer_load, GL_NV_texgen_reflection, GL_NV_texture_barrier, GL_NV_texture_compression_vtc, GL_NV_texture_env_combine4, GL_NV_texture_expand_normal, GL_NV_texture_multisample, GL_NV_texture_rectangle, GL_NV_texture_shader, GL_NV_texture_shader2, GL_NV_texture_shader3, GL_NV_transform_feedback, GL_NV_vertex_array_range, GL_NV_vertex_array_range2, GL_NV_vertex_buffer_unified_memory, GL_NV_vertex_program, GL_NV_vertex_program1_1, GL_NV_vertex_program2, GL_NV_vertex_program2_option, GL_NV_vertex_program3, GL_NVX_conditional_render, GL_NVX_gpu_memory_info, GL_SGIS_generate_mipmap, GL_SGIS_texture_lod, GL_SGIX_depth_texture, GL_SGIX_shadow, GL_SUN_slice_accum

1 0

vertexAttribPointer problem
by Ben Christy 17 Nov '10

17 Nov '10

using vertexAttribPointer results in error "user error (unknown OpenGL extension entry glVertexAttribIPointer, check for OpenGL 3.1)" the exact code was: vertexAttribPointer (AttribLocation 1) $= (KeepIntegral, (VertexArrayDescriptor 3 Float ((4) *10) (plusPtr nullPtr (0*4)))) according to version ← get (majorMinor glVersion) The version is 2.0 The OpenGl Spec states that vertexAttribPointer was added in version 2.0 so I am not certain of the problem any thoughts?

1 1

Scene Graph manual transformation problem
by Ben Christy 11 Nov '10

11 Nov '10

I have a problem with implementing the transformations for my scene graph manually. After removing the opengl functions translate and rotate form my program and managing the matrix by hand my scene is no longer transformed correctly and I am at a loss. My guess is that it has something to do with the order I am doing something as my scene appears to be rotated and then translated. As I walk down the scene graph I multiply the current matrix by a series of translation matrices SceneGraph = buildSSG = SimpleRootNode "HomeWork3" [ TransformNode "camera" (Rotate 0 0 0) (Translate 0 0 (-1)) [ TransformNode "ground" (Rotate 0 0 0) (Translate (-4) (-1.5) (-4)) [ ModelNode "groundModel" (Just groundModel) ], TransformNode "carousel" (Rotate 0 0 0) (Translate 0 0 0) [ TransformNode "carouselbase" (Rotate 90 0 0) (Translate 0 0 0) [ ModelNode "carouselbaseModel" (Just carouselBase) ], TransformNode "carouselRoof" (Rotate 90 0 0) (Translate 0 0.3 0) [ ModelNode "carouselRoofModel" (Just carouselRoof) ], TransformNode "carouselFloor" (Rotate 90 0 0) (Translate 0 0 0) [ ModelNode "carouselFloorModel" (Just carouselFloor), TransformNode "polls" (Rotate 0 0 0) (Translate 0 0 (-0.2)) [ OrbitalTransformNode "poll1"(Rotate 0 0 0 ) (Translate 0 0.45 0) [ ModelNode "poll1Model" (Just carouselPool), TransformNode "horse1" (Rotate 0 0 0 ) (Translate 0 0 0) [ ModelNode "horse1Model" (Just horseModel) ] ], OrbitalTransformNode "poll2" (Rotate 0 0 45) (Translate 0 0.45 0) [ ModelNode "poll2Model" (Just carouselPool), TransformNode "horse2" (Rotate 0 0 0) (Translate 0 0 0) [ ModelNode "horse2Model" (Just horseModel) ] ], OrbitalTransformNode "poll3" (Rotate 0 0 90) (Translate 0 0.45 0) [ ModelNode "poll3Model" (Just carouselPool), TransformNode "horse3" (Rotate 0 0 0) (Translate 0 0 0) [ ModelNode "horse3Model" (Just horseModel) ] ], OrbitalTransformNode "poll4" (Rotate 0 0 135) (Translate 0 0.45 0) [ ModelNode "poll4Model" (Just carouselPool), TransformNode "horse4" (Rotate 0 0 0) (Translate 0 0 0) [ ModelNode "horse4Model" (Just horseModel) ] ], OrbitalTransformNode "poll5" (Rotate 0 0 180) (Translate 0 0.45 0) [ ModelNode "poll5Model" (Just carouselPool), TransformNode "horse5" (Rotate 0 0 0) (Translate 0 0 0) [ ModelNode "horse5Model" (Just horseModel) ] ], OrbitalTransformNode "poll6" (Rotate 0 0 225) (Translate 0 0.45 0) [ ModelNode "poll6Model" (Just carouselPool), TransformNode "horse6" (Rotate 0 0 0) (Translate 0 0 0) [ ModelNode "horse6Model" (Just horseModel) ] ], OrbitalTransformNode "poll7" (Rotate 0 0 270) (Translate 0 0.45 0) [ ModelNode "poll7Model" (Just carouselPool), TransformNode "horse7" (Rotate 0 0 0) (Translate 0 0 0) [ ModelNode "horse7Model" (Just horseModel) ] ], OrbitalTransformNode "poll8" (Rotate 0 0 315) (Translate 0 0.45 0) [ ModelNode "poll8Model" (Just carouselPool), TransformNode "horse8" (Rotate 0 0 0) (Translate 0 0 0) [ ModelNode "horse8Model" (Just horseModel) ] ] ] ], TransformNode "carouselCeiling" (Rotate 90 0 0) (Translate 0 0.2 0) [ ModelNode "carouselCeilingModel" (Just carouselFloor) ] ] ] ] where groundModel = ClassicModel(0,0,0) (heightMapToVerts(genHeightMap 6 1 1.6 1.2 1.7) 0.1 0 3) carouselBase = GluShape (50,50,50) 0.55 0.550 0.55 0.550 0.550 0.550 1(Cylinder 0.5 0.5 0.05 20 20) (QuadricStyle(Just Smooth) NoTextureCoordinates Outside FillStyle) carouselRoof = GluShape (50,50,50) 0.55 0.55 0.55 0.550 0.550 0.550 1(Cylinder 0.001 0.5 0.1 20 20) (QuadricStyle(Just Smooth) NoTextureCoordinates Outside FillStyle) carouselPool = GluShape (50,50,50) 0.55 0.55 0.55 0.550 0.550 0.550 1(Cylinder 0.005 0.005 0.2 20 20) (QuadricStyle(Just Smooth) NoTextureCoordinates Outside FillStyle) carouselFloor = GluShape (50,50,50) 0.55 0.55 0.55 0.550 0.550 0.550 1(Disk 0 0.5 20 20) (QuadricStyle(Just Smooth) NoTextureCoordinates Outside FillStyle) horseModel = GluShape (50,50,50) 0.55 0.55 0.55 0.550 0.550 0.550 1(Sphere 0.03 20 20) (QuadricStyle(Just Smooth) NoTextureCoordinates Outside FillStyle) SceneGraph module= module SimpleSceneGraph ( findNodeByID, updateSceneGraph, GraphChange(DeleteNode, AddNode, RotateNode, TranslateNode), Model(ClassicModel, ModernModel, GluShape), Translate(Translate), Rotate(Rotate), CameraPos(CameraPos), LookAt(LookAt), UpVector(UpVector), Vert(Vert), vertexTupleListToVertexList, initModelVBO, getChanges, identityMatrix, DrawSceneGraph, SimpleSceneGraph(SimpleRootNode,SimpleCameraNode, SimpleLightNode, ModelNode, TransformNode, OrbitalTransformNode), render, getColorAtPixel, pngToArray ) where import Graphics.Rendering.OpenGL import Data.IORef import Graphics.UI.GLUT import Foreign.Storable import Control.Monad.ST.Strict import Data.Array.MArray import Data.Array.Storable import Foreign.Ptr import qualified Data.Map as Map import qualified Data.HashTable as Hashtable import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility import Graphics.Rendering.GLU.Raw import Graphics.Rendering.OpenGL.GLU import Data.Int import Prelude import Codec.Image.PNG data OpenGLType = ClassicGL | ModernGL openGLType = ModernGL class DrawSceneGraph a where process:: a→ IO Bool data Translate = Translate { tx::GLfloat, ty::GLfloat, tz::GLfloat } data Rotate = Rotate{ angleX::GLfloat, angleY::GLfloat, angleZ::GLfloat} data CameraPos = CameraPos { cpx::GLdouble, cpy::GLdouble, cpz::GLdouble} data LookAt = LookAt { lx::GLdouble, ly::GLdouble, lz::GLdouble} data UpVector = UpVector { uvx::GLdouble, uvy::GLdouble, uvz::GLdouble} data SimpleSceneGraph = SimpleRootNode { nid::String, children::[SimpleSceneGraph]} |TransformNode { nid::String, rotation::Rotate, translation::Translate, children::[SimpleSceneGraph]} |OrbitalTransformNode { nid::String, rotation::Rotate, translation::Translate, children::[SimpleSceneGraph] } | ModelNode { nid::String, model::(Maybe Model) } -- | SimpleNode { -- nid::String, -- model::(Maybe Model), -- rotation::Rotate, -- translation::Translate, -- children::[SimpleSceneGraph]} | SimpleLightNode { nid::String, rotation::Rotate, translation::Translate, amb::Color4 GLfloat, diff::Color4 GLfloat, spec::Color4 GLfloat, children::[SimpleSceneGraph]} -- | OrbitalNode { -- nid::String, -- model::(Maybe Model), -- rotation::Rotate, -- translation::Translate, -- children::[SimpleSceneGraph]} | SimpleCameraNode { nid::String, cameraPos::CameraPos, lookAT:: LookAt, upVector::UpVector, children::[SimpleSceneGraph]} class RenderSimpleSceneGraph a where render :: Matrix4x4 → a → IO () data Matrix4x4 = Matrix4x4 { i1j1 ::GLfloat, i1j2 ::GLfloat, i1j3 ::GLfloat, i1j4 ::GLfloat, i2j1 ::GLfloat, i2j2 ::GLfloat, i2j3 ::GLfloat, i2j4 ::GLfloat, i3j1 ::GLfloat, i3j2 ::GLfloat, i3j3 ::GLfloat, i3j4 ::GLfloat, i4j1 ::GLfloat, i4j2 ::GLfloat, i4j3 ::GLfloat, i4j4 ::GLfloat } deriving (Show) identityMatrix = Matrix4x4 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 rotateX θ = if θ ≠ 0 then Matrix4x4 1 0 0 0 0 (cos rad) (-(sin rad)) 0 0 (sin rad) (cos rad) 0 0 0 0 1 else identityMatrix where rad = θ * pi / 180 rotateY θ = if θ ≠ 0 then Matrix4x4 (cos rad) 0 (sin rad) 0 0 1 0 0 (-(sin rad)) 0 (cos rad) 0 0 0 0 1 else identityMatrix where rad = θ * pi / 180 rotateZ θ = if θ ≠ 0 then Matrix4x4 (cos rad) (-(sin rad)) 0 0 (sin rad) (cos rad) 0 0 0 0 1 0 0 0 0 1 else identityMatrix where rad = θ * pi / 180 trans (Vector3 x y z) = Matrix4x4 1 0 0 x 0 1 0 y 0 0 1 z 0 0 0 1 mult:: Matrix4x4 → Matrix4x4 → Matrix4x4 mult mL mR = Matrix4x4 x1y1 x1y2 x1y3 x1y4 x2y1 x2y2 x2y3 x2y4 x3y1 x3y2 x3y3 x3y4 x4y1 x4y2 x4y3 x4y4 where x1y1 = (i1j1 mL) * (i1j1 mR) + (i1j2 mL) * (i2j1 mR) + (i1j3 mL) * (i3j1 mR) + (i1j4 mL) * (i4j1 mR) x1y2 = (i1j1 mL) * (i1j2 mR) + (i1j2 mL) * (i2j2 mR) + (i1j3 mL) * (i3j2 mR) + (i1j4 mL) * (i4j2 mR) x1y3 = (i1j1 mL) * (i1j3 mR) + (i1j2 mL) * (i2j3 mR) + (i1j3 mL) * (i3j3 mR) + (i1j4 mL) * (i4j3 mR) x1y4 = (i1j1 mL) * (i1j4 mR) + (i1j2 mL) * (i2j4 mR) + (i1j3 mL) * (i3j4 mR) + (i1j4 mL) * (i4j4 mR) x2y1 = (i2j1 mL) * (i1j1 mR) + (i2j2 mL) * (i2j1 mR) + (i2j3 mL) * (i3j1 mR) + (i2j4 mL) * (i4j1 mR) x2y2 = (i2j1 mL) * (i1j2 mR) + (i2j2 mL) * (i2j2 mR) + (i2j3 mL) * (i3j2 mR) + (i2j4 mL) * (i4j2 mR) x2y3 = (i2j1 mL) * (i1j3 mR) + (i2j2 mL) * (i2j3 mR) + (i2j3 mL) * (i3j3 mR) + (i2j4 mL) * (i4j3 mR) x2y4 = (i2j1 mL) * (i1j4 mR) + (i2j2 mL) * (i2j4 mR) + (i2j3 mL) * (i3j4 mR) + (i2j4 mL) * (i4j4 mR) x3y1 = (i3j1 mL) * (i1j1 mR) + (i3j2 mL) * (i2j1 mR) + (i3j3 mL) * (i3j1 mR) + (i3j4 mL) * (i4j1 mR) x3y2 = (i3j1 mL) * (i1j2 mR) + (i3j2 mL) * (i2j2 mR) + (i3j3 mL) * (i3j2 mR) + (i3j4 mL) * (i4j2 mR) x3y3 = (i3j1 mL) * (i1j3 mR) + (i3j2 mL) * (i2j3 mR) + (i3j3 mL) * (i3j3 mR) + (i3j4 mL) * (i4j3 mR) x3y4 = (i3j1 mL) * (i1j4 mR) + (i3j2 mL) * (i2j4 mR) + (i3j3 mL) * (i3j4 mR) + (i3j4 mL) * (i4j4 mR) x4y1 = (i4j1 mL) * (i1j1 mR) + (i4j2 mL) * (i2j1 mR) + (i4j3 mL) * (i3j1 mR) + (i4j4 mL) * (i4j1 mR) x4y2 = (i4j1 mL) * (i1j2 mR) + (i4j2 mL) * (i2j2 mR) + (i4j3 mL) * (i3j2 mR) + (i4j4 mL) * (i4j2 mR) x4y3 = (i4j1 mL) * (i1j3 mR) + (i4j2 mL) * (i2j3 mR) + (i4j3 mL) * (i3j3 mR) + (i4j4 mL) * (i4j3 mR) x4y4 = (i4j1 mL) * (i1j4 mR) + (i4j2 mL) * (i2j4 mR) + (i4j3 mL) * (i3j4 mR) + (i4j4 mL) * (i4j4 mR) matrix4x4toList (Matrix4x4 i1j1 i1j2 i1j3 i1j4 i2j1 i2j2 i2j3 i2j4 i3j1 i3j2 i3j3 i3j4 i4j1 i4j2 i4j3 i4j4) = [i1j1, i1j2,i1j3,i1j4,i2j1,i2j2,i2j3,i2j4,i3j1,i3j2,i3j3,i3j4,i4j1,i4j2,i4j3,i4j4] matrix4x4toGLMatrix (Matrix4x4 i1j1 i1j2 i1j3 i1j4 i2j1 i2j2 i2j3 i2j4 i3j1 i3j2 i3j3 i3j4 i4j1 i4j2 i4j3 i4j4)= newMatrix RowMajor matList :: IO (GLmatrix GLfloat) where matList = [i1j1, i1j2,i1j3,i1j4,i2j1,i2j2,i2j3,i2j4,i3j1,i3j2,i3j3,i3j4,i4j1,i4j2,i4j3,i4j4] classicTransform matrix = do matrixMode $= Modelview 0 loadIdentity print "classic matrix operation" m ← newMatrix RowMajor (matrix4x4toList matrix) :: IO (GLmatrix GLfloat) multMatrix m return () data GraphChange = DeleteNode { cid ::String} | RotateNode { cid ::String, cx ::GLfloat, cy ::GLfloat, cz ::GLfloat} | TranslateNode { cid ::String, cx ::GLfloat, cy ::GLfloat, cz ::GLfloat} | AddNode { parentid::String, newNode::SimpleSceneGraph} data Vert = Vert { vertX::GLfloat, vertY::GLfloat, vertZ::GLfloat, colorR::GLfloat, colorG::GLfloat, colorB::GLfloat, specR::GLfloat, specG::GLfloat, specB::GLfloat, shiny::GLfloat} deriving (Show) data Model = ClassicModel{ colorID::(GLubyte,GLubyte,GLubyte), verts::[Vert]} | GluShape{ colorID::(GLubyte,GLubyte,GLubyte), shapeR::GLfloat, shapeG::GLfloat, shapeB::GLfloat, shapeSpecR::GLfloat, shapeSpecG::GLfloat, shapeSpecB::GLfloat, shapeShiny::GLfloat, shape ::(QuadricPrimitive), style :: QuadricStyle} | ModernModel{ vboData:: IO BufferObject, vertCount:: Int } instance RenderSimpleSceneGraph Model where render matrix (ClassicModel (r,g,b) verts ) = do print "a model" classicTransform matrix --color $ Color3 r g b renderPrimitive Triangles $ mapM_ renderVert verts render matrix (GluShape (r, g ,b) r1 g1 b1 sR sG sB shiny shape style) = do color $ Color3 r1 g1 b1 materialAmbientAndDiffuse FrontAndBack $= (Color4 r1 g1 b1 1) materialSpecular FrontAndBack $= (Color4 sR sG sB 1) materialShininess FrontAndBack $= shiny renderQuadric style shape renderVert (Vert x y z r g b sR sG sB shiny) = do color $ Color3 r g b materialAmbientAndDiffuse FrontAndBack $= (Color4 r g b 1) materialSpecular FrontAndBack $= (Color4 sR sG sB 1) materialShininess FrontAndBack $= shiny vertex $ Vertex3 x y z instance RenderSimpleSceneGraph SimpleSceneGraph where render matrix (SimpleRootNode id children) = do --matrixMode $= Projection --loadIdentity --depthFunc $= Just Less --viewport $= (Position 0 0, Size 800 600) --perspective 60 1.333 1 120 clear [ColorBuffer, DepthBuffer] lighting $= Enabled light (Light 0) $= Enabled matrixMode $= Modelview 0 loadIdentity traverseChildren matrix children flush swapBuffers return () render matrix (ModelNode id model) = do --print $ "drawing" ⊕ id --show matrix case model of Nothing → return() Just model1 → render matrix model1 render matrix (OrbitalTransformNode id (Rotate aX aY aZ) (Translate x y z) children) = do print $ "drawing" ⊕ id print translatedMat traverseChildren translatedMat children return () where rotatedXMat = (rotateX aX) `mult` matrix rotatedYMat = (rotateY aY) `mult`rotatedXMat rotatedZMat = (rotateZ aZ) `mult`rotatedYMat translatedMat = (trans (Vector3 x y z)) `mult` rotatedZMat render matrix (TransformNode id (Rotate aX aY aZ) (Translate x y z) children) = do print $ "drawing" ⊕ id print rotatedZMat traverseChildren rotatedZMat children return () where translatedMat = (trans (Vector3 x y z)) `mult` matrix rotatedXMat = (rotateX aX) `mult` translatedMat rotatedYMat = (rotateY aY) `mult` rotatedXMat rotatedZMat = (rotateZ aZ) `mult` rotatedYMat render matrix (SimpleLightNode nid rotation translation amb diff spec children) = do ambient (Light 0) $= amb diffuse (Light 0) $= diff specular (Light 0) $= spec position (Light 0) $= (Vertex4 1 1 1 0) where transX = tx translation transY = ty translation transZ = tz translation --angleRot = rangle rotation --rotX = rx rotation --rotY = ry rotation --rotZ = rz rotation translateRotateDraw = do --translate (Vector3 transX transY transZ) --rotate angleRot (Vector3 rotX rotY rotZ) traverseChildren matrix children --render matrix (SimpleNode id model rotation translation children) = do -- print $ "drawing" ⊕ id -- preservingMatrix translateRotateDraw -- return () -- where -- transX = tx translation -- transY = ty translation -- transZ = tz translation -- angleRot = rangle rotation -- rotX = rx rotation -- rotY = ry rotation -- rotZ = rz rotation -- translateRotateDraw = do -- -- translate (Vector3 transX transY transZ) -- rotate angleRot (Vector3 rotX rotY rotZ) -- traverseChildren matrix children -- case model of -- Nothing → return () -- Just m1 → render matrix m1 --render matrix (OrbitalNode id model rotation translation children) = do -- print $ "drawing" ⊕ id -- preservingMatrix translateRotateDraw -- return () -- where -- transX = tx translation -- transY = ty translation -- transZ = tz translation -- angleRot = rangle rotation -- rotX = rx rotation -- rotY = ry rotation -- rotZ = rz rotation -- translateRotateDraw = do -- rotate angleRot (Vector3 rotX rotY rotZ) -- translate (Vector3 transX transY transZ) -- traverseChildren matrix children -- case model of -- Nothing → return () -- Just m1 → render matrix m1 render matrix (SimpleCameraNode id (CameraPos posX posY posZ) (LookAt lookX lookY lookZ) (UpVector upX upY upZ) children) = do print $ "drawing" ⊕ id gluLookAt posX posY posZ lookX lookY lookZ upX upY upZ traverseChildren matrix children return () traverseChildren:: Matrix4x4 → [SimpleSceneGraph]→ IO () traverseChildren matrix (x:xs) = do render matrix x traverseChildren matrix xs traverseChildren _ [] = do return () initModelVBO :: [GLfloat] → IO BufferObject initModelVBO vertexList = do [models]← genObjectNames 1 :: IO [BufferObject] bindBuffer ArrayBuffer $= Just models tempArray ← newListArray (0, listLen - 1) vertexList :: IO(StorableArray Int GLfloat) withStorableArray tempArray (λptr -> bufferData ArrayBuffer $= (sizeOfList, ptr, StaticDraw)) bindBuffer ArrayBuffer $= Nothing return models where listLen = length vertexList elementSize = sizeOf $ head vertexList sizeOfList = toEnum $ listLen * elementSize vertexTupleListToVertexList::[(GLfloat,GLfloat,GLfloat)]→ [GLfloat] vertexTupleListToVertexList [] = [] vertexTupleListToVertexList ((x,y,z):verts) = x:y:z:vertexTupleListToVertexList verts --Takes a list of changes, should be hashtable though, and a SceneGraph --It then recursivly rebuild the graph making any change in the changes --data structure updateSceneGraph :: Map.Map String [GraphChange]→ SimpleSceneGraph → SimpleSceneGraph -- A root node can ¬ be changed or deleted and can only apear once as the ROOT --failing to follow these rules will result in undefined behaviors updateSceneGraph changes (SimpleRootNode id children) = SimpleRootNode id (updateChildren children changes) updateSceneGraph changes graph = graph findNodeByID id graph = if graphID ≡ id then Just graph else findNodeByIDChildren Nothing id (children graph) where graphID = nid graph findNodeByIDChildren (Just graph) _ _ = Just graph findNodeByIDChildren accum id (c:cs) = findNodeByIDChildren (findNodeByID id c) id cs findNodeByIDChildren accum _ [] = accum updateChildren :: [SimpleSceneGraph] → Map.Map String [GraphChange] → [SimpleSceneGraph] updateChildren [] changes = [] updateChildren (n:ns) changes = case newN of Nothing → (updateChildren ns changes) Just node → node:(updateChildren ns changes) where nodeID = nid n newN = applyAllChanges (Just n) applicableChanges changes applicableChanges = getChanges nodeID changes --Takes a String node id and returns all changes that apply to it getChanges::String→ Map.Map String [GraphChange]→ [GraphChange] getChanges id map = case changes of Nothing → [] Just cs → cs where changes = Map.lookup id map --Applies all changes for a node to that node applyAllChanges::(Maybe SimpleSceneGraph) → [GraphChange] → Map.Map String [GraphChange] → (Maybe SimpleSceneGraph) applyAllChanges Nothing _ _ = Nothing applyAllChanges (Just node) (c:cs) allChanges = applyAllChanges (updateNode node c ) cs allChanges applyAllChanges (Just (TransformNode id rotation trans children)) [] allChanges = Just (TransformNode id rotation trans (updateChildren children allChanges)) applyAllChanges (Just (OrbitalTransformNode id rotation trans children)) [] allChanges = Just (OrbitalTransformNode id rotation trans (updateChildren children allChanges)) applyAllChanges (Just (ModelNode id model)) [] allChanges = Just (ModelNode id model) applyAllChanges (Just (SimpleCameraNode id pos look up children)) [] allChanges = Just (SimpleCameraNode id pos look up (updateChildren children allChanges)) applyAllChanges ( Just(SimpleLightNode id rot trans amb diff spec children)) [] allChanges = Just (SimpleLightNode id rot trans amb diff spec (updateChildren children allChanges)) --Updates a single node with a single Change --Returns Just Node or Nothing if a delete change was requested updateNode:: SimpleSceneGraph→ GraphChange→ (Maybe SimpleSceneGraph) updateNode (SimpleCameraNode id pos lookat up children) (TranslateNode tId x y z)= Just (SimpleCameraNode id (CameraPos (realToFrac x) (realToFrac y) (realToFrac z)) lookat up children) updateNode (TransformNode id rotation translation children) (TranslateNode tId x y z)= Just (TransformNode id rotation (Translate x y z) children) updateNode (TransformNode id rotation translation children) (RotateNode tId x y z)= Just (TransformNode id (Rotate x y z) translation children) updateNode (TransformNode id rotation translation children) _= Just (TransformNode id rotation translation children) --updateNode (OrbitalNode id model rotation translation children) (TranslateNode tId x y z)= -- Just (OrbitalNode id model rotation (Translate x y z) children) --updateNode (OrbitalNode id model rotation translation children) (RotateNode tId r x y z)= --Just (OrbitalNode id model (Rotate r x y z) translation children) updateNode (OrbitalTransformNode id rotation translation children) _= Just (OrbitalTransformNode id rotation translation children) updateNode (ModelNode id model) _ = Just(ModelNode id model) updateNode _ (DeleteNode id) = Nothing pngToArray (Right png) = do Just (imageData png) pngToArray (Left error) = do Nothing getColorAtPixel x y = do colorArray ← newArray (0, 2) 0 :: IO(StorableArray Int Int) vp ← get viewport adjustedY ← return $ adjustY vp withStorableArray colorArray (λptr -> readPixels (Position x (fromIntegral adjustedY)) (Size 1 1 ) (PixelData RGB UnsignedByte ptr)) touchStorableArray colorArray colors ← getElems colorArray return $ head colors where adjustY vp = (extractSizeY vp) - y extractSizeY (_, (Size x y)) = fromIntegral y :: GLint

1 1