<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/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&lt;$trace)
    {
	printf "%02d%s%s: Flag ist %d   %s...\n", 
		$level, " "x(2*$level), $proc, $flag,
		substr($buf-&gt;{"Buffer"}, $buf-&gt;{"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-&gt;{"Buffer"}, $buf-&gt;{"Ptr"}, 40);
}


#////////////////////////////////////////////////////////
#
# utility functions
#
sub max
{
    my $m = $_[0];
    foreach $elem (@_)
    {
	$m = $elem if $elem&gt;$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-&gt;NextToken("{");
    # scanne ausgehende Strukturen
    while (!$buf-&gt;NextToken("}"))
    {
	$XY-&gt;eq($XYg);          
	$BBox-&gt;init($XY);
	$errn = $synterr, goto error if !&amp;fliste($XY, $BBox, $bFlag, ";");
	$BBoxg-&gt;MinMax($BBox);
    }
    $XYweiter-&gt;eq($XYg);
    $level--;
    return $true;

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


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

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

sub getpos
{
    my ($p1, $iAngle, $rLen) = @_;
    my $p2 = new loc();
    $p2-&gt;eq($p1-&gt;{"x"} + cos($iAngle*$pi/180)*$rLen, $p1-&gt;{"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&lt;0)
    {
	$rLen = abs($$rRadius);
	$$rRadius = $rLen/(2*sin($pi/$n));
    }
    else
    {
	$rLen = 2 * $$rRadius * sin($pi/$n);
    }
    $M-&gt;eq(- sin($rAngle)*$$rRadius, cos($rAngle)*$$rRadius);
    $M-&gt;translate($XYstart);
    my $i;
    my $rTheta = (-90-180/$n) + $iAngle;
    my $XY = new loc();
    for ($i=0; $i&lt;$n; $i++)
    {
	$rLena-&gt;[$i] = $rLen;
	$rThetaa-&gt;[$i] = $rTheta;
	$t-&gt;[$i] = $rTheta+180;
	$b-&gt;[$i] = $rTheta + 360/$n;
	$r-&gt;[$i] = $iAngle - $i*360/$n;
	$rTheta -= 360/$n;
	$XY-&gt;eq($M);
	$rAngle = (90-360/$n*$i + $iAngle)*$pi/180;
	$XY-&gt;translate(sin($rAngle)*$$rRadius, -cos($rAngle)*$$rRadius);
	$XYa-&gt;[$i] = $XY-&gt;new();
	$BLa-&gt;[$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(($_-&gt;rotate($iAngle) &amp;&amp; 0), @$XYa);
    my $XYshift = new loc($$XYa[$iStart]);
    grep(($_-&gt;translate(- $XYshift-&gt;{"x"},
			- $XYshift-&gt;{"y"}) &amp;&amp; 0), @$XYa);
    grep(($_-&gt;translate($XYstart) &amp;&amp; 0), @$XYa);
    $M-&gt;eq(0,0);
    $M-&gt;translate($XYstart);
    @$BLa = (0, 1, 2, 3, 4, 5);   # start atom
    grep((($_ += $iAngle) &amp;&amp; 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&lt;=2)
    {
	$rAngle = (90-120*$iStart+90)*$pi/180;
    }
    else
    {
	$rAngle = (90-120*($iStart-3)+$iAngle+90)*$pi/180;
    }
    $M-&gt;eq(- sin($rAngle)*$$rRadius, cos($rAngle)*$$rRadius);
    $M-&gt;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&lt;=2; $i++)
    {
	$rLena-&gt;[$i] = $$rRadius;
	$rThetaa-&gt;[$i] = 90-120*$i+180;
	$rAngle = (90-120*$i+90)*$pi/180;
	$XY-&gt;eq($M);
	$XY-&gt;translate(sin($rAngle)*$$rRadius, -cos($rAngle)*$$rRadius);
	$XYa-&gt;[$i] = $XY-&gt;new();
	$BLa-&gt;[$i] = $i;
	$rLena-&gt;[$i+3] = 0.5*$$rRadius;
	$rThetaa-&gt;[$i+3] = 90-120*$i+180+$iAngle;
	$rAngle = (90-120*$i+$iAngle+90)*$pi/180;
	$XY-&gt;eq($M);
	$XY-&gt;translate(sin($rAngle)*$$rRadius, -cos($rAngle)*$$rRadius);
	$XYa-&gt;[$i+3] = $XY-&gt;new();
	$BLa-&gt;[$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&gt;2;
    my $rAngle = (90-360/6*$iStart + $iAngle)*$pi/180;
    $M-&gt;eq(- sin($rAngle)*$$rRadius, cos($rAngle)*$$rRadius);
    $M-&gt;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&lt;6; $i++)
    {
	if ($i==3)
	{
	    $rTheta -= 360/6;
	    next;
	}
	$rLena-&gt;[$j] = ($i==2 ? 2*cos(30*$pi/180): 1) * $rLen;
	$rTheta = $iAngle+90 if $i==2;
	$rThetaa-&gt;[$j] = $rTheta;
	$rTheta += 30 if ($i==2);
	$rTheta -= 360/6;
	$XY-&gt;eq($M);
	$rAngle = (90-360/6*$i + $iAngle)*$pi/180;
	$XY-&gt;translate(sin($rAngle)*$$rRadius, -cos($rAngle)*$$rRadius);
	$XYa-&gt;[$j] = $XY-&gt;new();
	$j++;
    }
    $M-&gt;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) &amp;&amp; 0), @$b, @$r, @$t);
}


#////////////////////////////////////////////////////////
#//
#//  ring([&lt;cType&gt;] [, [&lt;startpos&gt;] [, [&lt;bliste&gt;] [, [&lt;radius&gt;] 
#//       [, [&lt;p1&gt;] [, [&lt;p2&gt;] ]]]]])
#//    {&lt;pos&gt;: fliste;      
#//     vertex()...
#//     ...
#//    }
#//  vertex([&lt;cType&gt;] [, [&lt;vertex1&gt;] [, [&lt;vertex2&gt;] [, [&lt;bliste&gt;] 
#//       [, [&lt;p1&gt;] ]]]])
#//    {&lt;pos&gt;: fliste;      
#//     vertex()...
#//     ...
#//    }
#//
#//  bliste := H | O | &lt;n&gt;&lt;bTyp&gt; bliste
#//  &lt;pos&gt; := 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++;

&amp;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-&gt;NextToken("(");

    # vertex? then some ring parameters can be calculated
    if ($vertex)
    {
	$cType = $tmp if $buf-&gt;GetText($tmp);
	$errn = $komma, goto error if !$buf-&gt;NextToken(",");
	my $cCmd = "$cType".
	    '_default_(\$iAnz, \$p1, \$p2, \$iStart, \@iBType, '. 
	    '\$bAromat, \$rRadius);';
	eval($cCmd);
	my ($iVertex1, $iVertex2) = (0,0);
	$iVertex1 = $tmp if $buf-&gt;GetInt($tmp);
	if ($buf-&gt;NextToken(","))
	{
	    $iVertex2 = $tmp if $buf-&gt;GetInt($tmp);
	    if ($buf-&gt;NextToken(","))
	    {
		if ($buf-&gt;NextToken("H"))
		{   
		    $bAromat = $false;
		}
		elsif ($buf-&gt;NextToken("O"))
		{
		    $bAromat = $true;
		}
		my ($iN, $iTypeN);
		while ($buf-&gt;GetInt($iN))
		{
		    $errn = $bonderr, goto error 
				if !$buf-&gt;GetBondType($iTypeN);
		    $iBType[$iN] = $iTypeN;
		}
		if ($buf-&gt;NextToken(","))
		{
		    $p1 = $tmp if $buf-&gt;GetInt($tmp);
		}
	    }
	}
	# calculate parameters, use some information from base ring system
	$rRadius = $radius_ring1;
	$XYg-&gt;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-&gt;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-&gt;NextToken(","))
	{
	    $iStart = $tmp if $buf-&gt;GetInt($tmp);
	    if ($buf-&gt;NextToken(","))
	    {
		if ($buf-&gt;NextToken("H"))
		{   
		    $bAromat = $false;
		}
		elsif ($buf-&gt;NextToken("O"))
		{
		    $bAromat = $true;
		}
		my ($iN, $iTypeN);
		while ($buf-&gt;GetInt($iN))
		{
		    $errn = $bonderr, goto error 
				if !$buf-&gt;GetBondType($iTypeN);
		    $iBType[$iN] = $iTypeN;
		}
		if ($buf-&gt;NextToken(","))
		{
		    my $rAbs = 1;
		    $rAbs = -1 if $buf-&gt;NextToken("#");
		    $rRadius = $tmp if $buf-&gt;GetBondLen($tmp);
		    $rRadius *= $rAbs;
		    if ($buf-&gt;NextToken(","))
		    {
			$p1 = $tmp if $buf-&gt;GetInt($tmp);
			if ($buf-&gt;NextToken(","))
			{
			    # check for some special symbolic angles
			    if ($cType eq "ring" || $cType eq "cpentane")
			    {
				if ($buf-&gt;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-&gt;NextToken("r"))
				    {   $p2 = $iAngleBond + 180 - $ra[$iStart]; }
				    elsif ($buf-&gt;NextToken("t"))
				    {   $p2 = $iAngleBond + 180 - $ta[$iStart]; }
				    elsif ($buf-&gt;NextToken("b"))
				    {   $p2 = $iAngleBond + 180 - $ba[$iStart]; }
				    else
				    {
					$errn = $badargerr, goto error;
				    }
				}               
			    }
			    else        # otherwise, param must be integer
			    {
				$p2 = $tmp if $buf-&gt;GetInt($tmp);
			    }
			}
		    }
		}
	    }
	}
    }       
    $errn = $rberr, goto error if !$buf-&gt;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 &gt; iAnz (type "ring")
    # and determine compound bounding box
    my $i;
    my $BBox = new bbox();
    for ($i=0; $i&lt;$iAnz; $i++)
    {
	$iBType[$i] = 0 if not defined $iBType[$i];
	$BBox-&gt;MinMax($XYa[$i]);
    }
    $BBoxg-&gt;MinMax($BBox);

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

    # scan structures at ring atoms
    my $XY = new loc();
    while (!$buf-&gt;NextToken("}"))
    {
	if ($buf-&gt;NextToken("vertex"))
	{
	    $XY-&gt;eq($XYg);
	    ring($true, $rRadius_bak, \@rTheta, \@XYa, \@BLa, \@rLen, 
						$XY, $XYweiter, $BBoxg, $bFlag);
	    $errn = $synterr, goto error if !$buf-&gt;NextToken(";");
	}
	else
	{
	    if ($buf-&gt;NextToken("C"))
	    {
		$XY-&gt;eq($M);
	    }
	    else
	    {
		$errn = $interr, goto error if !$buf-&gt;GetInt($iN);
		$errn = $badargerr, goto error if $iN&gt;=$iAnz;
		$XY-&gt;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-&gt;NextToken(":");
		
	    $BBox-&gt;init($XY);
	    $errn = $synterr, goto error if !&amp;fliste($XY, $BBox, $bFlag, ";");
	    $BBoxg-&gt;MinMax($BBox);
	}
    }
	
    $XYweiter-&gt;eq($XYg);
&amp;trace("ring OK", $bFlag);
    $level--;
    return $true;

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


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

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

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

error:
    $level--;
    &amp;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-&gt;OrigConPoint($iPos, $XY, $Null);
    # XY is no correct starting point, shift BBox
    $XY-&gt;translate($XYg);
    $TextBBox-&gt;translate($XY);
    $TextBBox-&gt;ToConPoint($iPosCont, $XYweiter);
    $XYg-&gt;eq($XY);
    $TextBBox-&gt;{"yu"} -= $dp;
    $BBoxg-&gt;MinMax($TextBBox);

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


#////////////////////////////////////////////////////////
#//
#//  atom(&lt;Text&gt; [, [&lt;pos&gt;][, [&lt;contpos&gt;] [, &lt;erase&gt;[]]]])
#//
sub atom
{
    my $errn = 0;
    $level++;
&amp;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-&gt;NextToken("(");
    $errn = $texerr, goto error if !$buf-&gt;GetText($cText);
    if ($buf-&gt;NextToken(","))
    {
	$iPos = $tmp if $buf-&gt;GetPos($tmp);
	if ($buf-&gt;NextToken(","))
	{
	    $iPosCont = $tmp if $buf-&gt;GetPos($tmp);
	    if ($buf-&gt;NextToken(","))
	    {
		$bErase = $tmp if $buf-&gt;GetInt($tmp);
	    }
	}
    }
    $errn = $rberr, goto error if !$buf-&gt;NextToken(")");
    &amp;atom_($cText, $iPos, $iPosCont, $bErase, @_);

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

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


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

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

    $level--;
    return $true;

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

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

    $XYweiter-&gt;eq($posXY[$n]);

    $level--;
    return $true;

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


#////////////////////////////////////////////////////////
#//
#//  orbital([&lt;iAngle&gt;] [, [&lt;rWeight&gt;]])
#//
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-&gt;NextToken("(");
    $iAngle = $tmp if $buf-&gt;GetInt($tmp);
    if ($buf-&gt;NextToken(","))
    {
	$rWeight = $tmp if $buf-&gt;GetReal($tmp);
    }
    $errn = $rberr, goto error if !$buf-&gt;NextToken(")");
    $rWeight *= 0.9*$rLenN;

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

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

    $level--;
    return $true;

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


#////////////////////////////////////////////////////////
#//
#//  fliste :== element fliste | &lt;endtoken&gt;
#//  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-&gt;NextToken($EndToken))
    {
	return $true;
    }
    elsif ($buf-&gt;NextToken("bond"))
    {
	$XYStart-&gt;eq($XYweiter), goto fliste 
		if &amp;bond($XYStart, $XYweiter, $BBoxg, $bFlag);
    }
    elsif ($buf-&gt;NextToken("atom"))
    {
	$XYStart-&gt;eq($XYweiter), goto fliste 
		if &amp;atom($XYStart, $XYweiter, $BBoxg, $bFlag);
    }
    elsif ($buf-&gt;NextToken("ring"))
    {
	$XYStart-&gt;eq($XYweiter), goto fliste 
		if &amp;ring($false, $XYStart, $XYweiter, $BBoxg, $bFlag);
    }
    elsif ($buf-&gt;NextToken("branch"))
    {
	$XYStart-&gt;eq($XYweiter), goto fliste 
		if &amp;branch($XYStart, $XYweiter, $BBoxg, $bFlag);
    }
    elsif ($buf-&gt;NextToken("saveXY"))
    {
	goto fliste if &amp;saveXY($XYStart);
    }
    elsif ($buf-&gt;NextToken("restoreXY"))
    {
	goto fliste if &amp;restoreXY($XYStart);
    }
    elsif ($buf-&gt;NextToken("orbital"))
    {
	goto fliste if &amp;orbital($XYStart, $BBoxg, $bFlag);
    }
    elsif ($buf-&gt;NextToken("save"))
    {
	goto fliste if &amp;save();
    }
    elsif ($buf-&gt;NextToken("restore"))
    {
	goto fliste if &amp;restore($bFlag);
    }
    elsif ($buf-&gt;NextToken("set"))
    {
	goto fliste if &amp;set($bFlag);
    }

    return $false;
}


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

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


#////////////////////////////////////////////////////////
#//
#//  space([&lt;pos&gt;])
#//
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-&gt;NextToken("(");
    $iPos = $tmp if $buf-&gt;GetPos($tmp);
    $errn = $rberr, goto error if !$buf-&gt;NextToken(")");

    &amp;space_($iPos, $XYweiter);

    $level--;
    return $true;

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


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

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

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

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

    $level--;
    return $true;

error:
    $level--;
    &amp;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-&gt;NextToken("(");
    $dx = $tmp if $buf-&gt;GetInt($tmp);
    if ($buf-&gt;NextToken(","))
    {
	$dy = $tmp if $buf-&gt;GetInt($tmp);
    }
    $errn = $rberr, goto error if !$buf-&gt;NextToken(")");

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

    $level--;
    return $true;

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


#////////////////////////////////////////////////////////
#//
#//  formula([&lt;pos&gt;] [, [&lt;contpos&gt;] [, &lt;Name&gt;, V|HA|HR, &lt;dy&gt;]]) :==
#//     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++;

&amp;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-&gt;NextToken("(");
    $iPos = $tmp if $buf-&gt;GetPos($tmp);
    if ($buf-&gt;NextToken(","))
    {
	$iPosCont = $tmp if $buf-&gt;GetPos($tmp);
	$iTextMode = $TM_NONE;
	if ($buf-&gt;NextToken(","))
	{
	    $errn = $texerr, goto error if !$buf-&gt;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 &lt; 0)
	    {
		$errn = $komma, goto error if !$buf-&gt;NextToken(",");
		SW: 
		{ $iTextMode = $TM_V, last SW if $buf-&gt;NextToken("V");
		  $iTextMode = $TM_HA, last SW if $buf-&gt;NextToken("HA");
		  $iTextMode = $TM_HR, last SW if $buf-&gt;NextToken("HR");
		  $errn = $synterr, goto error;
		}
		$errn = $komma, goto error if !$buf-&gt;NextToken(",");
		$errn = $interr, goto error if !$buf-&gt;GetInt($iDY);
	    }
	    else
	    {
		$iTextMode = $TM_HA;
		$iDY = $rTextSkip;
	    }
	}
    }
    $errn = $rberr, goto error if !$buf-&gt;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 !&amp;fliste($XY, $BBox, $false, "}");

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

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

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

	    $TextXY-&gt;{"y"} -= $iDY;

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

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

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

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


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

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

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

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

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


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

error:
    $level--;
    &amp;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([&lt;Winkel&gt;] [, [&lt;Len_Extend&gt;] [, [&lt;Typ&gt;]]])
#//    {text(T|B, &lt;pos&gt;){ sliste } ...
#//    }
#//
sub arrow
{
    my ($XYstart, $XYweiter, $BBoxg, $bFlag) = @_;
    my $errn = 0;
    $level++;

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

    $errn = $lberr, goto error if !$buf-&gt;NextToken("(");
    $iAngle = ($tmp%360) if $buf-&gt;GetInt($tmp);
    if ($buf-&gt;NextToken(","))
    {
	$iLen = $tmp if $buf-&gt;GetInt($tmp);
	if ($buf-&gt;NextToken(","))
	{
	    $iType = $tmp if $buf-&gt;GetArrowType($tmp);
	}
    }
    $errn = $rberr, goto error if !$buf-&gt;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-&gt;NextToken("}"))
	{
	    $errn = $synterr, goto error if !$buf-&gt;NextToken("text");
	    $errn = $lberr, goto error if !$buf-&gt;NextToken("(");
	    $errn = $poserr, goto error if !$buf-&gt;GetPos($iHPos);
	    $errn = $poserr, goto error 
				if ($iHPos != $bbox::SB_T &amp;&amp; $iHPos != $bbox::SB_B);
	    $errn = $komma, goto error if !$buf-&gt;NextToken(",");
	    $errn = $poserr, goto error if !$buf-&gt;GetPos($iPos);
	    $errn = $poserr, goto error 
		if ($iPos != $bbox::SB_L &amp;&amp; $iPos != $bbox::SB_C &amp;&amp; $iPos != $bbox::SB_R);
	    $errn = $rberr, goto error if !$buf-&gt;NextToken("){");
	    $BBox-&gt;init(0,0);
	    $XY-&gt;eq(0,0);
	    my $Ptr = $buf-&gt;GetPtr();
	    my $objIDtmp = $objid;
	    $errn = $synterr, goto error 
			if !&amp;sliste($XY, $BBox, $false, -1, 0, "}");
	    if ($iHPos==$bbox::SB_T)
	    {   
		$BBox1-&gt;eq($BBox);    
		$objID1 = $objIDtmp;
		$iPos1 = $iPos;
		$Ptr1 = $Ptr;
	    }
	    else
	    {
		$BBox2-&gt;eq($BBox);    
		$iPos2 = $iPos;
		$objID2 = $objIDtmp;
		$Ptr2 = $Ptr;
	    }
	}

	# position marker inconsistent ?
	$errn = $incargerr, goto error if 
		($iPos1 != -1 &amp;&amp; $iPos2 != -1 &amp;&amp; $iPos1 != $iPos2);
	# arrow length is max(Breite1, Breite2) + 2*arrow_extend
	if ($iAngle&lt;45 || $iAngle &gt;=315 || ($iAngle &gt;=135 &amp;&amp; $iAngle &lt;225))
	{
	    $iBreite = &amp;max($BBox1-&gt;width(), $BBox2-&gt;width());
	}
	else
	{
	    $iBreite = &amp;max($BBox1-&gt;height(), $BBox2-&gt;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)
	{
	    &amp;TranslatePos("T", $iPos1);
	    if ($iAngle==0)
	    {
		$XYref-&gt;eq($iLen, $rArrowSkip) 
					if $iPos1 == $bbox::SB_BL;
		$XYref-&gt;eq($iBreite/2, $rArrowSkip)
					if $iPos1 == $bbox::SB_B;
		$XYref-&gt;eq($iBreite-$iLen, $rArrowSkip)
					if $iPos1 == $bbox::SB_BR;
	    }
	    elsif ($iAngle==180)
	    {
		$XYref-&gt;eq(-$iLen, $rArrowSkip) 
					if $iPos1 == $bbox::SB_BR;
		$XYref-&gt;eq(-$iBreite/2, $rArrowSkip)
					if $iPos1 == $bbox::SB_B;
		$XYref-&gt;eq(-$iBreite+$iLen, $rArrowSkip)
					if $iPos1 == $bbox::SB_BL;
	    }
	    elsif ($iAngle==90)
	    {
		$XYref-&gt;eq(-$rArrowSkip, $iBreite-$iLen), $iPos1 = $bbox::SB_TR
					if $iPos1 == $bbox::SB_BL;
		$XYref-&gt;eq(-$rArrowSkip, $iBreite/2), $iPos1 = $bbox::SB_R
					if $iPos1 == $bbox::SB_B;
		$XYref-&gt;eq(-$rArrowSkip, $iLen), $iPos1 = $bbox::SB_TR
					if $iPos1 == $bbox::SB_BR;
	    }
	    elsif ($iAngle==270)
	    {
		$XYref-&gt;eq(-$rArrowSkip, -$iLen), $iPos1 = $bbox::SB_TR
					if $iPos1 == $bbox::SB_BL;
		$XYref-&gt;eq(-$rArrowSkip, -$iBreite/2), $iPos1 = $bbox::SB_R
					if $iPos1 == $bbox::SB_B;
		$XYref-&gt;eq(-$rArrowSkip, -$iBreite+$iLen), $iPos1 = $bbox::SB_BR
					if $iPos1 == $bbox::SB_BR;
	    }
	    else
	    {
		$XYref-&gt;eq(0.5*$ax-$rArrowSkip*$px, 0.5*$ay-$rArrowSkip*$py);
		SW: {
		$iPos1 = $bbox::SB_BR, last SW if $iAngle&lt;90;
		$iPos1 = $bbox::SB_TR, last SW if $iAngle&lt;180;
		$iPos1 = $bbox::SB_TL, last SW if $iAngle&lt;270;
		$iPos1 = $bbox::SB_BL, last SW;
		}
	    }
	    $BBox1-&gt;OrigConPoint($iPos1, $XY1, $Null);
	    $BBox1-&gt;translate($XY1);
	    $BBox1-&gt;translate($XYstart);
	    $BBox1-&gt;translate($XYref);
	    $XY1-&gt;translate($XYstart);
	    $XY1-&gt;translate($XYref);
	    $BBoxg-&gt;MinMax($BBox1);
	    $objid = $objID1;
	    $buf-&gt;SetPtr($Ptr1);
	    &amp;sliste($XY1, $BBox, $false, -1, 0, "}");
	}
	if ($iPos2 != -1)
	{
	    &amp;TranslatePos("B", $iPos2);
	    if ($iAngle==0)
	    {
		$XYref-&gt;eq($iLen, -$rArrowSkip) 
					if $iPos2 == $bbox::SB_TL;
		$XYref-&gt;eq($iBreite/2, -$rArrowSkip)
					if $iPos2 == $bbox::SB_T;
		$XYref-&gt;eq($iBreite-$iLen, -$rArrowSkip)
					if $iPos2 == $bbox::SB_TR;
	    }
	    elsif ($iAngle==180)
	    {
		$XYref-&gt;eq(-$iLen, -$rArrowSkip) 
					if $iPos2 == $bbox::SB_TR;
		$XYref-&gt;eq(-$iBreite/2, -$rArrowSkip)
					if $iPos2 == $bbox::SB_T;
		$XYref-&gt;eq(-$iBreite+$iLen, -$rArrowSkip)
					if $iPos2 == $bbox::SB_TL;
	    }
	    elsif ($iAngle==90)
	    {
		$XYref-&gt;eq($rArrowSkip, $iLen), $iPos2 = $bbox::SB_BL
					if $iPos2 == $bbox::SB_TL;
		$XYref-&gt;eq($rArrowSkip, $iBreite-$iLen), $iPos2 = $bbox::SB_TL
					if $iPos2 == $bbox::SB_TR;
		$XYref-&gt;eq($rArrowSkip, $iBreite/2), $iPos2 = $bbox::SB_L
					if $iPos2 == $bbox::SB_T;
	    }
	    elsif ($iAngle==270)
	    {
		$XYref-&gt;eq($rArrowSkip, -$iLen), $iPos2 = $bbox::SB_TL
					if $iPos2 == $bbox::SB_TL;
		$XYref-&gt;eq($rArrowSkip, -$iBreite+$iLen), $iPos2 = $bbox::SB_BL
					if $iPos2 == $bbox::SB_TR;
		$XYref-&gt;eq($rArrowSkip, -$iBreite/2), $iPos2 = $bbox::SB_L
					if $iPos2 == $bbox::SB_T;
	    }
	    else
	    {
		$XYref-&gt;eq(0.5*$ax+$rArrowSkip*$px, 0.5*$ay+$rArrowSkip*$py);
		SW1: {
		$iPos2 = $bbox::SB_TL, last SW1 if $iAngle&lt;90;
		$iPos2 = $bbox::SB_BL, last SW1 if $iAngle&lt;180;
		$iPos2 = $bbox::SB_BR, last SW1 if $iAngle&lt;270;
		$iPos2 = $bbox::SB_TR, last SW1;
		}
	    }
	    $BBox2-&gt;OrigConPoint($iPos2, $XY2, $Null);
	    $BBox2-&gt;translate($XY2);
	    $BBox2-&gt;translate($XYstart);
	    $BBox2-&gt;translate($XYref);
	    $XY2-&gt;translate($XYstart);
	    $XY2-&gt;translate($XYref);
	    $BBoxg-&gt;MinMax($BBox2);
	    $objid = $objID2;
	    $buf-&gt;SetPtr($Ptr2);
	    &amp;sliste($XY2, $BBox, $false, -1, 0, "}");
	}
	$buf-&gt;NextToken("}");

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

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

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

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


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

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


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

&amp;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-&gt;NextToken("(");
    $errn = $interr, goto error if !$buf-&gt;GetInt($iAnz);
    $errn = $komma, goto error if !$buf-&gt;NextToken(",");
    $iPosInner = $tmp if $buf-&gt;GetPos($tmp);
    $errn = $badargerr, goto error if ($iPosInner != $bbox::SB_L &amp;&amp;
	$iPosInner != $bbox::SB_C &amp;&amp; $iPosInner != $bbox::SB_R);
    if ($buf-&gt;NextToken(","))
    {
	$iPos = $tmp if $buf-&gt;GetPos($tmp);
	if ($buf-&gt;NextToken(","))
	{
	    $iLen = $tmp if $buf-&gt;GetInt($tmp);
	}
    }
    $errn = $rberr, goto error if !$buf-&gt;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-&gt;NextToken("}"))
	{
	    $i++;
	    $XY-&gt;eq(0,0);
	    $tmpBBox-&gt;init(0,0);
	    push(@Ptr, $buf-&gt;GetPtr());
	    push(@ObjID, $objid);
	    @fBBox = ();
	    $errn = $synterr, goto error 
				if !&amp;sliste($XY, $tmpBBox, $false, 0, \@fBBox, ";");
	    # save size of chain
	    push(@myBBox, $tmpBBox-&gt;new());
	    $iBreite = &amp;max($iBreite, $tmpBBox-&gt;width());
	    $iHoehe += $tmpBBox-&gt;height();
	    $iHoehe += $rChainSep if $i&gt;1;
	    my $iHMax = 0;
	    grep(($iHMax = &amp;max($iHMax, $_-&gt;height())) &amp;&amp; 0, @fBBox);
	    push(@iY, $iHMax);
	    push(@rRatio, $v = ($XY-&gt;{"y"}-$tmpBBox-&gt;{"yu"})/$tmpBBox-&gt;height());
	    # increase by text height if any
	    $iHoehe += $rTextSep +$iHMax/2 - $tmpBBox-&gt;height()*$v
				if $iHMax&gt;0 &amp;&amp; ($rTextSep+$iHMax/2&gt;$tmpBBox-&gt;height()*$v);
	}
	$iBreite += $iLen;

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

	$BBox-&gt;init(0,0);
	$BBox-&gt;MinMax($iBreite, $iHoehe);
	$BBox-&gt;OrigConPoint($iPos, $XY, $Null);
	# XY ist nun richtiger Startpunkt. Verschiebe BBox entsprechend
	$BBox-&gt;translate($XY);
	$BBox-&gt;translate($XYstart);
	$BBoxg-&gt;MinMax($BBox);
	$origin[$tmpObjID+1] = $BBox-&gt;{"xo"};
	$BBox-&gt;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&lt;$iAnz; $i++)
	{
	    $buf-&gt;SetPtr(shift(@Ptr));
	    $objid = shift(@ObjID);
	    $BBox = shift(@myBBox);     
	    my $iYY = shift(@iY);
	    my $iDY = $rTextSep + $iYY/2;
	    my $rBoxHeight = $BBox-&gt;height();
	    my $XYref = new loc($XYstart);
	    $XYref-&gt;translate($XY);
	    SW:
	    {
		$XYref-&gt;translate(0,$iH), last SW if $iPosInner == $bbox::SB_TL;
		$XYref-&gt;translate(($iBreite-$iLen)/2,$iH) if $iPosInner == $bbox::SB_T;
		$XYref-&gt;translate($iBreite-$iLen,$iH) if $iPosInner == $bbox::SB_TR;
	    }
	    $BBox-&gt;OrigConPoint($iPosInner, $XYs, $Null);
	    $XYs-&gt;translate($XYref);
	    $BBox-&gt;init($XYs);
	    $origin[$tmpObjID+2+$i] = $XYs-&gt;new();
	    &amp;sliste($XYs, $BBox, $false, $iDY, \@fBBox, ";");
	    $v = shift(@rRatio);
	    $BBox-&gt;{"yu"} += $rTextSep + $iYY/2 - $rBoxHeight*$v
			if $iYY&gt;0 &amp;&amp; ($rTextSep+$iYY &gt; $rBoxHeight*$v);
	    $box[$tmpObjID+2+$i] = $BBox-&gt;new();
	    $origin[$tmpObjID+2+$i+$iAnz] = $XYs-&gt;new();
	    $iH -= $rChainSep + $BBox-&gt;height();
	    $iH -= $rTextSep + $iYY/2 - $rBoxHeight*$v
			if $iYY&gt;0 &amp;&amp; ($rTextSep+$iYY &gt; $rBoxHeight*$v);
	}

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

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


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

&amp;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-&gt;NextToken("(");
    $errn = $interr, goto error if !$buf-&gt;GetInt($iAnz);
    $errn = $komma, goto error if !$buf-&gt;NextToken(",");
    $iPosInner = $tmp if $buf-&gt;GetPos($tmp);
    $errn = $badargerr, goto error if ($iPosInner != $bbox::SB_T &amp;&amp;
	$iPosInner != $bbox::SB_C &amp;&amp; $iPosInner != $bbox::SB_B);
    if ($buf-&gt;NextToken(","))
    {
	$iPos = $tmp if $buf-&gt;GetPos($tmp);
	if ($buf-&gt;NextToken(","))
	{
	    $iLen = $tmp if $buf-&gt;GetInt($tmp);
	}
    }
    $errn = $rberr, goto error if !$buf-&gt;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-&gt;NextToken("}"))
	{
	    $i++;
	    $XY-&gt;eq(0,0);
	    $tmpBBox-&gt;init(0,0);
	    push(@Ptr, $buf-&gt;GetPtr());
	    push(@ObjID, $objid);
	    $errn = $synterr, goto error 
				if !&amp;sliste($XY, $tmpBBox, $false, -1, 0, ";");
	    # save size of chain
	    push(@myBBox, $tmpBBox-&gt;new());
	    $iHoehe = &amp;max($iHoehe, $tmpBBox-&gt;height());
	    $iBreite += $tmpBBox-&gt;width();
	    $iBreite += $rChainSep if $i&gt;1;
	}
	$iHoehe += $iLen;

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

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

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

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

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


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

&amp;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-&gt;NextToken("(");
    $errn = $interr, goto error if !$buf-&gt;GetInt($iAnz);
    if ($buf-&gt;NextToken(","))
    {
	$iPosInner = $tmp if $buf-&gt;GetPos($tmp);
	$errn = $badargerr, goto error if ($iPosInner != $bbox::SB_L &amp;&amp;
		$iPosInner != $bbox::SB_C &amp;&amp; $iPosInner != $bbox::SB_R);
	if ($buf-&gt;NextToken(","))
	{
	    $iPos = $tmp if $buf-&gt;GetPos($tmp);
	    if ($buf-&gt;NextToken(","))
	    {
		$iPosCont = $tmp if $buf-&gt;GetPos($tmp);
	    }
	}
    }
    $errn = $rberr, goto error if !$buf-&gt;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-&gt;NextToken("}"))
	{
	    $i++;
	    $XY-&gt;eq(0,0);
	    $BBox-&gt;init(0,0);
	    push(@Ptr, $buf-&gt;GetPtr());
	    push(@ObjID, $objid);
	    @fBBox = ();
	    # test formula without text if any -&gt; pure height of formulas
	    $errn = $synterr, goto error 
				if !&amp;sliste($XY, $BBox, $false, 0, \@fBBox, ";");
	    # save size of chain
	    push(@myBBox, $BBox-&gt;new());
	    $iBreite = &amp;max($iBreite, $BBox-&gt;width());
	    $iHoehe += $BBox-&gt;height();
	    my $iHMax = 0;
	    grep(($iHMax = &amp;max($iHMax, $_-&gt;height())) &amp;&amp; 0, @fBBox);
	    push(@iY, $iHMax);
	    # increase by text height if any
	    push(@rRatio, $v = ($XY-&gt;{"y"}-$BBox-&gt;{"yu"})/$BBox-&gt;height());
	    $iHoehe += $rTextSep+$iHMax/2 - $BBox-&gt;height()*$v
			if $iHMax&gt;0 &amp;&amp; ( $rTextSep+$iHMax/2 &gt; $BBox-&gt;height()*$v);
	    $iHoehe += $rMultilineSep if $i&gt;1;
	}
	# given number of chains != actual number
	$errn = $incargerr, goto error if $i != $iAnz;

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

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

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

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

error:
    $level--;
    &amp;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-&gt;NextToken("(");
    if ($buf-&gt;NextToken("[]"))
    { $bLeft = $bRight = $true; }
    elsif ($buf-&gt;NextToken("["))
    { $bLeft = $true;  $bRight = $false; }
    elsif ($buf-&gt;NextToken("]"))
    { $bLeft = $false;  $bRight = $true; }
    $errn = $rberr, goto error if !$buf-&gt;NextToken(")");

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

    return $true;

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


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

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

    return $true;
}


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

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

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

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

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

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

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

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


