File Coverage

blib/lib/Video/Function.pm

Criterion	Covered	Total	%
statement	9	157	5.7
branch	0	66	0.0
condition	0	14	0.0
subroutine	3	19	15.7
pod	0	16	0.0
total	12	272	4.4

package Video::Function;

use vars qw($VERSION @EXPORT);
$VERSION = 0.01;
@EXPORT = qw(new sum show zero compress truncate);

use strict;
use Math::Round qw(nearest_ceil nearest_floor nearest);

sub new {
    my ($class, $resolution, $length) = @_;
    my $self = bless {}, ref($class) || $class;
    $self->{'function'} = {};

    #number of divisions in a sec
    $self->{'resolution'} = $resolution if $resolution;

    $self->{'length'} = $length || -1;

    return $self;
}

sub setlength {
    my ($self, $length) = @_;
    $self->{'length'} = $length if $length;
    return 1;
}

sub compress {
    my ($self, $desiredlength, $method) = @_;
    my $original = $self->{'function'};
    $self->{'desiredlength'} = $desiredlength;

    if ($desiredlength > $self->{'length'}) {
        my $multiplier = $desiredlength/$self->{'length'};
        $self->multiply($multiplier);
        print "warning: making coolness function longer, method is irrelevant\n";
    }

    if ($method eq "simple") {
        my $multiplier = $desiredlength / ($self->{'length'});
        $self->multiply($multiplier);
    }

    if ($method eq "cutoff") {
        my $cutoff = 0;
        my $delta = 0.1;
        while (($desiredlength < $self->sumsel($cutoff, "greater"))
          and ($cutoff <= 1)) {
            $cutoff += $delta;
        }
        my %function = %{$self->{'function'}};
        foreach my $point (keys %function) {
            if ($function{$point} < $cutoff) {
                $function{$point} = 0;
            }
        }
        %{$self->{'function'}} = %function;
    }
}

sub multiply {
    my ($self, $multiplier) = @_;
    my %function = %{$self->{'function'}};
    foreach my $point (keys %function) {
        $function{$point} *= $multiplier;
        if ($function{$point} > 1) {
            $function{$point} = 1;
        }
    }
    %{$self->{'function'}} = %function;
}

sub sum {
    my ($self) = @_;
    return $self->sumsel(0,"greater");
}

sub sumsel {
    my ($self, $cutoff, $sign) = @_;
    my $sum = 0;
    foreach my $value (values %{$self->{'function'}}) {
        if ($sign eq "greater") {
            if ($value >= $cutoff) {
                $sum += $value;
            }
        }
        if ($sign eq "less") {
            if ($value <= $cutoff) {
                $sum += $value;
            }
        }
    }
    return $sum/$self->{'resolution'};
}

sub zero {
    my ($self) = @_;
    my $length = $self->{'length'};
    my $resolution = $self->{'resolution'};
    for (my $i=0; $i<$length; $i+=(1/$resolution)) {
        my $big = scalar keys %{$self->{'function'}};
        $i = nearest(1/$resolution, $i);
        unless (defined $self->{'function'}{$i}) {
            $self->{'function'}{$i} = 0;
        }
    }
    return $self;
}

sub truncate {
    my ($self) = @_;
    my $length = $self->{'length'};
    foreach my $index (keys %{$self->{'function'}}) {
        if ($index < 0) {
            delete ${$self-{'function'}}{$index};
            print "truncated negative index\n";
        }
        if ($index > $length) {
            delete ${$self->{'function'}}{$index};
        }
    }
    return $self;
}

sub show {
    my ($self) = @_;
    my @unsorted = keys %{$self->{'function'}};
    my @sorted = sort {$a<=>$b} @unsorted;
    my $data = "";
    foreach my $key (@sorted) {
        $data .= sprintf("%3.2f \t %1.3f\n", $key, $self->{'function'}{$key});
    }
    return $data;
}

