# graphtex.pl - library file for gt
#
# $Id: graphtex.pl,v 1.5 1994/02/02 22:55:33 pliam Exp $
#

###########################################################################
# define constants, and routine &defaults which returns to defaults
###########################################################################
%symtab = ( # like a global symbol table
   'drawdim',   'mm',   # drawing dimension
   'linewd',    '0.3',  # line width
   'txtrefh',   '',     # horizontal text reference parameter (L, C, R)
   'txtrefv',   '',     # vertical text reference command (T, C, B)
   'vertstr',   '1.0',  # vertical stretch
   'arrowwd',   '2.0',  # arrowhead width
   'arrowln',   '2.0',  # arrowhead length
   'arrowdp',   '1.0',  # arrowhead depth (length where wings meet)
   'verrad',    '0.75', # vertex radius
   'versep',    '10',   # vertex separation
   'txtoff',    '2.0',  # text offset
   'bezfact',   '0.75', # Bezier curve stretch factor
   'edgmu',     '0.5',  # how far to move along edge before arrow
   'labelmu',   '0.5',	# how far to move along edge before label
   'loopln',    '10',   # dimensions of rectangle enclosing loop
   'loopwd',    '15',   #                  "
   'loopmu',    '0.18', # how far to move along loop before arrow
   'llabelmu',  '0.5',	# how far to move along loop before label
   'stubrat',   '0.5',	# fraction of \versep to draw \stub or \from
   'inverrat',  '0.75',	# ratio of inner to outer radius for \dblver
   'boxwd',     '1.5',	# width of a \box
   'boxht',     '1.5'	# height of a \box
);
sub defaults {
   $drawdim = $symtab{'drawdim'}; # O would that it were Perl 5
   $linewd = $symtab{'linewd'};
   $txtrefh = $symtab{'txtrefh'};
   $txtrefv = $symtab{'txtrefv'};
   $vertstr = $symtab{'vertstr'};
   $arrowwd = $symtab{'arrowwd'};
   $arrowln = $symtab{'arrowln'};
   $arrowdp = $symtab{'arrowdp'};
   $verrad = $symtab{'verrad'};
   $versep = $symtab{'versep'};
   $txtoff = $symtab{'txtoff'};
   $bezfact = $symtab{'bezfact'};
   $edgmu = $symtab{'edgmu'};
   $labelmu = $symtab{'labelmu'};
   $loopln = $symtab{'loopln'};
   $loopwd = $symtab{'loopwd'};
   $loopmu = $symtab{'loopmu'};
   $llabelmu = $symtab{'llabelmu'};
   $stubrat = $symtab{'stubrat'};
   $inverrat = $symtab{'inverrat'};
   $boxwd = $symtab{'boxwd'};
   $boxht = $symtab{'boxht'};
}

###########################################################################
# Crunch support
###########################################################################

$pi = 3.141592654;
sub tan { # assumes cos($x) is never zero, which it shouldn't here
   local($x) = @_;

   return sin($x)/cos($x);
}
sub norm { # Euclidean norm
   local($x, $y) = @_;

   return sqrt($x**2 + $y**2);
}
sub bezier { # parametric eqn for Bezier
   local($z0, $z1, $z2, $z3, $mu) = @_;

   return (1-$mu)**3*$z0 + 3*$mu*(1-$mu)**2*$z1 + 3*$mu**2*(1-$mu)*$z2
          + $mu**3*$z3;
}
sub bezDot { # its derivative
   local($z0, $z1, $z2, $z3, $mu) = @_;

   return -3*(1-$mu)**2*$z0 + 3*(1-4*$mu+3*$mu**2)*$z1 + 3*$mu*(2-3*$mu)*$z2
          + 3*$mu**2*$z3;
}

###########################################################################
# Drawing Commands
###########################################################################

