package be;
#
#       history
#
#       20-OCT-1999 IK  setting \unitlength in an enclosing group
#       19-JAN-2000 IK  inhibit undesired space (thanks to B. Seckinge)
#

($BE_PS, $BE_PSLATEX, $BE_LATEX) = (1, 2, 3);
my $type = $BE_PSLATEX;

# BE_PS:        drawing and text as PostScript
# BE_PSLATEX:   drawing as PostScript, text as LaTeX picture environment
# BE_LATEX:     drawing and text as LaTeX picture

#
#  create new backend object.
#  $be = be->new($type)
#

sub new
{
   my $r_be;
   my $pck = shift;    # first parameter is class name
   if (ref($pck))
   # called as instance method $beobject->new()
   {
       $r_be = { "type" => $pck->{"type"}
                };
   }
   else
   # called as class method be->new()
   {
       if (@_)
       {
           $r_be = { "type" => $_[0]
                   };
       }
       else
       {
           $r_be = { "type" => $BE_PSLATEX
                   };
       }
   }
   bless $r_be, 'be';
return $r_be;
}

# helper function for LaTeX output
# converts angle Phi to dx/dy in [0,4]
sub phi2delta
{
   my ($phi, $len, $dx, $dy, $proj) = @_;
   my $c30 = cos(30*3.1415927/180);
   $phi = $phi%360;
   SW:
   {
       $$dx = 2, $$dy = 1, $$proj = $c30*$len, last SW if $phi==30;
       $$dx = -2, $$dy = 1, $$proj = $c30*$len, last SW if $phi==150;
       $$dx = -2, $$dy = -1, $$proj = $c30*$len, last SW if $phi==210;
       $$dx = 2, $$dy = -1, $$proj = $c30*$len, last SW if $phi==330;
       $$dx = 1, $$dy = 2, $$proj = $len/2, last SW if $phi==60;
       $$dx = -1, $$dy = 2, $$proj = $len/2, last SW if $phi==120;
       $$dx = -1, $$dy = -2, $$proj = $len/2, last SW if $phi==240;
       $$dx = 1, $$dy = -2, $$proj = $len/2, last SW if $phi==300;
       $$dx = 1, $$dy = 0, $$proj = $len, last SW if $phi==0;
       $$dx = -1, $$dy = 0, $$proj = $len, last SW if $phi==180;
       $$dx = 0, $$dy = 1, $$proj = $len, last SW if $phi==90;
       $$dx = 0, $$dy = -1, $$proj = $len, last SW if $phi==270;
       $$dx = 1, $$dy = 1, $$proj = sqrt($len), last SW if $phi==45;
       $$dx = -1, $$dy = 1, $$proj = sqrt($len), last SW if $phi==135;
       $$dx = -1, $$dy = -1, $$proj = sqrt($len), last SW if $phi==225;
       $$dx = 1, $$dy = -1, $$proj = sqrt($len), last SW if $phi==315;
       print "warning: not converting angle $phi!\n";
   }
}


#
#  draw normal line giving starting point, length and direction
#  $be->line($x, $y, $phi, $len, [,$rem])
#
sub line
{
   my $r_be = shift;
   my ($x, $y, $phi, $len, $rem) = @_;

   if ($r_be->{"type"} == $BE_PS || $r_be->{"type"} == $BE_PSLATEX)
   {
       sprintf "gs %.2f %.2f tr %.2f rotate ".
               "0 0 m %.2f 0 rlineto stroke gr %s\n",
               $x, $y, $phi, $len,
               $rem ? "  %%$rem" : "";
   }
   elsif ($r_be->{"type"} == $BE_LATEX)
   {
       my ($xe, $ye) = ($x+cos($phi*$::pi/180)*$len, $y+sin($phi*$::pi/180)*$len);
       sprintf "\\drawline(%.2f,%.2f)(%.2f,%.2f) %s\n",
               $x, $y, $xe, $ye, $rem ? "  %%$rem" : "";
   }
}


#
#  draw general line connecting two points, giving dash pattern
#  $be->draw($x0, $y0, $x1, $y1 [,$cLineType])
#
sub draw
{
   my $r_be = shift;
   my ($x0, $y0, $x1, $y1, $cLineType) = @_;

   if ($r_be->{"type"} == $BE_PS || $r_be->{"type"} == $BE_PSLATEX)
   {
       sprintf "gs %s 0 setdash %.2f %.2f m %.2f %.2f l stroke gr\n",
               $cLineType, $x0, $y0, $x1, $y1;
   }
   elsif ($r_be->{"type"} == $BE_LATEX)
   {
       sprintf "\\drawline(%.2f,%.2f)(%.2f,%.2f)\n",
               $x0, $y0, $x1, $y1;
   }
}


