view release on metacpan or  search on metacpan

lib/Bio/Graphics/Glyph/fb_shmiggle.pm  view on Meta::CPAN

			my $x=  $screencoords[$xpos] + $xshift;
			my $visval;
			if( exists $SPEEDUP{$val} ) { $visval= $SPEEDUP{$val}; }
			else { $visval= int($val*$koeff); $SPEEDUP{$val}= $visval; }
			my $y= $yf2 - $yshift - $visval;
			push(@allx,$x);
			push(@ally,$y);
			push(@allvals,$visval);
			if( $xpos>0 ) {
    		$poly->addPt($x,$y+1);
				}
			($xold,$yold)= ($x,$y);
			$xpos++;
			}
    $poly->addPt($xf2+$xshift, $yf2-$yshift+1); 
  	$gd->filledPolygon($poly,$color) unless $profilen==0; # not on MAX predictor
		($xold,$yold)= ($allx[0],$ally[0]);
		for( my $en=1; $en<=$#allx; $en++ ) {
			my $x= $allx[$en];
			my $y= $ally[$en];
			$gd->line($xold,$yold,$x,$y,$edgecolor);
			($xold,$yold)= ($x,$y);
			} 
		if( $profilen==0 ) { # drawing mRNA (cutoff-based) predictor on MAX subset
			my($xxx,$yyy)= ($allx[1]-1,$yf2-$yw);
			$gd->line($xxx-4,$yyy,$xxx-2,$yyy,$black);
			$gd->string(GD::Font->Tiny,$xxx-12, $yyy-3,'0',$black);
			$gd->line($xxx-2,$yyy,$xxx-2,$yyy-50,$black);
			$gd->line($xxx-4,$yyy-47,$xxx-2,$yyy-50,$black);
			$gd->line($xxx,$yyy-47,$xxx-2,$yyy-50,$black);
			$gd->line($xxx-4,$yyy-44,$xxx-2,$yyy-44,$black);
			$gd->string(GD::Font->Tiny,$xxx-18, $yyy-47,$max_signal,$black);
			my($inexon,$exstart,$exend,$ymax)= (0,0,0,999);
			for( my $en=1; $en<=$#allx; $en++ ) {
				my $y= $ally[$en];
				$ymax= $y if $y < $ymax;
				if( $allvals[$en]>=$predictor_cutoff ) {
					my $x= $allx[$en];
					unless( $inexon ) { $inexon= 1; $exstart= $x; } # start exon
					$exend= $x; 
					}
				elsif( $inexon ) { # end exon and draw it
					$inexon= 0;
					$ymax -= 6;
					my $allowedymax= $yf2-$yshift-45;
					$ymax= $allowedymax if $ymax < $allowedymax; # set limit for huge peaks
					$gd->line($exstart,$ymax,$exstart,$ymax+2,$red);
					$gd->line($exstart,$ymax,$exend,$ymax,$red);
					$gd->line($exend,$ymax,$exend,$ymax+2,$red);
					($inexon,$exstart,$exend,$ymax)= (0,0,0,999);
					}
				}
			if( $inexon ) { # exon which ends beyond this screen
					$ymax -= 6;
					my $allowedymax= $yf2-$yshift-45;
					$ymax= $allowedymax if $ymax < $allowedymax; # set limit for huge peaks
					$gd->line($exstart,$ymax,$exstart,$ymax+2,$red);
					$gd->line($exstart,$ymax,$exend,$ymax,$red);
					}
			}
		if( 0 && $profilen>1 ) { # blocked - drawing roof lines doesn't work well with this view..
			for( my $en=3; $en<=$#allx; $en+=6 ) {
				next if $allvals[$en]==0 || $prevvals[$en]==0;
				my $y= $ally[$en];
				$yold= $prevy[$en];
				if( $yold<$y ) {
					my $x= $allx[$en];
					$xold= $prevx[$en];
					$gd->line($xold,$yold,$x,$y,$darkgrey);
					}
				}
			}
		$gd->string(GD::Font->Tiny,$xf2+$xshift+3, $yf2-$yshift-5,$subsetsnames->{$subset},$color);
		$colcycler++;
		$colcycler= 0 if $colcycler>$#colors;
		unless( $profilen==0 ) { @prevx= @allx; @prevy= @ally; @prevvals= @allvals; }
		$profilen++;
		}
	 
	return;
}

#--------------------------
sub getData {
  my $self = shift;
  my($ft,$datadir,$chromosome,$start,$stop,$scrstart,$scrstop,$flipped) = @_;
	my %Signals= ();
	$self->openDataFiles($datadir);
	my @subsets= (exists $ft->{'subsetsorder'}) ? @{$ft->{'subsetsorder'}} : sort split(/\t+/,$Indices{'subsets'});
	shift(@subsets) if $subsets[0] eq 'MAX';
	warn("subsets: @subsets\n") if DEBUG;
	my %SubsetsNames= (exists $ft->{'subsetsnames'}) ? %{$ft->{'subsetsnames'}} : map { $_, $_ } @subsets;
	$SubsetsNames{MAX}= 'MAX'; 
	my $screenstep= ($scrstop-$scrstart+1) * 1.0 / ($stop-$start+1);
	my $donecoords= 0;
	foreach my $subset ( @subsets ) {
		my $nstrings= 0;
		# scan seq ranges offsets to see where to start reading
		my $key= $subset.':'.$chromosome;
		my $poskey= $key.':offsets';
		my $ranges_pos= (exists $Indices{$poskey}) ? int($Indices{$poskey}) : -1;
		if( $ranges_pos == -1 ) { next; } # no such signal..
		warn("  positioning for $poskey starts at $ranges_pos\n") if DEBUG;
		if( $start>=1000000 ) {  
			my $bigstep= int($start/1000000.0);
			if( exists $Indices{$key.':offsets:'.$bigstep} ) {
				my $jumpval= $Indices{$key.':offsets:'.$bigstep}; 
				warn("  jump in offset search to $jumpval\n") if DEBUG;
				$ranges_pos= int($jumpval); }
			}
		seek(DATF,$ranges_pos,0);
		my($offset,$offset1)= (0,0);
		my $lastseqloc= -999999999;
		my $useoffset= 0;
		while( (my $strs=<DATF>) ) {
			$nstrings++ if DEBUG;
			if( DEBUG ) {
				chop($strs); warn("  	positioning read for coord $start ($strs)\n"); }
			last unless $strs=~m/^(-?\d+)[ \t]+(\d+)/;
			my($seqloc,$fileoffset)= ($1,$2);
			if( DEBUG ) {