Bio-Graphics

 view release on metacpan or  search on metacpan

lib/Bio/Graphics/Panel.pm  view on Meta::CPAN

	my $g = $track->factory->make_glyph(0,$t);
	$glyph = $g->keyglyph;
      }
      next unless $glyph;


      $tracks{$track} = $glyph;
      my ($h,$w) = ($glyph->layout_height,
		    $glyph->layout_width);
      $height = $h if $h > $height;
      $width  = $w if $w > $width;
      push @glyphs,$glyph;

    }

    $width += $self->key_spacing;

    # no key glyphs, no key
    return $self->{key_height} = 0 unless @glyphs;

    # now height and width hold the largest glyph, and $glyph_count
    # contains the number of glyphs.  We will format them into a
    # box that is roughly 3 height/4 width (golden mean)
    my $rows = 0;
    my $cols = 0;
    my $maxwidth = $self->width - $self->pad_left - $self->pad_right;
    while (++$rows) {
      $cols = @glyphs / $rows;
      $cols = int ($cols+1) if $cols =~ /\./;  # round upward for fractions
      my $total_width  = $cols * $width;
      my $total_height = $rows * $width;
      last if $total_width < $maxwidth;
    }

    # move glyphs into row-major format
    my $spacing = $self->key_spacing;
    my $i = 0;
    for (my $c = 0; $c < $cols; $c++) {
      for (my $r = 0; $r < $rows; $r++) {
	my $x = $c * ($width  + $spacing);
	my $y = $r * ($height + $spacing);
	next unless defined $glyphs[$i];
	$glyphs[$i]->move($x,$y);
	$i++;
      }
    }

    $self->{key_glyphs} = \@glyphs;     # remember our key glyphs
    # remember our key height
    return $self->{key_height} =
      ($height+$spacing) * $rows + $self->{key_font}->height +KEYPADTOP;
  }

  else {  # no known key style, neither "between" nor "bottom"
    return $self->{key_height} = 0;
  }
}

sub add_key_box {
  my $self = shift;
  my ($track,$label,$x,$y, $is_legend) = @_;
  my $value = [$label,$x,$y,$x+$self->{key_font}->width*CORE::length($label),$y+$self->{key_font}->height,$track];
  push @{$self->{key_boxes}},$value;
}

sub key_boxes {
  my $ref  = shift->{key_boxes};
  return wantarray ? @$ref : $ref;
}

sub add_category_labels {
  my $self = shift;
  my $d    = $self->{add_category_labels};
  $self->{add_category_labels} = shift if @_;
  $d;
}

sub track2key {
  my $self = shift;
  my $track = shift;
  return $track->make_key_name();
}

sub draw_empty {
  my $self  = shift;
  my ($gd,$offset,$style) = @_;
  $offset  += $self->spacing/2;
  my $left  = $self->pad_left;
  my $right = $self->width-$self->pad_right;
  my $color = $self->translate_color(MISSING_TRACK_COLOR);
  my $ic    = $self->image_class;
  if ($style eq 'dashed') {
    $gd->setStyle($color,$color,$ic->gdTransparent(),$ic->gdTransparent());
    $gd->line($left,$offset,$right,$offset,$ic->gdStyled());
  } else {
    $gd->line($left,$offset,$right,$offset,$color);
  }
  $offset;
}

# draw a grid
sub draw_grid {
  my $self = shift;
  my $gd = shift;

  my $gridcolor      = $self->translate_color($self->{gridcolor});
  my $gridmajorcolor = $self->translate_color($self->{gridmajorcolor});
  my @positions;
  my ($major,$minor);
  if (ref $self->{grid} eq 'ARRAY') {
    @positions = @{$self->{grid}};
  } else {
    ($major,$minor) = $self->ticks;
    my $first_tick = $minor * int($self->start/$minor);
    for (my $i = $first_tick; $i <= $self->end+1; $i += $minor) {
      push @positions,$i;
    }
  }
  my $pl = $self->pad_left;
  my $pt = $self->extend_grid ? 0 : $self->pad_top;
  my $pr = $self->right;



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