home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 February / PCWorld_2000-02_cd.bin / live / usr / X11R6 / lib / X11 / cbb / graphs / descpie < prev    next >
Encoding:
Tcl/Tk script  |  1998-10-07  |  7.3 KB  |  283 lines
  1. #!/usr/bin/wish -f
  2. #  descpie - Graph pie chart of expenses by description inside given category
  3. #
  4. #  Written by Alexandr E. Bravo (abravo@tctube.spb.su)
  5. #  Copyright (C) 1997  Alexandr E. Bravo (abravo@tctube.spb.su)
  6. #  Based on script graphpie written by Arlindo L. Oliveira (aml@inesc.pt)
  7. #                  Copyright (C) 1996  Arlindo L. Oliveira (aml@inesc.pt)
  8. #
  9. # $Id: descpie,v 1.1.1.1 1998/10/07 07:11:44 phil Exp $
  10. # (Log is kept at end of this file)
  11.  
  12. if { [file exists "$env(HOME)/.cbbrc.tcl"] } {
  13.       source "$env(HOME)/.cbbrc.tcl"
  14.    }
  15.  
  16. set data(0,1) " "
  17. set desc " "
  18. set cnt 1
  19. set dcnt 1
  20. frame .check
  21. set iter 1
  22.  
  23. frame .check.list_$iter
  24. button .check.ok -text Ok -command {destroy .check}
  25. pack .check.ok -side top -fill x
  26. pack .check.list_$iter -side left -anchor n
  27.  
  28. while {[gets stdin line] >= 1 && [lindex $line 0] != "!" } {
  29.      set desc [lindex $line 0]
  30.      
  31. # This line here is different for the ones that take both pos and neg
  32.  
  33. # option add *font "-cronyx-helvetica-bold-r-normal-*-*-130-*-*-*-*-*-*"
  34.  
  35.          option add *font $cbb(msg_text_font)
  36.          radiobutton .check.list_$iter.but_$cnt \
  37.                -text $desc \
  38.                -variable desc -relief flat -value $desc \
  39.            -relief flat 
  40.  
  41. #               -font "-cronyx-helvetica-bold-r-normal-*-*-130-*-*-*-*-*-*" 
  42.  
  43.          pack .check.list_$iter.but_$cnt -anchor w
  44.  
  45.          if {$cnt % 20 == 0} {
  46.              incr iter
  47.              frame .check.list_$iter
  48.              pack .check.list_$iter -side left -anchor n
  49.          }
  50.          incr cnt   
  51.      
  52. }
  53. pack .check
  54. tkwait window .check
  55.  
  56.              while {[gets stdin line] >= 1 } {
  57.                 if { [lindex $line 0] == $desc } { 
  58.           set data($dcnt,0) [lindex $line 1]
  59.                   set data($dcnt,1) [lindex $line 2]
  60.           incr dcnt
  61.                 }
  62.              }
  63.  
  64. set cnt $dcnt
  65.  
  66. proc graphData {graph row col} {
  67.     global data
  68.  
  69.  
  70.     return $data($row,$col)
  71. }
  72.  
  73. proc graphCols {canvas} {
  74.     return 1
  75. }
  76.  
  77. proc graphRows {canvas} {
  78.     global cnt
  79.     return [expr $cnt-1]
  80. }
  81.  
  82. #
  83. # createPieChart
  84. # rows : number of data rows 1 ... rows
  85. # cols : number of data cols 1 ... cols
  86. # data(0,i) contains data labels
  87. # data(i,0) contains abcissa labels
  88. #
  89.  
  90. set barColors(0) "darkgreen"
  91. set barColors(1) "gray40"
  92. set barColors(2) "IndianRed3"
  93. set barColors(3) "blue3"
  94. set barColors(4) "red"
  95. set barColors(5) "chartreuse4"
  96. set barColors(6) "SkyBlue4"
  97. set barColors(7) "gold4"
  98.  
  99. proc graphColor {i} {
  100.     global barColors
  101.  
  102.     return $barColors([expr $i % 8])
  103. }
  104.  
  105. proc defGraphMargin {} {
  106.     return 120
  107. }
  108.  
  109. proc defGraphHeight {} {
  110.     return 450
  111. }
  112.  
  113. proc defGraphWidth {} {
  114.     return 450
  115. }
  116.  
  117. proc defGraphWinHeight {} {
  118.     return [expr [defGraphHeight]+2*[defGraphMargin]]
  119. }
  120.  
  121. proc defGraphWinWidth {} {
  122.     return [expr [defGraphWidth]+[defGraphMargin]+[defGraphMargin]]
  123. }
  124.  
  125. proc createPieChart {graphName {canv 0}} {
  126.     global graphCnt use canvas cbb
  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 gray80]
  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 pie.ps"
  142.                         pack .m.msg
  143.                         wm geometry .m +300+300
  144.                         after 2000 {destroy .m}
  145.                         $canvas postscript -file pie.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.     #
  165.     # Find total
  166.     #
  167.     
  168.     set total 0
  169.     for {set j 1} {$j <= $cols} {incr j} {
  170.         for {set i 1} {$i <= $rows} {incr i} {
  171.             set total [expr $total+[graphData $graphName $i 1]]
  172.         }
  173.     }
  174.  
  175.     #
  176.     # Draw total
  177.     #
  178.  
  179.     set x2 [expr $gm + $gw/2.0]
  180.     set total2 [expr $total]
  181.     if { $total < 0 } {
  182.                 set total2 [expr -1.0*$total]
  183.               }
  184.     $canvas create text $x2 40 -fill "red" \
  185.                   -font $cbb(button_font) -text "$graphName=$total2" 
  186.  
  187.       
  188.     #
  189.     # Draw axes
  190.     # 
  191.  
  192. #    $canvas create rect $gm $gm [expr $gm+$gw] [expr $gm+$gh] \
  193. #            -fill gray80 -outline gray80
  194.     
  195.     #
  196.     # Draw legends
  197.     #
  198.     
  199.     for {set i 1} {$i <= $cols} {incr i} {
  200. #        $canvas create rect \
  201. #                [expr $gm+$gw+$gm/2] [expr $gm+40*$i] \
  202. #                [expr $gm+$gw+$gm+$gm/2] [expr $gm+40*$i+15] \
  203. #                -fill [graphColor $i]
  204.         $canvas create text \
  205.                 [expr $gm+$gw+$gm/2+10] [expr $gm+40*$i+18] \
  206.                 -anchor n -text [graphData $graphName 0 $i]
  207.         
  208.     }
  209.     
  210.     #
  211.     # Draw pie slices
  212.     #
  213.     
  214.         set parcial 0
  215.         for {set i 1} {$i <= $rows} {incr i} {
  216.             set x [expr -[graphData $graphName $i 1]]
  217.  
  218.             set offset 50
  219.             
  220.             
  221.             set tmp [$canvas create arc [expr $gm-$offset] [expr $gm-$offset] \
  222.                 [expr $gm+$gw+$offset] [expr $gm+$gh+$offset] \
  223.                 -extent 2 \
  224.                 -start [expr 360.0*($parcial+$x/2.0)/$total] \
  225.                 -tag [graphData $graphName $i 0] \
  226.                 -style arc -outline gray80]
  227.             set xx [$canvas bbox [graphData $graphName $i 0]]
  228.             $canvas create arc $gm $gm [expr $gm+$gw] [expr $gm+$gh] \
  229.                 -extent [expr 360.0*$x/$total] \
  230.                 -start [expr 360.0*$parcial/$total] \
  231.                 -fill [graphColor $i]
  232.              set parcial [expr $parcial+$x]
  233.             #
  234.             # Draw labels
  235.             #
  236.  
  237.             set x1 [expr ([lindex $xx 0]+[lindex $xx 2])/2]
  238.             set y1 [expr ([lindex $xx 1]+[lindex $xx 3])/2]
  239.             $canvas delete $tmp
  240.  
  241.             set s "[graphData $graphName $i 0] [format "%4.1f" [expr -(1.0*$x/$total*100)]]"
  242.  
  243.             set offset 0
  244.             set sign 1
  245.             while {1} {
  246.                 set a [$canvas create text $x1 [expr $y1+($offset*$sign)]\
  247.                   -font $cbb(fixed_font) \
  248.                         -text "$s%" \
  249.                         -fill [graphColor $i]]
  250.                 set x [$canvas bbox $a]
  251.                 set ll [$canvas find overlap \
  252.                         [lindex $x 0] [lindex $x 1] \
  253.                         [lindex $x 2] [lindex $x 3]]
  254.                 if {[llength $ll] == 1} {break}
  255.                 $canvas delete $a
  256.                 set sign [expr -$sign]
  257.                 incr offset
  258.              }
  259.             
  260. #                  -font "-cronyx-helvetica-bold-r-normal-*-*-130-*-*-*-*-*-*" \
  261. #            set tx [expr $cols*$cw/2+($i-1)*$rs+$gm]
  262. #            set tt [graphData $graphName $i 0] 
  263. #            set tt [string range $tt 0 7]
  264. #            $canvas create text $tx \
  265. #                        [expr $zero+6+(($i-1) % $nlevels)*13] -anchor n  \
  266. #                        -text $tt
  267.         }
  268.  
  269. }
  270. set graphCnt 0
  271. #createPieChart lixo 0
  272. createPieChart $desc 0
  273.  
  274.  
  275. # ----------------------------------------------------------------------------
  276. # $Log: descpie,v $
  277. # Revision 1.1.1.1  1998/10/07 07:11:44  phil
  278. #
  279. #
  280. # Revision 1.1  1998/08/14 14:24:03  curt
  281. # Initial revision.
  282. #
  283.