#!/usr/bin/perl -w
#
#       CHEM.PL
#
#   reads chemistry program and generates LaTeX picture environment
#   with PostScript drawing and LaTeX text. Backend can be configured
#   for easy generation of PS and other formats.
#   (c) 1999 Ingo Kloeckl
#
#   Modification history
#       1999-03-20 I.Kloeckl file creation
#       1999-03-26 I.Kloeckl new design
#       1999-04-03 I.Kloeckl generic output (PS, PS/LaTeX, LaTeX)
#       1999-04-11 I.Kloeckl code consolidation
#       1999-05-02 I.Kloeckl bugs fixed, goodies added
#       1999-10-20 I.Kloeckl setting \unitlength in a group before opening chem picture
#	2000-01-19 I.Kloeckl LaTeX packages can be given to be preloaded
#       2001-01-22 I.Kloeckl close LaTeX environments after error exit
#       2001-04-06 I.Kloeckl resize picture to its natural size for EPS generation
#   to-do wish list
#       o are t/r/b angles with type="chair",0/-1 ok?
#       o let bicyclic ring systems (bc221h, bc311h, bc222o, bc321o) rotate
#       o better parsing of p1 of bond (direction argument)
#       o make pure LaTeX output better looking
#       o pure PS output WITH text
#

use lib '.';
use Getopt::Long;

# ### load helper classes ##################
use loc;                # point class
use bbox;               # (bounding) box class
use streambuf;          # source stream/tokenizer class
use be;                 # generic output

# #### error codes #########################
$lberr = 1;             $errmsg[$lberr] = "left brace missing";
$rberr = 2;             $errmsg[$rberr] = "right brace missing";
$komma = 3;             $errmsg[$komma] = "Komma missing";
$interr = 4;            $errmsg[$interr] = "error parsing integer";
$texterr = 5;           $errmsg[$texterr] = "error parsing text";
$texerr = 6;            $errmsg[$texerr] = "error parsing TeX text";
$poserr = 7;            $errmsg[$poserr] = "error parsing position marker";
$bonderr = 8;           $errmsg[$bonderr] = "error parsing bond type";
$colonerr = 9;          $errmsg[$colonerr] = "colon missing";
$synterr = 10;          $errmsg[$synterr] = "syntax error";
$badargerr = 11;        $errmsg[$badargerr] = "bad argument";
$incargerr = 12;        $errmsg[$incargerr] = "inconsistent arguments";
$realerr = 13;          $errmsg[$realerr] = "error parsing fix float number";
$typerr = 14;           $errmsg[$typerr] = "unknown ring type";
$liberr = 15;           $errmsg[$liberr] = "unknown library";
$nexerr = 16;           $errmsg[$nexerr] = "non-existing index";

$true = (1==1);
$false = (1==0);
$pi = 3.1415927;

# global functional vars
$iAngleR = 0;
$iAngleT = 0;
$iAngleB = 0;
$iAngle_v = 0;
$iAngleBond = 0;        # angle of last drawn bond

$trace = 0;
$level = 0;

# ### the code #############################

#////////////////////////////////////////////////////////
#
# set parameter (dimens in pt) 
#
sub init_param
{
    $rLenS = 8;             # short bond 8 pt 
    $rLenN = 12;            # normal bond 12 pt
    $rLenL = 18;            # long bond 18 pt
    $rLW = 0.7;             # line width
    $rBW = 2.5;             # bond width
    $rBD = 1;               # bond dash pattern
    $rAW = 5;               # arrow width

    $rArrowSkip = 6;        # vert. space between arrow and text
    $rArrowExtend = 24;     # Abstand, um den der Pfeil ggue. den 
			    # Beschriftungen verlaengert wird

    $rXS = 6;               # hor. and vert. spacing
    $rYS = 6;
    $rEmove = 3;            # for electron moving

    $rChainSep = 36;        # vertical distance between reaction chains
    $rMultilineSep = 36;    # vertical distance between lines
    $rTextSep = 24;         # distance text - formula

    $fboxsep = 3;           # frame and bracket separation
}


#////////////////////////////////////////////////////////
#
# prints a trace message
#
sub trace
{
    my ($proc, $flag) = @_;
    if ($level<$trace)
    {
	printf "%02d%s%s: Flag ist %d   %s...\n", 
		$level, " "x(2*$level), $proc, $flag,
		substr($buf->{"Buffer"}, $buf->{"Ptr"}, 40);
    }
}


#////////////////////////////////////////////////////////
#
# prints an error message
#
sub error
{
    my ($errn, $proc) = @_;
    printf "%s: error %d, %s\n", $proc, $errn, $errmsg[$errn];
    printf "    %s...\n", substr($buf->{"Buffer"}, $buf->{"Ptr"}, 40);
}


#////////////////////////////////////////////////////////
#
# utility functions
#
sub max
{
    my $m = $_[0];
    foreach $elem (@_)
    {
	$m = $elem if $elem>$m;
    }
    return $m;
}


#////////////////////////////////////////////////////////
#//
#//  branch
#//    {fliste;
#//     fliste;
#//      ...
#//    }
#//
sub branch
{
    my ($XYg, $XYweiter, $BBoxg, $bFlag) = @_;
    my $XY = new loc();
    my $BBox = new bbox;
    my $errn = 0;
    $level++;

    $errn = $synterr, goto error if !$buf->NextToken("{");
    # scanne ausgehende Strukturen
    while (!$buf->NextToken("}"))
    {
	$XY->eq($XYg);          
	$BBox->init($XY);
	$errn = $synterr, goto error if !&fliste($XY, $BBox, $bFlag, ";");
	$BBoxg->MinMax($BBox);
    }
    $XYweiter->eq($XYg);
    $level--;
    return $true;

error:
    $level--;
    &error($errn, "branch");
    return $false;
}


#//////////////////////////////////////
#
#  some routines for generic ring macro
#
sub getangle
{
    my ($p1, $p2) = @_;
    return atan2($p2->{"y"}-$p1->{"y"}, $p2->{"x"}-$p1->{"x"})*180/$pi;
}

sub getlength
{
    my ($p1, $p2) = @_;
    my ($dx, $dy) = ($p2->{"x"}-$p1->{"x"}, $p2->{"y"}-$p1->{"y"});
    return sqrt($dx*$dx+$dy*$dy);
}

sub getpos
{
    my ($p1, $iAngle, $rLen) = @_;
    my $p2 = new loc();
    $p2->eq($p1->{"x"} + cos($iAngle*$pi/180)*$rLen, $p1->{"y"} + sin($iAngle*$pi/180)*$rLen);
    return $p2;
}

# polygon
# parameter: "ring", n, iangle, startpos, bliste, radius
sub ring_default_
{
    my ($iAnz, $n, $iAngle, $iStart, $BT, $bAromat, $rRadius) = @_;
    $$iAnz = $$n = 6;
    $$iStart = 0;
    $$iAngle = -90;
    $$rRadius = $rLenN;
    $$bAromat = $true;
    @$BT = (0, 0, 0, 0, 0, 0);
}

sub ring_
{
    my ($XYstart, $rRadius, $rRadius_bak, $iAnz, $n, $iAngle, $iStart, 
			$M, $rLena, $rThetaa, $XYa, $BLa, $t, $b, $r) = @_;

    $$iAnz = $n;
    my $rAngle = (90-360/$n*$iStart + $iAngle)*$pi/180;
    my $rLen;
    if ($$rRadius<0)
    {
	$rLen = abs($$rRadius);
	$$rRadius = $rLen/(2*sin($pi/$n));
    }
    else
    {
	$rLen = 2 * $$rRadius * sin($pi/$n);
    }
    $M->eq(- sin($rAngle)*$$rRadius, cos($rAngle)*$$rRadius);
    $M->translate($XYstart);
    my $i;
    my $rTheta = (-90-180/$n) + $iAngle;
    my $XY = new loc();
    for ($i=0; $i<$n; $i++)
    {
	$rLena->[$i] = $rLen;
	$rThetaa->[$i] = $rTheta;
	$t->[$i] = $rTheta+180;
	$b->[$i] = $rTheta + 360/$n;
	$r->[$i] = $iAngle - $i*360/$n;
	$rTheta -= 360/$n;
	$XY->eq($M);
	$rAngle = (90-360/$n*$i + $iAngle)*$pi/180;
	$XY->translate(sin($rAngle)*$$rRadius, -cos($rAngle)*$$rRadius);
	$XYa->[$i] = $XY->new();
	$BLa->[$i] = $i;
    }
    $$rRadius_bak = $$rRadius; 
    $$rRadius *= 0.7;
}

# cyclohexane in chair conformation
# parameter: "chair", , p2, startpos, bliste, radius
# p2 = 1 | 0 | -1: three conformations
sub chair_default_
{
    my ($iAnz, $conf, $iAngle, $iStart, $BT, $bAromat, $rRadius) = @_;
    $$iAnz = 6;
    $$iStart = $$iAngle = 0;
    $$conf = 1;
    $$rRadius = $rLenN;
    $$bAromat = $false;
    @$BT = (0, 0, 0, 9, 9, 9);
}

sub chair_
{
    my ($XYstart, $rRadius, $rRadius_bak, $iAnz, $conf, $iAngle, $iStart, 
			$M, $rLena, $rThetaa, $XYa, $BLa, $t, $b, $r) = @_;

    $$rRadius_bak = $$rRadius = abs($$rRadius);
    my ($dx, $dy) = (cos(30*$pi/180)*$$rRadius, sin(30*$pi/180)*$$rRadius);
    my ($sx, $sy) = ($$rRadius, sin(30*$pi/180)*(2*$$rRadius));
    my $l1 = sqrt($sx*$sx+$sy*$sy);
    if ($conf == 1)
    {
	@$XYa = (new loc(0,0), new loc($dx,-$dy), new loc(2*$dx,0), 
	    new loc($sx+2*$dx,-$sy), new loc($sx+$dx,$dy-$sy), 
	    new loc($sx,-$sy));
	@$rThetaa = (-30, +30, getangle($$XYa[2], $$XYa[3]), 
	    150, -150, getangle($$XYa[5], $$XYa[0]));
	@$rLena = ($$rRadius, $$rRadius, $l1, $$rRadius, $$rRadius, $l1);
	@$r = (150, -90, 90, -30, 90, -90);
	@$t = (90, 120, 90, 30, 90, 160);
	@$b = (-150, -90, -20, -90, -60, -90);
    }
    elsif ($conf == 0)
    {
	@$XYa = (new loc(0,0), new loc($dx,-$dy), new loc(3*$dx,$dy), 
	    new loc(4*$dx,0), new loc(3*$dx,-$dy), new loc($dx,$dy));
	@$rThetaa = (-30, 30, -30, -150, 150, -150);
	@$rLena = ($$rRadius, 2*$$rRadius, $$rRadius, $$rRadius, 2*$$rRadius, $$rRadius);
	@$r = (180, 120, -60, 0, 60, -120);
	@$t = (150, 20, 90, 30, 90, -20);
	@$b = (-90, -90, -20, -90, -20, -90);
    }
    elsif ($conf == -1)
    {
	@$XYa = (new loc(0,0), new loc($sx,$sy), new loc($sx+$dx,$sy-$dy), 
	    new loc($sx+2*$dx,$sy), new loc(2*$dx,0), new loc($dx,$dy));
	@$rThetaa = (getangle($$XYa[0], $$XYa[1]), -30, 30,
	    getangle($$XYa[3], $$XYa[4]), 150, -150);
	@$rLena = ($l1, $$rRadius, $$rRadius, $l1, $$rRadius, $$rRadius);
	@$r = (-150, 90, -90, 30, -90, 90);
	@$t = (150, 90, 60, 90, 20, 90);
	@$b = (-90, -160, -90, -30, -90, -120);
    }
    grep(($_->rotate($iAngle) && 0), @$XYa);
    my $XYshift = new loc($$XYa[$iStart]);
    grep(($_->translate(- $XYshift->{"x"},
			- $XYshift->{"y"}) && 0), @$XYa);
    grep(($_->translate($XYstart) && 0), @$XYa);
    $M->eq(0,0);
    $M->translate($XYstart);
    @$BLa = (0, 1, 2, 3, 4, 5);   # start atom
    grep((($_ += $iAngle) && 0), @$r, @$t, @$b, @$rThetaa);
}

