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

tclModules.tcl

$Author: hdeling $
$Revision: 1.3 $
$Log: tclModules.tcl,v $
Revision 1.3 2002/01/30 16:47:57 hdeling
corrected graph display

Revision 1.2 2002/01/02 16:03:11 jdlemare
add completion.tcl in the tclModules.tcl script

Revision 1.1 2001/12/13 19:20:30 jdlemare
*** empty log message ***

Revision 1.4 2001/12/04 17:50:16 jdlemare
add position in histogramm

Revision 1.3 2001/11/08 14:25:47 jdlemare
remove functions from the namespace to run zdoc

Revision 1.2 2001/10/05 16:06:44 hdeling
added scene graph tcl command

Revision 1.1 2001/08/27 10:12:09 jdlemare
add the TCL_SHELLS instead of interface.tcl

Revision 1.15 2001/07/16 15:15:49 hdeling
improved plot of histogram

Revision 1.14 2001/07/16 14:04:48 hdeling
changed display histogram

Revision 1.13 2001/06/01 08:49:08 hdeling
added histogram procedures

Revision 1.12 2001/05/17 15:00:50 hdeling
updated mpeg procedure

Revision 1.11 2001/05/03 13:22:11 hdeling
put in the background the execution of the mpeg-viewer program

Revision 1.10 2000/12/06 14:58:56 hdeling
added mpeg creation script

Revision 1.9 2000/12/05 15:11:40 hdeling
adding mainLoop at the end of command file dump

Revision 1.8 1999/04/26 15:58:41 aguimond
corrected typo with module slider command.

$Id: tclModules.tcl,v 1.3 2002/01/30 16:47:57 hdeling Exp $


bgerror
Comments  
Arguments str
Used by  
Uses modules::displayString
proc bgerror { str } {
    global errorInfo
    namespace eval onerror { global errCmd }
    
    if { [winfo exists $modules::parent.msg.r.b.list] } {
    if { ![info exists onerror::errCmd] } {
        set onerror::errCmd $errorInfo
        modules::displayString "error: $str" red
    } else {
        if { ![string compare $onerror::errCmd $errorInfo] } {
        modules::displayString "$errorInfo" red
        } else {
        set onerror::errCmd $errorInfo
        modules::displayString "error: $str" red
        }
    }
    } else {
    puts "********* TCL error ***********"
    puts "$errorInfo"
    }
    
    if { [winfo exists $modules::parent.cmd.r.b.list] } {
    $modules::parent.cmd.r.b.list insert $modules::yavncmds [$modules::parent.cmd.r.txt get]
    $modules::parent.cmd.r.txt delete 0 1000
    $modules::parent.cmd.r.b.list see end
    incr modules::yavncmds
    set modules::yavcrtcmd $modules::yavncmds
    }
}


completion
Comments  
Arguments  
Used by  
Uses  
namespace eval completion {

}


completion::commandCompletion
Comments perform command name completion on first str word
Arguments str
Used by  
Uses  
proc completion::commandCompletion { str } {
    set cmds [info commands [lindex $str 0]*]

    if {[llength $cmds] == 0} {
    return "$str"
    } elseif {[llength $cmds] == 1} {
    return "$cmds "
    } else {
    return [commonPrefix $cmds]
    }
}


completion::commonPrefix
Comments Find the longest common prefix
Arguments names
Used by  
Uses  
proc completion::commonPrefix { names } {
    set l 0
    set miss 0
    set prefix [lindex $names 0]
    set max [string length $prefix]

    while {!$miss} {
    if { $l == $max } {
        set miss 1
    } else {
        incr l
        set new [string range $prefix 0 $l]
        foreach f $names {
        if ![string match $new* $f] {
            set miss 1
            incr l -1
            break
        }
        }
    }
    }
    return [string range $prefix 0 $l]
}


completion::completion
Comments perform command name completion if str has only one word or file name
completion on last word otherwise
Arguments str
Used by  
Uses  
proc completion::completion { str } {
    switch [llength $str] {
    0 {
        return {}
    }
    1 {
        return [commandCompletion $str]
    }
    default {
        return [fileCompletion $str]
    }
    }
}


