home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 February / PCWorld_2000-02_cd.bin / live / usr / X11R6 / lib / X11 / cbb / graphs / graphpie < prev    next >
Encoding:
Tcl/Tk script  |  1998-10-07  |  7.4 KB  |  295 lines
  1. #!/usr/bin/wish -f
  2. #  graphpie - Graph pie chart of expenses 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: graphpie,v 2.4 1998/08/14 14:28:49 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.         [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. # createPieChart
  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(0) "darkgreen"
  100. set barColors(0) "chartreuse4"
  101.  
  102. set barColors(1) "gray40"
  103.  
  104. #set barColors(2) "tomato"
  105. set barColors(2) "IndianRed3"
  106.  
  107. set barColors(3) "blue3"
  108. set barColors(4) "red"
  109. set barColors(5) "darkgreen"
  110. set barColors(6) "tan2"
  111. set barColors(7) "SkyBlue4"
  112. set barColors(8) "gold4"
  113. set barColors(9) "tomato"
  114.  
  115.  
  116. proc graphColor {i} {
  117.     global barColors
  118.  
  119.     return $barColors([expr $i % 10])
  120. }
  121.  
  122. proc defGraphMargin {} {
  123.     return 120
  124. }
  125.  
  126. proc defGraphHeight {} {
  127.     return 450
  128. }
  129.  
  130. proc defGraphWidth {} {
  131.     return 450
  132. }
  133.  
  134. proc defGraphWinHeight {} {
  135.     return [expr [defGraphHeight]+2*[defGraphMargin]]
  136. }
  137.  
  138. proc defGraphWinWidth {} {
  139.     return [expr [defGraphWidth]+[defGraphMargin]+[defGraphMargin]]
  140. }
  141.  
  142. proc createPieChart {graphName {canv 0}} {
  143.     global graphCnt use canvas cbb
  144.  
  145.     set cols [graphCols $graphName]
  146.     set rows [graphRows $graphName]
  147.  
  148.     wm withdraw .
  149.     if {$canv == 0} {
  150.         toplevel .graph$graphCnt
  151.         set canvas [canvas .graph$graphCnt.graph -width [defGraphWinWidth] \
  152.                 -height [defGraphWinHeight] -bg gray80]
  153.         button .graph$graphCnt.dismiss -text dismiss \
  154.                 -command {destroy .}
  155.         button .graph$graphCnt.print -text Print \
  156.                 -command {
  157.                         toplevel .m
  158.                         message .m.msg -font 12x24 -text "Printing to file pie.ps"
  159.                         pack .m.msg
  160.                         wm geometry .m +300+300
  161.                         after 2000 {destroy .m}
  162.                         $canvas postscript -file pie.ps -pagewidth 19c
  163.                 }
  164.  
  165.  
  166.     }
  167.  
  168.     pack $canvas 
  169.     pack .graph$graphCnt.dismiss -fill x
  170.     pack .graph$graphCnt.print -fill x
  171.  
  172.     
  173.     #
  174.     # Width of each bar
  175.     #
  176.     
  177.     set gw [defGraphWidth]
  178.     set gh [defGraphHeight]
  179.     set gm [defGraphMargin]
  180.  
  181.     #
  182.     # Find total
  183.     #
  184.     
  185.     set total 0
  186.     for {set j 1} {$j <= $cols} {incr j} {
  187.         for {set i 1} {$i <= $rows} {incr i} {
  188.             set total [expr $total+[graphData $graphName $i 1]]
  189.         }
  190.     }
  191.  
  192.     #
  193.     # Draw axes
  194.     # 
  195.  
  196. #    $canvas create rect $gm $gm [expr $gm+$gw] [expr $gm+$gh] \
  197. #            -fill gray80 -outline gray80
  198.     
  199.     #
  200.     # Draw legends
  201.     #
  202.     
  203.     for {set i 1} {$i <= $cols} {incr i} {
  204. #        $canvas create rect \
  205. #                [expr $gm+$gw+$gm/2] [expr $gm+40*$i] \
  206. #                [expr $gm+$gw+$gm+$gm/2] [expr $gm+40*$i+15] \
  207. #                -fill [graphColor $i]
  208.         $canvas create text \
  209.                 [expr $gm+$gw+$gm/2+10] [expr $gm+40*$i+18] \
  210.                 -anchor n -text [graphData $graphName 0 $i]
  211.         
  212.     }
  213.     
  214.     #
  215.     # Draw pie slices
  216.     #
  217.     
  218.         set parcial 0
  219.         for {set i 1} {$i <= $rows} {incr i} {
  220.             set x [expr -[graphData $graphName $i 1]]
  221.  
  222.             set offset 60
  223.             
  224.             
  225.             set tmp [$canvas create arc [expr $gm-$offset] [expr $gm-$offset] \
  226.                 [expr $gm+$gw+$offset] [expr $gm+$gh+$offset] \
  227.                 -extent 2 \
  228.                 -start [expr 360.0*($parcial+$x/2.0)/$total] \
  229.                 -tag [graphData $graphName $i 0] \
  230.                 -style arc -outline gray80]
  231.             set xx [$canvas bbox [graphData $graphName $i 0]]
  232.             $canvas create arc $gm $gm [expr $gm+$gw] [expr $gm+$gh] \
  233.                 -extent [expr 360.0*$x/$total] \
  234.                 -start [expr 360.0*$parcial/$total] \
  235.                 -fill [graphColor $i]
  236.              set parcial [expr $parcial+$x]
  237.             #
  238.             # Draw labels
  239.             #
  240.  
  241.             set x1 [expr ([lindex $xx 0]+[lindex $xx 2])/2]
  242.             set y1 [expr ([lindex $xx 1]+[lindex $xx 3])/2]
  243.             $canvas delete $tmp
  244.  
  245.             set s "[graphData $graphName $i 0] [format "%4.1f" [expr -(1.0*$x/$total*100)]]"
  246.  
  247.             set offset 0
  248.             set sign 1
  249.             while {1} {
  250.                 set a [$canvas create text $x1 [expr $y1+($offset*$sign)]\
  251.                         -font $cbb(msg_text_font) \
  252.                         -text "$s%" \
  253.                         -fill [graphColor $i]]
  254.                 set x [$canvas bbox $a]
  255.                 set ll [$canvas find overlap \
  256.                         [lindex $x 0] [lindex $x 1] \
  257.                         [lindex $x 2] [lindex $x 3]]
  258.                 if {[llength $ll] == 1} {break}
  259.                 $canvas delete $a
  260.                 set sign [expr -$sign]
  261.                 incr offset
  262.              }
  263.             
  264. #            set tx [expr $cols*$cw/2+($i-1)*$rs+$gm]
  265. #            set tt [graphData $graphName $i 0] 
  266. #            set tt [string range $tt 0 7]
  267. #            $canvas create text $tx \
  268. #                        [expr $zero+6+(($i-1) % $nlevels)*13] -anchor n  \
  269. #                        -text $tt
  270.         }
  271.  
  272. }
  273. set graphCnt 0
  274. createPieChart lixo 0
  275.  
  276.  
  277. # ----------------------------------------------------------------------------
  278. # $Log: graphpie,v $
  279. # Revision 2.4  1998/08/14 14:28:49  curt
  280. # Added desc-pie graph.
  281. # Added option to eliminate splash screen.
  282. # Other misc. tweaks and bug fixes.
  283. #
  284. # Revision 2.3  1996/12/13 01:25:21  curt
  285. # Updated paths, modified to work with reports.tcl
  286. #
  287. # Revision 2.2  1996/07/13 02:58:36  curt
  288. # Misc. changes.
  289. #
  290. # Revision 2.1  1996/02/27  05:36:15  curt
  291. # Just stumbling around a bit with cvs ... :-(
  292. #
  293. # Revision 2.0  1996/02/27  04:43:24  curt
  294. # Initial 2.0 revision.  (See "Log" files for old history.)
  295.