# newman projection
# parameter: "newman", , iangle, startpos, bliste, radius
sub newman_default_
{
    my ($iAnz, $iAngle, $p2, $iStart, $BT, $bAromat, $rRadius) = @_;
    $$iAnz = 6;
    $$iStart = $$p2 = 0;
    $$iAngle = -60;
    $$rRadius = $rLenN;
    $$bAromat = $true;
    @$BT = (9, 9, 9, 0, 0, 0);
}

sub newman_
{
    my ($XYstart, $rRadius, $rRadius_bak, $iAnz, $iAngle, $p2, $iStart, 
			$M, $rLena, $rThetaa, $XYa, $BLa, $t, $b, $r) = @_;

    $$rRadius_bak = $$rRadius = abs($$rRadius);
    my $rAngle;
    if ($iStart<=2)
    {
	$rAngle = (90-120*$iStart+90)*$pi/180;
    }
    else
    {
	$rAngle = (90-120*($iStart-3)+$iAngle+90)*$pi/180;
    }
    $M->eq(- sin($rAngle)*$$rRadius, cos($rAngle)*$$rRadius);
    $M->translate($XYstart);
    my $i;
    my $rTheta;
    my $XY = new loc();
    @$r = (90, -30, -150, 90+$iAngle, -30+$iAngle, -150+$iAngle);
    @$t = (150, 30, -90, 150+$iAngle, 30+$iAngle, -90+$iAngle);
    @$b = (30, -90, 150, 30+$iAngle, -90+$iAngle, 150+$iAngle);
    for ($i=0; $i<=2; $i++)
    {
	$rLena->[$i] = $$rRadius;
	$rThetaa->[$i] = 90-120*$i+180;
	$rAngle = (90-120*$i+90)*$pi/180;
	$XY->eq($M);
	$XY->translate(sin($rAngle)*$$rRadius, -cos($rAngle)*$$rRadius);
	$XYa->[$i] = $XY->new();
	$BLa->[$i] = $i;
	$rLena->[$i+3] = 0.5*$$rRadius;
	$rThetaa->[$i+3] = 90-120*$i+180+$iAngle;
	$rAngle = (90-120*$i+$iAngle+90)*$pi/180;
	$XY->eq($M);
	$XY->translate(sin($rAngle)*$$rRadius, -cos($rAngle)*$$rRadius);
	$XYa->[$i+3] = $XY->new();
	$BLa->[$i+3] = $i+3;
    }
    $$rRadius *= 0.5;
}

# cyclopentane similar to benzene, with flat top
# parameter: "cpentane", n, iangle, startpos, bliste, radius
sub cpentane_default_
{
    my ($iAnz, $p1, $iAngle, $iStart, $BT, $bAromat, $rRadius) = @_;
    $$iAnz = 5;
    $$iStart = $$p1 = 0;
    $$iAngle = -90;
    $$rRadius = $rLenN;
    $$bAromat = $false;         # can be changed to true by formula program
    @$BT = (0, 0, 0, 0, 0);
}

sub cpentane_
{
    my ($XYstart, $rRadius, $rRadius_bak, $iAnz, $p1, $iAngle, $iStart, 
			$M, $rLena, $rThetaa, $XYa, $BLa, $t, $b, $r) = @_;

    $$rRadius_bak = $$rRadius = abs($$rRadius);
    $iStart++ if $iStart>2;
    my $rAngle = (90-360/6*$iStart + $iAngle)*$pi/180;
    $M->eq(- sin($rAngle)*$$rRadius, cos($rAngle)*$$rRadius);
    $M->translate($XYstart);
    my $rLen = 2 * $$rRadius * sin($pi/6);
    my $rTheta = (-90-180/6) + $iAngle;
    my $XY = new loc();
    my ($i, $j);
    for ($i = $j=0; $i<6; $i++)
    {
	if ($i==3)
	{
	    $rTheta -= 360/6;
	    next;
	}
	$rLena->[$j] = ($i==2 ? 2*cos(30*$pi/180): 1) * $rLen;
	$rTheta = $iAngle+90 if $i==2;
	$rThetaa->[$j] = $rTheta;
	$rTheta += 30 if ($i==2);
	$rTheta -= 360/6;
	$XY->eq($M);
	$rAngle = (90-360/6*$i + $iAngle)*$pi/180;
	$XY->translate(sin($rAngle)*$$rRadius, -cos($rAngle)*$$rRadius);
	$XYa->[$j] = $XY->new();
	$j++;
    }
    $M->translate(0, - sin(30*$pi/180)/3*$rLen);
    $$rRadius *= 0.5;   # ring size if someone wish it
    @$BLa = (0, 1, 2, 3, 4);
    @$r = (0, -60, -120, 120, 60);
    @$t = (60, 0, -90, 180, 120);
    @$b = (-60, -120, 180, 90, 0);
    grep((($_ += $iAngle) && 0), @$b, @$r, @$t);
}


#////////////////////////////////////////////////////////
#//
#//  ring([<cType>] [, [<startpos>] [, [<bliste>] [, [<radius>] 
#//       [, [<p1>] [, [<p2>] ]]]]])
#//    {<pos>: fliste;      
#//     vertex()...
#//     ...
#//    }
#//  vertex([<cType>] [, [<vertex1>] [, [<vertex2>] [, [<bliste>] 
#//       [, [<p1>] ]]]])
#//    {<pos>: fliste;      
#//     vertex()...
#//     ...
#//    }
#//
#//  bliste := H | O | <n><bTyp> bliste
#//  <pos> := C, 0, 1, ..., Anz-1
#//
sub ring
{
    my $vertex = shift;

    # if called by "vertex", get some information of base ring system
    my $radius_ring1 = shift if $vertex;
    my $rTheta_ring1 = shift if $vertex;
    my $XYa_ring1 = shift if $vertex;
    my $BLa_ring1 = shift if $vertex;
    my $rLen_ring1 = shift if $vertex;

    my ($XYg, $XYweiter, $BBoxg, $bFlag) = @_;
    my $errn = 0;
    $level++;

&trace("ring", $bFlag);
    # parse parameter list, defaults for benzene nucleus
    my $cType = "ring";
    my ($iAnz, $iAnztmp, $p1, $p2, $iStart, $bAromat, $rRadius, $rRadius_bak);
    my (@XYa, @rLen, @rTheta, @BLa, @iBType, @ta, @ba, @ra);
    my $tmp;
    my $M = new loc();

    $errn = $lberr, goto error if !$buf->NextToken("(");

    # vertex? then some ring parameters can be calculated
    if ($vertex)
    {
	$cType = $tmp if $buf->GetText($tmp);
	$errn = $komma, goto error if !$buf->NextToken(",");
	my $cCmd = "$cType".
	    '_default_(\$iAnz, \$p1, \$p2, \$iStart, \@iBType, '. 
	    '\$bAromat, \$rRadius);';
	eval($cCmd);
	my ($iVertex1, $iVertex2) = (0,0);
	$iVertex1 = $tmp if $buf->GetInt($tmp);
	if ($buf->NextToken(","))
	{
	    $iVertex2 = $tmp if $buf->GetInt($tmp);
	    if ($buf->NextToken(","))
	    {
		if ($buf->NextToken("H"))
		{   
		    $bAromat = $false;
		}
		elsif ($buf->NextToken("O"))
		{
		    $bAromat = $true;
		}
		my ($iN, $iTypeN);
		while ($buf->GetInt($iN))
		{
		    $errn = $bonderr, goto error 
				if !$buf->GetBondType($iTypeN);
		    $iBType[$iN] = $iTypeN;
		}
		if ($buf->NextToken(","))
		{
		    $p1 = $tmp if $buf->GetInt($tmp);
		}
	    }
	}
	# calculate parameters, use some information from base ring system
	$rRadius = $radius_ring1;
	$XYg->eq($$XYa_ring1[$$BLa_ring1[$iVertex1]]);
	$iStart = ($iVertex2+1) % $iAnz;
	$cCmd = "$cType".
	    '_($XYg, \$rRadius, \$rRadius_bak, \$iAnz, $p1, 0, $iStart,'. 
	    '$M, \@rLen, \@rTheta, \@XYa, \@BLa, \@ta, \@ba, \@ra);';
	eval($cCmd);
	$rRadius = abs($rRadius_bak * ($$rLen_ring1[$iVertex1]/$rLen[$iVertex2]));
	$p2 = $$rTheta_ring1[$iVertex1] - $rTheta[$iVertex2] + 180;
    }
    else
    {
	$cType = $tmp if $buf->GetText($tmp);
	# construct call of specific structure default function
	my $cCmd = "$cType".
	    '_default_(\$iAnz, \$p1, \$p2, \$iStart, \@iBType, '. 
	    '\$bAromat, \$rRadius);';
	eval($cCmd);
	$errn = $typerr, goto error if $@;

	if ($buf->NextToken(","))
	{
	    $iStart = $tmp if $buf->GetInt($tmp);
	    if ($buf->NextToken(","))
	    {
		if ($buf->NextToken("H"))
		{   
		    $bAromat = $false;
		}
		elsif ($buf->NextToken("O"))
		{
		    $bAromat = $true;
		}
		my ($iN, $iTypeN);
		while ($buf->GetInt($iN))
		{
		    $errn = $bonderr, goto error 
				if !$buf->GetBondType($iTypeN);
		    $iBType[$iN] = $iTypeN;
		}
		if ($buf->NextToken(","))
		{
		    my $rAbs = 1;
		    $rAbs = -1 if $buf->NextToken("#");
		    $rRadius = $tmp if $buf->GetBondLen($tmp);
		    $rRadius *= $rAbs;
		    if ($buf->NextToken(","))
		    {
			$p1 = $tmp if $buf->GetInt($tmp);
			if ($buf->NextToken(","))
			{
			    # check for some special symbolic angles
			    if ($cType eq "ring" || $cType eq "cpentane")
			    {
				if ($buf->GetInt($tmp))
				{
				    $p2 = $tmp;
				}
				else
				{
				    # construct call of specific structure function
				    # to get angles
				    $cCmd = "$cType".
					'_($XYg, \$tmp, \$tmp, \$iAnz, $p1, 0, $iStart,'. 
					'$M, \@rLen, \@rTheta, \@XYa, \@BLa, \@ta, \@ba, \@ra);';
				    eval($cCmd);
				    if ($buf->NextToken("r"))
				    {   $p2 = $iAngleBond + 180 - $ra[$iStart]; }
				    elsif ($buf->NextToken("t"))
				    {   $p2 = $iAngleBond + 180 - $ta[$iStart]; }
				    elsif ($buf->NextToken("b"))
				    {   $p2 = $iAngleBond + 180 - $ba[$iStart]; }
				    else
				    {
					$errn = $badargerr, goto error;
				    }
				}               
			    }
			    else        # otherwise, param must be integer
			    {
				$p2 = $tmp if $buf->GetInt($tmp);
			    }
			}
		    }
		}
	    }
	}
    }       
    $errn = $rberr, goto error if !$buf->NextToken("){");

    # now draw ring
    # construct call of specific structure function
    $cCmd = "$cType".
	'_($XYg, \$rRadius, \$rRadius_bak, \$iAnz, $p1, $p2, $iStart,'. 
	'$M, \@rLen, \@rTheta, \@XYa, \@BLa, \@ta, \@ba, \@ra);';
    eval($cCmd);
    # insert missing bond types if p1 > iAnz (type "ring")
    # and determine compound bounding box
    my $i;
    my $BBox = new bbox();
    for ($i=0; $i<$iAnz; $i++)
    {
	$iBType[$i] = 0 if not defined $iBType[$i];
	$BBox->MinMax($XYa[$i]);
    }
    $BBoxg->MinMax($BBox);

    if ($bFlag)
    {
	my ($start, $bond) = (0,0);
	foreach $start (@BLa)
	{
	    print OUT $be->bond($XYa[$start]->{"x"}, $XYa[$start]->{"y"}, 
			$rTheta[$bond]%360, $rLen[$bond], $iBType[$bond]);
	    $bond++;
	}
	print OUT $be->arc($M->{"x"}, $M->{"y"}, 0, 360, $rRadius)
				if $bAromat;    # draw aromatic ring symbol
    }

    # scan structures at ring atoms
    my $XY = new loc();
    while (!$buf->NextToken("}"))
    {
	if ($buf->NextToken("vertex"))
	{
	    $XY->eq($XYg);
	    ring($true, $rRadius_bak, \@rTheta, \@XYa, \@BLa, \@rLen, 
						$XY, $XYweiter, $BBoxg, $bFlag);
	    $errn = $synterr, goto error if !$buf->NextToken(";");
	}
	else
	{
	    if ($buf->NextToken("C"))
	    {
		$XY->eq($M);
	    }
	    else
	    {
		$errn = $interr, goto error if !$buf->GetInt($iN);
		$errn = $badargerr, goto error if $iN>=$iAnz;
		$XY->eq($XYa[$iN]);
		# save globale ring-specific angles (top, bottom, radial)
		$iAngleT = $ta[$iN];
		$iAngleB = $ba[$iN];
		$iAngleBond = $iAngleR = $ra[$iN];
		$Theta = \@rTheta;
	    }
	    $errn = $colonerr, goto error if !$buf->NextToken(":");
		
	    $BBox->init($XY);
	    $errn = $synterr, goto error if !&fliste($XY, $BBox, $bFlag, ";");
	    $BBoxg->MinMax($BBox);
	}
    }
	
    $XYweiter->eq($XYg);
&trace("ring OK", $bFlag);
    $level--;
    return $true;

error:
    $level--;
    &error($errn, "ring");
    return $false;
}


