home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 February / PCWorld_2000-02_cd.bin / live / usr / X11R6 / lib / X11 / cbb / graphs / graphcolpos < prev    next >
Text File  |  1998-10-07  |  7KB  |  294 lines
  1. #!/usr/bin/wish -f
  2. #  graphcolpos - Graph 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: graphcolpos,v 2.4 1998/08/14 14:28:48 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.  
  76. proc graphData {graph row col} {
  77.     global data 
  78.  
  79.  
  80.     return $data($row,$col)
  81. }
  82.  
  83. proc graphCols {canvas} {
  84.     return 1
  85. }
  86.  
  87. proc graphRows {canvas} {
  88.     global cnt
  89.     return [expr $cnt-1]
  90. }
  91.  
  92. #
  93. # createColumnGraph
  94. # rows : number of data rows 1 ... rows
  95. # cols : number of data cols 1 ... cols
  96. # data(0,i) contains data labels
  97. # data(i,0) contains abcissa labels
  98. #
  99.  
  100. set barColors(1) "blue"
  101. set barColors(2) "green"
  102. set barColors(3) "red"
  103. set barColors(4) "yellow"
  104. set barColors(5) "brown"
  105.  
  106. proc graphColor {i} {
  107.     global barColors
  108.  
  109.     return $barColors($i)
  110. }
  111.  
  112. proc defGraphMargin {} {
  113.     return 90
  114. }
  115.  
  116. proc defGraphHeight {} {
  117.     return 480
  118. }
  119.  
  120. proc defGraphWidth {} {
  121.     return 640
  122. }
  123.  
  124. proc defGraphWinHeight {} {
  125.     return [expr [defGraphHeight]+2*[defGraphMargin]]
  126. }
  127.  
  128. proc defGraphWinWidth {} {
  129.     return [expr [defGraphWidth]+[defGraphMargin]+[defGraphMargin]]
  130. }
  131.  
  132. proc createColumnGraph {graphName {canv 0}} {
  133.     global graphCnt canvas cbb
  134.  
  135.     set cols [graphCols $graphName]
  136.     set rows [graphRows $graphName]
  137.  
  138.     wm withdraw .
  139.     if {$canv == 0} {
  140.         toplevel .graph$graphCnt
  141.         set canvas [canvas .graph$graphCnt.graph -width [defGraphWinWidth] \
  142.                 -height [defGraphWinHeight] -bg white]
  143.         button .graph$graphCnt.dismiss -text dismiss \
  144.                 -command {destroy .}
  145.         button .graph$graphCnt.print -text Print \
  146.                 -command {
  147.                         toplevel .m
  148.                         message .m.msg -font 12x24 -text "Printing to file colpos.ps"
  149.                         pack .m.msg
  150.                         wm geometry .m +300+300
  151.                         after 2000 {destroy .m}
  152.                         $canvas postscript -file colpos.ps -pagewidth 19c
  153.                 }
  154.  
  155.  
  156.     }
  157.  
  158.     pack $canvas 
  159.     pack .graph$graphCnt.dismiss -fill x
  160.     pack .graph$graphCnt.print -fill x
  161.  
  162.     
  163.     #
  164.     # Width of each bar
  165.     #
  166.     
  167.     set gw [defGraphWidth]
  168.     set gh [defGraphHeight]
  169.     set gm [defGraphMargin]
  170.  
  171.     if {$cols == 1} {
  172.         set cw [expr $gw/$rows]
  173.         set rs $cw
  174.     } else {
  175.         set cw [expr [defGraphWidth]/($rows)/($cols+1)]
  176.         set rs [expr [defGraphWidth]/$rows]
  177.     }
  178.     
  179.     #
  180.     # Find scale factor
  181.     #
  182.     
  183.     set max 0
  184.     for {set j 1} {$j <= $cols} {incr j} {
  185.         for {set i 1} {$i <= $rows} {incr i} {
  186.             set x [graphData graphName $i $j]
  187.             if {$x < 0} {set x [expr -$x]}
  188.             if {$max < $x} {set max $x} 
  189.         }
  190.     }
  191.     for {set i 1} {$i < 10000000} {set i [expr 10*$i]} {
  192.         if {$i < $max} {set divider $i}
  193.     }
  194.     set max [expr ($max/$divider+1)*$divider]
  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: graphcolpos,v $
  278. # Revision 2.4  1998/08/14 14:28:48  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:20  curt
  284. # Updated paths, modified to work with reports.tcl
  285. #
  286. # Revision 2.2  1996/07/13 02:58:35  curt
  287. # Misc. changes.
  288. #
  289. # Revision 2.1  1996/02/27  05:36:14  curt
  290. # Just stumbling around a bit with cvs ... :-(
  291. #
  292. # Revision 2.0  1996/02/27  04:43:23  curt
  293. # Initial 2.0 revision.  (See "Log" files for old history.)
  294.