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

tclSimulation.tcl



haptic
Comments  
Arguments  
Used by  
Uses  
namespace eval haptic {
    
}


haptic::installHapticTriangulation3DMenu
Comments  
Arguments parent
camera
object
color
Used by  
Uses triangulation::installTriangulation3DMenu
proc haptic::installHapticTriangulation3DMenu {parent camera object color } {
    triangulation::installTriangulation3DMenu $parent $camera $object $color

    menubutton $parent.context.damping -text "Damping" -menu $parent.context.damping.m -anchor w -bg $color

    set mtyp [menu $parent.context.damping.m -bg $color -postcommand "scan \[$object -damping\] {%s} haptic::type"]    
    $mtyp add radio -selectcolor "black" -label "None" -variable ffback::type -value "none" -command "evaluate \"$object -damping none\""
    $mtyp add radio -selectcolor "black" -label "Linear" -variable ffback::type -value "linear" -command "evaluate \"$object -damping linear\""
    $mtyp add radio -selectcolor "black" -label "Viscous" -variable ffback::type -value "viscous" -command "evaluate \"$object -damping viscous\""
    $mtyp add radio -selectcolor "black" -label "ViscoLinear" -variable ffback::type -value "viscolinear" -command "evaluate \"$object -damping viscolinear\""
    $mtyp add radio -selectcolor "black" -label "ViscoNorm" -variable ffback::type -value "visconorm" -command "evaluate \"$object -damping visconorm\""
    pack  $parent.context.damping -side left

    #    installForceFeedbackMenu $parent $camera $object $color
    set popup $parent.popup
}


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


simulation
Comments  
Arguments  
Used by  
Uses  

}


simulation::LIEVsSimuTetrahedrisationConstraint
Comments  
Arguments object
Used by  
Uses  
proc simulation::LIEVsSimuTetrahedrisationConstraint { object } {
    set root .lieConstraint
    if {![winfo exists $root]} {
    set bg #A0D0A0
    set bg2  #80C080
    toplevel $root -bg $bg
    wm title $root "LIE Constraint"
    
    frame $root.f -bg $bg

    frame $root.buttons -bg $bg
    button $root.buttons.apply -text Apply -command "evaluate \"$object -LIEConstraint \"" -bg $bg
    button $root.buttons.applyDismiss -text "Apply & Dismiss" -command "evaluate \"$object -LIEConstraint new\";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 10
    pack $root.buttons -expand true -fill both
    }
}


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


simulation::coloroptions
Comments  
Arguments menu
object
Used by simulation::installActiveTubeDisplayMenu
Uses  
proc simulation::coloroptions { menu object } {
    global graphics3D::v$object
    set name ""
    foreach i [split $object] { set name $name$i }

    $menu add command -label red -command "evaluate \"$object -color 1.0 0.0 0.0 1.0\"" -background red -foreground white
    $menu add command -label green -command "evaluate \"$object -color 0.0 1.0 0.0 1.0\"" -background green -foreground black
    $menu add command -label blue -command "evaluate \"$object -color 0.0 0.0 1.0 1.0\"" -background blue -foreground white
    $menu add command -label yellow -command "evaluate \"$object -color 1.0 1.0 0.0 1.0\"" -background yellow -foreground black
    $menu add command -label orange -command "evaluate \"$object -color 1.0 0.5 0.0 1.0\"" -background orange -foreground black
    $menu add command -label purple -command "evaluate \"$object -color 1.0 0.0 1.0 1.0\"" -background purple -foreground white
    $menu add command -label grey -command "evaluate \"$object -color 0.5 0.5 0.5 0.5\"" -background grey -foreground black
    $menu add command -label white -command "evaluate \"$object -color 1.0 1.0 1.0 1.0\"" -background white -foreground black
    $menu add command -label black -command "evaluate \"$object -color 0.0 0.0 0.0 1.0\"" -background black -foreground white
}


simulation::editForceConstraint
Comments  
Arguments name
object
index
Used by simulation::forceConstraint
Uses simulation::gravityConstraint
proc simulation::editForceConstraint { name object index } {
    evaluate $name
    switch $name {
    "GravityTetra3DConstraint" { set result [$object -gravityConstraint]; simulation::gravityConstraint $object [lindex $result 0] [lindex $result 1] [lindex $result 2] }
    }
}