#////////////////////////////////////////////////////////
#//
#//  bond(<winkel> [, [<Typ>], [<Len>]])
#//  bond(#<n> [, [<Typ>]])
#//  bond([<winkel>] [+|-] r|b|t|v [/][t][+|- ...] [, [<Typ>], [<Len>]])
#//
sub bond
{
    my ($XYg, $XYweiter, $BBoxg, $bFlag) = @_;
    my $errn = 0;
    $level++;
	
&trace("bond", $bFlag);
    # parse parameter list, default is single bond, normal length
    my ($iAngle, $rAngle);
    $errn = $lberr, goto error if !$buf->NextToken("(");
bond_start:
    my ($iType, $rLen) = (0, $rLenN);
    if ($buf->NextToken("#"))
    {
	my ($n, $tmp);
	$errn = $interr, goto error if !$buf->GetInt($n);
	if ($buf->NextToken(","))
	{
	    $iType = $tmp if $buf->GetBondType($tmp);
	}
	$errn = $nexerr, goto error if !defined($posXY[$n]);
	$iAngle = getangle($XYg, $posXY[$n]);
	$rAngle = (90-$iAngle)*$pi/180;
	$rLen = getlength($XYg, $posXY[$n]);
    }
    else
    {
	$iAngle = $buf->GetInt($tmp) ? $tmp : 0;
	my ($term, $faktor) = (0,0);
	if ($buf->NextToken("+"))
	{   $faktor = 1; }
	elsif ($buf->NextToken("-"))
	{   $faktor = -1; }
	# ring-specific global values? (top/bottom/radial angle)
	if ($buf->NextToken("t"))
	{ $term = $iAngleT; }
	elsif ($buf->NextToken("b"))
	{ $term = $iAngleB; }
	elsif ($buf->NextToken("r"))
	{ $term = $iAngleR; }
	elsif ($buf->NextToken("l"))
	{ $term = $iAngleBond; }
	elsif ($buf->NextToken("v("))
	{ 
	    my $tmp;
	    $errn = $interr, goto error if !$buf->GetInt($tmp);
	    $errn = $rberr, goto error if !$buf->NextToken(")");
	    $term = $Theta->[$tmp] % 360;
	}
	else
	{
	    $term = 0;
	}
	$term += ((($term%360)/45)%2? 60 : -60) if $buf->NextToken("/");
	$term -= ((($term%360)/45)%2? 60 : -60) if $buf->NextToken("\\");
	$term -= ((($term%360)/45)%2? 60 : -60) if $buf->NextToken("t");
	while ($buf->NextToken("+")) { $term += 60; }
	while ($buf->NextToken("-")) { $term -= 60; }
	$term = 180-$term if $buf->NextToken("|");
	$iAngle += $term;
	$iAngle += 180 if $faktor<0;
	if ($buf->NextToken(","))
	{
	    my $tmp;
	    $iType = $tmp if $buf->GetBondType($tmp);
	    if ($buf->NextToken(","))
	    {
		$rLen = $tmp if $buf->GetBondLen($tmp);
	    }
	}
	$rAngle = (90-$iAngle) * $pi/180;
    }

    # OK, do the work!
    $XYweiter->eq($XYg);
    $XYweiter->translate(sin($rAngle)*$rLen, cos($rAngle)*$rLen);     
    $BBoxg->MinMax($XYg);      
    $BBoxg->MinMax($XYweiter);      
	
    if ($bFlag) 
    {
	print OUT $be->bond($XYg->{"x"}, $XYg->{"y"},
						$iAngle, $rLen, $iType);
    }
    $iAngleBond = $iAngle;

    $XYg->eq($XYweiter), goto bond_start if $buf->NextToken(";");
    $errn = $rberr, goto error if !$buf->NextToken(")");
					
&trace("bond OK", $bFlag);
    $level--;
    return $true;

error:
    $level--;
    &error($errn, "bond");
    return $false;
}


#///////////////////////////////////
# general function for text output
sub atom_
{
    my ($cText, $iPos, $iPosCont, $bErase, $XYg, $XYweiter, $BBoxg, 
								$bFlag) = @_;

    # read dimensions of text from dimension hash
    my ($wd, $ht, $dp) = $texthash{$cText} =~ /^A:(.+)pt,(.+)pt,(.+)pt/;
    my $TextBBox = new bbox(0,0, $wd, $ht);
# 14.4.2001 IK - class type changed
#    my $Null = new bbox();
    my $Null = new loc();
    my $XY = new loc();

    # bestimme Startpunkt, sodass BBox in Relation iPos zu XYg steht
    $TextBBox->OrigConPoint($iPos, $XY, $Null);
    # XY is no correct starting point, shift BBox
    $XY->translate($XYg);
    $TextBBox->translate($XY);
    $TextBBox->ToConPoint($iPosCont, $XYweiter);
    $XYg->eq($XY);
    $TextBBox->{"yu"} -= $dp;
    $BBoxg->MinMax($TextBBox);

    if ($bFlag) 
    {
	# erase background before writing text
	print TMP $be->erase($XY->{"x"}, $XY->{"y"}-$dp, $wd, $ht+$dp) if $bErase;
	print TMP $be->text($XY->{"x"}, $XY->{"y"}, $cText);
    }
}


#////////////////////////////////////////////////////////
#//
#//  atom(<Text> [, [<pos>][, [<contpos>] [, <erase>[]]]])
#//
sub atom
{
    my $errn = 0;
    $level++;
&trace("atom", $bFlag);
	
    # parse parameter list
    my $cText;
    my ($iPos, $iPosCont, $bErase) = ($bbox::SB_C, $bbox::SB_C, 1);
    my $tmp;
    $errn = $lberr, goto error if !$buf->NextToken("(");
    $errn = $texerr, goto error if !$buf->GetText($cText);
    if ($buf->NextToken(","))
    {
	$iPos = $tmp if $buf->GetPos($tmp);
	if ($buf->NextToken(","))
	{
	    $iPosCont = $tmp if $buf->GetPos($tmp);
	    if ($buf->NextToken(","))
	    {
		$bErase = $tmp if $buf->GetInt($tmp);
	    }
	}
    }
    $errn = $rberr, goto error if !$buf->NextToken(")");
    &atom_($cText, $iPos, $iPosCont, $bErase, @_);

&trace("atom OK", $bFlag);
    $level--;
    return $true;

error:
    $level--;
    &error($errn, "atom");
    return $false;
}


#////////////////////////////////////////////////////////
#//
#//  saveXY(#<n>) / restoreXY(#<n>)
#//
sub saveXY
{
    my ($XYstart) = @_;
    my $errn = 0;
    my $XY = new loc($XYstart);
    $level++;
	
    # parse parameter list
    my $n;
    $errn = $lberr, goto error if !$buf->NextToken("(#");
    $errn = $interr, goto error if !$buf->GetInt($n);
    if ($buf->NextToken(","))
    {
	my ($iAngle, $rLen);
	$errn = $interr, goto error if !$buf->GetInt($iAngle);
	$errn = $komma, goto error if !$buf->NextToken(",");
	$errn = $lenerr, goto error if !$buf->GetBondLen($rLen);
	$XY->translate(cos($iAngle*$pi/180)*$rLen, sin($iAngle*$pi/180)*$rLen);
    }
    $errn = $rberr, goto error if !$buf->NextToken(")");

    $posXY[$n] = $XY->new();

    $level--;
    return $true;

error:
    $level--;
    &error($errn, "saveXY");
    return $false;
}

sub restoreXY
{
    my ($XYweiter) = @_;
    my $errn = 0;
    $level++;
	
    # parse parameter list
    my $n;
    $errn = $lberr, goto error if !$buf->NextToken("(#");
    $errn = $interr, goto error if !$buf->GetInt($n);
    $errn = $rberr, goto error if !$buf->NextToken(")");

    $XYweiter->eq($posXY[$n]);

    $level--;
    return $true;

error:
    $level--;
    &error($errn, "restoreXY");
    return $false;
}


#////////////////////////////////////////////////////////
#//
#//  orbital([<iAngle>] [, [<rWeight>]])
#//
sub orbital
{
    my ($XYstart, $BBoxg, $bFlag) = @_;
    my $errn = 0;
    $level++;
	
    # parse parameter list
    my $tmp;
    my ($iAngle, $iWeight) = (90, 1);
    $errn = $lberr, goto error if !$buf->NextToken("(");
    $iAngle = $tmp if $buf->GetInt($tmp);
    if ($buf->NextToken(","))
    {
	$rWeight = $tmp if $buf->GetReal($tmp);
    }
    $errn = $rberr, goto error if !$buf->NextToken(")");
    $rWeight *= 0.9*$rLenN;

    my $XY = new loc($XYstart);
    $XY->translate(cos($iAngle*$pi/180)*$rWeight, sin($iAngle*$pi/180)*$rWeight);
    $BBoxg->MinMax($XY);
    $XY->translate(cos(($iAngle+180)*$pi/180)*$rWeight, sin(($iAngle+180)*$pi/180)*$rWeight);
    $BBoxg->MinMax($XY);

    if ($bFlag)
    {
	print OUT $be->orbital($XYstart->{"x"}, $XYstart->{"y"}, 
			      $iAngle, $rWeight); 
    }

    $level--;
    return $true;

error:
    $level--;
    &error($errn, "orbital");
    return $false;
}


#////////////////////////////////////////////////////////
#//
#//  fliste :== element fliste | <endtoken>
#//  element :== bond | atom | ring | branch | saveXY | restoreXY | orbital |
#//     save | restore | set
#//
sub fliste
{
    my ($XYg, $BBoxg, $bFlag, $EndToken) = @_;
    my $XYStart = new loc($XYg);
    my $XYweiter = new loc();
	
fliste:
    if ($buf->NextToken($EndToken))
    {
	return $true;
    }
    elsif ($buf->NextToken("bond"))
    {
	$XYStart->eq($XYweiter), goto fliste 
		if &bond($XYStart, $XYweiter, $BBoxg, $bFlag);
    }
    elsif ($buf->NextToken("atom"))
    {
	$XYStart->eq($XYweiter), goto fliste 
		if &atom($XYStart, $XYweiter, $BBoxg, $bFlag);
    }
    elsif ($buf->NextToken("ring"))
    {
	$XYStart->eq($XYweiter), goto fliste 
		if &ring($false, $XYStart, $XYweiter, $BBoxg, $bFlag);
    }
    elsif ($buf->NextToken("branch"))
    {
	$XYStart->eq($XYweiter), goto fliste 
		if &branch($XYStart, $XYweiter, $BBoxg, $bFlag);
    }
    elsif ($buf->NextToken("saveXY"))
    {
	goto fliste if &saveXY($XYStart);
    }
    elsif ($buf->NextToken("restoreXY"))
    {
	goto fliste if &restoreXY($XYStart);
    }
    elsif ($buf->NextToken("orbital"))
    {
	goto fliste if &orbital($XYStart, $BBoxg, $bFlag);
    }
    elsif ($buf->NextToken("save"))
    {
	goto fliste if &save();
    }
    elsif ($buf->NextToken("restore"))
    {
	goto fliste if &restore($bFlag);
    }
    elsif ($buf->NextToken("set"))
    {
	goto fliste if &set($bFlag);
    }

    return $false;
}


