HiPi

 view release on metacpan or  search on metacpan

lib/HiPi/Graphics/DrawingContext.pm  view on Meta::CPAN

    $self->draw_arc($x2 - $r, $y2 - $r, $r, $r, 0, 90, 0, $fill );
    #bottom left
    $self->draw_arc($x1 + $r, $y2 - $r, $r, $r, 90, 180, 0, $fill );
       
    # draw the pixels
    
    for my $point ( @points ) {
        $self->draw_pixel( @$point, 1);
    }
}

sub draw_polygon {
    my ( $self, $inputvertices, $fill ) = @_;
    
    my @vertices = @$inputvertices;
    return unless( scalar(@vertices) > 2 );
    
    # Close the polygon if it is not closed
    if($vertices[0]->[0] != $vertices[-1]->[0] || $vertices[0]->[1] != $vertices[-1]->[1]) {
        push @vertices , [ $vertices[0]->[0], $vertices[0]->[1] ];
    }
    
    my $lastpoint;
    my @polypoints = ();
    
    for my $inpoint ( @vertices ) {
        if( $lastpoint ) {
            my $linepoints = $self->_get_line_points( @$lastpoint, @$inpoint, 0 );
            push @polypoints, @$linepoints;
        }
        $lastpoint = $inpoint;
    }
    
    if( $fill ) {
        my($minX, $minY, $maxX, $maxY) = ( $self->buffer_cols, $self->buffer_rows, 0,0 );
        for my $point ( @polypoints ) {
            $maxX = $point->[0] if $point->[0] > $maxX;
            $maxY = $point->[1] if $point->[1] > $maxY;
            $minX = $point->[0] if $point->[0] < $minX;
            $minY = $point->[1] if $point->[1] < $minY;
        }
        my @newpoints = ();
        for (my $x = $minX; $x < $maxX; $x++) {
            for (my $y = $minY; $y < $maxY; $y++) {
                if( _point_in_polygon([$x, $y], @vertices ) ) {
                    push @newpoints, [ $x, $y ];
                }
            }
        }
        push @polypoints, @newpoints;
    }
    
    # draw
    
    for my $point ( @polypoints ) {
        $self->draw_pixel( @$point, 1);
    }
}

# _point_in_polygon
# Learned from latest Math::Polygon but that isn't in Raspbian Stretch
# and we only want this single function. There are no improvements here.

sub _point_in_polygon {
    my $point = shift;
    return 0 if @_ < 3;

    my ($x, $y) = @$point;
    my $inside  = 0;

    my ($px, $py) = @{ (shift) };

    while(@_) {
        my ($nx, $ny) = @{ (shift) };

        return 1 if $y==$py && $py==$ny
                 && ($x >= $px || $x >= $nx)
                 && ($x <= $px || $x <= $nx);

        return 1 if $x==$px && $px==$nx
                 && ($y >= $py || $y >= $ny)
                 && ($y <= $py || $y <= $ny);

        if(   $py == $ny
           || ($y <= $py && $y <= $ny)
           || ($y >  $py && $y >  $ny)
           || ($x >  $px && $x >  $nx)
          )  {
            ($px, $py) = ($nx, $ny);
            next;
        }

        my $xinters = ($y-$py)*($nx-$px)/($ny-$py)+$px;
        $inside = !$inside if $px==$nx || $x <= $xinters;
        ($px, $py) = ($nx, $ny);
    }
    
    return $inside;
}

sub draw_line {
    my( $self, $x1, $y1, $x2, $y2, $ep ) = @_;
    
    my $linepoints = $self->_get_line_points( $x1, $y1, $x2, $y2, $ep );
    
    # draw the pixels
    
    for my $point ( @$linepoints ) {
        $self->draw_pixel( @$point, 1);
    }
}

sub _get_line_points {
    
    my( $self, $x0, $y0, $x1, $y1, $ep ) = @_;
    
    $ep //= 1;
    
    my @points = ();
    
    my $dx = $x1 - $x0 >= 0 ? $x1 - $x0 : $x0 - $x1;



( run in 0.495 second using v1.01-cache-2.11-cpan-f4a522933cf )