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

tclTetrahedrisation.tcl



tetrahedrisation::activationConstraint
Comments  
Arguments object
file
Used by tetrahedrisation::editForceConstraint
tetrahedrisation::forceConstraint
Uses  
proc tetrahedrisation::activationConstraint { object file } {
    set root .activationConstraint
    if {![winfo exists $root]} {
    set bg #A0D0A0
    set bg2 #80C080

    toplevel $root -bg $bg
    wm title $root "Activation Constraint"

    button $root.file -textvariable file -text $file -bg $bg2 -relief raised -justify center \
        -command "set file \[tk_getOpenFile -filetypes {{\"Activation Files\" {.prob} } {All *}} -parent . -title {Read Activation file}\]"
    
    pack $root.file -padx 10 -pady 10

    frame $root.buttons -bg $bg
    button $root.buttons.apply -text "Apply" -command " evaluate \" $object -activationConstraint \$file \" " -bg $bg
    button $root.buttons.applyDismiss -text "Apply & Dismiss" -command " evaluate \"$object -activationConstraint \$file \" ; destroy $root " -bg $bg
    button $root.buttons.destroy -text "Destroy" -command "destroy $root" -bg $bg
    pack $root.buttons.apply $root.buttons.applyDismiss  $root.buttons.destroy -side left -expand true -fill both -padx 20 -pady 20
    pack $root.buttons -expand true -fill both
    }
}


tetrahedrisation::addTetraView
Comments  
Arguments name
mname
toff
color
Used by inrimage::OldaddObjectMenu
Uses tetrahedrisation::isTetraInView
proc tetrahedrisation::addTetraView { name mname {toff 0} {color "#E8E0D2"}} {
    $name add cascade -label "3D Tetrahedrisation" -menu $name.tet1
    menu $name.tet1 -tearoff $toff -bg $color -postcommand "set tetrahedrisation::scn \[ \[ lindex \[ split \[ ${mname} -views\] \] 0 \] -scene \]; $name.tet1 delete 0 last; foreach {i} \[which tet3D\] { set tetrahedrisation::view(\$i) \[ tetrahedrisation::isTetraInView \${tetrahedrisation::scn} \$i \];  }; foreach {i} \[which tet3D\] {$name.tet1 add checkbutton -selectcolor black -variable tetrahedrisation::view(\$i) -label \$i -command \" if  \$tetrahedrisation::view(\$i) \{evaluate {\[tetrahedrisation::getTetraInView  \${tetrahedrisation::scn} \$i\] -destroy } \} else  \{evaluate {new tetview \$i -scene \${tetrahedrisation::scn} } \}  \"}"
    $name add cascade -label "3D Active Tetrahedrisation" -menu $name.tet2
    menu $name.tet2 -tearoff $toff -bg $color -postcommand "set tetrahedrisation::scn \[ \[ lindex \[ split \[ ${mname} -views\] \] 0 \] -scene \]; $name.tet2 delete 0 last; foreach {i} \[which atet3D\] { set tetrahedrisation::view(\$i) \[ tetrahedrisation::isTetraInView \${tetrahedrisation::scn} \$i \] }; foreach {i} \[which atet3D\] {$name.tet2 add checkbutton -selectcolor black -variable tetrahedrisation::view(\$i) -label \$i -command \" if  \$tetrahedrisation::view(\$i) \{evaluate {\[tetrahedrisation::getTetraInView  \${tetrahedrisation::scn} \$i\] -destroy } \} else  \{evaluate {new tetview \$i -scene \${tetrahedrisation::scn} } \}  \"}"
}


tetrahedrisation::displayInternalForce3D
Comments  
Arguments object
item
force
Used by  
Uses  
proc tetrahedrisation::displayInternalForce3D { object item force } {
    variable setRestLength
    set root .dialogInternalTetraForce3D
    set list [winfo children $root.f]
    set bg #A0D0A0
    set bg2  #80C080
    foreach w $list {destroy $w}
    
    switch $force {
    "Spring-Mass System" {
        set  tetrahedrisation::setRestLength 0
        checkbutton $root.f.restLength -variable tetrahedrisation::setRestLength -text "Set Spring Rest Length" -relief flat -bg $bg
        pack $root.f.restLength -side left
        pack $root.f -expand true -fill both
    }
    }
}


tetrahedrisation::editForceConstraint
Comments  
Arguments name
object
index
Used by tetrahedrisation::forceConstraint
Uses tetrahedrisation::isovolumetricConstraint
tetrahedrisation::activationConstraint
tetrahedrisation::incompressibilityConstraint
tetrahedrisation::pressureConstraint
proc tetrahedrisation::editForceConstraint { name object index } {
    set j  -1
    set label  [$object -forceConstraint $index ]
    for { set i 0 } { $i <= $index } { incr i } {
    set label2 [$object -forceConstraint $i ]
    if  {[string compare $label2 $label ]==0}  {
        incr j}
    }
    switch $name {
    "Incompressibility Constraint"  { tetrahedrisation::incompressibilityConstraint $object [$object -incompressibilityConstraint]   }
    "Isovolumetric Constraint"  { tetrahedrisation::isovolumetricConstraint $object [lindex $result 1]  [lindex $result 2] }
    "Pressure Constraint"  { tetrahedrisation::pressureConstraint $object [$object -pressureConstraint] }
    "Activation Constraint" { tetrahedrisation::activationConstraint $object [lindex $result 1]  [lindex $result 2] }
    }
}


tetrahedrisation::editPositionConstraint
Comments  
Arguments name
object
Used by tetrahedrisation::positionConstraint
Uses  
proc tetrahedrisation::editPositionConstraint { name object } {
    switch $name {
    }
}