sub apply {
    my ($self, $time, $value) = @_;
    $time = nearest(1/($self->{'resolution'}), $time);
    if ($time < 0) { $time = 0; }
    $self->{'function'}{$time} = max($self->{'function'}{$time},
                                     $value
                                    );
}

sub applybunch {
    my ($self, $event) = @_;
    my $eventtime = $event->{'time'};
    my $zerooverride = $event->{'zerooverride'};

    $event->{'cool'} = 0 if not defined $event->{'cool'};
    #scale keypress (key between 1 and 9) to fit between 0 and 1
    $event->{'cool'} = ($event->{'cool'}/9) if $event->{'cool'} > 1;

    if (defined $event->{'type'}) {

    if ($event->{'type'} eq 'long') {
        if ( defined $event->{'endtime'} and
             defined $event->{'cool'}
           ) {
            my $numsteps = ($event->{'endtime'} - $eventtime)
                           * $self->{'resolution'};
            foreach my $step (0 .. $numsteps) {
                $self->apply(nearest(1/$self->{'resolution'},
                                     $eventtime + ($step/$self->{'resolution'})
                                    ),
                             $event->{'cool'}
                            );
            }
            if (defined $event->{'envelope'}) {
                $self->fillin($event->{'time'}, $event->{'envelope'}, $event->{'zerooverride'}, $event->{'cool'}, -1);
                $self->fillin($event->{'endtime'}, $event->{'envelope'}, $event->{'zerooverride'}, $event->{'cool'}, 1);
            }
        }
        else {
            die __PACKAGE__ . ": problem with long event, no endtime or no coolness, can't build coolness function";
        }
    }
    if ($event->{'type'} ne 'long') {
        $self->fillin($event->{'time'}, $event->{'envelope'}, $event->{'zerooverride'}, $event->{'cool'});
    }


    }
    #if type not defined, then can't apply envelope because don't know how

}


sub fillin {
    my ($self, $eventtime, $points, $zerooverride, $scaleto, $direction) = @_;
    my $resolution = $self->{'resolution'};
    my @ordered = sort {$a <=> $b} (keys %$points);
    my $first = nearest_ceil(1/$resolution, $ordered[0] + $eventtime);
    my $last = nearest_floor(1/$resolution, $ordered[-1] + $eventtime);

    my $counter = $ordered[0];
    my $point   = $first;
    while ($point <= $last) {
        $counter += 1/($resolution);
        $point += 1/($resolution);

        my $prev = getprev($counter, @ordered);
        my %previous = ('time'  => $prev,
                        'value' => $$points{$prev},
                       );
        my $next = getnext($counter, @ordered);
        my %next = ('time'  => $next,
                    'value' => $$points{$next},
                   );
        my $value = interpolate($counter, \%previous, \%next);
        $value *= $scaleto if $scaleto;
        $point = nearest(1/$resolution, $point);

        if ($point >= 0) {
            $self->{'function'}{$point} = max($self->{'function'}{$point},
                                              $value,
                                              $zerooverride
                                             );
        }


    }
}

sub interpolate {
    my ($point, $previous, $next) = @_;
    my $timeratio =   ( $point         - $$previous{'time'} )
                    / ( $$next{'time'} - $$previous{'time'} );
    my $mult = ( $$next{'value'} - $$previous{'value'} ) if $$next{'value'};
    $mult = $$previous{'value'} unless $$next{'value'};  #ew
    my $add =  ( $$previous{'value'} );
    return $timeratio * $mult + $add;
}


sub getnext {
    my ($point, @ordered) = @_;
    foreach my $compare (@ordered) {
        return $compare if $compare >= $point;
    }
    return -99999;
}

sub getprev {
    my ($point, @ordered) = @_;
    foreach my $compare (reverse @ordered) {
        return $compare if $compare < $point;
    }
    return -99999;
}

sub max {
    my ($first, $second, $zerooverride) = @_;
    return 0 if $zerooverride;
    return 0 if not $first and not $second;
    return $second if not $first;
    return $first if not $second;
    if ($first > $second) {return $first;}
    return $second;
}
1;