# Show the hierachy of an OSG file in a treeview widget.

package require Tk
package require tile
package require tablelist
package require tcl3d

proc bgerror { msg } {
    puts "Error: $msg\n$::errorInfo"
}

proc tcl3dCreateScrolledTreeview { wid titleStr args } {
    return [eval {tcl3dCreateScrolledWidget ttk::treeview $wid $titleStr} $args ]
}

proc NodeBmp {} {
return {
#define Node_width 16
#define Node_height 16
static char Node_bits[] = {
  0x00, 0x00,
  0x00, 0x00,
  0xf8, 0x07,
  0x08, 0x0c,
  0x08, 0x14,
  0x08, 0x3c,
  0x48, 0x20,
  0xc8, 0x20,
  0xfe, 0x21,
  0xfe, 0x21,
  0xc8, 0x20,
  0x48, 0x20,
  0x08, 0x20,
  0x08, 0x20,
  0xf8, 0x3f,
  0x00, 0x00};
}
}

proc NodeRefBmp {} {
return {
#define NodeRef_width 16
#define NodeRef_height 16
static char NodeRef_bits[] = {
  0x00, 0x00,
  0x00, 0x00,
  0xfc, 0x00,
  0x84, 0x01,
  0x84, 0x02,
  0x84, 0x07,
  0x04, 0x14,
  0x04, 0x34,
  0xc4, 0x7f,
  0xc4, 0x7f,
  0x04, 0x34,
  0x04, 0x14,
  0x04, 0x04,
  0x04, 0x04,
  0xfc, 0x07,
  0x00, 0x00};
}
}

proc visit { node args } {
    global gWidgets gTreeRootId gGraphParents

    puts "visit $node"

    set retVal [catch {osg::Object_getName $node} nodeName]
    if { $retVal != 0 } {
        puts "Warning: Unknown node $node"
        return
    }
    if { $nodeName eq "" } {
        set nodeName "Name not set"
    }
    set nodeType [osg::Object_className $node]
    scan $node "_%lx" nodeAddr

    set n [osg::Node_getNumParents $node]
    if { $n == 0 || ! [info exists gTreeRootId] } {
        # This node does not have a parent or it is the first node encountered.
        set gTreeRootId [$gWidgets(treeView) insert {} end -id $nodeAddr \
            -text $nodeName -open true \
            -tags $node -values [list $nodeType]]
    } elseif { $n == 1 } {
        # This node has exactly 1 parent. Thus we can insert it into the tree easily.
        set parent [osg::Node_getParent $node 0]
        puts -nonewline " [osg::Object_getName $parent]"
        scan $parent "_%lx" parentAddr
        $gWidgets(treeView) insert $parentAddr end -id $nodeAddr \
            -text $nodeName -open false \
            -tags $node -values [list $nodeType]
    } else {
        # We have a node with more than 1 parent, i.e. it is a graph and not a tree.
        set insertItem false
        for { set i 0 } { $i < $n } { incr i } {
            set parent [osg::Node_getParent $node $i]
            puts -nonewline " [osg::Object_getName $parent]"
            scan $parent "_%lx" parentAddr

            if { $insertItem == false } {
                if { ! [info exists gGraphParents($nodeAddr)] } {
                    # First time this node is encountered.
                    set insertItem true
                    set nodeImg [image create bitmap -data [NodeBmp]]
                    set gGraphParents($nodeAddr) 1
                    set gGraphParents($nodeAddr,$parentAddr) 1
                    set nodeId $nodeAddr
                } elseif { [info exists gGraphParents($nodeAddr,$parentAddr)] } {
                    # This node has already been inserted with the given parent.
                    set insertItem false
                } else {
                    # This node has already been inserted previously. Now a reference
                    # must be inserted.
                    set insertItem true
                    set nodeImg [image create bitmap -data [NodeRefBmp]]
                    set gGraphParents($nodeAddr,$parentAddr) 1
                    set nodeId ${nodeAddr}_$i
                }

                if { $insertItem } {
                    $gWidgets(treeView) insert $parentAddr end -id $nodeId \
                        -text $nodeName -open true \
                        -tags $node -values [list $nodeType]
                    $gWidgets(treeView) item $nodeId -image $nodeImg
                }
            }
        }
    }
}

proc ShowNodeProperties { treeId tableId } {
    set selList [$treeId selection]
    set treeItem [lindex $selList 0]
    set node [$treeId item $treeItem -tags] 

    set nodeName     [osg::Object_getName $node]
    if { $nodeName eq "" } {
        set nodeName "Name not set"
    }
    set nodeType     [osg::Object_className $node]
    set nodeMask     [osg::Node_getNodeMask $node]
    set nodeStateSet [osg::Node_getStateSet $node]

    $tableId delete 0 end
    $tableId insert end [list "Name" $nodeName]
    $tableId insert end [list "Type" $nodeType]
    $tableId insert end [list "Mask" [format "%0X" $nodeMask]]
    $tableId insert end [list "State Set" $nodeStateSet]

    set n [osg::Node_getNumDescriptions $node]
    for { set i 0 } { $i < $n } { incr i } {
        set desc [osg::Node_getDescription $node $i]
        $tableId insert end [list "Description-$i" $desc]
    }
}

if { $argc < 1 } {
    puts "Usage: $argv0 OSG-File"
    exit 1
}

set fileName [lindex $argv 0]
set rootNode [osgDB::readNodeFile $fileName]
if { $rootNode eq "NULL" } {
    puts "OSG file $fileName could not be loaded"
    exit 1
}

wm title . "$argv0 - $fileName"

ttk::frame .frTree
ttk::frame .frList
pack .frTree .frList -side left -expand true -fill both

set treeView [tcl3dCreateScrolledTreeview .frTree "Hierarchy" -columns [list "Type"]]
$treeView heading #0 -text "Tree"
$treeView heading 0 -text "Type"
set gWidgets(treeView) $treeView

set tableList [tcl3dCreateScrolledTablelist .frList "Properties" \
                -width 60 -height 10 -exportselection false \
                -columns {0 "Property" "left"
                          0 "Value"    "left" } \
                -setfocus 1 \
                -stripebackground #e0e8f0 \
                -selectmode extended \
                -labelcommand tablelist::sortByColumn \
                -showseparators yes]

bind $treeView <<TreeviewSelect>> "ShowNodeProperties $treeView $tableList"

bind . <Escape> exit

set travMode $::osg::NodeVisitor_TRAVERSE_NONE
set travMode $::osg::NodeVisitor_TRAVERSE_PARENTS
set travMode $::osg::NodeVisitor_TRAVERSE_ALL_CHILDREN

osg::tcl3dOsgNodeVisitor nv $travMode
nv setVisitorType $::osg::NodeVisitor_NODE_VISITOR
nv setVisitorProc visit

puts "NodeVisitor properties:"
puts "Traversal mode: [tcl3dOsgGetTraversalModeName $travMode]"
puts [format "Traversal mask: %0X"  [nv getTraversalMask]]
puts "Visitor type  : [tcl3dOsgGetVisitorTypeName [nv getVisitorType]]"
puts "Visitor proc  : [nv getVisitorProc]"

osg::Node_accept $rootNode nv
