<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package streambuf;
#
#	history
#
#	09-JAN-2000 IK	new bond shapes &gt;&gt; and &gt;. and b
#	19-JAN-2000 IK	new bond shape ~, bond length now determined by number of type markers,
#			LaTeX packages can be given to be preloaded
#

#
# creates new buffer
#
sub new
{
    $r_buffer = { "Ptr" =&gt; 0,
		  "Anz" =&gt; 0,
		  "Buffer" =&gt; ""
		};
    bless $r_buffer, 'streambuf';
    return $r_buffer;
}


#
#  $buf-&gt;LoadBuffer($file)
#
sub LoadBuffer
{
    my ($r_buff, $file, $texthash) = @_;
    my ($text, $l, $c, $bOutText);

    open(FILE, $file);
    while ($line = &lt;FILE&gt;)
    {
	chop($line);
	$l = ""; 
	$bOutText = $::true;
	for ($i=$j=0; $i&lt;length($line); $i++)
	{
	    $c = substr($line, $i, 1);
	    if ($c eq '"')
	    {
		if (substr($line, $i+1, 1) eq '"')
		{
		    $c = '"';
		    $i++;
		}
		else
		{
		    $bOutText = !$bOutText;
		    $c = ($bOutText ? "&lt;/text&gt;" : "&lt;text&gt;");
		}
	    }
	    last if ($c =~ /%/ &amp;&amp; $bOutText);  
	    next if ($c =~ /\s/ &amp;&amp; $bOutText);  
	    substr($l, $j) = $c;
	    $j += length($c);
	}
	$line = $l;
##+	$line =~ s/\s//g;		# delete white spaces
##+	$line =~ /^([^%]*)%*.*$/;	# cut off comment
##+	$line = $1;
	# write out all TeX text strings
	@textext = ($line =~ m{&lt;text&gt;(.*?)&lt;/text&gt;}g);
	if (@textext)
	{
	    foreach $text (@textext)
	    {
		$texthash-&gt;{$text} = "";
	    }
	}
	substr($r_buff-&gt;{"Buffer"}, $r_buff-&gt;{"Anz"}, 0) = $line;
	$r_buff-&gt;{"Anz"} += length($line);
    }
    close(FILE);
}


#
#  $buf-&gt;GetTextSize(...)
#
sub GetTextSize
{
    my ($r_buff, $tmptex, $texthash, $be_type, $latexcmd, $cFont, $packages) = @_;
    my $text;
    my ($opt, $package, $packagename);

    # get dimensions of text fragments
    if ($be_type == $be::BE_PSLATEX || $be_type == $be::BE_LATEX)
    {
	open(OUT, "&gt;".$tmptex);
	print OUT "\\documentclass[a4paper,12pt]{article}\n";
	print OUT "\\usepackage{german}\n";
	# write each desired LaTeX package in preamble
	while ($package = pop(@$packages))
	{
	    ($opt, $packagename) = $package =~ /(\[\S*\])*(\S*)/;
	    print OUT "\\usepackage$opt\{$packagename\}\n";
	}
	print OUT "\\newsavebox{\\testbox}\n";
	print OUT "\\newcommand{\\atom}[1]\n";
	print OUT "{\\sbox{\\testbox}{#1}\n";
	print OUT " \\typeout{A:\\the\\wd\\testbox,\\the\\ht\\testbox,\\the\\dp\\testbox}\n";
	print OUT " }\n";
	print OUT "\\newcommand{\\testfont}{$cFont}\n" if $cFont;
	print OUT "\n";
	print OUT "\\begin{document}\n";
	print OUT "\\testfont\n" if $cFont;
	foreach $text (keys %$texthash)
	{
	    print OUT "\\atom{$text}\n";
	}
	print OUT "\\end{document}\n";
	close(OUT);

	# build array of TeX text dimensions: LaTeX it!
	my @dimen = grep(/^A:/, `$latexcmd $tmptex`);
	my $i = 0;
	foreach $text (keys %$texthash)
	{
	    $texthash-&gt;{$text} = $dimen[$i++];
	}
    }
    elsif ($be_type == $be::BE_PS)
    {
	foreach $text (keys %$texthash)
	{
	    print "warning: cannot determine text size for $text\n";
	}
    }
}