completion::fileCompletion
Comments perform file name completion on last str word
Arguments str
Used by  
Uses  
proc completion::fileCompletion { str } {
    set l [string length $str]
    set c [string index $str [expr $l - 1]]

    if { [string compare $c " "] } {
    set i [string last " " $str]
    set bstr [string range $str 0 $i]
    set path [string range $str [expr $i + 1] $l]

    if { [string match ~* $path] } {           # ~username
        regexp (~\[^/\]*)(/*) $path dir username eop
        if [catch {file dirname $username} dir] {
        return $str
        }
        if { [string compare $eop ""] } {
        set dir [file dirname $path]
        } else {
        set dir $path
        }
        set tail [file tail $path]
    } else {                                   # other path
        set dir [file dirname $path]
        set tail [file tail $path]
    }
    if { ![string compare $dir "."] } {
        set cdir true
    } else {
        set cdir false
    }

    # See what files are there
    if { $cdir } {
        set files [glob -nocomplain $tail*]
    } else {
        set files [glob -nocomplain $dir/$tail*]
    }

    set alone 1
    switch [llength [split $files]] {
        0 {}                                       # no file match
        1 {                                        # matched a single file
        if { $cdir } {
            set path [file tail $files]
        } else {
            if { [string compare $dir "/"] } {
            set path $dir/[file tail $files]
            } else {
            set path /[file tail $files]
            }
        }
        }
        default {                                  # matched several files
        set alone 0
        set path [commonPrefix $files]
        }
    }

    if { [file isdirectory $path] } {
        if { ![string compare $path "/"] } {
        set rstr "$bstr/"
        } else {
        set rstr "$bstr$path/"
        }
    } elseif { [file exists $path] && $alone } {
        set rstr "$bstr$path "
    } else {
        set rstr "$bstr$path"
    }

    return $rstr
    }

    return $str
}


modules
Comments  
Arguments  
Used by  
Uses  
namespace eval modules {

    set yavcrtcmd 0
    set yavncmds 0
    set yavcrt ""

    set parent .

    set helpFct ""

    
}


modules::colorToRgb
Comments  
Arguments color
Used by modules::selectColor
modules::selectColorStr
Uses  
proc modules::colorToRgb { color } {
    scan $color "#%02x%02x%02x" r g b
    set r [expr $r/255.0]
    set g [expr $g/255.0]
    set b [expr $b/255.0]
    return [list $r $g $b]
}


modules::createHistogramGraph
Comments  
Arguments histo
graph
minVal
nbBuckets
Used by modules::drawHistogramInFrame
Uses  
proc modules::createHistogramGraph { histo graph minVal nbBuckets} {
    set xval $minVal
    set x {}
    set y {}
    set nb $nbBuckets
    set s  [ $histo -bucket size]
    for { set i 0} { $i < $nb} { incr i} {
    lappend x $xval
    lappend y [ $histo -value $xval ]
    set xval [ expr  $xval + $s ]
    }
    if {![$graph element exists $histo]} {
    $graph element create $histo -xdata $x -ydata $y -linewidth 1 -scalesymbols yes -pixels 2 -symbol ""
    } else {
    $graph element configure $histo  -xdata $x -ydata $y
    }
    # affichage des coordonnees
    if { [winfo exists .$histo.position.p]} {
    bind $graph <Motion> ".$histo.position.p configure -text \"\[format \"%%.2f\" \[$graph axis invtransform x \[lindex \[split \[lindex \[split \[$graph crosshairs cget -position\] ,\] 0\] @\] 1\]\] \] \[format \"%%.2f\" \[$graph axis invtransform y \[lindex \[split \[$graph crosshairs cget -position\] ,\] 1\]\]\]\""
    }
    # rajoute les barres verticales et horizontales du curseur
    Blt_Crosshairs $graph
}


modules::displayHelp
Comments  
Arguments msg
Used by modules::help
Uses  
proc modules::displayHelp { msg } {
    set l 1

    while { [string length $msg] > 75 } {
    set i 75
    while { $i > 0 && [string compare [string index $msg $i] "|"] &&
        [string compare [string index $msg $i] " "] } {
        incr i -1
    }
    if { $i == 0 } {
        set i 75
        while { $i < [string length $msg] &&
            [string compare [string index $msg $i] "|"] &&
            [string compare [string index $msg $i] " "] } {
        incr i
        }        
    }
    if { $l > 1 } {
        .help.txt.l insert end "   [string range $msg 0 $i]"
    } else {
        .help.txt.l insert end [string range $msg 0 $i]
    }
    set msg [string range $msg [expr $i + 1] end]
    incr l
    }
    if { $l > 1 } {
    .help.txt.l insert end "   $msg"
    } else {
    .help.txt.l insert end $msg
    }
}


modules::displayMessage
Comments  
Arguments str
Used by modules::evaluate
modules::setResult
Uses modules::displayString
proc modules::displayMessage { str } {
    modules::displayString $str black
}


modules::displayString
Comments  
Arguments str
color
Used by modules::displayMessage
bgerror
Uses  
proc modules::displayString { str color } {
    $modules::parent.msg.r.b.list insert [$modules::parent.msg.r.b.list size] [$modules::parent.msg.r.txt cget -text]
    $modules::parent.msg.r.b.list see end
    $modules::parent.msg.r.txt configure -text $str -fg $color
}


modules::drawHistogramInFrame
Comments  
Arguments frame
histo
color
Used by modules::plotHistogram
inrimage::thresholdDialog
Uses modules::createHistogramGraph
proc modules::drawHistogramInFrame { frame histo  {color "#E8E0D2"}} {
    set graph $frame.g
    #load BLT
    package require BLT
    
    blt::graph $frame.g -plotbackground white

    modules::createHistogramGraph $histo $graph [ $histo -minValue ] [ $histo -bucket number]
    Blt_ZoomStack $graph
    Blt_ClosestPoint $graph
    
    scrollbar $frame.xbar -command " $graph axis view x " -orient horizontal
    scrollbar $frame.ybar -command " $graph axis view y " -orient vertical
    $graph axis configure x -scrollcommand " $frame.xbar set " -logscale no -loose no
    $graph axis configure y -scrollcommand " $frame.ybar set " -logscale no
    
    pack  $frame.ybar -fill y -side left
    pack  $frame.g -fill both
    pack  $frame.xbar -fill x

}


modules::dumpCommandsToFile
Comments  
Arguments  
Used by  
Uses  
proc modules::dumpCommandsToFile { } {
    set fname [ tk_getSaveFile -filetypes {{Results {.dump}} {All *}} -parent . -title {Select an image} ]
    if { [string compare $fname ""] } {
    set fres [open $fname w]
    for {set i 0} {$i < [$modules::parent.cmd.r.b.list size]} {incr i} {
        puts $fres [$modules::parent.cmd.r.b.list get $i]
    }
    puts $fres "mainLoop\n"
    close $fres
    }
}


modules::dumpResultsToFile
Comments  
Arguments  
Used by  
Uses  
proc modules::dumpResultsToFile { } {
    set fname [ tk_getSaveFile -filetypes {{Results {.dump}} {All *}} -parent . -title {Select an image} ]
    if { [string compare $fname ""] } {
    set fres [open $fname w]
    for {set i 1} {$i < [$modules::parent.msg.r.b.list size]} {incr i} {
        puts $fres [$modules::parent.msg.r.b.list get $i]
    }
    puts $fres [$modules::parent.msg.r.txt cget -text]
    close $fres
    }
}


modules::entryDialog
Comments  
Arguments root
color
title
initVal
cmd
fg
Used by  
Uses  
proc modules::entryDialog  { root color title  initVal cmd  {fg black} } {
    if ![winfo exists $root] {
    toplevel $root  -bg $color
    frame $root.f -bg $color
    label $root.f.l -text $title -bg $color
    entry $root.f.e  -bg $color -fg $fg -relief sunken
    $root.f.e insert 0  $initVal
    pack $root.f.l $root.f.e -side left
    frame $root.buttons -bg $color
    button $root.buttons.apply -text Apply -command " eval \[modules::menusubstitute {$cmd} ...  \[$root.f.e get \] \] " -bg $color
    button $root.buttons.destroy -text "Destroy" -command "destroy $root" -bg $color
    pack $root.buttons.apply $root.buttons.destroy -side left -expand true -fill both -padx 20 -pady 10
    pack $root.f $root.buttons -expand true -fill both
    }
}


modules::evaluate
Comments  
Arguments commandStr
Used by  
Uses modules::displayMessage
proc modules::evaluate { commandStr } {
    # evaluate command at toplevel
    set res [uplevel \#0 $commandStr]
    
    # set result
    modules::displayMessage $res
    $modules::parent.cmd.r.txt delete 0 1000
    
    $modules::parent.cmd.r.b.list insert $modules::yavncmds $commandStr
    $modules::parent.cmd.r.b.list see end
    incr modules::yavncmds
    set modules::yavcrtcmd $modules::yavncmds
    
    return $res
}


modules::flushCommands
Comments  
Arguments  
Used by  
Uses  
proc modules::flushCommands { } {
    while { [$modules::parent.cmd.r.b.list size] > 0 } {
    $modules::parent.cmd.r.b.list delete 0
    }
    set modules::yavcrtcmd 0
    set modules::yavncmds 0
    set modules::yavcrt ""
}


modules::flushResults
Comments  
Arguments  
Used by  
Uses  
proc modules::flushResults { } {
    while { [$modules::parent.msg.r.b.list size] > 0 } {
    $modules::parent.msg.r.b.list delete 0
    }
    $modules::parent.msg.r.txt configure -text "Ready"
}


modules::help
Comments  
Arguments color
Used by  
Uses modules::displayHelp
proc modules::help { color } {
    if ![winfo exists .help] {
    toplevel .help -bg $color
    wm title .help "Help me!"

    frame .help.lists -bg $color

    frame .help.lists.modules -bg $color
    label .help.lists.modules.t -text "Modules" -relief raised -bg $color
    frame .help.lists.modules.l -bg $color
    listbox .help.lists.modules.l.l -height 8 -bg white -yscrollcommand [list .help.lists.modules.l.sy set]
    scrollbar .help.lists.modules.l.sy -orient vertical -bg $color -command [list .help.lists.modules.l.l yview]
    pack .help.lists.modules.l.l -fill both -expand true -side left
    pack .help.lists.modules.l.sy -fill y -side right
    pack .help.lists.modules.t -fill x -expand true
    pack .help.lists.modules.l -fill both -expand true
    foreach module [module -list] {
        .help.lists.modules.l.l insert end $module
    }
    bind .help.lists.modules.l.l <1> ".help.lists.functions.l.l delete 0 end; .help.lists.options.l.l delete 0 end; .help.txt.l delete 0 end; foreach fct \[functions \[.help.lists.modules.l.l get @%x,%y\]\] {.help.lists.functions.l.l insert end \$fct}"

    frame .help.lists.functions -bg $color
    label .help.lists.functions.t -text "Functions" -relief raised -bg $color
    frame .help.lists.functions.l -bg $color
    listbox .help.lists.functions.l.l -height 8 -bg white -yscrollcommand [list .help.lists.functions.l.sy set]
    scrollbar .help.lists.functions.l.sy -orient vertical -bg $color -command [list .help.lists.functions.l.l yview]
    pack .help.lists.functions.l.l -fill both -expand true -side left
    pack .help.lists.functions.l.sy -fill y -side right
    pack .help.lists.functions.t -fill x -expand true
    pack .help.lists.functions.l -fill both -expand true
    bind .help.lists.functions.l.l <1> ".help.lists.options.l.l delete 0 end; .help.txt.l delete 0 end; set modules::helpFct \[.help.lists.functions.l.l get @%x,%y\]; modules::displayHelp \[help \$modules::helpFct synopsis\]; modules::displayHelp \[help \$modules::helpFct description\]; .help.txt.l yview end; modules::displayHelp {}; foreach opt \[options \$modules::helpFct\] {.help.lists.options.l.l insert end \$opt}"

    frame .help.lists.options -bg $color
    label .help.lists.options.t -text "Options" -relief raised -bg $color
    frame .help.lists.options.l -bg $color
    listbox .help.lists.options.l.l -height 8 -bg white -yscrollcommand [list .help.lists.options.l.sy set]
    scrollbar .help.lists.options.l.sy -orient vertical -bg $color -command [list .help.lists.options.l.l yview]
    pack .help.lists.options.l.l -fill both -expand true -side left
    pack .help.lists.options.l.sy -fill y -side right
    pack .help.lists.options.t -fill x -expand true
    pack .help.lists.options.l -fill both -expand true
    bind .help.lists.options.l.l <1> "modules::displayHelp \[help \$modules::helpFct \[.help.lists.options.l.l get @%x,%y\] synopsis\]; modules::displayHelp \[help \$modules::helpFct \[.help.lists.options.l.l get @%x,%y\] description\]; .help.txt.l yview end; modules::displayHelp {}"

    pack .help.lists.modules .help.lists.functions .help.lists.options -fill both -expand true -padx 10 -pady 10 -side left

    frame .help.txt -bg $color
    listbox .help.txt.l -height 8 -width 80 -bg white -yscrollcommand [list .help.txt.sy set]
    scrollbar .help.txt.sy -orient vertical -bg $color -command [list .help.txt.l yview]
    pack .help.txt.l -fill both -expand true -side left
    pack .help.txt.sy -fill y -side right

    frame .help.bt -bg $color
    button .help.bt.quit -text "Dismiss" -command "destroy .help" -bg $color
    pack .help.bt.quit -pady 10

    pack .help.lists .help.txt -fill both -padx 10 -pady 10 -expand true
    pack .help.bt -fill x -expand true
    }
}


modules::historyDown
Comments  
Arguments parent
Used by  
Uses  
proc modules::historyDown { parent } {
    if {$modules::yavcrtcmd < $modules::yavncmds} {
    set modules::yavcrtcmd [expr $modules::yavcrtcmd + 1]
    $parent.cmd.r.txt delete 0 1000
    if {$modules::yavcrtcmd == $modules::yavncmds} {
        $parent.cmd.r.txt insert 0 $modules::yavcrt
    } else {
        $parent.cmd.r.txt insert 0 [$parent.cmd.r.b.list get $modules::yavcrtcmd]
    }
    }
}


modules::historyUp
Comments  
Arguments parent
Used by  
Uses  
proc modules::historyUp { parent } {
    if { $modules::yavcrtcmd == $modules::yavncmds } {
    set modules::yavcrt [$parent.cmd.r.txt get]
    }
    if {$modules::yavcrtcmd > 0} {
    set modules::yavcrtcmd [expr $modules::yavcrtcmd - 1]
    $parent.cmd.r.txt delete 0 1000
    $parent.cmd.r.txt insert 0 [$parent.cmd.r.b.list get $modules::yavcrtcmd]
    }
}


modules::interface
Comments end of interface
Arguments parent
color
Used by  
Uses  
proc modules::interface { parent color } {
    set modules::parent $parent

    setDisplayFunction "modules::displayMessage"
    setEvalFunction "modules::evaluate"

    # main frame
    frame $parent.cmd -bg $color
    frame $parent.cmd.r -bg $color
    frame $parent.cmd.r.b -bg $color
    label $parent.cmd.lbl -text "Command:" -bg $color
    pack $parent.cmd.lbl -side left
    pack $parent.cmd.r -side right -fill both -expand true -padx 8 -pady 5
    
    entry $parent.cmd.r.txt -bg white -relief sunken -width 60 -textvariable compname
    #eliminate binding tag to do our own focus management
    bindtags $parent.cmd.r.txt [list $parent.cmd.r.txt [winfo class $parent.cmd.r.txt] .]
    # exit on Control-d or Control-c
    #    bind $parent.cmd.r.txt <Control-d> { exit }
    #    bind $parent.cmd.r.txt <Control-D> { exit }
    #    bind $parent.cmd.r.txt <Control-c> { exit }
    #    bind $parent.cmd.r.txt <Control-C> { exit }
    
    bind $parent.cmd.r.txt <Return> "modules::evaluate \[$parent.cmd.r.txt get\]"
    bind $parent.cmd.r.txt <Up> "modules::historyUp $parent"
    bind $parent.cmd.r.txt <Down> "modules::historyDown $parent"
    #paste management
    bind $parent.cmd.r.txt <ButtonRelease-2> {
    if { ![catch {set str [selection get]}] } {
        set i [string length $str];
        set c [string index $str [expr $i - 1]];
        if { ![string compare $c "\n"] } {
        modules::evaluate [string range $str 0 [expr $i - 2]];
        selection clear
        }
    }
    }
    #focus management
    bind $parent.cmd.r.txt <Tab> "set str \[completion::completion \[$parent.cmd.r.txt get\]\]; $parent.cmd.r.txt delete 0 1000; $parent.cmd.r.txt insert 0 \$str"
    bind $parent <Enter> "focus $parent.cmd.r.txt"
    bind $parent.cmd <Tab> "focus $parent.cmd.r.txt"
    
    listbox $parent.cmd.r.b.list -height 3  -bg $color -yscrollcommand [list $parent.cmd.r.b.sy set] -xscrollcommand [list $parent.cmd.r.b.sx set]
    bind $parent.cmd.r.b.list <ButtonPress-1> "set str \[$parent.cmd.r.b.list get @%x,%y\]; if { \[string compare str \"\" \] != 0 } { $parent.cmd.r.txt delete 0 1000; $parent.cmd.r.txt insert 0 \$str }"
    scrollbar $parent.cmd.r.b.sy -orient vertical -bg $color -command [list $parent.cmd.r.b.list yview]
    scrollbar $parent.cmd.r.b.sx -orient horizontal -bg $color -command [list $parent.cmd.r.b.list xview]
    pack $parent.cmd.r.b.sx -fill x -side bottom
    pack $parent.cmd.r.b.list -fill both -expand true -side left
    pack $parent.cmd.r.b.sy -fill y -side right
    
    pack $parent.cmd.r.b -fill both -expand true
    pack $parent.cmd.r.txt -fill x
    
    frame $parent.msg -bg $color
    frame $parent.msg.r -bg $color
    frame $parent.msg.r.b -bg $color
    label $parent.msg.lbl -text "Message: " -bg $color
    pack $parent.msg.lbl -side left
    pack $parent.msg.r -side right -fill both -expand true -padx 8 -pady 5
    
    label $parent.msg.r.txt -text "Ready" -relief sunken -width 60 -anchor w -bg gray
    listbox $parent.msg.r.b.list -height 5 -bg $color -yscrollcommand [list $parent.msg.r.b.sy set] -xscrollcommand [list $parent.msg.r.b.sx set]
    scrollbar $parent.msg.r.b.sy -orient vertical -bg $color -command [list $parent.msg.r.b.list yview]
    scrollbar $parent.msg.r.b.sx -orient horizontal -bg $color -command [list $parent.msg.r.b.list xview]
    pack $parent.msg.r.b.sx -fill x -side bottom
    pack $parent.msg.r.b.list -fill both -expand true -side left
    pack $parent.msg.r.b.sy -fill y -side right
    
    pack $parent.msg.r.b -fill both -expand true
    pack $parent.msg.r.txt -fill x
    bind $parent.msg <Tab> "focus $parent.cmd.r.txt"
    

    frame $parent.buttons -bg $color
    button $parent.buttons.quit -text "Exit" -command exit -bg $color
    button $parent.buttons.help -text "Help" -command "modules::help $color" -bg $color

    pack $parent.buttons.quit $parent.buttons.help -side left -padx 20 -pady 10 -expand true

    pack $parent.cmd $parent.msg -fill both -expand true
    pack $parent.buttons -fill x -expand true
    focus $parent.cmd.r.txt
    
}


modules::menusubstitute
Comments  
Arguments str
tag
elt
Used by  
Uses  
proc modules::menusubstitute { str tag elt } {
    set index [string first $tag $str]
    if { $index == -1 } {
    return "eval {$str $elt}"
    } else {
    return "eval {[string range $str 0 [expr $index - 1]]$elt[string range $str [expr $index + [string length $tag]] end]}"
    }
}


modules::mpeg
Comments  
Arguments name
encode
play
factor
from
nb
Used by  
Uses  
proc modules::mpeg { name {encode mpeg_encode} {play xanim}  {factor 1} {from 0} {nb 4} } {
    set rname [file rootname $name]
    set ename [file extension $name]
    if [string compare $ename ".ppm"] {
    set conv 1
    } else {
    set conv 0
    }
    set i $from
    while { [ file exists ${rname}[set id [format "%0${nb}i" $i]]${ename}  ] } {
    for { set j 0 } { $j < $factor } { incr j } {
        set did [format "%0${nb}i" [expr $factor * $i + $j]]
        if $conv {
        exec convert ${rname}${id}${ename} ${rname}${id}.ppm
        }
        exec ln -s ${rname}${id}.ppm tmp.${rname}.$did.ppm
    }
    incr i
    }
    set to $i
    set bg [format "%0${nb}i" [expr $factor * $from]]
    set nd [format "%0${nb}i" [expr $factor * $to - 1]]
    
    set f [open tmp.${rname}.param w]
    puts $f "PATTERN I"
    puts $f "OUTPUT ${rname}.mpeg"
    puts $f "INPUT_DIR ."
    puts $f "INPUT"
    puts $f "tmp.${rname}.*.ppm \[${bg}-${nd}\]"
    puts $f "END_INPUT"
    puts $f "BASE_FILE_FORMAT PPM"
    puts $f "INPUT_CONVERT *"
    puts $f "GOP_SIZE 1"
    puts $f "SLICES_PER_FRAME 1"
    puts $f "PIXEL FULL"
    puts $f "RANGE 10"
    puts $f "PSEARCH_ALG EXHAUSTIVE"
    puts $f "BSEARCH_ALG EXHAUSTIVE"
    puts $f "IQSCALE 8"
    puts $f "PQSCALE 10"
    puts $f "BQSCALE 25"
    puts $f "REFERENCE_FRAME DECODED"
    close $f
    
    exec ${encode} tmp.${rname}.param  

    file delete tmp.${rname}.param
    
    for { set i $from } { $i < $to } { incr i } {
    set id [format "%0${nb}i" [expr $i]]
    if $conv {
        file delete ${rname}${id}.ppm
    }
    for { set j 0 } { $j < $factor } { incr j } {
        set did [format "%0${nb}i" [expr $factor * $i + $j]]
        file delete tmp.$rname.$did.ppm
    }
    }
    exec ${play}  ${rname}.mpeg &
}


modules::plotHistogram
Comments  
Arguments histo
color
subcolor
Used by  
Uses modules::drawHistogramInFrame
proc modules::plotHistogram { histo  {color "#E8E0D2"} {subcolor "#D8D0C2"}} {
    set root ".${histo}"
    if {![winfo exists $root]} {

    toplevel $root -bg $color
    wm title $root "Plot of Histogram $histo"

    frame $root.position -bg $color
    label $root.position.l -text "Position:"  -bg $color
    label $root.position.p -text "" -bg $color

    frame $root.menu -bg $color
    menubutton $root.menu.file -text "File" -menu $root.menu.file.m -anchor w -bg $color
    set mfile [ menu  $root.menu.file.m -bg $color]
    $mfile add command -label "Save as Postcript.." -command "$root.f.g postscript output \[tk_getSaveFile -filetypes {{\"Postcript File\" {*.ps}}  {\"All\" {*} }  } -parent . -title {Select a Postcript File}\] -maxpect yes -decorations no"
    $mfile add command -label "Save as PPM File" -command "set im \[ image create photo\]; blt::winop snap $root.f.g \$im; \$im write \[tk_getSaveFile -filetypes {{\"PPM File\" {*.ppm}}  {\"All\" {*} }  } -parent . -title {Select a PPM File}\] -format ppm "
    $mfile add separator
    $mfile add command -label "Destroy" -command "destroy $root; $histo -destroy"
    menubutton $root.menu.graph -text "Graphics" -menu $root.menu.graph.m -anchor w -bg $color
    set mgraph [ menu  $root.menu.graph.m -bg $color]
    $mgraph add command -label "Set X Range..."
    $mgraph add command -label "Set Y Range..."
    $mgraph add command -label "Set Background Color..." -command "$root.f.g configure -plotbackground \[ tk_chooseColor -title \"Choose a background color\" -initialcolor \[ $root.f.g cget -plotbackground\]  \] "
    menubutton $root.menu.hist -text "Histogram" -menu $root.menu.hist.m -anchor w -bg $color
    set mhist [ menu  $root.menu.hist.m -bg $color]
    $mhist add command -label "Set Number of Buckets..." -command "modules::scaleDialog .{$histo}NbBucket $color \"Set the number of buckets\" 2 256 \[$histo -bucket number \] \"evaluate \{ $histo -bucket number ... \};modules::createHistogramGraph $histo $root.f.g \[$histo -minValue\] \\\[$histo -bucket number \\\] \""
    $mhist add command -label "Set Bucket Size..." -command "modules::entryDialog .{$histo}BucketSize $color \"Set the size of each bucket\" \[$histo -bucket size \] \"evaluate \{ $histo -bucket size ... \};modules::createHistogramGraph $histo $root.f.g \[$histo -minValue\] \\\[$histo -bucket number \\\] \""
    $mhist add command -label "Show Statistics..." -command "tk_messageBox -icon info -message \" Mean Value : \[$histo -stat mean\] \n\n Median Value : \[$histo -stat median\] \n\n Min Value : \[$histo -minValue\]\n\n Max Value : \[$histo -maxValue\]\" "
    $mhist add command -label "Smooth Histogram..." -command  "modules::scaleDialog .{$histo}Smooth $color \"Set the filter size\" 1 10 2.0 \"evaluate \{ $histo -smooth ... \};modules::createHistogramGraph $histo $root.f.g \[$histo -minValue\] \\\[$histo -bucket number \\\] \""
    $mhist add command -label "Fit Gaussian..."
    
    pack $root.menu.file $root.menu.graph $root.menu.hist -side left
    pack $root.position.l $root.position.p -side left
    pack $root.position $root.menu -fill x
    
    frame $root.f -bg $color
    modules::drawHistogramInFrame $root.f $histo $color
    pack $root.f
    
    }
    
}


modules::rgbToColor
Comments  
Arguments str
Used by  
Uses  
proc modules::rgbToColor {str } {
    scan $str {%f %f %f} r g b
    return [ format "#%02x%02x%02x" [expr round($r*255)] [expr round($g*255)] [expr round($b*255)] ]
}


modules::scaleDialog
Comments  
Arguments root
color
title
from
to
initVal
cmd
resolution
fg
Used by  
Uses  
proc modules::scaleDialog  { root color title from to initVal cmd {resolution 1.0} {fg black} } {
    if ![winfo exists $root] {
    toplevel $root  -bg $color
    frame $root.f -bg $color
    label $root.f.l -text $title -bg $color
    scale $root.f.s -from $from -to $to -resolution $resolution -orient horizontal -bg $color -fg $fg
    $root.f.s set $initVal
    pack $root.f.l $root.f.s -side left
    frame $root.buttons -bg $color
    button $root.buttons.apply -text "Apply" -command " eval \[modules::menusubstitute {$cmd} ...  \[$root.f.s get \] \] " -bg $color
    button $root.buttons.destroy -text "Destroy" -command "destroy $root" -bg $color
    pack $root.buttons.apply $root.buttons.destroy -side left -expand true -fill both -padx 20 -pady 10
    pack $root.f $root.buttons -expand true -fill both
    }
}


modules::sceneGraph
Comments  
Arguments dim
Used by  
Uses  
proc modules::sceneGraph { { dim  2D}  } {
    package require BLT    
    set root .sceneGraph$dim
    if  ![winfo exists $root]  {
    toplevel $root
    #scrolll bar
    set vs $root.vs
    set hs $root.hs
    #create hierbox
    set list [blt::hierbox $root.h  \
              -yscrollcommand "$vs set " \
              -xscrollcommand "$hs set " ]
    $list configure -width 300

    scrollbar $vs -orient vertical -command " $list yview "
    scrollbar $hs -orient horizontal -command "$list xview "

    
    blt::table $root 0,0 $list  -fill both 0,1 $vs  -fill y 1,0 $hs -fill x

    blt::table configure $root c1 r1 -resize non
    #        blt::table configure $root c0 -width $list
    
    $list configure -separator "/" -autocreate yes -activebackground white

    $list entry configure root -label "$dim Scene Graph"  -labelfont { Helvetica 24 }  
    foreach i [which scn$dim] {
        scan $i "scn$dim%u" val
        set label "Scene no$val ($i)"
        $list insert end "$label" -labelfont { Helvetica 16 }  -labelcolor  magenta
        $list insert end "$label/Graphical Models" -labelcolor darkorange1
        foreach j [ $i -objects ] {
        set realName [scn$dim -realName [$j -kind] ]
        set name "$realName ($j)"
        $list insert end "$label/Graphical Models/$name" -labelcolor darkorange1
        #parse inrview
        if ![string compare [$j -kind] inrview] {
            foreach cam [$i -camera] {
            if ![string compare [$cam -kind] slicecam ] {
                set k [$j -background $cam]
                set otherRealName [scn$dim -realName [$k -kind] ]
                set otherName "$otherRealName ($k)"
                $list insert end "$label/Graphical Models/$name/$otherName"  
            }
            }
        }

        }
        set val [$list insert end "$label/Deformable Models"]
        $list entry configure $val -labelcolor forestgreen
        foreach j [ $i -deformable ] {
        set realName [scn$dim -realName [$j -kind] ]
        set name "$realName ($j)"
        set val [$list insert end "$label/Deformable Models/$name"]
        $list entry configure $val -labelcolor forestgreen
        }
        set val [$list insert end "$label/Range Data Models"]
        $list entry configure $val -labelcolor red
        foreach j [ $i -range ] {
        set realName [scn$dim -realName [$j -kind] ]
        set name "$realName ($j)"
        set val [$list insert end "$label/Range Data Models/$name"]
        $list entry configure $val -labelcolor red
        }
        set val [$list insert end "$label/Cameras"]
        $list entry configure $val -labelcolor blue
        foreach j [ $i -camera ] {
        set realName [scn$dim -realName [$j -kind] ]
        set name "$realName ($j)"
        set val [$list insert end "$label/Cameras/$name"]
        $list entry configure $val -labelcolor blue
        #parse slicecam
        if ![string compare [$j -kind] slicecam] {
            foreach k [$j -slicescale] {
            set otherRealName [scn$dim -realName [$k -kind] ]
            set otherName "$otherRealName ($k)"
            $list insert end "$label/Cameras/$name/$otherName"  
            }
        }
        }
        
    }
    }
}


modules::selectColor
Comments  
Arguments str
Used by graphics3D::viewer3DMenu
graphics2D::installSurfaceViewMenu
contour::installContourLineMenu
isosurface::installIsocontourDisplayMenu
inrimage::installROIMenu
contour::installContourDisplayMenu
triangulation::installTrianViewMenu
inrimage::installLandmarkSetMenu
contour::installActiveContour2DEdgeMenu
graphics2D::addCamera2DMenu
contour::installContourVertexMenu
Uses modules::colorToRgb
proc modules::selectColor {str}   {
    set color [tk_chooseColor -title "Choose a color"  -initialcolor [modules::rgbToColor $str] ]
    if ![string compare color " "] {
    return[ modules::colorToRgb str]
    } else {
    return [modules::colorToRgb $color]
    }
}


modules::selectColorStr
Comments  
Arguments str
Used by triangulation::installMainTriangulation3DMenu
graphics3D::installRectangle3DMenu
SM2::selectZone
tetrahedrisation::installTetra3DDisplayMenu
graphics3D::installSphereMenu
SM2::installSM2
Uses modules::colorToRgb
proc modules::selectColorStr {str}   {
    set color [tk_chooseColor -title "Choose a color" -initialcolor  $str]
    if ![string compare color " "] {
    return[ modules::colorToRgb str]
    } else {
    return [modules::colorToRgb $color]
    }
}


modules::setCommand
Comments  
Arguments cmd
Used by  
Uses  
proc modules::setCommand { cmd } {
    $modules::parent.cmd.r.b.list insert $modules::yavncmds $cmd
    $modules::parent.cmd.r.b.list see end
    incr modules::yavncmds
    set modules::yavcrtcmd $modules::yavncmds
}


modules::setPartialCommand
Comments  
Arguments cmd
Used by  
Uses  
proc modules::setPartialCommand { cmd } {
    $modules::parent.cmd.r.txt delete 0 1000
    $modules::parent.cmd.r.txt insert 0 $cmd
}


modules::setResult
Comments  
Arguments res
Used by  
Uses modules::displayMessage
proc modules::setResult { res } {
    modules::displayMessage $res    
}