Graphics-Framebuffer

 view release on metacpan or  search on metacpan

src/Framebuffer.pm  view on Meta::CPAN

=over 4

 $fb->clip_set({
    'x'  => 10,
    'y'  => 10,
    'xx' => 300,
    'yy' => 300
 });

=back

=cut

sub clip_set {
    my ($self, $params) = @_;

    $self->{'X_CLIP'}  = abs(int($params->{'x'}));
    $self->{'Y_CLIP'}  = abs(int($params->{'y'}));
    $self->{'XX_CLIP'} = abs(int($params->{'xx'}));
    $self->{'YY_CLIP'} = abs(int($params->{'yy'}));

    $self->{'X_CLIP'}  = ($self->{'XRES'} - 2) if ($self->{'X_CLIP'} > ($self->{'XRES'} - 1));
    $self->{'Y_CLIP'}  = ($self->{'YRES'} - 2) if ($self->{'Y_CLIP'} > ($self->{'YRES'} - 1));
    $self->{'XX_CLIP'} = ($self->{'XRES'} - 1) if ($self->{'XX_CLIP'} >= $self->{'XRES'});
    $self->{'YY_CLIP'} = ($self->{'YRES'} - 1) if ($self->{'YY_CLIP'} >= $self->{'YRES'});
    $self->{'W_CLIP'}  = $self->{'XX_CLIP'} - $self->{'X_CLIP'};
    $self->{'H_CLIP'}  = $self->{'YY_CLIP'} - $self->{'Y_CLIP'};
    $self->{'CLIPPED'} = TRUE;
} ## end sub clip_set

=head2 clip_rset

Sets the clipping rectangle to point x,y,width,height

=over 4

 $fb->clip_rset({
    'x'      => 10,
    'y'      => 10,
    'width'  => 600,
    'height' => 400
 });

=back

=cut

sub clip_rset {
    my ($self, $params) = @_;

    $params->{'xx'} = $params->{'x'} + $params->{'width'};
    $params->{'yy'} = $params->{'y'} + $params->{'height'};

    $self->clip_set($params);
} ## end sub clip_rset

=head2 monochrome

Removes all color information from an image, and leaves everything in greyscale.

It applies the following formula to calculate greyscale:

 grey_color = (red * 0.2126) + (green * 0.7155) + (blue * 0.0722)

=over 4

 Expects two parameters, 'image' and 'bits'.  The parameter 'image' is a string containing the image data.  The parameter 'bits' is how many bits per pixel make up the image.  Valid values are 16, 24, and 32 only.

 $fb->monochrome({
     'image' => "image data",
     'bits'  => 32
 });

 It returns 'image' back, but now in greyscale (still the same RGB format though).

 {
     'image' => "monochrome image data"
 }

=back

* You should normally use "blit_transform", but this is a more raw way of affecting the data

=cut

sub monochrome {
    ##########################################################################
    # This applies a well known set of blending constants to create a        #
    # monochrome representation of a color image                             #
    #                                                                        #
    # Multiply each color by the constant, then add them together to get the #
    # final monochrome value.                                                #
    #                                                                        #
    # NEWRED     = RED   * 0.2126                                            #
    # NEWGREEN   = GREEN * 0.7115                                            #
    # NEWBLUE    = BLUE  * 0.0722                                            #
    # MONOCHROME = NEWRED + NEWGREEN + NEWBLUE                               #
    ##########################################################################

    my ($self, $params) = @_;

    my ($r, $g, $b);

    my ($ro, $go, $bo) = ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'}, $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}, $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'});
    my ($rl, $gl, $bl) = ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'}, $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'}, $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'});

    my $color_order = $self->{'COLOR_ORDER'};
    my $size        = length($params->{'image'});

    my $inc;
    if ($params->{'bits'} == 32) {
        $inc = 4;
    } elsif ($params->{'bits'} == 24) {
        $inc = 3;
    } elsif ($params->{'bits'} == 16) {
        $inc = 2;
    } else {    # Only 32, 24, or 16 bits allowed
        $inc = 1;
    }
    if ($self->{'ACCELERATED'}) {
        c_monochrome($params->{'image'}, $size, $color_order, $inc, $params->{'bits'});



( run in 0.563 second using v1.01-cache-2.11-cpan-13bb782fe5a )