#jcosmo windows##############################################################

proc jcosmo {} {
    if {[winfo exists .jcosmo] == 1} {
	destroy .jcosmo
    }
    toplevel .jcosmo
    wm title .jcosmo "jCosmo"
    
    button .jcosmo.load -text "Load All" -command jcosmo_loadjava
    
    button .jcosmo.showallsmells -text "Show All Smells" \
	    -command jcosmo_showallsmells
    
    button .jcosmo.showsmellsbyclass -text "Show Smells by Class" \
	    -command jcosmo_showsmellsbyclass
    
    button .jcosmo.showsmellsbyclassnoempty -text "Show Smells by Class
    Filter ``Empty''" \
	    -command jcosmo_showsmellsbyclassnoempty
    
    button .jcosmo.filtercastwindow -text "Filter Cast Nodes" \
	    -command jcosmo_filtercastwindow
    
    button .jcosmo.hidesmelllabels -text "Hide Smell Labels" \
	    -command jcosmo_hidesmelllabels
    
    button .jcosmo.showsmelllabels -text "Show Smell Labels" \
	    -command jcosmo_showsmelllabels
    
    button .jcosmo.hidealllabels -text "Hide All Labels" \
	    -command jcosmo_hidealllabels
    
    button .jcosmo.showalllabels -text "Show All Labels" \
	    -command jcosmo_showalllabels
    
    button .jcosmo.showgradient -text "Show Casts by Gradient" \
	    -command "jcosmo_showgradient Cast"
    
    button .jcosmo.prunetree -text "Prune Tree" \
	    -command jcosmo_prunetree
    
    button .jcosmo.unprunetree -text "Unprune Tree" \
	    -command jcosmo_unprunetree
    
    button .jcosmo.exit -text "Exit jCosmo" \
	    -command "destroy .jcosmo"
    
    pack .jcosmo.load .jcosmo.showallsmells \
	    .jcosmo.showsmellsbyclass .jcosmo.showsmellsbyclassnoempty \
	    .jcosmo.filtercastwindow \
	    .jcosmo.hidesmelllabels .jcosmo.showsmelllabels \
	    .jcosmo.hidealllabels .jcosmo.showalllabels \
	    .jcosmo.showgradient \
	    .jcosmo.prunetree .jcosmo.unprunetree \
	    .jcosmo.exit \
	    -side top -fill x
}

proc jcosmo_filtercastwindow {} { 
    global typelist
    global direction

    if {[winfo exists .choose] == 1} {
	destroy .choose
    }
    toplevel .choose
    wm title .choose "Filter Cast Nodes"

    label .choose.labelshowcasts -text "Show Casts"

    radiobutton .choose.to -text "To" -variable direction \
	    -value to
    radiobutton .choose.from -text "From" -variable direction \
	    -value from

    label .choose.labeltypes -text "Types:"
    entry .choose.entry -width 20 -relief sunken -bd 2 -textvariable typelist
    
    button .choose.filtercast -text "Filter now" \
	    -command "filternow .choose.entry"
    
    pack .choose.labelshowcasts .choose.to .choose.from \
	    .choose.labeltypes .choose.entry \
	    .choose.filtercast -side left
    
    proc filternow {entrywidget} {
	global direction
	set filterlist [$entrywidget get]
	filtercastlist $direction $filterlist
    }
}

#jcosmo command line procedures##############################################

proc jcosmo_loadjava {} {
    set_domain java 0
    rcl_env_set DBDIR .
    rcl_load   
    rcl_grid_all
    rcl_refresh
}

proc jcosmo_showsmellsbyclass {} {
    rcl_win_set_drawing 0
    jcosmo_loadjava
    collapsesubtreeandshowsmells Class {Cast Switch Instanceof}
    collapsetree Interface contain out
    clean
    springlayout
    rcl_win_set_drawing 1
    rcl_refresh
}

proc jcosmo_showsmellsbyclassnoempty {} {
    rcl_win_set_drawing 0
    jcosmo_loadjava
    collapsesubtreeandshowsmells Class {Cast Switch Instanceof}
    collapsetree Interface contain out
    clean
    hideemptyclassorinterface
    springlayout
    rcl_win_set_drawing 1
    rcl_refresh
}

