File Coverage

blib/lib/Path/Hilbert.pm

Criterion	Covered	Total	%
statement	86	89	96.6
branch	5	6	83.3
condition			n/a
subroutine	18	19	94.7
pod	3	3	100.0
total	112	117	95.7

package Path::Hilbert;

use strict;
use warnings;
use 5.012;
use utf8;

use Exporter qw( import );

our @EXPORT = qw( xy2d d2xy );

our $VERSION = '1.204';

# optional constructor if you want OO-style
sub new {
    my $class = shift;
    my ($n) = @_;
    return bless { n => $n } => $class;
}

# convert (x,y) to d
sub xy2d {
    my ($side, $x, $y) = @_;
    my $n = _valid_n($side);
    my ($X, $Y) = map { int($_ + 0.5) } ($x, $y);
    my $D;
    {
        use integer;
        my $d = 0;
        my ($x, $y) = map { int($_) } ($X, $Y);
        for (my $s = $n / 2; $s > 0; $s /= 2) {
            my $rx = ($x & $s) > 0;
            my $ry = ($y & $s) > 0;
            $d += $s * $s * ((3 * $rx) ^ $ry);
            ($x, $y) = _rot($s, $x, $y, $rx, $ry);
        }
        no integer;
        $D = $d;
    }
    return $D * _side_scale($side);
}

# convert d to (x,y)
sub d2xy {
    my ($side, $d) = @_;
    my $n = _valid_n($side);
    my $T = int($d + 0.5);
    my ($X, $Y);
    {
        use integer;
        my ($x, $y) = (0, 0);
        my $t = int($T);
        for (my $s = 1; $s < $n; $s *= 2) {
            my $rx = 1 & ($t / 2);
            my $ry = 1 & ($t ^ $rx);
            ($x, $y) = _rot($s, $x, $y, $rx, $ry);
            $x += $s * $rx;
            $y += $s * $ry;
            $t /= 4;
        }
        no integer;
        ($X, $Y) = ($x, $y);
    }
    return map { _side_scale($side) * $_ } ($X, $Y);
}

# rotate/flip a quadrant appropriately
sub _rot {
    use integer;
    my ($n, $x, $y, $rx, $ry) = map { int($_) } @_;
    if (!$ry) {
        if ($rx) {
            $x = $n - 1 - $x;
            $y = $n - 1 - $y;
        }
        ($x, $y) = ($y, $x);
    }
    return ($x, $y);
}

sub _valid_n {
    my $n = _extract_side(shift(@_));
    no integer;
    my $rv = 2 ** int((log($n) / log(2)) + 0.5);
    use integer;
    return int($rv);
}

sub _extract_side {
    my ($n) = @_;
    $n = $n->{ n } if ref($n);
    return $n;
}

sub _side_scale {
    my $side = _extract_side(shift(@_));
    my $n = _valid_n($side);
    return $side / $n;
}

1;

__END__