catch { load vtktcl}

catch {font create fontvtk -size 7}
#
#  Creation de fenetres de dialogue pour des objets vtk permettant
#   de les examiner, de les modifier, d'acceder aux autres objets
#	references, d'acceder au champs des classes parentes,
#	d'executer les fonctions des objets
#


# liste des commandes d'un objet et d'une classe vtk et tri en:
#  fonctions get/set/on/off booleenne
#  fonctions d'action ex: Render, New, Delete...
#  fonctions get/set sur des valeurs quelconques 

# variables globales pour les listes des classes parentes et des fonctions

global classesparentes fgetsetonoff fgetset factions listcom fget fargs
global factionsargs fegtargs fgetsetargs 
global res

proc listvtkobjectcommands { o { all 0 } } {
global classesparentes fgetsetonoff fgetset factions listcom fargs fget
global factionsargs fgetargs fgetsetargs 

set classesparentes ""
set listcom ""
set fgetsetonoff ""
set fgetset ""
set factions ""
set fget ""
set fargs ""
set factionsargs ""
set fgetargs ""
set fgetsetargs  ""

set m [ $o ListMethods ]
foreach j $m {
	switch -glob -- $j {
		vtk*:   { 
#			puts "##### $j" 
			set co $j
			lappend classesparentes [string trim $j :] 
		      }
		} 
	}
if { $all } { set ci 0 } else { set ci [ lsearch -exact $m $co ] }
set ll [ llength $m ]
for {set k [expr $ci+1]} {$k<$ll} {incr k} {
	set w [lindex $m $k]
	switch -glob -- $w {
		[0-9][0-9] -
		[0-9] { set nbargs $w }
		arg -
		args -
		from -
		Methods -
		with { }
		vtk* { }
		default {
# puts " -------> $w "  
			if [expr [lsearch -exact $listcom $w]==-1] {
				lappend listcom $w
				set ww [lindex $m [expr $k+1]]
				switch -exact -- $ww {
					with { lappend fargs [lindex $m [expr $k+2]]}
					default { lappend fargs 0 }
					}
				} 
			} 
		}
	}

set ii -1
foreach i $listcom {
	incr ii
	switch -glob -- $i {
		Set* -
		Get* { set comm [string range $i 3 e] }
		*On  { set comm [string range $i 0 [ expr [string length $i ]-3] ] }
		*Off { set comm [string range $i 0 [ expr [string length $i ]-4] ] }
		default { set comm $i }
	}

	set ccc 0 
	if [expr [lsearch -exact $listcom ${comm}On] != -1 ] { set ccc [expr $ccc +1 ] }
	if [expr [lsearch -exact $listcom ${comm}Off] != -1 ] { set ccc [expr $ccc +2 ] }
	if [expr [lsearch -exact $listcom Get${comm}] != -1  ] { set ccc [expr $ccc +4 ]}
	if [expr [lsearch -exact $listcom Set${comm}] != -1 ] { set ccc [expr $ccc +8 ]}

	if [expr $ccc & 4 ] { if [expr [lindex $fargs [lsearch -exact $listcom Get${comm}]] > 0] {
		set ccc 0
		} }

	if [expr $ccc == 15] {
		 if [expr [lsearch -exact $fgetsetonoff $comm]==-1] {
			lappend fgetsetonoff $comm } } \
	elseif [expr $ccc == 12] {
		 if [expr [lsearch -exact $fgetset $comm]==-1] {
			lappend fgetset $comm ; lappend fgetsetargs [lindex $fargs $ii ] } } \
	elseif [expr $ccc == 4] {
		 if [expr [lsearch -exact $fget $i]==-1] {
			lappend fget $i ; lappend fgetargs [lindex $fargs $ii] } } \
	else { 
		if [expr [lsearch -exact $factions $i]==-1] {
			lappend factions $i ; lappend factionsargs [lindex $fargs $ii] } }

	}
#puts " CLASSES [llength $classesparentes] $classesparentes"
#puts " LISTCOM [llength $listcom] $listcom"
#puts " NBARGS [llength $fargs] $fargs"
#puts " GETSETONOFF [llength $fgetsetonoff] $fgetsetonoff"
#puts " GETSET [llength $fgetset] $fgetset "
#puts " GETSETARGS [llength $fgetsetargs] $fgetsetargs "
#puts " GET [llength $fget] $fget "
#puts " GETARGS [llength $fgetargs] $fgetargs "
#puts " ACTIONS [llength $factions] $factions "
#puts " ACTIONSARGS [llength $factionsargs] $factionsargs "

}

proc listvtkclassescommands { com { all 0 } } {
# par exemple vtk* , vtkA* ...

set t [ lsort -dictionary [info commands $com ] ]

foreach i $t {
	switch -regexp -- $i {
		vtkTk { puts " ---> $i command" }
		vtkCommand { puts "---> $i  command " }
		default {
			puts "$i command"
			catch { temp Delete }
			$i temp
			listvtkobjectcommands $temp $all
			temp Delete
			}
		}
	}
}