#////////////////////////////////////////////////////////
#//
#//  save(#&lt;n&gt;)/restore(#&lt;n&gt;)
#//  set(&lt;cPar&gt;, &lt;iVal&gt;)
#//
sub save
{
    my $errn;
    $level++;
    my $i;
    $errn = $lberr, goto error if !$buf-&gt;NextToken("(#");
    $errn = $interr, goto error if !$buf-&gt;GetInt($i);
    $errn = $rberr, goto error if !$buf-&gt;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--;
    &amp;error($errn, "save");
    return $false;
}

sub restore
{
    my ($bFlag) = @_;
    my $errn;
    $level++;
    my $i;
    $errn = $lberr, goto error if !$buf-&gt;NextToken("(#");
    $errn = $interr, goto error if !$buf-&gt;GetInt($i);
    $errn = $rberr, goto error if !$buf-&gt;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-&gt;parameter("lw", $rLW);
	print OUT $be-&gt;parameter("bw", $rBW);
	print OUT $be-&gt;parameter("aw", $rAW);
	print OUT $be-&gt;parameter("bd", $rBD);
    }
    return $true;

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

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

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

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

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

    return $true;

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

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

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

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


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

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

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

#////////////////////////////////////////////////////////
#//
#//  sliste :== formula | arrow | setcontext | savecontext |
#//     showcontext | space | multiline | &lt;endtoken&gt;
#//
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-&gt;NextToken($EndToken))
    {
	$XYg-&gt;eq($XYweiter);
	return $true;
    }
    elsif ($buf-&gt;NextToken("formula"))
    {
	$XYStart-&gt;eq($XYweiter), goto sliste
				if &amp;formula($XYStart, $XYweiter, $BBoxg, $bFlag,
						$rTextSkip, $fbox,
						$LastContext, $LastContextT);
    }
    elsif ($buf-&gt;NextToken("arrow"))
    {
	$XYStart-&gt;eq($XYweiter), goto sliste
				if &amp;arrow($XYStart, $XYweiter, $BBoxg, $bFlag);
    }
    elsif ($buf-&gt;NextToken("joinh"))
    {
	$XYStart-&gt;eq($XYweiter), goto sliste
				if &amp;joinh($XYStart, $XYweiter, $BBoxg, $bFlag);
    }
    elsif ($buf-&gt;NextToken("joinv"))
    {
	$XYStart-&gt;eq($XYweiter), goto sliste
				if &amp;joinv($XYStart, $XYweiter, $BBoxg, $bFlag);
    }
    elsif ($buf-&gt;NextToken("multiline"))
    {
	$XYStart-&gt;eq($XYweiter), goto sliste
				if &amp;multiline($XYStart, $XYweiter, $BBoxg, $bFlag,
						$LastContext, $LastContextT);
    }
    elsif ($buf-&gt;NextToken("space"))
    {
	$XYStart-&gt;eq($XYweiter), goto sliste
				if &amp;space($XYStart, $XYweiter, $BBoxg, $bFlag);
    }
    elsif ($buf-&gt;NextToken("gotoXY"))
    {
	$XYStart-&gt;eq($XYweiter), goto sliste
				if &amp;gotoXY($XYStart, $XYweiter, $BBoxg, $bFlag);
    }
    elsif ($buf-&gt;NextToken("shiftXY"))
    {
	$XYStart-&gt;eq($XYweiter), goto sliste
				if &amp;shiftXY($XYStart, $XYweiter, $BBoxg, $bFlag);
    }
    elsif ($buf-&gt;NextToken("bracket"))
    {
	goto sliste if &amp;bracket($LastContext, $bFlag);
    }
    elsif ($buf-&gt;NextToken("fbox"))
    {
	goto sliste if &amp;fbox($LastContextT, $bFlag);
    }
    elsif ($buf-&gt;NextToken("setcontext"))
    {
	$XYStart-&gt;eq($XYweiter), goto sliste if &amp;setcontext($XYStart, $XYweiter, $BBoxg, $bFlag);
    }
    elsif ($buf-&gt;NextToken("savecontext"))
    {
	goto sliste if &amp;savecontext($LastContext, $LastContextT);
    }
    elsif ($buf-&gt;NextToken("save"))
    {
	goto sliste if &amp;save();
    }
    elsif ($buf-&gt;NextToken("restore"))
    {
	goto sliste if &amp;restore($bFlag);
    }
    elsif ($buf-&gt;NextToken("set"))
    {
	goto sliste if &amp;set($bFlag);
    }
    elsif ($buf-&gt;NextToken("scale"))
    {
	goto sliste if &amp;scale($bFlag);
    }
    elsif ($buf-&gt;NextToken("emove"))
    {
	goto sliste if &amp;emove($bFlag);
    }

    &amp;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-&gt;GetPtr();
    $level = 0;
    $objid = 0;

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

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

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

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


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

    return $true;

error:
    $level--;
    &amp;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...] &lt;chm-file&gt;\n";
    print "                 -type &lt;n&gt;  output format, PS, PSLATEX, LATEX\n";
    print "                            default is 2\n";
    print "                 -trace &lt;level&gt; 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 &gt;$tmpfile`;
    $buf-&gt;LoadBuffer($tmpfile, \%texthash);
}
else
{
    $buf-&gt;LoadBuffer($infile, \%texthash);
}

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

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

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

    require "$cFile.pm";
}

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

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

    # parse schema
    my $BBox = new bbox();
    my ($rW, $rH);
    goto error if !&amp;schema($BBox, \$rW, \$rH);
    print OUT $be-&gt;inter();
    print OUT $be-&gt;erase(-1, -1, 0.01, 0.01);
    print OUT $be-&gt;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 &lt;TMP&gt;;
    close(TMP);

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

print "\n";
exit(0);

# error
error:
&amp;error($errn, "main");
print OUT $be-&gt;inter();
print OUT $be-&gt;close();
die "error aborted run ...\n";
</pre></body></html>