# helper function for spacing
# &space_($iPosCont, $XYweiter)
sub space_
{
    my ($iPos, $XYweiter) = @_;

    SWITCH:
    {
	$XYweiter->translate(-$rXS,0), last SWITCH 
					if $iPos == $bbox::SB_L;
	$XYweiter->translate(0,$rYS), last SWITCH 
					if $iPos == $bbox::SB_T;
	$XYweiter->translate($rXS,0), last SWITCH 
					if $iPos == $bbox::SB_R;
	$XYweiter->translate(0,-$rYS), last SWITCH 
					if $iPos == $bbox::SB_B;
	$XYweiter->translate(-$rXS,$rYS), last SWITCH 
					if $iPos == $bbox::SB_TL;
	$XYweiter->translate($rXS,$rYS), last SWITCH 
					if $iPos == $bbox::SB_TR;
	$XYweiter->translate(-$rXS,-$rYS), last SWITCH 
					if $iPos == $bbox::SB_BL;
	$XYweiter->translate($rXS,-$rYS), last SWITCH 
					if $iPos == $bbox::SB_BR;
    }
}


#////////////////////////////////////////////////////////
#//
#//  space([<pos>])
#//
sub space
{
    my ($XYg, $XYweiter, $BBoxg, $bFlag) = @_;
    my $errn = 0;
    $level++;

    # parse parameter list
    my $iPos = $bbox::SB_R;
    my $tmp;

    $errn = $lberr, goto error if !$buf->NextToken("(");
    $iPos = $tmp if $buf->GetPos($tmp);
    $errn = $rberr, goto error if !$buf->NextToken(")");

    &space_($iPos, $XYweiter);

    $level--;
    return $true;

error:
    $level--;
    &error($errn, "space");
    return $false;
}


#////////////////////////////////////////////////////////
#//
#//  gotoXY([<x>] [, [<y>]]) / shiftXY([<dx>] [, [<dy>]])
#//
sub gotoXY
{
    my ($XYstart, $XYweiter, $BBoxg, $bFlag) = @_;
    my $errn = 0;
    $level++;

    # parse parameter list
    my ($x, $y) = ($XYstart->{"x"}, $XYstart->{"y"});
    my $tmp;

    $errn = $lberr, goto error if !$buf->NextToken("(");
    $x = $tmp if $buf->GetInt($tmp);
    if ($buf->NextToken(","))
    {
	$y = $tmp if $buf->GetInt($tmp);
    }
    $errn = $rberr, goto error if !$buf->NextToken(")");

    $XYweiter->eq($x, $y);
    $BBoxg->MinMax($XYweiter);

    $level--;
    return $true;

error:
    $level--;
    &error($errn, "gotoXY");
    return $false;
}

sub shiftXY
{
    my ($XYstart, $XYweiter, $BBoxg, $bFlag) = @_;
    my $errn = 0;
    $level++;

    # parse parameter list
    my ($dx, $dy) = (0, 0);
    my $tmp;

    $errn = $lberr, goto error if !$buf->NextToken("(");
    $dx = $tmp if $buf->GetInt($tmp);
    if ($buf->NextToken(","))
    {
	$dy = $tmp if $buf->GetInt($tmp);
    }
    $errn = $rberr, goto error if !$buf->NextToken(")");

    $XYweiter->eq($XYstart);
    $XYweiter->translate($dx, $dy);
    $BBoxg->MinMax($XYweiter);

    $level--;
    return $true;

error:
    $level--;
    &error($errn, "shiftXY");
    return $false;
}


#////////////////////////////////////////////////////////
#//
#//  formula([<pos>] [, [<contpos>] [, <Name>, V|HA|HR, <dy>]]) :==
#//     fliste
#//
sub formula
{
    my ($XYstart, $XYweiter, $BBoxg, $bFlag, 
				$rTextSkip, $fbox, $context, $contextT) = @_;
    my ($TM_NONE, $TM_V, $TM_HA, $TM_HR) = (0, 1, 2, 3);
    my $errn = 0;
    $level++;

&trace("formula", $bFlag);
    # parse parameter list
    my ($iTextMode, $iDY, $tmp);
    my ($iPos, $iPosCont) = ($bbox::SB_L, $bbox::SB_R); 

    # some default angles in case of pure aliphatic compounds
    $iAngleT = 90;
    $iAngleB = -90;
    $iAngleBond = $iAngleR = 30;

    $errn = $lberr, goto error if !$buf->NextToken("(");
    $iPos = $tmp if $buf->GetPos($tmp);
    if ($buf->NextToken(","))
    {
	$iPosCont = $tmp if $buf->GetPos($tmp);
	$iTextMode = $TM_NONE;
	if ($buf->NextToken(","))
	{
	    $errn = $texerr, goto error if !$buf->GetText($cText);

	    # text size increase formula size due to user-given distance
	    # - but in multiline mode we have first to check for pure formula 
	    # height, later give a calculated text distance. Therefore user 
	    # must not give distance args!
	    if ($rTextSkip < 0)
	    {
		$errn = $komma, goto error if !$buf->NextToken(",");
		SW: 
		{ $iTextMode = $TM_V, last SW if $buf->NextToken("V");
		  $iTextMode = $TM_HA, last SW if $buf->NextToken("HA");
		  $iTextMode = $TM_HR, last SW if $buf->NextToken("HR");
		  $errn = $synterr, goto error;
		}
		$errn = $komma, goto error if !$buf->NextToken(",");
		$errn = $interr, goto error if !$buf->GetInt($iDY);
	    }
	    else
	    {
		$iTextMode = $TM_HA;
		$iDY = $rTextSkip;
	    }
	}
    }
    $errn = $rberr, goto error if !$buf->NextToken("){");

    my $XY = new loc();
    my $BBox = new bbox();
    my $Null = new loc();
    my $TextXY = new loc();
    my $fobjid = $objid+1;
    $objid += 2;

    if (!$bFlag)
    # calculate unknown dimensions and then the resulting starting point
    {
	# calculate size in BBox, starting point is (0,0)
	$errn = $synterr, goto error 
				if !&fliste($XY, $BBox, $false, "}");

	$context->eq($BBox);    # context without text
	$contextT->eq($BBox);   # text context is equal for textless formulas

	if ($iTextMode != $TM_NONE)
	{
	    $TextXY->{"x"} = ($BBox->{"xo"} + $BBox->{"xu"})/2;

	    $TextXY->{"y"} = $BBox->{"yu"} if $iTextMode == $TM_V;
	    $TextXY->{"y"} = ($BBox->{"yu"}+$BBox->{"yo"})/2 
					   if $iTextMode == $TM_HA;
	    $TextXY->{"y"} = $BBox->{"yu"} if $iTextMode == $TM_HR;

	    $TextXY->{"y"} -= $iDY;

	    my $XYdummy = new loc();
	    my $Boxdummy = new bbox();
	    # increase formula dimension by text box dimension
	    $XYT = $TextXY->new();
	    &atom_($cText, $bbox::SB_B, $bbox::SB_B, $false, $TextXY,
		$XYdummy, $Boxdummy, $bFlag);

	    $BBox->MinMax($Boxdummy->{"xu"}, $BBox->{"yu"});
	    $BBox->MinMax($Boxdummy->{"xo"}, $BBox->{"yu"});
	    if ($iPosCont == $bbox::SB_BL || $iPosCont == $bbox::SB_BR ||
		$iPosCont == $bbox::SB_B)
	    {
		$BBox->MinMax($BBox->{"xu"}, $TextXY->{"y"});
	    }
	    $contextT->eq($BBox);       # context with text box
	}

	# bestimme Startpunkt, sodass BBox in Relation iPos zu XYg steht
	$BBox->OrigConPoint($iPos, $XY, $Null);
	# XY ist nun richtiger Startpunkt. Verschiebe BBox entsprechend
	$BBox->translate($XY);
	$BBox->translate($XYstart);
	$XY->translate($XYstart);
	$context->translate($XY);
	$contextT->translate($XY);
	if ($iTextMode != $TM_NONE)
	{
	    $XYT->translate($XY);
	    $origin[$fobjid+1] = $XYT->new();
	}

	$BBox->ToConPoint($iPosCont, $XYweiter);# connection point is
						# not influenced by text size
	&space_($iPosCont, $XYweiter) if !$buf->NextToken("nospace");


	# save size and position of object for later use in pass #2
	$origin[$fobjid] = $XY->new();

	$BBoxg->MinMax($BBox);          # formula size 
	if ($iTextMode != $TM_NONE)     # dto with text
	{
	    $BBoxg->MinMax($XYT); 
	    $contextT->MinMax($XYT);    # added 1999-05-07 IK
	    push(@$fbox, $BBox->new());
	}
    }
    else
    # formula can be drawn
    {
	# get size of formula object
	print OUT $be->comment("formula");
	$XY = $origin[$fobjid];
	$BBox->init($XY);

	# draw at final position
	&fliste($XY, $BBox, $bFlag, "}");
	$buf->NextToken("nospace");

	$context->eq($BBox);    # context without text
	$contextT->eq($BBox);   # text context is equal for textless formulas

	if ($iTextMode != $TM_NONE)
	{
	    my $XYdummy = new loc();
	    my $Boxdummy = new bbox();
	    &atom_($cText, $bbox::SB_B, $bbox::SB_B, $true, $origin[$fobjid+1],
		$XYdummy, $Boxdummy, $bFlag);
	}
    }


&trace("formula OK", $bFlag);
    $level--;
    return $true;

error:
    $level--;
    &error($errn, "formula");
    return $false;
}


# helper function for arrow
sub TranslatePos
{
    if ($_[0] eq "T")
    {
	$_[1] = $bbox::SB_BL if $_[1] == $bbox::SB_L;
	$_[1] = $bbox::SB_B if $_[1] == $bbox::SB_C;
	$_[1] = $bbox::SB_BR if $_[1] == $bbox::SB_R;
    }
    else
    {
	$_[1] = $bbox::SB_TL if $_[1] == $bbox::SB_L;
	$_[1] = $bbox::SB_T if $_[1] == $bbox::SB_C;
	$_[1] = $bbox::SB_TR if $_[1] == $bbox::SB_R;
    }
}


