#!/usr/local/bin/perl -w

# $Id: render,v 1.1 2003/07/28 17:44:08 sheldon Exp $

# needs perlpod!!

# File render
# Use Bio::Graphics to render generic sequence feature data into a gif image
# Print the image directly to the browser
# can be used for dynamic image generation
# eg: <img src="render?text=$yourtext">
# needs to be installed in a cgi-bin or modperl directory for your webserver

use CGI qw/:standard/;
use CGI::Carp qw/fatalsToBrowser/;
use lib "/usr/local/perl-5.6.1/lib/site_perl/5.6.1";
use Bio::Graphics::FeatureFile;

use strict;

my $width = param('width') || 700;

my $text  = '';
if (param('demo')) {
    my @text = <DATA>;
    $text = join '', @text;
}
else {
    $text  = param('text')  || PrintHTML();
}

#
# text may have line endings replaced with '@@'
#
unless ( $text =~ /\n/ ) {
    $text =~ s/@@+/\n/g;
}


# draw the image
render($text);

#
# print form if there are no parameters passed
#
sub PrintHTML{
    print header,
          start_html("Render"),
	  "<center>",
          "<table align=center>",
          "<tr><td align=center>",
          start_form,
          h2('Enter data to render'),
	  submit,reset,br,
	  textarea(-name=>"text", -rows=>20, -cols=>50, -value=> join '', <DATA>),
	  end_form,
          "</td></tr></table>",
	  end_html;
    exit;
}

#
# mostly 'borrowed' from Lincoln Stein's frend script
#
sub render {
    
    my $text = shift;
    
    return unless $text;
    
    my $data = Bio::Graphics::FeatureFile->new(-text => $text); 

    unless ($data->min < $data->max) {
      die("This doesn't look like a valid annotation file.  No annotations found.");
    }

    # general configuration of the image here
    my $width = $width;
    my ($start,$stop) = $data->setting(general => 'bases') =~ /([\d-]+)(?:-|\.\.)([\d-]+)/;
  
    $start = $data->min unless defined $start;
    $stop  = $data->max unless defined $stop;
  

    # Use the order of the stylesheet to determine features.  Whatever is left
    # over is presented in alphabetic order
    my %types = map {$_=>1} $data->configured_types;
  
    my @configured_types   = grep {exists $data->features->{$_}} $data->configured_types;

    # create the segment,the panel and the arrow with tickmarks
    my $segment = Bio::Graphics::Feature->new(-start=>$start,-stop=>$stop);
    my $panel = Bio::Graphics::Panel->new(-segment   => $segment,
	  				  -width     => $width,
					  -key_style => 'bottom',
                                          -key_color => 'whitesmoke');
    $panel->add_track($segment,-glyph=>'arrow',-tick=>2);
  
    my @base_config = $data->style('general');

    for my $type (@configured_types) {
        my $features = $data->features($type);
        my @config = ( 
		       @base_config,             # global
		       $data->style($type),  # feature-specificp
		     );
        $panel->add_track($features,@config);
    }
  
    my $gd = $panel->gd;
    
    print header('image/gif');
    print $gd->gif;
    exit;
}

__DATA__
[general]
bases = 1-3200
height = 12
[gene]
glyph = transcript2
bgcolor = cyan
label = 1
description = 1
height = 7

[forward_primer]
glyph = triangle
bgcolor = blue
orient = E
height = 7
label = 1
description = 1

[reverse_primer]
glyph = triangle
bgcolor = green
orient = W
height = 7
label = 1
description = 1

[thing]
bgcolor = red
label = 1
description = 1
height = 5

gene 'my gene' 1750-410 'target gene'
gene 'downstream gene' 3075-1939 ' '
forward_primer 'F' 618-638 'Forward PCR primer'
reverse_primer 'R' 1444-1464 'Reverse PCR primer'
thing 'Thing' 2000-2200 'Some other thing'