#
# figure out the text reference parameters
#
sub quad { # the circle is divided up into 12 regions
   local($th) = @_;
   local($q);
   local(@refof) = (
      'L C',
      'L B',
      'L B',
      'C B',
      'R B',
      'R B',
      'R C',
      'R T',
      'R T',
      'C T',
      'L T',
      'L T'
   );

   $q = 12*($th + 2*$pi/24)/(2*$pi);
   $q = ($q + 12) % 12; # watch out for dumb mod!
   return $refof[$q];
}
sub txtRefH {
   local($th) = @_;
   local($str) = &quad($th);

   $str =~ s/(\w)\s+(\w)/\1/;
   return $str;
}
sub txtRefV {
   local($th) = @_;
   local($str) = &quad($th);

   $str =~ s/(\w)\s+(\w)/\2/;
   return $str;
}

#
# arrow with spaded shape
#
sub spadeTip {
   local($xcen, $ycen, $xtip, $ytip) = @_;
   local($xl, $yl, $xr, $yr, $th, $ph, $winglen);

   # the wing points
   $th = atan2($ytip-$ycen, $xtip-$xcen);
   $winglen = &norm($arrowln, $arrowwd/2);
   $ph = atan2($arrowwd/2, $arrowln);
   $xl = $xtip - $winglen*cos($ph - $th);
   $yl = $ytip + $winglen*sin($ph - $th);
   $xr = $xtip - $winglen*cos($ph + $th);
   $yr = $ytip - $winglen*sin($ph + $th);

   # draw it
   printf OUT "\\move (%f %f)\n", $xtip, $ytip;
   printf OUT "\\lvec (%f %f)\n", $xl, $yl;
   printf OUT "\\lvec (%f %f)\n", $xcen, $ycen;
   printf OUT "\\lvec (%f %f)\n", $xr, $yr;
   printf OUT "\\lvec (%f %f)\n", $xtip, $ytip;
   print OUT "\\lfill f:0\n";
}

#
# straight edge relative to (0,0), in units of drawdim
#
sub strghtEdg {
   local($xini, $yini, $xfin, $yfin, $arr, $tskew, $lab, $isline) = @_;
   local($th, $xtruini, $ytruini, $xtrufin, $ytrufin, $Dx, $Dy);
   local($trefh, $trefv, $quang);

   #
   # calculate some crucial geometric quantities
   # 
   $th = atan2(($yfin - $yini), ($xfin - $xini));
   $xtruini = $xini + $isline*$verrad*cos($th);
   $ytruini = $yini + $isline*$verrad*sin($th);
   $xtrufin = $xfin - $isline*$verrad*cos($th);
   $ytrufin = $yfin - $isline*$verrad*sin($th);
   $Dx = $xtrufin - $xtruini;
   $Dy = $ytrufin - $ytruini;
   #
   # draw edge
   #
   printf OUT "\\move (%f %f)\n", $xtruini, $ytruini;
   printf OUT "\\lvec (%f %f)\n", $xtrufin, $ytrufin;
   #
   # draw arrow
   #
   if ($arr) {
      if ($edgmu == 1) {
         &spadeTip(
            $xtrufin - $arrowdp*cos($th), 
            $ytrufin - $arrowdp*sin($th),
            $xtrufin,
            $ytrufin
         );
      }
      else {
         &spadeTip(
            $xtruini + $edgmu*$Dx,
            $ytruini + $edgmu*$Dy,
            $xtruini + $edgmu*$Dx + $arrowdp*cos($th), 
            $ytruini + $edgmu*$Dy + $arrowdp*sin($th)
         );
      }
   }
   #
   # draw label
   #
   if ($lab) {
      printf OUT "\\move (%f %f)\n", $xtruini + $labelmu*$Dx,
                                     $ytruini + $labelmu*$Dy;
      printf OUT "\\rmove (%f %f)\n", -$tskew*$txtoff*sin($th),
                                      $tskew*$txtoff*cos($th);
      $quang = atan2($tskew*cos($th), -$tskew*sin($th));
      $trefh = &txtRefH($quang); $trefv = &txtRefV($quang);
      $trefh = $txtrefh if ($txtrefh);
      $trefv = $txtrefv if ($txtrefv);
      printf OUT "\\textref h:$trefh v:$trefv \\htext{\$ $lab \$}\n";
   }
}

