home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 February / PCWorld_2000-02_cd.bin / live / usr / X11R6 / lib / X11 / cbb / graphs / graphbal < prev    next >
Encoding:
Tcl/Tk script  |  1998-10-07  |  6.9 KB  |  281 lines
  1. #!/usr/bin/wish -f
  2. #  graphbal - Graph running balance
  3. #
  4. #  Written by Arlindo L. Oliveira (aml@inesc.pt)
  5. #
  6. #  Copyright (C) 1996  Arlindo L. Oliveira (aml@inesc.pt)
  7. #
  8. # $Id: graphbal,v 2.6 1998/08/14 14:30:25 curt Exp $
  9. # (Log is kept at end of this file)
  10.  
  11.  
  12. set data(0,0) " "
  13. set data(0,1) " "
  14. set cnt 1
  15. while {[gets stdin line] >= 1} {
  16.      set data($cnt,0) [lindex $line 0]
  17.      set data($cnt,1) [lindex $line 1]
  18.      if {$data($cnt,0) == $data([expr $cnt-1],0)} {
  19.          set data([expr $cnt-1],1)  $data($cnt,1)
  20.      } else {
  21.          incr cnt
  22.      }
  23. }
  24.  
  25.  
  26. proc graphData {graph row col} {
  27.     global data
  28.  
  29.  
  30.     return $data($row,$col)
  31. }
  32.  
  33.  
  34. proc graphCols {canvas} {
  35.     return 1
  36. }
  37.  
  38.  
  39. proc graphRows {canvas} {
  40.     global cnt
  41.     return [expr $cnt-1]
  42. }
  43.  
  44.  
  45. #
  46. # createColumnGraph
  47. # rows : number of data rows 1 ... rows
  48. # cols : number of data cols 1 ... cols
  49. # data(0,i) contains data labels
  50. # data(i,0) contains abcissa labels
  51. #
  52.  
  53. set barColors(1) "blue"
  54. set barColors(2) "green"
  55. set barColors(3) "red"
  56. set barColors(4) "yellow"
  57. set barColors(5) "brown"
  58.  
  59. proc graphColor {i} {
  60.     global barColors
  61.  
  62.     return $barColors($i)
  63. }
  64.  
  65. proc defGraphMargin {} {
  66.     return 60
  67. }
  68.  
  69. proc defGraphHeight {} {
  70.     return 480
  71. }
  72.  
  73. proc defGraphWidth {} {
  74.     return 640
  75. }
  76.  
  77. proc defGraphWinHeight {} {
  78.     return [expr [defGraphHeight]+2*[defGraphMargin]]
  79. }
  80.  
  81. proc defGraphWinWidth {} {
  82.     return [expr [defGraphWidth]+[defGraphMargin]+[defGraphMargin]]
  83. }
  84.  
  85. proc cutZero {st} {
  86.     if {[string range $st 0 0] == 0} {
  87.         return [string range $st 1 2]
  88.     } else {
  89.         return $st
  90.     }
  91. }
  92.  
  93. set months(01) Jan
  94. set months(02) Feb
  95. set months(03) Mar
  96. set months(04) Apr
  97. set months(05) May
  98. set months(06) Jun
  99. set months(07) Jul
  100. set months(08) Aug
  101. set months(09) Sep
  102. set months(10) Oct
  103. set months(11) Nov
  104. set months(12) Dec
  105.  
  106. proc month {date} {
  107.     global months
  108.     return $months([string range $date 4 5])
  109. }
  110.  
  111. proc daysBetween {first last} {
  112.     set y1 [string range $first 0 3]
  113.     set m1 [cutZero [string range $first 4 5]]
  114.     set d1 [cutZero [string range $first 6 7]]
  115.  
  116.     set y2 [string range $last 0 3]
  117.     set m2 [cutZero [string range $last 4 5]]
  118.     set d2 [cutZero [string range $last 6 7]]
  119.  
  120.     
  121.  
  122.     return [expr 365*($y2-$y1) + 30*($m2-$m1) + $d2-$d1]
  123. }
  124.  
  125. proc createColumnGraph {graphName {canv 0}} {
  126.     global graphCnt canvas
  127.  
  128.     set cols [graphCols $graphName]
  129.     set rows [graphRows $graphName]
  130.  
  131.     wm withdraw .
  132.     if {$canv == 0} {
  133.         toplevel .graph$graphCnt
  134.         set canvas [canvas .graph$graphCnt.graph -width [defGraphWinWidth] \
  135.                 -height [defGraphWinHeight] -bg white]
  136.         button .graph$graphCnt.dismiss -text dismiss \
  137.                 -command {destroy .}
  138.         button .graph$graphCnt.print -text Print \
  139.                 -command {
  140.                         toplevel .m
  141.                         message .m.msg -font 12x24 -text "Printing to file bal.ps"
  142.                         pack .m.msg
  143.                         wm geometry .m +300+300
  144.                         after 2000 {destroy .m}
  145.                         $canvas postscript -file bal.ps -pagewidth 19c
  146.                 }
  147.  
  148.  
  149.     }
  150.  
  151.     pack $canvas 
  152.     pack .graph$graphCnt.dismiss -fill x
  153.     pack .graph$graphCnt.print -fill x
  154.  
  155.     
  156.     #
  157.     # Width of each bar
  158.     #
  159.     
  160.     set gw [defGraphWidth]
  161.     set gh [defGraphHeight]
  162.     set gm [defGraphMargin]
  163.  
  164.     $canvas create rectangle $gm $gm [expr $gm+$gw] [expr $gm+$gh] \
  165.         -fill gray80 -outline gray80
  166.  
  167.  
  168.     set max 0
  169.     set min 0
  170.     for {set j 1} {$j <= $cols} {incr j} {
  171.         for {set i 1} {$i <= $rows} {incr i} {
  172.             set x [graphData graphName $i $j]
  173.             if {$x < $min} {set min $x}
  174.             if {$x > $max} {set max $x} 
  175.         }
  176.     }
  177.  
  178.     set max_min_diff 1.0
  179.     if {$max != $min} {set max_min_diff ($max-$min)}
  180.  
  181.     set yscale [expr $gh/1.0/($max_min_diff)]
  182.     set zero [expr $gh+$gm+$min/($max_min_diff)*$gh]
  183.     set nlevels [expr $rows/8]
  184.     set ndays [daysBetween [graphData $graphName 1 0] \
  185.         [graphData $graphName $rows 0]]
  186.     if {$ndays !=  0} {
  187.     set xscale [expr $gw/1.0/$ndays]
  188.     } else {
  189.     set xscale [expr $gw/1.0]    
  190.     }
  191.  
  192.  
  193.     #
  194.     # Draw axes
  195.     # 
  196.  
  197.     $canvas create line $gm $zero [expr $gm+$gw] $zero
  198.     $canvas create line $gm [expr $gm+$gh] $gm $gm  -arrow last
  199.  
  200.     for {set i -1} {$i < 20} {incr i} {
  201.         set val [expr $i*1000]
  202.         if {$val < $max && $val > $min} {
  203.             $canvas create text [expr $gm-8] [expr $zero-$val*$yscale] \
  204.             -text $val -anchor e
  205.             $canvas create line $gm [expr $zero-$val*$yscale] \
  206.                                [expr $gm-5] [expr $zero-$val*$yscale]
  207.         }
  208.     } 
  209.  
  210.     #
  211.     # Draw a tic marking the final balance for period graphed.
  212.     #
  213.  
  214.     set finbal [graphData $graphName $rows 1]
  215.     $canvas create line $gm [expr $zero-$finbal*$yscale] \
  216.                   [expr $gm-5] [expr $zero-$finbal*$yscale] -fill red
  217.  
  218.  
  219.     set prevmt [month [graphData $graphName 1  0]]
  220.     for {set i 2} {$i <= $rows} {incr i} {
  221.         set x1 [daysBetween [graphData $graphName 1  0] \
  222.                             [graphData $graphName [expr $i-1] 0]]
  223.         set x2 [daysBetween [graphData $graphName 1  0] \
  224.                             [graphData $graphName $i 0]]
  225.         if {[graphData $graphName $i 1] > 0} {
  226.             set color red 
  227.         }  else {
  228.             set color red
  229.         }
  230.         $canvas create polygon \
  231.                [expr $gm+$x1*$xscale] \
  232.                [expr $zero-[graphData $graphName [expr $i-1] 1]*$yscale] \
  233.                [expr $gm+$x2*$xscale] \
  234.                [expr $zero-[graphData $graphName $i 1]*$yscale] \
  235.                [expr $gm+$x2*$xscale] \
  236.                $zero \
  237.                [expr $gm+$x1*$xscale] \
  238.                $zero \
  239.                -fill $color
  240.                                  
  241.         set mt [month [graphData $graphName $i 0]]
  242.         if {$mt != $prevmt} {
  243.             $canvas create text [expr $gm+$x2*$xscale+2] [expr $gm+$gh+10] \
  244.                   -anchor w -text $mt
  245.             $canvas create line [expr $gm+$x2*$xscale] [expr $gm+$gh+10] \
  246.                                 [expr $gm+$x2*$xscale] $zero
  247.             set prevmt $mt
  248.         }
  249.     }
  250.  
  251.     
  252. }
  253. set graphCnt 0
  254. createColumnGraph lixo 0
  255.  
  256.  
  257. # ----------------------------------------------------------------------------
  258. # $Log: graphbal,v $
  259. # Revision 2.6  1998/08/14 14:30:25  curt
  260. # Patches to the graphs/graphbal script to avoid divide by zero in certain
  261. # circumstances.
  262. #
  263. # Revision 2.5  1997/05/06 02:33:51  curt
  264. # Added "require memorized".
  265. #
  266. # Revision 2.4  1997/05/06 02:06:20  curt
  267. # Added patches by Ken Latta <ken@kdl.sc.scruznet.comt> to fix problems
  268. # with the running balance graph.
  269. #
  270. # Revision 2.3  1996/12/13 01:25:19  curt
  271. # Updated paths, modified to work with reports.tcl
  272. #
  273. # Revision 2.2  1996/07/13 02:58:33  curt
  274. # Misc. changes.
  275. #
  276. # Revision 2.1  1996/02/27  05:36:12  curt
  277. # Just stumbling around a bit with cvs ... :-(
  278. #
  279. # Revision 2.0  1996/02/27  04:43:22  curt
  280. # Initial 2.0 revision.  (See "Log" files for old history.)
  281.