package streambuf;
#
#       history
#
#       09-JAN-2000 IK  new bond shapes >> and >. 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" => 0,
                 "Anz" => 0,
                 "Buffer" => ""
               };
   bless $r_buffer, 'streambuf';
   return $r_buffer;
}


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

   open(FILE, $file);
   while ($line = <FILE>)
   {
       chop($line);
       $l = "";
       $bOutText = $::true;
       for ($i=$j=0; $i<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 ? "</text>" : "<text>");
               }
           }
           last if ($c =~ /%/ && $bOutText);
           next if ($c =~ /\s/ && $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{<text>(.*?)</text>}g);
       if (@textext)
       {
           foreach $text (@textext)
           {
               $texthash->{$text} = "";
           }
       }
       substr($r_buff->{"Buffer"}, $r_buff->{"Anz"}, 0) = $line;
       $r_buff->{"Anz"} += length($line);
   }
   close(FILE);
}


#
#  $buf->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, ">".$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->{$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->{"Ptr"};
}

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


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

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


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

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


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

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


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

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


#
#  decodes a type marker like X or Y
#  BOOL $buf->GetType($iType)
#
($T_X, $T_Y) = (0, 1);
sub GetType
{
   my $r_buff = shift;
   my $code = substr($r_buff->{"Buffer"}, $r_buff->{"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->{"Ptr"} += $l;
   return ($_[0] != -1);
}

#
#  decodes a position marker like T, TR, T, BL, C, ...
#  BOOL $buf->GetPos($iPos)
#
sub GetPos
{
   my $r_buff = shift;
   my $code2 = substr($r_buff->{"Buffer"}, $r_buff->{"Ptr"}, 2);
   my $code1 = substr($r_buff->{"Buffer"}, $r_buff->{"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->{"Ptr"} += $l;
   return ($_[0] != -1);
}


#
#  decodes a bond length marker like S, N, L and returns length
#  BOOL $buf->GetBondLen($rLen)
#
sub GetBondLen
{
   my $r_buff = shift;
   my $l;
   my $bFound = 0;
   $_[0] = 0;
   while(1)
   {
       my $code = substr($r_buff->{"Buffer"}, $r_buff->{"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->{"Ptr"} += 1; $bFound = 1; }
   return ($bFound);
}
sub GetBondLenOrig
{
   my $r_buff = shift;
   my $code2 = substr($r_buff->{"Buffer"}, $r_buff->{"Ptr"}, 2);
   my $code1 = substr($r_buff->{"Buffer"}, $r_buff->{"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->{"Ptr"} += $l;
   return ($_[0] != -1);
}


#
#  decodes a bond type marker like -, =, L and returns type code
#  BOOL $buf->GetBondType($iType)
#
sub GetBondType
{
   my $r_buff = shift;
   my %codes = ( "->" => 10,  "-" => 0,    "<-" => 11,  "s" => 12,
                 "<<" => 2,   "<." => 3,   "o" => 4,
                 "=C" => 5,   "=U" => 6,   "=" => 7,    "3" => 8,
                 "p" =>1,     "t" => 9,    ">>" => 13,  ">." => 14,
                 "b" => 15,   "~" => 16
               );
   $_[0] = -1;

   foreach $elem (keys %codes)
   {
       if (substr($r_buff->{"Buffer"}, $r_buff->{"Ptr"}, length($elem)) eq
               $elem)
       {
           $_[0] = $codes{$elem};
           $r_buff->{"Ptr"} += length($elem);
           last;
       }
   }
   return ($_[0] != -1);
}


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

#
#  decodes a marker type marker like -, =, ... and returns type code
#  BOOL $buf->GetMarkerType($iType)
#
sub GetMarkerType
{
   my $r_buff = shift;
   my $code2 = substr($r_buff->{"Buffer"}, $r_buff->{"Ptr"}, 2);
   my $code1 = substr($r_buff->{"Buffer"}, $r_buff->{"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->{"Ptr"} += $l;
   return ($_[0] != -1);
}


1;

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.