The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/local/bin/perl -w

use strict;
use English;
use Tk;

use lib '../.';

use Tk::Graph;


my $Main = MainWindow->new(-title => "Test", -background => "white" );
my $pollsec = 3;

###############################################################################

sub linegraph {
	my $target      = shift  or return undef;

	my $f1 = $target->Frame()->pack( -side => "left",-fill => "both", -expand => 1);
	my $g1 = $f1->Graph(
		-type           => "Line",
		-legend         => 0,
		-headroom       => 0,
		-foreground     => "black",
		-debug          => 0,
		-borderwidth    => 2,
		-titlecolor     => '#435d8d',
		-yformat        => '%g',
                -ylabel         => "Mb",
		-xformat        => "%g",
                -xlabel         => "Requests",
		-barwidth       => 15,
		-padding        => [50,20,-30,50],      # Padding [top, right, buttom, left]
		-printvalue     => '%s',           # Name: Wert
		-linewidth      => 2,
		-shadow         => '#435d8d',
		-shadowdepth     => 3,
		-dots           => 1,
		-look           => 20, 
		-wire           => "#d2e8e4",
		-max		=> 1024,
		-ytick		=> 8,
		-xtick		=> 5,
		-config         => { Used => { -color => "#2db82a" } },
	);

	update_system_memory( $g1, $pollsec*1000 );

	return $g1->pack(
		-side           => "bottom",
		-expand         => 1,
		-fill           => 'both',
	);
}

sub update_system_memory {
        my $wid = shift or return undef;
        my $ms  = shift or return undef;
	my $data = {};
	
	my $total = $data->{Total} = 1024;
	my $free  = $data->{Free}  = int rand(1024);

        my $used        = $total - $free;
        my $percent     = 100*$used/$total;

        my $title = sprintf "\nSystem Memory\nMax: %d %s\nUsed: %d %s",
                calc_unit_from_kb($total*1024,"Mb"),
                calc_unit_from_kb($used*1024,"MB");

        $wid->configure(
                -title  => $title,
                -config => { Used => { -color => ( $percent>=50 ? (  $percent>=90 ? "#ff3333" : "#ffb200" ) : "#2db82a" ) } },
        );

        printf "used=%s\n", $used;

        $wid->set({
                Used    => $used,
        });

        $wid->after($ms, [ \&update_system_memory => $wid, $ms ] );

}

sub calc_unit_from_kb {
        my $value = shift;      # Uebergabe in Kb!
        return (-0,"?") unless defined $value;

        my $unit = shift;
           $unit = uc $unit if defined $unit;

        my $u = "";
        foreach ( qw/Kb Mb Gb Tb Pb/ ) {
                $u = $_;
                last if defined $unit and uc($u) eq $unit;
                last if $value < 1024 and not defined $unit;
                $value = $value / 1024;
        }
        return ($value, $u);
}

###############################################################################

linegraph($Main);

MainLoop;

exit(99);