#
# Bezier edge relative to (0,0), in units of drawdim
#
sub bezierEdg {
   local($xini, $yini, $xfin, $yfin, $arr, $skew, $lab, $isline) = @_;
   local($x0, $y0, $x1, $y1, $x2, $y2, $x3, $y3);
   local($Dx, $Dy, $th, $ph, $D);
   local($xdot, $ydot, $delmu, $psi);
   local($trefh, $trefv, $quang);

   #
   # calculate some crucial geometric quantities
   # 
   $Dx = $xfin - $xini; $Dy = $yfin - $yini;
   $th = atan2($Dy, $Dx);
   $ph = atan2($bezfact*$skew, 1);
   $D = (1/3)*&norm($Dx, $Dy);
   #
   # calculate all critical points of the Bezier curve 
   #
   $x0 = $xini + $isline*$verrad*cos($th + $ph);
   $y0 = $yini + $isline*$verrad*sin($th + $ph);
   $x1 = $xini + $D*(cos($th) - &tan($ph)*sin($th));
   $y1 = $yini + $D*(sin($th) + &tan($ph)*cos($th));
   $x2 = $x1 + (1/3)*$Dx;
   $y2 = $y1 + (1/3)*$Dy;
   $x3 = $xfin - $isline*$verrad*cos($th - $ph);
   $y3 = $yfin - $isline*$verrad*sin($th - $ph);
   #
   # draw the edge
   #
   printf OUT "\\move (%f %f)\n", $x0, $y0;
   printf OUT "\\clvec (%f %f)(%f %f)(%f %f)\n", $x1, $y1, $x2, $y2, $x3, $y3;
   #
   # draw the arrow
   #
   if ($arr) {
      $xdot = &bezDot($x0, $x1, $x2, $x3, $edgmu);
      $ydot = &bezDot($y0, $y1, $y2, $y3, $edgmu);
      $delmu = $arrowdp/(&norm($xdot, $ydot));
      if ($edgmu == 1) {
         &spadeTip(
            &bezier($x0, $x1, $x2, $x3, $edgmu - $delmu), 
            &bezier($y0, $y1, $y2, $y3, $edgmu - $delmu),
            &bezier($x0, $x1, $x2, $x3, $edgmu),
            &bezier($y0, $y1, $y2, $y3, $edgmu)
         );
      }
      else { 
         &spadeTip(
            &bezier($x0, $x1, $x2, $x3, $edgmu), 
            &bezier($y0, $y1, $y2, $y3, $edgmu),
            &bezier($x0, $x1, $x2, $x3, $edgmu + $delmu),
            &bezier($y0, $y1, $y2, $y3, $edgmu + $delmu)
         );
      }
   }
   #
   # draw label
   #
   if ($lab) {
      printf OUT "\\move (%f %f)\n", &bezier($x0, $x1, $x2, $x3, $labelmu),
         &bezier($y0, $y1, $y2, $y3, $labelmu);
      $xdot = &bezDot($x0, $x1, $x2, $x3, $labelmu);
      $ydot = &bezDot($y0, $y1, $y2, $y3, $labelmu);
      $psi = atan2($ydot, $xdot);
      printf OUT "\\rmove (%f %f)\n", -$skew*$txtoff*sin($psi), 
         $skew*$txtoff*cos($psi);
      $quang = atan2($skew*cos($psi), -$skew*sin($psi));
      $trefh = &txtRefH($quang); $trefv = &txtRefV($quang);
      $trefh = $txtrefh if ($txtrefh);
      $trefv = $txtrefv if ($txtrefv);
      print OUT "\\textref h:$trefh v:$trefv \\htext{\$ $lab \$}\n"; 
   }
   #
   # additional move to help bounding box
   #
   printf OUT "\\move (%f %f)\n", &bezier($x0, $x1, $x2, $x3, 0.5),
      &bezier($y0, $y1, $y2, $y3, 0.5);
}

