view release on metacpan or  search on metacpan

lib/Math/SegmentedEnvelope.pm  view on Meta::CPAN

    $self->_past_segment(-1);
}

sub evaluator {
    my ($self) = @_;
    sub { $self->at(@_) };
}

sub at {
    my ($self, $t) = @_;
    $t = $self->wrap_pos($t);
    my ($pd,$i,$d) = (
        $self->_passed_segments_duration,
        $self->_current_segment
    );
    while ($t < $pd && $i > 0) { $pd -= $self->def->[1]->[--$i] } # backward
    $i == 0 ? $pd = 0 : $t -= $pd;  # remove duration of passed segments
    while ($i < $self->_segments) { # forward - determine segment and cache it for next time
        $d = $self->def->[1]->[$i]; # set current segment duration + error
        if ($t > $d && $i != $self->_segments - 1) { # t passed this segment, so remove this segment duration
            $t -= $d; $pd += $d; $i++; next;
        } else {  # $t is in current segment
            $t = $d if $t > $d;
            $i = $self->update_current_segment($i) unless $i == $self->_past_segment; last;
        }
    }
    # print "r:$i\tt:$t\td:$d\tp:$pd";
    $self->_passed_segments_duration($pd) if $pd != $self->_passed_segments_duration;
    $self->_current_segment($i) if $i != $self->_current_segment;
    abs( # result value
        $self->wrap_value(abs(( $self->_is_neg ? $d - $t : $t ) / $d))
        ** abs($self->def->[2]->[$i])
        * $self->_is_asc
        + $self->_is_neg
    ) * $self->_level_diff + $self->def->[0]->[$i];
    #print "\t$t\n"; $t;
}

sub wrap_value {
    my ($self) = @_;
    $self->is_morph ? $self->morpher->($_[1]) : $_[1]; # value smooth or whatever    
}

sub wrap_pos {
    my ($self,$t) = @_;
    my $total = $self->_duration;
    if ($self->is_hold) {
        $t > 0 ? ( $t > $total ? $total : $t ) : 0
    } else {
        my $at = abs($t);
        if ($at > $total) {
            if  ($self->is_fold_over && int($at/$total) % 2 == ( $t < 0 && $self->is_wrap_neg ? 0 : 1 )) { #fold
                ( 1 - ( ($at / $total) - int($at / $total) ) ) * $total;
            } else { # wrap
                ( ($at / $total) - int($at / $total) ) * $total;
            }
        } else { $at }
    };
}

sub update_current_segment {
    my ($self, $i) = @_;
    $i = $self->_current_segment(defined($i) ? $i : ());
    $self->_level_diff($self->level($i+1) - $self->level($i));
    $self->_is_neg($self->curve($i) < 0 ? 1 : 0);
    $self->_is_asc($self->_level_diff < 0 || $self->_is_neg ? -1 : 1);
    $self->_past_segment($i);
}

sub level {
    my $self = shift;
    my $r = $self->def_part_value(0, @_);
    $self->update_current_segment if @_ > 1 && abs($self->_current_segment - ($_[0] >= 0 ? $_[0] : $self->_segments + $_[0])) <= 1;
    $r;
}

sub levels { 
    my $self = shift;
    my @r = $self->def_part(0, @_);
    $self->update_current_segment if @_ > 0;
    @r;
}

sub dur {
    my $self = shift;
    my $r = $self->def_part_value(1, @_);
    $self->clean if @_ > 1;
    $r;
}

sub durs {
    my $self = shift;
    my @r = $self->def_part(1, @_);
    $self->clean if @_ > 1;
    @r;    
}

sub duration { shift->_duration }
sub segments { shift->_segments }

sub curve {
    my $self = shift;
    my $r = $self->def_part_value(2, @_);
    $self->update_current_segment if @_ > 1 && $self->_current_segment == $_[0];
    $r;
}

sub curves { 
    my $self = shift;
    my @r = $self->def_part(2, @_);
    $self->update_current_segment if @_ > 0;
    @r;
}

sub def_part {
    my ($self, $p, @values) = @_;
    (@values == @{$self->def->[$p]} ? $self->def->[$p] = [@values] : carp "size mismatch against initial definition") if @values;
    @{$self->def->[$p]};
}

sub def_part_value {