generated by zdoc.tcl on Thu Feb 14 16:15:16 MET 2002

tclTriangulation.tcl



triangulation
Comments  
Arguments  
Used by  
Uses  
namespace eval triangulation {
    global internalForceList
    set internalForceList { "Spring-Mass"  "Elastic Membrane" "Mean Curvature" "Quadratic Membrane" "Mean Curvature Continuity"}

}


triangulation::addTrianView
Comments  
Arguments name
mname
toff
color
Used by inrimage::OldaddObjectMenu
Uses triangulation::isTrianInView
proc triangulation::addTrianView { name mname {toff 0} {color "#E8E0D2"}} {
    $name add cascade -label "3D Triangulation" -menu $name.tr1
    menu $name.tr1 -tearoff $toff -bg $color -postcommand "set triangulation::scn \[ \[ lindex \[ split \[ ${mname} -views\] \] 0 \] -scene \]; $name.tr1 delete 0 last; foreach {i} \[which tr3D\] { set triangulation::view(\$i) \[ triangulation::isTrianInView \${triangulation::scn} \$i \];  }; foreach {i} \[which tr3D\] {$name.tr1 add checkbutton -selectcolor black -variable triangulation::view(\$i) -label \$i -command \" if  \$triangulation::view(\$i) \{evaluate {\[triangulation::getTrianInView  \${triangulation::scn} \$i\] -destroy } \} else  \{evaluate {new trianview \$i -scene \${triangulation::scn} } \}  \"}"
    $name add cascade -label "3D Active Triangulation" -menu $name.tr2
    menu $name.tr2 -tearoff $toff -bg $color -postcommand "set triangulation::scn \[ \[ lindex \[ split \[ ${mname} -views\] \] 0 \] -scene \]; $name.tr2 delete 0 last; foreach {i} \[which atr3D\] { set triangulation::view(\$i) \[ triangulation::isTrianInView \${triangulation::scn} \$i \] }; foreach {i} \[which atr3D\] {$name.tr2 add checkbutton -selectcolor black -variable triangulation::view(\$i) -label \$i -command \" if  \$triangulation::view(\$i) \{evaluate {\[triangulation::getTrianInView  \${triangulation::scn} \$i\] -destroy } \} else  \{evaluate {new trianview \$i -scene \${triangulation::scn} } \}  \"}"
    $name add cascade -label "3D Precomputed Triangulation" -menu $name.tr3
    menu $name.tr3 -tearoff $toff -bg $color -postcommand "set triangulation::scn \[ \[ lindex \[ split \[ ${mname} -views\] \] 0 \] -scene \]; $name.tr3 delete 0 last; foreach {i} \[which pretr3D\] { set triangulation::view(\$i) \[ triangulation::isTrianInView \${triangulation::scn} \$i \] }; foreach {i} \[which pretr3D\] {$name.tr3 add checkbutton -selectcolor black -variable triangulation::view(\$i) -label \$i -command \" if  \$triangulation::view(\$i) \{evaluate {\[triangulation::getTrianInView  \${triangulation::scn} \$i\] -destroy } \} else  \{evaluate {new trianview \$i -scene \${triangulation::scn} } \}  \"}"

}


triangulation::chooseInternalScheme
Comments  
Arguments object
scheme
bg
Used by  
Uses  
proc triangulation::chooseInternalScheme { object scheme bg } {
    set root .dialogInternalTriangulationForce3D
    set list [winfo children $root.s]
    foreach w $list {destroy $w}
    switch $scheme {
    "semi-implicit" {
        scale $root.s.iter -bg $bg -orient horizontal -from 0 -to 1 -resolution 0.001 -label "Numb. of Iterations for Conj. Gradient as Percentage of Numb. of Vertices" -length 200
        $root.s.iter set [ expr [ $object -CGIteration] / [ expr [$object -nbVertices] * 3.0 ] ]
        bind  $root.s.iter <ButtonRelease-1> "evaluate \"$object -CGIteration \[ expr \[ expr  \[ $root.s.iter get \]  * 3.0 \] * \[$object -nbVertices \] \] \" "

        pack $root.s.iter
    }
    }
}


