home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 February / PCWorld_2000-02_cd.bin / live / usr / X11R6 / lib / X11 / cbb / graphs / graphcol < prev    next >
Encoding:
Tcl/Tk script  |  1998-10-07  |  7.3 KB  |  294 lines
  1. #!/usr/bin/wish -f
  2. #  graphcol - Graph movements by category
  3. #
  4. #  Written by Arlindo L. Oliveira (aml@inesc.pt)
  5. #
  6. #  Copyright (C) 1996  Arlindo L. Oliveira (aml@inesc.pt)
  7. #
  8. # $Id: graphcol,v 2.4 1998/08/14 14:28:47 curt Exp $
  9. # (Log is kept at end of this file)
  10.  
  11.  
  12. proc skip {cnt} {
  13.    global use
  14.         
  15.    set use($cnt) 0
  16. }
  17.  
  18.  
  19. if { [file exists "$env(HOME)/.cbbrc.tcl"] } {
  20.     source "$env(HOME)/.cbbrc.tcl"            
  21. }
  22.  
  23.  
  24. set data(0,1) " "
  25. set cnt 1
  26. frame .check
  27. set iter 1
  28.  
  29. set skipped 0
  30.  
  31. frame .check.list_$iter
  32. button .check.ok -text Ok -command {destroy .check}
  33. button .check.clear -text "Clear all" -command \
  34.         {for {set ii 1} {$ii < $cnt} {incr ii} {set use($ii) 0}}
  35. button .check.set -text "Set all" -command \
  36.         {for {set ii 1} {$ii < $cnt} {incr ii} {set use($ii) 1}}
  37. pack .check.ok -side top -fill x
  38. pack .check.clear -side top -fill x
  39. pack .check.set -side top -fill x
  40. pack .check.list_$iter -side left -anchor n
  41. while {[gets stdin line] >= 1} {
  42.      set data($cnt,0) [lindex $line 0]
  43.      set data($cnt,1) [lindex $line 1]
  44.      
  45.          set use($cnt) 1
  46. # This line here is different for the ones that take both pos and neg
  47. #         if {$data($cnt,1) > 0  || }
  48.           if {[string range $data($cnt,0) 0 0] == "\["} { skip $cnt }
  49.  
  50.          checkbutton .check.list_$iter.but_$cnt -variable use($cnt) \
  51.          -font $cbb(msg_text_font) \
  52.          -text $data($cnt,0)
  53.          pack .check.list_$iter.but_$cnt -anchor w
  54.          if {$cnt % 20 == 0} {
  55.              incr iter
  56.              frame .check.list_$iter
  57.              pack .check.list_$iter -side left -anchor n
  58.          }
  59.          incr cnt   
  60.      
  61. }
  62. pack .check
  63. tkwait window .check
  64. for {set i 1} {$i < $cnt} {incr i} {
  65.    if {$use($i) == 0} {
  66.        incr skipped
  67.    } else {
  68.        set data([expr $i-$skipped],0) $data($i,0)
  69.        set data([expr $i-$skipped],1) $data($i,1)
  70.    }
  71. }
  72.  
  73. set cnt [expr $cnt-$skipped]
  74.  
  75. proc graphData {graph row col} {
  76.     global data
  77.  
  78.  
  79.     return $data($row,$col)
  80. }
  81.  
  82. proc graphCols {canvas} {
  83.     return 1
  84. }
  85.  
  86. proc graphRows {canvas} {
  87.     global cnt
  88.     return [expr $cnt-1]
  89. }
  90.  
  91. #
  92. # createColumnGraph
  93. # rows : number of data rows 1 ... rows
  94. # cols : number of data cols 1 ... cols
  95. # data(0,i) contains data labels
  96. # data(i,0) contains abcissa labels
  97. #
  98.  
  99. set barColors(1) "blue"
  100. set barColors(2) "green"
  101. set barColors(3) "red"
  102. set barColors(4) "yellow"
  103. set barColors(5) "brown"
  104.  
  105. proc graphColor {i} {
  106.     global barColors
  107.  
  108.     return $barColors($i)
  109. }
  110.  
  111. proc defGraphMargin {} {
  112.     return 90
  113. }
  114.  
  115. proc defGraphHeight {} {
  116.     return 480
  117. }
  118.  
  119. proc defGraphWidth {} {
  120.     return 640
  121. }
  122.  
  123. proc defGraphWinHeight {} {
  124.     return [expr [defGraphHeight]+2*[defGraphMargin]]
  125. }
  126.  
  127. proc defGraphWinWidth {} {
  128.     return [expr [defGraphWidth]+[defGraphMargin]+[defGraphMargin]]
  129. }
  130.  
  131. proc createColumnGraph {graphName {canv 0}} {
  132.     global graphCnt canvas cbb
  133.  
  134.     set cols [graphCols $graphName]
  135.     set rows [graphRows $graphName]
  136.  
  137.     wm withdraw .
  138.     if {$canv == 0} {
  139.         toplevel .graph$graphCnt
  140.         set canvas [canvas .graph$graphCnt.graph -width [defGraphWinWidth] \
  141.                 -height [defGraphWinHeight] -bg white]
  142.         button .graph$graphCnt.dismiss -text dismiss \
  143.                 -command {destroy .}
  144.         button .graph$graphCnt.print -text Print \
  145.                 -command {
  146.                         toplevel .m
  147.                         message .m.msg -font 12x24 -text "Printing to file col.ps"
  148.                         pack .m.msg
  149.                         wm geometry .m +300+300
  150.                         after 2000 {destroy .m}
  151.                         $canvas postscript -file col.ps -pagewidth 19c
  152.                 }
  153.  
  154.  
  155.     }
  156.  
  157.     pack $canvas 
  158.     pack .graph$graphCnt.dismiss -fill x
  159.     pack .graph$graphCnt.print -fill x
  160.  
  161.     
  162.     #
  163.     # Width of each bar
  164.     #
  165.     
  166.     set gw [defGraphWidth]
  167.     set gh [defGraphHeight]
  168.     set gm [defGraphMargin]
  169.  
  170.     if {$cols == 1} {
  171.         set cw [expr $gw/$rows]
  172.         set rs $cw
  173.     } else {
  174.         set cw [expr [defGraphWidth]/($rows)/($cols+1)]
  175.         set rs [expr [defGraphWidth]/$rows]
  176.     }
  177.     
  178.     #
  179.     # Find scale factor
  180.     #
  181.     
  182.     set max 0
  183.     for {set j 1} {$j <= $cols} {incr j} {
  184.         for {set i 1} {$i <= $rows} {incr i} {
  185.             set x [graphData graphName $i $j]
  186.             if {$x < 0} {set x [expr -$x]}
  187.             if {$max < $x} {set max $x} 
  188.         }
  189.     }
  190.     for {set i 1} {$i < 10000000} {set i [expr 10*$i]} {
  191.         if {$i < $max} {set divider $i}
  192.     }
  193.     set max [expr ($max/$divider+1)*$divider]
  194.  
  195.     set yscale [expr $gh/1.0/$max]
  196.     set zero [expr $gh+$gm]
  197.     set nlevels [expr $rows/8]
  198.     if {$nlevels == 0} {set nlevels 1}
  199.  
  200.  
  201.     #
  202.     # Draw axes
  203.     # 
  204.  
  205.     $canvas create rect $gm $zero [expr $gm+$gw] [expr $zero-$gh] \
  206.             -fill gray80 -outline gray80
  207.     $canvas create line $gm $zero [expr $gm+$gw] $zero
  208.     $canvas create line $gm $zero $gm [expr $zero-$gh-12]  -arrow last
  209.     
  210.     for {set i 0} {$i <= 10} {incr i} {
  211.         set label [expr $i/10.0*$max]
  212.         $canvas create text [expr $gm-6] [expr $gm+$gh-$label/$max*$gh] \
  213.                 -anchor e -text $label
  214.         $canvas create line \
  215.                 [expr $gm-4] [expr $gm+$gh-$label/$max*$gh] \
  216.                 [expr $gm] [expr $gm+$gh-$label/$max*$gh]
  217.     }
  218.     
  219.     #
  220.     # Draw legends
  221.     #
  222.     
  223.     for {set i 1} {$i <= $cols} {incr i} {
  224. #        $canvas create rect \
  225. #                [expr $gm+$gw+$gm/2] [expr $gm+40*$i] \
  226. #                [expr $gm+$gw+$gm+$gm/2] [expr $gm+40*$i+15] \
  227. #                -fill [graphColor $i]
  228.         $canvas create text \
  229.                 [expr $gm+$gw+$gm/2+10] [expr $gm+40*$i+18] \
  230.                 -anchor n -text [graphData $graphName 0 $i]
  231.         
  232.     }
  233.     
  234.     #
  235.     # Draw rectangles
  236.     #
  237.     
  238.     for {set j 1} {$j <= $cols} {incr j} {
  239.         for {set i 1} {$i <= $rows} {incr i} {
  240.             set x [expr -[graphData $graphName $i $j]]
  241.             if {$x < 0} {
  242.                 set x [expr -$x]
  243.                 set color red
  244.             } else {
  245.                 set color blue
  246.             }
  247.             set x1 [expr ($i-1)*$rs+($j-1)*$cw+$gm]
  248.             set y1 $zero
  249.             set x2 [expr ($i-1)*$rs+$cw*$j+$gm]
  250.             set y2 [expr $zero-$yscale*$x]
  251.  
  252.             
  253.             #
  254.             # Draw labels
  255.             #
  256.             
  257.             if {$j == 1} {
  258.                 
  259.                 set tx [expr $cols*$cw/2+($i-1)*$rs+$gm]
  260.                 set tt [graphData $graphName $i 0] 
  261.                 set tt [string range $tt 0 7]
  262.                 $canvas create text $tx \
  263.                         [expr $zero+6+(($i-1) % $nlevels)*13] -anchor n  \
  264.                         -font $cbb(msg_text_font) \
  265.                         -text $tt
  266.             }
  267.  
  268.             $canvas create rect $x1 $y1 $x2 $y2 -fill $color
  269.         }
  270.     }
  271. }
  272. set graphCnt 0
  273. createColumnGraph lixo 0
  274.  
  275.  
  276. # ----------------------------------------------------------------------------
  277. # $Log: graphcol,v $
  278. # Revision 2.4  1998/08/14 14:28:47  curt
  279. # Added desc-pie graph.
  280. # Added option to eliminate splash screen.
  281. # Other misc. tweaks and bug fixes.
  282. #
  283. # Revision 2.3  1996/12/13 01:25:19  curt
  284. # Updated paths, modified to work with reports.tcl
  285. #
  286. # Revision 2.2  1996/07/13 02:58:34  curt
  287. # Misc. changes.
  288. #
  289. # Revision 2.1  1996/02/27  05:36:13  curt
  290. # Just stumbling around a bit with cvs ... :-(
  291. #
  292. # Revision 2.0  1996/02/27  04:43:22  curt
  293. # Initial 2.0 revision.  (See "Log" files for old history.)
  294.