#
#  draw marker at given point
#  $be->mark($x0, $y0, $iType, $iSize)
#
sub mark
{
   my $r_be = shift;
   my ($x, $y, $iType, $iSize) = @_;

   if ($r_be->{"type"} == $BE_PS || $r_be->{"type"} == $BE_PSLATEX)
   {
       sprintf "%.2f %.2f %.2f m%d\n", $iSize, $x, $y, $iType;
   }
   elsif ($r_be->{"type"} == $BE_LATEX)
   {
       sprintf "\\put(%.2f,%.2f){\\circle*{%d}}\n", $x, $y, $iSize;
   }
}


#
#  chemical bond in different shapes
#  $be->bond($x, $y, $phi, $len, $type [,$rem])
#
sub bond
{
   my $r_be = shift;
   my ($x, $y, $phi, $len, $type, $rem) = @_;

   if ($r_be->{"type"} == $BE_PS || $r_be->{"type"} == $BE_PSLATEX)
   {
       sprintf "%.2f %.2f %.2f %.2f b%d%s\n",
               $phi, $x, $y, $len, $type, $rem ? "  %%$rem" : "";
   }
   elsif ($r_be->{"type"} == $BE_LATEX)
   {
       my ($xe, $ye) = ($x+cos($phi*$::pi/180)*$len, $y+sin($phi*$::pi/180)*$len);
       my ($dx1, $dy1) = (cos((45+$phi)*$::pi/180)*4, sin((45+$phi)*$::pi/180)*4);
       my ($dxe1, $dye1) = (cos((135+$phi)*$::pi/180)*4, sin((135+$phi)*$::pi/180)*4);
       my ($dx2, $dy2) = (cos((-45+$phi)*$::pi/180)*4, sin((-45+$phi)*$::pi/180)*4);
       my ($dxe2, $dye2) = (cos((-135+$phi)*$::pi/180)*4, sin((-135+$phi)*$::pi/180)*4);
       SW: {
       (sprintf "\\drawline(%.2f,%.2f)(%.2f,%.2f)\n",
               $x, $y, $xe, $ye), last SW if $type==0;
       (sprintf "\\drawline(%.2f,%.2f)(%.2f,%.2f) ".
               "\\drawline(%.2f,%.2f)(%.2f,%.2f)\n",
               $x, $y+$dy1, $xe, $ye+$dye1,
               $x, $y+$dy2, $xe, $ye+$dye2), last SW if $type==5;
       (sprintf "\\drawline(%.2f,%.2f)(%.2f,%.2f) ".
               "\\drawline(%.2f,%.2f)(%.2f,%.2f)\n",
               $x, $y, $xe, $ye,
               $x+$dx1, $y+$dy1, $xe+$dxe1, $ye+$dye1), last SW if $type==6;
       (sprintf "\\drawline(%.2f,%.2f)(%.2f,%.2f) ".
               "\\drawline(%.2f,%.2f)(%.2f,%.2f)\n",
               $x, $y, $xe, $ye,
               $x+$dx2, $y+$dy2, $xe+$dxe2, $ye+$dye2), last SW if $type==7;
       (sprintf "\\drawline(%.2f,%.2f)(%.2f,%.2f) ".
               "\\drawline(%.2f,%.2f)(%.2f,%.2f) ".
               "\\drawline(%.2f,%.2f)(%.2f,%.2f)\n",
               $x, $y, $xe, $ye,
               $x+$dx1, $y+$dy1, $xe+$dxe1, $ye+$dye1,
               $x+$dx2, $y+$dy2, $xe+$dxe2, $ye+$dye2), last SW if $type==8;
       (sprintf "{\\allinethickness{2pt}\\drawline(%.2f,%.2f)(%.2f,%.2f)}\n",
               $x, $y, $xe, $ye), last SW if $type==9;
       (sprintf "{\\allinethickness{2pt}\\dottedline(%.2f,%.2f)(%.2f,%.2f)}\n",
               $x, $y, $xe, $ye), last SW if $type==4;
       (sprintf "\\dottedline(%.2f,%.2f)(%.2f,%.2f)\n",
               $x, $y, $xe, $ye), last SW if $type==13;
       (sprintf "\n"), last SW if $type==12;
       my ($dx, $dy, $proj);
       &phi2delta($phi, $len, \$dx, \$dy, \$proj);
       (sprintf "\\put(%.2f,%.2f){\\vector(%d,%d){%.2f}}\n",
               $x, $y, $dx, $dy, $proj), last SW if $type==10;
       (sprintf "\\put(%.2f,%.2f){\\vector(%d,%d){%.2f}}\n",
               $x+$proj, $y, -$dx, $dy, $proj), last SW if $type==11;
       print "warning: not drawing bond type $type\n";
       }
   }
}

