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;