simulation::editPositionConstraint
Comments  
Arguments name
object
Used by simulation::positionConstraint
Uses simulation::exclusionZoneConstraint
proc simulation::editPositionConstraint { name object } {
    switch $name {
    "LIEVsSimuTetrahedrisationConstraint" { set result [ $object -LIEConstraint ]; object::LIEVsSimuTetrahedrisationConstraint $object }
    "PhantomVsSimuTetrahedrisationConstraint" { set result [ $object -phantomConstraint ]; object::PhantomVsSimuTetrahedrisationConstraint $object }
    "ExclusionZoneConstraint" { set result [$object -exclusionZoneConstraint]; simulation::exclusionZoneConstraint $object [lindex $result 0] [lindex $result 1] [lindex $result 2] [lindex $result 3] }
    }
}


simulation::exclusionZoneConstraint
Comments  
Arguments object
nx
ny
nz
d
Used by simulation::editPositionConstraint
Uses  
proc simulation::exclusionZoneConstraint {object nx ny nz d} {
    set root .exclusionZoneConstraint
    if {![winfo exists $root]} {
    set bg #A0D0A0
    set bg2  #80C080
    toplevel $root -bg $bg
    wm title $root "ExclsionZone Constraint"

    frame $root.f -bg $bg

    frame $root.f.nx -bd 2 -bg $bg
    entry $root.f.nx.entry -relief sunken -width 10 -bg $bg
    $root.f.nx.entry delete 0 10
    $root.f.nx.entry insert 0 $nx
    label $root.f.nx.label -text "X Coordinate" -bg $bg
    pack $root.f.nx.entry -side right -padx 20
    pack $root.f.nx.label -side left -padx 20

    frame $root.f.ny -bd 2 -bg $bg
    entry $root.f.ny.entry -relief sunken -width 10 -bg $bg
    $root.f.ny.entry delete 0 10
    $root.f.ny.entry insert 0 $ny
    label $root.f.ny.label -text "Y Coordinate" -bg $bg
    pack $root.f.ny.entry -side right -padx 20
    pack $root.f.ny.label -side left -padx 20

    frame $root.f.nz -bd 2 -bg $bg
    entry $root.f.nz.entry -relief sunken -width 10 -bg $bg
    $root.f.nz.entry delete 0 10
    $root.f.nz.entry insert 0 $nz
    label $root.f.nz.label -text "Z Coordinate" -bg $bg
    pack $root.f.nz.entry -side right -padx 20
    pack $root.f.nz.label -side left -padx 20

    frame $root.f.d -bd 2 -bg $bg
    entry $root.f.d.entry -relief sunken -width 10 -bg $bg
    $root.f.d.entry delete 0 10
    $root.f.d.entry insert 0 $d
    label $root.f.d.label -text "Distance to 0" -bg $bg
    pack $root.f.d.entry -side right -padx 20
    pack $root.f.d.label -side left -padx 20

    pack  $root.f.nx  $root.f.ny $root.f.nz $root.f.d

    pack $root.f -expand true -fill both
    
    frame $root.buttons -bg $bg
    button $root.buttons.apply -text Apply -command "evaluate \"$object -exclusionZoneConstraint \[$root.f.nx.entry get\] \[$root.f.ny.entry get\] \[$root.f.nz.entry get\] \[$root.f.d.entry get\]\"" -bg $bg
    button $root.buttons.applyDismiss -text "Apply & Dismiss" -command "evaluate \"$object -exclusionZoneConstraint \[$root.f.nx.entry get\] \[$root.f.ny.entry get\] \[$root.f.nz.entry get\] \[$root.f.d.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 10
    pack $root.buttons -expand true -fill both
    }
}


simulation::forceConstraint
Comments  
Arguments object
color
Used by  
Uses simulation::editForceConstraint
proc simulation::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 -gravityConstraint \] {none} \] {destroy $root;simulation::gravityConstraint $object 0 0 -1 } "
    button $root.process.edit -text "Edit Constraint" -bg $bg -command " simulation::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
    }
}