#
#  chemical arrow
#  $be->arrow($x, $y, $phi, $len, $type [,$rem])
#
sub arrow
{
   my $r_be = shift;
   my ($x, $y, $phi, $len, $type, $rem) = @_;

   if ($r_be->{"type"} == $BE_PS || $r_be->{"type"} == $BE_PSLATEX)
   {
       sprintf "%.2f %.2f %.2f %.2f ar%d%s\n",
               $len, $phi, $x, $y, $type,
               $rem ? "  %%$rem" : "";
   }
   elsif ($r_be->{"type"} == $BE_LATEX)
   {
       my ($dx, $dy, $proj);
       &phi2delta($phi, $len, \$dx, \$dy, \$proj);
       SW: {
       (sprintf "\\put(%.2f,%.2f){\\line(%d,%d){%.2f}}\n",
               $x, $y, $dx, $dy, $proj), last SW if $type==0;
       (sprintf "\\put(%.2f,%.2f){\\vector(%d,%d){%.2f}}\n",
               $x, $y, $dx, $dy, $proj), last SW if $type==1;
       (sprintf "\\put(%.2f,%.2f){\\vector(%d,%d){%.2f}}\n",
               $x+$proj, $y, -$dx, $dy, $proj),
               last SW if $type==2;
       (sprintf "\\put(%.2f,%.2f){\\vector(%d,%d){%.2f}} ".
               "\\put(%.2f,%.2f){\\vector(%d,%d){%.2f}}\n",
               $x, $y+3, $dx, $dy, $proj,
               $x+$proj, $y-3, -$dx, $dy, $proj),
               last SW if $type==3;
       (sprintf "\\put(%.2f,%.2f){\\vector(%d,%d){%.2f}} ".
               "\\put(%.2f,%.2f){\\vector(%d,%d){%.2f}}\n",
               $x, $y, $dx, $dy, $proj,
               $x+$proj, $y, -$dx, $dy,),
               last SW if $type==4;
       (sprintf "\\put(%.2f,%.2f){\\vector(%d,%d){%.2f}} ".
               "\\put(%.2f,%.2f){//}\n",
               $x, $y, $dx, $dy, $proj, $x+$proj/2,$y),
               last SW if $type==5;
       (sprintf "\\put(%.2f,%.2f){\\vector(%d,%d){%.2f}} ".
               "\\put(%.2f,%.2f){//}\n",
               $x+$proj, $y, -$dx, $dy, $proj, $x+$proj/2,$y),
               last SW if $type==6;
       }
   }
}


#
#  blanks out rectangle, normally used to erase background of text
#  $be->erase($x, $y, $width, $height [,$rem])
#
sub erase
{
   my $r_be = shift;
   my ($x, $y, $width, $height, $rem) = @_;

   if ($r_be->{"type"} == $BE_PS)
   {
       sprintf "gs 1 setgray np %f %f moveto %f 0 rlineto 0 %f rlineto -%f 0 rlineto ".
               "closepath fill gr\n",
               $x, $y, $width, $height, $rem ? "  %%$rem" : "";
   }
   elsif ($r_be->{"type"} == $BE_PSLATEX || $r_be->{"type"} == $BE_LATEX)
   {
       sprintf "\\put(%f,%f){\\textcolor{white}{\\rule{%fpt}{%fpt}}}\n",
               $x, $y, $width, $height, $rem ? "  %%$rem" : "";
   }
}


#
#  $be->text($x, $y, $text [,$rem])
#
sub text
{
   my $r_be = shift;
   my ($x, $y, $text, $rem) = @_;

   if ($r_be->{"type"} == $BE_PS)
   {
       sprintf "%.2f %.2f moveto (%s) show%s\n",
               $x, $y, $text, $rem ? "  %%$rem" : "";
   }
   elsif ($r_be->{"type"} == $BE_PSLATEX || $r_be->{"type"} == $BE_LATEX)
   {
       sprintf "\\put(%f,%f){%s}%s\n",
               $x, $y, $text, $rem ? "  %%$rem" : "";
   }
}


#
#  draw a circle
#  $be->arc($mx, $my, $phi0, $phiend, $radius [,$rem])
#
sub arc
{
   my $r_be = shift;
   my ($x, $y, $phi0, $phiend, $radius, $rem) = @_;

   if ($r_be->{"type"} == $BE_PS || $r_be->{"type"} == $BE_PSLATEX)
   {
       sprintf "np %.2f %.2f %4f %4f %.2f arc closepath s%s\n",
               $x, $y, $radius, $phi0, $phiend,
               $rem ? "  %$rem" : "";
   }
   elsif ($r_be->{"type"} == $BE_LATEX)
   {
       sprintf "\\put(%.2f,%.2f){\\circle{%.2f}}%s\n",
               $x, $y, $radius, $rem ? "  %$rem" : "";
   }
}


