view release on metacpan or  search on metacpan

Ace/Graphics/Glyph/arrow.pm  view on Meta::CPAN

package Ace::Graphics::Glyph::arrow;
# package to use for drawing an arrow

use strict;
use vars '@ISA';
@ISA = 'Ace::Graphics::Glyph';

sub bottom {
  my $self = shift;
  my $val = $self->SUPER::bottom(@_);
  $val += $self->font->height if $self->option('tick');
  $val += $self->labelheight  if $self->option('label');
  $val;
}

# override draw method
sub draw {
  my $self = shift;
  my $parallel = $self->option('parallel');
  $parallel = 1 unless defined $parallel;
  $self->draw_parallel(@_) if $parallel;
  $self->draw_perpendicular(@_) unless $parallel;
}

sub draw_perpendicular {
  my $self = shift;
  my $gd = shift;
  my ($x1,$y1,$x2,$y2) = $self->calculate_boundaries(@_);

  my $ne = $self->option('northeast');
  my $sw = $self->option('southwest');
  $ne = $sw = 1 unless defined($ne) || defined($sw);

  # draw a perpendicular arrow at position indicated by $x1
  my $fg = $self->fgcolor;
  my $a2 = $self->SUPER::height/4;

  my @positions = $x1 == $x2 ? ($x1) : ($x1,$x2);
  for my $x (@positions) {
    if ($ne) {
      $gd->line($x,$y1,$x,$y2,$fg);
      $gd->line($x-$a2,$y1+$a2,$x,$y1,$fg);
      $gd->line($x+$a2,$y1+$a2,$x,$y1,$fg);
    }
    if ($sw) {
      $gd->line($x,$y1,$x,$y2,$fg);
      $gd->line($x-$a2,$y2-$a2,$x,$y2,$fg);
      $gd->line($x+$a2,$y2-$a2,$x,$y2,$fg);
    }
  }

  # add a label if requested
  if ($self->option('label')) {
    $self->draw_label($gd,@_);  # this draws the label aligned to the left
  }
}

sub draw_parallel {
  my $self = shift;
  my $gd = shift;
  my ($x1,$y1,$x2,$y2) = $self->calculate_boundaries(@_);

  my $fg = $self->fgcolor;
  my $a2 = $self->SUPER::height/2;
  my $center = $y1+$a2;

  my $ne = $self->option('northeast');
  my $sw = $self->option('southwest');
  # turn on both if neither specified
  $ne = $sw = 1 unless defined($ne) || defined($sw);

  # turn on ticks
  if ($self->option('tick')) {
    my $left = shift;

    my $scale = $self->scale;

    # figure out tick mark scale
    # we want no more than 1 tick mark every 30 pixels
    # and enough room for the labels
    my $font = $self->font;
    my $width = $font->width;
    my $font_color = $self->fontcolor;

    my $interval = 1;
    my $mindist =  30;
    my $widest = 5 + (length($self->end) * $width);
    $mindist = $widest if $widest > $mindist;


    my ($gcolor,$gtop,$gbottom);
    if ($self->option('grid')) {
      $gcolor = $self->color('grid');
      my $panel_height = $self->factory->panel->height;
      $gtop    = $self->factory->panel->pad_top;
      $gbottom = $panel_height - $self->factory->panel->pad_bottom;
    }

    while (1) {
      my $pixels = $interval * $scale;
      last if $pixels >= $mindist;
      $interval *= 10;
    }

    my $first_tick = $interval * int(0.5 + $self->start/$interval);

    for (my $i = $first_tick; $i < $self->end; $i += $interval) {
      my $tickpos = $left + $self->map_pt($i);
      $gd->line($tickpos,$gtop,$tickpos,$gbottom,$gcolor) if defined $gcolor;
      $gd->line($tickpos,$center-$a2,$tickpos,$center+$a2,$fg);
    }

    if ($self->option('tick') >= 2) {
      my $a4 = $self->SUPER::height/4;
      for (my $i = $first_tick - $interval; $i < $self->end; $i += $interval/10) {
	my $tickpos = $left + $self->map_pt($i);
	$gd->line($tickpos,$gtop,$tickpos,$gbottom,$gcolor) if defined $gcolor;
	$gd->line($tickpos,$center-$a4,$tickpos,$center+$a4,$fg);