#!/usr/bin/perl
# convert MDL mol file to 2D structure in HTML
$filert = shift(@ARGV) ; # Extract first argument into pattern
$file = $filert.".mol" ; # DeFT output file
open(MOL,$file) || die "Can't find file $file\n";
# get cartesian coordinates
$_ = <MOL> ;
while ( <MOL> ) { last unless /^\n/ } ;
($x,$iatm,$ibnd,$x) = split ;
die "Zero atoms in file $file\n" if $iatm < 1 ;
	$j = 0 ;
while (<MOL>) {
	$j++ ;
	($x,$x[$j],$y[$j],$z[$j],$el[$j],$x) = split ;
	last if $j >= $iatm ;
		} # end while coordinates
	$j = 0 ;
	while (<MOL>) {
	$j++ ;
	($x,$a1[$j],$a2[$j],$bo[$j],$x) = split ;
	last if $j >= $ibnd ;
		} # end while bonds
# @occx position in grid, $asgn flag for atom, $iasgn=counter for assigned
$occx[1] = $occy[1] = 0 ; $asgn[1] = 1 ; $iasgn = 1 ;
for ($i=2;$i<=$iatm;$i++) { $asgn[$i]= 0 } ;
# for each fragment
while ($iasgn < $iatm ) {
# main loop assign atoms to 2D Grid $occx[], $occy[]
	$pass = 1 ;
while ( $pass < 5 && $iasgn < $iatm ) {
	$pass++ ;
    for ($i=2;$i<=$iatm;$i++) { 
	next if $asgn[$i] ;
	$ib = 0 ;
# find first bonded partner
        for ($j=1;$j<=$ibnd;$j++) {
	   $ib = $a1[$j] if $a2[$j] == $i ;
	   $ib = 0 unless $asgn[$ib] ;
	   last if $ib ;
				} # end for found as first atom
	unless ($ib) {
              for ($j=1;$j<=$ibnd;$j++) {
		$ib = $a2[$j] if $a1[$j] == $i ;
		$ib = 0 unless $asgn[$ib] ;
	        last if $ib ;
				} # end for found as second atom
		    } # end unless needed as second atom
	next unless $ib ;   # wait on this one till later
# assign new postion
	$cx = $occx[$ib] ; $cy = $occy[$ib];
	$tx = $cx ; $ty = $cy ; # trial = current
# use coordinates to guess at new position
	$dx = $x[$i]-$x[$ib] ; $dy = $y[$i]-$y[$ib] ;
	$tx++ if $dx > 0.3 ;
	$tx-- if $dx < -0.3 ;
	$ty++ if $dy > 0.3 ;
	$ty-- if $dy < -0.3 ;
# see if this spot is occupied
	if ( &OCCUP ) {
# use z values
	$ty++ if ($z[$i]-$z[$ib]) > 0.3 && $dy < 0.3 ;
	$ty-- if ($z[$i]-$z[$ib]) < -0.3 && $dy > -0.3 ;
	   if ( &OCCUP ) {
# try undoing x offset
		$tx-- if $dx > 0.3 ;
		$tx++ if $dx < -0.3 ;
# if there was no x offset try putting one in
		$tx++ if $dx >=0 && $dx <= 0.3 ;
		$tx-- if $dx >= -0.3 && $dx < 0 ;
				} # end if undo x
# oh well, can't find a spot--let it overlay another atom
			   } # end if spot occupied
# successful assignment
	$iasgn++ ; $asgn[$i] = 1 ;
	$occx[$i] = $tx ; $occy[$i] = $ty ;
#	print "assign atom $i: $occx[$i],$occy[$i],$el[$i]$i\n";
	last if $iasgn == $iatm ;  # finished
				  } # end for each atom
} # end while next pass main loop
# check to see if another fragment in file
	if ( $iasgn < $iatm) {
# find first unassigned atom
	   for ($j=1;$j<=$iatm;$j++) { last unless $asgn[$j] }
# find closest assigned atom
		$dmin = 100 ;
	   for ($k=1;$k<=$iatm;$k++) { 
		next unless $asgn[$k] ;
     	    $ds = ($x[$j]-$x[$k])**2+($y[$j]-$y[$k])**2+($z[$j]-$z[$k])**2;
	    if ( $ds < $dmin ) { $dmin = $ds ; $l = $k }
				 } # end for assigned atoms
	    if ( $dmin < 12.25 ) {
# if neighbor is < 3.5and away insert a bond entry
		$ibnd++ ;
		$a1[$ibnd] = $l ; $a2[$ibnd] = $j ;
		$bo[$j] = 1 ;
				 } # end if insert bond
	    else {
# assign location from scratch
     	    $tx = $x[$j]-$x[$l] ; $tx++ if int($tx)>0 && int($tx)<1 ;
     	    $ty = $y[$j]-$y[$l] ; $ty++ if int($ty)>0 && int($ty)<1 ;
     	    $tz = $z[$j]-$z[$l] ; $tz++ if int($tz)>0 && int($tz)<1 ;
		
     	    $tx = int($tx)+$occx[$l] ;
     	    $ty = int($tx)+$occy[$l]+int($tz) ;
		$iasgn++ ; $asgn[$j] = 1 ;
		$occx[$j] = $tx ; $occy[$j] = $ty ;
			} # end if start new fragment
		} # end if more fragments
} # end while fragment
#
# get extremes for plotting
$minx = $miny = $maxx = $maxy = 0 ;
     for ($j=1;$j<=$iatm;$j++) {
	   $tx = $occx[$j] ; $ty = $occy[$j] ;
	$minx = $tx if $tx < $minx ;  # extremes for plotting
	$miny = $ty if $ty < $miny ;
	$maxy = $ty if $ty > $maxy ;
	$maxx = $tx if $tx > $maxx ;
				} # end if extremes
