view release on metacpan or  search on metacpan

t/misc2.t  view on Meta::CPAN

}

sub add_tracks
{
	my $panel = shift;
	
	# ruler
	can_ok($panel, qw(add_track));
	$panel->add_track(
		Bio::Graphics::Feature->new(-start => $gene_minus->start-100, -end => $gene_minus->end),
		-glyph  => 'arrow',
		-bump   => 0,
		-double => 1,
		-tick   => 2
	);
	ok(1, 'ruler made');
	
	$panel->add_track
	(
		$gene_minus,
		-glyph => 'decorated_gene',
		-label_transcripts => 1,
		-description => 1,
		-label => 1,
		-height => 12,
		-decoration_image_map => 1,
		-box_subparts => 2,
		-decoration_visible => 1,	
		-decoration_color => sub { 
				my ($feature, $option_name, $part_no, $total_parts, $glyph) = @_;	
				return 'black' if ($glyph->active_decoration->name eq "TM");
				return 'yellow' if ($glyph->active_decoration->type eq "SignalP4")
			},
		-additional_decorations => sub { 
				my $feature = shift;
				my ($id) = $feature->get_tag_values('load_id');			
				my %add_h = ( "rna_PFA0680c-1" => "test:callback:100:130:0" );
				return $add_h{$id};
		},
			-decoration_position  => sub {
				my ($feature, $option_name, $part_no, $total_parts, $glyph) = @_;
				return '12' if ($glyph->active_decoration->name eq "VTS"); 
				return '-10'if ($glyph->active_decoration->name eq "TM"); 
				return '1';
		}	
	);
	ok(1, 'track1 added');
	
	my ($gene2) =  $store->features(-name => 'test1'); 	
	
	$panel->add_track
		(
			$gene2,
			-glyph => 'decorated_gene',
			-description => sub { "Gene label and description do not bump with extended decoration boundaries" },
			-label => 1,
			-label_position => 'top',
			-height => 12,
			-decoration_visible => 1,
			-decoration_border => "dashed",
			-decoration_color => "transparent",
			-decoration_label_position => "above",
			-decoration_label => 1,
			-decoration_border_color => "blue",
			-decoration_height  => sub {
				my ($feature, $option_name, $part_no, $total_parts, $glyph) = @_;
				return '24' if ($glyph->active_decoration->name eq "very interesting region"); 
				return '10';}
	
		);
	ok(1, 'track2 added');
	
	$panel->add_track
		(
			$gene2,
			-glyph => 'decorated_gene',
			-description => sub { "Gene label and description do not bump with extended decoration boundaries" },
			-label => 1,
			-label_position => 'below',
			-height => 12,
			-decoration_visible => sub {
				my ($feature, $option_name, $part_no, $total_parts, $glyph) = @_;
				return '0' if ($glyph->active_decoration->name eq "very interesting region"); 
				return '1';},
			-decoration_border => "dashed",
			-decoration_color => "yellow",
			-decoration_label_position => 'below',
			-decoration_label => 1,
			-decoration_level        => 'mRNA',
			-decoration_border_color => "blue",
			-decoration_height  => 12,
			-decoration_position  => sub {
				my ($feature, $option_name, $part_no, $total_parts, $glyph) = @_;
				return '12' if ($glyph->active_decoration->name eq "SP"); 
				return '12';}
		);
	ok(1, 'track3 added');
	
	$panel->add_track
		(
			$gene2,
			-glyph => 'decorated_gene',
			-description => sub { "Gene label and description do not bump with extended decoration boundaries" },
			-label => 1,
			-label_position => 'below',
			-height => 12,
			-decoration_visible => sub {
				my ($feature, $option_name, $part_no, $total_parts, $glyph) = @_;
				return '0' if ($glyph->active_decoration->name eq "very interesting region" || $glyph->active_decoration->name eq "SP"); 
				return '1';},
			-decoration_border => "dashed",
			-decoration_color => "yellow",
			-decoration_label_position => 'below',
			-decoration_label => 1,
			-decoration_border_color => "blue",
			-decoration_height  => 12,
			-additional_decorations =>  'TMHMM:TM:25:45:24',
			-decoration_level        => 'mRNA',
			-decoration_position  => sub {
				my ($feature, $option_name, $part_no, $total_parts, $glyph) = @_;
				return '12' if ($glyph->active_decoration->name eq "TM");