tetrahedrisation::forceConstraint
Comments  
Arguments object
color
Used by  
Uses tetrahedrisation::isovolumetricConstraint
tetrahedrisation::editForceConstraint
tetrahedrisation::activationConstraint
tetrahedrisation::pressureConstraint
tetrahedrisation::incompressibilityConstraint
proc tetrahedrisation::forceConstraint { object color } {
    set root .forceConstraint
    set bg $color
    if {![winfo exists $root]} {
    set bg #A0D0A0
    set bg2  #80C080
    toplevel $root -bg $bg
    wm title $root "ActiveTetra3D Force Constraint"
    label $root.msg -justify center -text "List of Force Constraints" -bg $bg
    pack $root.msg  -side top
    
    frame $root.f -borderwidth .5c -bg $bg
    pack $root.f -side top -expand yes -fill y
    
    scrollbar $root.f.scroll -command "$root.f.list yview" -bg $bg
    listbox $root.f.list -yscroll "$root.f.scroll set" -setgrid 1 -height 12 -bg $bg
    pack $root.f.scroll -side right -fill y
    pack $root.f.list -side left -expand 1 -fill both


    set nbConstraints [$object -forceConstraint]
    for { set i 0 } { $i < $nbConstraints } { incr i } {
        $root.f.list insert $i [$object -forceConstraint $i ]
    }

    frame $root.process -bg $bg
    pack $root.process -side top -pady 2m
    menubutton $root.process.create -text "Create Constraint" -bg $bg -underline 0 -direction above -menu $root.process.create.m -relief raised
    menu $root.process.create.m -tearoff 0
    $root.process.create.m add command -label "Gravity Constraint" -command "if \[ string compare \[ $object -vertexParameter \] {none} \] {destroy $root;tetrahedrisation::gravityConstraint $object \[ lindex \[$object -vertexParameter position\] 0\]  \[ lindex \[$object -vertexParameter position\] 1\] \[ $object -vertexParameter rank \]  0.5  } "
    
    $root.process.create.m add command -label "Pressure Constraint" -command " tetrahedrisation::pressureConstraint $object sz0 1.0 ; destroy $root "
    $root.process.create.m add command -label "Incompressibility Constraint" -command " tetrahedrisation::incompressibilityConstraint $object  1.0 ; destroy $root "
    $root.process.create.m add command -label "Isovolumetric Constraint" -command " tetrahedrisation::isovolumetricConstraint $object sz0 1.0e9 ; destroy $root "
    $root.process.create.m add command -label "Activation Constraint" -command " tetrahedrisation::activationConstraint $object \"Select File\" ; destroy $root "

    button $root.process.edit -text "Edit Constraint" -bg $bg -command " tetrahedrisation::editForceConstraint \[ $root.f.list get \[ lindex \[ $root.f.list curselection \] 0 \] \] $object \[ lindex \[ $root.f.list curselection \] 0 \]; destroy $root"
    button $root.process.delete -text "Delete Constraint" -bg $bg -command "$object -forceConstraint \[ lindex \[ $root.f.list curselection \] 0 \] delete;destroy $root"
    pack $root.process.create $root.process.edit $root.process.delete -side top -expand 1

    frame $root.button -bg $bg
    pack $root.button -side bottom -pady 2m
    button $root.button.dismiss -text Dismiss -command "destroy $root" -bg $bg
    pack  $root.button.dismiss -side left -expand 1
    }
}


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


tetrahedrisation::incompressibilityConstraint
Comments  
Arguments object
extent
Used by tetrahedrisation::editForceConstraint
tetrahedrisation::forceConstraint
Uses  
proc tetrahedrisation::incompressibilityConstraint { object extent } {
    set root .incompressibilityConstraint
    if {![winfo exists $root]} {
    set bg #A0D0A0
    set bg2 #80C080

    toplevel $root -bg $bg
    wm title $root "Incompressibility Constraint"

    frame $root.extent -bg $bg
    scale $root.extent.val -orient horizontal -label Extent -from 0 -to 1 -length 200 -resolution 0.01 -bg $bg
    $root.extent.val set $extent
    pack $root.extent.val
    pack $root.extent -padx 20 -pady 20

    frame $root.buttons -bg $bg
    button $root.buttons.apply -text "Apply" -command " evaluate \" $object -incompressibilityConstraint  \[ $root.extent.val get \] \" " -bg $bg
    button $root.buttons.applyDismiss -text "Apply & Dismiss" -command " evaluate \"$object -incompressibilityConstraint \[ $root.extent.val get \]  \" ; destroy $root " -bg $bg
    button $root.buttons.destroy -text "Destroy" -command "destroy $root" -bg $bg
    pack $root.buttons.apply $root.buttons.applyDismiss  $root.buttons.destroy -side left -expand true -fill both -padx 20 -pady 20
    pack $root.buttons -expand true -fill both
    }
}


tetrahedrisation::installActiveEdge3DMenu
Comments  
Arguments widget
object
edge
color
Used by  
Uses tetrahedrisation::installEdge3DMenu
proc tetrahedrisation::installActiveEdge3DMenu {widget object edge color} {
    tetrahedrisation::installEdge3DMenu $widget $object $edge $color
    $widget.mn add command -label "Remove Edge" -command "evaluate \"$object $edge -remove\""
}


tetrahedrisation::installActiveSurfaceZone3DMenu
Comments  
Arguments widget
object
szone
color
Used by  
Uses tetrahedrisation::installSurfaceZone3DMenu
proc tetrahedrisation::installActiveSurfaceZone3DMenu {widget object szone color} {
    tetrahedrisation::installSurfaceZone3DMenu $widget $object $szone $color
    $widget.mn add separator
    $widget.mn add command -label "Fix Zone" -command "evaluate \"$object $szone -fixZone\""
}


tetrahedrisation::installActiveTetra3DDisplayMenu
Comments  
Arguments parent
camera
object
color
Used by tetrahedrisation::installActiveTetra3DMenu
simulation::installSimuTetra3DMenu
Uses tetrahedrisation::installTetra3DDisplayMenu
proc tetrahedrisation::installActiveTetra3DDisplayMenu {parent camera object color } {
    tetrahedrisation::installTetra3DDisplayMenu $parent $camera $object $color
    set mdisplay $parent.context.graphics.mn
    $mdisplay add separator
    $mdisplay add checkbutton -label "Display Normals" -variable tetrahedrisation::displayNormal -onvalue true -offvalue false -selectcolor black -command "evaluate \"$object -showNormals \${tetrahedrisation::displayNormal}\" "
    $mdisplay add checkbutton -label "Display Closest Point" -variable tetrahedrisation::displayClosest -onvalue true -offvalue false -selectcolor black -command "evaluate \"$object -showClosestPoint \${tetrahedrisation::displayClosest}\" "
    $mdisplay add command -label "Show External Forces" -command "evaluate \"$object -showExternalForces\""
    set tetrahedrisation::displayNormal [$object -showNormals ]
    set tetrahedrisation::displayClosest [$object -showClosestPoint ]    
}


