#!/usr/bin/perl

use strict;
use CGI;
my %DEF = ();
my $PROGRAM = "cadepco.cgi";
my $CSS_FILE = "cadepco.css";
my $TITLE = "Computer-Assisted DEgenerate Primer COnstruction";
my $CGI = CGI->new();
my $PSEQ  = uc($CGI->param("PSEQ")  || 'ALPNGHYILRARGAPTAE');
my $PDIX  = $CGI->param("PDIX")  || '11111111111';

swi_init();
compute();
swi_display();
swi_exit();

# ----------------------------------------------------------


# ----------------------------------------------------------


sub arr2tr {
    my ($class,@args) = @_;
    return  "<tr".( $class ? " class='$class'" : "").">"
            .join('', map { "<td>$_</td>"; } @args)
            ."</tr>";
}

sub ard2tr {
    my ($class,@args) = @_;
    my $deg = pop @args;
    return  "<tr".( $class ? " class='$class'" : "").">"
            .join('', map { "<td>$_</td>"; } @args)
            ."<td class='ndeg'>$deg</td>"
            ."</tr>";
}

sub deg2tr {
    my ($class,@args) = @_;
    return  "<tr".( $class ? " class='$class'" : "").">"
            .join('', map { "<td class='deg$_'>$_</td>"; } @args)
            ."</tr>";
}

sub commify {
    my $text = reverse $_[0];
    $text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1./g;
    return scalar reverse $text;
}

