Bio::Graphics::Glyph::group - The "group" glyph

  See L<Bio::Graphics::Panel> and L<Bio::Graphics::Glyph>.

package Bio::Graphics::Glyph::group;

use strict;
use base qw(Bio::Graphics::Glyph::segmented_keyglyph);

sub my_description {
    return <<END;
This glyph is used internally by Bio::Graphics::Panel for laying out
groups of glyphs that are linked together.  It should not be used
explicitly.
END
}

sub my_options {
    return
    {
	group_label => [
	    'boolean',
	    undef,
	    'Attach a label to the group; this is independent of the label option which applies',
	    'to features within the group'
	    ],
	group_label_position => [
	    [qw(top left)],
	    'left',
	    'Position in which to draw the group label.'
	],
    }
}

# group sets connector to 'dashed'
sub connector {
  my $self = shift;
  my $super = $self->SUPER::connector(@_);
  return $super if $self->all_callbacks;
  return 'dashed' unless defined($super) && ($super eq 'none' or !$super);
}

# we don't label group (yet)
sub label { my $self = shift;
	    return $self->{_group_label} if exists $self->{_group_label};
	    return $self->{_group_label}  = $self->option('group_label') ? $self->feature->display_name : '' 
}

sub labelfont {
  my $self = shift;
  return $self->getfont('groupfont','gdMediumBoldFont');
}

sub pad_left { 
    my $self = shift;
    return 0 unless $self->option('group_label');
    return length($self->label||'') * $self->labelfont->width+3;
}

sub draw {
    my $self = shift;
    $self->SUPER::draw(@_) if $self->feature_has_subparts;
    $self->draw_label(@_)  if $self->option('group_label');
}

sub draw_label {
    my $self = shift;
    my $label = $self->label or return;
    my $panel= $self->panel;

    $self->SUPER::draw_label(@_) unless $panel->{suppress_key};

    my ($gd,$left,$top,$partno,$total_parts) = @_;
    my $font = $self->labelfont;

    my $x    = $self->left + $left; # valid for both "top" and "left" because the left-hand side is defined by pad_left
    my $y;
    if ($self->label_position eq 'top') {
	$x += $self->pad_left;  # offset to beginning of the drawn part of the feature
	$x = $panel->left + 1 if $x <= $panel->left;
	$y = $self->top + $top - 1;
    } elsif ($self->label_position eq 'left') {
	$y    = $self->{top} + ($self->height - $font->height)/2 + $top;
	$y    = $self->{top} + $top if $y < $self->{top} + $top;
    }
    $panel->add_key_box($self,$label,$x,$y);
}

sub label_position { 
    my $self = shift;
    my $pos  = $self->option('group_label_position') || 'left';
    return $pos;
}

sub new {
  my $self = shift;
  return $self->SUPER::new(@_,-level=>-1);
}


# don't allow simple bumping in groups -- it looks terrible...
sub bump {
    my $self = shift;
    my $bump = $self->SUPER::bump(@_);
    return 1  if $bump >  1;
    return -1 if $bump < -1;
    return $bump;
}

1;

__END__