[Haskell-beginners] pattern for tree traversel with a state
Andreas-Christoph Bernstein
andreas.bernstein at medien.uni-weimar.de
Thu Oct 23 13:35:01 EDT 2008
hi,
well i dont know about any haskell wrapper for openscenegraph. There are
some python wrappers. (pyosg, avango).
What i want to do is to use haskell for some simple graphics hacking,
demo effects and to test ideas.
Kind regards,
Andreas
C.M.Brown wrote:
> Andreas-Christoph,
>
> I'm afraid I can't help answering your question, but I was wondering what
> you were using to create your scene graph? I'm currently having to use
> OpenSceneGraph in C++, and would be grateful if you knew of some kind of
> Haskell wrapper for this?
>
> Kind regards,
> Chris.
>
>
> On Thu, 23 Oct 2008, Andreas-Christoph Bernstein wrote:
>
>
>> Hi,
>>
>> Is there a pattern for tree traversal with a state ?
>>
>> I am developing a small scenegraph represented by a tree. To draw a
>> scenegraph one traverses over the graph starting with a global state.
>> Inner Nodes can overwrite the inherited state for their subtree (e.g.
>> Transformations are accumulated). The accumulated state is then either
>> used immediately to draw the geometry in the leaf nodes, or a secondary
>> data structure is build. This secondary data structure (a list or a
>> tree) can then be sorted for optimal drawing performance.
>>
>> So i want to do the second and create a list of all leaves with the
>> accumulated global state. To illustrate my problem i appended some code.
>> The idea similar applies to a scenegraph.
>>
>> So my Question is: Is there allready a pattern for traversal with a state ?
>>
>> > module Main
>> > where
>>
>> produces: Fork (0,"a") (Fork (1,"a") (Leaf (2,"a")) (Leaf (1,"a")))
>> (Leaf (0,"a"))
>>
>> > newTree :: BTree State
>> > newTree = traverse modState globalState sampleTree
>>
>> produces: [(0,"a"),(1,"a"),(2,"a"),(1,"a"),(0,"a")]
>>
>> > stateList = flattenTree newTree
>>
>> > flattenTree (Leaf x) = [x]
>> > flattenTree (Fork x l r) = [x] ++ flattenTree l ++ flattenTree r
>>
>> > type State = (Int, String)
>> >
>> > globalState :: State
>> > globalState = (0, "a")
>>
>> State modifiers
>>
>> > data StateMod
>> > = ModInt
>> > | ModString
>> > | ModNop
>> > deriving Show
>>
>> > modState :: StateMod -> State -> State
>> > modState ModInt (x,w) = (x+1,w)
>> > modState ModNop s = s
>> > modState ModString (x,w) = (x,'b':w)
>>
>> > data BTree a = Fork a (BTree a) (BTree a)
>> > | Leaf a
>> > deriving Show
>>
>> traverses the tree and executes a function which modifies the current
>> state depending on the statemodifier
>>
>> > traverse :: (a -> b -> b) -> b -> BTree a -> BTree b
>> > traverse f state (Leaf x) = Leaf (f x state)
>> > traverse f state (Fork x l r) =
>> > Fork (f x state) newLeft newRight
>> > where newLeft = traverse f (f x state) l
>> > newRight = traverse f (f x state) r
>>
>> an example tree
>>
>> > sampleTree :: BTree StateMod
>> > sampleTree = Fork ModNop
>> > (Fork ModInt (Leaf ModInt) (Leaf ModNop))
>> > (Leaf ModNop)
>>
>> creates a list from a tree
>>
>> > flattenTree (Leaf x) = [x]
>> > flattenTree (Fork x l r) = [x] ++ flattenTree l ++ flattenTree r
>>
>> Thanks for any help and ideas
>>
>> Andreas
>> _______________________________________________
>> Beginners mailing list
>> Beginners at haskell.org
>> http://www.haskell.org/mailman/listinfo/beginners
>>
>>
More information about the Beginners
mailing list