tetrahedrisation::installActiveTetra3DMenu
Comments  
Arguments parent
camera
object
color
Used by  
Uses tetrahedrisation::installTetra3DFileMenu
tetrahedrisation::installActiveTetra3DDisplayMenu
imagedata::editRangeInformation
imagedata::createRangeInformation
tetrahedrisation::installActiveTetra3DMeshMenu
proc tetrahedrisation::installActiveTetra3DMenu {parent camera object color } {
    variable select$camera
    variable asynchronous
    set popup [menu $parent.popup -tearoff 0 -bg "white" -postcommand "set tetrahedrisation::select$camera \[$object -selectionMode $camera\]" ]
    $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 tetrahedrisation::select$camera -value object
    $popup add radio -label "Select Vertex" -command "evaluate \"$object -selectionMode vertex $camera\"" -selectcolor black -variable tetrahedrisation::select$camera -value vertex
    $popup add radio -label "Select Edge" -command "evaluate \"$object -selectionMode edge $camera\"" -selectcolor black -variable tetrahedrisation::select$camera -value edge
    $popup add radio -label "Select Triangle" -command "evaluate \"$object -selectionMode triangle $camera\"" -selectcolor black -variable tetrahedrisation::select$camera -value triangle
    $popup add radio -label "Select Zone" -command "evaluate \"$object -selectionMode zone $camera\"" -selectcolor black -variable tetrahedrisation::select$camera -value zone
    $popup add radio -label "Select Surface Zone" -command "evaluate \"$object -selectionMode surfaceZone $camera\"" -selectcolor black -variable tetrahedrisation::select$camera -value surfaceZone
    $popup add radio -label "Edit Zone" -command "evaluate \"$object -selectionMode editZone $camera\"" -selectcolor black -variable tetrahedrisation::select$camera -value editZone
    $popup add radio -label "Edit Surface Zone" -command "evaluate \"$object -selectionMode editSurfaceZone $camera\"" -selectcolor black -variable tetrahedrisation::select$camera -value editSurfaceZone
    $popup add radio -label "Grab Tetrahedrisation" -command "evaluate \"$object -selectionMode grab $camera\"" -selectcolor black -variable tetrahedrisation::select$camera -value grab
    $popup add radio -label "Remove Tetrahedron" -command "evaluate \"$object -selectionMode removeTetrahedron $camera\"" -selectcolor black -variable tetrahedrisation::select$camera -value removeTetrahedron
    bind [$camera -widget]  <Button-3> "tk_popup $popup %X %Y"

    tetrahedrisation::installTetra3DFileMenu $parent $camera $object $color atet3D
    tetrahedrisation::installActiveTetra3DDisplayMenu $parent $camera $object $color
    tetrahedrisation::installActiveTetra3DMeshMenu $parent $camera $object $color

    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 checkbutton -label "asynchronous" -variable tetrahedrisation::asynchronous -onvalue true -offvalue false -selectcolor black -command "evaluate \"$object -asynchronous \$tetrahedrisation::asynchronous\""
    $minternal add command -label "Internal Parameters..." -command "tetrahedrisation::internalParametersDialog $object $color"
    $minternal add command -label "Internal Force Type..." -command "tetrahedrisation::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 tetrahedrisation::mode \[$object -deformationMode\]"]
    $mn add radiobutton -label "none" -variable tetrahedrisation::mode -selectcolor black -value no -command "evaluate \"$object -deformationMode no\""
    $mn add radiobutton -label "local" -variable tetrahedrisation::mode -selectcolor black -command "evaluate \"$object -deformationMode local\""
    $mn add radiobutton -label "global" -variable tetrahedrisation::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 tetrahedrisation::transfo \[$object -globalTransformation\]"]
    $mn add radiobutton -label "rigid" -variable tetrahedrisation::transfo -selectcolor black -command "evaluate \"$object -globalTransformation rigid\""
    $mn add radiobutton -label "similarity" -variable tetrahedrisation::transfo -selectcolor black -command "evaluate \"$object -globalTransformation similarity\""
    $mn add radiobutton -label "affine" -variable tetrahedrisation::transfo -selectcolor black -command "evaluate \"$object -globalTransformation affine\""
    $minternal add command -label "Time Parameters..." -command "tetrahedrisation::setTimeParameters $object $color"
    $minternal add command -label "Material properties..." -command "tetrahedrisation::materialProperties $object $color"
    $minternal add separator
    $minternal add command -label "Force Constraint..." -command "tetrahedrisation::forceConstraint $object $color"
    $minternal add command -label "Position Constraint..." -command "tetrahedrisation::positionConstraint $object $color"
    pack  $parent.context.internal -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
}


tetrahedrisation::installActiveTetra3DMeshMenu
Comments  
Arguments parent
camera
object
color
Used by simulation::installSimuTetra3DMenu
tetrahedrisation::installActiveTetra3DMenu
Uses tetrahedrisation::installTetra3DMeshMenu
proc tetrahedrisation::installActiveTetra3DMeshMenu {parent camera object color } {
    tetrahedrisation::installTetra3DMeshMenu $parent $camera $object $color
    set mmesh $parent.context.mesh.mn
    $mmesh add separator
    $mmesh add command -label "Tetrahedron Quality..." -command "evaluate \" \[ $object -qualityHistogram \] -plot \""
}


tetrahedrisation::installActiveTetrahedron3DMenu
Comments  
Arguments widget
object
tetrahedron
color
Used by  
Uses tetrahedrisation::installTetrahedron3DMenu
proc tetrahedrisation::installActiveTetrahedron3DMenu {widget object tetrahedron color} {
    tetrahedrisation::installTetrahedron3DMenu $widget $object $tetrahedron $color
}


tetrahedrisation::installActiveTriangle3DMenu
Comments  
Arguments widget
object
triangle
color
Used by  
Uses tetrahedrisation::installTriangle3DMenu
proc tetrahedrisation::installActiveTriangle3DMenu {widget object triangle color} {
    tetrahedrisation::installTriangle3DMenu $widget $object $triangle $color
    $widget.mn add command -label "Swap Triangle" -command "evaluate \"$object $triangle -swap\""
}


tetrahedrisation::installActiveVertex3DMenu
Comments  
Arguments widget
object
vertex
color
Used by  
Uses tetrahedrisation::installBasicVertex3DMenu
proc tetrahedrisation::installActiveVertex3DMenu {widget object vertex color} {
    menubutton $widget -text $vertex -bg $color -menu $widget.mn
    pack $widget -side right
    set menu [menu $widget.mn -bg $color  -postcommand "set tetrahedrisation::fixed \[$object $vertex -fixed\]"]
    tetrahedrisation::installBasicVertex3DMenu $widget $object $vertex $color $menu

    $widget.mn add command -label "Remove Vertex" -command "evaluate \"$object $vertex -remove\""
    $menu add checkbutton -label "fixed" -variable tetrahedrisation::fixed -onvalue true -offvalue false -selectcolor black -command "evaluate \"$object $vertex -fixed \$tetrahedrisation::fixed\""

    if [string compare [isModuleLoaded tclImageData] no] {
    if [string compare [ which rimg3D ] "" ] {
        $widget.mn add command -label "Intensity profile..." -command "imagedata::viewImageProfile $object $vertex $color"
    }
    }
}


tetrahedrisation::installActiveZone3DMenu
Comments  
Arguments widget
object
zone
color
Used by  
Uses tetrahedrisation::installZone3DMenu
proc tetrahedrisation::installActiveZone3DMenu {widget object zone color} {
    tetrahedrisation::installZone3DMenu $widget $object $zone $color
    $widget.mn add command -label "Set Edge Size..." -command "tetrahedrisation::setEdgeSize $object $zone $color"
    $widget.mn add command -label "Multiply Edge Size..." -command "tetrahedrisation::multiplyEdgeSize $object $zone $color"
    $widget.mn add command -label "remove" -command "evaluate \"$object $zone -remove\""
}


tetrahedrisation::installBasicVertex3DMenu
Comments  
Arguments widget
object
vertex
color
menu
Used by tetrahedrisation::installVertex3DMenu
tetrahedrisation::installActiveVertex3DMenu
Uses  
proc tetrahedrisation::installBasicVertex3DMenu {widget object vertex color menu} {
    $menu add command -label "info..." -command "tk_messageBox -message \[ concat \[ concat \[ concat \[ concat \[ concat \"Position\" \[$object $vertex -position \] \] \" \n Edge Size \" \] \[$object $vertex -edgeSize \] \] \" \n Priority \" \] \[$object $vertex -priority \] \]"
    $widget.mn add command -label "Refine Vertex" -command "evaluate \"$object $vertex -refine\""
}


