Chart

 view release on metacpan or  search on metacpan

lib/Chart/Base.pm  view on Meta::CPAN

    $self->{'curr_x_min'} = 0;
    $self->{'curr_x_max'} = $x;    # maximum pixel in x direction (right)

    # use a 10 pixel border around the whole png
    $self->{'png_border'} = 10;

    # leave some space around the text fields
    $self->{'text_space'} = 2;

    # and leave some more space around the chart itself
    $self->{'graph_border'} = 10;

    # leave a bit of space inside the legend box
    $self->{'legend_space'} = 4;

    # set some default fonts
    $self->{'title_font'}        = gdLargeFont,
      $self->{'sub_title_font'}  = gdLargeFont,
      $self->{'legend_font'}     = gdSmallFont,
      $self->{'label_font'}      = gdMediumBoldFont,
      $self->{'tick_label_font'} = gdSmallFont;

    # put the legend on the bottom of the chart
    $self->{'legend'} = 'right';

    # default to an empty list of labels
    $self->{'legend_labels'} = [];

    # use 20 pixel length example lines in the legend
    $self->{'legend_example_size'} = 20;

    # Set the maximum & minimum number of ticks to use.
    $self->{'y_ticks'}          = 6,
      $self->{'min_y_ticks'}    = 6,
      $self->{'max_y_ticks'}    = 100,
      $self->{'x_number_ticks'} = 1,
      $self->{'min_x_ticks'}    = 6,
      $self->{'max_x_ticks'}    = 100;

    # make the ticks 4 pixels long
    $self->{'tick_len'} = 4;

    # no custom y tick labels
    $self->{'y_tick_labels'} = undef;

    # no patterns
    $self->{'patterns'} = undef;

    # let the lines in Chart::Lines be 6 pixels wide
    $self->{'brush_size'} = 6;

    # let the points in Chart::Points and Chart::LinesPoints be 18 pixels wide
    $self->{'pt_size'} = 18;

    # use the old non-spaced bars
    $self->{'spaced_bars'} = 'true';

    # use the new grey background for the plots
    $self->{'grey_background'} = 'true';

    # don't default to transparent
    $self->{'transparent'} = 'false';

    # default to "normal" x_tick drawing
    $self->{'x_ticks'} = 'normal';

    # we're not a component until Chart::Composite says we are
    $self->{'component'} = 'false';

    # don't force the y-axes in a Composite chare to be the same
    $self->{'same_y_axes'} = 'false';

    # plot rectangeles in the legend instead of lines in a composite chart
    $self->{'legend_example_height'} = 'false';

    # don't force integer y-ticks
    $self->{'integer_ticks_only'} = 'false';

    # don't forbid a false zero scale.
    $self->{'include_zero'} = 'false';

    # don't waste time/memory by storing imagemap info unless they ask
    $self->{'imagemap'} = 'false';

    # default for grid_lines is off
    $self->{grid_lines}      = 'false',
      $self->{x_grid_lines}  = 'false',
      $self->{y_grid_lines}  = 'false',
      $self->{y2_grid_lines} = 'false';

    # default for no_cache is false.  (it breaks netscape 4.5)
    $self->{no_cache} = 'false';

    # default value for skip_y_ticks for the labels
    $self->{skip_y_ticks} = 1;

    # default value for skip_int_ticks only for integer_ticks_only
    $self->{skip_int_ticks} = 1;

    # default value for precision
    $self->{precision} = 3;

    # default value for legend label values in pie charts
    $self->{legend_label_values} = 'value';

    #  default value for the labels in a pie chart
    $self->{label_values} = 'percent';

    # default position for the y-axes
    $self->{y_axes} = 'left';

    # copies of the current values at the x-ticks function
    $self->{temp_x_min} = 0;
    $self->{temp_x_max} = 0;
    $self->{temp_y_min} = 0;
    $self->{temp_y_max} = 0;

    # Instance for a sum
    $self->{sum} = 0;

    # Don't sort the data unless they ask
    $self->{'sort'} = 'false';

lib/Chart/Base.pm  view on Meta::CPAN

    $self->{'x_tick_label_length'} = $length;

    # find x-scale, if a x-y plot is wanted
    # makes only sense for some charts
    if ( $self->true( $self->{'xy_plot'} ) && (   $self->isa('Chart::Lines')
                                               || $self->isa('Chart::Points')
                                               || $self->isa('Chart::LinesPoints')
                                               || $self->isa('Chart::Split')
                                               || $self->isa('Chart::ErrorBars') ) ) {
        $self->_find_x_scale;
    }

    return 1;
}