#////////////////////////////////////////////////////////
#//
#//  arrow([<Winkel>] [, [<Len_Extend>] [, [<Typ>]]])
#//    {text(T|B, <pos>){ sliste } ...
#//    }
#//
sub arrow
{
    my ($XYstart, $XYweiter, $BBoxg, $bFlag) = @_;
    my $errn = 0;
    $level++;

&trace("arrow", $bFlag);
    # parse parameter list
    # default: 0 degree, ->
    my ($iAngle, $iType, $iLen) = (0, 1, $rArrowExtend);
    my $tmp;

    $errn = $lberr, goto error if !$buf->NextToken("(");
    $iAngle = ($tmp%360) if $buf->GetInt($tmp);
    if ($buf->NextToken(","))
    {
	$iLen = $tmp if $buf->GetInt($tmp);
	if ($buf->NextToken(","))
	{
	    $iType = $tmp if $buf->GetArrowType($tmp);
	}
    }
    $errn = $rberr, goto error if !$buf->NextToken("){"); 

    my $iBreite = 0;
    my $XY = new loc();
    my $XY1 = new loc();
    my $XY2 = new loc();
    my $BBox = new bbox();
# 15.4.2001 IK bug fixed
#    my $Null = new bbox();
    my $Null = new loc();
    my $BBox1 = new bbox();
    my $BBox2 = new bbox();
    my ($iPos1, $iPos2, $iPos) = (-1, -1, 0);

    my $tmpObjID = $objid+1;
    $objid += 4;
    my ($objID1, $objID2, $Ptr1, $Ptr2);
   
    if (!$bFlag)
    # bestimme Ausdehnungen der beiden Beschriftungen
    {
	my $iHPos;
	while (!$buf->NextToken("}"))
	{
	    $errn = $synterr, goto error if !$buf->NextToken("text");
	    $errn = $lberr, goto error if !$buf->NextToken("(");
	    $errn = $poserr, goto error if !$buf->GetPos($iHPos);
	    $errn = $poserr, goto error 
				if ($iHPos != $bbox::SB_T && $iHPos != $bbox::SB_B);
	    $errn = $komma, goto error if !$buf->NextToken(",");
	    $errn = $poserr, goto error if !$buf->GetPos($iPos);
	    $errn = $poserr, goto error 
		if ($iPos != $bbox::SB_L && $iPos != $bbox::SB_C && $iPos != $bbox::SB_R);
	    $errn = $rberr, goto error if !$buf->NextToken("){");
	    $BBox->init(0,0);
	    $XY->eq(0,0);
	    my $Ptr = $buf->GetPtr();
	    my $objIDtmp = $objid;
	    $errn = $synterr, goto error 
			if !&sliste($XY, $BBox, $false, -1, 0, "}");
	    if ($iHPos==$bbox::SB_T)
	    {   
		$BBox1->eq($BBox);    
		$objID1 = $objIDtmp;
		$iPos1 = $iPos;
		$Ptr1 = $Ptr;
	    }
	    else
	    {
		$BBox2->eq($BBox);    
		$iPos2 = $iPos;
		$objID2 = $objIDtmp;
		$Ptr2 = $Ptr;
	    }
	}

	# position marker inconsistent ?
	$errn = $incargerr, goto error if 
		($iPos1 != -1 && $iPos2 != -1 && $iPos1 != $iPos2);
	# arrow length is max(Breite1, Breite2) + 2*arrow_extend
	if ($iAngle<45 || $iAngle >=315 || ($iAngle >=135 && $iAngle <225))
	{
	    $iBreite = &max($BBox1->width(), $BBox2->width());
	}
	else
	{
	    $iBreite = &max($BBox1->height(), $BBox2->height());
	}
	$iBreite += 2*$iLen;

	my $XYref = new loc();
	my $iAngleBM = (90-$iAngle)*$pi/180;
	my ($ax, $ay) = ($iBreite*sin($iAngleBM), $iBreite*cos($iAngleBM));
	my ($px, $py) = ($ay/$iBreite, -$ax/$iBreite);

	if ($iPos1 != -1)
	{
	    &TranslatePos("T", $iPos1);
	    if ($iAngle==0)
	    {
		$XYref->eq($iLen, $rArrowSkip) 
					if $iPos1 == $bbox::SB_BL;
		$XYref->eq($iBreite/2, $rArrowSkip)
					if $iPos1 == $bbox::SB_B;
		$XYref->eq($iBreite-$iLen, $rArrowSkip)
					if $iPos1 == $bbox::SB_BR;
	    }
	    elsif ($iAngle==180)
	    {
		$XYref->eq(-$iLen, $rArrowSkip) 
					if $iPos1 == $bbox::SB_BR;
		$XYref->eq(-$iBreite/2, $rArrowSkip)
					if $iPos1 == $bbox::SB_B;
		$XYref->eq(-$iBreite+$iLen, $rArrowSkip)
					if $iPos1 == $bbox::SB_BL;
	    }
	    elsif ($iAngle==90)
	    {
		$XYref->eq(-$rArrowSkip, $iBreite-$iLen), $iPos1 = $bbox::SB_TR
					if $iPos1 == $bbox::SB_BL;
		$XYref->eq(-$rArrowSkip, $iBreite/2), $iPos1 = $bbox::SB_R
					if $iPos1 == $bbox::SB_B;
		$XYref->eq(-$rArrowSkip, $iLen), $iPos1 = $bbox::SB_TR
					if $iPos1 == $bbox::SB_BR;
	    }
	    elsif ($iAngle==270)
	    {
		$XYref->eq(-$rArrowSkip, -$iLen), $iPos1 = $bbox::SB_TR
					if $iPos1 == $bbox::SB_BL;
		$XYref->eq(-$rArrowSkip, -$iBreite/2), $iPos1 = $bbox::SB_R
					if $iPos1 == $bbox::SB_B;
		$XYref->eq(-$rArrowSkip, -$iBreite+$iLen), $iPos1 = $bbox::SB_BR
					if $iPos1 == $bbox::SB_BR;
	    }
	    else
	    {
		$XYref->eq(0.5*$ax-$rArrowSkip*$px, 0.5*$ay-$rArrowSkip*$py);
		SW: {
		$iPos1 = $bbox::SB_BR, last SW if $iAngle<90;
		$iPos1 = $bbox::SB_TR, last SW if $iAngle<180;
		$iPos1 = $bbox::SB_TL, last SW if $iAngle<270;
		$iPos1 = $bbox::SB_BL, last SW;
		}
	    }
	    $BBox1->OrigConPoint($iPos1, $XY1, $Null);
	    $BBox1->translate($XY1);
	    $BBox1->translate($XYstart);
	    $BBox1->translate($XYref);
	    $XY1->translate($XYstart);
	    $XY1->translate($XYref);
	    $BBoxg->MinMax($BBox1);
	    $objid = $objID1;
	    $buf->SetPtr($Ptr1);
	    &sliste($XY1, $BBox, $false, -1, 0, "}");
	}
	if ($iPos2 != -1)
	{
	    &TranslatePos("B", $iPos2);
	    if ($iAngle==0)
	    {
		$XYref->eq($iLen, -$rArrowSkip) 
					if $iPos2 == $bbox::SB_TL;
		$XYref->eq($iBreite/2, -$rArrowSkip)
					if $iPos2 == $bbox::SB_T;
		$XYref->eq($iBreite-$iLen, -$rArrowSkip)
					if $iPos2 == $bbox::SB_TR;
	    }
	    elsif ($iAngle==180)
	    {
		$XYref->eq(-$iLen, -$rArrowSkip) 
					if $iPos2 == $bbox::SB_TR;
		$XYref->eq(-$iBreite/2, -$rArrowSkip)
					if $iPos2 == $bbox::SB_T;
		$XYref->eq(-$iBreite+$iLen, -$rArrowSkip)
					if $iPos2 == $bbox::SB_TL;
	    }
	    elsif ($iAngle==90)
	    {
		$XYref->eq($rArrowSkip, $iLen), $iPos2 = $bbox::SB_BL
					if $iPos2 == $bbox::SB_TL;
		$XYref->eq($rArrowSkip, $iBreite-$iLen), $iPos2 = $bbox::SB_TL
					if $iPos2 == $bbox::SB_TR;
		$XYref->eq($rArrowSkip, $iBreite/2), $iPos2 = $bbox::SB_L
					if $iPos2 == $bbox::SB_T;
	    }
	    elsif ($iAngle==270)
	    {
		$XYref->eq($rArrowSkip, -$iLen), $iPos2 = $bbox::SB_TL
					if $iPos2 == $bbox::SB_TL;
		$XYref->eq($rArrowSkip, -$iBreite+$iLen), $iPos2 = $bbox::SB_BL
					if $iPos2 == $bbox::SB_TR;
		$XYref->eq($rArrowSkip, -$iBreite/2), $iPos2 = $bbox::SB_L
					if $iPos2 == $bbox::SB_T;
	    }
	    else
	    {
		$XYref->eq(0.5*$ax+$rArrowSkip*$px, 0.5*$ay+$rArrowSkip*$py);
		SW1: {
		$iPos2 = $bbox::SB_TL, last SW1 if $iAngle<90;
		$iPos2 = $bbox::SB_BL, last SW1 if $iAngle<180;
		$iPos2 = $bbox::SB_BR, last SW1 if $iAngle<270;
		$iPos2 = $bbox::SB_TR, last SW1;
		}
	    }
	    $BBox2->OrigConPoint($iPos2, $XY2, $Null);
	    $BBox2->translate($XY2);
	    $BBox2->translate($XYstart);
	    $BBox2->translate($XYref);
	    $XY2->translate($XYstart);
	    $XY2->translate($XYref);
	    $BBoxg->MinMax($BBox2);
	    $objid = $objID2;
	    $buf->SetPtr($Ptr2);
	    &sliste($XY2, $BBox, $false, -1, 0, "}");
	}
	$buf->NextToken("}");

	# save corrected origins of objects
	$origin[$tmpObjID] = $XY1->new();
	$origin[$tmpObjID+1] = $XY2->new();
	$origin[$tmpObjID+2] = $iBreite;

	# starting point remains at XYstart, ending point is shifted by
	# the arrow-vector
	$origin[$tmpObjID+3] = $XYstart->new();
	$XYweiter->eq($XYstart);
	$XYweiter->translate($ax, $ay);
	$BBoxg->MinMax($XYweiter);

	my $iPosCont = $bbox::SB_C;
	SWITCH:
	{
	    $iPosCont = $bbox::SB_R, last SWITCH if $iAngle<=22.5 || $iAngle>337.5;
	    $iPosCont = $bbox::SB_TR, last SWITCH if $iAngle<=67.5;
	    $iPosCont = $bbox::SB_T, last SWITCH if $iAngle<=112.5;
	    $iPosCont = $bbox::SB_TL, last SWITCH if $iAngle<=157.5;
	    $iPosCont = $bbox::SB_L, last SWITCH if $iAngle<=202.5;
	    $iPosCont = $bbox::SB_BL, last SWITCH if $iAngle<=247.5;
	    $iPosCont = $bbox::SB_B, last SWITCH if $iAngle<292.5;
	    $iPosCont = $bbox::SB_BR, last SWITCH if $iAngle<=337.5;
	}
	&space_($iPosCont, $XYweiter) if !$buf->NextToken("nospace");

    }
    else
    # setze im zweiten Lauf alles anhand der bekannten Ma"se zusammen
    {
	print OUT $be->comment("arrow");
	$XY1 = $origin[$tmpObjID];
	$XY2 = $origin[$tmpObjID+1];
	$iBreite = $origin[$tmpObjID+2];
	$XYstart = $origin[$tmpObjID+3];
	print OUT $be->arrow($XYstart->{"x"}, $XYstart->{"y"},
					$iAngle, $iBreite, $iType);
	while (!$buf->NextToken("}"))
	{
	    $buf->NextToken("text");
	    $buf->NextToken("(");
	    $buf->GetPos($iHPos);
	    $buf->NextToken(",");
	    $buf->GetPos($iPos);
	    $buf->NextToken("){");
	    if ($iHPos==$bbox::SB_T)
	    {   
		print OUT $be->comment("arrow text T");
		&sliste($XY1, $BBox1, $true, -1, 0, "}");
	    }
	    else
	    {
		print OUT $be->comment("arrow text B");
		&sliste($XY2, $BBox2, $true, -1, 0, "}");
	    }
	}
	$buf->NextToken("nospace");
    }


&trace("arrow OK", $bFlag);
    $level--;
    return $true;

error:
    $level--;
    &error($errn, "arrow");
    return $false;
}