# Creation d'un bouton case a cocher pour les action on/off

proc MakeCheckButton { val win o} {
global ${val}_$o
checkbutton $win._$val -text "$val" -variable ${val}_$o -command "$o Set$val \$${val}_$o" 
pack $win._$val -anchor w
set ${val}_$o [$o Get$val]
if [$o Get$val] { $win._$val select } else { $win._$val deselect }
}

# creation d'une fenetre d'affichage et de modification d'une
# valeur d'un champ d'un objet vtk
# val : fonction ex: Debug, Mapper,.. accesible par Getval, Setval...
# win : widget (toplevel) tk ou afficher la fenetre
# o : objet vtk concerne
# ty : open   acces a l'objet reference
#      set    modifie la valeur du champ
#      openset  open et set en meme temps

proc MakeValuesEntry { val win o { ty "" } {all 0 }} {
global ${val}_$o
frame $win._${val}f
set ${val}_$o [$o Get$val]
#switch -regexp -- [list [$o Get$val] ] {
#	[a-zA-Z] {}
#	default { set ty "set" }
#	}
switch -regexp -- "[$o Get$val]" {
	(^)([-+]?)[0-9] {set ty "set"}
	default {  }
	}
entry $win._${val}f._${val} -textvariable ${val}_$o -width 10
#label $win._${val}f._${val}l -text $val -anchor w
button $win._${val}f._${val}l -text $val -anchor w -command " eval $o Set$val \$${val}_$o"
pack $win._${val}f._${val}l $win._${val}f._${val} -side left -anchor e

switch -exact -- $ty {
	open { MakeOpenButton $val $win._${val}f $o $all}
	set { MakeGetButton $val $win._${val}f $o }
	openset { MakeOpenButton $val $win._${val}f $o $all; MakeGetButton $val $win._${val}f $o }
	}
pack $win._${val}f -anchor e
}

# creation d'un bouton permettant d'acceder a l'objet vtk correspondant
#  au champ val de l'objet o. Le bouton est cree dans le widget tk win

proc MakeOpenButton { val win o {all 0}} {
global ${val}_$o

button $win._${val}bop -text "Open" -command "vtkShow \[$o Get$val] $all \[\[$o Get$val] GetClassName ]"

pack $win._${val}bop -side left -anchor e
}

# creation d'un bouton permettant de recuperer
#  le champ val de l'objet o. Le bouton est cree dans le widget tk win

proc MakeGetButton { val win o} {
global ${val}_$o

button $win._${val}bos -text "Get" -command " set ${val}_$o \[$o Get$val] "

pack $win._${val}bos -side left -anchor e
}

proc MakeActionButton { val win o nbargs} {

global ${val}_$o
global res

frame $win._${val}f
if [expr $nbargs > 0 ] {
	entry $win._${val}f._${val} -textvariable ${val}_$o -width 10 
	button $win._${val}f._${val}boa -text "$val" -width 20 -height 1 -command "set res \[eval $o $val $${val}_$o ]" -font fontvtk
	pack $win._${val}f._${val}boa $win._${val}f._${val} -side left -anchor e }\
else {
	button $win._${val}f._${val}boa -text "$val" -height 1 -command "set res \[$o $val]" -font fontvtk
	pack $win._${val}f._${val}boa -side left -anchor w -fill x}

pack $win._${val}f -anchor w
}

# Affichage Générique

proc vtkShow { o {all 1} { classe "" } } {
global classesparentes fgetsetonoff fgetset factions listcom factionsargs fget fgetargs
global res

listvtkobjectcommands $o $all

if [expr [string compare $classe ""]==0 ] { set classe [$o GetClassName] }
set base .$o
toplevel $base
button $base.ok -text "Ok" -command "destroy $base"
frame $base.f0
button $base.f0.open -text "Open" -command " vtkShow \$res $all"
button $base.f0.refresh -text "Refresh" -command "destroy $base; vtkShow $o $all"
label $base.f0.l1 -text "[$o GetClassName ] : [lindex $classesparentes end] "
label $base.f0.l2 -textvariable res -relief sunken
pack $base.f0
pack $base.f0.l1 $base.f0.l2 $base.f0.open $base.f0.refresh -side left -padx 5

frame $base.f1
frame $base.f2
frame $base.f3
frame $base.f4
pack $base.f1 $base.f2 $base.f3 $base.f4 -side left -padx 5


foreach i $fgetset { MakeValuesEntry $i $base.f1 $o openset $all}
foreach i $fgetsetonoff { MakeCheckButton $i $base.f1 $o }
set lc [concat $factions $fget]
set lca [concat $factionsargs $fgetargs]
foreach i $lc { 
	set k [lsearch -exact $lc $i]
	if [expr $k < 20 ] {
		MakeActionButton $i $base.f2 $o [lindex $lca $k] } \
	elseif [expr $k < 40 ] {MakeActionButton $i $base.f3 $o [lindex $lca $k] } \
	else {MakeActionButton $i $base.f4 $o [lindex $lca $k] } }

pack $base.ok
}