sub bezLoop {
   local($x, $y, $th, $lab) = @_;
   local($x0, $y0, $x1, $y1, $x2, $y2, $x3, $y3, $ph, $winglen);
   local($xdot, $ydot, $psi);
   local($trefh, $trefv, $quang);

   #
   # calculate critical points
   #
   $ph = atan2($loopwd/2, $loopln);
   $winglen = &norm($loopln, $loopwd/2);
   $x0 = $x + $verrad*cos($th - $ph);
   $y0 = $y + $verrad*sin($th - $ph);
   $x1 = $x + $winglen*cos($th - $ph);
   $y1 = $y + $winglen*sin($th - $ph);
   $x2 = $x + $winglen*cos($th + $ph);
   $y2 = $y + $winglen*sin($th + $ph);
   $x3 = $x + $verrad*cos($th + $ph);
   $y3 = $y + $verrad*sin($th + $ph);
   #
   # draw edge
   #
   printf OUT "\\move (%f %f)\n", $x0, $y0;
   printf OUT "\\clvec (%f %f)(%f %f)(%f %f)\n", $x1, $y1, $x2, $y2, $x3, $y3;
   #
   # draw arrow
   #
   $xdot = &bezDot($x0, $x1, $x2, $x3, $loopmu);
   $ydot = &bezDot($y0, $y1, $y2, $y3, $loopmu);
   $delmu = $arrowdp/(&norm($xdot, $ydot));
   if ($loopmu == 1) {
      &spadeTip(
         &bezier($x0, $x1, $x2, $x3, $loopmu - $delmu),
         &bezier($y0, $y1, $y2, $y3, $loopmu - $delmu),
         &bezier($x0, $x1, $x2, $x3, $loopmu),
         &bezier($y0, $y1, $y2, $y3, $loopmu)
      );
   }
   else {
      &spadeTip(
         &bezier($x0, $x1, $x2, $x3, $loopmu),
         &bezier($y0, $y1, $y2, $y3, $loopmu),
         &bezier($x0, $x1, $x2, $x3, $loopmu + $delmu),
         &bezier($y0, $y1, $y2, $y3, $loopmu + $delmu)
      );
   } 
   #
   # draw label
   #
   if ($lab) {
      printf OUT "\\move (%f %f)\n", &bezier($x0, $x1, $x2, $x3, $llabelmu),
         &bezier($y0, $y1, $y2, $y3, $llabelmu);
      $xdot = &bezDot($x0, $x1, $x2, $x3, $llabelmu);
      $ydot = &bezDot($y0, $y1, $y2, $y3, $llabelmu);
      $psi = atan2($ydot, $xdot);
      printf OUT "\\rmove (%f %f)\n", $txtoff*sin($psi), -$txtoff*cos($psi);
      $quang = atan2(-cos($psi), sin($psi));
      $trefh = &txtRefH($quang); $trefv = &txtRefV($quang);
      $trefh = $txtrefh if ($txtrefh);
      $trefv = $txtrefv if ($txtrefv);
      print OUT "\\textref h:$trefh v:$trefv \\htext{\$ $lab \$}\n";
   }
   #
   # additional move to help bounding box
   #
   printf OUT "\\move (%f %f)\n", &bezier($x0, $x1, $x2, $x3, 0.5),
      &bezier($y0, $y1, $y2, $y3, 0.5);
}

###########################################################################
# Parsing Commands
###########################################################################

#                      u                ^     
#                      |                |
# displacements:   l --+-- r   or   < --+-- >
#                      |                |
#                      d               {v,_}
sub xdisp {
   local($s) = @_;
   
   $s =~ s/l/-1/g;
   $s =~ s/r/+1/g;
   $s =~ s/u/+0/g;
   $s =~ s/d/+0/g;

   $s =~ s/</-1/g;
   $s =~ s/>/+1/g;
   $s =~ s/\^/+0/g;
   $s =~ s/v/+0/g;
   $s =~ s/_/+0/g;

   return eval($s);
}
sub ydisp {
   local($s) = @_;
   
   $s =~ s/l/+0/g;
   $s =~ s/r/+0/g;
   $s =~ s/u/+1/g;
   $s =~ s/d/-1/g;

   $s =~ s/</+0/g;
   $s =~ s/>/+0/g;
   $s =~ s/\^/+1/g;
   $s =~ s/v/-1/g;
   $s =~ s/_/-1/g;

   return eval($s);
}

sub strip { # strip off { and } from math mode expression
   local($st) = @_;

   $st =~ s/^\{//;
   $st =~ s/\}$//;
   return $st;
}