proc jcosmo_showallsmells {} {
   rcl_win_set_drawing 0
   jcosmo_loadjava
   rcl_filter_nodetype Unknown 1
   rcl_filter_nodetype Variable 1
   #rcl_filter_nodetype Cast 1
   #rcl_filter_nodetype Instanceof 1
   #rcl_filter_nodetype Switch 1
   rcl_filter_arctype call 1
   rcl_filter_arctype access 1
   rcl_filter_apply 1 any
   collapsestrays Method Variable
   springlayout
   rcl_win_set_drawing 1
   rcl_refresh
}

proc jcosmo_showdepen {ntype} {
    rcl_win_set_drawing 0
    jcosmo_loadjava
    if { $ntype == "Class" } {
	collapsetree Interface contain out
	collapsestrays Method Variable
    } elseif { $ntype == "Package" } {
	collapsetree Interface contain out
	collapsetree Class contain out
        collapsestrays Method Variable Class
    }
    collapsetree $ntype contain out
    rcl_filter_nodetype Unknown 1
    rcl_filter_apply 1 any
    spring any 1
    rcl_win_set_drawing 1
    rcl_refresh
}

proc jcosmo_hidesmelllabels {} {
    rcl_select_type Cast
    if { [ llength [ rcl_select_get_list ] ] > 0 } {
	rcl_filter_hide_name
    }
    rcl_select_type Switch
    if { [ llength [ rcl_select_get_list ] ] > 0 } {
	rcl_filter_hide_name
    }
    rcl_select_type Instanceof
    if { [ llength [ rcl_select_get_list ] ] > 0 } {
	rcl_filter_hide_name
    }
    rcl_select_all
}

proc jcosmo_showsmelllabels {} {
    rcl_select_type Cast
    if { [ llength [ rcl_select_get_list ] ] > 0 } {
	rcl_filter_show_name
    }
    rcl_select_type Switch
    if { [ llength [ rcl_select_get_list ] ] > 0 } {
	rcl_filter_show_name
    }
    rcl_select_type Instanceof
    if { [ llength [ rcl_select_get_list ] ] > 0 } {
	rcl_filter_show_name
    }
    rcl_select_all
}

proc jcosmo_showalllabels {} {
    rcl_select_all
    rcl_filter_show_name 
    rcl_refresh
}

proc jcosmo_hidealllabels {} {
    rcl_select_all
    rcl_filter_hide_name 
    rcl_refresh
}

#to or from and then a list of types
proc jcosmo_filtercast {dir args} {
    set arglist {}
    foreach arg $args {
	lappend arglist $arg
    }
    filtercastlist $dir $arglist
}

proc jcosmo_showgradient {smell} {
    rcl_win_set_drawing 0
    jcosmo_loadjava
    rcl_filter_nodetype Unknown 1
    rcl_filter_nodetype Variable 1
    rcl_filter_nodetype Cast 1
    rcl_filter_nodetype Switch 1
    rcl_filter_nodetype Interface 1
    rcl_filter_nodetype Instanceof 1
    rcl_filter_arctype call 1
    rcl_filter_arctype access 1
    rcl_filter_apply 1 any
    collapsestrays Method Variable
    rcl_node_delete [rcl_get_node_id Miscellaneous]
    gradient $smell
    hidearctypes all
    jcosmo_hidealllabels
    rcl_win_set_drawing 1
    rcl_refresh
}

proc jcosmo_unprunetree {} {
    rcl_win_set_drawing 0
    shownodetypes Collapse
    unprunetree
    rcl_select_all
    rcl_filter_hide_name
    hidenodetypes Collapse
    hidearctypes contain
    rcl_win_set_drawing 1
    rcl_refresh
}

proc jcosmo_prunetree {} {
    set list [rcl_select_get_list]
    if { [llength $list] != 1 } {
	puts "Please select one node for prune tree."
    } else {
	rcl_win_set_drawing 0
	shownodetypes Collapse
	showarctypes contain
        set node [lindex $list 0]
	prunetreeofnode $node  
	rcl_select_all
	rcl_filter_show_name  
	hidenodetypes Collapse
	rcl_win_set_drawing 1
	rcl_refresh
    }  
}

