The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

NAME

Tk::Image::Calculation - Perl extension for graphic calculations

SYNOPSIS

    use Tk::Image::Calculation;
    my @points_oval = (10, 10, 30, 50);
    my @points_circle = (20, 20, 60, 60);
    my @points_polygon = (136, 23, 231, 55, 463, 390, 338, 448, 182, 401, 148, 503, 15, 496, 9, 87);
    # polygon = (x1, y1, x2, y2, x3, y3, x4, y4, ... and so on)
    
    my $cal = Tk::Image::Calculation->new();    
    my $ref_array = $cal->GetPointsInOval(@points_oval);
    # my $ref_array = $cal->GetPointsOutOval(@points_oval);
    # my $ref_array = $cal->GetPointsInCircle(@points_circle);
    # my $ref_array = $cal->GetPointsOutCircle(@points_circle);
    # my $ref_array = $cal->GetPointsInPolygon(@points_polygon);
    # my $ref_array = $cal->GetPointsOutPolygon(@points_polygon);
    
    for(@{$ref_array})
    {
        print("x:$_->[0]    y:$_->[1]\n");
    }
    
    my $ref_array1 = $cal->GetLinesInOval(@points_oval);
    # my $ref_array1 = $cal->GetLinesOutOval(@points_oval);
    # my $ref_array1 = $cal->GetLinesInCircle(@points_circle);
    # my $ref_array1 = $cal->GetLinesOutCircle(@points_circle);
    # my $ref_array1 = $cal->GetLinesInPolygon(@points_polygon);
    # my $ref_array1 = $cal->GetLinesOutPolygon(@points_polygon);
    for(@{$ref_array1})
    {
        print("x1:$_->[0]   y1:$_->[1]  x2:$_->[2]  y2:$_->[3]\n");
    }
    
    #-------------------------------------------------
    my $cal1 = Tk::Image::Calculation->new(
        -points => \@points_circle,
        -form   => "circle", # or "oval" or "polygon"
    );
    for my $subset ("points_inside", "points_outside")
    {
        print("\n$subset circle : \n");
        for(@{$cal1->{$subset}})
        {
            print("x:$_->[0]    y:$_->[1]\n");
        }
    }
    for my $subset ("lines_inside", "lines_outside")
    {
        print("\n$subset circle : \n");
        for(@{$cal1->{$subset}})
        {
            print("x1:$_->[0]   y1:$_->[1]  x2:$_->[2]  y2:$_->[3]\n");
        }
    }
    
    #-------------------------------------------------
    my $cal2 = Tk::Image::Calculation->new(
        -points => \@points_polygon, # need three points at least
        -form   => "polygon", 
        -subset => "lines_outside", # defaults to "all"
    );
    
    use Tk;
    my $mw = MainWindow->new();
    my $canvas = $mw->Canvas(
        -width  => 800,
        -height => 600,
    )->pack();
    
    for(@{$cal2->{lines_outside}})
    {
        $canvas->createLine(@{$_});
    }
    MainLoop();
    
    #-------------------------------------------------
    use Tk;
    use Tk::JPEG;
    my $mw = MainWindow->new();
    my $image = $mw->Photo(-file => "test.jpg");
    my $cal3 = Tk::Image::Calculation->new();
    my $ref_points = $cal3->GetPointsOutCircle(50, 50, 150,  150);
    $image->put("#FFFFFF", -to => $_->[0], $_->[1]) for(@{$ref_points});
    $image->write("new.jpg", -from => 50, 50, 150, 150);
    #-------------------------------------------------

DESCRIPTION

This module calculates points and lines inside or outside from simple graphic objects. At this time possible objects:

    "oval",
    "circle",
    "polygon"

CONSTRUCTOR

    my $object = Tk::Image::Calculation->new();

Returns an empty object just for calling the methods.

    my $object = Tk::Image::Calculation->new(
        -points => [$x1, $y1, $x2, $y2],    # required
        -form   => "oval",      # required
        -subset => "points_outside, # optional
    );

    -points    takes a arrayreference with points  required
    -form  takes one of the forms "oval", "circle" or "polygon" required
    -subset    takes one of the strings "points_outside", "points_inside", "lines_inside" or "lines_outside" 
    
    optional defaults to "all"

Returns a hashreference blessed as object with a key that was defined with the options -subset. The value of the key is an arrayreferences with points or lines.

    Points [x, y]
    Lines [x1, y1, x2, y2]

Is the option -subset set to "all" the returned hash have the following keys.

    "points_outside",
    "points_inside",
    "lines_outside",
    "lines_inside"

METHODS

Two points are handed over to the functions for Oval or Circle. In the following form ($x1, $y1, $x2, $y2). The first point to the left up and the second point to the right below of a thought rectangle, in that the graphic object does fitting. The returned values are array references of points or lines.

    Points [x, y]
    Lines [x1, y1, x2, y2]
GetPointsOval

Takes over two points as parameters. Returns a hashreferences with the following keys.

    "points_outside", 
    "points_inside",
    "lines_outside", 
    "lines_inside"

The values of the keys are arrayreferences with points or lines.

GetPointsInOval, GetPointsOutOval, GetLinesInOval, GetLinesOutOval

Takes over two points as parameters. Returns a array reference of Points or Lines inside or outside of the Oval.

GetPointsCircle

Just the same as GetPointsOval.

GetPointsInCircle, GetPointsOutCircle, GetLinesInCircle, GetLinesOutCircle

Takes over two points as parameters. Returns a array reference of Points or Lines inside or outside of the Circle.

GetPointsPolygon

Takes over a list of points in the following way.

    my @polygon = (x1, y1, x2, y2, x3, y3, x4, y4, ... and so on)
    my $ref_hash = $object->GetPointsPolygon(@polygon);

Need at least three points. Returns a hashreferences with the following keys.

    "points_outside", 
    "points_inside",
    "lines_outside", 
    "lines_inside"

The values of the keys are arrayreferences with points or lines.

GetPointsInPolygon, GetPointsOutPolygon, GetLinesInPolygon, GetLinesOutPolygon

Takes over a list with at least three points. Returns a array reference of Points or Lines inside or outside of the Circle.

EXPORT

None by default.

SEE ALSO

Tk::Image::Cut

KEYWORDS

graphic, calculation

BUGS

Maybe you'll find some. Please let me know.

AUTHOR

Torsten Knorr

COPYRIGHT AND LICENSE

Copyright (C) 2006 by Torsten Knorr

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.9.2 or, at your option, any later version of Perl 5 you may have available.