#////////////////////////////////////////////////////////
#//
#//  joinh(<n>, [<iPosInner>] [, [<iPos>] [, [<Len_Extend>]])
#//     {[nospace] sliste;
#//      ...
#//     }
#//
sub joinh
{
    my ($XYstart, $XYweiter, $BBoxg, $bFlag) = @_;
    my $errn = 0;
    $level++;

&trace("joinh", $bFlag);
    # parse parameter list
    my ($iAnz, $iLen, $iPos, $iPosInner, $tmp);
    $iLen = $rArrowExtend;
    $iPosInner = $bbox::SB_L;   # default: left aligned
    $iPos = $bbox::SB_BL;

    $errn = $lberr, goto error if !$buf->NextToken("(");
    $errn = $interr, goto error if !$buf->GetInt($iAnz);
    $errn = $komma, goto error if !$buf->NextToken(",");
    $iPosInner = $tmp if $buf->GetPos($tmp);
    $errn = $badargerr, goto error if ($iPosInner != $bbox::SB_L &&
	$iPosInner != $bbox::SB_C && $iPosInner != $bbox::SB_R);
    if ($buf->NextToken(","))
    {
	$iPos = $tmp if $buf->GetPos($tmp);
	if ($buf->NextToken(","))
	{
	    $iLen = $tmp if $buf->GetInt($tmp);
	}
    }
    $errn = $rberr, goto error if !$buf->NextToken("){"); 

    my $XY = new loc();
    my $XYs = new loc();
    my $Null = new loc();
    my $BBox = new bbox();
    my $tmpBBox = new bbox();
    my $tmpObjID = $objid+1;    # space for two entries in @size
    $objid += 3*$iAnz+2;
    my (@Ptr, @ObjID, @myBBox, @rRatio, @iY, @fBBox);

    if (!$bFlag)
    # determine dimensions of chains
    {
	my ($i, $iBreite, $iHoehe, $v) = (0, 0, 0, 0);
	@rRatio = ();
	while (!$buf->NextToken("}"))
	{
	    $i++;
	    $XY->eq(0,0);
	    $tmpBBox->init(0,0);
	    push(@Ptr, $buf->GetPtr());
	    push(@ObjID, $objid);
	    @fBBox = ();
	    $errn = $synterr, goto error 
				if !&sliste($XY, $tmpBBox, $false, 0, \@fBBox, ";");
	    # save size of chain
	    push(@myBBox, $tmpBBox->new());
	    $iBreite = &max($iBreite, $tmpBBox->width());
	    $iHoehe += $tmpBBox->height();
	    $iHoehe += $rChainSep if $i>1;
	    my $iHMax = 0;
	    grep(($iHMax = &max($iHMax, $_->height())) && 0, @fBBox);
	    push(@iY, $iHMax);
	    push(@rRatio, $v = ($XY->{"y"}-$tmpBBox->{"yu"})/$tmpBBox->height());
	    # increase by text height if any
	    $iHoehe += $rTextSep +$iHMax/2 - $tmpBBox->height()*$v
				if $iHMax>0 && ($rTextSep+$iHMax/2>$tmpBBox->height()*$v);
	}
	$iBreite += $iLen;

	# given number of chains != actual number
	$errn = $incargerr, goto error if $i != $iAnz;

	$BBox->init(0,0);
	$BBox->MinMax($iBreite, $iHoehe);
	$BBox->OrigConPoint($iPos, $XY, $Null);
	# XY ist nun richtiger Startpunkt. Verschiebe BBox entsprechend
	$BBox->translate($XY);
	$BBox->translate($XYstart);
	$BBoxg->MinMax($BBox);
	$origin[$tmpObjID+1] = $BBox->{"xo"};
	$BBox->ToConPoint($bbox::SB_R, $XYweiter);      # y-value will be modified some
							# lines later

	# construct chains, dimensions are now known
	my $iH = $iHoehe;
	SW1: 
	{
	    $iPosInner = $bbox::SB_TL, last SW1 if $iPosInner == $bbox::SB_L;
	    $iPosInner = $bbox::SB_T, last SW1 if $iPosInner == $bbox::SB_C;
	    $iPosInner = $bbox::SB_TR, last SW1 if $iPosInner == $bbox::SB_R;
	}
	for ($i=0; $i<$iAnz; $i++)
	{
	    $buf->SetPtr(shift(@Ptr));
	    $objid = shift(@ObjID);
	    $BBox = shift(@myBBox);     
	    my $iYY = shift(@iY);
	    my $iDY = $rTextSep + $iYY/2;
	    my $rBoxHeight = $BBox->height();
	    my $XYref = new loc($XYstart);
	    $XYref->translate($XY);
	    SW:
	    {
		$XYref->translate(0,$iH), last SW if $iPosInner == $bbox::SB_TL;
		$XYref->translate(($iBreite-$iLen)/2,$iH) if $iPosInner == $bbox::SB_T;
		$XYref->translate($iBreite-$iLen,$iH) if $iPosInner == $bbox::SB_TR;
	    }
	    $BBox->OrigConPoint($iPosInner, $XYs, $Null);
	    $XYs->translate($XYref);
	    $BBox->init($XYs);
	    $origin[$tmpObjID+2+$i] = $XYs->new();
	    &sliste($XYs, $BBox, $false, $iDY, \@fBBox, ";");
	    $v = shift(@rRatio);
	    $BBox->{"yu"} += $rTextSep + $iYY/2 - $rBoxHeight*$v
			if $iYY>0 && ($rTextSep+$iYY > $rBoxHeight*$v);
	    $box[$tmpObjID+2+$i] = $BBox->new();
	    $origin[$tmpObjID+2+$i+$iAnz] = $XYs->new();
	    $iH -= $rChainSep + $BBox->height();
	    $iH -= $rTextSep + $iYY/2 - $rBoxHeight*$v
			if $iYY>0 && ($rTextSep+$iYY > $rBoxHeight*$v);
	}

	$XYweiter->{"y"} = ($origin[$tmpObjID+2+$iAnz]->{"y"}+
				$origin[$tmpObjID+2+2*$iAnz-1]->{"y"})/2;
	$origin[$tmpObjID] = $XYweiter->{"y"};          
	for ($i=0; $i<$iAnz; $i++)
	{
	    $origin[$tmpObjID+2+$i+2*$iAnz] = 
				$origin[$tmpObjID+2+$i+$iAnz]->{"y"}-$XYweiter->{"y"};
	}
	$buf->NextToken("}");
    }
    else
    # draw chains on known origins
    {
	print OUT $be->comment("joinh");
	my $iLineheight = $origin[$tmpObjID];
	my $XO = $origin[$tmpObjID+1];
	my $XYw = new loc();
	my ($iLen, $i) = (0, 0);
	while (!$buf->NextToken("}"))
	{
	    $i++;
	    $XYs = $origin[$tmpObjID+1+$i];
	    $XYw = $origin[$tmpObjID+1+$i+$iAnz];
	    $iLen = $origin[$tmpObjID+1+$i+2*$iAnz];
	    &sliste($XYs, $BBox, $true, 0, 0, ";");
	    $BBox = $box[$tmpObjID+1+$i];
	    print OUT $be->comment(sprintf "chain %d", $i);
	    print OUT $be->arrow($XYw->{"x"}, $XYw->{"y"},
			0, $XO-$XYw->{"x"}, 0, sprintf "joinh BOND %d", $i);
	    print OUT $be->arrow($XO, $XYw->{"y"}, $iLen>0 ? -90 : 90,
		abs($iLen), 0, sprintf "joinh BOND %d", $i);
	}
    }
    
&trace("joinh OK", $bFlag);
    $level--;
    return $true;

error:
    $level--;
    &error($errn, "joinh");
    return $false;
}


#////////////////////////////////////////////////////////
#//
#//  joinv(<n>, [<iPosInner>] [, [<iPos>] [, [<Len_Extend>]])
#//    {sliste;
#//     ...
#//    }
#//
sub joinv
{
    my ($XYstart, $XYweiter, $BBoxg, $bFlag) = @_;
    my $errn = 0;
    $level++;

&trace("joinv", $bFlag);
    # parse parameter list
    my ($iAnz, $iLen, $iPos, $iPosInner, $tmp);
    $iLen = $rArrowExtend;
    $iPosInner = $bbox::SB_T;   # default: top aligned
    $iPos = $bbox::SB_BL;

    $errn = $lberr, goto error if !$buf->NextToken("(");
    $errn = $interr, goto error if !$buf->GetInt($iAnz);
    $errn = $komma, goto error if !$buf->NextToken(",");
    $iPosInner = $tmp if $buf->GetPos($tmp);
    $errn = $badargerr, goto error if ($iPosInner != $bbox::SB_T &&
	$iPosInner != $bbox::SB_C && $iPosInner != $bbox::SB_B);
    if ($buf->NextToken(","))
    {
	$iPos = $tmp if $buf->GetPos($tmp);
	if ($buf->NextToken(","))
	{
	    $iLen = $tmp if $buf->GetInt($tmp);
	}
    }
    $errn = $rberr, goto error if !$buf->NextToken("){"); 

    my $XY = new loc();
    my $XYs = new loc();
    my $Null = new loc();
    my $BBox = new bbox();
    my $tmpBBox = new bbox();
    my $tmpObjID = $objid+1;    # space for two entries in @size
    $objid += 2*$iAnz+2;
    my (@Ptr, @ObjID, @myBBox);

    if (!$bFlag)
    # determine dimensions of chains
    {
	my ($i, $iBreite, $iHoehe) = (0, 0, 0);
	while (!$buf->NextToken("}"))
	{
	    $i++;
	    $XY->eq(0,0);
	    $tmpBBox->init(0,0);
	    push(@Ptr, $buf->GetPtr());
	    push(@ObjID, $objid);
	    $errn = $synterr, goto error 
				if !&sliste($XY, $tmpBBox, $false, -1, 0, ";");
	    # save size of chain
	    push(@myBBox, $tmpBBox->new());
	    $iHoehe = &max($iHoehe, $tmpBBox->height());
	    $iBreite += $tmpBBox->width();
	    $iBreite += $rChainSep if $i>1;
	}
	$iHoehe += $iLen;

	# given number of chains != actual number
	$errn = $incargerr, goto error if $i != $iAnz;

	$BBox->init(0,0);
	$BBox->MinMax($iBreite, $iHoehe);
	$BBox->OrigConPoint($iPos, $XY, $Null);
	# XY ist nun richtiger Startpunkt. Verschiebe BBox entsprechend
	$BBox->translate($XY);
	$BBox->translate($XYstart);
	$BBoxg->MinMax($BBox);

	$BBox->ToConPoint($bbox::SB_B, $XYweiter);      # x-value will be modified some
							# lines later
	$origin[$tmpObjID+1] = $XYweiter->new();
	# construct chains, dimensions are now known
	my $iB = 0;
	SW1: 
	{
	    $iPosInner = $bbox::SB_TL, last SW1 if $iPosInner == $bbox::SB_T;
	    $iPosInner = $bbox::SB_L, last SW1 if $iPosInner == $bbox::SB_C;
	    $iPosInner = $bbox::SB_BL, last SW1 if $iPosInner == $bbox::SB_B;
	}
	for ($i=0; $i<$iAnz; $i++)
	{
	    $buf->SetPtr(shift(@Ptr));
	    $objid = shift(@ObjID);
	    $BBox = shift(@myBBox);     
	    my $XYref = new loc($XYstart);
	    $XYref->translate($XY);
	    SW: 
	    {
		$XYref->translate($iB,$iHoehe), last SW if $iPosInner == $bbox::SB_TL;
		$XYref->translate($iB, ($iHoehe-$iLen)/2+$iLen) if $iPosInner == $bbox::SB_L;
		$XYref->translate($iB, $iLen) if $iPosInner == $bbox::SB_BL;
	    }
	    $BBox->OrigConPoint($iPosInner, $XYs, $Null);
	    $XYs->translate($XYref);
	    $BBox->init($XYs);
	    $origin[$tmpObjID+2+$i] = $XYs->new();
	    &sliste($XYs, $BBox, $false, -1, 0, ";");
	    $box[$tmpObjID+2+$i] = $BBox->new();
	    $origin[$tmpObjID+2+$i+$iAnz] = $XYs->new();
	    $iB += $rChainSep + $BBox->width();
	}

	$XYweiter->{"x"} = ($origin[$tmpObjID+2+$iAnz]->{"x"}+
					$origin[$tmpObjID+2+2*$iAnz-1]->{"x"})/2;
	$origin[$tmpObjID] = $XYweiter->{"x"};
	$buf->NextToken("}");
    }
    else
    # draw chains on known origins
    {
	print OUT $be->comment("joinv");
	my $iLinewidth = $origin[$tmpObjID];
	my $YU = $origin[$tmpObjID+1]->{"y"};
	my $XYw = new loc();
	my $i = 0;
	while (!$buf->NextToken("}"))
	{
	    $i++;
	    $XYs = $origin[$tmpObjID+1+$i];
	    $XYw = $origin[$tmpObjID+1+$i+$iAnz];
	    &sliste($XYs, $BBox, $true, -1, 0, ";");
	    $BBox = $box[$tmpObjID+1+$i];
	    my $y = $XYw->{"y"};
	    print OUT $be->comment(sprintf "chain %d", $i);
	    print OUT $be->arrow($XYw->{"x"}, $XYw->{"y"},
			-90, $XYw->{"y"}-$YU, 0, 
			sprintf "joinv BOND %d", $i);
	    print OUT $be->arrow($XYw->{"x"}, $YU, 
		$XYw->{"x"} > $iLinewidth ? 180 : 0,
		abs($XYw->{"x"} - $iLinewidth), 0, sprintf "joinv BOND %d", $i);
	}
    }
    
&trace("joinv OK", $bFlag);
    $level--;
    return $true;

error:
    $level--;
    &error($errn, "joinv");
    return $false;
}