#########################################################################


proc shownodetypes {args} {
    if {[lindex $args 0] == "all"} {
	set args [rcl_get_nodetypes]
    }
    foreach type $args {
	if {[rcl_filter_nodetype_filtered $type 1] == 1} {
	    rcl_filter_nodetype $type 1
	    rcl_filter_apply 1 node
	}
    }
}

proc hidenodetypes {args} {
    if {[lindex $args 0] == "all"} {
	set args [rcl_get_nodetypes]
    }
    foreach type $args {
	if {[rcl_filter_nodetype_filtered $type 1] == 0} {
	    rcl_filter_nodetype $type 1
	    rcl_filter_apply 1 node
	}
    }
}

proc showarctypes {args} {    
    if {[lindex $args 0] == "all"} {
	set args [rcl_get_arctypes]
    }
    foreach type $args {
	if {[rcl_filter_arctype_filtered $type 1] == 1} {
	    rcl_filter_arctype $type 1
	    rcl_filter_apply 1 arc
	}
    }
}

proc hidearctypes {args} {
    if {[lindex $args 0] == "all"} {
	set args [rcl_get_arctypes]
    }
    foreach type $args {
	if {[rcl_filter_arctype_filtered $type 1] == 0} {
	    rcl_filter_arctype $type 1
	    rcl_filter_apply 1 arc
	}
    }
}

proc unprunetree {} {
    rcl_select_name jcosmo_pruned
    if {[llength [rcl_select_get_list]] != 0} {
	rcl_expand
    }
}

proc selecttreeoftypes {startnode arctypes} {
    set nodelist {}
    foreach arctype $arctypes {
	rcl_set_current_arctype $arctype
        rcl_select_id $startnode
	rcl_select_forward_tree
	set nodelist  [concat $nodelist [rcl_select_get_list]]
	
	rcl_select_id $startnode
	rcl_select_reverse_tree
	set nodelist [concat $nodelist [rcl_select_get_list]]
    }
    return $nodelist
}

proc prunetreeofnode {startnode} {
    unprunetree

    #open up any aggregate nodes created by gradient
    rcl_select_grep Collapsed*
    set agg [rcl_select_get_list]
    foreach node $agg {
	rcl_select_id $node
	rcl_expand
    }

    rcl_select_id $startnode
    set tree [selecttreeoftypes $startnode {contain} ]
    rcl_select_all
    foreach treenode $tree {
	rcl_select_deselect_id $treenode
    }

    if {[llength [rcl_select_get_list]] != 0} {
	rcl_collapse
	rcl_node_rename jcosmo_pruned
    }
}

# take the view produced by showallsmells or showsmellsbyclass and
# display as spring layout: need to add object class and arcs to it
proc springlayout {} {
    #create new root node
    set rootname System
    rcl_node_create System $rootname 1 0 0
    
    #create arcs
    rcl_select_type Class
    set highlevelnodes [rcl_select_get_list]
    #rcl_select_type Interface
    #set highlevelnodes [concat $highlevelnodes [rcl_select_get_list]]
    rcl_select_type Package
    set highlevelnodes [concat $highlevelnodes [rcl_select_get_list]]
    
    foreach highlevelnode $highlevelnodes {
	#check to see if there are any incoming arcs for this node
	set arclist [rcl_node_get_arclist $highlevelnode any in 1 1]
	#puts "node [rcl_get_node_name $highlevelnode] has arcs $arclist length [llength $arclist]"
	if { [llength $arclist] == 0 } {
	    rcl_arc_create2 [rcl_get_node_id $rootname] $highlevelnode contain
	}
    }

    #remove "miscellaneous" node
    rcl_select_name Miscellaneous
    rcl_cut

    #do the layout and display
    spring
    rcl_select_all
    rcl_filter_hide_name
}
    


