#!/usr/bin/wish4.2 # graphcolpos - Graph expenses by category # # Written by Arlindo L. Oliveira (aml@inesc.pt) # # Copyright (C) 1996 Arlindo L. Oliveira (aml@inesc.pt) # # $Id: graphcolpos,v 1.1.1.1 1999/12/18 02:06:55 curt Exp $ proc skip {cnt} { global use set use($cnt) 0 } if { [file exists "$env(HOME)/.cbbrc.tcl"] } { source "$env(HOME)/.cbbrc.tcl" } set data(0,1) " " set cnt 1 frame .check set iter 1 set skipped 0 frame .check.list_$iter button .check.ok -text Ok -command {destroy .check} button .check.clear -text "Clear all" -command \ {for {set ii 1} {$ii < $cnt} {incr ii} {set use($ii) 0}} button .check.set -text "Set all" -command \ {for {set ii 1} {$ii < $cnt} {incr ii} {set use($ii) 1}} pack .check.ok -side top -fill x pack .check.clear -side top -fill x pack .check.set -side top -fill x pack .check.list_$iter -side left -anchor n while {[gets stdin line] >= 1} { set data($cnt,0) [lindex $line 0] set data($cnt,1) [lindex $line 1] set use($cnt) 1 # This line here is different for the ones that take both pos and neg if {$data($cnt,1) > 0 || \ [string range $data($cnt,0) 0 0] == "\["} { skip $cnt } checkbutton .check.list_$iter.but_$cnt -variable use($cnt) \ -font $cbb(msg_text_font) \ -text $data($cnt,0) pack .check.list_$iter.but_$cnt -anchor w if {$cnt % 20 == 0} { incr iter frame .check.list_$iter pack .check.list_$iter -side left -anchor n } incr cnt } pack .check tkwait window .check for {set i 1} {$i < $cnt} {incr i} { if {$use($i) == 0} { incr skipped } else { set data([expr $i-$skipped],0) $data($i,0) set data([expr $i-$skipped],1) $data($i,1) } } set cnt [expr $cnt-$skipped] proc graphData {graph row col} { global data return $data($row,$col) } proc graphCols {canvas} { return 1 } proc graphRows {canvas} { global cnt return [expr $cnt-1] } # # createColumnGraph # rows : number of data rows 1 ... rows # cols : number of data cols 1 ... cols # data(0,i) contains data labels # data(i,0) contains abcissa labels # set barColors(1) "blue" set barColors(2) "green" set barColors(3) "red" set barColors(4) "yellow" set barColors(5) "brown" proc graphColor {i} { global barColors return $barColors($i) } proc defGraphMargin {} { return 90 } proc defGraphHeight {} { return 480 } proc defGraphWidth {} { return 640 } proc defGraphWinHeight {} { return [expr [defGraphHeight]+2*[defGraphMargin]] } proc defGraphWinWidth {} { return [expr [defGraphWidth]+[defGraphMargin]+[defGraphMargin]] } proc createColumnGraph {graphName {canv 0}} { global graphCnt canvas cbb set cols [graphCols $graphName] set rows [graphRows $graphName] wm withdraw . if {$canv == 0} { toplevel .graph$graphCnt set canvas [canvas .graph$graphCnt.graph -width [defGraphWinWidth] \ -height [defGraphWinHeight] -bg white] button .graph$graphCnt.dismiss -text dismiss \ -command {destroy .} button .graph$graphCnt.print -text Print \ -command { toplevel .m message .m.msg -font 12x24 -text "Printing to file colpos.ps" pack .m.msg wm geometry .m +300+300 after 2000 {destroy .m} $canvas postscript -file colpos.ps -pagewidth 19c } } pack $canvas pack .graph$graphCnt.dismiss -fill x pack .graph$graphCnt.print -fill x # # Width of each bar # set gw [defGraphWidth] set gh [defGraphHeight] set gm [defGraphMargin] if {$cols == 1} { set cw [expr $gw/$rows] set rs $cw } else { set cw [expr [defGraphWidth]/($rows)/($cols+1)] set rs [expr [defGraphWidth]/$rows] } # # Find scale factor # set max 0 for {set j 1} {$j <= $cols} {incr j} { for {set i 1} {$i <= $rows} {incr i} { set x [graphData graphName $i $j] if {$x < 0} {set x [expr -$x]} if {$max < $x} {set max $x} } } for {set i 1} {$i < 10000000} {set i [expr 10*$i]} { if {$i < $max} {set divider $i} } set max [expr ($max/$divider+1)*$divider] set yscale [expr $gh/1.0/$max] set zero [expr $gh+$gm] set nlevels [expr $rows/8] if {$nlevels == 0} {set nlevels 1} # # Draw axes # $canvas create rect $gm $zero [expr $gm+$gw] [expr $zero-$gh] \ -fill gray80 -outline gray80 $canvas create line $gm $zero [expr $gm+$gw] $zero $canvas create line $gm $zero $gm [expr $zero-$gh-12] -arrow last for {set i 0} {$i <= 10} {incr i} { set label [expr $i/10.0*$max] $canvas create text [expr $gm-6] [expr $gm+$gh-$label/$max*$gh] \ -anchor e -text $label $canvas create line \ [expr $gm-4] [expr $gm+$gh-$label/$max*$gh] \ [expr $gm] [expr $gm+$gh-$label/$max*$gh] } # # Draw legends # for {set i 1} {$i <= $cols} {incr i} { # $canvas create rect \ # [expr $gm+$gw+$gm/2] [expr $gm+40*$i] \ # [expr $gm+$gw+$gm+$gm/2] [expr $gm+40*$i+15] \ # -fill [graphColor $i] $canvas create text \ [expr $gm+$gw+$gm/2+10] [expr $gm+40*$i+18] \ -anchor n -text [graphData $graphName 0 $i] } # # Draw rectangles # for {set j 1} {$j <= $cols} {incr j} { for {set i 1} {$i <= $rows} {incr i} { set x [expr -[graphData $graphName $i $j]] if {$x < 0} { set x [expr -$x] set color red } else { set color blue } set x1 [expr ($i-1)*$rs+($j-1)*$cw+$gm] set y1 $zero set x2 [expr ($i-1)*$rs+$cw*$j+$gm] set y2 [expr $zero-$yscale*$x] # # Draw labels # if {$j == 1} { set tx [expr $cols*$cw/2+($i-1)*$rs+$gm] set tt [graphData $graphName $i 0] set tt [string range $tt 0 7] $canvas create text $tx \ [expr $zero+6+(($i-1) % $nlevels)*13] -anchor n \ -font $cbb(msg_text_font) \ -text $tt } $canvas create rect $x1 $y1 $x2 $y2 -fill $color } } } set graphCnt 0 createColumnGraph lixo 0