sub compute {
    return if $PSEQ eq '';
    $DEF{'PSEQ'} = $PSEQ;
    $DEF{'PDIX'} = $PDIX;
#    print "PSEQ = '$PSEQ'\n";
    my $rv;
    my $P = protein->new($PSEQ,$PDIX);
    my @AASEQ = $P->arr_AASEQ();
    my (@RNAN,@DDNA_all,@NAMES);
    my @DEG = $P->arr_AADEG();
    my $sd;
    map { $sd += $_; } @DEG;
    my @DNA2 = $P->arr_DNA2();
    my @PRIM = $P->arr_PRIM();
    my @IPRIM = $P->arr_IPRIM();
    my @IDNA = $P->arr_IDNA();
    my @IDNAN = map { my $v = $_; $v =~ s/I/N/g; $v; } @IDNA;
    my @DDNA_sel = $P->arr_DDNA();

    @NAMES =
        map {
            my $AA = $P->AACID($_);
            $AA->{name};
        }
        $P->arr_AASEQ()
    ;

    my @IDNA_all =
        map {
            my $AA = $P->AACID($_);
            $AA->{idna};
        }
        $P->arr_AASEQ()
    ;

    my $ii = 0;
    map {
        my $AA = $P->AACID($_);
        push @RNAN, join('<br/>', @{$AA->{codes}});
        my $cc = 0;
        push @DDNA_all,
            join('<br/>',
                map {
                    $cc++;
                    my $v =
                        "<input type='radio' name='c_$ii' ".($_ eq $DDNA_sel[$ii] ? "checked" : "")." onclick='javascript:sc(this,$ii,$cc);'>"
                        .($_ eq $DDNA_sel[$ii] ? "<span class='seldix'>$_</span>" : $_)
                        ;
                    $v;
                } @{$AA->{ddna}}
            );
        $ii++;
    }
    $P->arr_AASEQ();

    $DEF{'PSEQ'} = join('',@AASEQ);
    $DEF{'PDIX'} = '1' x scalar @AASEQ;
    $rv =
        "\n<table class='result'>"
        ."\n".ard2tr( "Order"    , "Order"      , "  ", (1..$#DEG+1) , "  ")
        ."\n".arr2tr( "Sequence" , "Seq"        , "5'", @AASEQ       , "3'")
        ."\n".arr2tr( "Name"     , "Name"       , "5'", @NAMES       , "3'")
        ."\n".deg2tr( "DEG"      , "Deg ($sd)"  , "  ", @DEG         , "  ")
        ."\n".arr2tr( "RNA"      , "RNA"        , "  ", @RNAN        , "  ")
        ."\n".arr2tr( "DDNAN"    , "Deg DNA"    , "  ", @DDNA_all    , "  ")

#       ."\n".ard2tr( "IDNAN"    , "Primer-IN"  , "5'", @IDNAN       , "3'", $P->tmelt(@IDNAN)   , commify($P->degeneracy(@IDNAN)))
#       ."\n".ard2tr( "IDNA"     , "Primer-I"   , "5'", @IDNA        , "3'", $P->tmelt(@IDNA)    , commify($P->degeneracy(@IDNA)))
#       ."\n".ard2tr( "Primer"   , "Primer-IC"  , "5'", @IPRIM       , "3'", $P->tmelt(@IPRIM)   , commify($P->degeneracy(@IPRIM)))

        ."\n".ard2tr( "DDNA"     , "Primer-N"   , "5'", @DDNA_sel    , "3'")
        ."\n".ard2tr( "DNA2"     , "Compl."     , "3'", @DNA2        , "5'")
        ."\n".ard2tr( "Primer"   , "Primer-C"   , "5'", @PRIM        , "3'")
        ."\n"."</table>\n"
        ."Primer length is ".(3*@PRIM).".\n"
        ."<br/>Melting temperature is ".($P->tmelt(@PRIM))."&deg;C\n"
        ."<br/>Annealing temperature is ".($P->tmelt(@PRIM)-5)."&deg;C\n"
        ."<br/>Primer degenaracy is ".($P->degeneracy(@PRIM))."\n"
        ;
my $iupac = '';
if (1) {
    $iupac .= "IUPAC table used";
    $iupac .= "<table class='iupac' border=0>";
    $iupac .= "<tr class='iupac-title'><td>Code</td><td>C'</td><td>Codes</td><td>Deg</td></tr>\n";
    my $odd = 1;
    my $class = "";
    my %DEG = (1 => 'deg-1', 2 => 'deg-2', 3 => 'deg-3', 4 => 'deg-4');
    foreach my $key (sort keys %protein::IUPAC) {
       $odd = !$odd;
       $class = $odd ? 'iupac-odd' : 'iupac-even'; 
       my $P = $protein::IUPAC{$key};
       $iupac .= "<tr class='$class $DEG{$P->{ndeg}}'><td>$key</td><td>$P->{comp}</td><td>$P->{codes}</td><td>$P->{ndeg}</td></tr>\n";
    }
    $iupac .= "</table>";
}
    $DEF{'RESULT'} = $rv.$iupac;
    $DEF{'PDIX'} = join('',$P->arr_AADIX());
}

# ----------------------------------------------------------

sub swi_load {
    my ($name,$END);
    while (<DATA>) {
        if (/^DEFINE\s+(\w+)(\s+UNTIL\s+(\w+))?$/) {
            $name = $1;
            $DEF{$name} = "";
            $END = $3 || 'END';
        }
        elsif (/^$END$/) { $name = undef; }
        elsif (defined $name) { $DEF{$name} .= $_; }
        else { } # ignore
    }
    close(DATA);
}

sub swi_exit {
    %DEF = ();
}

sub swi_init {
    print "Content-Type: text/html\n\n";
    %DEF = ();
    $DEF{'PROGRAM'} = $PROGRAM;
    $DEF{'TITLE'} = $TITLE;
    $DEF{'CSS_FILE'} = $CSS_FILE || 'default.css';
    $DEF{'ICON_FILE'} = 'default.ico';
    map { $DEF{$_} = $CGI->param($_); } $CGI->param();
    swi_load();
}

sub swi_eval {
    my ($src) = @_;
    my $rv = "";
    $src =~ s/\$\{\s*([^}]+)\s*\}/swi_parse($1)/gse;
    return $src;
   
}

sub swi_parse {
    my ($param) = @_;
    my (@arg) = split(/\s+/, $param);
    my $cmd = shift @arg;
    if (0 == @arg) { return $DEF{$cmd}; }
    elsif ($cmd eq "EVAL") { return swi_eval($DEF{$arg[0]}); }
    else { return "UNRECOGNIZED: ('$cmd' @arg)";  }
#print "\n";
}

sub swi_display {
    my ($root) = "HTML";
    print swi_eval($DEF{$root});
}

# --------------------------------------------------------------------
# protein package 

package protein;

our %BASE;
our %IUPAC;
our %AACID;

sub _init_data {
    %IUPAC =
    (
        'A' => { codes=>'A---', comp=>'T', ndeg=>0 },   
        'C' => { codes=>'-C--', comp=>'G', ndeg=>0 },   
        'G' => { codes=>'--G-', comp=>'C', ndeg=>0 },   
        'T' => { codes=>'---T', comp=>'A', ndeg=>0 },   
        'U' => { codes=>'---T', comp=>'A', ndeg=>0 },   
        'M' => { codes=>'AC--', comp=>'K', ndeg=>0 },
        'R' => { codes=>'A-G-', comp=>'Y', ndeg=>0 },
        'W' => { codes=>'A--T', comp=>'W', ndeg=>0 },
        'S' => { codes=>'-CG-', comp=>'S', ndeg=>0 },
        'Y' => { codes=>'-C-T', comp=>'R', ndeg=>0 },
        'K' => { codes=>'--GT', comp=>'M', ndeg=>0 },
        'V' => { codes=>'ACG-', comp=>'B', ndeg=>0 },
        'H' => { codes=>'AC-T', comp=>'D', ndeg=>0 },
        'D' => { codes=>'A-GT', comp=>'H', ndeg=>0 },
        'B' => { codes=>'-CGT', comp=>'V', ndeg=>0 },
        'N' => { codes=>'ACGT', comp=>'N', ndeg=>0 },
        'I' => { codes=>'ACGT', comp=>'I', ndeg=>1 },
    );
    foreach (keys %IUPAC) {
        next if $_ eq 'I';  # I has degeneracy of 1!
        # recompute n-degeneracy
        my @codes = ($IUPAC{$_}->{codes} =~ m/[ACGT]/g);
        $IUPAC{$_}->{ndeg} = scalar @codes;
    }

    %AACID =
    (
        'A' => { name=>'Ala', deg=>0, dix=>0, idna=>"GCI", ddna=>[qw[GCN]]            , codes=>[qw[GCU GCC GCA GCG]]},    
        'C' => { name=>'Cys', deg=>0, dix=>0, idna=>"TGY", ddna=>[qw[TGY]]            , codes=>[qw[UGU UGC]]},            
        'D' => { name=>'Asp', deg=>0, dix=>0, idna=>"GAY", ddna=>[qw[GAY]]            , codes=>[qw[GAU GAC]]},            
        'E' => { name=>'Glu', deg=>0, dix=>0, idna=>"GAR", ddna=>[qw[GAR]]            , codes=>[qw[GAA GAG]]},            
        'F' => { name=>'Phe', deg=>0, dix=>0, idna=>"TTY", ddna=>[qw[TTY]]            , codes=>[qw[UUU UUC]]},            
        'G' => { name=>'Gly', deg=>0, dix=>0, idna=>"GGI", ddna=>[qw[GGN]]            , codes=>[qw[GGU GGC GGA GGG]]},    
        'H' => { name=>'His', deg=>0, dix=>0, idna=>"CAY", ddna=>[qw[CAY]]            , codes=>[qw[CAU CAC]]},            
        'I' => { name=>'Ile', deg=>0, dix=>0, idna=>"ATH", ddna=>[qw[ATH]]            , codes=>[qw[AUU AUC AUA]]},        
        'K' => { name=>'Lys', deg=>0, dix=>0, idna=>"AAR", ddna=>[qw[AAR]]            , codes=>[qw[AAA AAG]]},            
        'L' => { name=>'Leu', deg=>0, dix=>0, idna=>"YTI", ddna=>[qw[CTN TTR YTR CTY]], codes=>[qw[UUA UUG CUU CUC CUA CUG]]},
        'M' => { name=>'Met', deg=>0, dix=>0, idna=>"ATG", ddna=>[qw[ATG]]            , codes=>[qw[AUG]]},
        'N' => { name=>'Asn', deg=>0, dix=>0, idna=>"AAY", ddna=>[qw[AAY]]            , codes=>[qw[AAU AAC]]},
        'P' => { name=>'Pro', deg=>0, dix=>0, idna=>"CCI", ddna=>[qw[CCN]]            , codes=>[qw[CCU CCC CCA CCG]]},
        'Q' => { name=>'Gln', deg=>0, dix=>0, idna=>"CAR", ddna=>[qw[CAR]]            , codes=>[qw[CAA CAG]]},
        'R' => { name=>'Arg', deg=>0, dix=>0, idna=>"MGI", ddna=>[qw[CGN AGR MGR CGY]], codes=>[qw[CGU CGC CGA CGG AGA AGG]]},
        'S' => { name=>'Ser', deg=>0, dix=>0, idna=>"WSI", ddna=>[qw[TCN AGY]]        , codes=>[qw[UCU UCC UCA UCG AGU AGC]]},
        'T' => { name=>'Thr', deg=>0, dix=>0, idna=>"ACI", ddna=>[qw[ACN]]            , codes=>[qw[ACU ACC ACA ACG]]},
        'U' => { name=>'Thr', deg=>0, dix=>0, idna=>"CAI", ddna=>[qw[CAN]]            , codes=>[qw[ACU ACC ACA ACG]]},
        'V' => { name=>'Val', deg=>0, dix=>0, idna=>"GTI", ddna=>[qw[GTN]]            , codes=>[qw[GUU GUC GUA GUG]]},
        'W' => { name=>'Trp', deg=>0, dix=>0, idna=>"TGG", ddna=>[qw[TGG]]            , codes=>[qw[UGG]]},
        'Y' => { name=>'Tyr', deg=>0, dix=>0, idna=>"TAY", ddna=>[qw[TAY]]            , codes=>[qw[UAU UAC]]},
        '1' => { name=>'Sta', deg=>0, dix=>0, idna=>"RTG", ddna=>[qw[RUG]]            , codes=>[qw[AUG GUG]]},
        '0' => { name=>'Sto', deg=>0, dix=>0, idna=>"TRR", ddna=>[qw[URR]]            , codes=>[qw[UAG UGA UAA]]},
    );

    foreach (keys %AACID) {
        # recompute codes
        my @codes = @{$AACID{$_}->{codes}};
        @codes = sort @codes;
        $AACID{$_}->{codes} = \@codes;
        $AACID{$_}->{deg} = scalar @codes;
        
        # recompute ddna
        my %ddna = map {($_, 1);} (@{$AACID{$_}->{ddna}});
        my $idna = $AACID{$_}->{idna};
        delete $ddna{$idna};
        my @ddna = ($idna, sort keys %ddna);
        @{$AACID{$_}->{ddna}} = @ddna;
        $AACID{$_}->{dix} = scalar @ddna;
    }
}

sub _set { $_[0]->{$_[1]} = $_[2]; }
sub _get { $_[0]->{$_[1]}; }

sub AACID { $AACID{$_[1]}; }
sub AACID_dix {
    my ($self,$code) = @_;
    return '0' if not defined $AACID{$code};
    return $AACID{$code}->{dix};
}

sub IUPAC { $IUPAC{$_[1]}; }
sub IUPAC_comp {
    my ($self,$code) = @_;
    return '-' if not defined $IUPAC{$code};
    return $IUPAC{$code}->{comp};
}

sub setAASEQ { die "Not an array ref!" if ref($_[1]) ne "ARRAY"; $_[0]->{'AASEQ'} = $_[1]; }
sub setAADIX { die "Not an array ref!" if ref($_[1]) ne "ARRAY"; $_[0]->{'AADIX'} = $_[1]; }
sub setAADEG { die "Not an array ref!" if ref($_[1]) ne "ARRAY"; $_[0]->{'AADEG'} = $_[1]; }
sub setDDNA  { die "Not an array ref!" if ref($_[1]) ne "ARRAY"; $_[0]->{'DDNA'}  = $_[1]; }
sub setIDNA  { die "Not an array ref!" if ref($_[1]) ne "ARRAY"; $_[0]->{'IDNA'}  = $_[1]; }
sub setDNA2  { die "Not an array ref!" if ref($_[1]) ne "ARRAY"; $_[0]->{'DNA2'}  = $_[1]; }
sub setPRIM  { die "Not an array ref!" if ref($_[1]) ne "ARRAY"; $_[0]->{'PRIM'}  = $_[1]; }
sub setIPRIM { die "Not an array ref!" if ref($_[1]) ne "ARRAY"; $_[0]->{'IPRIM'} = $_[1]; }

sub AASEQ { $_[0]->{'AASEQ'}->[$_[1]]; }
sub AADIX { $_[0]->{'AADIX'}->[$_[1]]; }
sub AADEG { $_[0]->{'AADEG'}->[$_[1]]; }
sub DDNA  { $_[0]->{'DDNA'}->[$_[1]]; }
sub IDNA  { $_[0]->{'IDNA'}->[$_[1]]; }
sub DNA2  { $_[0]->{'DNA2'}->[$_[1]]; }
sub PRIM  { $_[0]->{'PRIM'}->[$_[1]]; }
sub IPRIM { $_[0]->{'IPRIM'}->[$_[1]]; }

sub arr_AASEQ { @{$_[0]->{'AASEQ'}}; }
sub arr_AADIX { @{$_[0]->{'AADIX'}}; }
sub arr_AADEG { @{$_[0]->{'AADEG'}}; }
sub arr_DDNA  { @{$_[0]->{'DDNA'}}; }
sub arr_IDNA  { @{$_[0]->{'IDNA'}}; }
sub arr_DNA2  { @{$_[0]->{'DNA2'}}; }
sub arr_PRIM  { @{$_[0]->{'PRIM'}}; }
sub arr_IPRIM { @{$_[0]->{'IPRIM'}}; }

sub new {
    my ($class,$prot,$dix) = @_;
    my $self = {};
    bless $self, ref $class || $class || 'protein';
    $self->_init_data();
    $self->init($prot,$dix) if defined $prot;
    return $self;
}

sub init {
    my ($self, $prot, $dix) = @_;

    my $DEBUG = 0;

    my @AASEQ = $self->str_to_aaseq($prot);
    $self->setAASEQ(\@AASEQ);

    my @IDNA  = $self->str_to_idna($prot);
    $self->setIDNA(\@IDNA);
        
    my @IPRIM  = $self->dna_reverse(@IDNA);
    $self->setIPRIM(\@IPRIM);
        
    my @AADIX = $self->str_to_dix($dix,@AASEQ);
    $self->setAADIX(\@AADIX);

    my @AADEG = $self->str_to_aadeg($prot);
    $self->setAADEG(\@AADEG);

    my @DDNA  = $self->aaseq_to_ddna(@AASEQ,$dix);
    $self->setDDNA(\@DDNA);
 
    my @DNA2  = $self->ddna_to_dna2(@DDNA);
    $self->setDNA2(\@DNA2);
        
    my @DNAR  = $self->dna_reverse(@DNA2);
    $self->setPRIM(\@DNAR);
        
    if ($DEBUG) {
        print "arr AASEQ:";
        foreach ($self->arr_AASEQ()) { print "$_ "; }
        print "\n";
    }

    if ($DEBUG) {
        print "arr AADIX:";
        foreach ($self->arr_AADIX()) { print "$_ "; }
        print "\n";
    }

    if ($DEBUG) {
        print "arr DDNA: ";
        foreach ($self->arr_DDNA()) { print "$_ "; }
        print "\n";
    }

    if ($DEBUG) {
        print "arr IDNA: ";
        foreach ($self->arr_IDNA()) { print "$_ "; }
        print "\n";
    }

    if ($DEBUG) {
        print "arr DNA2: ";
        foreach ($self->arr_DNA2()) { print "$_ "; }
        print "\n";
    }

    if ($DEBUG) {
        print "arr PRIM: ";
        foreach ($self->arr_PRIM()) { print "$_ "; }
        print "\n";
    }
}

sub str_to_aaseq {
    my ($self,$str) = @_;
    my @AASEQ;
    foreach my $aa (split(//,uc($str))) {
        my $AA = $self->AACID($aa);
        next if not $AA;
        push @AASEQ, $aa;
    }
    return @AASEQ;
}

sub str_to_dix {
    my ($self,$str,@AASEQ) = @_;
    my @dix = map { sprintf "%d", $_; } split(//,$str);
    my @DIX;
    my $ii = 0;
    foreach my $aa (@AASEQ) {
        my $AA = $self->AACID($aa);
        next if not $AA;
        $dix[$ii] = $AA->{dix} if 
        push @DIX, ($dix[$ii] > $AA->{dix} ? $AA->{dix} : $dix[$ii]) || 1;
        $ii++;
    }
    return @DIX;
}

sub str_to_aadeg {
    my ($self,$str) = @_;
    my @AADEG;
    foreach my $aa (split(//,uc($str))) {
        my $AA = $self->AACID($aa);
        next if not $AA;
        push @AADEG, $AA->{deg};
    }
    return @AADEG;
}

sub str_to_idna {
    my ($self,$str) = @_;
    my @IDNA;
    foreach my $aa (split(//,uc($str))) {
        my $AA = $self->AACID($aa);
        next if not $AA;
        push @IDNA, $AA->{idna};
    }
    return @IDNA;
}


sub aaseq_to_ddna {
    my ($self) = @_;
    my @aaseq = $self->arr_AASEQ();
    my @aadix = $self->arr_AADIX();
    my @DDNA;
    my $ii;
    foreach my $aa (@aaseq) {
        my $AA = $self->AACID($aa);
        next if not $AA;
        push @DDNA, $AA->{ddna}->[$aadix[$ii]-1];
        $ii++;
    }
    return @DDNA;
}

sub ddna_to_dna2 {
    my ($self,@ddna) = @_;
    my @DNA2;
    foreach (@ddna) {
        my $dna2 = $_;
        $dna2 =~ s/(.)/$self->IUPAC_comp($1)/ge;
        push @DNA2, $dna2;
    }
    return @DNA2;
}

sub dna_reverse {
    my ($self,@dna) = @_;
    my @DNA;
    foreach (reverse @dna) {
        push @DNA, join('',reverse(split //, $_));
    }
    return @DNA;
}

sub degeneracy {
    my ($self,@dna) = @_;
    my $deg = 1;
    my @sss;
    my @seq = split(//,join('',@dna));
    map { $deg *= ($IUPAC{$_}->{ndeg} || 1); } @seq;
    map { push @sss, ($IUPAC{$_}->{ndeg} || 1); } @seq;
#    return $deg;
    my @mmm;
    my @dnp;
    while (@sss) {
       push @mmm, (shift @sss) . (shift @sss) . (shift @sss);
       push @dnp, (shift @seq) . (shift @seq) . (shift @seq);
    }
    my $rv = "";
    for my $i (0..(scalar @dnp)-1) {
      $rv .= "<td class='".( $i % 2 == 0 ? 'prim-odd':'prim-even')."'>".($i+1)."<br/>$dnp[$i]<br/>$mmm[$i]</td>\n";
    }
    return " = $deg <table class='prim-deg'><tr>$rv</tr></table>\n";
}

sub tmelt {
    my ($self,@code) = @_;
    my %TEMP = ('a'=>2, 't'=>2, 'g'=>4, 'c'=>4, 'i'=>0);
    my $C13 = 0;
    my $code = join('',@code);
    $code = lc($code);
    $code =~ s/[^acgtiu]//gs;
    my @a;
    my $aa = scalar (@a = ($code =~ m/a/sg));
    my $tt = scalar (@a = ($code =~ m/t/sg));
    my $uu = scalar (@a = ($code =~ m/u/sg));
    my $cc = scalar (@a = ($code =~ m/c/sg));
    my $gg = scalar (@a = ($code =~ m/g/sg));
    my $TT = $uu + $tt;
    my $all = $aa + $TT + $cc + $gg;
    my $mt;

    if ($all < 13 or $C13) {
        $mt =   $aa * $TEMP{'a'} + $TT * $TEMP{'t'}
              + $cc * $TEMP{'c'} + $gg * $TEMP{'g'};
    }
    else {
        $mt = 64 + ($gg+$cc-16.4)/$all;
    }
    if ($all) {
        $mt   = sprintf "%4.2f", $mt;
    }
    else {
        $mt   = "N/A";
    }
    return $mt;
}

1;

__END__

DEFINE HTML
    <html>
    <head>
        <title>${TITLE}</title>
        <link rel="stylesheet" href="${CSS_FILE}">
        <link rel="shortcut icon" href="${ICON_FILE}">
        <script language="javascript">
            function sc(obj,id,cc) {
                var pre  = document.forms[0].elements[1].value.substr(0,id);
                var post = document.forms[0].elements[1].value.substr(id+1, document.forms[0].elements[1].value.length);
                document.forms[0].elements[1].value = pre + '' + cc+ '' + post;
                return 0;
            }
        </script>
    </head>
    <body>
        <div class="menu">${EVAL MENU}</div>
        <hr>
        <h1>${TITLE}</h1>
        <div id='calc'>${EVAL FORM}</div>
        <div id='result'>${RESULT}</div>
    </body>
    </html>
END

DEFINE FORM
    <form style="form" action="${PROGRAM}" method="post">
        <input type="text" size="40" maxlength="40" name="PSEQ" value="${PSEQ}"><br/>
        <input type="text" size="40" maxlength="40" name="PDIX" value="${PDIX}"><br/>
        <input type="submit" value="Calculate">
        <input type="reset" value="Reset">
        <input type="button" value="Empty" onClick="javascript:document.forms[0].elements[0].value = '';document.forms[0].elements[0].focus();">
        <script language="JavaScript">document.forms[0].elements[0].focus();</script>
    </form>
END

DEFINE MENU
    <ul class="menu">
        <li><a href="../index.html">sabina.anzlovar.com</a></li>
        <li><a href="acgt.cgi">acgt</a></li>
        <li><a href="ethanol.cgi">ethanol.cgi</a></li>
    </ul>
END