# By JMartin
# For all nodes of type ntype:
# - collapse all nodes that are connected to the node with an arc of 
#   type atype (the direction of the connection is dir) to a single node.
# - redirect all arcs going to or coming from the node to the
#   new collapsed node.
# - give the new collapsed node the name of the original node
#   delete the original node
# an exampe of usage: c_collapse Function isDefinedIn in
proc c_collapse2 {ntype atype dir} {
    rcl_select_type $ntype
    set winnodes [rcl_select_get_list]
    
    foreach node $winnodes {
        rcl_select_id $node
        select_neighbors $atype $dir 1
        rcl_select_deselect_id $node
        if { [ llength [ rcl_select_get_list ] ] >= 1 } {
            if { [ rcl_collapse $ntype [ rcl_get_node_name $node ] ] == 0} { 
                return 
            }
            set id [rcl_select_get_list]
	    
            set arclist [ rcl_node_get_arclist $node any out 1 1 ]
            foreach arc $arclist {
                set type [rcl_get_arc_type $arc]
                set dst [rcl_get_arc_dst $arc]
                if { $id != $dst } {
                    rcl_arc_create2 $id $dst $type
                }
            }
            set arclist [ rcl_node_get_arclist $node any in 1 1 ]
            foreach arc $arclist {
                set type [rcl_get_arc_type $arc]
                set src [rcl_get_arc_src $arc]
                if { $src != $id } {
                    rcl_arc_create2 $src $id $type
                }
            }
            rcl_node_delete $node
        }
    }
}

#collapse the whole forward tree of each node of type nodetype, and show any nodes of smelltypes attached to outer node while duplicated inside
proc collapsesubtreeandshowsmells {nodetype smelltypes} {

    rcl_select_type $nodetype
    set nodes [rcl_select_get_list]

    foreach node $nodes {
        rcl_select_id $node
	rcl_set_current_arctype contain
	rcl_select_forward_tree
        rcl_select_deselect_id $node
	
	set fwd [rcl_select_get_list]
	
        if { [ llength [ rcl_select_get_list ] ] >= 1 } {
	    #collapse selected nodes into a node with $node's name 
	    #and return if there's a problem
	    set collapsenodes [rcl_collapse $nodetype [rcl_get_node_name $node]]
	    if {$collapsenodes == 0} { 
		return 
	    }
	    set newnode [rcl_select_get_list]
	    
	    set arclist [ rcl_node_get_arclist $node any out 1 1 ]
	    foreach arc $arclist {
		set type [rcl_get_arc_type $arc]
		set dst [rcl_get_arc_dst $arc]
		if { $newnode != $dst } {
		    rcl_arc_create2 $newnode $dst $type
		}
            }
            set arclist [ rcl_node_get_arclist $node any in 1 1 ]
            foreach arc $arclist {
		set type [rcl_get_arc_type $arc]
		set src [rcl_get_arc_src $arc]
		if { $src != $newnode } {
		    rcl_arc_create2 $src $newnode $type
		}
            }
	    
	    #make nodes and arcs to show the smell nodes on the outside 
	    #of the node
	    
	    foreach sname $smelltypes {
		set nodenum 0
		set stype [gettypecode $sname]
		foreach fnode $fwd {
		    if {[rcl_get_node_type $fnode] == $stype} {
			set name [rcl_get_node_name $fnode]
			set tempname "[rcl_get_node_name $node].$sname.$nodenum"
			rcl_node_create $sname "$tempname" 1 100 100
			rcl_arc_create2 $collapsenodes [rcl_get_node_id $tempname] contain
			rcl_node_rename "$name" [rcl_get_node_id $tempname]
			incr nodenum
		    } 
		}
	    }
	    
            rcl_node_delete $node
        }
    }
}

#show the contents of a list of nodes for debugging purposes
proc readlist {nodelist} {
    foreach node $nodelist {
	puts "[rcl_get_node_name $node]($node)  "
    }
}

proc filter {} {
    rcl_filter_nodetype Unknown 1
    #rcl_filter_nodetype Method 1
    #rcl_filter_nodetype Variable 1
    rcl_filter_arctype call 1
    rcl_filter_arctype access 1
    rcl_filter_apply 1 any
}

proc clean {} {
    filter
    collapsestrays Method Variable
}