#
#
#
sub GetPtr
{
    my $r_buff = shift;
    return $r_buff-&gt;{"Ptr"};
}

sub SetPtr
{
    my ($r_buff, $ptr) = @_;
    $r_buff-&gt;{"Ptr"} = $ptr;
}


#
#  check if next token in buffer is $token, and adjusts buffer pointer
#  Returns zero if there's not this token.
#  BOOL $buf-&gt;NextToken($token)
#
sub NextToken
{
    my ($r_buff, $text) = @_;
    my $Ptr = $r_buff-&gt;{"Ptr"};
    my $Anz = $r_buff-&gt;{"Anz"};
    my $len = length($text);

    return 0 if $len+$Ptr &gt; $Anz;
    if (substr($r_buff-&gt;{"Buffer"}, $Ptr, $len) eq $text)
    {
	$r_buff-&gt;{"Ptr"} += $len;
	return 1;
    }
    return 0;
}


#
#  Tries to get an signed integer value.
#  BOOL $buf-&gt;GetInt($iVar)
#
sub GetInt
{
    my $r_buff = shift;

    if ( $iAnz = substr($r_buff-&gt;{"Buffer"}, $r_buff-&gt;{"Ptr"}) =~ 
			/^([+-]?\d+)/)
    {
	$_[0] = $1;
	$r_buff-&gt;{"Ptr"} += length($1);
    }
    return ($iAnz);
}


#
#  Tries to get an signed fix float value.
#  BOOL $buf-&gt;GetReal($rVar)
#
sub GetReal
{
    my $r_buff = shift;

    if ( $iAnz = substr($r_buff-&gt;{"Buffer"}, $r_buff-&gt;{"Ptr"}) =~ 
			/^([+-]?(\d+(\.\d*)*)|(\d*\.\d*))/)
    {
	$_[0] = $1;
	$r_buff-&gt;{"Ptr"} += length($1);
    }
    return ($iAnz);
}


#
#  Tries to get a text enclosed in &lt;text&gt;...&lt;/text&gt;
#  BOOL $buf-&gt;GetText($cVar)
#
sub GetText
{
    my $r_buff = shift;

    if ( $iAnz = substr($r_buff-&gt;{"Buffer"}, $r_buff-&gt;{"Ptr"}) =~ 
			m{^&lt;text&gt;(.*?)&lt;/text&gt;})
    {
	$_[0] = $1;
	$r_buff-&gt;{"Ptr"} += length($1) + 13;
    }
    return ($iAnz);
}


#
#  decodes a type marker like X or Y
#  BOOL $buf-&gt;GetType($iType)
#
($T_X, $T_Y) = (0, 1);
sub GetType
{
    my $r_buff = shift;
    my $code = substr($r_buff-&gt;{"Buffer"}, $r_buff-&gt;{"Ptr"}, 1);
    my $l;
    $_[0] = -1;
    SWITCH: {
	$l = 1;
    	$_[0] = $T_X, last SWITCH if $code eq "X";
    	$_[0] = $T_Y, last SWITCH if $code eq "Y";
	$l = 0;
    }
    $r_buff-&gt;{"Ptr"} += $l;
    return ($_[0] != -1);
}

