#!/usr/bin/perl use warnings; use strict; use Tk; use MeM; my $w=20; my $x=0; my $y=0; my %colors = ( 0 => ['black','yellow'], 1 => ['yellow','black'], 2 => ['white','green'], 3 => ['green','white'], 4 => ['grey','red'], 5 => ['red','grey'], 6 => ['blue','white'], 7 => ['white','blue'], 8 => ['orange','grey45'], 9 => ['grey45','orange'], ); my %bardata = ( 0 => rand 200, 1 => rand 200, 2 => rand 200, 3 => rand 200, 4 => rand 200, 5 => rand 200, 6 => rand 200, 7 => rand 200, 8 => rand 200, 9 => rand 200, ); my %bars; my $mw=tkinit; my $c = $mw->Canvas->pack; for (0..9) { $bars{$_} = $c->createRectangle($x,$y,$x+20,$bardata{$_}, -fill=> ${$colors{$_}}[0], ); my $text = $c->createText($x+10,$y+10, -anchor=>'center', -fill => ${$colors{$_}}[1], -text => $_ ); $x+=20; } $mw->Button( -text => "Save", -command => [sub { $c->update; my @capture=(); my ($x0,$y0,$x1,$y1)=$c->bbox('all'); @capture=('-x'=>$x0,'-y'=>$y0,-height=>$y1-$y0,-width=>$x1-$x0); $c -> postscript(-colormode=>'color', -file=>$0.'.ps', -rotate=>90, -width=>800, -height=>500, @capture); } ] )->pack; $mw->repeat(2000, sub{ &update }); MainLoop; ########################################################## sub update{ $x=0; $y=0; %bardata = ( 0 => rand 200, 1 => rand 200, 2 => rand 200, 3 => rand 200, 4 => rand 200, 5 => rand 200, 6 => rand 200, 7 => rand 200, 8 => rand 200, 9 => rand 200, ); for (0..9) { $c->delete( $bars{$_} ); $bars{$_} = $c->createRectangle($x,$y,$x+20,$bardata{$_}, -fill=> ${$colors{$_}}[0], ); my $text = $c->createText($x+10,$y+10, -anchor=>'center', -fill => ${$colors{$_}}[1], -text => $_ ); $x+=20; } }