File Coverage

blib/lib/Term/Twiddle.pm

Criterion	Covered	Total	%
statement	75	126	59.5
branch	18	44	40.9
condition	3	10	30.0
subroutine	19	24	79.1
pod	11	12	91.6
total	126	216	58.3

package Term::Twiddle;

use 5.005;
use strict;
use vars qw( @ISA $VERSION );

$VERSION = '2.73';

use Time::HiRes qw(setitimer ITIMER_REAL);
#$SIG{'ALRM'} = \&_spin;
$SIG{'INT'} = $SIG{'TERM'} = \&_set_alarm(0);

## for normal spinning routines
use vars qw( $thingy $rate $probability $stream $_step );

## for whole line motion routines (e.g., bounce, swish)
use vars qw( $width $delay $_dtime $_offset $_scale $_time $_xpos);

sub new {
    my $self  = {};
    my $proto = shift;
    my $class = ref($proto) || $proto;
    bless $self, $class;

    $self->init(shift);

    return $self;
}

sub init {
    my $self = shift;
    my $args = shift;

    $self->thingy( ( $args->{'thingy'} ? $args->{'thingy'} : [ "\\", "|", "/", "-" ] ) );
    $self->rate( ( $args->{'rate'}   ? $args->{'rate'}   : 0.175 ) );
    $self->probability( ( $args->{'probability'} ? $args->{'probability'} : 0 ) );
    $self->stream( ( $args->{'stream'} ? $args->{'stream'} : *STDOUT ) );

    $self->type( ( $args->{'type'} ? $args->{'type'} : '' ) );
    $self->width( ( $args->{'width'} ? $args->{'width'} : _get_max_width() ) );
    $self->delay( ( $args->{'delay'} ? $args->{'delay'} : undef ) );
}

sub start {
    my $self = shift;
    _set_alarm( $rate );
}

sub stop {
    my $self = shift;
    _set_alarm(0);
}

sub thingy {
    my $self       = shift;
    my $new_thingy = shift;
    $_step = 0;

    return $thingy = ( $new_thingy
		       ? $new_thingy
		       : $thingy );
}

sub rate {
    my $self     = shift;
    my $new_rate = shift;

    return $rate = ( defined $new_rate
		     ? $new_rate
		     : $rate );
}

sub probability {
    my $self     = shift;
    my $new_prob = shift;

    return $probability = ( defined $new_prob
			    ? $new_prob
			    : $probability );
}

sub stream {
    my $self       = shift;
    my $new_stream = shift;

    return $stream = ( defined $new_stream
		       ? $new_stream
		       : $stream );
}

sub random {
    my $self = shift;
    my $prob = shift;
    $prob = ( defined $prob ? $prob : 25 );
    $self->probability($prob);
}

sub type {
    my $self = shift;
    my $type = shift || '';

    if( $type eq 'bounce' ) {
	$_offset = $width/2;
	$_scale  = $_offset/0.9;
	$delay   = 0.01;
	$_dtime  = 0.038;
	$SIG{'ALRM'} = \&_bounce;
    }

    elsif( $type eq 'swish' ) {
	$_offset = $width/2;
	$delay   = 0.0001;
	$_dtime  = 0.1;
	$SIG{'ALRM'} = \&_swish;
    }

    else {
	$SIG{'ALRM'} = \&_spin;
	return 1;
    }
}

sub width {
    my $self      = shift;
    my $new_width = shift;

    $width = ( defined $new_width
	       ? $new_width
	       : $width );

    ## set dependant package vars
    $_offset = $width/2;
    $_scale  = $_offset/0.9;

    return $width;
}

sub delay {
    my $self      = shift;
    my $new_delay = shift;

    return $delay = ( defined $new_delay
		      ? $new_delay
		      : $delay );
}

## send me a SIGALRM in this many seconds (fractions ok)
sub _set_alarm {
    return setitimer(ITIMER_REAL, shift, 0);
}

sub _get_max_width {
    my $width;

    ## suck in Term::Size, if possible
    eval { require Term::Size };

    ## no Term::Size; try using tput to find terminal width
    if( $@ ) {
	## find tput via poor man's "which"
	for my $path ( split /:/, $ENV{'PATH'} ) {
	    next unless -x "$path/tput";
	    $width = `$path/tput cols`;
	    chomp $width;
	    last;
	}
    }

    ## we have Term::Size; use it
    else {
	($width, undef) = &Term::Size::chars(*STDERR);
    }

    ## assign a default if not already assigned
    $width ||= 80;

    return $width;
}

sub _bounce {

  BOUNCE: {
	my $old_fh = select($stream);
	local $| = 1;

	my $oldx = $_xpos;

	## original damped harmonic motion filched from some java
	## somewhere...please forgive me! I can't remember where!
	$_time += $_dtime;
	$_xpos = int( $_offset + ($_scale * ( abs(1.7 * cos $_time) - 0.9 ) ) );

	print $stream ' ' x $_xpos;
	print $stream "*";
	print $stream ' ' x ( $oldx > $_xpos ? $oldx-$_xpos : 0 );
	print $stream "\r";

	select($old_fh);
    }

    $SIG{'ALRM'} = \&_bounce;
    _set_alarm($delay);
}

sub _swish {

  SWISH: {
	my $old_fh = select($stream);
	local $| = 1;

	my $oldx = $_xpos;

	## orignal swishing motion filched from Term::ReadKey test.pl
	## by Kenneth Albanowski
	$_time += $_dtime;
	$_xpos = int( $_offset * (cos($_time) + 1) );

	print $stream ' ' x $_xpos;
	print $stream "*";
	print $stream ' ' x ( $oldx > $_xpos ? $oldx-$_xpos : 0 );
	print $stream "\r";

	select($old_fh);
    }

    $SIG{'ALRM'} = \&_swish;
    _set_alarm($delay);
}

sub _spin {

  SPIN: {
	my $old_fh = select($stream);
	local $| = 1;
	print $stream $$thingy[$_step],
	  chr(8) x length($$thingy[$_step]);
	select($old_fh);
    }

    $_step = ( $_step+1 > $#$thingy ? 0 : $_step+1 );

    ## randomize if required
    $rate = rand(0.2)
      if $probability && (rand() * 100) < $probability;

    $SIG{'ALRM'} = \&_spin;
    _set_alarm($rate);
}

sub DESTROY {
    shift->stop;
}

1;
__END__