## @fn private int _draw
# Plot the chart to the gd object\n
# Calls:
# @see _draw_title
# @see _draw_sub_title
# @see _sort_data
# @see _plot
#
# @return status
sub _draw {
    my $self = shift;

    # leave the appropriate border on the png
    $self->{'curr_x_max'} -= $self->{'png_border'};
    $self->{'curr_x_min'} += $self->{'png_border'};
    $self->{'curr_y_max'} -= $self->{'png_border'};
    $self->{'curr_y_min'} += $self->{'png_border'};

    # draw in the title
    $self->_draw_title() if $self->{'title'};

    # have to leave this here for backwards compatibility
    $self->_draw_sub_title() if $self->{'sub_title'};

    # sort the data if they want to (mainly here to make sure
    # pareto charts get sorted)
    $self->_sort_data() if ( $self->true( $self->{'sort'} ) );

    # start drawing the data (most methods in this will be
    # overridden by the derived classes)
    # include _draw_legend() in this to ensure that the legend
    # will be flush with the chart
    $self->_plot();

    # and return
    return 1;
}

## @fn private int _set_colors
#  specify my colors
# @return status
sub _set_colors {
    my $self = shift;

    my $index = $self->_color_role_to_index('background');    # allocate GD color
    if ( $self->true( $self->{'transparent'} ) )
    {
        $self->{'gd_obj'}->transparent($index);
    }

    # all other roles are initialized by calling $self->_color_role_to_index(ROLENAME);

    # and return
    return 1;
}

## @fn private int _color_role_to_index
# return a (list of) color index(es) corresponding to the (list of) role(s)
#
# @details wantarray
# is a special keyword which returns a flag indicating
# which context your subroutine has been called in.
# It will return one of three values.
#
# @li true: If your subroutine has been called in list context
# @li false: If your subroutine has been called in scalar context
# @li undef: If your subroutine has been called in void context
#
# @return a (list of) color index(es) corresponding to the (list of) role(s) in \\\@_.
sub _color_role_to_index {
    my $self = shift;

    # Return a (list of) color index(es) corresponding to the (list of) role(s) in @_.
    my @result = map {
        my $role  = $_;
        my $index = $self->{'color_table'}->{$role};

        unless ( defined $index ) {
            my $spec =
                 $self->{'colors'}->{$role}
              || $self->{'colors_default_spec'}->{$role}
              || $self->{'colors_default_spec'}->{ $self->{'colors_default_role'}->{$role} };
            my @rgb = $self->_color_spec_to_rgb( $role, $spec );

            my $string = sprintf " RGB(%d,%d,%d)", map { $_ + 0 } @rgb;

            $index = $self->{'color_table'}->{$string};
            unless ( defined $index ) {
                $index = $self->{'gd_obj'}->colorAllocate(@rgb);
                $self->{'color_table'}->{$string} = $index;
            }

            $self->{'color_table'}->{$role} = $index;
        }
        $index;
    } @_;

    ( wantarray && @_ > 1 ? @result : $result[0] );
}

sub _color_spec_to_rgb {
    my ($self, $role, $spec) = @_; # color role name (from set) for error msg
    my $color = Chart::Property::DataType::Color->new( $spec );
    return croak "Unrecognized color for $role\n" unless ref $color;
    $color->rgb;
}

## @fn private int _brushStyles_of_roles

lib/Chart/Base.pm  view on Meta::CPAN

    }
    return 1;
}

