Tie-Cycle-Sinewave-0.05000755 001751 001751 00000000000 10714430351 015134 5ustar00daviddavid000000 000000 Tie-Cycle-Sinewave-0.05/META.yml000644 001751 001751 00000000615 10714430351 016466 0ustar00daviddavid000000 000000 --- #YAML:1.0 name: Tie-Cycle-Sinewave version: 0.05 abstract: Cycle through a series of values on a sinewave license: perl generated_by: ExtUtils::MakeMaker version 6.36 distribution_type: module requires: meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 author: - David Landgren Tie-Cycle-Sinewave-0.05/t000755 001751 001751 00000000000 10714430351 015377 5ustar00daviddavid000000 000000 Tie-Cycle-Sinewave-0.05/Changes000644 001751 001751 00000001771 10714430073 016515 0ustar00daviddavid000000 000000 Revision history for Perl extension Tie::Cycle::Sinewave 0.05 2007-11-07 21:31:52 UTC - New-style POD testing infrastructure used. - META.yml should conform to current spec. No code changes, current users do not need to upgrade. 0.04 2006-11-03 13:11:01 UTC - Clarified licensing information in META.yml. No other functional changes. 0.03 2006-07-25 14:13:26 UTC - Fixed up a silly error in the synopsis example code. - Refined the code to deal with 2*PI wraparound (only shows up on 64-bit platforms. Not sure if this fix is sufficient). - The README talked about Build.PL instead of Makefile.PL. 0.02 2005-10-02 15:16:29 UTC - Couldn't get Build.PL to play nicely under smoke tests (the dreaded "Too early to specify a build action 'Build'." error). So I threw it away and use ExtUtils::MakeMaker instead. - t/pod.t and t/pod_coverage.t were subsumed by t/00-basic.t - detabbed source files 0.01 2005-04-05 15:00:09 UTC - initial release Tie-Cycle-Sinewave-0.05/eg000755 001751 001751 00000000000 10714430351 015527 5ustar00daviddavid000000 000000 Tie-Cycle-Sinewave-0.05/MANIFEST000644 001751 001751 00000000237 10714427047 016356 0ustar00daviddavid000000 000000 Changes MANIFEST MANIFEST.SKIP META.yml Makefile.PL README Sinewave.pm TODO eg/callback eg/cb2 eg/cmd eg/simple eg/wave t/00-load.t t/01-basic.t t/99-author.t Tie-Cycle-Sinewave-0.05/Sinewave.pm000644 001751 001751 00000016127 10714430105 017336 0ustar00daviddavid000000 000000 package Tie::Cycle::Sinewave; use strict; =head1 NAME Tie::Cycle::Sinewave - Cycle through a series of values on a sinewave =head1 VERSION This document describes version 0.05 of Tie::Cycle::Sinewave, released 2007-11-07. =cut use vars '$VERSION'; $VERSION = '0.05'; =head1 SYNOPSIS This module allows you to make a scalar iterate through the values on a sinewave. You set the maximum and minimum values and the number of steps and you're set. use strict; use Tie::Cycle::Sinewave; tie my $cycle, 'Tie::Cycle::Sinewave', { min => 10, max => 50, period => 12, }; printf("%0.2f\n", $cycle) for 1..10; =head1 PARAMETERS A number of parameters can be passed in to the creation of the tied object. They are as follows (in order of likely usefulness): =over 4 =item min Sets the minimum value. If not specified, 0 will be used as a default minimum. =item max Sets the maximum value. Should be higher than min, but the values will be swapped if necessary. If not specified, 100 will be used as a default maximum. =item period Sets the period of the curve. The cycle will go through this many values from min to max. If not specified, 20 will be used as a default. If period is set to 0, it will be silently changed to 1, to prevent internal calculations from attempting to divide by 0. =item start_max Optional. When set to 1 (or anything), the cyle will start at the maximum value. (C exists as a an alias). =item start_min Optional. When set to 1 (or anything), the cyle will start at the minimum value. (C exists as a an alias). If neither C nor C are specified, it will at the origin (thus, mid-way between min and max and will move to max). =item at_max Optional. When set to a coderef, will be executed when the cycle reaches the maximum value. This allows the modification of the cycle, I modifying the minimum value or the period. (The key C exists as an alias). =item at_min Optional. When set to a coderef, will be executed when the cycle reaches the minimum value. This allows the modification of the cycle, I modifying the maximum value or the period. (The key C exists as an alias). =back =cut use constant PI => 3.1415926535_8979323846_2643383280; use constant PI_2 => 2 * PI; sub TIESCALAR { my $class = shift; my %param = ref($_[0]) eq 'HASH' ? %{$_[0]} : @_; my $min = exists $param{min} ? +$param{min} : 0; my $max = exists $param{max} ? +$param{max} : 100; my $period = exists $param{period} ? +$param{period} : 20; $period = 1 if $period == 0; $param{start_max} = delete $param{startmax} if exists $param{startmax}; $param{start_min} = delete $param{startmin} if exists $param{startmin}; $param{at_max} = delete $param{atmax} if exists $param{atmax}; $param{at_min} = delete $param{atmin} if exists $param{atmin}; my $start = exists $param{start_max} ? PI / 2 : exists $param{start_min} ? PI / 2 * 3 : 0 ; my $self = { min => $min, max => $max, angle => $start, prev => $start, period => $period, }; $self->{at_max} = $param{at_max} if exists $param{at_max} and ref($param{at_max}) eq 'CODE'; $self->{at_min} = $param{at_min} if exists $param{at_min} and ref($param{at_min}) eq 'CODE'; $self = bless $self, $class; $self->_validate_min_max(); $self; } sub FETCH { my $self = shift; my $sin_prev = sin( $self->{prev} ); my $sin = sin( $self->{angle} ); my $delta = PI_2 / $self->{period}; $self->{prev} = $self->{angle}; $self->{angle} += $delta; my $sin_next = sin( $self->{angle} ); my $prev_vs_curr = $sin_prev <=> $sin; my $curr_vs_next = $sin <=> $sin_next; if( -1 == $prev_vs_curr and 1 == $curr_vs_next ) { # the previous is smaller than the current, # and the current is greater than the next, # therefore we must be at the top of the wave. exists $self->{at_max} and $self->{at_max}->($self); # Clamp the value to 0 < x < 2PI. For long running cycles this # should improve accuracy (if P.J. Plauger it to be believed). if( $self->{prev} > PI_2 ) { $self->{prev} -= PI_2; $self->{angle} -= PI_2; } } elsif( 1 == $prev_vs_curr and -1 == $curr_vs_next ) { # at the bottom (trough) of the wave exists $self->{at_min} and $self->{at_min}->($self); } (($sin + 1) / 2) * ($self->{max} - $self->{min}) + $self->{min}; } sub STORE { my $self = shift; $self->{angle} = $self->{prev} = $_[0]; } =head1 OBJECT METHODS You can call methods on the underlying object (which you access with the C function). Have a look at the file C for an example on what you might want to do with these. =over 4 =item min When called without a parameter, returns the current minimum value. When called with a (numeric) parameter, sets the new current minimum value. The previous value is returned. my $min = (tied $cycle)->min(); (tied $cycle)->min($min - 20); =cut sub min { my $self = shift; my $old = $self->{min}; if( @_ ) { $self->{min} = shift; $self->_validate_min_max(); } $old; } =item max When called without a parameter, returns the current maximum value. When called with a (numeric) parameter, sets the new current maximum value. The previous value is returned. my $max = (tied $cycle)->max(); (tied $cycle)->max($max * 10); When C or C are modified, a consistency check is run to ensure that C. If this check fails, the two values are quietly swapped around. =cut sub max { my $self = shift; my $old = $self->{max}; if( @_ ) { $self->{max} = shift; $self->_validate_min_max(); } $old; } =item period When called without a parameter, returns the current period. When called with a (numeric) parameter, sets the new current period. The previous value is returned. =cut sub period { my $self = shift; my $old = $self->{period}; if( @_ ) { $self->{period} = shift; $self->{period} = 1 if $self->{period} == 0; } $old; } sub _validate_min_max { ($_[0]->{min}, $_[0]->{max}) = ($_[0]->{max}, $_[0]->{min}) if $_[0]->{max} < $_[0]->{min}; } =item angle Returns the current angle of the sine, which is guaranteed to be in the range C< 0 <= angle <= 2*PI>. =back =cut sub angle { my $self = shift; if( $self->{prev} > PI_2 ) { $self->{prev} -= PI_2; $self->{angle} -= PI_2; } $self->{angle} } =head1 AUTHOR David Landgren. =head1 SEE ALSO L L =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. =head1 COPYRIGHT & LICENSE Copyright 2005-2007 David Landgren, All Rights Reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; # End of Tie::Cycle::Sinewave Tie-Cycle-Sinewave-0.05/TODO000644 001751 001751 00000000054 10224730723 015704 0ustar00daviddavid000000 000000 No new features are planned for the moment. Tie-Cycle-Sinewave-0.05/MANIFEST.SKIP000644 001751 001751 00000000012 10714427760 017114 0ustar00daviddavid000000 000000 \B\.svn\b Tie-Cycle-Sinewave-0.05/Makefile.PL000644 001751 001751 00000001020 10522637371 017166 0ustar00daviddavid000000 000000 # generate Makefile for building Tie::Cycle::Sinewave # # Copyright (C) 2005-2006 David Landgren use strict; use ExtUtils::MakeMaker; eval "use ExtUtils::MakeMaker::Coverage"; if( $@ ) { print "Can't load ExtUtils::MakeMaker::Coverage, not adding testcover target\n"; } else { print "Adding testcover target\n"; } WriteMakefile( NAME => 'Tie::Cycle::Sinewave', VERSION_FROM => 'Sinewave.pm', ABSTRACT_FROM => 'Sinewave.pm', AUTHOR => 'David Landgren', LICENSE => 'perl', ); Tie-Cycle-Sinewave-0.05/README000644 001751 001751 00000002250 10714430117 016072 0ustar00daviddavid000000 000000 This file is the README for Tie::Cycle::Sinewave version 0.05 INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install DESCRIPTION This module is used to create scalars whose values vary between a minimum value and a maximum value, and path taken between the two values follows the curve of a sinewave. Callbacks can be fired off when it passes through the maximum or minimum, which can be used to modify the cycle's parameters (amplitude and period). A number of sample programs are available in the eg/ directory. If you don't have easy access to this they are available on the web, at http://search.cpan.org/~DLAND/ STATUS This module is under active development. The test suite achieves 100% coverage according to Devel::Cover. BUGS Please report any bugs or feature requests to bug-tie-cycle-sinewave@rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Tie-Cycle-Sinewave COPYRIGHT AND LICENCE Copyright (C) 2005-2007 David Landgren. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Tie-Cycle-Sinewave-0.05/eg/wave000644 001751 001751 00000001035 10317757070 016503 0ustar00daviddavid000000 000000 #! /usr/local/bin/perl -w # # wave - draw a pretty picture. On broken platforms the 'select' # call may need to be commented out. # # This file is part of the Tie::Cycle::Sinewave perl extension # Copyright (c) 2005 David Landgren. All rights reservered. use strict; use Tie::Cycle::Sinewave; my $period = shift || 100; tie my $c, 'Tie::Cycle::Sinewave', { start_min => 1, min => 2, max => 76, period => $period, }; while( 1 ) { print +(' ' x $c), "*\n"; select undef, undef, undef, 0.05; } Tie-Cycle-Sinewave-0.05/eg/cb2000644 001751 001751 00000001234 10317757050 016206 0ustar00daviddavid000000 000000 #! /usr/local/bin/perl -w # # cb2 - Another simple callback demonstration, showing how # a T::C::S object can interact with the outside # # This file is part of the Tie::Cycle::Sinewave perl extension # Copyright (c) 2005 David Landgren. All rights reservered. use strict; use Tie::Cycle::Sinewave; my $at_min = 0; my $at_max = 0; tie my $c, 'Tie::Cycle::Sinewave', { start_max => 1, min => 0, max => 100, period => 12, at_max => sub { ++$at_max }, at_min => sub { ++$at_min }, }; my $iter = 0; while( 1 ) { printf "%3d %10.2f %2d %2d\n", ++$iter, $c, $at_min, $at_max; select undef, undef, undef, 0.2; } Tie-Cycle-Sinewave-0.05/eg/simple000644 001751 001751 00000000465 10224730723 017031 0ustar00daviddavid000000 000000 #! /usr/local/bin/perl -w # # simple - basic usage of a Tie::Cycle::Sinewave object # # This file is part of the Tie::Cycle::Sinewave perl extension # Copyright (c) 2005 David Landgren. All rights reservered. use strict; use Tie::Cycle::Sinewave; tie my $c, 'Tie::Cycle::Sinewave'; print "$c\n" for 1..40; Tie-Cycle-Sinewave-0.05/eg/cmd000644 001751 001751 00000001127 10317757056 016312 0ustar00daviddavid000000 000000 # ! /usr/local/bin/perl -w # # cmd - Another of a Tie::Cycle::Sinewave object, for which a # number of parameters can be set from the command line # # This file is part of the Tie::Cycle::Sinewave perl extension # Copyright (c) 2005 David Landgren. All rights reservered. use strict; use Tie::Cycle::Sinewave; my $min = shift || 0; my $max = shift || 100; my $period = shift || 20; tie my $c, 'Tie::Cycle::Sinewave', { start_max => 1, min => $min, max => $max, period => $period, }; while( 1 ) { printf "%10.2f\n"; select undef, undef, undef, 0.2; } Tie-Cycle-Sinewave-0.05/eg/callback000644 001751 001751 00000001363 10317757043 017301 0ustar00daviddavid000000 000000 #! /usr/local/bin/perl -w # # callback - demonstrate how callbacks can modify the parameters # of a Tie::Cycle::Sinewave object # # This file is part of the Tie::Cycle::Sinewave perl extension # Copyright (c) 2005 David Landgren. All rights reservered. use strict; use Tie::Cycle::Sinewave; tie my $c, 'Tie::Cycle::Sinewave', { start_min => 1, min => 10, max => 20, period => 4, at_max => sub { my $s = shift; $s->min($s->min() - 2); $s->period($s->period() + 1 ); }, at_min => sub { my $s = shift; $s->max($s->max() + 5); $s->period($s->period() + 1 ); }, }; while( 1 ) { printf "%10.2f\n", $c; select undef, undef, undef, 0.15; } Tie-Cycle-Sinewave-0.05/t/99-author.t000644 001751 001751 00000002204 10714426615 017412 0ustar00daviddavid000000 000000 # 99-author.t # # Test suite for Tie::Cycle::Sinewave - test the POD # # copyright (C) 2007 David Landgren use strict; use Test::More; if (!$ENV{PERL_AUTHOR_TESTING}) { plan skip_all => 'PERL_AUTHOR_TESTING environment variable not set (or zero)'; exit; } my @file; if (open MAN, 'MANIFEST') { while () { chomp; push @file, $_ if /\.pm$/ or m{^eg/[^/]+$}; } close MAN; } else { diag "failed to read MANIFEST: $!"; } my @coverage = qw( Tie::Cycle::Sinewave ); my $test_pod_tests = eval "use Test::Pod" ? 0 : @file; my $test_pod_coverage_tests = eval "use Test::Pod::Coverage" ? 0 : @coverage; if ($test_pod_tests + $test_pod_coverage_tests) { plan tests => @file + @coverage; } else { plan skip_all => 'POD testing modules not installed'; } SKIP: { skip( 'Test::Pod not installed on this system', scalar(@file) ) unless $test_pod_tests; pod_file_ok($_) for @file; } SKIP: { skip( 'Test::Pod::Coverage not installed on this system', scalar(@coverage) ) unless $test_pod_coverage_tests; pod_coverage_ok( $_, "$_ POD coverage is go!" ) for @coverage; } Tie-Cycle-Sinewave-0.05/t/00-load.t000644 001751 001751 00000000365 10714427660 017014 0ustar00daviddavid000000 000000 # 00-load.t # # basic tests for Tie::Cycle::Sinewave # # Copyright (c) 2005-2007 David Landgren use Test::More tests => 1; BEGIN { use_ok( 'Tie::Cycle::Sinewave' ); } diag( "testing Tie::Cycle::Sinewave $Tie::Cycle::Sinewave::VERSION" ); Tie-Cycle-Sinewave-0.05/t/01-basic.t000644 001751 001751 00000007344 10461425736 017164 0ustar00daviddavid000000 000000 # 01-basic.t # # basic tests for Tie::Cycle::Sinewave # # Copyright (c) 2005 David Landgren use strict; use Tie::Cycle::Sinewave; use Test::More tests => 31; { tie my $c, 'Tie::Cycle::Sinewave', { min => 20, max => 40, period => 5, }; cmp_ok( ref(tied $c), 'eq', 'Tie::Cycle::Sinewave', 'we have a T::C::S object' ); } { tie my $x, 'Tie::Cycle::Sinewave', min => -50, max => 50, period => 16, start_max => 1, ; cmp_ok( $x, '==', 50, 'max start 50' ); cmp_ok( (tied $x)->min, '==', -50, 'min is -50' ); cmp_ok( (tied $x)->min(-20), '==', -50, 'min is -50, set to -20' ); cmp_ok( (tied $x)->min, '==', -20, 'min is -20' ); cmp_ok( (tied $x)->max, '==', 50, 'max is 50' ); cmp_ok( (tied $x)->max(100), '==', 50, 'max is 50, set to 100' ); cmp_ok( (tied $x)->max, '==', 100, 'max is 100' ); cmp_ok( (tied $x)->period, '==', 16, 'period is 16' ); cmp_ok( (tied $x)->period(20), '==', 16, 'period is 16, set to 20' ); cmp_ok( (tied $x)->period, '==', 20, 'period is 20' ); } { tie my $y, 'Tie::Cycle::Sinewave', { min => 50, max => -50, start_min => 1, }; cmp_ok( (tied $y)->min, '==', -50, 'swap min is -50' ); cmp_ok( (tied $y)->max, '==', 50, 'swap max is 50' ); cmp_ok( (tied $y)->max(-100), '==', 50, 'max is 50, set to -100' ); cmp_ok( (tied $y)->min, '==', -100, 'now swap min is -100' ); cmp_ok( (tied $y)->max, '==', -50, 'now swap max is -50' ); cmp_ok( $y, '==', -100, 'min start -100' ); } { my $at_min = 0; my $at_max = 0; my $dont_care; tie my $cb, 'Tie::Cycle::Sinewave', { period => 20, at_max => sub { ++$at_max }, at_min => sub { ++$at_min }, startmax => 1, }; $dont_care = $cb for 1..11; cmp_ok( $at_max, '==', 0, 'not yet past max' ); cmp_ok( $at_min, '==', 1, 'but past min' ); $dont_care = $cb for 1..11; cmp_ok( $at_max, '==', 1, 'now past max' ); } { my $at_min = 0; my $at_max = 0; my $dont_care; tie my $cb, 'Tie::Cycle::Sinewave', { period => 20, atmax => sub { ++$at_max }, atmin => sub { ++$at_min }, startmin => 1, }; $dont_care = $cb for 1..11; cmp_ok( $at_min, '==', 0, 'not yet past min' ); cmp_ok( $at_max, '==', 1, 'but past max' ); $dont_care = $cb for 1..11; cmp_ok( $at_min, '==', 1, 'now past min' ); } { my $dont_care; my $period = 17; tie my $d, 'Tie::Cycle::Sinewave', { min => 18, max => 99, period => $period, at_min => 'nop', at_max => 'nop', }; my $first = $d; my $angle = (tied $d)->angle; $dont_care = $d for 1 .. ($period - 1); cmp_ok( abs($first - $d), '<', 1e-3, 'back to where we started' ); my $now = (tied $d)->angle; my $error = abs($angle - $now); $error -= Tie::Cycle::Sinewave::PI_2 if $error > Tie::Cycle::Sinewave::PI; cmp_ok( $error, '<', 1e-3, 'angle check' ) or diag("angle=$angle, now=$now"); my $next = $d; ok( not( exists( (tied $d)->{at_min} )), 'at_min not defined for garbage' ); ok( not( exists( (tied $d)->{at_max} )), 'at_max not defined for garbage' ); $dont_care = $d for 1 .. 10; $d = $angle; cmp_ok( abs($next - $d), '<', 1e-3, 'STORE check' ); } { my $dont_care; tie my $p, 'Tie::Cycle::Sinewave', { min => 18, max => 90, period => 0, }; cmp_ok( (tied $p)->period, '==', 1, 'zero-length period changed to 1' ); cmp_ok( (tied $p)->period(0), '==', 1, 'period is 1, set to 0' ); cmp_ok( (tied $p)->period, '==', 1, 'zero-length period changed to 1 again' ); }