simulation::gravityConstraint
Comments  
Arguments object
gx
gy
gz
Used by simulation::editForceConstraint
Uses  
proc simulation::gravityConstraint {object gx gy gz} {
    set root .gravityConstraint
    if {![winfo exists $root]} {
    set bg #A0D0A0
    set bg2  #80C080
    toplevel $root -bg $bg
    wm title $root "Gravity Constraint"

    frame $root.f -bg $bg

    frame $root.f.gx -bd 2 -bg $bg
    entry $root.f.gx.entry -relief sunken -width 10 -bg $bg
    $root.f.gx.entry delete 0 10
    $root.f.gx.entry insert 0 $gx
    label $root.f.gx.label -text "X Coordinate" -bg $bg
    pack $root.f.gx.entry -side right -padx 20
    pack $root.f.gx.label -side left -padx 20

    frame $root.f.gy -bd 2 -bg $bg
    entry $root.f.gy.entry -relief sunken -width 10 -bg $bg
    $root.f.gy.entry delete 0 10
    $root.f.gy.entry insert 0 $gy
    label $root.f.gy.label -text "Y Coordinate" -bg $bg
    pack $root.f.gy.entry -side right -padx 20
    pack $root.f.gy.label -side left -padx 20

    frame $root.f.gz -bd 2 -bg $bg
    entry $root.f.gz.entry -relief sunken -width 10 -bg $bg
    $root.f.gz.entry delete 0 10
    $root.f.gz.entry insert 0 $gz
    label $root.f.gz.label -text "Z Coordinate" -bg $bg
    pack $root.f.gz.entry -side right -padx 20
    pack $root.f.gz.label -side left -padx 20

    pack  $root.f.gx  $root.f.gy $root.f.gz

    pack $root.f -expand true -fill both
    
    frame $root.buttons -bg $bg
    button $root.buttons.apply -text Apply -command "evaluate \"$object -gravityConstraint \[$root.f.gx.entry get\] \[$root.f.gy.entry get\] \[$root.f.gz.entry get\]\"" -bg $bg
    button $root.buttons.applyDismiss -text "Apply & Dismiss" -command "evaluate \"$object -gravityConstraint \[$root.f.gx.entry get\] \[$root.f.gy.entry get\] \[$root.f.gz.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 10
    pack $root.buttons -expand true -fill both
    }
}


simulation::installActiveTubeDisplayMenu
Comments  
Arguments parent
camera
object
color
Used by simulation::installActiveTubeMenu
Uses simulation::materialoptions
simulation::coloroptions
proc simulation::installActiveTubeDisplayMenu { 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\]"]
    $menu add cascade -label "Color Definition" -menu $menu.color
    menu $menu.color -bg $color -tearoff 0
    simulation::coloroptions $menu.color $object
    $menu add cascade -label "Material Definition" -menu $menu.material
    menu $menu.material -bg $color -tearoff 0
    simulation::materialoptions $menu.material $object
    pack $parent.context.graphics -side left

}


simulation::installActiveTubeMenu
Comments  
Arguments parent
camera
object
color
Used by  
Uses contour::installActiveContour2DLineMenu
graphics3D::renderoptions
simulation::installActiveTubeDisplayMenu
contour::installContourFileMenu
contour::installActiveContour2DEdgeMenu
contour::installContourInternalMenu
contour::installActiveContour2DVertexMenu
proc simulation::installActiveTubeMenu { parent camera object color } {
    global showRange
    global showClosest

    # Instalations des Menus de la barre du haut

    contour::installContourFileMenu $parent $camera $object $color
    simulation::installActiveTubeDisplayMenu $parent $camera $object $color
    contour::installContourInternalMenu $parent $camera $object $color

    menubutton $parent.context.sgraphics -text "Surface Graphics" -menu $parent.context.sgraphics.mn -bg $color
    set menu [menu $parent.context.sgraphics.mn -bg $color ]
    #    graphics3D::renderoptions $menu $object
    pack $parent.context.sgraphics -side left
    
    if {[string compare [evaluate "$object -selectionMode"] "line"]== 0} {
    contour::installActiveContour2DLineMenu $parent $camera $contour
    }        
    if {[string compare [evaluate "$object -selectionMode"] "edge"]== 0} {
    contour::installActiveContour2DEdgeMenu $parent $camera $contour
    }    
    if {[string compare [evaluate "$object -selectionMode"] "vertex"]== 0} {
    contour::installActiveContour2DVertexMenu $parent $camera $object
    }

    # PopupMenu
    set popup [menu $parent.popup -tearoff 0 -bg "white" -postcommand "scan \[$object -selectionMode \] {%s} contour::selectionMode;scan \[$camera -motionMode \] {%s} contour::motionMode " ]

    $popup add cascade -label "Surface Graphics" -menu $popup.surfacegraphics
    set popupsgraphics [menu $popup.surfacegraphics -tearoff 0 -bg "white"]
    $popup add cascade -label "Left Button" -menu $popup.leftbutton
    set popuplbutton [menu $popup.leftbutton -tearoff 0 -bg "white"]
    $popup add cascade -label "Middle Button" -menu $popup.middlebutton
    set popupmbutton [menu $popup.middlebutton -tearoff 0 -bg "white"]



    # PopopMenu Surface Graphics
    #graphics3D::renderoptions $popupsgraphics $object

    # PopupMenu-LeftButton
    $popuplbutton add radio -selectcolor "black" -label "Select Object" -variable contour::selectionMode -value "object" -command "evaluate \"$object -selectionMode object  $camera\""
    $popuplbutton add radio -selectcolor "black" -label "Select Line" -variable contour::selectionMode -value "line" -command "evaluate \"$object -selectionMode line  $camera\""
    $popuplbutton add radio -selectcolor "black" -label "Select Vertex" -variable contour::selectionMode -value "vertex" -command "evaluate \"$object -selectionMode vertex  $camera\""
    $popuplbutton add radio -selectcolor "black" -label "Select Edge" -variable contour::selectionMode -value "edge" -command "evaluate \"$object -selectionMode edge  $camera\""
    $popuplbutton add radio -selectcolor "black" -label "Grab Vertex" -variable contour::selectionMode -value "grab" -command "evaluate \"$object -selectionMode grab  $camera\""

    # PopupMenu-MiddleButton
    $popupmbutton add radio -selectcolor "black" -label "Move Contour" -variable contour::motionMode -value "object" -command "evaluate \"$camera -motionMode object\""
    $popupmbutton add radio -selectcolor "black" -label "Move Camera" -variable contour::motionMode -value "camera" -command "evaluate \"$camera -motionMode camera\""
    


    bind [$camera -widget] <Button-3> "tk_popup $popup %X %Y"
    
    
}


