—
—
—

              
package Cairo::CuttingLine;
use warnings;
use strict;
HideShow 10 lines of Pod
=head1 NAME
Cairo::CuttingLine - draw cutting line to cairo surface
=head1 VERSION
Version 0.05
=cut
our $VERSION = '0.05';
HideShow 40 lines of Pod
=head1 SYNOPSIS
to use Cairo::CuttingLine to render cutting lines to a canvas:
    use Cairo::CuttingLine;
we need to provide L<Cairo::Context> for L<Cairo::CuttingLine> method new.
    my $surf = Cairo::ImageSurface->create ('argb32', 200 , 200 );
    my $cr = Cairo::Context->create ($surf);
set Cairo::Context object
    my $page = Cairo::CuttingLine->new( $cr );
or by cr accessor
    $page->cr( $cr );
    $page->set(  x => 10 , y => 10  );
    $page->size( width => 100 , width => 120 );
    $page->length( 10 );
    $page->line_width( 3 );
    $page->color( 1, 1, 1, 1 );    # for set_source_rgba
    $page->stroke();
=head1 DESCRIPTION
Cairo::CuttingLine draws cutting line like this:
    |       |
   -+       +-
      IMAGE
   -+       +-
    |       |
=head1 FUNCTIONS
=cut
sub new {
    my $class = shift;
    my $self = {};
    bless $self , $class;
    $self->{cr} = shift;
    return $self;
}
sub cr {
    my $self = shift;
    $self->{cr} = shift if @_;
    $self->{cr};
}
sub set {
    my $self = shift;
    $self->{p} = { @_ } if @_;
    return $self->{p};
}
sub length {
    my $self = shift;
    $self->{length} = shift if @_;
    $self->{length};
}
sub size {
    my $self = shift;
    $self->{size} = { @_ } if @_;
    $self->{size};
}
sub color {
    my $self = shift;
    $self->{color} = [ @_ ] if @_;
    $self->{color};
}
sub line_width {
    my $self = shift;
    $self->{line_width} = shift if @_;
    $self->{line_width};
}
sub stroke {
    my $self = shift;
    my $cr = $self->{cr};
    $cr->save;
    my $color = $self->{color};
    $color ||= [1,1,1,1];
    $cr->set_source_rgba( @$color );
    $cr->set_line_width( $self->line_width );
    my $pos = $self->set;
    my $s = $self->size;
    my $line_len = $self->length;
    for my $p ( 0 .. 3 ) {
        my ( $c_x, $c_y ) = ( $pos->{x}, $pos->{y} );
        if( $p & 1 ) {
            $c_x += $s->{width};
        }
        if( $p & 2 ) {
            $c_y += $s->{height};
        }
        $cr->move_to( $c_x , $c_y );
        $cr->line_to(
            $c_x + ( $p & 1 ? $line_len : -$line_len ),
            $c_y
        );
        $cr->move_to( $c_x , $c_y );
        $cr->line_to(
            $c_x,
            $c_y + ( $p & 2 ? $line_len : -$line_len ),
        );
        $cr->stroke();
    }
    $cr->restore;
}
HideShow 53 lines of Pod
=head1 AUTHOR
Cornelius, C<< <cornelius.howl at gmail.com> >>
=head1 BUGS
Please report any bugs or feature requests to C<bug-cairo-cuttingline at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Cairo-CuttingLine>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
    perldoc Cairo::CuttingLine
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Cairo-CuttingLine>
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/Cairo-CuttingLine>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/Cairo-CuttingLine>
=item * Search CPAN
L<http://search.cpan.org/dist/Cairo-CuttingLine/>
=back
=head1 ACKNOWLEDGEMENTS
=head1 COPYRIGHT & LICENSE
Copyright 2009 Cornelius, 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 Cairo::CuttingLine