view release on metacpan or  search on metacpan

lib/Algorithm/BinPack/2D.pm  view on Meta::CPAN

    if ($bin->{left}) {
        return pack_in_a_bin($bin->{left}, $width, $height, $label)
          || pack_in_a_bin($bin->{right}, $width, $height, $label);
    }

    if (   $bin->{filled}
        || $bin->{width} < $width
        || $bin->{height} < $height) {
        return;
    }

    if ($bin->{width} == $width && $bin->{height} == $height) {
        $bin->{filled} = 1;
        $bin->{label}  = $label;
        return $bin;
    }

    my $width_diff  = $bin->{width} - $width;
    my $height_diff = $bin->{height} - $height;

    if ($width_diff > $height_diff) {
        $bin->{left} = +{
            x      => $bin->{x},
            y      => $bin->{y},
            filled => 0,
            width  => $width,
            height => $bin->{height},
        };
        $bin->{right} = +{
            x      => $bin->{x} + $width,
            y      => $bin->{y},
            filled => 0,
            width  => $width_diff,
            height => $bin->{height},
        };
    } else {
        $bin->{left} = +{
            x      => $bin->{x},
            y      => $bin->{y},
            filled => 0,
            width  => $bin->{width},
            height => $height,
        };
        $bin->{right} = +{
            x      => $bin->{x},
            y      => $bin->{y} + $height,
            filled => 0,
            width  => $bin->{width},
            height => $height_diff,
        };
    }

    return pack_in_a_bin($bin->{left}, $width, $height, $label);
} ## end sub pack_in_a_bin

sub sort_items {
    my $items = shift;

    sort {
        # Sorting by max(width, height) is the best heuristic.
        my $abigger = $a->{width} > $a->{height} ? $a->{width} : $a->{height};
        my $bbigger = $b->{width} > $b->{height} ? $b->{width} : $b->{height};

        my $asmaller = $a->{width} <= $a->{height} ? $a->{width} : $a->{height};
        my $bsmaller = $b->{width} <= $b->{height} ? $b->{width} : $b->{height};

             $bbigger <=> $abigger
          || $bsmaller <=> $asmaller
          || $b->{width} <=> $a->{width}
          || $a->{label} cmp $b->{label}
    } @{$items};
}

1;

=back

=head1 SEE ALSO

C<Algorithm::BinPack>

=head1 AUTHOR

Tasuku SUENAGA a.k.a. gunyarakun E<lt>tasuku-s-cpan ATAT titech.acE<gt>

=head1 LICENSE

Copyright (C) Tasuku SUENAGA a.k.a. gunyarakun

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut