view release on metacpan or  search on metacpan

Graph/axestype.pm  view on Meta::CPAN

    x_last_label_skip	=> 0,

    # Do we want ticks on the x axis?
    x_ticks             => 1,
    x_all_ticks         => 0,

    # Where to place the x and y labels
    x_label_position    => 3/4,
    y_label_position    => 1/2,

    # vertical printing of x labels
    x_labels_vertical   => 0,
 
    # Draw axes as a box? (otherwise just left and bottom)
    box_axis            => 1,

    # Disable axes?
    # undef -> all axes, 0 -> Only line for bars, other -> no axes at all.
    no_axes             => undef,
 
    # Use two different axes for the first and second dataset. The first
    # will be displayed using the left axis, the second using the right
    # axis. You cannot use more than two datasets when this option is on.
    two_axes            => 0,

    # Which axis to use for each dataset. This only is in effect when
    # two_axes is true. The axis number will wrap around, just like
    # the dclrs array.
    use_axis            => [1, 2],
 
    # Print values on the axes?
    x_plot_values       => 1,
    y_plot_values       => 1,
 
    # Space between axis and text
    axis_space          => 4,
 
    # Do you want bars to be drawn on top of each other, or side by side?
    overwrite           => 0,

    # This will replace 'overwrite = 2'. For now, it is hardcoded to set
    # overwrite to 2
    cumulate            => 0,

    # Do you want me to correct the width of the graph, so that bars are
    # always drawn with a nice integer number of pixels?
    #
    # The GD::Graph::bars::initialise sub will switch this on.
    # Do not set this to anything else than undef!
    correct_width       => undef,

    # XXX The following two need to get better defaults. Maybe computed.
    # Draw the zero axis in the graph in case there are negative values
    zero_axis           =>  0,

    # Draw the zero axis, but do not draw the bottom axis, in case
    # box-axis == 0
    # This also moves the x axis labels to the zero axis
    zero_axis_only      =>  0,

    # Size of the legend markers
    legend_marker_height    => 8,
    legend_marker_width     => 12,
    legend_spacing          => 4,
    legend_placement        => 'BC',        # '[BR][LCR]'
    lg_cols                 => undef,

    # Display the y values above the bar or point in the graph.
    show_values             => undef,
    hide_overlapping_values => 0,
    values_vertical         => undef,   # vertical?
    values_space            => 4,       # extra spacing
    values_format           => undef,   # how to format the value
    
    # Draw the X axis left and the y1 axis at the bottom (y2 at top)
    rotate_chart            => undef,

    # CONTRIB Edwin Hildebrand
    # How narrow is a dataset allowed to become before we drop the
    # accents?
    accent_treshold         => 4,

    # Format of the numbers on the x and y axis
    y_number_format         => undef,
    y1_number_format        => undef,       # CONTRIB Andrew OBrien
    y2_number_format        => undef,       # CONTRIB Andrew OBrien
    x_number_format         => undef,       # CONTRIB Scott Prahl

    # and some attributes without default values
    x_label         => undef,
    y_label         => undef,
    y1_label        => undef,
    y2_label        => undef,
    x_min_value     => undef,
    x_max_value     => undef,
    y_min_value     => undef,
    y1_min_value    => undef,
    y2_min_value    => undef,
    y_max_value     => undef,
    y1_max_value    => undef,
    y2_max_value    => undef,
    y_min_range     => undef,               # CONTRIB Ben Tilly
    y1_min_range     => undef,
    y2_min_range     => undef,

    borderclrs      => undef,

    # XXX
    # Multiple inheritance (linespoints and mixed) finally bit me. The
    # _has_defaults and set methods can only work correctly when the
    # spot where the defaults are kept are in a mutual parent, which
    # would be this. The odd implementation of SUPER doesn't help

    # XXX points
    # The size of the marker to use in the points and linespoints graphs
    # in pixels
    marker_size => 4,

    # attributes with no default
    markers => undef,

    # XXX lines
    # The width of the line to use in the lines and linespoints graphs
    # in pixels
    line_width      => 1,

    # Set the scale of the line types
    line_type_scale => 8,

    # Which line types to use
    line_types      => [1],

    # Skip undefined values, and don't draw them at all
    skip_undef      => 0,

    # XXX bars
    # Spacing between the bars and groups of bars
    bar_width       => undef,
    bar_spacing     => 0,
    bargroup_spacing=> 0,                   # CONTRIB Grant McLean

    # cycle through colours per data point, not set
    cycle_clrs      => 0,

    # colour of the shadow
    shadowclr       => 'dgray',
    shadow_depth    => 0,

    # XXX mixed
    default_type    => 'lines',
    types           => undef,
);

sub _has_default { 
    my $self = shift;
    my $attr = shift || return;
    exists $Defaults{$attr} || $self->SUPER::_has_default($attr);
}

sub initialise
{
    my $self = shift;

    $self->SUPER::initialise();

    while (my($key, $val) = each %Defaults) 
        { $self->{$key} = $val }

    $self->set_x_label_font(GD::gdSmallFont);
    $self->set_y_label_font(GD::gdSmallFont);
    $self->set_x_axis_font(GD::gdTinyFont);
    $self->set_y_axis_font(GD::gdTinyFont);
    $self->set_legend_font(GD::gdTinyFont);
    $self->set_values_font(GD::gdTinyFont);
}

# PUBLIC
sub plot
{
    my $self = shift;
    my $data = shift;

    $self->check_data($data)            or return;
    $self->init_graph()                 or return;
    $self->setup_text()                 or return;
    $self->setup_legend();
    $self->setup_coords()               or return;
    $self->draw_text();
    unless (defined $self->{no_axes})
    {
        $self->draw_axes();
        $self->draw_ticks()             or return;
    }
    $self->draw_data()                  or return;
    $self->draw_values()                or return;
    $self->draw_legend();

    return $self->{graph}
}

sub set
{
    my $self = shift;
    my %args = @_;

    for (keys %args) 
    { 
        /^tick_length$/ and do 
        {
            $self->{x_tick_length} = 
            $self->{y_tick_length} = $args{$_};
            delete $args{$_};
            next;
        };
        /^long_ticks$/ and do 
        {
            $self->{x_long_ticks} = 
            $self->{y_long_ticks} = $args{$_};
            delete $args{$_};
            next;
        };
        /^overwrite$/ and do
        {
            $self->{cumulate} = 1 if $args{$_} == 2;
            $self->{overwrite} = $args{$_};
            delete $args{$_};
            next;
        };
        /^cumulate$/ and do
        {
            $self->{cumulate} = $args{$_};
            # XXX And for now
            $self->{overwrite} = 2 if $args{$_};
            delete $args{$_};
            next;
        };
    }

    return $self->SUPER::set(%args);
}

sub setup_text
{
    my $self = shift;

    $self->{gdta_x_label}->set(colour => $self->{lci});
    $self->{gdta_y_label}->set(colour => $self->{lci});
    $self->{xlfh} = $self->{gdta_x_label}->get('height');
    $self->{ylfh} = $self->{gdta_y_label}->get('height');

    $self->{gdta_x_axis}->set(colour => $self->{alci});
    $self->{gdta_y_axis}->set(colour => $self->{alci});
    $self->{xafh} = $self->{gdta_x_axis}->get('height');
    $self->{yafh} = $self->{gdta_x_axis}->get('height');

    $self->{gdta_title}->set(colour => $self->{tci});
    $self->{gdta_title}->set_align('top', 'center');
    $self->{tfh} = $self->{gdta_title}->get('height');

    $self->{gdta_legend}->set(colour => $self->{legendci});
    $self->{gdta_legend}->set_align('top', 'left');
    $self->{lgfh} = $self->{gdta_legend}->get('height');

    $self->{gdta_values}->set(colour => $self->{valuesci});
    unless ($self->{rotate_chart})
    {
        if ($self->{values_vertical})
        {
            $self->{gdta_values}->set_align('center', 'left');
        }
        else
        {
            $self->{gdta_values}->set_align('bottom', 'center');
        }
    }
    else
    {
        if ($self->{values_vertical})
        {
            $self->{gdta_values}->set_align('top', 'center');
        }
        else
        {
            $self->{gdta_values}->set_align('center', 'left');
        }
    }

    return $self;
}

sub set_x_label_font # (fontname)
{
    my $self = shift;
    $self->_set_font('gdta_x_label', @_);
}
sub set_y_label_font # (fontname)
{
    my $self = shift;
    $self->_set_font('gdta_y_label', @_);
}
sub set_x_axis_font # (fontname)
{
    my $self = shift;
    $self->_set_font('gdta_x_axis', @_);
}

sub set_y_axis_font # (fontname)
{
    my $self = shift;
    $self->_set_font('gdta_y_axis', @_);
}

sub set_values_font
{
    my $self = shift;
    $self->_set_font('gdta_values', @_);
}

sub set_legend # List of legend keys
{
    my $self = shift;
    $self->{legend} = [@_];
}