tetrahedrisation::installEdge3DMenu
Comments  
Arguments widget
object
edge
color
Used by tetrahedrisation::installActiveEdge3DMenu
Uses  
proc tetrahedrisation::installEdge3DMenu {widget object edge color} {
    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 \[ concat \[ concat \" connectivity \" \[$object $edge -connectivity \] \] \"\n length \" \] \[$object $edge -length \] \]"
    $widget.mn add command -label "Refine Edge" -command "evaluate \"$object $edge -refine\""
}


tetrahedrisation::installSurfaceZone3DMenu
Comments  
Arguments widget
object
szone
color
Used by tetrahedrisation::installActiveSurfaceZone3DMenu
Uses graphics3D::materialoptions
graphics3D::textureoptions
proc tetrahedrisation::installSurfaceZone3DMenu {widget object szone color} {
    menubutton $widget -text $szone -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 $szone -name \] \]"
    $menu add command -label "Shrink" -command "evaluate \"$object $szone -shrink\""
    $menu add command -label "Expand" -command "evaluate \"$object $szone -expand\""
    $menu add command -label "Zone Material..." -command "graphics3D::materialBasic \"$object $szone\" $color"
    graphics3D::materialoptions $menu "$object $szone"
    graphics3D::textureoptions $menu "$object $szone" $color
    $menu add command -label "Fix Texture" -command "evaluate \"$object $szone -fixTexture\""
    $menu add command -label "Save vertices list" -command "evaluate \" $object $szone -writeVertexList \[tk_getSaveFile -filetypes {{\"Zone vertices Files\" {.txt} } {All *}} -parent . -title {Save Vertices List as}\] \" "
}


tetrahedrisation::installTetra3DDisplayMenu
Comments  
Arguments parent
camera
object
color
Used by tetrahedrisation::installActiveTetra3DDisplayMenu
tetrahedrisation::installTetra3DMenu
Uses graphics3D::materialoptions
modules::selectColorStr
graphics3D::textureoptions
graphics3D::renderoptions
proc tetrahedrisation::installTetra3DDisplayMenu {parent camera object color } {
    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
}


tetrahedrisation::installTetra3DFileMenu
Comments  
Arguments parent
camera
object
color
ext
Used by tetrahedrisation::installActiveTetra3DMenu
tetrahedrisation::installTetra3DMenu
simulation::installSimuTetra3DMenu
Uses  
proc tetrahedrisation::installTetra3DFileMenu {parent camera object color {ext tet3D}} {
    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 "tetrahedrisation::saveOption $object { {\"Tetrahedrisation\" {*.$ext} }  } {Select a Tetrahedrisation name}"
    $menu add command -label "Save As GHS3D..." -command "$object -saveAsGHS3D  \[tk_getSaveFile -filetypes {{\"GHS3D Files\" {.noboite} } {All *}} -parent . -title {Save tetrahedrisation as}\]"
    $menu add command -label "Save As Triangulation..." -command "$object -saveTr  \[tk_getSaveFile -filetypes {{\"Tr Files\" {.tr} } {All *}} -parent . -title {Save tetrahedrisation as}\]"
    $menu add command -label "Save As Precomputed Tr..." -command "$object -saveAsPreTr  \[tk_getSaveFile -filetypes {{\"Precomputed Tr Files\" {.pretr} } {All *}} -parent . -title {Save tetrahedrisation as}\]"
    $menu add command -label "Read Basic Transformation..." -command "$object -readBasicTransformation  \[tk_getOpenFile -filetypes {{\"Transformation Files\" {.transfo} } {All *}} -parent . -title {Read Basic Transformation file}\]"
    $menu add command -label "Apply Transformation" -command "$object -applyTransformation  \[tk_getOpenFile -filetypes {{\"Transformation Files\" {.trsf} } {All *}} -parent . -title {Read Transformation file}\]"
    
    $menu add separator
    $menu add command -label destroy -command "evaluate \"$object -destroy\""
    pack $parent.context.object -side left
}


tetrahedrisation::installTetra3DMenu
Comments  
Arguments parent
camera
object
color
Used by  
Uses tetrahedrisation::installTetra3DFileMenu
tetrahedrisation::installTetra3DMeshMenu
tetrahedrisation::installTetra3DDisplayMenu
proc tetrahedrisation::installTetra3DMenu {parent camera object color } {
    variable select$camera
    set popup [menu $parent.popup -tearoff 0 -bg "white" -postcommand "set tetrahedrisation::select$camera \[$object -selectionMode $camera\]" ]
    $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 tetrahedrisation::select$camera -value object
    $popup add radio -label "Select Vertex" -command "evaluate \"$object -selectionMode vertex $camera\"" -selectcolor black -variable tetrahedrisation::select$camera -value vertex
    $popup add radio -label "Select Edge" -command "evaluate \"$object -selectionMode edge $camera\"" -selectcolor black -variable tetrahedrisation::select$camera -value edge
    $popup add radio -label "Select Triangle" -command "evaluate \"$object -selectionMode triangle $camera\"" -selectcolor black -variable tetrahedrisation::select$camera -value triangle
    $popup add radio -label "Select Zone" -command "evaluate \"$object -selectionMode zone $camera\"" -selectcolor black -variable tetrahedrisation::select$camera -value zone
    $popup add radio -label "Select Surface Zone" -command "evaluate \"$object -selectionMode surfaceZone $camera\"" -selectcolor black -variable tetrahedrisation::select$camera -value surfaceZone
    $popup add radio -label "Edit Zone" -command "evaluate \"$object -selectionMode editZone $camera\"" -selectcolor black -variable tetrahedrisation::select$camera -value editZone
    $popup add radio -label "Edit Surface Zone" -command "evaluate \"$object -selectionMode editSurfaceZone $camera\"" -selectcolor black -variable tetrahedrisation::select$camera -value editSurfaceZone
    $popup add radio -label "Remove Tetrahedron" -command "evaluate \"$object -selectionMode removeTetrahedron $camera\"" -selectcolor black -variable tetrahedrisation::select$camera -value removeTetrahedron
    bind [$camera -widget]  <Button-3> "tk_popup $popup %X %Y"

    tetrahedrisation::installTetra3DFileMenu $parent $camera $object $color
    tetrahedrisation::installTetra3DDisplayMenu $parent $camera $object $color
    tetrahedrisation::installTetra3DMeshMenu $parent $camera $object $color

}


tetrahedrisation::installTetra3DMeshMenu
Comments  
Arguments parent
camera
object
color
Used by tetrahedrisation::installActiveTetra3DMeshMenu
tetrahedrisation::installTetra3DMenu
Uses  
proc tetrahedrisation::installTetra3DMeshMenu {parent camera object color } {
    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 "tetrahedrisation::newZone $object $color"
    $menu add cascade -label "Select Zone..." -menu $menu.zones
    menu $menu.zones -tearoff 0 -bg $color -postcommand "
        set tetrahedrisation::selectedZone \[ $object -selectedZone \]
        $menu.zones delete 0 last
        foreach {z} \[ $object -zones \] {
           $menu.zones add radio -label \[ $object \$z -name \] -selectcolor black -variable tetrahedrisation::selectedZone -value \$z -command \"evaluate {$object \$z -select } \" }"
    $menu add separator
    $menu add command -label "Create New Surface Zone..." -command "tetrahedrisation::newSurfaceZone $object $color"
    $menu add cascade -label "Select Surface Zone..." -menu $menu.szones
    menu $menu.szones -tearoff 0 -bg $color -postcommand "
        set tetrahedrisation::selectedSZone \[ $object -selectedSurfaceZone \]
        $menu.szones delete 0 last
        foreach {z} \[ $object -surfaceZones \] {
           $menu.szones add radio -label \[ $object \$z -name \] -selectcolor black -variable tetrahedrisation::selectedSZone -value \$z -command \"evaluate {$object -selectionMode surfaceZone $camera};evaluate {$object \$z -select } \" }"
    pack $parent.context.mesh -side left
}


tetrahedrisation::installTetrahedron3DMenu
Comments  
Arguments widget
object
tetrahedron
color
Used by tetrahedrisation::installActiveTetrahedron3DMenu
Uses  
proc tetrahedrisation::installTetrahedron3DMenu {widget object tetrahedron color} {
    menubutton $widget -text $tetrahedron -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 $tetrahedron -connectivity \]  \]"
}