triangulation::displayActiveTriangulation3D
Comments  
Arguments object
color
Used by  
Uses  
proc triangulation::displayActiveTriangulation3D { object color } {
    if ![winfo exists .display${object}] {
    set name .display${object}
    toplevel $name -bg $color
    wm title $name "display components for $object"
    
    variable forces { internal external global averaged gc total }
    variable colors { \#FF0000 \#FF00FF \#FF0080 \#0000FF \#00FF00 \#FFFFFF }
    variable nd${object}
    variable nc${object}
    variable nw${object}
    variable ns${object}
    variable nr${object}
    
    variable i
    variable j
    variable str

    variable fd${object} true
    set j 0
    foreach i $forces {
        variable fd${object}${i} false
        variable fc${object}${i} [lindex ${colors} $j]
        incr j
    }
    variable fw${object}
    variable fs${object}
    
    scan [$object -normal] "%s %s %s %s %s %s %s %s %s %s" ign triangulation::nd${object} ign triangulation::nc${object} ign triangulation::nw${object} ign triangulation::ns${object} ign triangulation::nr${object}
    set str [$object -force]
    for {set i 0} { $i < [llength $str]} {incr i} {
        switch [lindex $str $i] {
        false {
            set fd${object} false
            foreach j $forces { set fd${object}${j} false }
        }
        width {
            incr i
            set fw${object} [lindex $str $i]
        }
        scale {
            incr i
            set fs${object} [lindex $str $i]
        }
        default {
            foreach j $forces {
            if ![string compare $j [lindex $str $i]] {
                set fd${object}${j} ${j}
                incr i
                set fc${object}${j} [lindex $str $i]
            }
            }
        }
        }
    }

    # normals
    checkbutton $name.n -text "display normals" -bg $color -selectcolor black -anchor w -onvalue true -offvalue false -variable triangulation::nd${object}
    frame $name.nf -bg $color
    checkbutton $name.nf.rev -text reverse -bg $color -selectcolor black -onvalue true -offvalue false -anchor w -variable triangulation::nr${object}
    button $name.nf.c -bg $color -text "Color..." -command "set triangulation::nc${object} \[tk_chooseColor -initialcolor \$triangulation::nc${object}\]"
    scale $name.nf.w -bg $color -orient horizontal -from 1 -to 5 -label width
    $name.nf.w set [set triangulation::nw$object]
    scale $name.nf.s -bg $color -orient horizontal -from 1 -to 20 -label scale
    $name.nf.s set [set triangulation::ns$object]
    grid $name.nf.rev -row 1 -column 1 -sticky ew -padx 5
    grid $name.nf.c -row 1 -column 2 -sticky ew -padx 5
    grid $name.nf.w -row 2 -column 1 -sticky ew -padx 5
    grid $name.nf.s -row 2 -column 2 -sticky ew -padx 5

    # forces
    checkbutton $name.f -text "display forces" -bg $color -selectcolor black -anchor w -onvalue true -offvalue false -variable triangulation::fd${object}
    frame $name.ff -bg $color
    set j 0
    foreach i $forces {
        checkbutton $name.ff.$i -anchor w -text $i -bg $color -selectcolor black -onvalue $i -offvalue false -variable triangulation::fd${object}${i}
        button $name.ff.c${i} -bg $color -text "Color..." -command "set triangulation::fc${object}${i} \[tk_chooseColor -initialcolor \$triangulation::fc${object}${i}\]"
        grid $name.ff.$i -row $j -column 1 -sticky ew -padx 5
        grid $name.ff.c$i -row $j -column 2 -sticky ew -padx 5
        incr j
    }      
    scale $name.ff.w -bg $color -orient horizontal -from 1 -to 5 -label width
    $name.ff.w set [set triangulation::fw$object]
    scale $name.ff.s -bg $color -orient horizontal -from 1 -to 20 -label scale
    $name.ff.s set [set triangulation::fs$object]
    grid $name.ff.w -row 7 -column 1 -sticky ew -padx 5
    grid $name.ff.s -row 7 -column 2 -sticky ew -padx 5

    frame $name.b -bg $color
    button $name.b.apply -text Apply -bg $color -command "$object -normal display \$triangulation::nd$object color \$triangulation::nc$object width \[$name.nf.w get\] scale \[$name.nf.s get\] reverse \$triangulation::nr$object; if !\[string compare \$triangulation::fd${object} false\] { evaluate \"$object -force false\" } else { set triangulation::str \"$object -force width \[$name.ff.w get\] scale \[$name.ff.s get\]\"; foreach i {${triangulation::forces}} { if !\[string compare \[set triangulation::fd${object}\${i}\] false\] { set triangulation::str \"\${triangulation::str} -\${i}\"} else { set triangulation::str \"\${triangulation::str} +\${i} \[set triangulation::fc${object}\${i}\]\" } }; evaluate \$triangulation::str }"
    button $name.b.applydismiss -text "Apply & dismiss" -bg $color -command "$object -normal display \$triangulation::nd$object color \$triangulation::nc$object width \[$name.nf.w get\] scale \[$name.nf.s get\] reverse \$triangulation::nr$object; if !\[string compare \$triangulation::fd${object} false\] { evaluate \"$object -force false\" } else { set triangulation::str \"$object -force width \[$name.ff.w get\] scale \[$name.ff.s get\]\"; foreach i {${triangulation::forces}} { if !\[string compare \[set triangulation::fd${object}\${i}\] false\] { set triangulation::str \"\${triangulation::str} -\${i}\"} else { set triangulation::str \"\${triangulation::str} +\${i} \[set triangulation::fc${object}\${i}\]\" } }; evaluate \$triangulation::str }; destroy $name"
    button $name.b.dismiss -text Dismiss -bg $color -command "destroy $name"
    pack $name.b.apply $name.b.applydismiss $name.b.dismiss -side left -expand true -padx 5

    pack $name.n $name.nf $name.f $name.ff $name.b -expand true -fill both -pady 5
    }
}


triangulation::displayInternalForce3D
Comments  
Arguments object
item
force
Used by  
Uses  
proc triangulation::displayInternalForce3D { object item force } {
    variable setRestLength
    set root .dialogInternalTriangulationForce3D
    set list [winfo children $root.f]
    set bg #A0D0A0
    set bg2  #80C080
    foreach w $list {destroy $w}
    
    switch $force {
    "Spring-Mass" {
        set  triangulation::setRestLength 0
        checkbutton $root.f.restLength -variable triangulation::setRestLength -text "Set Spring Rest Length" -relief flat -bg $bg
        pack $root.f.restLength -side left
        pack $root.f -expand true -fill both
    }
    "Quadratic Membrane" {
        scale $root.f.lambda -bg $bg -orient horizontal -from 0 -to 1000000 -resolution 100 -label "Lambda Lamé coefficient" -length 200
        $root.f.lambda set [$object -lameCoefficient lambda]
        bind  $root.f.lambda <ButtonRelease-1> "evaluate \"$object -lameCoefficient lambda \[ $root.f.lambda get \] \""
        pack $root.f.lambda -side left

        scale $root.f.mu -bg $bg -orient horizontal -from 0 -to 1000000 -resolution 100 -label "Mu Lamé coefficient" -length 200
        $root.f.mu set [$object -lameCoefficient mu]
        bind  $root.f.mu <ButtonRelease-1> "evaluate \"$object -lameCoefficient mu \[ $root.f.mu get \] \""
        pack $root.f.mu -side left
        pack $root.f -expand true -fill both
        
    }
    "Mean Curvature" {
    }
    }
}


triangulation::getTrianInView
Comments  
Arguments scn
sm
Used by  
Uses  
proc triangulation::getTrianInView { scn sm } {
    set val 0
    foreach {i} [$scn -objects] {
    if {[string match trianview* $i]} {
        if { ![string compare [$i -mesh] $sm]} {
        set val $i
        }
    }
    }
    return $val
}


triangulation::installActiveTriangulation3DMenu
Comments  
Arguments parent
camera
object
color
Used by  
Uses imagedata::createRangeInformation
triangulation::installTriangulationMiddlePopupMenu
triangulation::installMainTriangulation3DMenu
imagedata::editRangeInformation
proc triangulation::installActiveTriangulation3DMenu {parent camera object color } {
    set popup [triangulation::installTriangulationLeftPopupMenu $parent $camera $object]
    $popup add radio -label "Grab Triangulation" -command "evaluate \"$object -selectionMode grab $camera\"" -selectcolor black -variable triangulation::select$camera -value grab

    triangulation::installTriangulationMiddlePopupMenu $popup $camera $object
    bind [$camera -widget]  <Button-3> "tk_popup $popup %X %Y"
    triangulation::installMainTriangulation3DMenu $parent $camera $object $color
    $parent.context.object.mn add command -label "Save Transformation" -command "$object -writeGlobalMatrix  \[tk_getSaveFile -filetypes {{\"Transformation File\" {*.trsf} } {All *}} -parent . -title {Save transformation as}\]"
    
    set menu $parent.context.graphics.mn
    $menu add command -label "Display Parameters..." -command "triangulation::displayActiveTriangulation3D $object $color"
    $menu add checkbutton -label "Display normals" -variable triangulation::nd${object} -onvalue true -offvalue false -selectcolor black -command "evaluate \"$object -normal display \${triangulation::nd$object}\" scale 10"
    $menu add checkbutton -label "Display forces" -variable triangulation::fd${object} -onvalue "external scale 10" -offvalue false -selectcolor black -command "evaluate \"$object -force \${triangulation::fd$object}\""

    menubutton $parent.context.internal -text "Internal Constraints" -menu $parent.context.internal.m -anchor w -bg $color
    set minternal [menu $parent.context.internal.m -bg $color]
    $minternal add command -label "Internal Parameters..." -command "triangulation::internalParametersDialog $object $color"
    $minternal add command -label "Internal Force Type..." -command "triangulation::internalForce3D $object $color"
    $minternal add cascade -label "Deformation mode" -menu $parent.context.internal.mode
    set mn [menu $parent.context.internal.mode -bg $color -tearoff 0 -postcommand "set triangulation::mode \[$object -deformationMode\]"]
    $mn add radiobutton -label "none" -variable triangulation::mode -selectcolor black -value no -command "evaluate \"$object -deformationMode no\""
    $mn add radiobutton -label "local" -variable triangulation::mode -selectcolor black -command "evaluate \"$object -deformationMode local\""
    $mn add radiobutton -label "globally constrained" -variable triangulation::mode -selectcolor black -command "evaluate \"$object -deformationMode globallyConstrained\"" -value globallyConstrained
    $mn add radiobutton -label "global" -variable triangulation::mode -selectcolor black -command "evaluate \"$object -deformationMode global\""

    $minternal add cascade -label "Global transformation" -menu $parent.context.internal.transfo
    set mn [menu $parent.context.internal.transfo -bg $color -tearoff 0 -postcommand "set triangulation::transfo \[$object -globalTransformation\]"]
    $mn add radiobutton -label "rigid" -variable triangulation::transfo -selectcolor black -command "evaluate \"$object -globalTransformation rigid\""
    $mn add radiobutton -label "similarity" -variable triangulation::transfo -selectcolor black -command "evaluate \"$object -globalTransformation similarity\""
    $mn add radiobutton -label "affine" -variable triangulation::transfo -selectcolor black -command "evaluate \"$object -globalTransformation affine\""
    $mn add radiobutton -label "spline" -variable triangulation::transfo -selectcolor black -command "evaluate \"$object -globalTransformation spline\""
    $mn add radiobutton -label "axial" -variable triangulation::transfo -selectcolor black -command "evaluate \"$object -globalTransformation axial\""
    $menu add separator
    $minternal add checkbutton -label "use reference shape" -selectcolor black -variable triangulation::refshape -onvalue true -offvalue false -command "if !\[string compare \$triangulation::refshape true\] { evaluate \"$object -referenceShape true store\"; evaluate \"$object -deformationMode globallyConstrained\" } else { evaluate \"$object -referenceShape false\" }"
    $minternal add command -label "store reference shape" -command "evaluate \"$object -referenceShape store\""
    $minternal add command -label "Force Constraint..." -command "triangulation::forceConstraint3D $object $color"
    $minternal add command -label "Position Constraint..." -command "triangulation::positionConstraint3D $object $color"
    pack  $parent.context.internal -side left
    pack  $parent.context -side left

    menubutton $parent.context.external -text "External Constraints" -menu $parent.context.external.mn -bg $color
    set mn [menu $parent.context.external.mn -bg $color -tearoff 0 ]
    $mn add command -label "Edit Range Information" -command " if [string compare [isModuleLoaded tclImageData] no] { imagedata::editRangeInformation \[$object -rangeInformation\]}"
    
    $mn add cascade -label "Set New Range Information" -menu $mn.new
    set mn2 [menu $mn.new -bg $color -tearoff 0 ]
    if [string compare [isModuleLoaded tclImageData] no] { imagedata::createRangeInformation $mn.new $object $color }
    pack $parent.context.external -side left

}


triangulation::installEdge3DMenu
Comments  
Arguments widget
object
edge
color
Used by  
Uses  
proc triangulation::installEdge3DMenu {widget object edge color} {
    if ![winfo exists $widget] {
    menubutton $widget -text $edge -bg $color -menu $widget.mn
    pack $widget -side right
    set menu [menu $widget.mn -bg $color ]
    $menu add command -label "info..." -command "tk_messageBox -message \[ concat \" connectivity \" \[$object $edge -connectivity \] \]"
    $menu add command -label "remove" -command "evaluate \"$object $edge -remove \""
    $menu add command -label "swap" -command "evaluate \"$object $edge -swap \""
    }
}


triangulation::installMainTriangulation3DMenu
Comments  
Arguments parent
camera
object
color
Used by triangulation::installActiveTriangulation3DMenu
triangulation::installTriangulation3DMenu
Uses modules::selectColorStr
graphics3D::materialoptions
graphics3D::renderoptions
graphics3D::textureoptions
proc triangulation::installMainTriangulation3DMenu {parent camera object color } {
    menubutton $parent.context.object -text "File" -menu $parent.context.object.mn -bg $color
    set menu [menu $parent.context.object.mn -bg $color ]
    $menu add command -label "Save" -command "evaluate \"$object -save\""
    $menu add command -label "Save As..." -command "triangulation::saveOption $object {{\"Triangulation\" {*.tr3d } } {\"Old Triangulation\" {*.trian} }  } {Select a Triangulation name}"
    $menu add command -label "Save As GHS3D..." -command "$object -saveAsGHS3D  \[tk_getSaveFile -filetypes {{\"GHS3D Files\" {.points} } {All *}} -parent . -title {Save triangulation as}\]"
    $menu add command -label "Save As Trian..." -command "$object -saveAsTrian  \[tk_getSaveFile -filetypes {{\"Trian Files\" {.trian} } {All *}} -parent . -title {Save triangulation as}\]"

    $menu add separator
    $menu add command -label destroy -command "evaluate \"$object -destroy\""
    pack $parent.context.object -side left

    menubutton $parent.context.graphics -text "Display" -menu $parent.context.graphics.mn -bg $color
    set menu [menu $parent.context.graphics.mn -bg $color -postcommand "set graphics3D::v$object \[$object -render\]"]
    graphics3D::renderoptions $menu $object
    $menu add separator
    graphics3D::textureoptions $menu $object $color
    $menu add command -label "Flip Normals" -command "evaluate \"$object -flipNormals\""
    $menu add command -label "Line color..." -command "evaluate \"$object -color \[ modules::selectColorStr  \[ $object -color\] \]\""
    $menu add cascade -label "Material Definition" -menu $menu.material
    menu $menu.material -bg $color -tearoff 0
    $menu.material add command -label "Material..." -command "graphics3D::material $object $color"
    $menu.material add command -label "Selected Material..." -command "graphics3D::materialBasic $object $color \"-selectedMaterial\""
    graphics3D::materialoptions $menu.material $object    
    pack $parent.context.graphics -side left

    menubutton $parent.context.mesh -text "Mesh" -menu $parent.context.mesh.mn -bg $color
    set menu [menu $parent.context.mesh.mn -bg $color ]
    $menu add command -label "Create New Zone..." -command "triangulation::newZone $object $color"
    $menu add cascade -label "Select Zone..." -menu $menu.zones
    menu $menu.zones -tearoff 0 -bg $color -postcommand "
        set triangulation::selectedZone \[ $object -selectedZone \]
        $menu.zones delete 0 last
        foreach {z} \[ $object -zones \] {
           $menu.zones add radio -label \[ $object \$z -name \] -selectcolor black -variable triangulation::selectedZone -value \$z -command \"evaluate {$object -selectionMode zone $camera};evaluate {$object \$z -select } \" }"
    $menu add cascade -label "Remove Holes..." -menu $menu.holes
    menu $menu.holes -tearoff 0 -bg $color -postcommand "
        $menu.holes delete 0 last
        foreach {v} \[ $object -holes \] {
           $menu.holes add command -label \"Virtual vertex \$v\" -command \"evaluate {$object \$v -removeHole} \" }"
    pack $parent.context.mesh -side left
}


triangulation::installPrecomputedTriangulation3DMenu
Comments  
Arguments parent
camera
object
color
Used by  
Uses imagedata::editIntensityProfileDialog
imagedata::createRangeInformation
triangulation::installTriangulation3DMenu
imagedata::editRangeInformation
proc triangulation::installPrecomputedTriangulation3DMenu {parent camera object color } {
    triangulation::installTriangulation3DMenu $parent $camera $object $color
    $parent.context.object.mn add separator
    $parent.context.object.mn add command -label "Save As PrecomputedTrian..." -command "$object -saveAsPreTr  \[tk_getSaveFile -filetypes {{\"PrecomputedTrian Files\" {.pretr} } {All *}} -parent . -title {Save triangulation as}\]"
    $parent.context.object.mn add command -label "Save Transformation..." -command "$object -saveTransformation  \[tk_getSaveFile -filetypes {{\"Transformation Files\" {.transfo} } {All *}} -parent . -title {Save Transformation}\]"
    
    menubutton $parent.context.ext -text "External Constraints" -menu $parent.context.ext.mn -bg $color
    set mn [menu $parent.context.ext.mn -bg $color -tearoff 0 ]
    $mn add command -label "Set Rest Position" -command "evaluate \"$object -setRestPosition\""
    $mn add separator
    $mn add command -label "Set Force Boundary" -command "evaluate \"$object -setForceBoundary\""
    $mn add command -label "Set Displacement Boundary" -command "evaluate \"$object -setDisplacementBoundary\""
    $mn add command -label "Edit Range Information" -command "if [string compare [isModuleLoaded tclImageData] no] { imagedata::editRangeInformation \[$object -rangeInformation\]}"
    
    $mn add cascade -label "Set New Range Information" -menu $mn.new
    set mn2 [menu $mn.new -bg $color -tearoff 0 ]
    if [string compare [isModuleLoaded tclImageData] no] {imagedata::createRangeInformation $mn.new $object $color}
    $mn add command -label "Store Intensity Profiles..." -command "sm2::storeIntensityProfileDialog $object"
    $mn add command -label "Edit Intensity Profiles..." -command "set rinfs \[ $object -rangeInformationSet \]; if \[ string compare \$rinfs \"Intensity Profile\" \] { if \[string compare \[isModuleLoaded tclImageData \] no \] { imagedata::editIntensityProfileDialog \[new ipinfos \$rinfs \]  } } "

    pack  $parent.context.ext -side left

    set popup $parent.popup
    $popup add separator
    $popup add radio -label "Grab Triangulation" -command "evaluate \"$object -selectionMode grab $camera\"" -selectcolor black -variable triangulation::select$camera -value grab      
}


triangulation::installTrianViewMenu
Comments  
Arguments viewer
camera
contour
bg
Used by  
Uses modules::selectColor
proc triangulation::installTrianViewMenu {viewer camera contour bg } {
    menubutton $viewer.context.display -text "Display" -menu $viewer.context.display.m -anchor w -bg $bg
    set mdisplay [menu $viewer.context.display.m -bg $bg ]
    $mdisplay add command -label "Line Color..." -command "set col \[ modules::selectColor  \[ $contour -lineColor\] \]; evaluate \"$contour -lineColor \[lindex \$col 0\] \[lindex \$col 1\] \[lindex \$col 2\] \""
    
}


triangulation::installTriangle3DMenu
Comments  
Arguments widget
object
triangle
color
Used by  
Uses  
proc triangulation::installTriangle3DMenu {widget object triangle color} {
    if ![winfo exists $widget] {
    menubutton $widget -text $triangle -bg $color -menu $widget.mn
    pack $widget -side right
    set menu [menu $widget.mn -bg $color ]
    $menu add command -label "info..." -command "tk_messageBox -message \[ concat \" connectivity \" \[$object $triangle -connectivity \] \]"
    }
}


triangulation::installTriangulation3DMenu
Comments  
Arguments parent
camera
object
color
Used by haptic::installHapticTriangulation3DMenu
triangulation::installPrecomputedTriangulation3DMenu
Uses triangulation::installMainTriangulation3DMenu
triangulation::installTriangulationMiddlePopupMenu
proc triangulation::installTriangulation3DMenu {parent camera object color } {
    set popup [triangulation::installTriangulationLeftPopupMenu $parent $camera $object]
    triangulation::installTriangulationMiddlePopupMenu $popup $camera $object
    bind [$camera -widget]  <Button-3> "tk_popup $popup %X %Y"
    triangulation::installMainTriangulation3DMenu $parent $camera $object $color
}


triangulation::installTriangulationLeftPopupMenu
Comments  
Arguments parent
camera
object
Used by  
Uses  
proc triangulation::installTriangulationLeftPopupMenu {parent camera object} {
    variable select$camera
    set popup [menu $parent.popup -tearoff 0 -bg "white" -postcommand "set triangulation::select$camera \[$object -selectionMode $camera\]; set triangulation::motionMode \[ $camera -motionMode\]" ]
    $popup add command -label "Left Button" -foreground black -state disabled -command {}
    $popup add radio -label "Select Object" -command "evaluate \"$object -selectionMode object $camera\"" -selectcolor black -variable triangulation::select$camera -value object
    $popup add radio -label "Select Zone" -command "evaluate \"$object -selectionMode zone $camera\"" -selectcolor black -variable triangulation::select$camera -value zone
    $popup add radio -label "Select Vertex" -command "evaluate \"$object -selectionMode vertex $camera\"" -selectcolor black -variable triangulation::select$camera -value vertex
    $popup add radio -label "Select Edge" -command "evaluate \"$object -selectionMode edge $camera\"" -selectcolor black -variable triangulation::select$camera -value edge
    $popup add radio -label "Select Triangle" -command "evaluate \"$object -selectionMode triangle $camera\"" -selectcolor black -variable triangulation::select$camera -value triangle
    $popup add radio -label "Edit Zone" -command "evaluate \"$object -selectionMode editZone $camera\"" -selectcolor black -variable triangulation::select$camera -value editZone
    return $popup
}


triangulation::installTriangulationMiddlePopupMenu
Comments  
Arguments popup
camera
object
Used by triangulation::installActiveTriangulation3DMenu
triangulation::installTriangulation3DMenu
Uses  
proc triangulation::installTriangulationMiddlePopupMenu {popup camera object} {
    $popup add command -label "Middle Button" -state disabled -command {}
    $popup add radio -selectcolor "black" -label "Move Triangulation" -variable triangulation::motionMode -value "object" -command "evaluate \"$camera -motionMode object\""
    $popup add radio -selectcolor "black" -label "Move Camera" -variable triangulation::motionMode -value "camera" -command "evaluate \"$camera -motionMode camera\""
}


triangulation::installVertex3DMenu
Comments  
Arguments widget
object
vertex
color
Used by  
Uses  
proc triangulation::installVertex3DMenu {widget object vertex color} {
    if ![winfo exists $widget] {
    menubutton $widget -text $vertex -bg $color -menu $widget.mn
    pack $widget -side right
    set menu [menu $widget.mn -bg $color  -postcommand "set triangulation::fixed \[$object $vertex -mobility\]"]
    $menu add command -label "info..." -command "tk_messageBox -message \[ concat \[ concat \[ concat \" position \" \[$object $vertex -position \] \] \"\n normal \" \] \[$object $vertex -normal \] \]"
    $menu add checkbutton -label "fixed" -variable triangulation::fixed -onvalue true -offvalue false -selectcolor black -command "evaluate \"$object $vertex -mobility \$triangulation::fixed\""
    if [string compare [isModuleLoaded tclImageData] no] {
        if [string compare [ which rimg3D ] "" ] {
        $menu add command -label "Intensity profile..." -command "imagedata::viewImageProfile $object $vertex $color"
        }
    }
    }
}


triangulation::installZone3DMenu
Comments  
Arguments widget
object
zone
color
Used by  
Uses graphics3D::textureoptions
graphics3D::materialoptions
proc triangulation::installZone3DMenu {widget object zone color} {
    if ![winfo exists $widget] {
    menubutton $widget -text $zone -bg $color -menu $widget.mn
    pack $widget -side right
    set menu [menu $widget.mn -bg $color ]
    $menu add command -label "Zone Name..." -command "tk_messageBox -message \[ concat \" Name : \" \[$object $zone -name \] \]"
    $menu add command -label "Zone Material..." -command "graphics3D::materialBasic \"$object $zone\" $color"
    graphics3D::materialoptions $menu "$object $zone"
    graphics3D::textureoptions $menu "$object $zone" $color
    $menu add command -label "FixTexture" -command "evaluate \"$object $zone -fixTexture\""
    }
}


triangulation::internalForce3D
Comments  
Arguments object
color
Used by  
Uses  
proc triangulation::internalForce3D { object color } {
    global forceType
    variable scheme
    #    global extremityType
    set root .dialogInternalTriangulationForce3D

    if {![winfo exists $root]} {
    set bg $color
    set bg2  "#80C080"
    toplevel $root -bg $bg
    wm title $root "Active 3D Triangulation Internal Force"

    set forceType [$object -internalForce]

    set triangulation::scheme [$object -discretizationScheme]
    set mn [tk_optionMenu $root.item triangulation::scheme "semi-implicit" "explicit" ]
    $root.item  configure -bg $bg2
    for {set i 0} {$i <= [$mn index last]} {incr i} {
        $mn entryconfigure $i -selectcolor black -command "triangulation::chooseInternalScheme $object \$triangulation::scheme  $bg" -background $color  
    }

    pack $root.item -padx 10 -pady 10 -expand true -fill x
    frame $root.s -bg $bg
    pack $root.s -expand true -fill both

    triangulation::chooseInternalScheme $object [$object -discretizationScheme]  $bg

    set mn2 [tk_optionMenu $root.type forceType  [ lindex $triangulation::internalForceList 0 ] ]
    $root.type  configure -bg $bg2
    
    foreach i [ lrange $triangulation::internalForceList 1 end ] {
        $mn2 add radiobutton -label  $i -variable forceType
    }


    for {set i 0} {$i <= [$mn2 index last]} {incr i} {
        $mn2 entryconfigure $i -selectcolor black -command "triangulation::displayInternalForce3D $object $object \[$mn2 entrycget $i -label\]" -background $bg2
    }
    pack $root.type -padx 10 -pady 10 -expand true -fill x

    
    frame $root.f -bg $bg
    pack $root.f -expand true -fill both
    

    frame $root.buttons -bg $bg
    button $root.buttons.apply -text Apply -command "evaluate \"$object -discretizationScheme \$triangulation::scheme\";triangulation::setInternalForce3D $object $object \$forceType" -bg $bg2
    button $root.buttons.applyDismiss -text "Apply & Dismiss" -command "evaluate \"$object -discretizationScheme \$triangulation::scheme\";triangulation::setInternalForce3D $object $object \$forceType;destroy $root" -bg $bg2
    button $root.buttons.destroy -text "Destroy" -command "destroy $root" -bg $bg2
    pack $root.buttons.apply $root.buttons.applyDismiss  $root.buttons.destroy -side left -expand true -fill both -padx 20 -pady 10
    pack $root.buttons -expand true -fill both

    set deformableItem $object
    triangulation::displayInternalForce3D $object $object $forceType
    }
}


triangulation::internalParametersDialog
Comments  
Arguments object
color
Used by  
Uses  
proc triangulation::internalParametersDialog { object color } {
    variable zm
    
    set name .dialogInternal$object
    if ![winfo exists $name] {
    toplevel $name -bg $color
    wm title $name "$object internal parameters"
    set triangulation::zm $object

    scale $name.alpha -orient horizontal -label Alpha -from 0 -to 1 -length 200 -resolution 0.01 -bg $color
    bind $name.alpha <ButtonRelease-1> "evaluate \"\$triangulation::zm -alpha \[$name.alpha get\]\""
    $name.alpha set [$object -alpha]

    scale $name.beta -orient horizontal -label Beta -from 0 -to 1 -length 200 -resolution 0.01 -bg $color
    bind $name.beta <ButtonRelease-1> "evaluate \"\$triangulation::zm -beta \[$name.beta get\]\""
    
    $name.beta set [$object -beta]
    
    scale $name.damping -orient horizontal -label Damping -from 0 -to 1 -length 200 -resolution 0.01 -bg $color
    bind $name.damping <ButtonRelease-1> "evaluate \"\$triangulation::zm -damping \[$name.damping get\]\""
    $name.damping set [$object -damping]

    scale $name.elasticDamping -orient horizontal -label {Elastic Damping} -from 0 -to 1 -length 200 -resolution 0.01 -bg $color
    bind $name.elasticDamping <ButtonRelease-1> "evaluate \"\$triangulation::zm -elasticDamping \[$name.elasticDamping get\]\""
    $name.damping set [$object -damping]
    
    #         scale $name.weight -orient horizontal -label Weight -from 0 -to 1 -resolution 0.01 -length 200 -bg $color
    #         bind $name.weight <ButtonRelease-1> "evaluate \"\$triangulation::zm -weight \[$name.weight get\]\""
    #         $name.weight set [$object -weight]
    
    scale $name.rigidity -orient horizontal -label Rigidity -from 0 -to [$object -rigidity max] -length 200 -bg $color
    bind $name.rigidity <ButtonRelease-1> "evaluate \"\$triangulation::zm -rigidity \[$name.rigidity get\]\""
    $name.rigidity set [$object -rigidity]

    button $name.dismiss -text "Dismiss" -command "destroy $name" -bg $color

    set mn [tk_optionMenu $name.zm triangulation::zm $object]
    $name.zm configure -bg $color
    $mn configure -postcommand "
             set sel \[$object -select\]
        if { \[string match v* \$sel\] } {
              set add 1
         for {set i 0} {\$i <= \[$mn index last\]} {incr i} {
                if !\[string compare \[$mn entrycget \$i -label\] \$sel\] {
                  set add 0
                }
         }
         if \$add { $mn add radiobutton -variable triangulation::zm -label \$sel -value \"$object \$sel\" -selectcolor black -background $color -command \"$name.alpha set \\\[eval \\\$triangulation::zm -alpha\\\]; $name.beta set \\\[eval \\\$triangulation::zm -beta\\\]; $name.damping set \\\[eval \\\$triangulation::zm -damping\\\]; $name.weight set \\\[eval \\\$triangulation::zm -weight\\\]; $name.rigidity set \\\[eval \\\$triangulation::zm -rigidity\\\]\" }
       }"
    foreach z "[$object -zones]"  {
        $mn add radiobutton -variable triangulation::zm -label "$z ([$object $z -name])" -value "$object $z"
    }
    for {set i 0} {$i <= [$mn index last]} {incr i} {
        $mn entryconfigure $i -selectcolor black -background $color -command "$name.alpha set \[eval \$triangulation::zm -alpha\]; $name.beta set \[eval \$triangulation::zm -beta\]; $name.damping set \[eval \$triangulation::zm -damping\]; $name.weight set \[eval \$triangulation::zm -weight\]; $name.rigidity set \[eval \$triangulation::zm -rigidity\]"
    }
    
    pack $name.zm -padx 10 -pady 10
    pack $name.alpha $name.beta $name.damping $name.elasticDamping $name.rigidity -padx 10 -pady 5
    pack $name.dismiss -padx 10 -pady 20
    }
}


triangulation::isTrianInView
Comments  
Arguments scn
sm
Used by triangulation::addTrianView
Uses  
proc triangulation::isTrianInView { scn sm } {
    set val 0
    foreach {i} [$scn -objects] {
    if {[string match trianview* $i]} {
        if { ![string compare [$i -mesh] $sm]} {
        set val 1
        }
    }
    }
    return $val
}


triangulation::newZone
Comments  
Arguments object
bg
Used by  
Uses  
proc triangulation::newZone {object bg} {
    set root .trianNewZone    
    if {![winfo exists $root]} {
    set bg "#A0D0A0"
    set bg2  "#80C080"
    toplevel $root -bg $bg
    wm title $root "New Triangulation Zone"
    
    frame $root.f -bg $bg
    
    frame $root.f.name -bd 2 -bg $bg
    entry $root.f.name.entry -relief sunken -width 20 -bg $bg
    $root.f.name.entry delete 0 20
    $root.f.name.entry insert 0 {New part}
    label $root.f.name.label -text "Zone Name" -bg $bg
    pack $root.f.name.entry -side right -padx 20
    pack $root.f.name.label -side left -padx 20

    pack $root.f.name  -side top -fill x
    pack $root.f -expand true -fill both

    frame $root.buttons -bg $bg
    button $root.buttons.applyDismiss -text "Apply & Dismiss" -command "evaluate \"$object -newZone \{\[$root.f.name.entry get\]\}\"; destroy $root" -bg $bg
    button $root.buttons.destroy -text "Destroy" -command "destroy $root" -bg $bg
    pack $root.buttons.applyDismiss  $root.buttons.destroy -side left -expand true -fill both -padx 20 -pady 10
    pack $root.buttons -expand true -fill both
    }
}


triangulation::saveOption
Comments  
Arguments object
fileType
windowTitle
Used by  
Uses  
proc triangulation::saveOption { object fileType windowTitle} {
    set root .trianSave
    if {![winfo exists $root]} {
    set bg "#A0D0A0"
    set bg2  "#80C080"
    toplevel $root -bg $bg
    wm title $root "Save Triangulation"
    frame $root.f -bg $bg

    foreach f [$object -saveOption] {
        set name $root.f.[string tolower $f]
        set $f.save [$object -saveOption $f]
        checkbutton $name  -text $f -variable $f.save -relief flat -bg $bg -onvalue {true} -offvalue {false}
        if {[$object -saveOption $f]}  {
        $name select
        } else {
        $name deselect
        }
        pack $name -side top -expand true -fill both
    }
    pack $root.f -side top
    frame $root.buttons -bg $bg
    button $root.buttons.save -text "Save" -command "destroy $root;  foreach f \[$object -saveOption\] {evaluate \"$object -saveOption \$f \[subst $\\{\$f.save\\} \]\"}; evaluate \"$object -save \[ tk_getSaveFile -filetypes \{$fileType\} -title \{$windowTitle\}\]\"" -bg $bg
    button $root.buttons.destroy -text "Dismiss" -command "evaluate \"destroy $root\"" -bg $bg
    pack $root.buttons.save  $root.buttons.destroy -side left -expand true -fill both -padx 20 -pady 10
    pack $root.buttons -expand true -fill both
    }
}


triangulation::setInternalForce3D
Comments  
Arguments object
item
force
Used by  
Uses  
proc triangulation::setInternalForce3D {object item force } {
    switch $force {
    "Spring-Mass" {
        if { $triangulation::setRestLength == 1 } {
        evaluate "$object -setRestLength" }
    }
    }
    evaluate " $item -internalForce \"$force\" "
}


triangulation::setInternalParameters
Comments  
Arguments line
label
Used by  
Uses  
proc triangulation::setInternalParameters {line label} {
    
    if {[winfo exists .dialogInternal]} {
    switch $label {
        "Contour" { set option "-contourParameter" }
        "Selected Vertex" { set option "-vertexParameter" }
    }
    
    .dialogInternal.alpha set [$line $option alpha]
    .dialogInternal.beta set [$line $option beta]
    .dialogInternal.locality set [$line $option locality]
    .dialogInternal.damping set [$line $option damping]
    .dialogInternal.rigidity set [$line $option rigidity]
    #        
    bind .dialogInternal.alpha <ButtonRelease-1> "evaluate \"$line $option alpha  \[.dialogInternal.alpha get\]\" "
    bind .dialogInternal.beta <ButtonRelease-1> "evaluate \"$line $option beta  \[.dialogInternal.beta get\]\" "
    bind .dialogInternal.locality <ButtonRelease-1> "evaluate \"$line $option locality  \[.dialogInternal.locality get\] \" "
    bind .dialogInternal.damping <ButtonRelease-1> "evaluate \"$line $option damping  \[.dialogInternal.damping get\] \""
    bind .dialogInternal.rigidity <ButtonRelease-1> "evaluate \"$line $option rigidity  \[.dialogInternal.rigidity get\] \" "
    }
}


triangulation::uninstallActiveTriangulation3DMenu
Comments  
Arguments parent
camera
object
Used by  
Uses triangulation::uninstallTriangulation3DMenu
proc triangulation::uninstallActiveTriangulation3DMenu {parent camera object } {
    triangulation::uninstallTriangulation3DMenu $parent $camera $object
    destroy $parent.context.internal
}


triangulation::uninstallPrecomputedTriangulation3DMenu
Comments  
Arguments parent
camera
object
Used by  
Uses triangulation::uninstallTriangulation3DMenu
proc triangulation::uninstallPrecomputedTriangulation3DMenu {parent camera object } {
    triangulation::uninstallTriangulation3DMenu $parent $camera $object
}


triangulation::uninstallTriangulation3DMenu
Comments  
Arguments parent
camera
object
Used by triangulation::uninstallPrecomputedTriangulation3DMenu
haptic::uninstallHapticTriangulation3DMenu
triangulation::uninstallActiveTriangulation3DMenu
Uses  
proc triangulation::uninstallTriangulation3DMenu {parent camera object } {
    # remove frame children
    set list [winfo children $parent.context]
    foreach w $list { destroy $w}
    destroy $parent.popup
    #reset selection mode
    $camera -motionMode camera
    bind [$camera -widget]  <Button-3> ""
}