[HOpenGL] Re: Scene Graph manual transformation problem
Ben Christy
ben.christy at gmail.com
Thu Nov 11 09:46:22 EST 2010
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 <ben.christy at gmail.com> 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
>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/hopengl/attachments/20101111/4b2a1de2/attachment-0001.html
More information about the HOpenGL
mailing list