#!/usr/local/bin/wish
#
# Copyright (C) 1999 Paul Rajlich
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Library General Public License for more details.
# 
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA  02111-1307, USA.
#
# Author contact information:
#   prajlich@ncsa.uiuc.edu
#   http://monet.astro.uiuc.edu/~prajlich/

source tree.tcl

proc Tree:removeAll { } {
  global vtkPipelineWin
  global Tree

  foreach c $Tree($vtkPipelineWin.f.w:/:children) {
    catch {Tree:delitem $vtkPipelineWin.f.w /$c}
  }
}

# new idea...
proc buildFrom { obj prev {actor ""} } {
  global vtkPipelineWin

  set str "$obj"

  while {$prev != ""} {
    set str "$prev/$str"
    if [catch {set prev [$prev GetSource]} result] { break }
    if {$prev == ""} { break }
    set str "$prev/$str"
    if [catch {set input [$prev GetInput]} result] { break }
    set src ""
    if [catch {set src [$prev GetSource]} result] { }
    if {$src != ""} { buildFrom $prev $src }
    if [catch {set src [$prev GetSource 0]} result] { }
    if {$src != ""} {
       set numSrcs [$prev GetNumberOfSources]
       for {set i 0} {$i < $numSrcs} {incr i 1} {
         buildFrom $prev [$prev GetSource $i]
       }
    }
    set prev $input
    if {$prev == ""} { break }
  }

  if {$actor == ""} {
    # put extra slash to include last filter ($obj)
    set str "/$str/"
  } else {
    set str "/$str"
  }
  #puts $str
  set len [string length $str]
  set index 1
  # add "dirs" to tree
  while {$index < $len} {
    set c [string index $str $index]
    if {$c == "/"} {
      set item [string range $str 0 [expr $index - 1]] 
      #puts "$item"
      set slash [string last "/" $item]
      set object [string range $item [expr $slash + 1] end]
      set methods [$object ListMethods]
      #puts "$object"
      #puts "$methods"
      # is this a vtkProcessObject? Search for that string in methods printout
      set dataPos [string last "vtkProcessObject" $methods]
      if {$dataPos != "-1"} {
        Tree:newitem $vtkPipelineWin.f.w $item -image iprocess
        $object SetStartMethod "Tree:setselection $vtkPipelineWin.f.w $item; update idletasks"
        $object SetEndMethod "Tree:setselection $vtkPipelineWin.f.w nothing; update idletasks"
        #$object SetStartMethod "puts \"$object executing\""
      } else {
        Tree:newitem $vtkPipelineWin.f.w $item -image idata
      }
    }
    set index [expr $index + 1]
  }
  if {$actor != ""} {
    set mapper [$actor GetMapper]
    set property [$actor GetProperty]
    Tree:newitem $vtkPipelineWin.f.w "$str$mapper" -image iprocess
    Tree:newitem $vtkPipelineWin.f.w "$str$property" -image ifile
    Tree:newitem $vtkPipelineWin.f.w "$str$actor" -image iactor
  }
}

proc vtkPipelineRefresh { renWin } {
  global vtkPipelineWin

  puts "refresh"
  Tree:removeAll

  set renderers [ $renWin GetRenderers ]
  $renderers InitTraversal
  set currRen [$renderers GetNextItem]

  while {$currRen != "" } {
    set actors [$currRen GetActors]
    $actors InitTraversal
    set currActor [$actors GetNextItem]

    # for each actor, trace back through pipeline
    while {$currActor != ""} {
      set mapper [$currActor GetMapper]
      set prev [$mapper GetInput]

      # build dir path-like string
      buildFrom "" $prev $currActor

      set currActor [$actors GetNextItem]
    }
    set currRen [$renderers GetNextItem]
  }
  vtkPipelineOpenAll
}

proc Tree:openAll { w v } {
  global Tree

  catch {Tree:open $w $v}
  foreach c $Tree($w:$v:children) {
    catch {Tree:openAll $w $v/$c}
  }  
}

proc vtkPipelineOpenAll { } {
  global vtkPipelineWin
  global Tree

  puts "opening all"
  foreach c $Tree($vtkPipelineWin.f.w:/:children) {
    catch {Tree:openAll $vtkPipelineWin.f.w /$c}
  }
}