## @fn private int _prepare_brush($color,$type,$role)
# prepare brush
#
# @details
#  set the gdBrush object to tick GD into drawing fat lines & points
#  of interesting shapes
#  Needed by "Lines", "Points" and "LinesPoints"
#  All hacked up by Richard Dice <rdice@pobox.com> Sunday 16 May 1999
#
# @param color
# @param type    'line','point'
# @param role
#
# @return status
sub _prepare_brush {
    my $self  = shift;
    my $color = shift;
    my $type  = shift;
    my $role  = shift || 'default';

    my $brushStyle = $self->{'brushStyle'};
    if ( defined $role ) {
        my (@brushStyles) = $self->_brushStyles_of_roles($role);
        $brushStyle = $brushStyles[0];
    }

    #print STDERR "role=$role\n";

    # decide what $type should be in the event that a param isn't
    # passed -- this is necessary to preserve backward compatibility
    # with apps that use this module prior to putting _prepare_brush
    # in with Base.pm
    if ( !defined($type) ) { $type = 'point'; }

    if (   ( !length($type) )
        || ( !grep { $type eq $_ } ( 'line', 'point' ) ) ) {
        $brushStyle = $self->{'brushStyle'};
        $type       = 'line' if ref $self eq 'Chart::Lines';
        $type       = 'point' if ref $self eq 'Chart::Points';
    }

    my ( $radius, @rgb, $brush, $white, $newcolor );

    # get the rgb values for the desired color
    @rgb = $self->{'gd_obj'}->rgb($color);

    # get the appropriate brush size
    if ( $type eq 'line' ) {
        $radius = $self->{'brush_size'} / 2;
    } elsif ( $type eq 'point' ) {
        $radius = $self->{'pt_size'} / 2;
    }

    # create the new image
    $brush = GD::Image->new( $radius * 2, $radius * 2 );

    # get the colors, make the background transparent
    $white = $brush->colorAllocate( 255, 255, 255 );
    $newcolor = $brush->colorAllocate(@rgb);
    $brush->transparent($white);

    # draw the circle
    if ( $type eq 'line' ) {
        $brush->arc( $radius - 1, $radius - 1, $radius, $radius, 0, 360, $newcolor );
        $brush->fill( $radius - 1, $radius - 1, $newcolor );

        # RLD
        #
        # Does $brush->fill really have to be here?  Dunno... this
        # seems to be a relic from earlier code
        #
        # Note that 'line's don't benefit from a $brushStyle... yet.
        # It shouldn't be too tough to hack this in by taking advantage
        # of GD's gdStyled facility

    }

    if ( $type eq 'point' ) {
        $brushStyle = $self->{'brushStyle'}
          unless grep { $brushStyle eq $_ } (
            'FilledCircle',  'circle',             'donut',  'OpenCircle',
            'triangle',      'upsidedownTriangle', 'square', 'hollowSquare',
            'OpenRectangle', 'fatPlus',            'Star',   'OpenStar',
            'FilledDiamond', 'OpenDiamond'
          );

        my ( $xc, $yc ) = ( $radius, $radius );

        if ( grep { $brushStyle eq $_ } ( 'default', 'circle', 'donut', 'OpenCircle', 'FilledCircle' ) ) {
            $brush->arc( $xc, $yc, $radius, $radius, 0, 360, $newcolor );
            $brush->fill( $xc, $yc, $newcolor );

            # draw a white (and therefore transparent) circle in the middle
            # of the existing circle to make the "donut", if appropriate

            if ( $brushStyle eq 'donut' || $brushStyle eq 'OpenCircle' )
            {
                $brush->arc( $xc, $yc, int( $radius / 2 ), int( $radius / 2 ), 0, 360, $white );
                $brush->fill( $xc, $yc, $white );
            }
        }

        if ( grep { $brushStyle eq $_ } ( 'triangle', 'upsidedownTriangle' ) ) {
            my $poly = new GD::Polygon;
            my $sign = ( $brushStyle eq 'triangle' ) ? 1 : (-1);
            my $z    = int( 0.8 * $radius );                       # scaling factor

            # co-ords are chosen to make an equilateral triangle

            $poly->addPt( $xc, $yc - ( $z * $sign ) );
            $poly->addPt( $xc + int( ( sqrt(3) * $z ) / 2 ), $yc + ( int( $z / 2 ) * $sign ) );
            $poly->addPt( $xc - int( ( sqrt(3) * $z ) / 2 ), $yc + ( int( $z / 2 ) * $sign ) );

            $brush->filledPolygon( $poly, $newcolor );
        }

        if ( $brushStyle eq 'fatPlus' )  {
            my $poly = new GD::Polygon;
            my $z = int( 0.3 * $radius );

            $poly->addPt( $xc + $z,     $yc + $z );
            $poly->addPt( $xc + 2 * $z, $yc + $z );
            $poly->addPt( $xc + 2 * $z, $yc - $z );

            $poly->addPt( $xc + $z, $yc - $z );
            $poly->addPt( $xc + $z, $yc - 2 * $z );
            $poly->addPt( $xc - $z, $yc - 2 * $z );

            $poly->addPt( $xc - $z,     $yc - $z );
            $poly->addPt( $xc - 2 * $z, $yc - $z );
            $poly->addPt( $xc - 2 * $z, $yc + $z );

            $poly->addPt( $xc - $z, $yc + $z );
            $poly->addPt( $xc - $z, $yc + 2 * $z );
            $poly->addPt( $xc + $z, $yc + 2 * $z );
            $brush->filledPolygon( $poly, $newcolor );
        }

        if ( $brushStyle eq 'Star' || $brushStyle eq 'OpenStar' ) {
            my $poly = new GD::Polygon;

            my $z  = int($radius);
            my $sz = int( $z / 3 * 1.75 );    # small z

            my $x1 = int( $xc + $z );
            my $y1 = int($yc);
            my ( $x2, $y2 );

            my $xyRatio = $self->_xyRatio();

            $poly->addPt( $x1, $y1 );

            $x2 = $xc + int( $sz * 0.5 );



( run in 1.424 second using v1.01-cache-2.11-cpan-39bf76dae61 )