#!/usr/bin/perl use warnings; use strict; use Glib qw/TRUE FALSE/; use Gtk2 '-init'; use Gnome2::Canvas; use constant PI => 3.1415926; use Tie::Watch; my $width = 200; my $height = 100; my $value = 0; my $max = 100; my $min = 0; my $watch = Tie::Watch->new( -variable => \$value, -shadow => 0, -store => \&update_meter, ); my $window = Gtk2::Window->new; $window->signal_connect( 'destroy' => \&delete_event ); $window->set_default_size( $width, $height ); my $canvas = Gnome2::Canvas->new_aa(); $canvas->set_size_request($width,$height); $canvas->set_scroll_region( 0, 0, $width, $height ); #to get upper left corner $canvas->set_size_request( $width, $height ); #useless ? my $vbox = Gtk2::VBox->new( FALSE, 6 ); $window->add($vbox); $vbox->set_border_width(2); $vbox->pack_start($canvas,FALSE,FALSE,0); $window->show_all; my $root = $canvas->root(); my $text = Gnome2::Canvas::Item->new( $root, 'Gnome2::Canvas::Text', x => $width / 2, y => $height * .50, fill_color => 'yellow', font => 'Sans 14', anchor => 'GTK_ANCHOR_CENTER', text => $value ); my $box = Gnome2::Canvas::Item->new( $root, 'Gnome2::Canvas::Rect', x1 => 0, y1 => 0, x2 => $width, y2 => $height, fill_color => 'black', outline_color => 'black' ); my $hub = Gnome2::Canvas::Item->new( $root, "Gnome2::Canvas::Ellipse", x1 => $width / 2 - 8, y1 => ( $height * .80 ) - 8, x2 => $width / 2 + 8, y2 => ( $height * .80 ) + 8, fill_color => 'white', outline_color => 'black' ); my $gauge = Gnome2::Canvas::Item->new( $root, "Gnome2::Canvas::Ellipse", x1 => $width / 2 - 80, y1 => ( $height * .80 ) - 80, x2 => $width / 2 + 80, y2 => ( $height * .80 ) + 80, outline_color => 'white', fill_color => 'steelblue' ); my $floor = Gnome2::Canvas::Item->new( $root, 'Gnome2::Canvas::Rect', x1 => 0, y1 => $height * .80, x2 => $width, y2 => $height, fill_color => 'black', ); my $needle = Gnome2::Canvas::Item->new( $root, "Gnome2::Canvas::Line", points => [ $width / 2, ( $height * .80 ), $width / 2, 10 ], width_units => 5, fill_color => 'hotpink', last_arrowhead => 1, arrow_shape_b => 20 ); $box->lower_to_bottom; $needle->raise_to_top; $hub->raise_to_top; $text->raise($gauge); my $toggle = 1; my $count = 0; Glib::Timeout->add (50, sub { $count += $toggle; $value = $count; return TRUE; } ); Gtk2->main; ###########################################################3 sub delete_event { #muppet's fixes for errors on exit $text = undef; $box = undef; $hub = undef; $gauge = undef; $floor = undef; $needle = undef; # end update fixes $watch->Unwatch; $canvas->destroy; Gtk2->main_quit; return 0; } ###########################################################3 sub update_meter { if ( $value <= $min ) { $toggle = 1 } if ( $value >= $max ) { $toggle = -1 } my $pos = $value * PI/$max; my $x = $width/2 - $height * .80 * ( cos( $pos ) ); my $y = $height * .80 - $height * .80 * ( sin( $pos ) ) ; $needle->set( points => [ $width / 2, ( $height * .80 ), $x, $y ], ); $text->set(text => $value); return $value; } ############################################################