#collapse nodes of given types if they aren't contained by anything
proc collapsestrays {args} {

    set dc {}
    foreach nodetype $args {
	set dc [concat $dc [getdisconnected $nodetype contain in]]
    }
    rcl_select_all
    foreach node $dc {
	#puts "in dc: [rcl_get_node_name $node]"
	rcl_select_deselect_id $node
    }
    rcl_select_invert
    if { [llength [rcl_select_get_list ]] < 1 } {
	return
    }
    rcl_collapse
    rcl_node_rename Miscellaneous
    rcl_select_all
}

#return a list of nodes of type ntype that have no arcs of direction dir
#and type atype
proc getdisconnected {ntype atype dir} {
    rcl_select_type $ntype
    set nodes [rcl_select_get_list]
    
    set dc {}
    foreach node $nodes {
	set connect [rcl_node_get_neighbors_in_window $node $atype $dir]
	if {[llength $connect] < 1} {
	    lappend dc $node
	}
    }
    return $dc
}

#same as c_collapse2 except that the whole forward tree is collapsed
proc collapsetree {ntype atype dir} {
    rcl_select_type $ntype
    set winnodes [rcl_select_get_list]
    
    foreach node $winnodes {
        rcl_select_id $node
	rcl_set_current_arctype contain
	rcl_select_forward_tree
        rcl_select_deselect_id $node
        if { [ llength [ rcl_select_get_list ] ] >= 1 } {
            if { [ rcl_collapse $ntype [ rcl_get_node_name $node ] ] == 0} { 
                return 
            }
            set id [rcl_select_get_list]
	    
            set arclist [ rcl_node_get_arclist $node any out 1 1 ]
            foreach arc $arclist {
                set type [rcl_get_arc_type $arc]
                set dst [rcl_get_arc_dst $arc]
                if { $id != $dst } {
                    rcl_arc_create2 $id $dst $type
                }
            }
            set arclist [ rcl_node_get_arclist $node any in 1 1 ]
            foreach arc $arclist {
                set type [rcl_get_arc_type $arc]
                set src [rcl_get_arc_src $arc]
                if { $src != $id } {
                    rcl_arc_create2 $src $id $type
                }
            }
	    #put the new node where the old one was
	    set position [rcl_get_node_position $node]
	    rcl_set_node_position $id [lindex $position 0] [lindex $position 1]
            rcl_node_delete $node
        }
    }
}

#get all children (at any level)
proc getchildren {parenttype childtype thearray} {	
    rcl_select_type $parenttype
    set parents [rcl_select_get_list]
    if {$parenttype == "Method"} {
	#puts "getchildren called with Method"
	rcl_select_type Constructor
	set cons [rcl_select_get_list]
	set parents [concat $parents $cons]
    }
    
    upvar $thearray children
    foreach parent $parents {
	#puts "parent: [rcl_get_node_name $parent], id: $parent"
	rcl_select_id $parent
	rcl_select_forward_tree
	rcl_select_deselect_id $parent
	set neighbours [rcl_select_get_list]
	set children($parent) {}
	if {$childtype == "all"} {
	    set children($parent) $neighbours
	} else {
	    foreach child $neighbours {
		if {[gettypecode $childtype] == [rcl_get_node_type $child]} {
		    #puts "adding [rcl_get_node_name $child]"
		    lappend children($parent) $child
		    #puts "children $parent $children($parent)"
		}
	    }
	}
     }
}
	
proc gettypecode {name} {
	set nt(Collapse) 0
	set nt(System) 1
	set nt(Release) 2
	set nt(Revison) 3
	set nt(Composite) 4
	set nt(Class) 5
	set nt(Method) 6
	set nt(Constructor) 7
	set nt(Variable) 8
	set nt(Interface) 9
	set nt(Staticblock) 10
	set nt(Exception) 11
	set nt(Package) 12
	set nt(Unknown) 13
	set nt(Cast) 14
	set nt(Instanceof) 15
	set nt(Switch) 16
	return $nt($name)
}