sub vertex {
   local($x, $y, $label, $ori, $type) = @_;
   local($th, $trefh, $trefv);

   #
   # draw vertex always
   #
   printf OUT "\\move (%f %f)\n", $x, $y;
   printf OUT "\\lcir r:%f\n", $verrad;
   if ($type eq 'double') {
      printf OUT "\\lcir r:%f\n", $inverrat*$verrad;
   }
   if ($type eq 'solid') {
      printf OUT "\\fcir f:0 r:%f\n", $verrad;
   }
   #
   # draw label if necessary
   #
   if ($label) {
      $th = atan2(&ydisp($ori), &xdisp($ori));
      printf OUT "\\rmove (%f %f)\n", $txtoff*cos($th), $txtoff*sin($th);
 
      $trefh = &txtRefH($th); $trefv = &txtRefV($th);
      $trefh = $txtrefh if ($txtrefh);
      $trefv = $txtrefv if ($txtrefv);

      printf OUT "\\textref h:$trefh v:$trefv \\htext{\$%s\$}\n", 
                 $label;
   }
}

sub loop {
   local($x, $y, $oristr, $label) = @_;

   &bezLoop(
      $x,
      $y,
      atan2(&ydisp($oristr), &xdisp($oristr)),
      $label
   );
}

sub stub {
   local($x, $y, $xfin, $yfin, $arrow) = @_;
   local($xini, $yini, $th);

   print OUT "% arrow = $arrow\n";
   $th = atan2($yfin - $y, $xfin - $x);
   $xini = $x + $verrad*cos($th);
   $yini = $y + $verrad*sin($th);
   #
   # draw line stroke
   #
   printf OUT "\\move (%f %f)\n", $xini, $yini;
   printf OUT "\\lvec (%f %f)\n", $xfin, $yfin;
   #
   # draw arrow if necessary
   #
   if ($arrow) {
      &spadeTip(
         $xini + $arrowdp*cos($th),
         $yini + $arrowdp*sin($th),
         $xini,
         $yini
      );
   }
}

sub box {
   local($x, $y) = @_;

   printf OUT "\\move (%f %f)\n", $x + 0.5*$boxwd, $y + 0.5*$boxht;
   printf OUT "\\rlvec (%f %f)\n", 0, -$boxht;
   printf OUT "\\rlvec (%f %f)\n", -$boxwd, 0;
   printf OUT "\\rlvec (%f %f)\n", 0, $boxht;
   printf OUT "\\rlvec (%f %f)\n", $boxwd, 0;
}

sub mmode {
   local($x, $y, $expr) = @_;
   local($trefh, $trefv);

   printf OUT "\\move (%f %f)\n", $x, $y;
   $trefh = 'C'; $trefv = 'C';
   $trefh = $txtrefh if ($txtrefh);
   $trefv = $txtrefv if ($txtrefv);
   printf OUT "\\textref h:$trefh v:$trefv \\htext{\$ %s \$}\n", $expr; 
}

###########################################################################
# The Main Parsing Routine
###########################################################################