#////////////////////////////////////////////////////////
#//
#//  multiline(<n> [, [<iInnerPos>] [, [<iPos>] [, [<iPosCont>]]]])
#//    {sliste;
#//     ...
#//    }
#//
sub multiline
{
    my ($XYstart, $XYweiter, $BBoxg, $bFlag, $context, $contextT) = @_;
    my $errn = 0;
    $level++;

&trace("multiline", $bFlag);
    # parse parameter list
    my $iAnz;
    my ($iPosInner, $iPos, $iPosCont) = ($bbox::SB_L, $bbox::SB_L, $bbox::SB_R);
    my $tmp;
    $errn = $lberr, goto error if !$buf->NextToken("(");
    $errn = $interr, goto error if !$buf->GetInt($iAnz);
    if ($buf->NextToken(","))
    {
	$iPosInner = $tmp if $buf->GetPos($tmp);
	$errn = $badargerr, goto error if ($iPosInner != $bbox::SB_L &&
		$iPosInner != $bbox::SB_C && $iPosInner != $bbox::SB_R);
	if ($buf->NextToken(","))
	{
	    $iPos = $tmp if $buf->GetPos($tmp);
	    if ($buf->NextToken(","))
	    {
		$iPosCont = $tmp if $buf->GetPos($tmp);
	    }
	}
    }
    $errn = $rberr, goto error if !$buf->NextToken("){"); 

    my $XY = new loc();
    my $XYref = new loc();
    my $Null = new loc();
    my $BBox = new bbox();
    my $tmpObjID = $objid+1;    # space for two entries in @size
    $objid += $iAnz;
    my (@iY, @myBBox, @fBBox, @rRatio, @Ptr, @ObjID);

    if (!$bFlag)
    # determine dimensions of lines
    {
	my ($i, $iBreite, $iHoehe, $v) = (0, 0, 0, 0);
	@rRatio = ();
	while (!$buf->NextToken("}"))
	{
	    $i++;
	    $XY->eq(0,0);
	    $BBox->init(0,0);
	    push(@Ptr, $buf->GetPtr());
	    push(@ObjID, $objid);
	    @fBBox = ();
	    # test formula without text if any -> pure height of formulas
	    $errn = $synterr, goto error 
				if !&sliste($XY, $BBox, $false, 0, \@fBBox, ";");
	    # save size of chain
	    push(@myBBox, $BBox->new());
	    $iBreite = &max($iBreite, $BBox->width());
	    $iHoehe += $BBox->height();
	    my $iHMax = 0;
	    grep(($iHMax = &max($iHMax, $_->height())) && 0, @fBBox);
	    push(@iY, $iHMax);
	    # increase by text height if any
	    push(@rRatio, $v = ($XY->{"y"}-$BBox->{"yu"})/$BBox->height());
	    $iHoehe += $rTextSep+$iHMax/2 - $BBox->height()*$v
			if $iHMax>0 && ( $rTextSep+$iHMax/2 > $BBox->height()*$v);
	    $iHoehe += $rMultilineSep if $i>1;
	}
	# given number of chains != actual number
	$errn = $incargerr, goto error if $i != $iAnz;

	$BBox->init(0,0);
	$BBox->MinMax($iBreite, $iHoehe);
	$BBox->OrigConPoint($iPos, $XY, $Null);
	# XY ist nun richtiger Startpunkt. Verschiebe BBox entsprechend
	$BBox->translate($XY);
	$BBox->translate($XYstart);
	$BBoxg->MinMax($BBox);
	$context->eq($BBox);
	$contextT->eq($BBox);

	$BBox->ToConPoint($iPosCont, $XYweiter);
	&space_($iPosCont, $XYweiter) if !$buf->NextToken("nospace");

	my $XYorig = new loc($BBox->{"xu"}, $BBox->{"yu"});
	# construct lines, dimensions are now known
	my $XYs = new loc();
	my $iH = $iHoehe;
	for ($i=0; $i<$iAnz; $i++)
	{
	    $buf->SetPtr(shift(@Ptr));
	    $objid = shift(@ObjID);
	    $BBox = shift(@myBBox);     
	    my $iYY = shift(@iY);     
	    my $iDY = $rTextSep + $iYY/2;     
	    my $rBoxHeight = $BBox->height();
	    $iH -= $rBoxHeight/2;
	    my $XYref = new loc($XYorig);
	    $XYref->translate(0,$iH) if $iPosInner == $bbox::SB_L;
	    $XYref->translate(($iBreite-$iLen)/2,$iH) if $iPosInner == $bbox::SB_C;
	    $XYref->translate($iBreite-$iLen,$iH) if $iPosInner == $bbox::SB_R;
	    $BBox->OrigConPoint($iPosInner, $XYs, $Null);
	    $XYs->translate($XYref);
	    $BBox->init($XYs);
	    $origin[$tmpObjID+$i] = $XYs->new();
	    &sliste($XYs, $BBox, $false, $iDY, \@fBBox, ";");
	    $v = shift(@rRatio);
	    $iH -= $rChainSep + $rBoxHeight/2;
	    $iH -= $rTextSep + $iYY/2 - $rBoxHeight*$v
			    if ($iYY>0 && $rTextSep+$iYY/2 > $rBoxHeight*$v);
	}
	$buf->NextToken("}");
    }
    else
    # setze im zweiten Lauf alles anhand der bekannten Ma"se zusammen
    {
	print OUT $be->comment("multiline");
	my $i = 0;
	while (!$buf->NextToken("}"))
	{
	    $i++;
	    $be->comment(sprintf("chain %d", $i));
	    $XYs = $origin[$tmpObjID+$i-1];     ## "-1" added 1999-05-07 IK
	    &sliste($XYs, $BBox, $true, 0, 0, ";");
	}
	$buf->NextToken("nospace");
    }

&trace("multiline OK", $bFlag);
    $level--;
    return $true;

error:
    $level--;
    &error($errn, "multiline");
    return $false;
}


#////////////////////////////////////////////////////////
#//
#//  bracket() | bracket([]) | bracket([) | bracket(])
#//
sub bracket
{
    my ($BBox, $bFlag) = @_; 
    my $errn;
    $level++;

    my ($bLeft, $bRight) = ($true, $true);
    $errn = $lberr, goto error if !$buf->NextToken("(");
    if ($buf->NextToken("[]"))
    { $bLeft = $bRight = $true; }
    elsif ($buf->NextToken("["))
    { $bLeft = $true;  $bRight = $false; }
    elsif ($buf->NextToken("]"))
    { $bLeft = $false;  $bRight = $true; }
    $errn = $rberr, goto error if !$buf->NextToken(")");

    $objid++;
    if (!$bFlag)
    {
	$origin[$objid] = $BBox->new();
    }
    else
    {
	$BBox = $origin[$objid];
	if ($bLeft)
	{
	    print OUT $be->line($BBox->{"xu"}-$fboxsep, $BBox->{"yu"}-$fboxsep, 
						0, 6+$fboxsep);
	    print OUT $be->line($BBox->{"xu"}-$fboxsep, $BBox->{"yu"}-$fboxsep, 
						90 ,$BBox->height()+2*$fboxsep);
	    print OUT $be->line($BBox->{"xu"}-$fboxsep, $BBox->{"yo"}+$fboxsep,
						0, 6+$fboxsep);
	}
	if ($bRight)
	{
	    print OUT $be->line($BBox->{"xo"}+$fboxsep, $BBox->{"yu"}-$fboxsep,
						180, 6+$fboxsep);
	    print OUT $be->line($BBox->{"xo"}+$fboxsep, $BBox->{"yu"}-$fboxsep,
						90 ,$BBox->height()+2*$fboxsep);
	    print OUT $be->line($BBox->{"xo"}+$fboxsep, $BBox->{"yo"}+$fboxsep,
						180, 6+$fboxsep);
	}
    }

    return $true;

error:
    $level--;
    &error($errn, "bracket");
    return $false;
}


#////////////////////////////////////////////////////////
#//
#//  fbox
#//
sub fbox
{
    my ($BBox, $bFlag) = @_; 
    $level++;

    $objid++;
    if (!$bFlag)
    {
	$origin[$objid] = $BBox->new();
    }
    else
    {
	$BBox = $origin[$objid];
	print OUT $be->line($BBox->{"xu"}-$fboxsep, $BBox->{"yu"}-$fboxsep, 
					0, $BBox->width()+2*$fboxsep);
	print OUT $be->line($BBox->{"xu"}-$fboxsep, $BBox->{"yu"}-$fboxsep, 
					90 ,$BBox->height()+2*$fboxsep);
	print OUT $be->line($BBox->{"xo"}+$fboxsep, $BBox->{"yu"}-$fboxsep, 
					90 ,$BBox->height()+2*$fboxsep);
	print OUT $be->line($BBox->{"xu"}-$fboxsep, $BBox->{"yo"}+$fboxsep, 
					0, $BBox->width()+2*$fboxsep);
    }

    return $true;
}


#////////////////////////////////////////////////////////
#//
#//  setcontext(#<Nr>, <pos>)
#//  savecontext(#<Nr>)
#//
sub setcontext
{
    my ($XYstart, $XYweiter, $BBoxg, $bFlag) = @_;
    my $errn;
    $level++;

    my $i;
    my $iPos;
    $errn = $lberr, goto error if !$buf->NextToken("(#");
    $errn = $interr, goto error if !$buf->GetInt($i);
    $errn = $komma, goto error if !$buf->NextToken(",");
    $errn = $poserr, goto error if !$buf->GetPos($iPos);
    $errn = $rberr, goto error if !$buf->NextToken(")");

    $errn = $nexerr, goto error if !defined($contextlist[$i]);
    if ($iPos==$bbox::SB_B || $iPos==$bbox::SB_BL || $iPos==$bbox::SB_BR)
    {
	$contextTlist[$i]->ToConPoint($iPos, $XYweiter);
    }
    else
    {
	$contextlist[$i]->ToConPoint($iPos, $XYweiter);
    }
    &space_($iPos, $XYweiter) if !$buf->NextToken("nospace");
    return $true;

error:
    $level--;
    &error($errn, "setcontext");
    return $false;
}

sub savecontext
{
    my ($context, $contextT) = @_;
    my $errn;
    $level++;

    my $i;
    $errn = $lberr, goto error if !$buf->NextToken("(#");
    $errn = $interr, goto error if !$buf->GetInt($i);
    $errn = $rberr, goto error if !$buf->NextToken(")");

    $contextlist[$i] = $context->new();
    $contextTlist[$i] = $contextT->new();
    return $true;

error:
    $level--;
    &error($errn, "savecontext");
    return $false;
}


#////////////////////////////////////////////////////////
#//
#//  save(#<n>)/restore(#<n>)
#//  set(<cPar>, <iVal>)
#//
sub save
{
    my $errn;
    $level++;
    my $i;
    $errn = $lberr, goto error if !$buf->NextToken("(#");
    $errn = $interr, goto error if !$buf->GetInt($i);
    $errn = $rberr, goto error if !$buf->NextToken(")");

    my $r_par = [$rLenS, $rLenN, $rLenL, $rLW, $rBW, $rBD, $rAW, $rXS, $rYS,
		 $rArrowSkip, $rArrowExtend, $rChainSep, $rMultilineSep,
		 $fboxsep];
    $par_stack[$i] = $r_par;
    return $true;

error:
    $level--;
    &error($errn, "save");
    return $false;
}

sub restore
{
    my ($bFlag) = @_;
    my $errn;
    $level++;
    my $i;
    $errn = $lberr, goto error if !$buf->NextToken("(#");
    $errn = $interr, goto error if !$buf->GetInt($i);
    $errn = $rberr, goto error if !$buf->NextToken(")");

    $errn = $nexerr, goto error if !defined($par_stack[$i]);
    my $r_par = $par_stack[$i];
    ($rLenS, $rLenN, $rLenL, $rLW, $rBW, $rBD, $rAW, $rXS, $rYS,
     $rArrowSkip, $rArrowExtend, $rChainSep, $rMultilineSep,
     $fboxsep) = @$r_par;
    
    if ($bFlag)
    {
	print OUT $be->parameter("lw", $rLW);
	print OUT $be->parameter("bw", $rBW);
	print OUT $be->parameter("aw", $rAW);
	print OUT $be->parameter("bd", $rBD);
    }
    return $true;

error:
    $level--;
    &error($errn, "restore");
    return $false;
}

sub set
{
    my ($bFlag) = @_;
    my ($cPar, $rVal);
    my $errn;
    $level++;

    $errn = $lberr, goto error if !$buf->NextToken("(");
    $errn = $texterr, goto error if !$buf->GetText($cPar);
    $errn = $komma, goto error if !$buf->NextToken(",");
    $errn = $realerr, goto error if !$buf->GetReal($rVal);
    $errn = $rberr, goto error if !$buf->NextToken(")");

    eval('$'."$cPar = $rVal;");

    if ($bFlag)
    {
	SW: 
	{
	    (print OUT $be->parameter("lw", $rVal)), last SW if $cPar eq 'rLW';
	    (print OUT $be->parameter("bw", $rVal)), last SW if $cPar eq 'rBW';
	    (print OUT $be->parameter("bd", $rVal)), last SW if $cPar eq 'rBD';
	    (print OUT $be->parameter("aw", $rVal)), last SW if $cPar eq 'rAW';
	}
    }

    return $true;

error:
    $level--;
    &error($errn, "set");
    return $false;
}