# expand scale to make room for bonds and shift axis to lower left
for ($j=1;$j<=$iatm;$j++) {
	$occx[$j] = ($occx[$j]-$minx)*2 ;
	$occy[$j] = ($occy[$j]-$miny)*2 ;
		} # end for all atoms
	$maxx = ($maxx-$minx)*2 ; $maxy = ($maxy-$miny)*2 ;
# put in bonds
@type1 = (' / ',' | ',' \ ',' - ','',' - ', ' \ ',' | ',' / ') ;
@type2 = ('// ','|| ','\\ ',' = ','',' = ', '\\ ','|| ','// ') ;
@type3 = ('///','|||','\\\\',' E ','',' E ','\\\\','|||','///') ;
for ($j=1;$j<=$ibnd;$j++) {
	$dx = $occx[$a2[$j]]-$occx[$a1[$j]] ;
	$dy = $occy[$a2[$j]]-$occy[$a1[$j]] ;
	$bndx[$j] = $occx[$a1[$j]]+$dx/2 ;
	$bndy[$j] = $occy[$a1[$j]]+$dy/2 ;
	$x = $dx/2+1+3*($dy/2+1) ;
	$bsym[$j] = $type1[$x] if $bo[$j] == 1 ;
	$bsym[$j] = $type2[$x] if $bo[$j] == 2 ;
	$bsym[$j] = $type3[$x] if $bo[$j] == 3 ;
		} # end for all bonds
#
sub OCCUP {
$OCCUP = 0 ;
for ($k=1;$k<=$iatm;$k++) {
	next unless $asgn[$k] ;
	next unless $tx == $occx[$k] ;
	next unless $ty == $occy[$k] ;
		$OCCUP = 1 ; last ;
			} # end for all atoms
} # end sub OCCUP
#
print "<TABLE><TR><TD>\n";
	$path = 'http://www.colby.edu/chemistry/webmo/' ;
print "<embed src = \"$path$file\" display3d=ball&stick spiny=360 startspin=true
width=200 height=200></TD><TD>\n" ;
#
print "<TABLE>\n" ;
for ($i=$maxy;$i>=0;$i--) {
	for ($j=0;$j<=$maxx;$j++) { $plot[$j]="" }
	print "<TR ALIGN=CENTER>" ;
# put in atoms
	for ($j=1;$j<=$iatm;$j++) {
		$tx = $occx[$j] ;
		$plot[$tx] = $el[$j].$j if $occy[$j]==$i ;
				   } # end for all x values
# put in bonds
	for ($j=1;$j<=$ibnd;$j++) {
		next if $bsym[$j] eq '' ;
		$tx = $bndx[$j] ;
		$plot[$tx] = $bsym[$j] if $bndy[$j]==$i ;
				   } # end for all x values
	for ($j=0;$j<=$maxx;$j++) { print "<TD>$plot[$j]</TD>" }
    print "</TR>\n" ;
				} # end for each y value
print "</TABLE></TD></TR></TABLE>\n";