home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activetcltk / ActiveTcl8.3.4.1-8.win32-ix86.exe / ActiveTcl8.3.4.1-win32-ix86 / demos / Snack / dataplot.plg < prev    next >
Encoding:
Text File  |  2001-10-22  |  7.6 KB  |  275 lines
  1. # -*-Mode:Tcl-*-
  2.  
  3. catch {tk_getOpenFile -junk}
  4.  
  5. namespace eval dataplot_v1 {
  6.     variable dataplot
  7.  
  8.     set dataplot(fmtstr) "0:red"
  9.     set dataplot(max) 0
  10.     set dataplot(min) 0
  11.     set dataplot(ybase) [expr $::v(waveh) + $::v(spegh)]
  12.     set dataplot(height) $::v(spegh)
  13.     set dataplot(frametime) 0.01
  14.     set dataplot(offset) 0.0
  15.     set dataplot(skip) 0
  16.     set dataplot(lockmax) 0
  17.     set dataplot(lockmin) 0
  18.  
  19.     lappend ::v(plugins) ::dataplot_v1
  20.     snack::menuCommand Tools {Plot Data} ::dataplot_v1::PlotDataWin
  21.  
  22.     proc Describe {} {
  23.     return "This plug-in adds the capability to plot numerical ASCII data. It is also possible to modify the plot and save the changes."
  24.     }
  25.     
  26.     proc Unload {} {
  27.     snack::menuDelete Tools {Plot Data}
  28.     }
  29.     
  30.     proc Redraw y {
  31.     global c f v
  32.     variable dataplot
  33.     
  34.     set max -1000000
  35.     set min  1000000
  36.     if ![info exist dataplot(check)]      { return 0 }
  37.     if {$dataplot(check) != $f(sndfile)}  { return 0 }
  38.     $c delete plot
  39.     
  40.     foreach def [split $dataplot(fmtstr)] {
  41.         scan $def "%d:%s" column color
  42.         set plot($column) $color
  43.     }
  44.     
  45.     foreach column [array names plot] {
  46.         if {!$dataplot(lockmax)} {
  47.         for {set i 0} {$i < $dataplot(rows)} {incr i} {
  48.             set val $dataplot($i.$column)
  49.             if {$val > $max} { set max $val }
  50.         }
  51.         set dataplot(max) $max
  52.         } else {
  53.         set max $dataplot(max)
  54.         }
  55.         if {!$dataplot(lockmin)} {
  56.         for {set i 0} {$i < $dataplot(rows)} {incr i} {
  57.             set val $dataplot($i.$column)
  58.             if {$val < $min} { set min $val }
  59.         }
  60.         set dataplot(min) $min
  61.         } else {
  62.         set min $dataplot(min)
  63.         }
  64.         set range [expr $max - $min]
  65.         set data [ComputeCoords 0 [expr $dataplot(rows)-1] $column $range $min]
  66.         eval $c create line $data -tags {[list col$column $column plot]} -fill $plot($column)
  67.         set dataplot(data$column) $data
  68.     }
  69.     
  70.     $c bind plot <B1-Motion>      "::dataplot_v1::EditPlot %W %x %y draw"
  71.     $c bind plot <ButtonPress-1>  "::dataplot_v1::EditPlot %W %x %y set"
  72.     
  73.     set dataplot(min) $min
  74.     set dataplot(range) $range
  75.     return 0
  76.     }
  77.  
  78.     proc Putmark m {
  79.     }
  80.     
  81.     proc ComputeCoords {start end column range min} {
  82.     global v
  83.     variable dataplot
  84.     
  85.     set t 0
  86.     set toff [expr $dataplot(offset) - double($v(startsmp))/$v(rate)] 
  87.     for {set i $start} {$i <= $end} {incr i} {
  88.         set val $dataplot($i.$column)
  89.         set yplot [expr $dataplot(ybase) - (($val - $min) * $dataplot(height) / $range)]
  90.         set t [expr ($i * $dataplot(frametime) + $toff) * $v(pps)]
  91.         lappend data $t $yplot
  92.     }
  93.     return $data
  94.     }
  95.     
  96.     proc PlotDataWin {} {
  97.     global v
  98.     variable dataplot
  99.  
  100.     set w .plot
  101.     catch {destroy $w}
  102.     toplevel $w
  103.     wm title $w "Plot data"
  104.     wm geometry $w [xsGetGeometry]
  105.     
  106.     pack [ label $w.lFmt -text "Format example: 1:green 3:red"]
  107.     pack [ entry $w.eFmt -textvar ::dataplot_v1::dataplot(fmtstr) -wi 34]
  108.     
  109.     pack [ frame $w.f1]
  110.     pack [ label $w.f1.lFrameTime -text "Frame spacing (s):" -wi 26] -side left
  111.     pack [ entry $w.f1.eFrameTime -textvar ::dataplot_v1::dataplot(frametime) -wi 8] -side left
  112.     
  113.     pack [ frame $w.f11]
  114.     pack [ label $w.f11.lStartOffset -text "Start offset (s):" -wi 20] -side left
  115.     pack [ entry $w.f11.eStartOffset -textvar ::dataplot_v1::dataplot(offset) -wi 8] -side left
  116.     
  117.     pack [ frame $w.f2]
  118.     pack [ label $w.f2.lmax -text "Plot value at top:" -wi 26] -side left
  119.     pack [ entry $w.f2.emax -textvar ::dataplot_v1::dataplot(max) -wi 8] -side left
  120.     pack [ checkbutton $w.f2.rLock -text Lock -var ::dataplot_v1::dataplot(lockmax)]
  121.  
  122.     pack [ frame $w.f21]
  123.     pack [ label $w.f21.lmin -text "Plot value at bottom:" -wi 26] -side left
  124.     pack [ entry $w.f21.emin -textvar ::dataplot_v1::dataplot(min) -wi 8] -side left
  125.     pack [ checkbutton $w.f21.rLock -text Lock -var ::dataplot_v1::dataplot(lockmin)]
  126.     
  127.     pack [ frame $w.f3]
  128.     pack [ label $w.f3.lYBase -text "Plot baseline at (pixels):" -wi 26] -side left
  129.     pack [ entry $w.f3.eYBase -textvar ::dataplot_v1::dataplot(ybase) -wi 8]
  130.     
  131.     pack [ frame $w.f4]
  132.     pack [ label $w.f4.lHeight -text "Plot height (pixels):" -wi 26] -side left
  133.     pack [ entry $w.f4.eHeight -textvar ::dataplot_v1::dataplot(height) -wi 8]
  134.     
  135.     pack [ frame $w.f5]
  136.     pack [ label $w.f5.lSkipHeader -text "Skip header (lines):" -wi 26] -side left
  137.     pack [ entry $w.f5.eSkipHeader -textvar ::dataplot_v1::dataplot(skip) -wi 8]
  138.     
  139.     pack [ frame $w.fb]
  140.     pack [ button $w.fb.bLoad -text Load -command ::dataplot_v1::PlotGetFile] -side left
  141.     pack [ button $w.fb.bSave -text Save -command ::dataplot_v1::SaveFile] -side left
  142.     pack [ button $w.fb.bPlot -text Plot -command ::Redraw] -side left
  143.     pack [ frame $w.f] -side bottom -fill x
  144.     label $w.f.lab -text "" -width 1 -relief sunken -bd 1 -anchor w
  145.     pack $w.f.lab -side left -expand yes -fill x
  146.     pack [ button $w.f.bExit -text Close -command "destroy $w"] -side left
  147.     bind $w <Key-Return> ::Redraw  
  148.     }
  149.     
  150.     proc PlotGetFile {} {
  151.     global f v
  152.     variable dataplot
  153.  
  154.     set file [tk_getOpenFile -title "Open data file" -initialfile [file rootname $f(sndfile)]]
  155.     if {$file == ""} return
  156.     if {[PlotReadFile $file] == -1} return
  157.  
  158.     set strip_fn [lindex [file split [file rootname $file]] end]
  159.     set ext [file extension $f(sndfile)]
  160.  
  161.     if {[string compare $strip_fn$ext $f(sndfile)] != 0} {
  162.         ::OpenFiles $f(spath)$strip_fn$ext
  163.     }
  164.  
  165.     set dataplot(frametime) [expr [snd length -units seconds]/$dataplot(rows)]
  166.     set dataplot(check) $f(sndfile)
  167.     set v(msg) "Plotting data file: $file"
  168.     ::Redraw
  169.     }
  170.     
  171.     proc PlotReadFile file {
  172.     global f v
  173.     variable dataplot
  174.  
  175.     set dataplot(file) $file
  176.     if {$file != ""} {
  177.         if [catch {open $file} in] {
  178.         SetMsg $in
  179.         return -1
  180.         } else {
  181.         set row 0
  182.         for {set i 0} {$i < $dataplot(skip)} {incr i} {
  183.             gets $in line
  184.         }
  185.         gets $in line
  186.         while ![eof $in] {
  187.             set column 0
  188.             foreach item [split $line] {
  189.             if {$item == ""} continue
  190.             if [catch {scan $item "%s" val} res] {
  191.                 SetMsg "Failed reading data at row: $row, col: $column"
  192.                 return
  193.             }
  194.             set dataplot($row.$column) $val
  195.             incr column
  196.             }
  197.             incr row
  198.             gets $in line
  199.         }
  200.         close $in
  201.         }
  202.         set dataplot(rows) $row
  203.         set dataplot(cols) $column
  204.     }
  205.     }
  206.     
  207.     proc SaveFile {} {
  208.     variable dataplot
  209.     
  210.     file copy -force $dataplot(file) $dataplot(file)~
  211.     if [catch {open $dataplot(file) w} out] {
  212.         SetMsg $out
  213.     } else {
  214.         for {set i 0} {$i < $dataplot(rows)} {incr i} {
  215.         set row ""
  216.         for {set j 0} {$j < $dataplot(cols)} {incr j} {
  217.             if $j { append row " " }
  218.             append row $dataplot($i.$j)
  219.         }
  220.         puts $out $row
  221.         }
  222.     }
  223.     close $out
  224.     }
  225.     
  226.     
  227.     proc EditPlot {w x y flag} {
  228.     global c v
  229.     variable dataplot
  230.     
  231.     set xc [$c canvasx $x]
  232.     set yc [$c canvasy $y]
  233.     set tag [lindex [$c gettags current] 0]
  234.     set col [lindex [$c gettags current] 1]
  235.     set i [expr int(($v(startsmp)/$v(rate)+$xc*1.0/$v(pps)-$dataplot(offset)) / $dataplot(frametime))]
  236.     
  237.     if {$i < 0 || $i >= $dataplot(rows)} return
  238.     if {$flag == "set"} {
  239.         set dataplot(orow) $i
  240.         return
  241.     }
  242.     if {$yc > $dataplot(ybase)} {
  243.         set yc $dataplot(ybase)
  244.     }
  245.     if {$yc < $dataplot(ybase) - $dataplot(height)} {
  246.         set yc [expr $dataplot(ybase) - $dataplot(height)]
  247.     }
  248.     set val [expr -$dataplot(range) * ($yc - $dataplot(ybase)) / $dataplot(height) + $dataplot(min)]
  249.     set inc 0
  250.     if {$i > $dataplot(orow)} {
  251.         set inc 1 
  252.     }
  253.     if {$i < $dataplot(orow)} {
  254.         set inc -1
  255.     }
  256.     set start [expr $dataplot(orow) + $inc]
  257.     for {set j $start} {$j != $i} {incr j $inc} {
  258.         set dataplot($j.$col) $val
  259.     }
  260.     set dataplot($i.$col) $val
  261.     SetMsg "Row: $i, Value: $val"
  262.     if {$start <= $i} {
  263.         set end $i
  264.     } else {
  265.         set end $start
  266.         set start $i
  267.     }
  268.     set chgd [ComputeCoords $start $end $col $dataplot(range) $dataplot(min)]
  269.     set dataplot(data$col) [eval lreplace {$dataplot(data$col)} [expr 2*$start] [expr 2*$end+1] $chgd]
  270.     
  271.     eval $c coords $tag $dataplot(data$col)
  272.     set dataplot(orow) $i
  273.     }
  274.  
  275. }