Re: Scene Graph manual transformation problem
Ben Christy <[email protected]> Thu, 11 Nov 2010 09:46:22 -0500
| Newsgroups | gmane.comp.lang.haskell.hopengl |
|---|---|
| Message-ID | <[email protected]> |
Ok fixed it. I was not applying the transformation to the GLUshape model type. But I have a new problem. It crashes I think I am overflowing the stack with all of the matrices being passed around. On Thu, Nov 11, 2010 at 8:27 AM, Ben Christy <[email protected]> wrote: > 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 > > > _______________________________________________ HOpenGL mailing list [email protected] http://www.haskell.org/mailman/listinfo/hopengl