sub set_legend_font # (font name)
{
    my $self = shift;
    $self->_set_font('gdta_legend', @_);
}

sub get_hotspot
{
    my $self = shift;
    my $ds = shift;     # Which data set
    my $np = shift;     # Which data point?

    if (defined $np && defined $ds)
    {
        return @{$self->{_hotspots}->[$ds]->[$np]};
    }
    elsif (defined $ds)
    {
        return @{$self->{_hotspots}->[$ds]};
    }
    else
    {
        return @{$self->{_hotspots}};
    }
}

sub _set_feature_coords
{
    my $self = shift;
    my $feature = shift;
    my $type = shift;
    $self->{_feat_coords}->{$feature} = [ $type, @_ ];
}

sub _set_text_feature_coords
{
    my $self = shift;
    my $feature = shift;
    $self->_set_feature_coords($feature, "rect", @_[0,1,4,5]);
}

sub get_feature_coordinates
{
    my $self = shift;
    my $feature = shift;
    if ($feature)
    {
        $self->{_feat_coords}->{$feature};
    }
    else
    {
        $self->{_feat_coords};
    }
}

# PRIVATE

# inherit check_data from GD::Graph

#
# calculate the bottom of the bounding box for the graph
#
sub setup_bottom_boundary
{

Graph/axestype.pm  view on Meta::CPAN

    if ($self->{cumulate} && $ds > 1)
    {
        my $left;
        my $pvalue = $self->{_data}->get_y_cumulative($ds - 1, $np);
        ($left, $bottom) = $self->val_to_pixel($np + 1, $pvalue, $ds);
        $bottom = $left if $self->{rotate_chart};
    }

    return $bottom;
}

#
# Convert value coordinates to pixel coordinates on the canvas.
# TODO Clean up all the rotate_chart stuff
#
sub val_to_pixel    # ($x, $y, $dataset) or ($x, $y, -$axis) in real coords
{                   # return [x, y] in pixel coords
    my $self = shift;
    my ($x, $y, $i) = @_;

    # XXX use_axis
    my $axis = 1;
    if ( $self->{two_axes} ) {
        $axis = $i < 0 ? -$i : $self->{use_axis}[$i - 1];
    }
    
    my $y_min = $self->{y_min}[$axis];
    my $y_max = $self->{y_max}[$axis];
    my $y_range = ($y_max - $y_min) || 1; 
    # XXX the above might be an appropriate place for a conditional warning

    my $y_step = $self->{rotate_chart} ?
        abs(($self->{right} - $self->{left}) / $y_range) :
        abs(($self->{bottom} - $self->{top}) / $y_range);

    my $ret_x;
    my $origin = $self->{rotate_chart} ? $self->{top} : $self->{left};

    if (defined($self->{x_min_value}) && defined($self->{x_max_value}))
    {
        $ret_x = $origin + ($x - $self->{x_min}) * $self->{x_step};
    }
    else
    {
        $ret_x = ($self->{x_tick_number} ? $self->{x_offset} : $origin) 
            + $x * $self->{x_step};
    }
    my $ret_y = $self->{rotate_chart} ? 
        $self->{left} + ($y - $y_min) * $y_step :
        $self->{bottom} - ($y - $y_min) * $y_step;

    return $self->{rotate_chart} ?
        (_round($ret_y), _round($ret_x)) :
        (_round($ret_x), _round($ret_y));
}