sub scale
{
    my ($bFlag) = @_;
    my $errn;
    $level++;
    my $r;
    $errn = $lberr, goto error if !$buf->NextToken("(");
    $errn = $realerr, goto error if !$buf->GetReal($r);
    $errn = $rberr, goto error if !$buf->NextToken(")");

    foreach $par ($rLenS, $rLenN, $rLenL, $rLW, $rBW, $rBD, $rAW, $rXS, $rYS,
	$rArrowSkip, $rArrowExtend, $rChainSep, $rMultilineSep,
	$fboxsep)
    {
	$par *= $r;
    }
    
    if ($bFlag)
    {
	print OUT $be->parameter("lw", $rLW);
	print OUT $be->parameter("bw", $rBW);
	print OUT $be->parameter("aw", $rAW);
	print OUT $be->parameter("bd", $rBD);
    }
    return $true;

error:
    $level--;
    &error($errn, "scale");
    return $false;
}


#////////////////////////////////////////////////////////
#//
#// emove(#<n1>, <iAngle1>, <ctrl1>, #<n2>, <iAngle2>, <ctrl2>)
#//
sub emove
{
    my ($bFlag) = @_;
    my $errn;
    $level++;
    my ($i, $iAngle, $iCtrl, $j, $jAngle, $jCtrl);
    $errn = $lberr, goto error if !$buf->NextToken("(#");
    $errn = $interr, goto error if !$buf->GetInt($i);
    $errn = $komma, goto error if !$buf->NextToken(",");
    $errn = $interr, goto error if !$buf->GetInt($iAngle);
    $errn = $komma, goto error if !$buf->NextToken(",");
    $errn = $realerr, goto error if !$buf->GetReal($iCtrl);
    $errn = $komma, goto error if !$buf->NextToken(",#");
    $errn = $interr, goto error if !$buf->GetInt($j);
    $errn = $komma, goto error if !$buf->NextToken(",");
    $errn = $interr, goto error if !$buf->GetInt($jAngle);
    $errn = $komma, goto error if !$buf->NextToken(",");
    $errn = $realerr, goto error if !$buf->GetReal($jCtrl);
    $errn = $rberr, goto error if !$buf->NextToken(")");

    if ($bFlag)
    {
	my ($p1, $p2, $pa, $pe);
	$pa = new loc($posXY[$i]);
	$pa->translate(cos($iAngle*$pi/180)*$rEmove, sin($iAngle*$pi/180)*$rEmove);
	$p1 = new loc($posXY[$i]);
	$p1->translate(cos($iAngle*$pi/180)*$iCtrl, sin($iAngle*$pi/180)*$iCtrl);
	$pe = new loc($posXY[$j]);
	$pe->translate(cos($jAngle*$pi/180)*$rEmove, sin($jAngle*$pi/180)*$rEmove);
	$p2 = new loc($posXY[$j]);
	$p2->translate(cos($jAngle*$pi/180)*$jCtrl, sin($jAngle*$pi/180)*$jCtrl);
	print OUT $be->spline($pa->{"x"}, $pa->{"y"},
			      $p1->{"x"}, $p1->{"y"}, $p2->{"x"}, $p2->{"y"},
			      $pe->{"x"}, $pe->{"y"}, $jAngle+180);
    }
    return $true;

error:
    $level--;
    &error($errn, "emove");
    return $false;
}

#////////////////////////////////////////////////////////
#//
#//  sliste :== formula | arrow | setcontext | savecontext |
#//     showcontext | space | multiline | <endtoken>
#//
sub sliste
{
    my ($XYg, $BBoxg, $bFlag, $rTextSkip, $fbox, $EndToken) = @_;
    my $XYStart = new loc($XYg);
    my $XYweiter = new loc();
    my $LastContext = new bbox();
    my $LastContextT = new bbox();
sliste:
    if ($buf->NextToken($EndToken))
    {
	$XYg->eq($XYweiter);
	return $true;
    }
    elsif ($buf->NextToken("formula"))
    {
	$XYStart->eq($XYweiter), goto sliste
				if &formula($XYStart, $XYweiter, $BBoxg, $bFlag,
						$rTextSkip, $fbox,
						$LastContext, $LastContextT);
    }
    elsif ($buf->NextToken("arrow"))
    {
	$XYStart->eq($XYweiter), goto sliste
				if &arrow($XYStart, $XYweiter, $BBoxg, $bFlag);
    }
    elsif ($buf->NextToken("joinh"))
    {
	$XYStart->eq($XYweiter), goto sliste
				if &joinh($XYStart, $XYweiter, $BBoxg, $bFlag);
    }
    elsif ($buf->NextToken("joinv"))
    {
	$XYStart->eq($XYweiter), goto sliste
				if &joinv($XYStart, $XYweiter, $BBoxg, $bFlag);
    }
    elsif ($buf->NextToken("multiline"))
    {
	$XYStart->eq($XYweiter), goto sliste
				if &multiline($XYStart, $XYweiter, $BBoxg, $bFlag,
						$LastContext, $LastContextT);
    }
    elsif ($buf->NextToken("space"))
    {
	$XYStart->eq($XYweiter), goto sliste
				if &space($XYStart, $XYweiter, $BBoxg, $bFlag);
    }
    elsif ($buf->NextToken("gotoXY"))
    {
	$XYStart->eq($XYweiter), goto sliste
				if &gotoXY($XYStart, $XYweiter, $BBoxg, $bFlag);
    }
    elsif ($buf->NextToken("shiftXY"))
    {
	$XYStart->eq($XYweiter), goto sliste
				if &shiftXY($XYStart, $XYweiter, $BBoxg, $bFlag);
    }
    elsif ($buf->NextToken("bracket"))
    {
	goto sliste if &bracket($LastContext, $bFlag);
    }
    elsif ($buf->NextToken("fbox"))
    {
	goto sliste if &fbox($LastContextT, $bFlag);
    }
    elsif ($buf->NextToken("setcontext"))
    {
	$XYStart->eq($XYweiter), goto sliste if &setcontext($XYStart, $XYweiter, $BBoxg, $bFlag);
    }
    elsif ($buf->NextToken("savecontext"))
    {
	goto sliste if &savecontext($LastContext, $LastContextT);
    }
    elsif ($buf->NextToken("save"))
    {
	goto sliste if &save();
    }
    elsif ($buf->NextToken("restore"))
    {
	goto sliste if &restore($bFlag);
    }
    elsif ($buf->NextToken("set"))
    {
	goto sliste if &set($bFlag);
    }
    elsif ($buf->NextToken("scale"))
    {
	goto sliste if &scale($bFlag);
    }
    elsif ($buf->NextToken("emove"))
    {
	goto sliste if &emove($bFlag);
    }

    &error($synterr, "sliste");
    return $false;
}


#////////////////////////////////////////////////////////
#//
#//  schema :== schema(id)
#//     { sliste ...}
#//
sub schema
{
    my ($BBox, $rW, $rH) = @_;
    my $errn = 0;
    my $XY = new loc();
    my $Null = new loc();
    my $lBuf = $buf->GetPtr();
    $level = 0;
    $objid = 0;

    &init_param;
    $errn = $synterr, goto error if !&sliste($XY, $BBox, $false, -1, 0, "endschema");

    # save dimensions for use in picture environment size
    $$rW = $BBox->width();
    $$rH = $BBox->height();

    # lies nun alles nochmal, wobei der Startpunkt 
    # mit der gewuenschten Positionierung angepasst ist

    &init_param;
    # write parameter initialization
    print OUT $be->comment("initialization section");
    print OUT $be->parameter("lw", $rLW);
    print OUT $be->parameter("bw", $rBW);
    print OUT $be->parameter("bd", $rBD);
    print OUT $be->parameter("aw", $rAW);


    $shift = new loc(-$BBox->{"xu"}, -$BBox->{"yu"});
    $shift->dump("shift") if $trace;
    grep((ref($_) && $_->translate($shift) && 0), @origin);
    $BBox->init(0,0);
    $XY->eq(0,0);
    $buf->SetPtr($lBuf);
    $objid = 0;
    &sliste($XY, $BBox, $true, -1, 0, "endschema");

    return $true;

error:
    $level--;
    &error($errn, "schema");
    return $false;
}


#////////////////////////////////////////////////////////
#//
#//  main routine
#//

$version = "1.0b 2001-04-10";

print "This is OCHEM chemistry compiler version $version\n";
print "requires OCHEM.STY 3.0e\n";

# ##### parse command line #########
my ($help, $be_type, $preproc, $infile);
GetOptions("h", \$help, "trace=i", \$trace, "type=s", \$be_type,
     "pp", \$preproc);
#$be_type = "PS";
#$preproc = 1;

if (defined $help)
{
    print "usage: chemie.pl [opt...] <chm-file>\n";
    print "                 -type <n>  output format, PS, PSLATEX, LATEX\n";
    print "                            default is 2\n";
    print "                 -trace <level> trace level\n";
    print "                 -pp        use praeprocessor\n";
    print "\n\n";
    exit(0);
}

$infile = shift;


# ##### output device, default is postscript drawing and LaTeX picture text #####
$be_type = "PSLATEX" unless defined $be_type;
$cCmd = '$be_type = $be::BE_'.$be_type;
eval($cCmd);
$be = new be($be_type);

# other initialization, tmp file names
my ($tmptex, $tmpfile) = ("tmp.tex", "tmp.dat");
$errn = 0;
$level = 0;

# ##### replace with call to your LaTeX ######
# e.g. "tex386 -format=glatex"
$latexcmd = "latex";



# ##### start parsing source code #########
# fill buffer with compressed text and get dimensions of all text fragments
# enclosed in btex...etex
%texthash = ();
$buf = new streambuf();

# ##### preprocess input file ? ######
if (defined $preproc)
{
    ##### replace with call to your preprocessor ######
    `m4 $infile >$tmpfile`;
    $buf->LoadBuffer($tmpfile, \%texthash);
}
else
{
    $buf->LoadBuffer($infile, \%texthash);
}

# check if a special font for text is required
if ($buf->NextToken("font("))
{
    $errn = $texterr, goto error if !$buf->GetText($cFont);
    $errn = $rberr, goto error if !$buf->NextToken(")");
}

# 
# fill in list of desired preloaded LaTeX packages, if required
#
@packages = ();
while ($buf->NextToken("package("))
{
    $errn = $texterr, goto error if !$buf->GetText($cPackage);
    unshift (@packages, $cPackage);
    $errn = $rberr, goto error if !$buf->NextToken(")");
}
$buf->GetTextSize($tmptex, \%texthash, $be_type, $latexcmd, $cFont, \@packages);

# check if perl modules are to load
while ($buf->NextToken("require"))
{
    my ($cFile, $cCmd);
    $errn = $lberr, goto error if !$buf->NextToken("(");
    $errn = $texterr, goto error if !$buf->GetText($cFile);
    $errn = $rberr, goto error if !$buf->NextToken(")");

    require "$cFile.pm";
}

# parse each "schema" unit
while ($buf->NextToken("schema"))
{
    # parse parameter list
    $errn = $lberr, goto error if !$buf->NextToken("(");
    $errn = $texterr, goto error if !$buf->GetText($outfile);
    $errn = $rberr, goto error if !$buf->NextToken(")");

    # open aux files
    open(OUT, ">".$outfile);
    open(TMP, ">".$tmpfile);
    print "[$outfile] ";
    $lBackPatch = tell(OUT);
    # assume (0,0) for unknown box dimension
    print OUT $be->open('chemfont', 0, 0);

    # parse schema
    my $BBox = new bbox();
    my ($rW, $rH);
    goto error if !&schema($BBox, \$rW, \$rH);
    print OUT $be->inter();
    print OUT $be->erase(-1, -1, 0.01, 0.01);
    print OUT $be->erase($rW+1, $rH+1, 0.01, 0.01);
    close(TMP);

    # load aux file with LaTeX text for output in picture environment
    open(TMP, $tmpfile);
    print OUT <TMP>;
    close(TMP);

    print OUT $be->close();
    seek(OUT, $lBackPatch, 0);
    printf OUT $be->open('chemfont', $rW, $rH);
    close(OUT);
}

print "\n";
exit(0);

# error
error:
&error($errn, "main");
print OUT $be->inter();
print OUT $be->close();
die "error aborted run ...\n";