#!/usr/bin/perl -w # OOopict.pl # (c) Copyright 2009 by H. Moeller (mollerh@math.uni-muenster.de). # Version 1.6 for OpenOffice.org Draw , Apache OpenOffice Draw or LibreOffice Draw # with Perl 5.16, and with the LaTeX package 'pict2e' from 2008 # or with 'pict2e' (2003) 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 by the author". # use POSIX('ceil','floor'); #________________________________________________________ # Definable by the user: # Unitlength in pt: $ul = 1.0; # If your package pict2e is from 2008 or later (else: $pictnew = 0): $pictnew = 1; # Fill factor (for laser printer; for filling up to 360% zoom: $fillf=5) $fillf = 10; # Point factor (for points on dotted lines and curves): $pointf = 0.3; #________________________________________________________ # Constants: # Constants in dotted figures: $uli = sp(4 / $ul); $ule = sp(0.8 / $ul); $ulb = sp(1.2 / $ul); # Color names: $black = "0.0030.0030.003"; $navy = "0.0030.0030.503"; $green = "0.0030.5030.003"; $teal = "0.0030.5030.503"; $maroon = "0.5030.0030.003"; $purple = "0.5030.0030.503"; $olive = "0.5030.5030.003"; $blue = "0.0030.0031.000"; $lime = "0.0031.0000.003"; $cyan = "0.0031.0001.000"; $red = "1.0000.0030.003"; $magenta = "1.0000.0031.000"; #________________________________________________________ # Further Constants: #Conversion factor to pt: $cpt = 0.02845276; # Greatest integer of Perl $gi = 2147483647; #________________________________________________________ @lines = <>; do { $_ = $lines[$i++]; if ((/ l /o) or (/ ct /o) or (/ p[cs ][\se]/o)) { s/\d+ lw \d+ lj //go; s/ m //go; if (/ c /o) { s/(\d\.\d+) (\d\.\d+) (\d\.\d+) c //o; $c=$1.$2.$3." "; } $t=""; $l=""; $tflag=0; $fflag=0; while ($_ !~ (/p[cs ][\se]/o)) { if (/ ct /o) { $tflag=1; s/ ct / /go; /(.*)/o; $t.=$1; } elsif (/ l /o) { s/ l / /go; s/ l / /o; /(.*)/o; $l.=$1; } $_ = $lines[$i++]; } $fflag=($_ !~ (/p /o)); if (/ ct /o) { $tflag=1; s/ ct / /go; /(.*\d)/o; $t.=$1; } elsif (/ l /o) { s/ l / /go; s/ l / /o; /(.*\d)/o; $l.=$1; } if ($tflag and $fflag) { $curve[++$#curve] = $c.$t; } elsif ($fflag) { $polygon[++$#polygon] = $c.$l; } } } until $i == $#lines; # $sflag = 1; $lt = 8; $coun = 0; $xtex = ""; $mtex = ""; $btex = "\\documentclass{article}\n"; if (not $pictnew) { $btex .= "\\usepackage{ebezier}\n"; } #________________________________________________________ # Lines and polygons $cflag = 1; foreach (@polygon) { @po = split; $p0 = $po[0]; $pon = $#po; if ($pon == 12) {$rec = abs($po[2] - $po[4]) + abs($po[3] - $po[5]) + abs($po[6] - $po[8]) + abs($po[7] -$po[9]) + abs($po[10]- $po[12]) < 1.0E-4; } for (my $j = 1; $j <= $pon; $j++) { $po[$j] *= (-1)**($j+1)*$cpt; } if ($cflag) { $xtex .= "%Lines, arrows, polygons and quadratic B".chr(142)."zier curves\n"; $cflag = 0; } if (($p0 ne $blue) and ($p0 ne $green)) { for (my $i = 1; $i <= $pon - 1; $i += 2) { bound($po[$i],$po[$i + 1]); } } if (($p0 eq $black) or ($p0 eq $lime) or ($p0 eq $maroon) or ($p0 eq $purple)) { if ($pon == 12 and $rec) { for (my $h = 3; $h <= 7; $h += 2) { lin($p0,$po[$h],$po[$h+1],$po[$h+2],$po[$h+3]); } lin($p0,$po[9],$po[10],$po[3],$po[4]); } else { for (my $i = 1; $i <= $pon - 3; $i += 2) { lin($p0,$po[$i],$po[$i+1],$po[$i+2],$po[$i+3]); } } } if (($p0 eq $teal) or ($p0 eq $navy)) { $xtex .= "%Arrow\n"; $dx = $po[3] - $po[1]; $dy = $po[4] - $po[2]; $roo = sqrt($dx**2+$dy**2); $co = $dx / $roo; $si = $dy / $roo; $pxh = $po[3] - 4.8 * $co / $ul; $pyh = $po[4] - 4.8 * $si / $ul; $px2 = $pxh - 2.4 * $si / $ul; $py2 = $pyh + 2.4 * $co / $ul; $px3 = $pxh + 2.4 * $si / $ul; $py3 = $pyh - 2.4 * $co / $ul; bound($px2,$py2); bound($px3,$py3); $len = abs($dx); if ($len > 1.0E-3) { @p = best(abs($dy / $dx), 1000); $psx = $p[1] * ($dx <=> 0); $psy = $p[0] * ($dy <=> 0); $len = sp(abs($len - 4 * $len / ($roo * $ul))); } else { $psx = 0; $psy = ($dy <=> 0); $len = sp(abs(abs($dy) - 4 / $ul)); } if ($p0 eq $teal) { $xb = sp($po[1]); $yb = sp($po[2]); if ($lt != 8) { $xtex .= "\\linethickness{0.8pt}\n"; $lt = 8; } $xtex .= "\\put(".$xb.",".$yb."){\\line(".$psx.",".$psy."){".$len."}}\n"; } else { $xe = $po[3] - $uli * $dx / $roo; $ye = $po[4] - $uli * $dy / $roo; lin($p0,$po[1],$po[2],$xe,$ye); } if ($lt != 12) { $xtex .= "\\linethickness{1.2pt}\n"; $lt = 12; } $xtex .= "\\put(".sp($po[3]).",".sp($po[4])."){\\vector(".$psx.",".$psy."){0}}\n"; } if (($p0 eq $red) or ($p0 eq $maroon) or ($p0 eq $olive) or ($p0 eq $purple) or ($p0 eq $magenta)) { if ($pon == 8) { tri($p0,$po[1],$po[2],$po[3],$po[4],$po[5],$po[6]); } elsif ($pon == 10) { ($p0,$u1,$v1,$u2,$v2,$u3,$v3,$u4,$v4,$u5,$v5) = @po; tri($p0,$u1,$v1,$u2,$v2,$u3,$v3); tri($p0,$u1,$v1,$u3,$v3,$u4,$v4); } elsif ($pon == 12) { ($p0,$u0,$v0,$u1,$v1,$u2,$v2,$u3,$v3,$u4,$v4,$u5,$v5) = @po; if ($rec) { rect($p0,$u1,$v1,$u2,$v2,$u3,$v3,$u4,$v4); } else { tri($p0,$u0,$v0,$u1,$v1,$u2,$v2); tri($p0,$u0,$v0,$u2,$v2,$u3,$v3); tri($p0,$u0,$v0,$u3,$v3,$u4,$v4); } } elsif ($pon > 12) { for (my $j = 3; $j <= $pon - 5; $j += 2) { tri($p0,$po[1],$po[2],$po[$j],$po[$j + 1],$po[$j + 2],$po[$j + 3]); } } } elsif ($p0 eq $cyan) { # Text marker $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 (($p0 eq $blue) or ($p0 eq $green)) { $xtex .= "%Quadratic B".chr(142)."zier curve\n"; qbez($p0,$po[1],$po[2],$po[3],$po[4],$po[5],$po[6]); } } # Curves $cflag = 1; foreach (@curve) { @co = split; $c0 = $co[0]; $con = $#co; if (($c0 eq $black) or ($c0 eq $lime)) { for (my $j = 1; $j <= $con; $j++) { $co[$j] *= (-1)**($j+1)*$cpt; } if ($cflag) { $xtex .= "%Cubic B".chr(142)."zier curves\n"; $cflag = 0; } for (my $j = 3; $j <= $con - 5; $j += 6) { cbez($c0,$co[$j-2],$co[$j-1],$co[$j],$co[$j+1],$co[$j+2],$co[$j+3], $co[$j+4],$co[$j+5]); } } } #________________________________________________________ # Frame if ($xtex . $mtex ne "") { $xtex = $btex."\\usepackage[pdftex,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".$xtex; $xtex .= $mtex."\\end{picture}\n\n\\end{document}"; } print $xtex."\n"; #________________________________________________________ # Best pair for the slope of a line or an arrow sub best { my ($x,$lsc) = @_; if ($x > 1000) { return (1,0); } elsif ($x < 0.001) { return (0,1); } else { if ($x =~ (/^\d+$/)) { return ($x,1); } else { if ($x < 1.0) { $num1 = floor($x * $gi); $den1 = $gi; } else { $num1 = $gi; $den1 = floor($gi / $x); } $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 /= $r0; $den1 /= $r0; if ($num1 <= $lsc and $den1 <= $lsc) { 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 <= $lsc and $denh <= $lsc) 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 > $lsc or $denh > $lsc) { 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 $black) or ($c eq $maroon) or ($c eq $purple)) { $dx = $xe - $xb; $dy = $ye - $yb; $le = abs($dx); if ($le > 1.0E-3) { if ($pictnew) { @p = best(abs($dy / $dx), 16383); } else { @p = best(abs($dy / $dx), 1000); } $psx = $p[1] * ($dx <=> 0); $psy = $p[0] * ($dy <=> 0); } else { $psx = 0; $psy = ($dy <=> 0); $le = abs($dy); } $xbu = sp($xb); $ybu = sp($yb); $leu = sp($le); if ($lt != 8) { $xtex .= "\\linethickness{0.8pt}\n"; $lt = 8; } $xtex .= "\\put(".$xbu.",".$ybu."){\\line(".$psx.",".$psy."){".$leu."}}\n"; } elsif (($c eq $lime) or ($c eq $navy)) { # Dotted line $dx = $xe - $xb; $dy = $ye - $yb; $le = floor($pointf * $ul * (sqrt($dx**2 + $dy**2))) + 1; if ($le > 1) { $xbu = sp($xb - $ulb / 2); $ybu = sp($yb); $xiu = sp($dx / ($le - 1)); $yiu = sp($dy / ($le - 1)); if ($lt != 12) { $xtex .= "\\linethickness{1.2pt}\n"; $lt = 12; } $xtex .= "\\multiput(".$xbu.",".$ybu.")(".$xiu.",".$yiu; $xtex .= "){".$le."}{\\line(1,0){".$ulb."}}\n"; } } } #________________________________________________________ # Triangles sub tri { my ($q0,$qx1,$qy1,$qx2,$qy2,$qx3,$qy3) = @_; $qx1 *= $ul; $qy1 *= $ul; $qx2 *= $ul; $qy2 *= $ul; $qx3 *= $ul; $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 = floor(($qy3 - $qy1) * $fillf); $xtex .= "%Filled triangle\n"; if ($lt != 1) { $xtex .= "\\linethickness{0.1pt}\n"; $lt = 1; } $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"; } } elsif (($q0 eq $purple) or ($q0 eq $magenta)) { # 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"; if ($lt != 8) { $xtex .= "\\linethickness{0.8pt}\n"; $lt = 8; } $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); $xbu = sp($xbd / $ul - $ule / 2); $qyu = sp($qy / $ul); $xtex .= "\\multiput(".$xbu.",".$qyu.")(".$uli.",0){".$num; $xtex .= "}{\\line(1,0){".$ule."}}\n"; } } elsif (($q0 eq $maroon) or ($q0 eq $olive)) { # Hatched triangle $xtex .= "%Hatched triangle\n"; if ($lt != 8) { $xtex .= "\\linethickness{0.8pt}\n"; $lt = 8; } $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"; if ($lt != 1) { $xtex .= "\\linethickness{0.1pt}\n"; $lt = 1; } $xbu = sp($xb / $ul); $ybu = sp($yb / $ul); if ($dy <= $dx) { $lin = floor($fillf * $dy); $dxu = sp($dx / $ul); $ybi = sp(1.0 / ($fillf * $ul)); $xtex .= "\\multiput(".$xbu.",".$ybu.")(0,".$ybi."){".$lin; $xtex .= "}{\\line(1,0){".$dxu."}}\n"; } else { $lin = floor($fillf * $dx); $dyu = sp($dy / $ul); $xbi = sp(1.0 / ($fillf * $ul)); $xtex .= "\\multiput(".$xbu.",".$ybu.")(".$xbi.",0){".$lin; $xtex .= "}{\\line(0,1){".$dyu."}}\n"; } } # Dotted rectangle elsif (($q0 eq $purple) or ($q0 eq $magenta)) { $xtex .= "%Dotted rectangle\n"; if ($lt != 8) { $xtex .= "\\linethickness{0.8pt}\n"; $lt = 8; } $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 - $ule / 2); $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 $maroon) or ($q0 eq $olive)) { $xtex .= "%Hatched rectangle\n"; if ($lt != 8) { $xtex .= "\\linethickness{0.8pt}\n"; $lt = 8; } $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 Bézier curves sub qbez { my ($q0,$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 ($q0 eq $green) { $le = floor($pointf * $ul * $len); if ($lt != 12) { $xtex .= "\\linethickness{1.2pt}\n"; $lt = 12; } if ($pictnew) { $xtex .= "\\qbezier["; } else { $xtex .= "\\Qbezier["; } $xtex .= $le."](".$x1.",".$y1.")(".$x2.",".$y2.")(".$x3.",".$y3.")\n"; } elsif ($q0 eq $blue) { if ($lt != 8) { $xtex .= "\\linethickness{0.8pt}\n"; $lt = 8; } $xtex .= "\\qbezier(".$x1.",".$y1.")(".$x2.",".$y2; $xtex .= ")(".$x3.",".$y3.")\n"; } } #________________________________________________________ # Cubic Bézier curves sub cbez { my ($q0,$x1,$y1,$x2,$y2,$x3,$y3,$x4,$y4) = @_; my $xb = $x1; my $yb = $y1; if ($q0 eq $black) { 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); if ($lt != 8) { $xtex .= "\\linethickness{0.8pt}\n"; $lt = 8; } $xtex .= "\\cbezier(".$x1.",".$y1.")(".$x2.",".$y2.")(".$x3.",".$y3.")(".$x4.",".$y4.")\n"; } elsif ($q0 eq $lime) { if ($lt != 12) { $xtex .= "\\linethickness{1.2pt}\n"; $lt = 12; } my $len = 0.0; for ($t1 = 0.02; $t1 <= 1.0; $t1 += 0.02) { bound($xb,$yb); $s1 = 1.0 - $t1; $u1 = $s1 * $x1 + $t1 * $x2; $v1 = $s1 * $y1 + $t1 * $y2; $u2 = $s1 * $x2 + $t1 * $x3; $v2 = $s1 * $y2 + $t1 * $y3; $u3 = $s1 * $x3 + $t1 * $x4; $v3 = $s1 * $y3 + $t1 * $y4; $xe = $s1 * ($s1 * $u1 + $t1 * $u2) + $t1 * ($s1 * $u2 + $t1 * $u3); $ye = $s1 * ($s1 * $v1 + $t1 * $v2) + $t1 * ($s1 * $v2 + $t1 * $v3); $len += sqrt(($xe - $xb)**2 + ($ye - $yb)**2); $xb = $xe; $yb = $ye; } bound($x4,$y4); $le = floor($pointf * $ul * $len); $dflag = 0; if ($le >= 4) { @px = (); @py = (); @qx = (); @qy = (); @r = (); @de = (); @xh = (); @yh = (); for (my $k = 0; $k <= 4; $k++) { $tk = $k / 4; $sk = 1.0 - $tk; $px[++$#px]=$sk**3*$x1+3*$sk**2*$tk*$x2+3*$sk*$tk**2*$x3+$tk**3*$x4; $py[++$#py]=$sk**3*$y1+3*$sk**2*$tk*$y2+3*$sk*$tk**2*$y3+$tk**3*$y4; $qx[++$#qx]=3.0*(-$sk**2*$x1+$sk*(1-3*$tk)*$x2+$tk*(2-3*$tk)*$x3+ $tk**2*$x4); $qy[++$#qy]=3.0*(-$sk**2*$y1+$sk*(1-3*$tk)*$y2+$tk*(2-3*$tk)*$y3+ $tk**2*$y4); $r[++$#r] = $px[$k] * $qy[$k] - $py[$k] * $qx[$k]; } for (my $i = 0; $i <=3; $i++) { $det = $qx[$i] * $qy[$i+1] - $qy[$i]*$qx[$i+1]; if (abs($det) < 1.0E-10) { last; } $de[++$#de] = $det; $xh[++$#xh] = ($qx[$i] * $r[$i+1] - $r[$i]*$qx[$i+1]) / $det; $yh[++$#yh] = ($qy[$i] * $r[$i+1] - $r[$i]*$qy[$i+1]) / $det; } if ($#de == 3) { $le = ceil($le / 4); for (my $i = 0; $i <=3; $i++) { $x1 = sp($px[$i]); $y1 = sp($py[$i]); $x2 = sp($xh[$i]); $y2 = sp($yh[$i]); $x3 = sp($px[$i+1]); $y3 = sp($py[$i+1]); if ($pictnew) { $xtex .= "\\qbezier["; } else { $xtex .= "\\Qbezier["; } $xtex .= $le."](".$x1.",".$y1.")(".$x2.",".$y2.")(".$x3.",".$y3.")\n"; } $dflag = 1; } } if (not $dflag) { $xb = $x1; $yb = $y1; $le = 1/ceil($pointf * $ul * $len); $xc = sp($xb - $ulb / 2); $yc = sp($yb); for ($t = $le; $t <= 1.0 + $le; $t += $le) { $xtex .= "\\put(".$xc.",".$yc."){\\line(1,0){".$ulb."}}\n"; $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; $xc = sp($xb - $ulb / 2); $yc = sp($yb); } $xc = sp($x4 - $ulb / 2); $yc = sp($y4); $xtex .= "\\put(".$xc.",".$yc."){\\line(1,0){".$ulb."}}\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; } #________________________________________________________