#use this after showsmellsbyclass to remove classes that contain no smells
#this will also remove all the interface nodes
proc hideemptyclassorinterface {} {
    rcl_select_type Class
    set classes [rcl_select_get_list]
    rcl_select_type Interface
    set classes [concat $classes [rcl_select_get_list]]

    foreach class $classes {
	rcl_select_id $class
	set arclist [rcl_node_get_arclist $class contain out 1 1]
	if {[llength $arclist] == 0} {
	    rcl_select_id $class
	    rcl_cut
	}
    }
}

#Hide all Cast nodes except those casting to the classes named as args.
#Use "filtercast all" to view all casts.
#Use jcosmo_filtercast on the command line with a variable number of arguments.
#Collapse the rest into a node called jcosmo_hiddencasts which is connected to the central system node if that exists.
proc filtercastlist {dir typelist} {
    rcl_win_set_drawing 0

    #check to see if we have a System node called System
    rcl_select_type System
    set systemnodes [rcl_select_get_list]
    if {[llength $systemnodes] == 1} {
	if {[rcl_get_node_name [lindex $systemnodes 0]] == "System"} {
	    set havesystem true
	} else {
	    set havesystem false
	}
    }

    #expand the jcosmo_hiddencasts Collapse node if we have one
    if {[rcl_filter_nodetype_filtered Collapse 1] == 1} {
	rcl_filter_nodetype Collapse 1
	rcl_filter_apply 1
    }
    rcl_select_type Collapse
    set collapsenodes [rcl_select_get_list]
    foreach collapsenode $collapsenodes {
	if {[rcl_get_node_name $collapsenode] == "jcosmo_hiddencasts"} {
	    rcl_select_id $collapsenode
	    rcl_expand
	}
    }

    #now that all casts are visible, set list of nodes to hide
    set keepers {}
    if {[lindex $typelist 0] == "all"} {
	rcl_select_all
	set keepers [rcl_select_get_list]
    } else {
	if {$dir == "to"} {
	    set searchstring to
	} else {
	    set searchstring cast
	}
	foreach type $typelist {
	    rcl_select_grep $searchstring$type
	    set keepers [concat $keepers [rcl_select_get_list]]
	}
    }
	
    rcl_select_type Cast
    set allcastnodes [rcl_select_get_list]
    set hiders {}
    foreach castnode $allcastnodes {
	if {[lsearch $keepers $castnode] < 0} {
	    set hiders [concat $hiders $castnode]
	}
    }

    #collapse nodes to be hidden into jcosmo_hiddencasts and attach to System 
    if {[llength $hiders] > 0} {
	#puts "length hiders is [llength $hiders] hiders is $hiders"
	rcl_select_all
	foreach hidenode $hiders {
	    rcl_select_deselect_id $hidenode
	}
	rcl_select_invert
	rcl_collapse
	rcl_node_rename jcosmo_hiddencasts
	if {$havesystem == "true"} {
	    rcl_arc_create2 [rcl_get_node_id System] [rcl_get_node_id jcosmo_hiddencasts] contain
	}
	#hide the newly create jcosmo_hiddencasts
	rcl_filter_nodetype Collapse 1
	rcl_filter_apply
    }
    rcl_select_all
    rcl_win_set_drawing 1
    rcl_refresh
}

proc gradient {smell} {

    #this is to set the window size to something that's about right
    rcl_set_scale_function_to_window
    rcl_select_all
    rcl_set_scale_function_to_factor
    rcl_set_scale_factor 50
    rcl_scale_by_factor

    #now turn off scaling altogether
    rcl_set_scale_function_to_none

    #unfilter the smell we're dealing with
    shownodetypes $smell

    #collapse smells into their parent methods but leave another copy outside for the following functions to use
    collapsesubtreeandshowsmells Method $smell
    
    #get all children of type smell for each method and put them in the 
    #array methods
    getchildren Method $smell methods

    #get rid of external smell nodes; we won't need them again
    rcl_select_type $smell
    rcl_cut

    #get the largest number of smell nodes that any method has
    set max 0
    foreach method [array names methods] {
	set n [llength $methods($method)]
	set numsmell($method) $n
	if {$n > $max} {
	    set max $n
	}
    }	
    
    #using max, graph the methods across the width of the window
    rcl_set_grid_size 1
    set width [rcl_win_canvas_width 1]
    set xoffset [expr $width / 20]
    set yoffset [expr [rcl_win_canvas_height] / 20]
    set methodlevel 10
    
    if {$max == 0} {
	set xdelta 0
    } elseif {$max == 1} {
	set xdelta [expr $width - 2 * $xoffset]
    } else {
	set xdelta [expr ($width - 2 * $xoffset) / $max]
    }
    
    global methodpos
    foreach method [array names methods] {
	set xpos [expr $xoffset + $xdelta * $numsmell($method)]
	set ypos [expr $methodlevel * $yoffset]
	set methodpos($method) $xpos
	lappend posmethod($xpos) $method
	rcl_select_id $method
	rcl_cursor_set $xpos $ypos
	rcl_group_grid
    }
    gposition Package [expr ($methodlevel - 6) * $yoffset] $xoffset
    
    gposition Class [expr ($methodlevel - 3) * $yoffset] $xoffset

    deoverlap_all
    rcl_scale_to_window
}