#
#  decodes a position marker like T, TR, T, BL, C, ...
#  BOOL $buf-&gt;GetPos($iPos)
#
sub GetPos
{
    my $r_buff = shift;
    my $code2 = substr($r_buff-&gt;{"Buffer"}, $r_buff-&gt;{"Ptr"}, 2);
    my $code1 = substr($r_buff-&gt;{"Buffer"}, $r_buff-&gt;{"Ptr"}, 1);
    my $l;
    $_[0] = -1;
    SWITCH: {
	$l = 2;
    	$_[0] = $bbox::SB_BL, last SWITCH if $code2 eq "BL";
    	$_[0] = $bbox::SB_BR, last SWITCH if $code2 eq "BR";
    	$_[0] = $bbox::SB_TL, last SWITCH if $code2 eq "TL";
    	$_[0] = $bbox::SB_TR, last SWITCH if $code2 eq "TR";
	$l = 1;
    	$_[0] = $bbox::SB_L, last SWITCH if $code1 eq "L";
    	$_[0] = $bbox::SB_R, last SWITCH if $code1 eq "R";
    	$_[0] = $bbox::SB_T, last SWITCH if $code1 eq "T";
    	$_[0] = $bbox::SB_B, last SWITCH if $code1 eq "B";
    	$_[0] = $bbox::SB_C, last SWITCH if $code1 eq "C";
	$l = 0;
    }
    $r_buff-&gt;{"Ptr"} += $l;
    return ($_[0] != -1);
}


#
#  decodes a bond length marker like S, N, L and returns length
#  BOOL $buf-&gt;GetBondLen($rLen)
#
sub GetBondLen
{
    my $r_buff = shift;
    my $l;
    my $bFound = 0;
    $_[0] = 0;
    while(1)
    {
	my $code = substr($r_buff-&gt;{"Buffer"}, $r_buff-&gt;{"Ptr"}, 1);
    	$_[0] += $main::rLenN, next if $code eq "N";
    	$_[0] += $main::rLenL, next if $code eq "L";
    	$_[0] += $main::rLenS, next if $code eq "S";
    	$_[0] += $main::rLenN/2, next if $code eq "n";
    	$_[0] += $main::rLenL/2, next if $code eq "l";
    	$_[0] += $main::rLenS/2, next if $code eq "s";
    	next if $code eq "0";
	last;
    } continue { $r_buff-&gt;{"Ptr"} += 1; $bFound = 1; }
    return ($bFound);
}
sub GetBondLenOrig
{
    my $r_buff = shift;
    my $code2 = substr($r_buff-&gt;{"Buffer"}, $r_buff-&gt;{"Ptr"}, 2);
    my $code1 = substr($r_buff-&gt;{"Buffer"}, $r_buff-&gt;{"Ptr"}, 1);
    my $l;
    $_[0] = -1;
    SWITCH: {
	$l = 2;
    	$_[0] = 2*$main::rLenN, last SWITCH if $code2 eq "NN";
    	$_[0] = 2*$main::rLenS, last SWITCH if $code2 eq "SS";
    	$_[0] = 2*$main::rLenL, last SWITCH if $code2 eq "LL";
	$l = 1;
    	$_[0] = $main::rLenN, last SWITCH if $code1 eq "N";
    	$_[0] = $main::rLenL, last SWITCH if $code1 eq "L";
    	$_[0] = $main::rLenS, last SWITCH if $code1 eq "S";
    	$_[0] = $main::rLenN/2, last SWITCH if $code1 eq "n";
    	$_[0] = $main::rLenL/2, last SWITCH if $code1 eq "l";
    	$_[0] = $main::rLenS/2, last SWITCH if $code1 eq "s";
    	$_[0] = 0, last SWITCH if $code1 eq "0";
	$l = 0;
    }
    $r_buff-&gt;{"Ptr"} += $l;
    return ($_[0] != -1);
}