#
# Legend
#
sub setup_legend
{
    my $self = shift;

    return unless defined $self->{legend};

    my $maxlen = 0;
    my $num = 0;

    # Save some variables
    $self->{r_margin_abs} = $self->{r_margin};
    $self->{b_margin_abs} = $self->{b_margin};

    foreach my $legend (@{$self->{legend}})
    {
        if (defined($legend) and $legend ne "")
        {
            $self->{gdta_legend}->set_text($legend);
            my $len = $self->{gdta_legend}->get('width');
            $maxlen = ($maxlen > $len) ? $maxlen : $len;
            $num++;
        }
        last if $num >= $self->{_data}->num_sets;
    }

    $self->{lg_num} = $num or return; 
    # not actually bug 20792 (unsure that this will ever get hit, but if it does..!)

    # calculate the height and width of each element
    my $legend_height = _max($self->{lgfh}, $self->{legend_marker_height});

    $self->{lg_el_width} = 
        $maxlen + $self->{legend_marker_width} + 3 * $self->{legend_spacing};
    $self->{lg_el_height} = $legend_height + 2 * $self->{legend_spacing};

    my ($lg_pos, $lg_align) = split(//, $self->{legend_placement});

    if ($lg_pos eq 'R')
    {
        # Always work in one column
        $self->{lg_cols} = 1;
        $self->{lg_rows} = $num;

        # Just for completeness, might use this in later versions
        $self->{lg_x_size} = $self->{lg_cols} * $self->{lg_el_width};
        $self->{lg_y_size} = $self->{lg_rows} * $self->{lg_el_height};

        # Adjust the right margin for the rest of the graph
        $self->{r_margin} += $self->{lg_x_size};

        # Set the x starting point
        $self->{lg_xs} = $self->{width} - $self->{r_margin};

        # Set the y starting point, depending on alignment
        if ($lg_align eq 'T')
        {
            $self->{lg_ys} = $self->{t_margin};
        }
        elsif ($lg_align eq 'B')
        {
            $self->{lg_ys} = $self->{height} - $self->{b_margin} - 
                $self->{lg_y_size};
        }
        else # default 'C'
        {
            my $height = $self->{height} - $self->{t_margin} - 
                $self->{b_margin};

            $self->{lg_ys} = 
                int($self->{t_margin} + $height/2 - $self->{lg_y_size}/2) ;
        }
    }
    else # 'B' is the default
    {
        # What width can we use
        my $width = $self->{width} - $self->{l_margin} - $self->{r_margin};

        (!defined($self->{lg_cols})) and 
            $self->{lg_cols} = int($width/$self->{lg_el_width}) || 1; # bug 20792
        
        $self->{lg_cols} = _min($self->{lg_cols}, $num);

        $self->{lg_rows} = 
            int($num / $self->{lg_cols}) + (($num % $self->{lg_cols}) ? 1 : 0);

        $self->{lg_x_size} = $self->{lg_cols} * $self->{lg_el_width};
        $self->{lg_y_size} = $self->{lg_rows} * $self->{lg_el_height};

        # Adjust the bottom margin for the rest of the graph
        $self->{b_margin} += $self->{lg_y_size};

        # Set the y starting point
        $self->{lg_ys} = $self->{height} - $self->{b_margin};

        # Set the x starting point, depending on alignment
        if ($lg_align eq 'R')
        {
            $self->{lg_xs} = $self->{width} - $self->{r_margin} - 
                $self->{lg_x_size};
        }
        elsif ($lg_align eq 'L')
        {
            $self->{lg_xs} = $self->{l_margin};
        }
        else # default 'C'
        {
            $self->{lg_xs} =  
                int($self->{l_margin} + $width/2 - $self->{lg_x_size}/2);
        }
    }
}

sub draw_legend
{
    my $self = shift;

    return unless defined $self->{legend};

    my $xl = $self->{lg_xs} + $self->{legend_spacing};
    my $y  = $self->{lg_ys} + $self->{legend_spacing} - 1;
    
    my $i = 0;
    my $row = 1;
    my $x = $xl;    # start position of current element

    foreach my $legend (@{$self->{legend}})
    {
        $i++;
        last if $i > $self->{_data}->num_sets;

        my $xe = $x;    # position within an element

        next unless defined($legend) && $legend ne "";

        $self->draw_legend_marker($i, $xe, $y);

        $xe += $self->{legend_marker_width} + $self->{legend_spacing};
        my $ys = int($y + $self->{lg_el_height}/2 - $self->{lgfh}/2);

        $self->{gdta_legend}->set_text($legend);
        $self->{gdta_legend}->draw($xe, $ys);

        $x += $self->{lg_el_width};

        if (++$row > $self->{lg_cols})
        {
            $row = 1;
            $y += $self->{lg_el_height};
            $x = $xl;
        }
    }
}

#
# This will be virtual; every sub class should define their own
# if this one doesn't suffice
#
sub draw_legend_marker # data_set_number, x, y
{
    my $s = shift;
    my $n = shift;
    my $x = shift;
    my $y = shift;

    my $g = $s->{graph};

    my $ci = $s->set_clr($s->pick_data_clr($n));
    return unless defined $ci;

    $y += int($s->{lg_el_height}/2 - $s->{legend_marker_height}/2);

    $g->filledRectangle(
        $x, $y, 
        $x + $s->{legend_marker_width}, $y + $s->{legend_marker_height},
        $ci
    );

    $g->rectangle(
        $x, $y, 
        $x + $s->{legend_marker_width}, $y + $s->{legend_marker_height},
        $s->{acci}
    );
}

"Just another true value";