[HOpenGL] Scene Graph manual transformation problem

11 Nov 2010


      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] Scene Graph manual transformation problem

Ben Christy