#!/usr/bin/perl -w

# Created: Waider 26 September 2000
# Last Modified: Waider 08 October 2000
# October 2002:
#  Use Gtk::Perl
# -----------------------------------------------------------------------------
package Monitor;

use Gtk;

sub new {
  my $obj = shift;
  my $mon = bless {}, $obj;

  $obj;
}

sub init {
  my $mon = shift;
  my $main = shift;
  my $label;
  my $text = "[unstarted]";
  $mon->{'text'} = $text;

  # see if there are "-fg" and "-bg" args. This is really clunky.
  my ( $fg, $bg );
  my @args = @ARGV;
  while ( @args ) {
      my $a = shift @args;
      if ( $a eq "-fg" ) {
          $fg = shift @args;
      } elsif ( $a eq "-bg" ) {
          $bg = shift @args;
      }
  }

  $fg = "black" unless defined( $fg );
  $bg = "white" unless defined( $bg );

  print STDERR "Using bg = $bg, fg = $fg\n" if $mon->{'DEBUG'};

  # FIXME allow non-Tk monitors
  if ( !defined( $main )) {
	# Wire up a suitable class name
	my $class = $mon;
	$class =~ s/^Monitor:://;
	$class =~ s/:://; # not sure what's appropriate here, but.

	$main = new Gtk::Window;
	$main->set_title( "$class" );

	my $tt = new Gtk::Tooltips;
	$tt->enable();
	$mon->{'tooltips'} = $tt;

	# Nail the beggar down.
	$main->set_policy( 0, 0, 0 ); # allow shrink, grow, auto_shrink

  }

  # color management. w00t.
  my $colormap = $main->get_colormap();
  my $gdk_fg = Gtk::Gdk::Color->parse_color( $fg );
  $gdk_fg = $colormap->color_alloc( $gdk_fg );
  my $gdk_bg = Gtk::Gdk::Color->parse_color( $bg );
  $gdk_bg = $colormap->color_alloc( $gdk_bg );

  Gtk::Rc->parse_string(<<EOS);
style "normal" {
	bg[NORMAL] = { $gdk_bg->{red}, $gdk_bg->{green}, $gdk_bg->{blue}}
	fg[NORMAL] = { $gdk_fg->{red}, $gdk_fg->{green}, $gdk_fg->{blue}}
    font = "fixed"
}

widget "*" style "normal"
EOS

  # $label->configure( -wrap=>0, -font=>'fixed' ); XXX

  $label = new Gtk::Label();
  $label->set_text( "" );
  $label->set_alignment( 0.5, 0.5 );
  $label->set_line_wrap( 0 );

  $main->realize();
  $main->add( $label );

  $mon->{'main'} = $main;
  $mon->{'label'} = $label;

  $mon->set_tooltip( $class );

  # Display the window
  $main->show_all;

  $mon;
}

sub set_tooltip {
  my $mon = shift;
  my $main = $mon->{'main'};
  my $tt = $mon->{'tooltips'};
  my $tip = $mon->{'tip'} || "";
  my $newtip = shift;

  if ( $newtip ne $tip ) {
	$tip = $newtip;
	$tt->set_tip( $mon->{'main'}, $tip );
  }

  $mon->{'tip'} = $tip;
}

sub start {
  my $mon = shift;
  my $interval = shift;
  my $main = $mon->{'main'};

  $interval ||= $mon->{'interval'};

  if ( !defined( $interval )) {
	$interval = 1000;
  }

  $mon->{'interval'} = $interval;
  $mon->{'lastrun'} = time;

  # Kick the updater, which will happily loop itself.
  $mon->update();
  Gtk->timeout_add( $mon->{'interval'}, sub { $mon->update }, undef );
}

sub update {
  my $mon = shift;
  my $main = $mon->{'main'};
  my $label = $mon->{'label'};

  # fetch new data
  my $text = $mon->newdata();

  # no trailing crlf
  $text =~ s/[\r\n]+$//s;

  # how big should the window be?
  my $t = $text;
  my $w = 0;
  my $h = 1;

  while ( $t =~ /[\r\n]/s ) {
	my $l;
	( $l, $t ) = $t =~ m|^([^\r\n]*)[\r\n]+(.*)$|s;
  	if ( length( $l ) + 1 > $w ) {
  	  $w = length( $l ) + 1;
  	}
  	$h++;
  }

  # Cleanup
  if ( length( $t ) + 1 > $w ) {
  	$w = length( $t ) + 1;
  }

  if ( $w == 0 ) {
  	$w = length( $text );
  }

#  $label->configure( -width=>$w, -height=>$h, -text=>$text );
#  $label->size_request( ) # XXX
  $label->set_text( $text );
  $mon->{'text'} = $text;

  # store the runtime
  $mon->{'lastrun'} = time;

  1; # loop me baby
}

sub newdata {
  my $mon = shift;
  return $mon->{'text'};
}

1;