#!/srv/local/bin/perl 

# plt2mol.pl (C) Charlie Bond 240398
# Converts oplot plt format objects to molscript 2.0 external 
# object syntax
# Requires perl v5
# As it was designed to convert map objects for display with molscript, it only
# deals with objects made from 'move' and 'line' commands.

# Check for command line input

intro: {
unless ($ARGV[0]) {
    while (<STDIN>) {
        if (/^begin /) {
            @line = split ; 
            push ( @object_list, $line[1] );
            if ($line[1] =~ /_MAP$/) {
                push ( @map_objects, $line[1] );
            }
        }
    }
    die<<EOT
   Usage: plt2mol object_name < input_file.plt > output_file.dat
       
   Available object_names are    : @object_list

   You probably want a map object: @map_objects
EOT
}

# So you gave an object name - I hope it was the right one

$object_name= $ARGV[0];
$r_col=$ARGV[1];
$g_col=$ARGV[2];
$b_col=$ARGV[3];

};

# Parse input until the appropriate 'begin' statement appears


main: {
while (<STDIN>) {
    if (/^begin $object_name/) {
# Go and translate the object
        &TranslateObject;
    }
};
print STDERR "No such object: $object_name\nType 'plt2mol.pl < input_file.plt' to get a list of objects.\n"
}
exit;


sub TranslateObject {

    while (<STDIN>) {
# If the line begins with anything other than move/line skip it.
# eg colour, line_type etc
#
# Block changed by Pat Fleming, May 1, 1998
#
        if ( /^move |^line |^end_object/) {
        $n++;
# split line and place each argument in an list of lists 
        @linel = split;
        $line[0][$n]=$linel[0];
        $line[1][$n]=$linel[1];
        $line[2][$n]=$linel[2];
        $line[3][$n]=$linel[3];
        
        };
# Each bit of map comes in blocks:
# Each block begins with a 'move' line and then has a number
# of 'line' lines.
# After each move 'line' is encountered, I count up the 'line'
# lines until another 'move' line is encountered.
# At this point the molscript object record is printed:
# L {no of coordinates} {list of coordinates ... }
# When all blocks have been printed, a 'Q' record terminates the object.
        
        if ($line[0][$n] eq "move") {
            unless ($n <= 1) {
                $count++;
                print "LC $count \n";
                foreach $ln ( 1 .. $count ) { 
                    print $line[1][$n-$ln]," ",$line[2][$n-$ln]," ",$line[3][$n-$ln]," ",$r_col," ",$g_col," ",$b_col," ","\n";
                    $count=0;
                }
            }
        }
        if ($line[0][$n] eq "line") {$count++};
        
        if ($line[0][$n] eq "end_object") {
            print "Q\n";
            
            exit;
        }
    }
};