simulation::installSimuSynchroMenu
Comments  
Arguments parent
camera
ssync
bg
Used by  
Uses  
proc simulation::installSimuSynchroMenu {parent camera ssync bg} {
    menubutton $parent.context.settings -text "Settings" -menu $parent.context.settings.m -anchor w -bg $bg
    set mset [ menu $parent.context.settings.m -bg $bg -tearoff 0 -postcommand "scan \[$ssync -useRealTime \] {%s} simulation::ssyncUseRealTime" ]
    $mset add command -label "destroy" -command "evaluate \"$ssync -destroy\""
#    menu  $mset -tearoff 0 -postcommand "scan \[$ssync -useRealTime \] {%s} simulation::ssyncUseRealTime"
    $mset add radio -selectcolor "black" -label "useRealTime" -variable simulation::ssyncUseRealTime -value "true" -command "evaluate \"$ssync -useRealTime switch\""

    pack  $parent.context.settings -side left
}


simulation::installSimuTetra3DMenu
Comments  
Arguments parent
camera
object
color
Used by  
Uses tetrahedrisation::installActiveTetra3DMeshMenu
tetrahedrisation::installActiveTetra3DDisplayMenu
tetrahedrisation::installTetra3DFileMenu
proc simulation::installSimuTetra3DMenu { 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 "Grab Tetrahedrisation" -command "evaluate \"$object -selectionMode grab $camera\"" -selectcolor black -variable tetrahedrisation::select$camera -value brab
    $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::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 command -label "Internal Parameters..." -command "triangulation::internalParametersDialog $object $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 Force Type..." -command "tetrahedrisation::internalForce3D $object $color"
    $minternal add command -label "Time Parameters..." -command "tetrahedrisation::setTimeParameters $object $color"
    $minternal add separator
    $minternal add command -label "Material properties..." -command "tetrahedrisation::materialProperties $object $color"
    $minternal add command -label "Force Constraint..." -command "simulation::forceConstraint $object $color"
    $minternal add command -label "Position Constraint..." -command "simulation::positionConstraint $object $color"
    pack  $parent.context.internal -side left    
}