#
#  decodes a bond type marker like -, =, L and returns type code
#  BOOL $buf-&gt;GetBondType($iType)
#
sub GetBondType
{
    my $r_buff = shift;
    my %codes = ( "-&gt;" =&gt; 10,  "-" =&gt; 0,    "&lt;-" =&gt; 11,  "s" =&gt; 12,
		  "&lt;&lt;" =&gt; 2,   "&lt;." =&gt; 3,   "o" =&gt; 4, 
   		  "=C" =&gt; 5,   "=U" =&gt; 6,   "=" =&gt; 7,    "3" =&gt; 8,
		  "p" =&gt;1,     "t" =&gt; 9,    "&gt;&gt;" =&gt; 13,  "&gt;." =&gt; 14,
		  "b" =&gt; 15,   "~" =&gt; 16
		);
    $_[0] = -1;
    
    foreach $elem (keys %codes)
    {
	if (substr($r_buff-&gt;{"Buffer"}, $r_buff-&gt;{"Ptr"}, length($elem)) eq
		$elem)
	{
	    $_[0] = $codes{$elem};
	    $r_buff-&gt;{"Ptr"} += length($elem);
	    last;
	}
    }
    return ($_[0] != -1);
}


#
#  decodes a arrow type marker like -, =, ... and returns type code
#  BOOL $buf-&gt;GetArrowType($iType)
#
sub GetArrowType
{
    my $r_buff = shift;
    my $code3 = substr($r_buff-&gt;{"Buffer"}, $r_buff-&gt;{"Ptr"}, 3);
    my $code2 = substr($r_buff-&gt;{"Buffer"}, $r_buff-&gt;{"Ptr"}, 2);
    my $code1 = substr($r_buff-&gt;{"Buffer"}, $r_buff-&gt;{"Ptr"}, 1);
    my $l;
    $_[0] = -1;
    SWITCH: {
	$l = 3;
    	$_[0] = 3, last SWITCH if $code3 eq "&lt;=&gt;";
    	$_[0] = 4, last SWITCH if $code3 eq "&lt;-&gt;";
    	$_[0] = 5, last SWITCH if $code3 eq "-|&gt;";
    	$_[0] = 6, last SWITCH if $code3 eq "&lt;|-";
	$l = 2;
    	$_[0] = 1, last SWITCH if $code2 eq "-&gt;";
    	$_[0] = 2, last SWITCH if $code2 eq "&lt;-";
	$l = 1;
    	$_[0] = 0, last SWITCH if $code1 eq "-";
	$l = 0;
    }
    $r_buff-&gt;{"Ptr"} += $l;
    return ($_[0] != -1);
}

#
#  decodes a marker type marker like -, =, ... and returns type code
#  BOOL $buf-&gt;GetMarkerType($iType)
#
sub GetMarkerType
{
    my $r_buff = shift;
    my $code2 = substr($r_buff-&gt;{"Buffer"}, $r_buff-&gt;{"Ptr"}, 2);
    my $code1 = substr($r_buff-&gt;{"Buffer"}, $r_buff-&gt;{"Ptr"}, 1);
    my $l;
    $_[0] = -1;
    SWITCH: {
	$l = 2;
    	$_[0] = 3, last SWITCH if $code2 eq "4f";
    	$_[0] = 1, last SWITCH if $code2 eq "of";
    	$_[0] = 5, last SWITCH if $code2 eq "rf";
    	$_[0] = 7, last SWITCH if $code2 eq "3f";
	$l = 1;
    	$_[0] = 0, last SWITCH if $code1 eq "o";
    	$_[0] = 2, last SWITCH if $code1 eq "4";
    	$_[0] = 4, last SWITCH if $code1 eq "r";
    	$_[0] = 6, last SWITCH if $code1 eq "3";
    	$_[0] = 8, last SWITCH if $code1 eq "+";
    	$_[0] = 9, last SWITCH if $code1 eq "x";
    	$_[0] = 10, last SWITCH if $code1 eq "*";
    	$_[0] = 11, last SWITCH if $code1 eq "n";
	$l = 0;
    }
    $r_buff-&gt;{"Ptr"} += $l;
    return ($_[0] != -1);
}


1;
</pre></body></html>