sub parse {
   local($obj, $pat);
   local($currx, $curry, $destx, $desty);

   #
   # preamble
   #
   &defaults;
   print OUT "%\n";
   print OUT "% These commands generated by GraphTeX.\n";
   print OUT "% (c) 1993, 1994 John Pliam.\n";
   print OUT "% All rights reversed.\n";
   print OUT "%\n";
   print OUT "\\vcenter{\\btexdraw\n";
   print OUT "\\drawdim $drawdim\n";
   printf OUT "\\linewd %f\n", $linewd;

   #
   # loop through keys(%connect)
   #
   foreach $obj (sort keys(%connect)) {
      &defaults; # scope of local changes is within &'s
      ($currx, $curry) = split(/\s+/, $posit{$obj});
      print OUT "% cx = $currx, cy = $curry\n" if ($db);
      foreach $pat (split(/\s+/, $connect{$obj})) {
         print OUT "% pat = :$pat:\n" if ($db);
         #
         # match \gtset{\var}{val}
         #
         if ($pat =~ /\\gtset\{\\([^\}]+)\}\{([^\}]+)\}\s*$/) {
            print OUT "% gtset $1, $2\n";
            eval('$'."$1 = $2");
         }
         #
         # match vertex, e.g. \ver^{f(x)}
         #
         elsif (($pat =~ /\\ver/) 
             || ($pat =~ /\\dblver/) 
             || ($pat =~ /\\solver/)) {
            $ori = ''; $label = ''; $type = '';

            $type = 'double' if ($pat =~ /\\dblver/);
            $type = 'solid' if ($pat =~ /\\solver/);

            if ($' =~ /([<>^_v]+)(.*)/) {
               $label = &strip($2);
               $ori = $1; # label orientation
            }
            &vertex($currx, $curry, $label, $ori, $type);
         }
         #
         # match self-loop, \loop(^){\frac{1}{0}}
         #
         elsif ($pat =~ /\\loop\(([^\)]+)\)/) {
            $label = '';
            $ori = $1;
            print OUT "% ";
            printf OUT "ori = %s, (%d, %d)\n", $ori,
               &xdisp($ori),
               &ydisp($ori);
            if ($') {
               $label = $';
               $label =~ s/^[_\^]//;
               $label = &strip($label); 
            }
            &loop($currx, $curry, $ori, $label);
         }
         #
         # match edge, e.g. \uurto(+)_{\alpha}, \edg<ob>(-)_{a}
         #
         elsif (($pat =~ /^\\[lrud]*to/) 
                || ($pat =~ /^\\[lrud]*edg/) 
                || ($pat =~ /^\\[lrud]*stick/)) {
            $bend = ''; $labori = ''; $label = ''; $arrow = ''; $isline = 1.0;

            $pat =~ /^\\([lrud]*)/;
	    $disp = $1;
            $rest = $'; print OUT "% rest = $rest\n" if ($db);
            if ($rest =~ /edg/) { $rest = $'; }
            elsif ($rest =~ /to/) {
               $rest = $'; print OUT "% rest = $rest\n" if ($db);
               $arrow = 'arrow';
            }
            else { 
               $rest = $';
               $isline = 0.0;
            }

            if ($disp) { # relative displacement
               print OUT "% matched \\[lrud]+to\n" if ($db);
               $destx = $currx + &xdisp($disp)*$versep;
               $desty = $curry + &ydisp($disp)*$versep*$vertstr;
            }
            else { # absolute displacement
               print OUT "% matched \to<obj>\n" if ($db);
               if ($rest =~ /<([^>]+)>/) {
                  $obj = $1;
                  $rest = $'; print OUT "% rest = $rest\n" if ($db);
                  ($destx, $desty) = split(/\s+/, $posit{$obj});
               }
            }
            if ($rest =~ /^\(([-\+])\)/) { # bend (+) or (-)
               $bend = eval("$1 1.0");
               $rest = $'; print OUT "% rest = $rest\n" if ($db);
            }
            if ($rest =~ /([\^_])(.*)/) { # label
               $labori = $1;
               $label = &strip($2);
               $labori =~ s/\^/+/; $labori =~ s/_/-/;
               $tskew = eval("$labori 1.0");
            }
            #
            # call &bezierEdg or &strghtEdg depending
            #
            if ($bend) {
               &bezierEdg($currx, $curry, $destx, $desty, 
                          $arrow, $bend, $label, $isline);
            }
            else {
               &strghtEdg($currx, $curry, $destx, $desty, 
                          $arrow, $tskew, $label, $isline);
            }
         }
         #
         # match \stub or \from
         #
         elsif (($pat =~ /\\[lrud]+stub/) || ($pat =~ /\\[lrud]+from/)) {
            $arrow = '';
            $pat =~ /\\([lrud]+)/;
            $disp = $1; $rest = $';
            if ($rest =~ /from/) { $arrow = 'arrow'; }
            $destx = $currx + &xdisp($disp)*$stubrat*$versep;
            $desty = $curry + &ydisp($disp)*$stubrat*$versep*$vertstr;
            &stub($currx, $curry, $destx, $desty, $arrow);
         }
         #
         # match \box
         #
         elsif ($pat =~ /\\box/) {
            &box($currx, $curry);
         }
         #
         # assume anything else to be a math mode expression
         #
         else {
            &mmode($currx, $curry, $pat);
	 }
      }
   }
   print OUT "\\etexdraw}\n";
}

1;