proc vtkPipeline { renWin } {
  global vtkPipelineWin
 
  $vtkPipelineWin config -bd 3 -relief flat
  if {$vtkPipelineWin == "."} { set vtkPipelineWin "" }
  frame $vtkPipelineWin.f -bg white
  pack $vtkPipelineWin.f -fill both -expand 1
  image create photo idir -data {
      R0lGODdhEAAQAPIAAAAAAHh4eLi4uPj4APj4+P///wAAAAAAACwAAAAAEAAQAAADPVi63P4w
      LkKCtTTnUsXwQqBtAfh910UU4ugGAEucpgnLNY3Gop7folwNOBOeiEYQ0acDpp6pGAFArVqt
      hQQAO///
  }
  image create photo ifile -data {
      R0lGODdhEAAQAPIAAAAAAHh4eLi4uPj4+P///wAAAAAAAAAAACwAAAAAEAAQAAADPkixzPOD
      yADrWE8qC8WN0+BZAmBq1GMOqwigXFXCrGk/cxjjr27fLtout6n9eMIYMTXsFZsogXRKJf6u
      P0kCADv/
  }
  image create photo idata -data {
      R0lGODlhEgANAPAAAAAAAP///yH+JSAgSW1wb3J0ZWQgZnJvbSBTR0kgaW1hZ2U6IGltYWdl
      My5yZ2IALAAAAAASAA0AQALQTBIRERERQgghhBBCCAGEEABBEARBEARBEAQBEAQBEARBEARB
      EARBEAgEAoFAIBAIBAKBQCAQCAQCgUAgEAgEAoFAIBAIBAIBQCAQCAACgUAgEAgEAoFAIBAI
      BAKBQCAQEBAQAAAAAAAAAAAAAAAAAAAAABAQEBAQEBAAAAAAEBAQEBAQEBAQEBAQEBAAEBAQ
      EAAQEBAQEBAQEBAQEBAAEBAQEAAQEBAQEBAQEBAQEBAAAAAAEBAQEBAQEBAQAAAAAAAAAAAA
      AAAAAAAAABBQAAA7
  }
  image create photo iprocess -data {
      R0lGODlhEgANAPEAABwNDuFocf///wAAACH+JSAgSW1wb3J0ZWQgZnJvbSBTR0kgaW1hZ2U6
      IGltYWdlNC5yZ2IALAAAAAASAA0AQALQlCQiIiIihBBCCAFCCCGAEARBEAQBIAhAEARBAARB
      AARBEACCIAiCIBAIBAKBQCAQCAQCgQAACAQCgUAgEAgEAACBQAAIBAKBAAAAAAQCgUAAIBAI
      AIBAIBAIBAKBQAAAICAgICAAAAAAAAAAAAAAAAAgICAgAAAQEBAQAAAAABAQEBAAACAgABAQ
      EBAQABAQEAAQEBAQACAgABAQEBAQABAQEBAQEBAQACAgAAAQEBAQABAQEBAQEBAAACAgICAA
      AAAAAAAAAAAAAAAgICBQAAA7
  }
  image create photo iactor -data {
      R0lGODlhEgANAPEAABIVGo+n0f///wAAACH+JSAgSW1wb3J0ZWQgZnJvbSBTR0kgaW1hZ2U6
      IGltYWdlNS5yZ2IALAAAAAASAA0AQALQlCQiIiIihBBCCAFCCCGAEABBEAQBIAhAEARBEABA
      EARBEACCIAiCIBAIBAKBQCAQCAQCASAQCAQCgUAgEAgEAgGAQAAIBAKBACAQAAQCgUAAIBAA
      AoFAIBAIBAKBQCAQACAgAAAAAAAAAAAAAAAAAAAAACAgABAQEBAQEBAAEBAQEBAQACAgABAQ
      EBAQEAAQABAQEBAQACAgABAQEBAQAAAAABAQEBAQACAgABAQEBAAEBAQEAAQEBAQACAgAAAA
      AAAAAAAAAAAAAAAAACBQAAA7
  }

  frame $vtkPipelineWin.f.mb -bd 2 -relief raised
  pack $vtkPipelineWin.f.mb -side top -fill x
  Tree:create $vtkPipelineWin.f.w -width 300 -height 200 -yscrollcommand {$vtkPipelineWin.f.sb set}
  scrollbar $vtkPipelineWin.f.sb -orient vertical -command {$vtkPipelineWin.f.w yview}
  pack $vtkPipelineWin.f.w -side left -fill both -expand 1 -padx 5 -pady 5
  pack $vtkPipelineWin.f.sb -side left -fill y

  button $vtkPipelineWin.f.mb.rb -command "vtkPipelineRefresh $renWin" -text "refresh"
  button $vtkPipelineWin.f.mb.ob -command {vtkPipelineOpenAll} -text "open all"
  pack $vtkPipelineWin.f.mb.rb $vtkPipelineWin.f.mb.ob -side left

  frame $vtkPipelineWin.f.c -height 400 -width 400 -bg white
  pack $vtkPipelineWin.f.c -side left -fill both -expand 1
  text $vtkPipelineWin.f.c.l -background white -width 50 -height 20 -setgrid true -yscrollcommand {$vtkPipelineWin.f.c.sb set}
  scrollbar $vtkPipelineWin.f.c.sb -orient vertical -command {$vtkPipelineWin.f.c.l yview}
  pack $vtkPipelineWin.f.c.sb -side right -fill y
  pack $vtkPipelineWin.f.c.l -side left -fill both -expand true

  vtkPipelineRefresh $renWin

  $vtkPipelineWin.f.w bind x <3> {
    set lbl [Tree:labelat %W %x %y]
    Tree:setselection %W $lbl
    set start  [string last "/" $lbl]
    set result [string range $lbl [expr $start + 1] end]
    vtkShow $result
  }
  $vtkPipelineWin.f.w bind x <1> {
    set lbl [Tree:labelat %W %x %y]
    Tree:setselection %W $lbl
    set start  [string last "/" $lbl]
    set result [string range $lbl [expr $start + 1] end]
    $vtkPipelineWin.f.c.l delete 1.0 end
    $vtkPipelineWin.f.c.l insert 1.0 [$result Print]
  }
  $vtkPipelineWin.f.w bind x <Double-1> {
    #Tree:open %W [Tree:labelat %W %x %y]
    set lbl [Tree:labelat %W %x %y]
    Tree:setselection %W $lbl
    set start  [string last "/" $lbl]
    set result [string range $lbl [expr $start + 1] end]
    vtkShow $result
  }
  #$vtkPipelineWin.f.w bind x <2> {
  #  set lbl [Tree:labelat %W %x %y]
  #  Tree:delitem %W $lbl
  #}
  update
}