#!/usr/bin/perl -w
# CABpict.pl
# (c) Copyright 2006 by H. Moeller (mollerh@math.uni-muenster.de).
# Version 1.2 for Cabri-g�om�tre II with MacOS 9.x, Virtual Printer as PostScript driver, MacPerl 5.6, and LATEX-packages 'pict2e' and 'ebezier'.
# This program may be distributed and/or modified under the conditions of the LaTeX Project Public License, either version 1.3 of this license or (at your option) any later version.
# The latest version of this license is in http://www.latex-project.org/lppl.txt.
# This program has the LPPL maintenance status "maintained". The Current Maintainer of this program is H. M�ller.
#
use POSIX('ceil','floor');
#________________________________________________________
# Definable by the user:
# Unitlength in pt:
$ul = 1.0;
# Fill factor (for filling with magnification up to 500%)
$fillf = 5;
# Point factor:
$pointf = 0.3;
# Flag for the dotting of parabolic arcs (1: Dotting)
$Qbezflag = 0;
#________________________________________________________
# Constants:
# Color names:
$yellow = "0.9843900.9511410.020249";
$orange = "1.0000000.3927370.009949";
$red = "0.8649270.0342110.025910";
$purple = "0.9486080.0325630.519234";
$violet = "0.2769050.0000000.645487";
$navy = "0.0000000.0000000.828138";
$blue = "0.0088040.6692610.917967";
$green = "0.1215990.7170980.078874";
$darkgreen = "0.0000000.3933010.069093";
$darkbrown = "0.3359430.1742730.020081";
$brown = "0.5657890.4428780.227359";
#________________________________________________________
# Further Constants:
# Pi:
$Pi = "3.14159265358979";
# Floor of the tenth part of the greatest integer of Perl
$gi = 214748364;
# Constants in dotted figures:
$uli = sp(4 / $ul);
$ule = sp(0.8 / $ul);
#________________________________________________________
@lines = <>;
do {
  $_ = $lines[$i++];
  if (/ setrgbcolor \s/o) {
    s/ //go;
    s/setrgbcolor\s/ /o;
    $c = $_;
    $_ = $lines[$i++];
    s/ moveto//o;
    s/lineto stroke/stroke/o;
    s/curveto stroke/curveto/o;
    s/ setlinewidth stroke//o;
    s/ lineto//go;
    if (/stroke/o) {
      $line[++$#line] = $c.$_;
    }
    elsif (/closepath fill/o) {
      $vector[++$#vector] = $c.$_;
    }
    elsif (/arc /o) {
      $circle[++$#circle] = $c.$_;
    }
    elsif (/arcn/o) {
      $arc[++$#arc] = $c.$_;
    }
    elsif (/curveto/o) {
      do {
        $conic[++$#conic] = $c.$_;
        $_ = $lines[$i++];
        s/ moveto//o;
        s/curveto stroke/curveto/o;
      }
      until $_ !~ /curveto/o;
    }
  }
}
until $i == $#lines;
#
$pflag = 1;
$sflag = 1;
$thicknessflag = 1;
$coun = 0;
$xtex = "";
$mtex = "";
#________________________________________________________
# Lines and polygons
$cflag = 1;
foreach (@line) {
  @coo = split;
  $co0 = $coo[0];
  $co2 = (-1) * $coo[2];
  $co4 = (-1) * $coo[4];
  if (($co0 ne $violet) and ($co0 ne $yellow)) {
    if ($cflag) {
      $xtex .= "%Lines, arrows, polygons and Bezier curves\n";
      $cflag = 0;
    }
    if ($co0 ne $blue) {
      bound($coo[1],$co2);
      bound($coo[3],$co4);
    }
    if (($co0 ne $red) and ($co0 ne $blue) and ($co0 ne $brown)
      and ($co0 ne $darkbrown) and ($co0 ne $navy)) {
      lin($co0,$coo[1],$co2,$coo[3],$co4);
    }
    if (($co0 ne $green) and ($co0 ne $darkgreen)) {
      if ($pflag) {
        $cb1 = $coo[1];
        $cb2 = $co2;
        $pol = $co0." ".$cb1." ".$cb2;
        $pflag = 0;
      }
      else {
        $pol .= " ".$coo[1]." ".$co2;
        if (abs($coo[3] - $cb1) + abs($co4 - $cb2) < 2.0E-6) {
          $poly[++$#poly] = $pol;
          $pflag = 1;
        }
      }
    }
  }
  if ($co0 eq $violet) {
      $xtex .= "%Arrow\n";
      bound($coo[1],$co2);
      bound($coo[3],$co4);
      $dx = $coo[3] - $coo[1];
      $dy = $co4 - $co2;
      $len = sp(abs($dx));
      if ($len > 1.0E-3) {
        @p = best(abs($dy / $dx));
        $psx = sp($p[1]) * ($dx <=> 0);
        $psy = sp($p[0]) * ($dy <=> 0);
      }
      else {
        $psx = 0;
        $psy = ($dy <=> 0);
        $len = sp(abs($dy));
      }
      $xb = sp($coo[1]);
      $yb = sp($co2);
      if (not $thicknessflag) {
        $xtex .= "\\linethickness{0.8pt}\n";
        $thicknessflag = 1;
      }
      $xtex .= "\\put(".$xb.",".$yb."){\\vector(".$psx.",".$psy."){".$len."}}\n";  
  }
}
#
foreach (@poly) {
  @po = split;
  $p0 = $po[0];
  $pon = $#po;
  if (($p0 eq $red) or ($p0 eq $purple) or ($p0 eq $darkbrown)
    or ($p0 eq $orange) or ($p0 eq $brown)) {
    if ($pon == 6) {
      tri($p0,$po[1],$po[2],$po[3],$po[4],$po[5],$po[6]);
    }    
    elsif ($pon == 8) {
      ($p0,$u1,$v1,$u2,$v2,$u3,$v3,$u4,$v4) = @po;
      $s1 =  abs($u1 - $u4) + abs($u2 - $u3) + abs($v1 - $v2) + abs($v3 -$v4);
      $s2 =  abs($u1 - $u2) + abs($u3 - $u4) + abs($v1 - $v4) + abs($v2 -$v3);
      if (($s1 < 4.0E-6) or ($s2 < 4.0E-6)) {
        bound($u1,$v1);
        bound($u3,$v3);
        rect($p0,$u1,$v1,$u2,$v2,$u3,$v3,$u4,$v4);
      }
      else {
        bound($u1,$v1);
        bound($u2,$v2);
        bound($u3,$v3);
        bound($u4,$v4);
        tri($p0,$u1,$v1,$u2,$v2,$u3,$v3);
        tri($p0,$u1,$v1,$u3,$v3,$u4,$v4);
      }
    }
    elsif ($pon > 8) {
      bound($po[1],$po[2]);
      for (my $j = 3; $j <= $pon - 3; $j += 2) {
        bound($po[$j],$po[$j + 1]);
        tri($p0,$po[1],$po[2],$po[$j],$po[$j + 1],$po[$j + 2],$po[$j + 3]);
      }
      bound($po[$pon - 1],$po[$pon]);
    }
  }
  elsif ($p0 eq $navy) {
    for (my $j = 1; $j <= $pon - 3; $j +=2) {
      lin($p0,$po[$j],$po[$j + 1],$po[$j + 2],$po[$j + 3]);
    }
  }
  elsif ($p0 eq $blue) {
    if ($pon == 4) {
# Text marker and Bezier curves
    $coun++;
    $bo3 = $po[1] + ($po[3] - $po[1]) / $ul;
    $bo4 = $po[2] + ($po[4] - $po[2]) / $ul;
    bound($po[1],$po[2]);
    bound($bo3,$bo4);
    $po1 = sp($po[1]);
    $po2 = sp($po[2]);
    $mtex .= "\\put(".$po1.",".$po2."){".$coun."}\n";
      }  
    elsif ($pon == 6) {
      $xtex .= "%Quadratic Bezier curve\n";
      qbez($po[1],$po[2],$po[3],$po[4],$po[5],$po[6]);
    }
    elsif ($pon == 8) {
      $xtex .= "%Cubic Bezier curve\n";
      cbez($po[1],$po[2],$po[3],$po[4],$po[5],$po[6],$po[7],$po[8]);
    }
  }
}
#________________________________________________________
# Arrows
foreach (@vector) {
  @ve = split;
  if ($ve[0] eq $darkgreen) { 
    if ($cflag) {
      $xtex .= "%Arrow\n";
      $cflag = 0;
    }  
    $ve[2] = (-1) * $ve[2];
    $ve[4] = (-1) * $ve[4];
    $ve[6] = (-1) * $ve[6];
    $ve[8] = (-1) * $ve[8];
    bound($ve[1],$ve[2]);
    bound($ve[3],$ve[4]);
    bound($ve[7],$ve[8]);
    $vu0 = $ve[5] + ($ve[1] - $ve[5]) / $ul;
    $vu1 = $ve[6] + ($ve[2] - $ve[6]) / $ul;
    $vu2 = $ve[5] + ($ve[3] - $ve[5]) / $ul;
    $vu3 = $ve[6] + ($ve[4] - $ve[6]) / $ul;
    $vu6 = $ve[5] + ($ve[7] - $ve[5]) / $ul;
    $vu7 = $ve[6] + ($ve[8] - $ve[6]) / $ul;
    tri($red,$vu0,$vu1,$vu2,$vu3,$ve[5],$ve[6]);
    tri($red,$vu0,$vu1,$vu6,$vu7,$ve[5],$ve[6]);
  }
}
#________________________________________________________
# Conics
$cflag = 1;
foreach (@conic) {
  @po = split;
  $p0 = $po[0];
  if ($p0 ne $yellow) {
    if ($cflag) {
      $xtex .= "%Conics\n";
      $cflag = 0;
    }
    $po[2] = (-1) * $po[2];
    $po[4] = (-1) * $po[4];
    $po[6] = (-1) * $po[6];
    $po[8] = (-1) * $po[8];
    cbez($po[1],$po[2],$po[3],$po[4],$po[5],$po[6],$po[7],$po[8]);
  }
}
#________________________________________________________
# Circles, halves and quarters of circles
$cflag = 1;
$aflag = 1;
foreach (@circle) {
  @po = split;
  $p0 = $po[0];
  if ($p0 ne $yellow) {
    $po[2] = (-1) * $po[2];
    $di = 2 * $po[3];
    if ($po[4] > 1.0E-3 or abs($po[5] - 360) > 1.0E-3) {
      if ($aflag) {
        $xtex .= "%Arcs\n";
        $aflag = 0;
      }
      $arce = ($po[4] > 0) ? 360 - $po[4] : 0;
      $arcb = ($po[5] > 0) ? 360 - $po[5] : 0;
      $darc = $arce - $arcb;
      if ($darc < 0) {$darc += 360}
      $quar = int($darc / 90);
      if ($quar > 0) {
        for (my $k = 1; $k <= $quar; $k++) {
          arc($p0,$po[1],$po[2],$po[3],$arcb,$arcb + 90);
          $arcb += 90;
          if ($arcb > 360) {$arcb -= 360}
        }
      }
      if ($darc > $quar * 90) {
        arc($p0,$po[1],$po[2],$po[3],$arcb,$arce);
      }
    }
    else {
      if ($cflag) {
      $xtex .= "%Circles, halves and quarters of circles\n";
      $cflag = 0;
      }
      if ($p0 eq $navy) {
        $xtex .= "\\put(".$po[1].",".$po[2]."){\\circle{".$di."}}\n";
        bound($po[1] + $po[3],$po[2] + $po[3]);
        bound($po[1] + $po[3],$po[2] - $po[3]);
        bound($po[1] - $po[3],$po[2] + $po[3]);
        bound($po[1] - $po[3],$po[2] - $po[3]);    
      }
      elsif ($p0 eq $purple) {
        $xtex .= "\\put(".$po[1].",".$po[2]."){\\oval[".$di."](".$di.",".$di.")[l]}\n";
        bound($po[1],$po[2] + $po[3]);
        bound($po[1] - $po[3],$po[2] - $po[3]);
      }
      elsif ($p0 eq $red) {
        $xtex .= "\\put(".$po[1].",".$po[2]."){\\oval[".$di."](".$di.",".$di.")[r]}\n";
        bound($po[1],$po[2] - $po[3]);
        bound($po[1] + $po[3],$po[2] + $po[3]);
      }
      elsif ($p0 eq $orange) {
        $xtex .= "\\put(".$po[1].",".$po[2]."){\\oval[".$di."](".$di.",".$di.")[b]}\n";
        bound($po[1] - $po[3],$po[2] - $po[3]);
        bound($po[1] + $po[3],$po[2]);
      }
      elsif ($p0 eq $darkbrown) {
        $xtex .= "\\put(".$po[1].",".$po[2]."){\\oval[".$di."](".$di.",".$di.")[t]}\n";
        bound($po[1] - $po[3],$po[2]);
        bound($po[1] + $po[3],$po[2] + $po[3]);
      }
      elsif ($p0 eq $blue) {
        $xtex .= "\\put(".$po[1].",".$po[2]."){\\oval[".$di."](".$di.",".$di.")[bl]}\n";
        bound($po[1] - $po[3],$po[2]);
        bound($po[1],$po[2] - $po[3]);
      }
      elsif ($p0 eq $green) {
        $xtex .= "\\put(".$po[1].",".$po[2]."){\\oval[".$di."](".$di.",".$di.")[tl]}\n";
        bound($po[1] - $po[3],$po[2]);
        bound($po[1],$po[2] + $po[3]);
      }
      elsif ($p0 eq $brown) {
        $xtex .= "\\put(".$po[1].",".$po[2]."){\\oval[".$di."](".$di.",".$di.")[br]}\n";
        bound($po[1],$po[2] - $po[3]);
        bound($po[1] + $po[3],$po[2]);
      }
      elsif ($p0 eq $violet) {
        $xtex .= "\\put(".$po[1].",".$po[2]."){\\oval[".$di."](".$di.",".$di.")[tr]}\n";
        bound($po[1] + $po[3],$po[2]);
        bound($po[1],$po[2] + $po[3]);
      }
      elsif ($p0 eq $darkgreen) {
        $r = $po[3];
        $le = int(2 * $pointf * $ul * $Pi * $r);    
        $xtex .= "\\cCircle[".$le."](".$po[1].",".$po[2]."){".$r."}[f]\n";
        bound($po[1] + $r,$po[2] + $r);
        bound($po[1] + $r,$po[2] - $r);
        bound($po[1] - $r,$po[2] + $r);
        bound($po[1] - $r,$po[2] - $r);
      }
    }
  }
}
#________________________________________________________
# Arcs
$aflag = 1;
foreach (@arc) {
  @po = split;
  if ($aflag) {
    $xtex .= "%Arcs\n";
    $aflag = 0;
  }
  $po[2] = (-1) * $po[2];
  $arcb = ($po[4] > 0) ? 360 - $po[4] : 0;
  $arce = ($po[5] > 0) ? 360 - $po[5] : 0;
  $darc = $arce - $arcb;
  if ($darc < 0) {$darc += 360}
  $quar = int($darc / 90);
  if ($quar > 0) {
    for (my $k = 1; $k <= $quar; $k++) {
      arc($po[0],$po[1],$po[2],$po[3],$arcb,$arcb + 90);
      $arcb += 90;
      if ($arcb > 360) {$arcb -= 360}
    }
  }
  if ($darc > $quar * 90) {
    arc($po[0],$po[1],$po[2],$po[3],$arcb,$arce);
  }
}
#________________________________________________________
# Frame
if ($xtex . $mtex  ne "") {
$xtex = "\\documentclass{article}\n\\usepackage{ebezier}\n".
"\\usepackage[pstarrows]{pict2e}\n\n\\begin{document}\n\n".
"\\setlength{\\unitlength}{".$ul."pt}\n".
"\\begin{picture}(".ceil(($xmax - $xmin)).",".
ceil(($ymax - $ymin)).")(".floor($xmin).",".floor($ymin).")\n".
"\\linethickness{0.8pt}\n"."\\thicklines\n".$xtex;
$xtex .= $mtex."\\end{picture}\n\n\\end{document}";
}
print $xtex."\n";
#________________________________________________________
# Best pair for the slope of a line
sub best {
  my $x = shift;
  if ($x > 1000) {
    return (1,0);
  }
  elsif ($x < 1.0E-3) {
    return (0,1);  
  }
  else {
    if ($x =~ (/^\d+$/)) {
      return ($x,1);
    }
    else {
      $num1 = floor($x);
      $den1 = 1;
      $y = $x;
      while (($y =~ (/\D+/)) and ($num1 <= $gi) and ($den1 <= $gi)) {
        $y *= 10;
        $num1 = floor($y);
        $den1 *= 10;
      }
      $r0 = $num1;
      $r1 = $den1;
      $q1 = 1;
      @li = (0);
      while ($r1 != 0) {
        $q1 = floor($r0 / $r1);
        $r2 = ($r0 % $r1);
        $r0 = $r1;
        $r1 = $r2;
        $li[++$#li] = $q1;
      }
      $num1 = $num1 / $r0;
      $den1 = $den1 / $r0;
      if ($num1 <= 1000 and $den1 <= 1000) {
        return ($num1,$den1);
      }
      else {
        $n = $#li;
        @num = (1,$li[1]);
        @den = (0,1);
        $bnum = $li[1];
        $bden = 1;
        $i = 2;
        $numh = 0;
        $denh = 0;
        while (($numh <= 1000 and $denh <= 1000) and $i <= $n) {
          $c = ($li[$i] >> 1);
          if (($li[$i] % 2) == 1) {
            $c++;
          }
          else {
            $j = 1;
            while (($i - $j >= 1 and $i + $j <= $n) and $li[$i - $j] == $li[$i + $j]) {
              $j++;
            }
            $dj = $i - $j;
            $sj = $i + $j;
            if (($dj >= 1 and $sj <= $n) and $li[$dj] != $li[$sj])  {
              $c += (($j + (($li[$sj] < $li[$dj]) ? 0 : 1)) % 2);
            }
            elsif ($dj == 0 and $sj <= $n) {
              $c += ($j % 2);
            }
            elsif ($dj >= 1 and $sj == $n + 1) {
              $c += (($j + 1) % 2);
            }
            elsif (($dj == 0 and $sj == $n + 1) or ($dj == 2 and
            $sj == $n and $li[1] == 1 and $li[2] + 1 == $li[$n]) or
            ($dj == 1 and $sj == $n - 1 and $li[$n] == 1
            and $li[$n - 1] + 1 == $li[1])) {
              $c++;
            }
          }
          $k = $c;
          while ($k <= $li[$i]) {
            $numh = $k * $num[$i - 1] + $num[$i - 2];
            $denh = $k * $den[$i - 1] + $den[$i - 2];
            if ($numh > 1000 or $denh > 1000) {
              last;
            }
            $bnum = $numh;
            $bden = $denh;
            if ($k == $li[$i]) {
              $num[$i] = $numh;
              $den[$i] = $denh;
            }
            $k++;
          }
          $i++;
        }
        return ($bnum,$bden);
      }
    }
  }
}
#________________________________________________________
# Lines
sub lin {
  my ($c,$xb,$yb,$xe,$ye) = @_;
  if (($c eq $green) or ($c eq $orange) or ($c eq $purple) or ($c eq $navy)) {
    $dx = $xe - $xb;
    $dy = $ye - $yb;  
    $le = abs($dx);
    if ($le > 1.0E-3) {
      @p = best(abs($dy / $dx));
      $psx = sp($p[1]) * ($dx <=> 0);
      $psy = sp($p[0]) * ($dy <=> 0);
    }
    else {
      $psx = 0;
      $psy = ($dy <=> 0);
      $le = abs($dy);
    }
    $xbu = sp($xb);
    $ybu = sp($yb);
    $leu = sp($le);
    $xtex .= "\\put(".$xbu.",".$ybu."){\\line(".$psx.",".$psy."){".$leu."}}\n";
  }
  elsif ($c eq $darkgreen) {
# Dotted line
    if ($thicknessflag) {
      $xtex .= "%Dotted line\n\\linethickness{1.2pt}\n";
      $thicknessflag = 0;
    }
    $le = floor($pointf * $ul * (sqrt(($xe - $xb)**2 + ($ye - $yb)**2)));
    if ($le > 0) {
      $xbu = sp($xb);
      $ybu = sp($yb);
      $xeu = sp($xe);
      $yeu = sp($ye);
      $xtex .= "\\Lbezier[".$le."](".$xbu.",".$ybu.")(".$xeu.",".$yeu.")\n";
    }
  }
}
#________________________________________________________
# Triangles
sub tri {
my ($q0,$qx1,$qy1,$qx2,$qy2,$qx3,$qy3) = @_;
  $qx1 = $qx1 * $ul;
  $qy1 = $qy1 * $ul;
  $qx2 = $qx2 * $ul;
  $qy2 = $qy2 * $ul;
  $qx3 = $qx3 * $ul;
  $qy3 = $qy3 * $ul;
  if ($q0 eq $red) {
# Filled triangle
    %ha = ($qx1,$qy1,$qx2+1e-07,$qy2+1e-07,$qx3+2e-07,$qy3+2e-07);
    @hb = ();
    @hc = ();
    foreach (sort { $ha{$a} <=> $ha{$b} } keys %ha) {
      $hb[++$#hb] = $_;
      $hc[++$#hc] = $ha{$_};
    }
    ($qx1,$qx2,$qx3) = @hb;
    ($qy1,$qy2,$qy3) = @hc;
    $lin = int(($qy3 - $qy1) * $fillf);
    $xtex .= "%Filled triangle\n\\linethickness{0.1pt}\n";
    $si = ($qy3 - $qy1) * $qx2 - ($qx3 - $qx1) * $qy2 - $qx1 * $qy3 + $qx3 * $qy1 <=> 0;
    $dex = ($qx3 - $qx1) / ($qy3 - $qy1) / $fillf;
    $d1 = $qy2 - $qy1;
    $d2 = $qy3 - $qy2;
    if ($d1 >= 1.0E-3) {
      $fx1 = ($qx2 - $qx1) / $d1;
      $sx1 = $qx1 - $qy1 * $fx1;
    }
    if ($d2 >= 1.0E-3) {
      $fx2 = ($qx3 - $qx2) / $d2;
      $sx2 = $qx2 - $qy2 * $fx2;
    }
    for ($k = 1; $k <= $lin; $k++) {
      $xb = $qx1 + $k * $dex;
      $yb = $qy1 + $k / $fillf;
      if ($yb <= $qy2) {
        if ($d1 >= 1.0E-3) {
          $leu = sp((abs($sx1 + $yb * $fx1 - $xb) + 0.5)/ $ul);
        }
        else {
          $leu = sp((abs($qx2 - $qx1) + 0.5)/ $ul);
        }
      }
      else {
        if ($d2 >= 1.0E-3) {
          $leu = sp((abs($sx2 + $yb * $fx2 - $xb) + 0.5)/ $ul);
        }
        else {
          $leu = sp((abs($qx3 - $qx2) + 0.5)/ $ul);
        }
      }
      if ($si > 0) {
        $xbu = sp($xb / $ul);
      }
      else {
        $xbu = sp($xb / $ul);
      }
      $ybu = sp($yb / $ul);
      $xtex .= "\\put(".$xbu.",".$ybu."){\\line(".$si.",0){".$leu."}}\n";
    }
    $xtex .= "\\linethickness{0.8pt}\n";
  }
  elsif (($q0 eq $purple) or ($q0 eq $darkbrown)) {
# Dotted triangle
    %ha = ($qx1,$qy1,$qx2+1e-07,$qy2+1e-07,$qx3+2e-07,$qy3+2e-07);
    @hb = ();
    @hc = ();
    foreach (sort { $ha{$a} <=> $ha{$b} } keys %ha) {
      $hb[++$#hb] = $_;
      $hc[++$#hc] = $ha{$_};
    }
    ($qx1,$qx2,$qx3) = @hb;
    ($qy1,$qy2,$qy3) = @hc;
    $xtex .= "%Dotted triangle\n";
    $si = ($qy3 - $qy1) * $qx2 - ($qx3 - $qx1) * $qy2 - $qx1 * $qy3 + $qx3 * $qy1 <=> 0;
    $dy1 = 2 * ceil($qy1 / 2);
    $dy3 = 2 * floor($qy3 / 2);
    $lin = $dy3 - $dy1;
    $dex = ($qx3 - $qx1) / ($qy3 - $qy1);
    $xbh = $qx1 + ($dy1 - $qy1 - 2.0) * $dex;
    $dex = 2 * $dex;
    $d1 = $qy2 - $qy1;
    $d2 = $qy3 - $qy2;
    if ($d1 >= 1.0E-3) {
      $fx1 = ($qx2 - $qx1) / $d1;
      $sx1 = $qx1 + ($dy1 - $qy1) * $fx1;
    }
    if ($d2 >= 1.0E-3) {
      $fx2 = ($qx3 - $qx2) / $d2;
      $sx2 = $qx2 + ($dy1 - $qy2) * $fx2;
    }
    for ($k = 0; $k <= $lin; $k += 2) {
      $qy = $dy1 + $k;
      $xbh = $xbh + $dex;
      ($si > 0) ? ($xb = $xbh) : ($xe = $xbh);
      if ($qy <= $qy2) {
        ($d1 >= 1.0E-3) ? ($xeh = $sx1 + $k * $fx1) : ($xeh = $qx1);
      }
      else {
        ($d2 >= 1.0E-3) ? ($xeh = $sx2 + $k * $fx2) : ($xeh = $qx2);
      }
      ($si > 0) ? ($xe = $xeh) : ($xb = $xeh);
      $xb = 2 * ceil($xb / 2);
      $xbd = $xb + (($xb + $qy) % 4);
      ($xe >= $xbd) ? ($num = floor(($xe - $xbd) / 4) + 1) : ($num = 0);
      if (not $thicknessflag) {
        $xtex .= "\\linethickness{0.8pt}\n";
        $thicknessflag = 1;
      }
      $xbu = sp($xbd / $ul);
      $qyu = sp($qy / $ul);
      $xtex .= "\\multiput(".$xbu.",".$qyu.")(".$uli.",0){".$num;
      $xtex .= "}{\\line(1,0){".$ule."}}\n";
    }
  }
  elsif (($q0 eq $orange) or ($q0 eq $brown)) {
# Hatched triangle
    $xtex .= "%Hatched triangle\n";
    $d1 = $qx1 - $qy1;
    $d2 = $qx2 - $qy2;
    $d3 = $qx3 - $qy3;
    $qd1 = $d1;
    $qd2 = $d2;
    $qd3 = $d3;
    %ha = ($qx1,$qd1,$qx2+1e-07,$qd2+1e-07,$qx3+2e-07,$qd3+2e-07);
    @hb = ();
    foreach (sort { $ha{$a} <=> $ha{$b} } keys %ha) {
      $hb[++$#hb] = $_;
    }
    ($qx1,$qx2,$qx3) = @hb;
    %ha = ($qy1,$qd1,$qy2+1e-07,$qd2+1e-07,$qy3+2e-07,$qd3+2e-07);
    @hb = ();
    @hc = ();
    foreach (sort { $ha{$a} <=> $ha{$b} } keys %ha) {
      $hb[++$#hb] = $_;
      $hc[++$#hc] = $ha{$_};
    }
    ($qy1,$qy2,$qy3) = @hb;  
    ($d1,$d2,$d3) = @hc;
    $si = (-$qy3 + $qy1) * $qx2 + ($qx3 - $qx1) * $qy2 + $qx1 * $qy3 - $qx3 * $qy1 <=> 0;
    $p1 = 4 * ceil($d1 / 4);
    $p2 = 4 * floor($d2 / 4);
    $p3 = 4 * floor($d3 / 4);
    $fx1 = ($qx1 - $qx3) / ($d3 - $d1);
    $sx1 = $qx3 + $fx1 * $d3;
    $fy1 = ($qy1 - $qy3) / ($d3 - $d1);
    $sy1 = $qy3 + $fy1 * $d3;
    $d21 = $d2 - $d1;
    $d32 = $d3 - $d2;
    if ($d21 >= 1.0E-3) {
      $fx2 = ($qx1 - $qx2) / $d21;
      $sx2 = $qx2 + $fx2 * $d2;
    }
    if ($d32 >= 1.0E-3) {
      $fx3 = ($qx2 - $qx3) / $d32;
      $sx3 = $qx3 + $fx3 * $d3;
    }
    for ($k = $p1; $k <= $p3; $k += 4) {
      $xbk = $sx1 - $k * $fx1;
      $ybk = $sy1 - $k * $fy1;
      if ($k <= $p2) {
        ($d21 < 1.0E-3) ? ($le = abs($qx2 - $qx1)) : ($le = abs($sx2 - $k * $fx2 - $xbk));
      }
      else {
        ($d32 < 1.0E-3) ? ($le = abs($qx3 - $qx2)) : ($le = abs($sx3 - $k * $fx3 - $xbk));
      }
      $xbk = sp($xbk / $ul);
      $ybk = sp($ybk / $ul);
      $le = sp($le / $ul);
      $xtex .= "\\put(".$xbk.",".$ybk."){\\line(".$si.",".$si."){".$le."}}\n";
    }
  }
}
#________________________________________________________
# Rectangles
sub rect {
  my ($q0,$x1,$y1,$x2,$y2,$x3,$y3,$x4,$y4) = @_;
  $dx = abs($x2 - $x1);
  $dx = ($dx < 1.0E-6) ? abs($x3 -$x2) : $dx;
  $dx = $dx * $ul;
  $xb = ($x1 < $x2) ? (($x1 < $x3) ? $x1 : $x3) : (($x2 < $x3) ? $x2 : $x3);
  $xb = $xb * $ul;
  $dy = abs($y2 - $y1);
  $dy = ($dy < 1.0E-6) ? abs($y3 -$y2) : $dy;
  $dy = $dy * $ul;
  $yb = ($y1 < $y2) ? (($y1 < $y3) ? $y1 : $y3) : (($y2 < $y3) ? $y2 : $y3);
  $yb = $yb * $ul;
  $xe = $xb + $dx;
  $ye = $yb + $dy;
# Filled rectangle
  if ($q0 eq $red) {
    $xtex .= "%Filled rectangle\n\\linethickness{0.1pt}\n";
    $lin = 5 * $dx;
    if ($dy <= $dx) {
      $ybf = $yb - 0.2;
      $xbu = sp($xb / $ul);
      $dxu = sp($dx / $ul);
      for ($k = 0; $k <= $lin; $k++) {
        $ybf += 0.2;
        $ybu = sp($ybf / $ul);
        $xtex .= "\\put(".$xbu.",".$ybu."){\\line(1,0){".$dxu."}}\n";
      }
    }
    else {
      $xbf = $xb - 0.2;
      $ybu = sp($yb / $ul);
      $dyu = sp($dy / $ul);
      for ($k = 0; $k <= $lin; $k++) {
        $xbf += 0.2;
        $xbu = sp($xbf / $ul);
        $xtex .= "\\put(".$xbu.",".$ybu."){\\line(0,1){".$dyu."}}\n";
      }
    }
    $xtex .= "\\linethickness{0.8pt}\n";
  }
# Dotted rectangle
  elsif (($q0 eq $purple) or ($q0 eq $darkbrown)) {
    $xtex .= "%Dotted rectangle\n";
    $xbb = 2 * ceil($xb / 2);
    $ybb = 2 * ceil($yb / 2);
    for ($k = 0; $k <= 2; $k += 2) {
      $ybd = $ybb + $k;
      $xbd = $xbb + (($xbb + $ybd) % 4);
      $numx = floor(($xe - 0.13 - $xbd) / 4) + 1;
      $numy = floor(($ye - 0.13 - $ybd) / 4) + 1;
      $xbu = sp($xbd / $ul);
      $ybu = sp($ybd / $ul);
      $xtex .= "\\multiput(".$xbu.",".$ybu.")(".$uli.",0){".$numx."}\n";
      $xtex .= "{\\begin{picture}(0,0)\\multiput(0,0)(0,".$uli."){";
      $xtex .= $numy."}\n{\\line(1,0){".$ule."}}\\end{picture}}\n";
    }
  }
# Hatched rectangle
  elsif (($q0 eq $orange) or ($q0 eq $brown)) {
    $xtex .= "%Hatched rectangle\n";
    $p1 = 4 * ceil(($xb - $ye) / 4);
    if ($dx >= $dy) {
      $p2 = 4 * floor(($xb - $yb) / 4) + 4;
      $p3 = 4 * floor(($xe - $ye) / 4) + 4;
      $xp = $yb + $p2;
      $yp = $yb;
      $lp = $dy;
      $ip1 = 4;
      $ip2 = 0;
    }
    else {
      $p3 = 4 * floor(($xb - $yb) / 4) + 4;
      $p2 = 4 * floor(($xe - $ye) / 4) + 4;
      $xp = $xb;
      $yp = $xb - $p2;
      $lp = $dx;
      $ip1 = 0;
      $ip2 = -4;
    }
    $p4 = 4 * floor(($xe - $yb) / 4);
    for ($k = $p1; $k <= $p2 - 4; $k += 4) {
      $xbu = sp($xb / $ul);
      $ybu = sp(($xb - $k) / $ul);
      $le = sp(($ye - $xb + $k) / $ul);
      $xtex .= "\\put(".$xbu.",".$ybu."){\\line(1,1){".$le."}}\n";
    }
    $np = ($p3 - $p2) / 4;
    if ($p3 > $p2) {
        $xpu = sp($xp / $ul);
        $ypu = sp($yp / $ul);
        $ip1u = sp($ip1 / $ul);
        $ip2u = sp($ip2 / $ul);
        $lpu = sp($lp / $ul - 0.1);
        $xtex .= "\\multiput(".$xpu.",".$ypu.")(".$ip1u.",".$ip2u;
        $xtex .= "){".$np."}{\\line(1,1){".$lpu."}}\n";
    }
    for ($k = $p3; $k <= $p4; $k += 4) {
      $xbu = sp(($yb + $k) / $ul);
      $ybu = sp($yb / $ul);
      $leu = sp(($xe - $yb - $k) / $ul);      
      $xtex .= "\\put(".$xbu.",".$ybu."){\\line(1,1){".$leu."}}\n";
    }
  }
}
#________________________________________________________
# Quadratic Bezier curve
sub qbez {
  my ($x1,$y1,$x2,$y2,$x3,$y3) = @_;
  my $xb = $x1;
  my $yb = $y1;
  my $len = 0.0;
  for ($t = 0.02; $t <= 1.0; $t += 0.02) {
    bound($xb,$yb);
    $s = 1.0 - $t;
    $xe = $s * ($s * $x1 + $t * $x2) + $t * ($s * $x2 + $t * $x3);
    $ye = $s * ($s * $y1 + $t * $y2) + $t * ($s * $y2 + $t * $y3);
    $len += sqrt(($xe - $xb)**2 + ($ye - $yb)**2);
    $xb = $xe;
    $yb = $ye;
  }
  bound($x3,$y3);
  $x1 = sp($x1);
  $y1 = sp($y1);
  $x2 = sp($x2);
  $y2 = sp($y2);
  $x3 = sp($x3);
  $y3 = sp($y3);
  if ($Qbezflag) {
    $le = int($pointf * $ul * $len);
    $xtex .= "\\Qbezier[".$le."](".$x1.",".$y1.")(".$x2.",".$y2;
    $xtex .= ")(".$x3.",".$y3.")\n";
  }
  else {
    $xtex .= "\\qbezier(".$x1.",".$y1.")(".$x2.",".$y2;
    $xtex .= ")(".$x3.",".$y3.")\n";
  }
}
#________________________________________________________
# Cubic Bezier curve
sub cbez {
  my ($x1,$y1,$x2,$y2,$x3,$y3,$x4,$y4) = @_;
  my $xb = $x1;
  my $yb = $y1;
  for ($t = 0.02; $t <= 1.0; $t += 0.02) {
    bound($xb,$yb);
    $s = 1.0 - $t;
    $u1 = $s * $x1 + $t * $x2;
    $v1 = $s * $y1 + $t * $y2;
    $u2 = $s * $x2 + $t * $x3;
    $v2 = $s * $y2 + $t * $y3;
    $u3 = $s * $x3 + $t * $x4;
    $v3 = $s * $y3 + $t * $y4;
    $xe = $s * ($s * $u1 + $t * $u2) + $t * ($s * $u2 + $t * $u3);
    $ye = $s * ($s * $v1 + $t * $v2) + $t * ($s * $v2 + $t * $v3);
    $xb = $xe;
    $yb = $ye;
  }
  bound($x4,$y4);
  $x1 = sp($x1);
  $y1 = sp($y1);
  $x2 = sp($x2);
  $y2 = sp($y2);
  $x3 = sp($x3);
  $y3 = sp($y3);
  $x4 = sp($x4);
  $y4 = sp($y4);
  $xtex .= "\\cbezier(".$x1.",".$y1.")(".$x2.",".$y2.")(".$x3.",".$y3.")(".$x4.",".$y4.")\n";
}
#________________________________________________________
# Short arcs
sub arc {
  my ($col,$xm,$ym,$r,$al,$be) = @_;
  $al1 = $al * $Pi / 180;
  $be1 = $be * $Pi / 180;
  $dx1 = $r * cos($al1);
  $dy1 = $r * sin($al1);
  $dx4 = $r * cos($be1);
  $dy4 = $r * sin($be1);
  $x1 = $xm + $dx1;
  $y1 = $ym + $dy1;
  $x4 = $xm + $dx4;
  $y4 = $ym + $dy4;
  bound($x1,$y1);
  bound($x4,$y4);
  $gal = 90 * int($al / 90);
  $gbe = 90 * int($be / 90);
  if ($gal != $gbe) {
    if ($gbe == 0) {
      $gx1 = $r;
      $gy1 = 0;
    }
    elsif ($gbe == 90) {
      $gx1 = 0;
      $gy1 = $r;
    }
    elsif ($gbe == 180) {
      $gx1 = (-1) * $r;
      $gy1 = 0;
    }
    elsif ($gbe == 270) {
      $gx1 = 0;
      $gy1 = (-1) * $r;
    }
    bound($xm + $gx1,$ym + $gy1);
  }
  $aux = 4 * (2 * $r - sqrt(($dx1 + $dx4)**2 + ($dy1 + $dy4)**2)) / 3;
  $lam = $aux / sqrt(($dx1 - $dx4)**2 + ($dy1 - $dy4)**2);
  $x1u = sp($x1);
  $y1u = sp($y1);
  $x4u = sp($x4);
  $y4u = sp($y4);
  if ($col eq $darkgreen) { 
    $d1 = abs($al1 - $be1);
    if ($d1 > $Pi) {$d1 = 2 * $Pi - $d1}
    $le = int($pointf * $d1 * $r * $ul);
    $xmu = sp($xm);
    $ymu = sp($ym);
    $xtex .= "\\cArcs[".$le."](".$xmu.",".$ymu.")(".$x1u.",".$y1u,
    $xtex .= ")(".$x4u.",".$y4u.")\n";
  }
  else {
    $x2u = sp($x1 - $lam * $dy1);
    $y2u = sp($y1 + $lam * $dx1);
    $x3u = sp($x4 + $lam * $dy4);
    $y3u = sp($y4 - $lam * $dx4);
    $xtex .= "\\cbezier(".$x1u.",".$y1u.")(".$x2u.",".$y2u.")(".$x3u.",";
    $xtex .= $y3u.")(".$x4u.",".$y4u.")\n";
  }
}
#________________________________________________________
# Bounding box
sub bound {
  my ($xn,$yn) = @_;
  if ($sflag) {
    $xmin = $xn;
    $xmax = $xn;
    $ymin = $yn;
    $ymax = $yn;
    $sflag = 0;
  }
  else {
    if ($xn < $xmin) {$xmin = $xn} elsif ($xmax < $xn) {$xmax = $xn}
    if ($yn < $ymin) {$ymin = $yn} elsif ($ymax < $yn) {$ymax = $yn}
  }
}
#________________________________________________________
# Sprintf
sub sp {
  my $x = shift;
  return sprintf("%.3f",$x) + 0;
}
#________________________________________________________