simulation::materialoptions
Comments  
Arguments menu
object
Used by simulation::installActiveTubeDisplayMenu
Uses  
proc simulation::materialoptions { menu object } {
    global graphics3D::v$object
    set name ""
    foreach i [split $object] { set name $name$i }

    $menu add command -label red -command "evaluate \"$object -material ambient 0.8 0.5 0.5 diffuse 1.0 0.2 0.2 specular 1.0 0.2 0.3 shininess 30\"" -background red -foreground white
    $menu add command -label green -command "evaluate \"$object -material ambient 0.5 0.8 0.5 diffuse 0.2 1.0 0.2 specular 0.3 0.9 0.3 shininess 30\"" -background green -foreground black
    $menu add command -label blue -command "evaluate \"$object -material ambient 0.8 0.4 0.5 diffuse 0.2 0.3 1.0 specular 0.3 0.4 1.0 shininess 30\"" -background blue -foreground white
    $menu add command -label yellow -command "evaluate \"$object -material ambient 0.9 0.9 0.6 diffuse 0.9 0.9 0.2 specular 0.9 0.9 0.2 shininess 30\"" -background yellow -foreground black
    $menu add command -label orange -command "evaluate \"$object -material ambient 1.0 0.3 0.7 diffuse 1.0 0.6 0.1 specular 0.9 0.5 0.9 shininess 30\"" -background orange -foreground black
    $menu add command -label purple -command "evaluate \"$object -material ambient 0.8 0.5 0.8 diffuse 1.0 0.6 1.0 specular 0.8 0.0 0.8 shininess 30\"" -background purple -foreground white
    $menu add command -label grey -command "evaluate \"$object -material ambient 0.5 0.5 0.5 diffuse 0.4 0.4 0.4 specular 0.4 0.4 0.4 shininess 30\"" -background grey -foreground black
    $menu add command -label white -command "evaluate \"$object -material ambient 1.0 1.0 1.0 diffuse 1.0 1.0 1.0 specular 0.9 0.9 0.9 shininess 30\"" -background white -foreground black
    $menu add command -label black -command "evaluate \"$object -material ambient 0.1 0.1 0.1 diffuse 0.0 0.0 0.0 specular 0.5 0.5 0.5 shininess 30\"" -background black -foreground white
}


simulation::phantomVsSimuTetrahedrisationConstraint
Comments  
Arguments object
Used by  
Uses  
proc simulation::phantomVsSimuTetrahedrisationConstraint { object } {
    set root .phantomConstraint
    if {![winfo exists $root]} {
    set bg #A0D0A0
    set bg2  #80C080
    toplevel $root -bg $bg
    wm title $root "Phantom Constraint"
    
    frame $root.f -bg $bg

    frame $root.buttons -bg $bg
    button $root.buttons.apply -text Apply -command "evaluate \"$object -phantomConstraint \"" -bg $bg
    button $root.buttons.applyDismiss -text "Apply & Dismiss" -command "evaluate \"$object -phantomConstraint new\";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 10
    pack $root.buttons -expand true -fill both
    }
}


simulation::positionConstraint
Comments  
Arguments object
color
Used by  
Uses simulation::editPositionConstraint
proc simulation::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
    $root.process.create.m add command -label "ExclusionZone Constraint" -command "if !\[ string compare \[ $object -exclusionZoneConstraint \] {none} \] {destroy $root;simulation::exclusionZoneConstraint $object 0 0 1 0} "
    $root.process.create.m add command -label "Phantom Constraint" -command "if { !\[ string compare \[ $object -phantomConstraint \] {none} \] } {destroy $root;simulation::phantomVsSimuTetrahedrisationConstraint $object}"
    $root.process.create.m add command -label "LIE Constraint" -command "if { !\[ string compare \[ $object -LIEConstraint \] {none} \] } {destroy $root;simulation::LIEVsSimuTetrahedrisationConstraint $object}"
    button $root.process.edit -text "Edit Csonstraint" -bg $bg -command " simulation::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
    }
}


simulation::uninstallActiveTubeMenu
Comments  
Arguments viewer
camera
object
Used by  
Uses  
proc simulation::uninstallActiveTubeMenu { viewer camera object } {
    #contour::uninstallContourMenu $viewer $camera $object
    # remove frame children
    set list [winfo children $viewer.context]
    foreach w $list { destroy $w}
    pack $viewer.context -fill x
    #remove popup
    destroy  $viewer.popup
    #reset selection mode
    $camera -motionMode camera
    #unbind popup
    bind [$camera -widget] <Button-3> ""


}


simulation::uninstallSimuSynchroMenu
Comments  
Arguments parent
camera
ssync
Used by  
Uses  
proc simulation::uninstallSimuSynchroMenu {parent camera ssync} {
     set list [winfo children $parent.context]
    foreach w $list { destroy $w}
    pack $parent.context -fill x
}