#position all nodes of given nodetype relative to the method row at the given height and x offset
proc gposition {type height xoffset} {
    rcl_set_grid_size 1
 
    getchildren $type Method children
    foreach node [array names children] {
	set methods $children($node)
	if {[llength $methods] < 1} {
	    set xpos $xoffset
	} else {
	    set xpos [getaveragex $methods]
	}
	set childpos($node) $xpos
	rcl_select_id $node
	rcl_cursor_set $xpos $height
	rcl_group_grid
    }	
    
    #clean up nodes
    #first go from node-to-position mapping to position-to-node mapping
    foreach node [array names childpos] {
	set xpos $childpos($node)
	lappend posnode($xpos) $node
    }
    
}

#stagger nodes that are sitting on the same spot, or collapse them if there are too many
proc deoverlap_all {} {
    #nodeoffset is the staggering between nodes that are in the same position
    set nodeoffset 20
    set collapse 0
    set collapsethreshold 10

    rcl_select_all
    set allnodes [rcl_select_get_list]
    foreach node $allnodes {
	set pos [rcl_get_node_position $node]
	set posx [lindex $pos 0]
	set posy [lindex $pos 1]

	lappend position($posx,$posy) $node
    }

    foreach pos [array names position] {
	rcl_select_all
	foreach node $position($pos) {
	    rcl_select_deselect_id $node
	}
	rcl_select_invert
	if {($collapse == 1) && ([llength [rcl_select_get_list]] > $collapsethreshold)} {
	    rcl_collapse [rcl_get_node_type $node] "Collapsed [llength [rcl_select_get_list]] nodes"
	} 
	if {[llength [rcl_select_get_list]] > 0} {
	    rcl_set_grid_size $nodeoffset
	    set posx [lindex [split $pos ,] 0]
	    set posy [lindex [split $pos ,] 1]
	    rcl_cursor_set $posx $posy
	    rcl_group_vertically
	}
    }
}

proc getaveragex {methods} {
    set totalx 0
    set nummethods [llength $methods]
    global methodpos
    if {$nummethods == 0} {
	return 0
    } else {	
	foreach method $methods {
	    #puts "global method position for [rcl_get_node_name $method]: $methodpos($method)"
	    set xpos $methodpos($method)
	    incr totalx $xpos
	    #puts "x position of [rcl_get_node_name $method]: $xpos"
	}
	return [expr $totalx / $nummethods]
    }
}

proc columns {} {
    rcl_select_all 
    foreach nodeID [rcl_select_get_list] { 
        set nodeTypes([rcl_get_node_type $nodeID]) 1 
    } 
    set numNodeTypes [array size nodeTypes] 
    if {$numNodeTypes == 0} { 
        return 
    } 
    set xDelta [expr [rcl_win_canvas_width] / $numNodeTypes] 
    set xPos [expr $xDelta / 2] 
 
    foreach nodeType [array names nodeTypes] { 
        rcl_select_type $nodeType 
        rcl_cursor_set $xPos 0 
        rcl_group_vertically 
        incr xPos $xDelta 
    } 
    rcl_scale_to_window 
    rcl_select_none 
}

#globals####################################################################
set methodpos() {}
set typelist {}
set direction to

# start the UI #############################################################

jcosmo