tetrahedrisation::installTriangle3DMenu
Comments  
Arguments widget
object
triangle
color
Used by tetrahedrisation::installActiveTriangle3DMenu
Uses  
proc tetrahedrisation::installTriangle3DMenu {widget object triangle color} {
    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 \]  \]"
}


tetrahedrisation::installVertex3DMenu
Comments  
Arguments widget
object
vertex
color
Used by  
Uses tetrahedrisation::installBasicVertex3DMenu
proc tetrahedrisation::installVertex3DMenu {widget object vertex color} {
    menubutton $widget -text $vertex -bg $color -menu $widget.mn
    pack $widget -side right
    set menu [menu $widget.mn -bg $color ]
    tetrahedrisation::installBasicVertex3DMenu $widget $object $vertex $color $menu
}


tetrahedrisation::installZone3DMenu
Comments  
Arguments widget
object
zone
color
Used by tetrahedrisation::installActiveZone3DMenu
Uses  
proc tetrahedrisation::installZone3DMenu {widget object zone color} {
    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 "Shrink" -command "evaluate \"$object $zone -shrink\""
    $menu add command -label "Expand" -command "evaluate \"$object $zone -expand\""
}


tetrahedrisation::internalForce3D
Comments  
Arguments object
color
Used by  
Uses  
proc tetrahedrisation::internalForce3D { object color } {
    variable forceType
    variable deformableItem
    set root .dialogInternalTetraForce3D

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

    set tetrahedrisation::forceType [$object -internalForce ]

    set mn [tk_optionMenu $root.item tetrahedrisation::deformableItem $object]
    $root.item  configure -bg $bg2
    for {set i 0} {$i <= [$mn index last]} {incr i} {
        evaluate "$mn entryconfigure $i -selectcolor black -command \"tetrahedrisation::displayInternalForce3D $object $object \{\$tetrahedrisation::forceType\} \" -background $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 { set val \"$object \$sel\";$mn add radiobutton -variable tetrahedrisation::deformableItem -label \$sel -value \"$object \$sel\" -selectcolor black -background $color -command \"tetrahedrisation::displayInternalForce3D $object \{\$val\} \{\$tetrahedrisation::forceType\}\" }
       }"
    foreach z "[$object -zones]"  {
        $mn add radiobutton -variable tetrahedrisation::deformableItem -label "$z ([$object $z -name])" -value "$object $z" -background $color -command  "tetrahedrisation::displayInternalForce3D $object {$object \$z} \$tetrahedrisation::forceType"
    }
    #        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.locality set \[eval \$triangulation::zm -locality\]; $name.weight set \[eval \$triangulation::zm -weight\]; $name.rigidity set \[eval \$triangulation::zm -rigidity\]"
    #       }


    pack $root.item -padx 10 -pady 10 -expand true -fill x

    set mn2 [ eval {tk_optionMenu $root.type tetrahedrisation::forceType} [$object -internalForce all]]

    $root.type  configure -bg $bg2

    for {set i 0} {$i <= [$mn2 index last]} {incr i} {
        $mn2 entryconfigure $i -selectcolor black -command "tetrahedrisation::displayInternalForce3D $object \$tetrahedrisation::deformableItem \[$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 "tetrahedrisation::setInternalForce3D $object \$tetrahedrisation::deformableItem \$tetrahedrisation::forceType" -bg $bg2
    button $root.buttons.applyDismiss -text "Apply & Dismiss" -command "tetrahedrisation::setInternalForce3D $object \$tetrahedrisation::deformableItem \$tetrahedrisation::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
    tetrahedrisation::displayInternalForce3D $object $object  $tetrahedrisation::forceType
    }
}