#
#  draws a spline starting at p1, control points p2/p3 with an arrow tip
#  at the end point p4
#  $be->spline($p1.x, $p1.y, ..., $p4.y)
#
sub spline
{
   my $r_be = shift;
   my ($x1, $y1, $x2, $y2, $x3, $y3, $x4, $y4, $angle) = @_;

   if ($r_be->{"type"} == $BE_PS || $r_be->{"type"} == $BE_PSLATEX)
   {
       sprintf "np %.2f %.2f moveto %.2f %.2f %.2f %.2f %.2f %.2f curveto s".
               "  %d %.2f %.2f atip\n",
               $x1, $y1, $x2, $y2, $x3, $y3, $x4, $y4, $angle, $x4, $y4;
   }
   elsif ($r_be->{"type"} == $BE_LATEX)
   {
       print "warning: not drawing emove spline!\n";
       sprintf "\n";
   }
}


#
#  $be->orbital($x, $y, $iAngle, $rWeight)
#
sub orbital
{
   my $r_be = shift;
   my ($x, $y, $iAngle, $rWeight) = @_;

   my $XY1 = loc->new($x, $y);
   my $XY2 = loc->new($x, $y);
   if ($r_be->{"type"} == $BE_PS || $r_be->{"type"} == $BE_PSLATEX)
   {

       sprintf "gsave %.2f %.2f translate %d rotate %.2f dup scale ".
               ".9 setgray np 0 0 moveto  1 .5 1 -.5 0 0 rcurveto fill ".
               ".7 setgray np 0 0 moveto -1 .5 -1 -.5 0 0 rcurveto fill grestore\n",
               $x, $y, $iAngle, $rWeight;
   }
   elsif ($r_be->{"type"} == $BE_LATEX)
   {
       print "warning: not drawing orbital!\n";
       sprintf "\n";
   }
}


#
#  sets graphical parameters
#  $be->parameter($name, $wert)
#
sub parameter
{
   my $r_be = shift;
   my ($name, $value, $rem) = @_;

   if ($r_be->{"type"} == $BE_PS || $r_be->{"type"} == $BE_PSLATEX)
   {
       SW: {
           (sprintf "%f setlinewidth /lw %f def \n", $value, $value),
                                                       last SW if $name eq "lw";
           (sprintf "%f setgray\n", $value), last SW if $name eq "gray";
           sprintf "/%s %f def\n", $name, $value;
       }
   }
   elsif ($r_be->{"type"} == $BE_LATEX)
   {
       SW1: {
           (sprintf "\\allinethickness{%.2fpt}\n", $value), last SW1 if $name eq "lw";
       }
   }
}


# $be->comment($rem)
sub comment
{
   my $r_be = shift;
   my ($rem) = @_;

   if ($r_be->{"type"} == $BE_PS || $r_be->{"type"} == $BE_PSLATEX ||
                                               $r_be->{"type"} == $BE_LATEX)
   {
       sprintf "%%%s\n", $rem;
   }
}


#
#  called when picture is to be opened
#  $be->open($font, $x, $y, [,$rem])
#
sub open
{
   my $r_be = shift;
   my ($font, $x, $y, $rem) = @_;

   if ($r_be->{"type"} == $BE_PS)
   {
       sprintf "%sBoundingBox: 0 0 %7.2f %7.2f%s\n", "%%%%",
               $x, $y, $rem ? "\n%% $rem" : "";

   }
   elsif ($r_be->{"type"} == $BE_PSLATEX)
   {
       sprintf "{\\unitlength1pt\\begin{picture}(%7.2f,%7.2f)\n".
       "{\\%sname\n".
       "\\special{\\string\"\n", $x, $y, $font;
   }
   elsif ($r_be->{"type"} == $BE_LATEX)
   {
       sprintf "{\\unitlength1pt\\begin{picture}(%7.2f,%7.2f)\n".
       "{\\%s\n", $x, $y, $font;
   }
}


#
#  called at closure of picture
#  $be->close([$rem])
#
sub close
{
   my $r_be = shift;
   my ($rem) = @_;

   if ($r_be->{"type"} == $BE_PS)
   {
       sprintf "%% end of chem pic%s\n", $rem ? "  ($rem)" : "";
   }
   if ($r_be->{"type"} == $BE_PSLATEX || $r_be->{"type"} == $BE_LATEX)
   {
       sprintf "}\\end{picture}}\%%s\n", $rem ? "  %%$rem" : "";
   }
}


#
#  called after drawing data was written, but before text is wrote
#  $be->inter([$rem])
#
sub inter
{
   my $r_be = shift;
   my ($rem) = @_;

   if ($r_be->{"type"} == $BE_PS || $r_be->{"type"} == $BE_LATEX)
   {
       sprintf "\n";
   }
   elsif ($r_be->{"type"} == $BE_PSLATEX)
   {
       sprintf "} %% end of special%s\n", $rem ? "  ($rem)" : "";
   }
}

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.