home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / programming / tcl / tcl_1 / !Hist_Hist < prev    next >
Encoding:
Text File  |  1996-02-05  |  3.4 KB  |  137 lines
  1. # Hist
  2.  
  3. source {<tcl$Dir>.!Choices}
  4.  
  5. w_init Hist
  6.  
  7. source {<tcl$Dir>.library.debug}
  8.  
  9. set diag 0
  10.  
  11. w_box progInfo create "About this program"\
  12.  { hlist {sprite !hist}
  13.            {vlist {info Name Hist}
  14.                   {info Purpose "Draw Histograms"}
  15.                   {info Author C.T.Stretch}
  16.                   {info Version 0.00}
  17.            }       
  18.  }
  19.  
  20. w_bar -menu { Hist {Info -dbox progInfo}
  21.                     {Quit -click exit}
  22.             }\
  23.       -drag { dragproc $w_file %t}
  24.  
  25. w_box dataInfo create "About the data"\
  26.  { vlist {display File fname}
  27.          {display N num}
  28.          {hlist {display Max maxd 10} {display Min mind 10}}
  29.  } -tag
  30.  
  31. w_box saveBox create "Save as:"\
  32.  { vlist {save DrawFile dname {savedrag $w_file %d}}
  33.          {hlist {action Cancel} {default Save {saveclick %d}}}
  34.  } -tag
  35.  
  36. proc savedrag {f w}\
  37.  { global dname
  38.    w_draw $w save $f
  39.    set dname($w) $f
  40.    return 0
  41.  }
  42.  
  43. proc saveclick {w}\
  44.  { global dname
  45.    if [string match *.* $dname($w)] \
  46.    { w_draw $w save $dname($w)
  47.      return 0
  48.    }
  49.    w_error "To save, drag the icon to a directory display"
  50.    return 0
  51.  }
  52.  
  53. proc saveMclick {w}\
  54.  { global dname
  55.    if [string match *.* $dname($w)] \
  56.    { w_draw $w save $dname($w)
  57.    } \
  58.    else \
  59.    { w_box saveBox open $w
  60.    }
  61.  }
  62.  
  63. proc dragproc {f t}\
  64.  { global diag fname num maxd mind dname
  65.    if {$t!=4095} return
  66.    set infile [open $f r]
  67.    incr diag
  68.    set fname(diag$diag) $f
  69.    set dname(diag$diag) DrawFile
  70.    while {![eof $infile]}\
  71.    { set line [gets $infile]
  72.      regsub -all {[^0-9.eE+-]+} $line " " line
  73.      set line [string trim $line]
  74.      append val "$line "
  75.    }
  76.    set val [lsort -real $val]
  77.    set n [llength $val]
  78.    set num(diag$diag) $n
  79.    if {$n<8} {w_error "Insufficient data (n=$n)" ; return}
  80.    set m [expr round(sqrt($n)+0.5)]
  81.    if {$m>25} {set m 25}
  82.    set least [lindex $val 0]
  83.    set most  [lindex $val [expr $n-1]]
  84.    set maxd(diag$diag) $most
  85.    set mind(diag$diag) $least
  86.    set gap [expr double($most-$least)]
  87.    if {$gap<0.00001} { w_error "Insufficient range (range=$gap)" ; return}
  88.    set gap [expr $gap/$m]
  89.    set e10 [expr round(log10($gap)-0.5)]
  90.    set mant [expr $gap/pow(10,$e10)]
  91.    set gap 1
  92.    if {$mant>1.5} {set gap 2}
  93.    if {$mant>3} {set gap 5}
  94.    if {$mant>7} {set gap 10}
  95.    set gap [expr $gap*pow(10,$e10)]
  96.    if {$gap>.99} {set gap [expr round($gap)]}
  97.    set start [expr round(double($least)/$gap-0.5)]
  98.    set end [expr round(double($most)/$gap+0.5)]
  99.    set last [expr $end-$start]
  100.    w_draw diag$diag create -page 5ix6i \
  101.       -xscale  [expr 5.0/($last+2)]i -yscale 0.5i \
  102.       -menu { Hist {Data -dbox dataInfo}
  103.                    {Save -dbox saveBox -click {saveMclick %w} }
  104.                    {Quit -click exit}
  105.             }
  106.    w_draw diag$diag path (1,1)-([expr $last+1],1) -t0.03i
  107.    set skip 1
  108.    if {$last>5} {set skip 2}
  109.    if {$last>12} {set skip 5}
  110.    for {set i 0} {$i<=$last} {incr i $skip}\
  111.    { w_draw diag$diag text ([expr $i+1],0.5) [expr $gap*($start+$i)]\
  112.      -oc -fn@10p
  113.    }
  114.    for {set i 0} {$i<=$last} {incr i} {set count($i) 0}
  115.    foreach i $val \
  116.    { set x [expr round(double($i)/$gap-0.5)-$start]
  117.      incr count($x)
  118.    }
  119.    set top 0
  120.    for {set i 0} {$i<$last} {incr i}\
  121.    { if {$count($i)>$top} {set top $count($i)}
  122.    }
  123.    set ys [expr 10.0/$top]
  124.    for {set i 0} {$i<$last} {incr i}\
  125.    {  set y [expr $count($i)*$ys+1]
  126.       set x0 [expr $i+1]
  127.       set x1 [expr $i+2]
  128.       w_draw diag$diag path ($x0,1)-($x0,$y)-($x1,$y)-($x1,1). -iyellow -t0.03i
  129.    }
  130.    w_draw diag$diag open
  131.    close $infile
  132.  }
  133.  
  134.  
  135.  
  136.  
  137.