tetrahedrisation::internalParametersDialog
Comments  
Arguments object
color
Used by  
Uses  
proc tetrahedrisation::internalParametersDialog { object color } {
    variable zm

    set name .dialogInternal$object
    if ![winfo exists $name] {
    toplevel $name -bg $color
    wm title $name "$object internal parameters"
    set tetrahedrisation::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 \"\$tetrahedrisation::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 \"\$tetrahedrisation::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 \"\$tetrahedrisation::zm -damping \[$name.damping get\]\""
    $name.damping set [$object -damping]
    
    scale $name.elasticDamping -orient horizontal -label {Elastic Damping} -from 0 -to 1 -resolution 0.01 -length 200 -bg $color
    bind $name.elasticDamping <ButtonRelease-1> "evaluate \"\$tetrahedrisation::zm -elasticDamping \[$name.elasticDamping get\]\""
    $name.elasticDamping set [$object -elasticDamping]
    

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

    set mn [tk_optionMenu $name.zm tetrahedrisation::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 tetrahedrisation::zm -label \$sel -value \"$object \$sel\" -selectcolor black -background $color -command \"$name.alpha set \\\[eval \\\$tetrahedrisation::zm -alpha\\\]; $name.beta set \\\[eval \\\$tetrahedrisation::zm -beta\\\]; $name.locality set \\\[eval \\\$tetrahedrisation::zm -locality\\\]; $name.weight set \\\[eval \\\$tetrahedrisation::zm -weight\\\]; $name.rigidity set \\\[eval \\\$tetrahedrisation::zm -rigidity\\\]\" }
    #        }"
    #         foreach z "[$object -zones]"  {
    #            $mn add radiobutton -variable tetrahedrisation::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 \$tetrahedrisation::zm -alpha\]; $name.beta set \[eval \$tetrahedrisation::zm -beta\]; $name.locality set \[eval \$tetrahedrisation::zm -locality\]; $name.weight set \[eval \$tetrahedrisation::zm -weight\]; $name.rigidity set \[eval \$tetrahedrisation::zm -rigidity\]"
    #        }
    
    pack $name.zm -padx 10 -pady 10
    pack $name.alpha $name.beta $name.damping $name.elasticDamping -padx 10 -pady 5
    pack $name.dismiss -padx 10 -pady 20
    }
}


tetrahedrisation::isTetraInView
Comments  
Arguments scn
sm
Used by simulation::addSimuTetraView
tetrahedrisation::addTetraView
Uses  
proc tetrahedrisation::isTetraInView { scn sm } {
    set val 0
    foreach {i} [$scn -objects] {
    if {[string match tetview* $i]} {
        if { ![string compare [$i -mesh] $sm]} {
        set val 1
        }
    }
    }
    return $val
}


tetrahedrisation::isovolumetricConstraint
Comments  
Arguments object
sz
pfactor
Used by tetrahedrisation::editForceConstraint
tetrahedrisation::forceConstraint
Uses  
proc tetrahedrisation::isovolumetricConstraint { object sz pfactor } {
    set root .isovolumetricConstraint
    if {![winfo exists $root]} {
    set bg #A0D0A0
    set bg2 #80C080
    set zname [ $object $sz -name ]

    toplevel $root -bg $bg
    wm title $root "Isovolumetric Constraint"

    menubutton $root.szones -menu $root.szones.mn -textvariable zname -text $zname -bg $bg2 -relief raised -justify center

    menu $root.szones.mn -tearoff 0 -bg $bg
    foreach {z} [ $object -surfaceZones ] {
        $root.szones.mn add radiobutton -label [ $object $z -name ] -selectcolor black -variable sz -value $z \
        -command " set zname \[ $object $z -name \] "
    }

    pack $root.szones -padx 20 -pady 20

    frame $root.pf -bg $bg
    frame $root.pf.value -bg $bg
    entry $root.pf.value.entry -relief sunken -width 5 -bg $bg
    $root.pf.value.entry delete 0 5
    $root.pf.value.entry insert 0 $pfactor
    label $root.pf.value.label -text "Penalty Factor:" -bg $bg
    pack $root.pf.value.entry -side right -padx 10
    pack $root.pf.value.label -side left -padx 10
    pack $root.pf.value $root.pf -padx 10 -pady 10
    
    frame $root.buttons -bg $bg
    button $root.buttons.apply -text "Apply" -command " evaluate \" $object -isovolumetricConstraint \$sz \[ $root.pf.value.entry get \] \" " -bg $bg
    button $root.buttons.applyDismiss -text "Apply & Dismiss" -command " evaluate \"$object -isovolumetricConstraint \$sz  \[ $root.pf.value.entry get \] \" ; destroy $root " -bg $bg
    button $root.buttons.destroy -text "Destroy" -command "destroy $root" -bg $bg
    pack $root.buttons.apply $root.buttons.applyDismiss  $root.buttons.destroy -side left -expand true -fill both -padx 20 -pady 20
    pack $root.buttons -expand true -fill both
    }
}


tetrahedrisation::materialProperties
Comments  
Arguments object
color
Used by  
Uses  
proc tetrahedrisation::materialProperties { object color } {
    set root .dialogMaterialProperties
    set bg $color
    set bg2  #8080ff
    set bg3  #80ff80
    set bg4  #ff8080
    toplevel $root -bg $bg
    wm title $root "Material Properties"
    
    set md [$object -massDensity]
    scan $md {%f} massDensity

    set lame [$object -isotropicLameCoefficient]
    scan $lame {%f %f} lambda mu
    set lameAniso [$object -anisotropicLameCoefficient]
    scan $lameAniso {%f %f} lambdaAniso muAniso
    set anisoDir [$object -anisoDir]
    scan $anisoDir {%f %f %f} a0x a0y a0z
    set ani [$object -anisotropy]
    variable aniso
    set tetrahedrisation::aniso 0
    if {$ani == "true"} {set tetrahedrisation::aniso 1}
    set st1 [$object -anisoStretch1]
    variable stretch1
    set tetrahedrisation::stretch1 0
    if {$st1 == "true"} {set tetrahedrisation::stretch1 1}
    set sh [$object -anisoShear]
    variable shear
    set tetrahedrisation::shear 0
    if {$sh == "true"} {set tetrahedrisation::shear 1}
    
    frame $root.massd -bg $bg2

    frame $root.massd.value -bg $bg2
    entry $root.massd.value.entry -relief sunken -width 10 -bg $bg2
    $root.massd.value.entry delete 0 10
    $root.massd.value.entry insert 0 $md
    label $root.massd.value.label -text "Mass Density" -bg $bg2
    pack $root.massd.value.entry -side right -padx 20
    pack $root.massd.value.label -side left -padx 20

    frame $root.massd.button -bd 2 -bg $bg2
    button $root.massd.button.apply -text "Apply New Mass Density" -command "evaluate \"$object -massDensity \[$root.massd.value.entry get\] \"" -bg $bg2
    pack $root.massd.button.apply -side top -expand true -padx 20 -pady 10
    pack $root.massd.value $root.massd.button -side top -pady 10
    pack $root.massd -expand true -fill both          


    frame $root.lame -bg $bg

    frame $root.lame.lambda -bd 2 -bg $bg
    entry $root.lame.lambda.entry -relief sunken -width 10 -bg $bg
    $root.lame.lambda.entry delete 0 10
    $root.lame.lambda.entry insert 0 $lambda
    label $root.lame.lambda.label -text "Lambda" -bg $bg
    pack $root.lame.lambda.entry -side right -padx 20
    pack $root.lame.lambda.label -side left -padx 20

    frame $root.lame.mu -bd 2 -bg $bg
    entry $root.lame.mu.entry -relief sunken -width 10 -bg $bg
    $root.lame.mu.entry delete 0 10
    $root.lame.mu.entry insert 0 $mu
    label $root.lame.mu.label -text "Mu" -bg $bg
    pack $root.lame.mu.entry -side right -padx 20
    pack $root.lame.mu.label -side left -padx 20

    frame $root.lame.button -bd 2 -bg $bg
    button $root.lame.button.apply -text "Apply New Lame" -command "evaluate \"$object -isotropicLameCoefficient \[$root.lame.lambda.entry get\] \[$root.lame.mu.entry get\]\"" -bg $bg
    pack $root.lame.button.apply -side top -expand true -padx 20 -pady 10
    
    pack $root.lame.lambda $root.lame.mu $root.lame.button -side top -fill x
    pack $root.lame -expand true -fill both
    
    frame $root.lameAniso -bg $bg2

    frame $root.lameAniso.lambda -bd 2 -bg $bg2
    entry $root.lameAniso.lambda.entry -relief sunken -width 10 -bg $bg2          
    $root.lameAniso.lambda.entry delete 0 10
    $root.lameAniso.lambda.entry insert 0 $lambdaAniso
    label $root.lameAniso.lambda.label -text "Lambda Long." -bg $bg2
    pack $root.lameAniso.lambda.entry -side right -padx 20
    pack $root.lameAniso.lambda.label -side left -padx 20

    frame $root.lameAniso.mu -bd 2 -bg $bg2
    entry $root.lameAniso.mu.entry -relief sunken -width 10 -bg $bg2          
    $root.lameAniso.mu.entry delete 0 10
    $root.lameAniso.mu.entry insert 0 $muAniso
    label $root.lameAniso.mu.label -text "Mu Long." -bg $bg2
    pack $root.lameAniso.mu.entry -side right -padx 20
    pack $root.lameAniso.mu.label -side left -padx 20

    frame $root.lameAniso.button -bd 2 -bg $bg2
    button $root.lameAniso.button.apply -text "Apply New Lame Long." -command "evaluate \"$object -anisotropicLameCoefficient \[$root.lameAniso.lambda.entry get\] \[$root.lameAniso.mu.entry get\]\"" -bg $bg2
    pack $root.lameAniso.button.apply -side top -expand true -padx 20 -pady 10
    
    pack $root.lameAniso.lambda $root.lameAniso.mu $root.lameAniso.button -side top -fill x
    pack $root.lameAniso -expand true -fill both

    frame $root.anisoDir -bg $bg3
    frame $root.anisoDir.coord -bd 2 -bg $bg3

    entry $root.anisoDir.coord.entryX -relief sunken -width 10 -bg $bg3
    $root.anisoDir.coord.entryX delete 0 10
    $root.anisoDir.coord.entryX insert 0 $a0x

    entry $root.anisoDir.coord.entryY -relief sunken -width 10 -bg $bg3
    $root.anisoDir.coord.entryY delete 0 10
    $root.anisoDir.coord.entryY insert 0 $a0y

    entry $root.anisoDir.coord.entryZ -relief sunken -width 10 -bg $bg3
    $root.anisoDir.coord.entryZ delete 0 10
    $root.anisoDir.coord.entryZ insert 0 $a0z
    
    pack $root.anisoDir.coord.entryX $root.anisoDir.coord.entryY $root.anisoDir.coord.entryZ -side top -fill x

    label $root.anisoDir.label -text "Anisotropic Direction" -bg $bg3
    
    pack $root.anisoDir.coord -side right -padx 20
    pack $root.anisoDir.label -side left -padx 20

    pack $root.anisoDir -expand true -fill both

    frame $root.button -bg $bg3
    button $root.button.apply -text "Apply New Anisotropic Direction" -command "evaluate \"$object -anisoDir \[$root.anisoDir.coord.entryX get\] \[$root.anisoDir.coord.entryY get\] \[$root.anisoDir.coord.entryZ get\]\"" -bg $bg3
    pack $root.button.apply -side top -expand true -padx 20 -pady 10

    pack $root.button -side top -fill both
    
    frame $root.anisotropy -bg $bg4

    frame $root.anisotropy.f1 -bg $bg4
    checkbutton $root.anisotropy.f1.check -variable tetrahedrisation::aniso -text "Use Anisotropy" -relief flat -bg $bg4
    pack $root.anisotropy.f1.check -side left -padx 10 -pady 10
    pack $root.anisotropy.f1 -expand true -fill both
    
    frame $root.anisotropy.f2 -bg $bg4
    checkbutton $root.anisotropy.f2.stretch1 -variable tetrahedrisation::stretch1 -text "Use Anisotropic Stretch1" -relief flat -bg $bg4
    pack $root.anisotropy.f2.stretch1 -side left -padx 30 -pady 5
    pack $root.anisotropy.f2 -expand true -fill both

    frame $root.anisotropy.f4 -bg $bg4
    checkbutton $root.anisotropy.f4.shear -variable tetrahedrisation::shear -text "Use Anisotropic Shear" -relief flat -bg $bg4
    pack $root.anisotropy.f4.shear -side left -padx 30 -pady 5
    pack $root.anisotropy.f4 -expand true -fill both
    
    frame $root.anisotropy.button -bg $bg4
    button $root.anisotropy.button.apply -text "Apply Anisotropic Force Composition" -command "tetrahedrisation::setAnisotropicForce $object" -bg $bg4

    pack $root.anisotropy.button.apply -side top -expand true -padx 20 -pady 10
    pack $root.anisotropy.button -expand true -fill both
    
    pack $root.anisotropy -expand true -fill both

    frame $root.dismiss -bd 2 -bg $bg
    button $root.dismiss.exit -text "Dismiss" -command "destroy $root" -bg $bg
    pack  $root.dismiss.exit -side top -expand true -padx 20 -pady 10
    pack  $root.dismiss -side top -pady 10
}


tetrahedrisation::multiplyEdgeSize
Comments  
Arguments object
zone
bg
Used by  
Uses  
proc tetrahedrisation::multiplyEdgeSize {object zone bg} {
    set root .tetraMultiplyEdgeSize
    if {![winfo exists $root]} {
    set bg "#A0D0A0"
    set bg2  "#80C080"
    toplevel $root -bg $bg
    wm title $root "Multiply Edge Size on 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 {1.0}
    label $root.f.name.label -text "Average Edge Size" -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 $zone -multiplyEdgeSize \{\[$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
    }
}


tetrahedrisation::newSurfaceZone
Comments  
Arguments object
bg
Used by  
Uses  
proc tetrahedrisation::newSurfaceZone {object bg} {
    set root .tetraNewSurfaceZone    
    if {![winfo exists $root]} {
    set bg "#A0D0A0"
    set bg2  "#80C080"
    toplevel $root -bg $bg
    wm title $root "New Tetrahedrisation Surface 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 "Surface 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 -newSurfaceZone \{\[$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
    }
}


tetrahedrisation::newZone
Comments  
Arguments object
bg
Used by  
Uses  
proc tetrahedrisation::newZone {object bg} {
    set root .tetraNewZone    
    if {![winfo exists $root]} {
    set bg "#A0D0A0"
    set bg2  "#80C080"
    toplevel $root -bg $bg
    wm title $root "New Tetrahedrisation 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
    }
}


tetrahedrisation::positionConstraint
Comments  
Arguments object
color
Used by  
Uses tetrahedrisation::editPositionConstraint
proc tetrahedrisation::positionConstraint { object color} {
    set root .positionConstraint2D
    set bg $color
    if {![winfo exists $root]} {
    set bg #A0D0A0
    set bg2  #80C080
    toplevel $root -bg $bg
    wm title $root "ActiveTetra3D Position Constraint"
    label $root.msg -justify center -text "List of Position Constraints" -bg $bg
    pack $root.msg  -side top
    
    frame $root.f -borderwidth .5c -bg $bg
    pack $root.f -side top -expand yes -fill y
    
    scrollbar $root.f.scroll -command "$root.f.list yview" -bg $bg
    listbox $root.f.list -yscroll "$root.f.scroll set" -setgrid 1 -height 12 -bg $bg
    pack $root.f.scroll -side right -fill y
    pack $root.f.list -side left -expand 1 -fill both

    set nbConstraints [$object -positionConstraint]
    for { set i 0 } { $i < $nbConstraints } { incr i } {
        $root.f.list insert $i [$object -positionConstraint $i ]
    }

    frame $root.process -bg $bg
    pack $root.process -side top -pady 2m
    menubutton $root.process.create -text "Create Constraint" -bg $bg -underline 0 -direction above -menu $root.process.create.m -relief raised
    menu $root.process.create.m -tearoff 0
    button $root.process.edit -text "Edit Constraint" -bg $bg -command " tetrahedrisation::editPositionConstraint \[ $root.f.list get \[ lindex \[ $root.f.list curselection \] 0 \] \] $object; destroy $root"
    button $root.process.delete -text "Delete Constraint" -bg $bg -command "$object -positionConstraint \[ lindex \[ $root.f.list curselection \] 0 \] delete;destroy $root"
    pack $root.process.create $root.process.edit $root.process.delete -side top -expand 1

    frame $root.button -bg $bg
    pack $root.button -side bottom -pady 2m
    button $root.button.dismiss -text Dismiss -command "destroy $root" -bg $bg
    pack  $root.button.dismiss -side left -expand 1
    }
}


tetrahedrisation::pressureConstraint
Comments  
Arguments object
sz
press
Used by tetrahedrisation::editForceConstraint
tetrahedrisation::forceConstraint
Uses  
proc tetrahedrisation::pressureConstraint { object sz press } {
    set root .pressureConstraint
    if {![winfo exists $root]} {
    set bg #A0D0A0
    set bg2 #80C080
    set zname [ $object $sz -name ]

    toplevel $root -bg $bg
    wm title $root "Pressure Constraint"

    menubutton $root.szones -menu $root.szones.mn -textvariable zname -text $zname -bg $bg2 -relief raised -justify center

    menu $root.szones.mn -tearoff 0 -bg $bg
    foreach {z} [ $object -surfaceZones ] {
        $root.szones.mn add radiobutton -label [ $object $z -name ] -selectcolor black -variable sz -value $z \
        -command " set zname \[ $object $z -name \] "
    }

    pack $root.szones -padx 20 -pady 20

    frame $root.pressure -bg $bg
    frame $root.pressure.value -bg $bg
    entry $root.pressure.value.entry -relief sunken -width 5 -bg $bg
    $root.pressure.value.entry delete 0 5
    $root.pressure.value.entry insert 0 $press
    label $root.pressure.value.label -text "Pressure:" -bg $bg
    pack $root.pressure.value.entry -side right -padx 10
    pack $root.pressure.value.label -side left -padx 10
    pack $root.pressure.value $root.pressure -padx 10 -pady 10
    
    frame $root.buttons -bg $bg
    button $root.buttons.apply -text "Apply" -command " evaluate \" $object -pressureConstraint \$sz \[ $root.pressure.value.entry get \] \" " -bg $bg
    button $root.buttons.applyDismiss -text "Apply & Dismiss" -command " evaluate \"$object -pressureConstraint \$sz \[ $root.pressure.value.entry get \] \" ; destroy $root " -bg $bg
    button $root.buttons.destroy -text "Destroy" -command "destroy $root" -bg $bg
    pack $root.buttons.apply $root.buttons.applyDismiss  $root.buttons.destroy -side left -expand true -fill both -padx 20 -pady 20
    pack $root.buttons -expand true -fill both
    }
}


tetrahedrisation::saveOption
Comments  
Arguments object
fileType
windowTitle
Used by  
Uses  
proc tetrahedrisation::saveOption { object fileType windowTitle} {
    set root .tetraSave
    if {![winfo exists $root]} {
    set bg "#A0D0A0"
    set bg2  "#80C080"
    toplevel $root -bg $bg
    wm title $root "Tetrahedrisation Save"
    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
    }
}


tetrahedrisation::setAnisotropicForce
Comments  
Arguments object
Used by  
Uses  
proc tetrahedrisation::setAnisotropicForce { object } {
    evaluate "$object -anisotropy $tetrahedrisation::aniso"
    evaluate "$object -anisoStretch1 $tetrahedrisation::stretch1"
    evaluate "$object -anisoShear $tetrahedrisation::shear"
    evaluate "$object -recomputeTensors"
}


tetrahedrisation::setEdgeSize
Comments  
Arguments object
zone
bg
Used by  
Uses  
proc tetrahedrisation::setEdgeSize {object zone bg} {
    set root .tetraSetEdgeSize
    if {![winfo exists $root]} {
    set bg "#A0D0A0"
    set bg2  "#80C080"
    toplevel $root -bg $bg
    wm title $root "Set Edge Size on 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 {10.0}
    label $root.f.name.label -text "Average Edge Size" -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 $zone -setEdgeSize \{\[$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
    }
}


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


tetrahedrisation::setTimeParameters
Comments  
Arguments object
bg
Used by  
Uses  
proc tetrahedrisation::setTimeParameters {object bg} {
    set root .tetraSetTimeParameters
    if {![winfo exists $root]} {
    set bg "#A0D0A0"
    toplevel $root -bg $bg
    wm title $root "Set Time Parameters on Mesh"
    
    set im [$object -integrationMethod]
    frame $root.integration -bg $bg      
    label $root.integration.label -text "Integration Method :" -bg $bg
    pack $root.integration.label -side top -padx 10 -pady 10
    menubutton $root.integration.method -textvariable im -text $im -bg $bg -underline 0 -direction above -menu $root.integration.method.m -relief raised
    menu $root.integration.method.m -tearoff 0
    $root.integration.method.m add radiobutton -label "Explicit" -command  "set im \" EXPLICIT \"; evaluate \"$object -integrationMethod EXPLICIT\" "
    $root.integration.method.m add radiobutton -label "Implicit" -command  "set im \" IMPLICIT \"; evaluate \"$object -integrationMethod IMPLICIT\" "
    $root.integration.method.m add radiobutton -label "Asynchronous" -command  "set im \" ASYNCHRONOUS \"; evaluate \"$object -integrationMethod ASYNCHRONOUS\" "
    $root.integration.method.m add radiobutton -label "Houbolt" -command  "set im HOUBOLT; evaluate \"$object -integrationMethod HOUBOLT \" "
    
    pack $root.integration.method -side top -expand 1
    pack $root.integration -side top -pady 2m

    frame $root.unit -bg $bg      
    label $root.unit.label -text "Unit :" -bg $bg
    pack $root.unit.label -side top -padx 10 -pady 10
    
    set mn [tk_optionMenu $root.unit.m tetrahedrisation::unitItem "none" "mmeter" "millimeter"]
    $mn entryconfigure 0 -selectcolor black -command "evaluate \"$object -unit none\""
    $mn entryconfigure 1 -selectcolor black -command "evaluate \"$object -unit meter\""
    $mn entryconfigure 2 -selectcolor black -command "evaluate \"$object -unit millimeter\""
    set tetrahedrisation::unitItem [$object -unit]

    $root.unit.m  configure -bg $bg
    pack $root.unit.m -side top -expand 1
    pack $root.unit -side top -pady 2m


    set ts [$object -timeStep]
    frame $root.step -bg $bg
    frame $root.step.value -bg $bg
    entry $root.step.value.entry -relief sunken -width 12 -bg $bg
    $root.step.value.entry delete 0 12
    $root.step.value.entry insert 0 $ts
    label $root.step.value.label -text "Time Step :" -bg $bg
    pack $root.step.value.entry -side right -padx 10
    pack $root.step.value.label -side left -padx 10

    frame $root.step.button -bg $bg
    button $root.step.button.apply -text "Apply New Time Step" -command "evaluate \"$object -timeStep \[$root.step.value.entry get\] \" " -bg $bg

    pack $root.step.button.apply -side top -expand true -padx 10 -pady 10
    pack $root.step.value $root.step.button -side top -pady 10
    pack $root.step  -side top -fill x


    frame $root.buttons -bg $bg
    button $root.buttons.destroy -text "Destroy" -command "destroy $root" -bg $bg
    pack $root.buttons.destroy -side left -expand true -fill both -padx 20 -pady 10
    pack $root.buttons -expand true -fill both
    }
}


tetrahedrisation::uninstallActiveTetra3DMenu
Comments  
Arguments parent
camera
object
Used by  
Uses tetrahedrisation::uninstallTetra3DMenu
proc tetrahedrisation::uninstallActiveTetra3DMenu {parent camera object } {
    tetrahedrisation::uninstallTetra3DMenu $parent $camera $object
    destroy $parent.context.internal
    destroy $parent.context.external
}


tetrahedrisation::uninstallTetra3DMenu
Comments  
Arguments parent
camera
object
Used by tetrahedrisation::uninstallActiveTetra3DMenu
Uses  
proc tetrahedrisation::uninstallTetra3DMenu {parent camera object } {
    # remove frame children
    set list [winfo children $parent.context]
    foreach w $list { destroy $w}
    pack $parent.context -fill x
    #remove popup
    destroy $parent.popup
    #unbind popup
    bind [$camera -widget]  <Button-3> ""
}