From d48428e06cb39d4d8b33eaf3545bc18b0cdcce82 Mon Sep 17 00:00:00 2001 From: Max Maischein Date: Sat, 4 Jun 2011 15:57:25 +0200 Subject: [PATCH] Get release ready for CPAN --- Changes | 4 ++ MANIFEST | 16 +++++ MANIFEST.skip | 17 ++++++ README | 121 ++++++++++++++++++++++++++++++++++++++ lib/Random/PoissonDisc.pm | 44 +++++++++++--- t/99-changes.t | 28 +++++++++ t/99-examples.t | 16 +++++ t/99-manifest.t | 31 ++++++++++ t/99-pod.t | 36 ++++++++++++ t/99-todo.t | 47 +++++++++++++++ t/99-unix-text.t | 37 ++++++++++++ t/99-versions.t | 49 +++++++++++++++ 12 files changed, 437 insertions(+), 9 deletions(-) create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 MANIFEST.skip create mode 100644 README create mode 100644 t/99-changes.t create mode 100644 t/99-examples.t create mode 100644 t/99-manifest.t create mode 100644 t/99-pod.t create mode 100644 t/99-todo.t create mode 100644 t/99-unix-text.t create mode 100644 t/99-versions.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..feb8804 --- /dev/null +++ b/Changes @@ -0,0 +1,4 @@ +TO DO: + +0.01 20110603 + . Released on an unsuspecting world diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..4acadaa --- /dev/null +++ b/MANIFEST @@ -0,0 +1,16 @@ +.gitignore +bin/random-poissondisc.pl +Changes +lib/Random/PoissonDisc.pm +Makefile.PL +MANIFEST This list of files +MANIFEST.skip +README +t/01-random-unit-vector.t +t/99-changes.t +t/99-examples.t +t/99-manifest.t +t/99-pod.t +t/99-todo.t +t/99-unix-text.t +t/99-versions.t diff --git a/MANIFEST.skip b/MANIFEST.skip new file mode 100644 index 0000000..c1614f9 --- /dev/null +++ b/MANIFEST.skip @@ -0,0 +1,17 @@ +.cvsignore$ +^.git/ +^.lwpcookies +^.releaserc +^blib/ +^Random-PoissonDisc-.* +CVS/ +^pm_to_blib +.tar.gz$ +.old$ +^Makefile$ +^cvstest$ +^blibdirs$ +.bak$ +^cover_db/ +^db/ +^documents/ \ No newline at end of file diff --git a/README b/README new file mode 100644 index 0000000..59110e4 --- /dev/null +++ b/README @@ -0,0 +1,121 @@ +NAME + Random::PoissonDisc - distribute points aesthetically in R^n + +SYNOPSIS + my $points = Random::PoissonDisc->points( + dimensions => [100,100], + r => $r, + ); + print join( ",", @$_),"\n" + for @$points; + + This module allows relatively fast (O(N)) generation of random points in + *n*-dimensional space with a distance of at least `r' between each + other. This distribution results in aesthetic so called "blue noise". + + The algorithm was adapted from a sketch by Robert Bridson in + http://www.cs.ubc.ca/~rbridson/docs/bridson-siggraph07-poissondisk.pdf. + +DATA REPRESENTATION + All vectors (or points) are represented as anonymous arrays of numbers. + All have the same dimension as the cardinality of the `dimensions' array + passed in the `->points' method. + + USER INTERFACE + `Random::PoissonDisc->points( %options )' + Returns a reference to an array of points. + + Acceptable options are: + + * ` - minimum distance between points. + + Default is 10 units. + + * ` - number of dimensions and respective value range as + an arrayref. + + Default is + + [ 100, 100 ] + + meaning all points will be in R^2 , with each coordinate in the + range [0, 100). + + * ` - Number of candidates to inspect before deciding + that no ew neighbours can be placed around a point. + + Default is 30. + + This number may or may not need to be tweaked if you go further up + in dimensionality beyond 3 dimensions. The more candidates you + inspect the longer the algorithm will run for generating a number of + points. + + In the algorithm description, this constant is named *k*. + + INTERNAL SUBROUTINES + These subroutines are used for the algorithm. If you want to port this + module to PDL or any other vector library, you will likely have to + rewrite these. + + `rnd( $low, $high )' + print rnd( 0, 1 ); + + Returns a uniform distributed random number in `[ $low, $high )'. + + `grid_coords( $grid_size, $point )' + Returns the string representing the coordinates of the grid cell in + which `$point' falls. + + `norm( @vector )' + print norm( 1,1 ); # 1.4142 + + Returns the Euclidean length of the vector, passed in as array. + + `vdist( $l, $r )' + print vdist( [1,0], [0,1] ); # 1.4142 + + Returns the Euclidean distance between two points (or vectors) + + `neighbour_points( $size, $point, $grid )' + my @neighbours = neighbour_points( $size, $p, \%grid ) + + Returns the points from the grid that have a distance between 0 and 2r + around `$point'. These points are the candidates to check when trying to + insert a new random point into the space. + + `random_unit_vector( $dimensions )' + print join ",", @{ random_unit_vector( 2 ) }; + + Returns a vector of unit lenght poiting in a random uniform distributed + *n*-dimensional direction angle and returns a unit vector pointing in + that direction + + The algorithm used is outlined in Knuth, _The Art of Computer + Programming_, vol. 2, 3rd. ed., section 3.4.1.E.6. but has not been + verified formally or mathematically by the module author. + +TODO + The module does not use PDL or any other vector library. + +REPOSITORY + The public repository of this module is + http://github.com/Corion/random-poissondisc. + +SUPPORT + The public support forum of this module is http://perlmonks.org/. + +BUG TRACKER + Please report bugs in this module via the RT CPAN bug queue at + https://rt.cpan.org/Public/Dist/Display.html?Name=Random-PoissonDisc or + via mail to random-poissondisc@rt.cpan.org. + +AUTHOR + Max Maischein `corion@cpan.org' + +COPYRIGHT (c) + Copyright 2011 by Max Maischein `corion@cpan.org'. + +LICENSE + This module is released under the same terms as Perl itself. + diff --git a/lib/Random/PoissonDisc.pm b/lib/Random/PoissonDisc.pm index fa94421..320f282 100644 --- a/lib/Random/PoissonDisc.pm +++ b/lib/Random/PoissonDisc.pm @@ -85,26 +85,24 @@ In the algorithm description, this constant is named I. sub points { my ($class,%options) = @_; - # XXX Allow the grid to be passed in $options{candidates} ||= 30; $options{dimensions} ||= [100,100]; # do we only create integral points? $options{r} ||= 10; - #$options{max} ||= 10; # we want to fill the space instead?! + #$options{max} ||= 10; # we want to fill the space instead?! + $options{ grid } ||= {}; my $grid_size = $options{ r } / sqrt( 0+@{$options{dimensions}}); my @result; my @work; - my %grid; # well, a fakey grid, but as long as we use only integer - # coordinates for the grid, using a hash and normalized point coordinates is convenient # Create a first random point somewhere in our cube: my $p = [map { rnd(0,$_) } @{ $options{ dimensions }}]; push @result, $p; push @work, $p; my $c = grid_coords($grid_size, $p); - $grid{ $c } = $p; + $options{ grid }->{ $c } = $p; while (@work) { my $origin = splice @work, int rnd(0,$#work), 1; @@ -131,8 +129,8 @@ sub points { # check discs by using the grid # Here we should check the "neighbours" in the grid too my $c = grid_coords($grid_size, $p); - if (! $grid{ $c }) { - my @n = neighbour_points($grid_size, $p, \%grid); + if (! $options{ grid }->{ $c }) { + my @n = neighbour_points($grid_size, $p, $options{ grid }); for my $neighbour (@n) { if( vdist($neighbour, $p) < $options{ r }) { next CANDIDATE; @@ -142,7 +140,7 @@ sub points { # not already in grid, no close neighbours, add it push @result, $p; push @work, $p; - $grid{ $c } = $p; + $options{ grid }->{ $c } = $p; #warn "$candidate Taking"; } else { #warn "$candidate Occupied"; @@ -297,4 +295,32 @@ sub random_unit_vector { The module does not use L or any other vector library. -=cut \ No newline at end of file +=head1 REPOSITORY + +The public repository of this module is +L. + +=head1 SUPPORT + +The public support forum of this module is +L. + +=head1 BUG TRACKER + +Please report bugs in this module via the RT CPAN bug queue at +L +or via mail to L. + +=head1 AUTHOR + +Max Maischein C + +=head1 COPYRIGHT (c) + +Copyright 2011 by Max Maischein C. + +=head1 LICENSE + +This module is released under the same terms as Perl itself. + +=cut diff --git a/t/99-changes.t b/t/99-changes.t new file mode 100644 index 0000000..eecbcb1 --- /dev/null +++ b/t/99-changes.t @@ -0,0 +1,28 @@ +#!perl -w +use warnings; +use strict; +use File::Find; +use Test::More tests => 2; + +=head1 PURPOSE + +This test ensures that the Changes file +mentions the current version and that a +release date is mentioned as well + +=cut + +my $module = 'WWW::Mechanize::Firefox'; + +(my $file = $module) =~ s!::!/!g; +require "$file.pm"; + +my $version = sprintf '%0.2f', $module->VERSION; +diag "Checking for version " . $version; + +my $changes = do { local $/; open my $fh, 'Changes' or die $!; <$fh> }; + +ok $changes =~ /^(.*$version.*)$/m, "We find version $version"; +my $changes_line = $1; +ok $changes_line =~ /$version\s+20\d{6}/, "We find a release date on the same line" + or diag $changes_line; diff --git a/t/99-examples.t b/t/99-examples.t new file mode 100644 index 0000000..f45b8dd --- /dev/null +++ b/t/99-examples.t @@ -0,0 +1,16 @@ +#!perl -w + +use warnings; +use strict; +use Test::More; +use File::Find; + +plan 'no_plan'; + +sub check { + return if (! m{\.pl \z}xms); + my $output = `"$^X" -c $_ 2>&1`; + like( $output, qr/$_ syntax OK/, "$_ compiles" ) +} + +find({wanted => \&check, no_chdir => 1}, 'examples'); diff --git a/t/99-manifest.t b/t/99-manifest.t new file mode 100644 index 0000000..38f5cba --- /dev/null +++ b/t/99-manifest.t @@ -0,0 +1,31 @@ +use strict; +use Test::More; + +# Check that MANIFEST and MANIFEST.skip are sane : + +use File::Find; +use File::Spec; + +my @files = qw( MANIFEST MANIFEST.skip ); +plan tests => scalar @files * 4 + +1 # MANIFEST existence check + ; + +for my $file (@files) { + ok(-f $file, "$file exists"); + open F, "<$file" + or die "Couldn't open $file : $!"; + my @lines = ; + is_deeply([grep(/^$/, @lines)],[], "No empty lines in $file"); + is_deeply([grep(/^\s+$/, @lines)],[], "No whitespace-only lines in $file"); + is_deeply([grep(/^\s*\S\s+$/, @lines)],[],"No trailing whitespace on lines in $file"); + + if ($file eq 'MANIFEST') { + chomp @lines; + is_deeply([grep { s/\s.*//; ! -f } @lines], [], "All files in $file exist") + or do { diag "$_ is mentioned in $file but doesn't exist on disk" for grep { ! -f } @lines }; + }; + + close F; +}; + diff --git a/t/99-pod.t b/t/99-pod.t new file mode 100644 index 0000000..079bc40 --- /dev/null +++ b/t/99-pod.t @@ -0,0 +1,36 @@ +use Test::More; + +# Check our Pod +# The test was provided by Andy Lester, +# who stole it from Brian D. Foy +# Thanks to both ! + +use File::Spec; +use File::Find; +use strict; + +eval { + require Test::Pod; + Test::Pod->import; +}; + +my @files; + +if ($@) { + plan skip_all => "Test::Pod required for testing POD"; +} +elsif ($Test::Pod::VERSION < 0.95) { + plan skip_all => "Test::Pod 0.95 required for testing POD"; +} +else { + my $blib = File::Spec->catfile(qw(blib lib)); + find(\&wanted, grep { -d } ($blib, 'bin')); + plan tests => scalar @files; + foreach my $file (@files) { + pod_file_ok($file); + } +} + +sub wanted { + push @files, $File::Find::name if /\.p(l|m|od)$/; +} diff --git a/t/99-todo.t b/t/99-todo.t new file mode 100644 index 0000000..17f8aef --- /dev/null +++ b/t/99-todo.t @@ -0,0 +1,47 @@ +use Test::More; +use File::Spec; +use File::Find; +use strict; + +# Check that all files do not contain any +# lines with "XXX" - such markers should +# either have been converted into Todo-stuff +# or have been resolved. +# The test was provided by Andy Lester. + +my @files; +my $blib = File::Spec->catfile(qw(blib lib)); +find(\&wanted, grep { -d } ($blib, 'bin')); +plan tests => 2* @files; +foreach my $file (@files) { + source_file_ok($file); +} + +sub wanted { + push @files, $File::Find::name if /\.p(l|m|od)$/; +} + +sub source_file_ok { + my $file = shift; + + open( my $fh, "<$file" ) or die "Can't open $file: $!"; + my @lines = <$fh>; + close $fh; + + my $n = 0; + for ( @lines ) { + ++$n; + s/^/$file ($n): /; + } + + my @x = grep /XXX/, @lines; + + if ( !is( scalar @x, 0, "Looking for XXXes in $file" ) ) { + diag( $_ ) for @x; + } + @x = grep /<<<|>>>/, @lines; + + if ( !is( scalar @x, 0, "Looking for <<<<|>>>> in $file" ) ) { + diag( $_ ) for @x; + } +} diff --git a/t/99-unix-text.t b/t/99-unix-text.t new file mode 100644 index 0000000..f91c526 --- /dev/null +++ b/t/99-unix-text.t @@ -0,0 +1,37 @@ +use Test::More; + +# Check that all released module files are in +# UNIX text format + +use File::Spec; +use File::Find; +use strict; + +my @files; + +my $blib = File::Spec->catfile(qw(blib lib)); +find(\&wanted, grep { -d } ($blib, 'bin')); +plan tests => scalar @files; +foreach my $file (@files) { + unix_file_ok($file); +} + +sub wanted { + push @files, $File::Find::name if /\.p(l|m|od)$/; +} + +sub unix_file_ok { + my ($filename) = @_; + local $/; + open F, "< $filename" + or die "Couldn't open '$filename' : $!\n"; + binmode F; + my $content = ; + + my $i; + my @lines = grep { /\x0D\x0A$/sm } map { sprintf "%s: %s\x0A", $i++, $_ } split /\x0A/, $content; + unless (is(scalar @lines, 0,"'$filename' contains no windows newlines")) { + diag $_ for @lines; + }; + close F; +}; diff --git a/t/99-versions.t b/t/99-versions.t new file mode 100644 index 0000000..597a084 --- /dev/null +++ b/t/99-versions.t @@ -0,0 +1,49 @@ +#!perl -w + +# Stolen from ChrisDolan on use.perl.org +# http://use.perl.org/comments.pl?sid=29264&cid=44309 + +use warnings; +use strict; +use File::Find; +use Test::More; +BEGIN { + eval 'use File::Slurp; 1'; + if ($@) { + plan skip_all => "File::Slurp needed for testing"; + exit 0; + }; +}; + +plan 'no_plan'; + +my $last_version = undef; + +sub check { + return if (! m{blib/script/}xms && ! m{\.pm \z}xms); + + my $content = read_file($_); + + # only look at perl scripts, not sh scripts + return if (m{blib/script/}xms && $content !~ m/\A \#![^\r\n]+?perl/xms); + + my @version_lines = $content =~ m/ ( [^\n]* \$VERSION \s* = [^=] [^\n]* ) /gxms; + if (@version_lines == 0) { + fail($_); + } + for my $line (@version_lines) { + if (!defined $last_version) { + $last_version = shift @version_lines; + diag "Checking for $last_version"; + pass($_); + } else { + is($line, $last_version, $_); + } + } +} + +find({wanted => \&check, no_chdir => 1}, 'blib'); + +if (! defined $last_version) { + fail('Failed to find any files with $VERSION'); +}