From 3d1639d263d3315ae55d789b527ff12499ed8549 Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Tue, 23 Aug 2011 16:33:07 +0000 Subject: have to rename mathspicNNN.pl in scripts tree for sake of w32 wrapper git-svn-id: svn://tug.org/texlive/trunk@23661 c570f23f-e606-0410-a88d-b1316a301751 --- Master/texmf-dist/scripts/mathspic/mathspic.pl | 3336 +++++++++++++++++++++ Master/texmf-dist/scripts/mathspic/mathspic113.pl | 3336 --------------------- 2 files changed, 3336 insertions(+), 3336 deletions(-) create mode 100755 Master/texmf-dist/scripts/mathspic/mathspic.pl delete mode 100755 Master/texmf-dist/scripts/mathspic/mathspic113.pl (limited to 'Master/texmf-dist/scripts/mathspic') diff --git a/Master/texmf-dist/scripts/mathspic/mathspic.pl b/Master/texmf-dist/scripts/mathspic/mathspic.pl new file mode 100755 index 00000000000..5c3ed4ec1f9 --- /dev/null +++ b/Master/texmf-dist/scripts/mathspic/mathspic.pl @@ -0,0 +1,3336 @@ +#!/usr/bin/perl +# +#(c) Copyright 2005-2010 VERSION 1.13 April 26, 2010 +# Apostolos Syropoulos & R.W.D. Nickalls +# asyropoulos@yahoo.com dick@nickalls.org +# +# This program can be redistributed and/or modified under the terms +# of the LaTeX Project Public License Distributed from CTAN +# archives in directory macros/latex/base/lppl.txt; either +# version 1 of the License, or any later version. +# +package DummyFH; +my $index = 0; +sub TIEHANDLE { + my $class = shift; + my $self= shift; + bless $self, $class; +} +sub READLINE { + my $self = shift; + #shift @$self; + if ($index > $#$self) { + $index = 0; + return undef; + } + else { + return $self->[$index++]; + } +} + +package main; +use Math::Trig; +our $version_number = "1.13 Apr 26, 2010"; +our $commandLineArgs = join(" ", @ARGV); +our $command = ""; +our $curr_in_file = ""; +our %PointTable = (); +our %VarTable = (); +our %ConstTable = (); +our $no_errors = 0; +our $xunits = "1pt"; +our $yunits = "1pt"; +our $units = "pt|pc|in|bp|cm|mm|dd|cc|sp"; +our $defaultsymbol = "\$\\bullet\$"; +our $defaultLFradius = 0; +use constant PI => atan2(1,1)*4; +use constant R2D => 180 / PI; +use constant D2R => PI / 180; +our $arrowLength = 2; +our $arrowLengthUnits = "mm"; +our $arrowAngleB = 30; +our $arrowAngleC = 40; +our %DimOfPoint = (); +our $GlobalDimOfPoints = 0; +our @Macros = (); +our $LineThickness = 0.4; + + sub mpp { + my $in_line; + chomp($in_line = shift); + my $LC = shift; + my $out_line = $in_line; + my $macro_name = ""; + my @macro_param = (); + my $macro_code = ""; + if ($in_line =~ s/^%def\s*//) { + if ($in_line =~ s/^(\w+)\s*//){ + $macro_name = $1; + } + else { + PrintErrorMessage("No macro name has been found",$LC); + return "" + } + if ($in_line =~ s/^\(\s*//) { + # do nothing + } + else { + PrintErrorMessage("No left parenthesis after macro name has been found",$LC); + return ""; + } + if ($in_line =~ s/^\)//) { + # Macro has no parameters! + } + else { + MACROS: while (1) { + if ($in_line =~ s/^(\w+)\s*//) { + push (@macro_param, $1); + } + else { + PrintErrorMessage("No macro parameter name has been found",$LC); + return ""; + } + if ($in_line =~ s/^,\s*//) { + next MACROS; + } + else { + last MACROS; + } + } + if ($in_line =~ s/^\)//) { + # do nothing! + } + else { + PrintErrorMessage("No closing parenthesis after macro parameters",$LC); + return ""; + } + } + $in_line =~ s/([^%]+)(%.*)/$1/; + $macro_code = $in_line; + push ( @Macros , { 'macro_name' => $macro_name, + 'macro_code' => $macro_code, + 'macro_param' => \@macro_param }); + return $out_line; + } + elsif ($in_line =~ s/^%undef\s*//) { + if ($in_line =~ s/^(\w+)//) { + my $undef_macro = $1; + for(my $i = $#Macros; $i >= 0; $i--) { + if ($Macros[$i]->{'macro_name'} eq $undef_macro) { + splice(@Macros,$i,1); + } + } + } + return $out_line; + } + elsif ($in_line =~ s/^\s*%//) { + return $out_line; + } + else { + my $comment = $2 if $in_line =~ s/([^%]+)(%.+)/$1/; + EXPANSIONLOOP: while () { + my $org_in_line = $in_line; + for(my $i = $#Macros; $i >= 0; $i--) { + my $macro_name = $Macros[$i]->{'macro_name'}; + if ($in_line =~ /&$macro_name\b/) { ############################ + my $num_of_macro_args = @{$Macros[$i]->{'macro_param'}}; + if ( $num_of_macro_args > 0 ) { + # Macro with parameters + my $pattern = "&$macro_name\\("; + foreach my $p ( 1..$num_of_macro_args ) { + my $comma = ($p == $num_of_macro_args) ? "\\s*" : "\\s*,\\s*"; + $pattern .= "\\s*[^\\s\\)]+$comma"; + } + $pattern .= "\\)"; + while($in_line =~ /&$macro_name\b/) { + if ($in_line =~ /$pattern/) { + my $before = $`; + my $after = $'; + my $match = $&; + my $new_code = $Macros[$i]->{'macro_code'}; + $match =~ s/^&$macro_name\(\s*//; + $match =~ s/\)$//; + foreach my $arg ( 0..($num_of_macro_args - 1) ) { + my $old = $Macros[$i]->{'macro_param'}->[$arg]; + my $comma = ($arg == ($num_of_macro_args - 1)) ? "" : ","; + $match =~ s/^\s*([^\s,]+)\s*$comma//; + my $new = $1; + # 'g': Parameter may occur several times + # in $new_code. + # '\b': Substitute only whole words + # not x in xA + $new_code =~ s/\b$old\b/$new/g; + } + $in_line = "$before$new_code$after"; + } + else { + PrintErrorMessage("Usage of macro &$macro_name does not " . + "match its definition", $LC); + return ""; + } + } + } + else { + # Macro without parameters + my $replacement = $Macros[$i]->{'macro_code'}; + # '\b': Substitute only whole words + # not x in xA + $in_line =~ s/&$macro_name\b/$replacement/g; + } + } + } + last EXPANSIONLOOP if ( $org_in_line eq $in_line ); + } + return "$in_line$comment"; + } + } + + sub PrintErrorMessage { + my $errormessage = shift; + my $error_line = shift; + my ($l,$A); + $l = 1+length($command)-length; + $A = substr($command,0,$l); + $l += 7 +length($error_line); + + for my $fh (STDOUT, LOG) { + print $fh "$curr_in_file", "Line $error_line: $A\n"; + print $fh " " x $l ,$_,"***Error: $errormessage\n"; + } + if ($comments_on) { #print to output file file + print OUT "%% *** $curr_in_file", "Line $error_line: $A\n"; + print OUT "%% *** "," " x $l ,$_,"%% ... Error: $errormessage\n"; + } + $no_errors++; + } + + sub PrintWarningMessage { + my $warningMessage = shift; + my $warning_line = shift; + my ($l,$A); + $l = 1+length($command)-length; + $A = substr($command,0,$l); + $l += 7 +length($warning_line); + + for my $fh (STDOUT, LOG) { + print $fh "$curr_in_file", "Line $warning_line: $A\n"; + print $fh " " x $l ,$_,"***Warning: $warningMessage\n"; + } + if ($comments_on) { #print to output file file + print OUT "%% *** $curr_in_file", "Line $warning_line: $A\n"; + print OUT "%% *** "," " x $l ,$_,"%% ... Warning: $warningMessage\n"; + } + } + + sub PrintFatalError { + my $FatalMessage = shift; + my $fatal_line = shift; + my ($l,$A); + $l = 1+length($command)-length; + $A = substr($command,0,$l); + $l += 7 +length($fatal_line); + + die "$curr_in_file", "Line $fatal_line: $A\n" . + (" " x $l) . $_ . "***Fatal Error: $FatalMessage\n"; + } + + sub chk_lparen { + my $token = $_[0]; + my $lc = $_[1]; + s/\s*//; + if (/^[^\(]/) { + PrintErrorMessage("Missing ( after $token",$lc); + } + else { + s/^\(\s*//; + } + } + + sub chk_rparen { + my $token = $_[0]; + my $lc = $_[1]; + s/\s*//; + if (s/^\)//) { + s/\s*//; + } + else { + PrintErrorMessage("Missing ) after $token",$lc); + } + } + + + sub chk_lcb { + my $token = $_[0]; + my $lc = $_[1]; + s/\s*//; + if ($_ !~ /^\{/) { + PrintErrorMessage("Missing { after $token",$lc); + } + else { + s/^{\s*//; + } + } + + sub chk_rcb { + my $token = $_[0]; + my $lc = $_[1]; + if ($_ !~ /^\s*\}/) { + PrintErrorMessage("Missing } after $token",$lc); + } + else { + s/^\s*}\s*//; + } + } + + sub chk_lsb { + my $token = $_[0]; + my $lc = $_[1]; + + s/\s*//; + if ($_ !~ /^\[/) { + PrintErrorMessage("Missing [ after $token",$lc); + } + else { + s/^\[\s*//; + } + } + + sub chk_rsb { + my $token = $_[0]; + my $lc = $_[1]; + + s/\s*//; + if ($_ !~ /^\]/) { + PrintErrorMessage("Missing ] after $token",$lc); + } + else { + s/^\]\s*//; + } + } + + sub chk_comma { + my $lc = $_[0]; + + s/\s*//; + if (/^[^,]/) { + PrintErrorMessage("Did not find expected comma",$lc); + } + else { + s/^,\s*//; + } + } + + sub chk_comment { + my $lc = $_[0]; + + s/\s*//; + if (/^%/) { + # do nothing! + } + elsif (/^[^%]/) { + PrintWarningMessage("Trailing text is ignored",$lc); + } + } + + sub print_headers + { + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; + $year+=1900; + $mon+=1; + $now_string = "$year/" . ($mon>9 ? "$mon/" : "0$mon/") . + ($mday>9 ? "$mday " : "0$mday ") . + ($hour>9 ? "$hour:" : "0$hour:") . + ($min>9 ? "$min:" : "0$min:") . + ($sec>9 ? "$sec" : "0$sec"); + print OUT "%* -----------------------------------------------\n"; + print OUT "%* mathspic (Perl version $version_number)\n"; + print OUT "%* A filter program for use with PiCTeX\n"; + print OUT "%* Copyright (c) 2005-2010 A Syropoulos & RWD Nickalls \n"; + print OUT "%* Command line: $0 $commandLineArgs\n"; + print OUT "%* Input filename : $source_file\n"; + print OUT "%* Output filename: $out_file\n"; + print OUT "%* Date & time: $now_string\n"; + print OUT "%* -----------------------------------------------\n"; + # + print LOG "----\n"; + print LOG "$now_string\n"; + print LOG "mathspic (Perl version $version_number)\n"; + print LOG "Copyright (c) 2005-2010 A Syropoulos & RWD Nickalls \n"; + print LOG "Input file = $source_file\n"; + print LOG "Output file = $out_file\n"; + print LOG "Log file = $log_file\n"; + print LOG "----\n"; + } + + sub get_point { + + my ($lc) = $_[0]; + my ($PointName); + + if (s/^([^\W\d_]\d{0,4})\s*//i) { #point name + $PointName = $1; + if (!exists($PointTable{lc($PointName)})) { + PrintErrorMessage("Undefined point $PointName",$lc); + return "_undef_"; + } + else { + return lc($PointName); + } + } + else { + PrintErrorMessage("Point name expected",$lc); + return "_undef_"; + } + } + + sub perpendicular { + my ($xP, $yP, $xA, $yA, $xB, $yB) = @_; + my ($xF, $yF, $deltax, $deltay, $m1, $m2, $c1, $c2, $factor); + + $deltax = $xA - $xB; + return ($xA, $yP) if abs($deltax) < 0.0000001; + $deltay = $yA - $yB; + return ($xP, $yA) if abs($deltay) < 0.0000001; + $m1 = $deltay / $deltax; + eval { $m2 = (-1) / $m1;}; + PrintFatalError("Division by zero",$lc) if $@; + $c1 = $yA - $m1 * $xA; + $c2 = $yP - $m2 * $xP; + eval { $factor = 1 / ($m1 - $m2)}; + PrintFatalError("Division by zero",$lc) if $@; + return (($c2 - $c1) * $factor, ($m1 * $c2 - $m2 * $c1) * $factor); + } + + sub Length { + my ($xA, $yA, $xB, $yB)=@_; + return sqrt(($xB - $xA)**2 + ($yB - $yA)**2); + } + + sub triangleArea { + my ($xA, $yA, $xB, $yB, $xC, $yC)=@_; + my ($lenAB, $lenBC, $lenCA, $s); + + $lenAB = Length($xA,$yA,$xB,$yB); + $lenBC = Length($xB,$yB,$xC,$yC); + $lenCA = Length($xC,$yC,$xA,$yA); + $s = ($lenAB + $lenBC + $lenCA) / 2; + return sqrt($s * ($s - $lenAB)*($s - $lenBC)*($s - $lenCA)); + } + + sub pointOnLine { + my ($xA, $yA, $xB, $yB, $dist)=@_; + my ($deltax, $deltay, $xPol, $yPol); + + $deltax = $xB - $xA; + $deltay = $yB - $yA; + $xPol = $xA + ($dist * $deltax / &Length($xA,$yA,$xB,$yB)); + $yPol = $yA + ($dist * $deltay / &Length($xA,$yA,$xB,$yB)); + return ($xPol, $yPol); + } + + + + sub circumCircleCenter { + my ($xA, $yA, $xB, $yB, $xC, $yC, $lc)=@_; + my ($deltay12, $deltax12, $xs12, $ys12); + my ($deltay23, $deltax23, $xs23, $ys23); + my ($xcc, $ycc); + my ($m23, $mr23, $c23, $m12, $mr12, $c12); + my ($sideA, $sideB, $sideC, $a, $radius); + + if (abs(triangleArea($xA, $yA, $xB, $yB, $xC, $yC)) < 0.0000001) + { + PrintErrorMessage("Area of triangle is zero!",$lc); + return (0,0,0); + } + $deltay12 = $yB - $yA; + $deltax12 = $xB - $xA; + $xs12 = $xA + $deltax12 / 2; + $ys12 = $yA + $deltay12 / 2; + # + $deltay23 = $yC - $yB; + $deltax23 = $xC - $xB; + $xs23 = $xB + $deltax23 / 2; + $ys23 = $yB + $deltay23 / 2; + # + CCXYLINE:{ + if (abs($deltay12) < 0.0000001) + { + $xcc = $xs12; + if (abs($deltax23) < 0.0000001) + { + $ycc = $ys23; + last CCXYLINE; + } + else + { + $m23 = $deltay23 / $deltax23; + $mr23 = -1 / $m23; + $c23 = $ys23 - $mr23 * $xs23; + $ycc = $mr23 * $xs12 + $c23; + last CCXYLINE; + } + } + if (abs($deltax12) < 0.0000001) + { + $ycc = $ys12; + if (abs($deltay23) < 0.0000001) + { + $xcc = $xs23; + last CCXYLINE; + } + else + { + $m23 = $deltay23 / $deltax23; + $mr23 = -1 / $m23; + $c23 = $ys23 - $mr23 * $xs23; + $xcc = ($ys12 - $c23) / $mr23; + last CCXYLINE; + } + } + if (abs($deltay23) < 0.0000001) + { + $xcc = $xs23; + if (abs($deltax12) < 0.0000001) + { + $ycc = $ys12; + last CCXYLINE; + } + else + { + $m12 = $deltay12 / $deltax12; + $mr12 = -1 / $m12; + $c12 = $ys12 - $mr12 * $xs12; + $ycc = $mr12 * $xcc + $c12; + last CCXYLINE; + } + } + if (abs($deltax23) < 0.0000001) + { + $ycc = $ys23; + if (abs($deltay12) < 0.0000001) + { + $xcc = $xs12; + last CCXYLINE; + } + else + { + $m12 = $deltay12 / $deltax12; + $mr12 = -1 / $m12; + $c12 = $ys12 - $mr12 * $xs12; + $xcc = ($ycc - $c12) / $mr12; + last CCXYLINE; + } + } + $m12 = $deltay12 / $deltax12; + $mr12 = -1 / $m12; + $c12 = $ys12 - $mr12 * $xs12; + #----- + $m23 = $deltay23 / $deltax23; + $mr23 = -1 / $m23; + $c23 = $ys23 - $mr23 * $xs23; + $xcc = ($c23 - $c12) / ($mr12 - $mr23); + $ycc = ($c23 * $mr12 - $c12 * $mr23) / ($mr12 - $mr23); + } + # + $sideA = &Length($xA,$yA,$xB,$yB); + $sideB = &Length($xB,$yB,$xC,$yC); + $sideC = &Length($xC,$yC,$xA,$yA); + $a = triangleArea($xA, $yA, $xB, $yB, $xC, $yC); + $radius = ($sideA * $sideB * $sideC) / (4 * $a); + # + return ($xcc, $ycc, $radius); + } + + sub ComputeDist { + my ($lc) = $_[0]; + my ($v1, $v2); + + if (s/^((\+|-)?\d+(\.\d+)?([eE](\+|-)?\d+)?)//) #is it a number? + { + return ($1, 1); + } + elsif (/^[^\W\d_]\d{0,4}[^\W\d_]\d{0,4}/) #it is a pair of IDs? + { + s/^([^\W\d_]\d{0,4})//i; + $v1 = $1; + if (!exists($PointTable{lc($v1)})) { + if (exists($VarTable{lc($v1)})) { + return ($VarTable{lc($v1)}, 1); + } + PrintErrorMessage("Point $v1 has not been defined", $lc); + s/^\s*[^\W\d_]\d{0,4}//i; + return (0,0); + } + $v1 = lc($v1); + s/^\s*([^\W\d_]\d{0,4})//i; + $v2 = $1; + if (!exists($PointTable{lc($v2)})) + { + PrintErrorMessage("Point $v2 has not been defined", $lc); + return (0,0); + } + $v2 = lc($v2); + my ($x1,$y1,$pSV1,$pS1) = unpack("d3A*",$PointTable{$v1}); + my ($x2,$y2,$pSV2,$pS2) = unpack("d3A*",$PointTable{$v2}); + return (Length($x1,$y1,$x2,$y2), 1); + } + elsif (s/^([^\W\d_]\d{0,4})//i) # it is a single id + { + $v1 = $1; + if (!exists($VarTable{lc($v1)})) #it isn't a variable + { + PrintErrorMessage("Variable $v1 has not been defined", $lc); + return (0,0); + } + return ($VarTable{lc($v1)}, 1); + } + else + { + PrintErrorMessage("Unexpected token", $lc); + return (0,0); + } + } + + sub intersection4points { + my ($x1, $y1, $x2, $y2, $x3, $y3, $x4, $y4) = @_; + my ($deltay12, $deltax12, $deltay34, $deltax34); + my ($xcc, $ycc, $m34, $c34, $m12, $c12); + + $deltay12 = $y2 - $y1; + $deltax12 = $x2 - $x1; + # + $deltay34 = $y4 - $y3; + $deltax34 = $x4 - $x3; + I4PXYLINE:{ + if (abs($deltay12) < 0.0000001) + { + $ycc = $y1; + if (abs($deltax34) < 0.0000001) + { + $xcc = $x3; + last I4PXYLINE; + } + else + { + $m34 = $deltay34 / $deltax34; + $c34 = $y3 - $m34 * $x3; + $xcc = ($ycc - $c34) / $m34; + last I4PXYLINE; + } + } + if (abs($deltax12) < 0.0000001) + { + $xcc = $x1; + if (abs($deltay34) < 0.0000001) + { + $ycc = $y3; + last I4PXYLINE; + } + else + { + $m34 = $deltay34 / $deltax34; + $c34 = $y3 - $m34 * $x3; + $ycc = $m34 * $xcc + $c34; + last I4PXYLINE; + } + } + if (abs($deltay34) < 0.0000001) + { + $ycc = $y3; + if (abs($deltax12) < 0.0000001) + { + $xcc = $x1; + last I4PXYLINE; + } + else + { + $m12 = $deltay12 / $deltax12; + $c12 = $y1 - $m12 * $x1; + $xcc = ($ycc - $c12) / $m12; + last I4PXYLINE; + } + } + if (abs($deltax34) < 0.0000001) + { + $xcc = $x3; + if (abs($deltay12) < 0.0000001) + { + $ycc = $y1; + last I4PXYLINE; + } + else + { + $m12 = $deltay12 / $deltax12; + $c12 = $y1 - $m12 * $x1; + $ycc = $m12 * $xcc + $c12; + last I4PXYLINE; + } + } + $m12 = $deltay12 / $deltax12; + $c12 = $y1 - $m12 * $x1; + $m34 = $deltay34 / $deltax34; + $c34 = $y3 - $m34 * $x3; + $xcc = ($c34 - $c12) / ($m12 - $m34); + $ycc = ($c34 * $m12 - $c12 * $m34) / ($m12 - $m34); + } + return ($xcc, $ycc); + } + + sub IncircleCenter { + my ($Ax, $Ay, $Bx, $By, $Cx, $Cy) = @_; + my ($sideA, $sideB, $sideC); + my ($ba1, $xA1, $yA1, $cb1, $ac1, $xB1, $yB1, $xC1, $yC1, $a, $s, $r); + + #determine the lengths of the sides + $sideA = Length($Bx, $By, $Cx, $Cy); + $sideB = Length($Cx, $Cy, $Ax, $Ay); + $sideC = Length($Ax, $Ay, $Bx, $By); + # + $ba1 = ($sideC * $sideA) / ($sideB + $sideC); + ($xA1, $yA1) = pointOnLine($Bx, $By, $Cx, $Cy, $ba1); + $cb1 = ($sideA * $sideB) / ($sideC + $sideA); + ($xB1, $yB1) = pointOnLine($Cx, $Cy, $Ax, $Ay, $cb1); + $ac1 = ($sideB * $sideC) / ($sideA + $sideB); + ($xC1, $yC1) = pointOnLine($Ax, $Ay, $Bx, $By, $ac1); + ($xcenter, $ycenter) = &intersection4points($Ax, $Ay, $xA1, $yA1, + $Bx, $By, $xB1, $yB1); + # get radius + $a = &triangleArea($Ax, $Ay, $Bx, $By, $Cx, $Cy); + $s = ($sideA + $sideB +$sideC) / 2; + $r = $a / $s; + return ($xcenter, $ycenter, $r); + } + + sub Angle { + my ($Ax, $Ay, $Bx, $By, $Cx, $Cy) = @_; + my ($RAx, $RAy, $RBx, $RBy, $RCx, $RCy, $deltax, $deltay); + my ($lineBA, $lineBC, $lineAC, $k, $kk, $angle); + my ($T, $cosT, $sinT) = (0.3, cos(0.3), sin(0.3)); + + $RAx = $Ax * $cosT + $Ay * $sinT; + $RAy = -$Ax * $sinT + $Ay * $cosT; + $RBx = $Bx * $cosT + $By * $sinT; + $RBy = -$Bx * $sinT + $By * $cosT; + $RCx = $Cx * $cosT + $Cy * $sinT; + $RCy = -$Cx * $sinT + $Cy * $cosT; + $deltax = $RBx - $RAx; + $deltay = $RBy - $RAy; + $lineBA = sqrt($deltax*$deltax + $deltay*$deltay); + if ($lineBA < 0.0000001) + { + return -500; + } + $deltax = $RBx - $RCx; + $deltay = $RBy - $RCy; + $lineBC = sqrt($deltax*$deltax + $deltay*$deltay); + if ($lineBC < 0.0000001) + { + return -500; + } + $deltax = $RAx - $RCx; + $deltay = $RAy - $RCy; + $lineAC = sqrt($deltax*$deltax + $deltay*$deltay); + if ($lineAC < 0.0000001) + { + return -500; + } + $k = ($lineBA*$lineBA + $lineBC*$lineBC - $lineAC*$lineAC ) / + (2 * $lineBA * $lineBC); + $k = -1 if $k < -0.99999; + $k = 1 if $k > 0.99999; + $kk = $k * $k; + if (($kk * $kk) == 1) + { + $angle = PI if $k == -1; + $angle = 0 if $k == 1; + } + else + { + $angle = (PI / 2) - atan2($k / sqrt(1 - $kk),1); + } + return $angle * 180 / PI; + } + + sub excircle { + my ($A, $B, $C, $D, $E) = @_; + my ($Ax,$Ay,$Bx,$By,$Dx,$Dy,$Ex,$Ey,$ASVA,$ASA); + ($Ax,$Ay,$ASVA,$ASA)=unpack("d3A*",$PointTable{$A}); + ($Bx,$By,$ASVA,$ASA)=unpack("d3A*",$PointTable{$B}); + ($Cx,$Cy,$ASVA,$ASA)=unpack("d3A*",$PointTable{$C}); + ($Dx,$Dy,$ASVA,$ASA)=unpack("d3A*",$PointTable{$D}); + ($Ex,$Ey,$ASVA,$ASA)=unpack("d3A*",$PointTable{$E}); + my ($sideA, $sideB, $sideC, $s, $R, $theAdeg, $d); + my ($Xmypoint, $Ymypoint, $deltax, $deltay, $mylength, $xc, $yc); + + $sideA = &Length($Bx, $By, $Cx, $Cy); + $sideB = &Length($Cx, $Cy, $Ax, $Ay); + $sideC = &Length($Ax, $Ay, $Bx, $By); + $s = ($sideA + $sideB + $sideC) / 2; + $R = triangleArea($Ax, $Ay, $Bx, $By, $Cx, $Cy) / + ($s - &Length($Dx, $Dy, $Ex, $Ey)); + if (($D eq $A && $E eq $B) || ($D eq $B && $E eq $A)) + { + $theAdeg = &Angle($Bx, $By, $Cx, $Cy, $Ax, $Ay); + $Xmypoint = $Cx; + $Ymypoint = $Cy; + } + elsif (($D eq $B && $E eq $C) || ($D eq $C && $E eq $B)) + { + $theAdeg = &Angle($Cx, $Cy, $Ax, $Ay, $Bx, $By); + $Xmypoint = $Ax; + $Ymypoint = $Ay; + } + elsif (($D eq $C && $E eq $A) || ($D eq $A && $E eq $C)) + { + $theAdeg = &Angle($Ax, $Ay, $Bx, $By, $Cx, $Cy); + $Xmypoint = $Bx; + $Ymypoint = $By; + } + else + { + return (0,0,0); + } + $d = $R / sin($theAdeg * PI / 180 / 2); + my ($xIn, $yIn, $rin) = &IncircleCenter($Ax, $Ay, $Bx, $By, $Cx, $Cy); + $deltax = $xIn - $Xmypoint; + $deltay = $yIn - $Ymypoint; + $mylength = sqrt($deltax*$deltax + $deltay*$deltay); + $xc = $Xmypoint + $d * $deltax / $mylength; + $yc = $Ymypoint + $d * $deltay / $mylength; + return ($xc, $yc, $R); + } + + sub DrawLineOrArrow { + my $draw_Line = shift; + my $lc = shift; + my $lineLength = -1; + my $stacklen = 0; + my @PP = (); + # if ($draw_Line != 2) { + # s/\s*//; + # if (s/^\[\s*//) { # optional length specifier + # $lineLength = expr($lc); + # if ($lineLength <= 0) { + # PrintErrorMessage("length must greater than zero",$lc); + # $lineLength = -1; + # } + # chk_rsb("optional part",$lc); + # } + # } + chk_lparen("$cmd",$lc); + DRAWLINES:while(1) { + @PP = () ; + while(1) { + if (s/^([^\W\d_]\d{0,4})\s*//i) { #point name + $P = $1; + if (!exists($PointTable{lc($P)})) { + PrintErrorMessage("Undefined point $P",$lc); + } + else { + push (@PP,$P); + } + } + else { + $stacklen = @PP; + if ($draw_Line != 2) { + if ($stacklen <= 1) { + PrintErrorMessage("Wrong number of points",$lc); + } + else { + push(@PP,$lc); + if ($draw_Line == 0) { + drawarrows(@PP); + } + elsif ($draw_Line == 1) { + drawlines(@PP); + } + } + } + if (s/^,\s*// and $draw_Line != 2) { + next DRAWLINES; + } + else { + last DRAWLINES; + } + } + } + } + if ($draw_Line == 2) { + $stacklen = @PP; + if ($stacklen < 2) { + PrintErrorMessage("Wrong number of points",$lc); + } + elsif ($stacklen % 2 == 0) { + PrintErrorMessage("Number of points must be odd",$lc); + } + else { + drawCurve(@PP); + } + } + chk_rparen("arguments of $cmd",$lc); + chk_comment($lc); + } + + sub drawarrows { + my ($NoArgs); + $NoArgs = @_; + my ($lc) = $_[$NoArgs-1]; #line number is the last argument + my ($NumberOfPoints, $p, $q, $r12, $d12); + my ($px,$py,$pSV,$pS, $qx,$qy,$qSV,$qS); + + $NumberOfPoints = $NoArgs - 1; + LOOP: for(my $i=0; $i < $NumberOfPoints - 1; $i++) + { + $p = $_[$i]; + $q = $_[$i+1]; + ($px,$py,$pSV,$pS) = unpack("d3A*",$PointTable{lc($p)}); + ($qx,$qy,$qSV,$qS) = unpack("d3A*",$PointTable{lc($q)}); + $pSV = $defaultLFradius if $pSV == 0; + $qSV = $defaultLFradius if $qSV == 0; + $r12 = $pSV + $qSV; + $d12 = Length($px,$py,$qx,$qy); + if ($d12 <= $r12) + { + if($d12 == 0) + { + PrintErrorMessage("points $p and $q are the same", $lc); + next LOOP; + } + PrintWarningMessage("arrow $p$q not drawn: points too close or ". + "radii too big", $lc); + next LOOP; + } + ($px, $py) = pointOnLine($px, $py, $qx, $qy, $pSV) if $pSV > 0; + ($qx, $qy) = pointOnLine($qx, $qy, $px, $py, $qSV) if $qSV > 0; + my ($beta, $gamma); + $beta = tan($arrowAngleB * D2R / 2); + $gamma = 2 * tan($arrowAngleC * D2R / 2); + printf OUT "\\arrow <%.5f%s> [%.5f,%.5f] from %.5f %.5f to %.5f %.5f\n", + $arrowLength, $arrowLengthUnits, $beta, $gamma, $px, $py, $qx, $qy; + } + } + + sub drawlines { + my ($NoArgs); + $NoArgs = @_; + my ($lc) = $_[$NoArgs-1]; #line number is the last argument + my ($NumberOfPoints, $p, $q, $r12, $d12); + my ($px,$py,$pSV,$pS, $qx,$qy,$qSV,$qS); + + $NumberOfPoints = $NoArgs - 1; + LOOP: for(my $i=0; $i < $NumberOfPoints - 1; $i++) + { + $p = $_[$i]; + $q = $_[$i+1]; + ($px,$py,$pSV,$pS) = unpack("d3A*",$PointTable{lc($p)}); + ($qx,$qy,$qSV,$qS) = unpack("d3A*",$PointTable{lc($q)}); + $pSV = $defaultLFradius if $pSV == 0; + $qSV = $defaultLFradius if $qSV == 0; + $r12 = $pSV + $qSV; + $d12 = Length($px,$py,$qx,$qy); + if ($d12 <= $r12) + { + if($d12 == 0) + { + PrintErrorMessage("points $p and $q are the same", $lc); + next LOOP; + } + PrintWarningMessage("line $p$q not drawn: points too close or ". + "radii too big", $lc); + next LOOP; + } + ($px, $py) = pointOnLine($px, $py, $qx, $qy, $pSV) if $pSV > 0; + ($qx, $qy) = pointOnLine($qx, $qy, $px, $py, $qSV) if $qSV > 0; + if ($px == $qx || $py == $qy) + { + printf OUT "\\putrule from %.5f %.5f to %.5f %.5f %%%% %s%s\n", + $px,$py,$qx,$qy,$p,$q; + } + else + { + printf OUT "\\plot %.5f %.5f\t%.5f %.5f / %%%% %s%s\n", + $px, $py,$qx,$qy,$p,$q; + } + } + } + + sub drawCurve { + my ($NoArgs); + $NoArgs = @_; + my ($lc) = $_[$NoArgs-1]; #line number is the last argument + my ($NumberOfPoints, $p); + + $NumberOfPoints = $NoArgs - 1; + print OUT "\\setquadratic\n\\plot\n"; + for(my $i=0; $i <= $NumberOfPoints; $i++) + { + $p = $_[$i]; + my ($px,$py,$pSV,$pS) = unpack("d3A*",$PointTable{lc($p)}); + printf OUT "\t%0.5f %0.5f", $px, $py; + print OUT (($i == $NumberOfPoints) ? " / %$p\n" : " %$p\n"); + } + print OUT "\\setlinear\n"; + } + + sub drawpoints { + my ($NumberOfPoints,$p); + $NumberOfPoints = @_; + my ($px,$py,$pSV,$pS); + + for($i=0; $i < $NumberOfPoints; $i++) + { + $p = $_[$i]; + ($px,$py,$pSV,$pS) = unpack("d3A*",$PointTable{lc($p)}); + if ($pS eq "" and $defaultsymbol =~ /circle|square/) { + $pS = $defaultsymbol; + } + POINTSWITCH: { + if ($pS eq "") # no plot symbol specified + { + printf OUT "\\put {%s} at %.5f %.5f %%%% %s\n", + $defaultsymbol, $px, $py, $p; + last POINTSWITCH; + } + if ($pS eq "circle") # plot symbol is a circle + { + my $radius = (defined($DimOfPoint{lc($p)})) ? $DimOfPoint{lc($p)} : + $GlobalDimOfPoints; + if ($radius > 0) # draw a circle using the current units + { + if ($radius == 1.5) # use \bigcirc + { + printf OUT "\\put {\$\\bigcirc\$} at %.5f %.5f %%%% %s\n", + $px, $py, $p; + } + else + { + printf OUT "\\circulararc 360 degrees from %.5f %.5f center at %.5f %.5f %%%% %s\n", + $px+$radius, $py, $px, $py, $p; + } + } + else #use \circ symbol + { + printf OUT "\\put {\$\\circ\$} at %.5f %.5f %%%% %s\n", + $px,$py,$p; + } + last POINTSWITCH; + } + if ($pS eq "square") + { + my $side = (defined($DimOfPoint{lc($p)})) ? $DimOfPoint{lc($p)} : + $GlobalDimOfPoints; + printf OUT "\\put {%s} at %.5f %.5f %%%% %s\n", + drawsquare($side), $px, $py, $p; + last POINTSWITCH; + } + printf OUT "\\put {%s} at %.5f %.5f %%%% %s\n", $pS,$px,$py,$p; + } + } + } + + sub drawAngleArc { + my ($P1, $P2, $P3, $radius, $inout, $direction) = @_; + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$P1}); + my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$P2}); + my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$P3}); + + my $internalAngle = Angle($x1, $y1, $x2, $y2, $x3, $y3); + my $externalAngle = 360 - $internalAngle; + my ($x, $y) = pointOnLine($x2, $y2, $x1, $y1, $radius); + my $code = ""; + if ($inout eq "internal" and $direction eq "clockwise" ) { + $code = sprintf "\\circulararc %.5f degrees from %.5f %.5f center at %.5f %.5f\n", + -1 * $internalAngle, $x, $y, $x2, $y2; + } + elsif ($inout eq "internal" and $direction eq "anticlockwise" ) { + $code = sprintf "\\circulararc %.5f degrees from %.5f %.5f center at %.5f %.5f\n", + $internalAngle, $x, $y, $x2, $y2; + } + elsif ($inout eq "external" and $direction eq "clockwise" ) { + $code = sprintf "\\circulararc %.5f degrees from %.5f %.5f center at %.5f %.5f\n", + -1 * $externalAngle, $x, $y, $x2, $y2; + } + elsif ($inout eq "external" and $direction eq "anticlockwise" ) { + $code = sprintf "\\circulararc %.5f degrees from %.5f %.5f center at %.5f %.5f\n", + $externalAngle, $x, $y, $x2, $y2; + } + return $code; + } + + sub drawAngleArrow { + my ($P1, $P2, $P3, $radius, $inout, $direction) = @_; + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$P1}); + my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$P2}); + my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$P3}); + + my $code = drawAngleArc($P1, $P2, $P3, $radius, $inout, $direction); + + my ($xqp, $yqp) = pointOnLine($x2, $y2, $x1, $y1, $radius); + my ($deltax, $deltay) = ($x1 - $x2, $y1 - $y2); + my $AL; + + if ($xunits =~ /mm/) { + $AL = 1; + } + elsif ($xunits =~ /cm/) { + $AL = 0.1; + } + elsif ($xunits =~ /pt/) { + $AL = 2.845; + } + elsif ($xunits =~ /bp/) { + $AL = 2.835; + } + elsif ($xunits =~ /pc/) { + $AL = 0.2371; + } + elsif ($xunits =~ /in/) { + $AL = 0.03937; + } + elsif ($xunits =~ /dd/) { + $AL = 2.659; + } + elsif ($xunits =~ /cc/) { + $AL = 0.2216; + } + elsif ($xunits =~ /sp/) { + $AL = 186467.98; + } + my $halfAL = $AL / 2; + my $d = sqrt($radius * $radius - $halfAL * $halfAL); + my $alpha = atan2($d / $halfAL, 1) * R2D; + my $beta = 2 * (90 - $alpha); + my $thetaqr; + if (abs($deltay) < 0.00001) { + if ($deltax > 0 ) {$thetaqr = 0 } + elsif ($deltax < 0) {$thetaqr = -180} + } + else { + if (abs($deltax) < 0.00001) { + $thetaqr = 90; + } + else { + $thetaqr = atan2($deltay / $deltax, 1) * R2D; + } + } + my ($xqr, $yqr) = pointOnLine($x2, $y2, $x3, $y3, $radius); + $deltax = $x3 - $x2; + $deltay = $y3 - $y2; + $alpha = atan2(sqrt($radius * $radius - $halfAL * $halfAL) / $halfAL, 1) / + D2R; + $beta = 2 * (90 - $alpha); + LINE2 : { + if (abs($deltax) < 0.00001) { + if ($deltay > 0) { $thetaqr = 90 } + elsif ($deltay < 0) { $thetaqr = - 90 } + last LINE2; + } + else { + $thetaqr = atan2($deltay / $deltax, 1) * R2D; + } + if (abs($deltay) < 0.00001) { + if ($deltax > 0) { $thetaqr = 0 } + elsif ($deltax < 0) { $thetaqr = -180 } + last LINE2; + } + else { + $thetaqr = atan2($deltay / $deltax, 1) * R2D; + } + if ($deltax < 0 and $deltay > 0) { $thetaqr += 180 } + elsif ($deltax < 0 and $deltay < 0) { $thetaqr += 180 } + elsif ($deltax > 0 and $deltay < 0) { $thetaqr += 360 } + } + my $xqrleft = $x2 + $radius * cos(($thetaqr + $beta) * D2R); + my $yqrleft = $y2 + $radius * sin(($thetaqr + $beta) * D2R); + my $xqrright = $x2 + $radius * cos(($thetaqr - $beta) * D2R); + my $yqrright = $y2 + $radius * sin(($thetaqr - $beta) * D2R); + if ($inout eq "internal" and $direction eq "clockwise") { + $code .= sprintf "\\arrow <1.5mm> [0.5, 1] from %.5f %.5f to %.5f %.5f\n", + $xqrleft, $yqrleft, $xqr, $yqr; + } + elsif ($inout eq "internal" and $direction eq "anticlockwise") { + $code .= sprintf "\\arrow <1.5mm> [0.5, 1] from %.5f %.5f to %.5f %.5f\n", + $xqrright, $yqrright, $xqr, $yqr; + } + elsif ($inout eq "external" and $direction eq "clockwise") { + $code .= sprintf "\\arrow <1.5mm> [0.5, 1] from %.5f %.5f to %.5f %.5f\n", + $xqrleft, $yqrleft, $xqr, $yqr; + } + elsif ($inout eq "external" and $direction eq "anticlockwise") { + $code .= sprintf "\\arrow <1.5mm> [0.5, 1] from %.5f %.5f to %.5f %.5f\n", + $xqrright, $yqrright, $xqr, $yqr; + } + return $code; + } + + sub expr { + my $lc = $_[0]; + my($left,$op,$right); + + $left = term($lc); + while ($op = addop()) { + $right = term($lc); + if ($op eq '+') + { $left += $right } + else + { $left -= $right } + } + return $left; + } + + sub addop { + s/^([+-])// && $1; + } + + sub term { + my $lc = $_[0]; + my ($left, $op, $right); + $left = factor($lc); + while ($op = mulop()) { + $right = factor($lc); + if ($op eq '*') + { $left *= $right } + elsif ($op =~ /rem/i) { + eval {$left %= $right}; + PrintFatalError("Division by zero", $lc) if $@; + } + else { + eval {$left /= $right}; + PrintFatalError("Division by zero", $lc) if $@; + } + } + return $left; + } + + sub mulop { + (s#^([*/])## || s/^(rem)//i) && lc($1); + } + + sub factor { + my $lc = $_[0]; + my ($left); + + $left = primitive($lc); + if (s/^\*\*//) { + $left **= factor($lc); + } + return $left; + } + + sub primitive { + my $lc = $_[0]; + my $val; + s/\s*//; + if (s/^\(//) { #is it an expr in parentheses + $val = expr($lc); + s/^\)// || PrintErrorMessage("Missing right parenthesis", $lc); + } + elsif (s/^-//) { # is it a negated primitive + $val = - primitive(); + } + elsif (s/^\+//) { # is it a positive primitive + $val = primitive(); + } + elsif (s/^angledeg//i) { + chk_lparen("angledeg",$lc); + my $point_1 = get_point($lc); + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1}); + my $point_2 = get_point($lc); + my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2}); + my $point_3 = get_point($lc); + my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point_3}); + my $d12 = Length($x1, $y1, $x2, $y2); + my $d23 = Length($x2, $y2, $x3, $y3); + my $d31 = Length($x3, $y3, $x1, $y1); + if ( $d12 == 0 ) { + PrintErrorMessage("points `$point_1' and `$point_2' are the same", $lc); + $val = 0; + } + elsif ( $d23 == 0 ) { + PrintErrorMessage("points `$point_2' and `$point_3' are the same", $lc); + $val = 0; + } + elsif ( $d31 == 0 ) { + PrintErrorMessage("points `$point_1' and `$point_3' are the same", $lc); + $val = 0; + } + else { + $val = Angle($x1, $y1, $x2, $y2, $x3, $y3); + $val = 0 if $val == -500; + } + chk_rparen("Missing right parenthesis", $lc); + } + elsif (s/^angle//i) { + chk_lparen("angle",$lc); + my $point_1 = get_point($lc); + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1}); + my $point_2 = get_point($lc); + my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2}); + my $point_3 = get_point($lc); + my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point_3}); + my $d12 = Length($x1, $y1, $x2, $y2); + my $d23 = Length($x2, $y2, $x3, $y3); + my $d31 = Length($x3, $y3, $x1, $y1); + if ( $d12 == 0 ) { + PrintErrorMessage("points `$point_1' and `$point_2' are the same", $lc); + $val = 0; + } + elsif ( $d23 == 0 ) { + PrintErrorMessage("points `$point_2' and `$point_3' are the same", $lc); + $val = 0; + } + elsif ( $d31 == 0 ) { + PrintErrorMessage("points `$point_1' and `$point_3' are the same", $lc); + $val = 0; + } + else { + $val = Angle($x1, $y1, $x2, $y2, $x3, $y3); + if ($val == -500) { + $val = 0; + } + else { + $val = D2R * $val; + } + } + chk_rparen("Missing right parenthesis", $lc); + } + elsif (s/^area//i) { + chk_lparen("angledeg",$lc); + my $point_1 = get_point($lc); + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1}); + my $point_2 = get_point($lc); + my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2}); + my $point_3 = get_point($lc); + my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point_3}); + $val = triangleArea($x1, $y1, $x2, $y2, $x3, $y3); + chk_rparen("Missing right parenthesis", $lc); + } + elsif (s/^asin//i) { + chk_lparen("asin"); + $val = expr(); + PrintFatalError("Can't take asin of $val", $lc) if $val < -1 || $val > 1; + $val = asin($val); + chk_rparen("Missing right parenthesis", $lc); + } + elsif (s/^acos//i) { + chk_lparen("acos"); + $val = expr(); + PrintFatalError("Can't take acos of $val", $lc) if $val < -1 || $val > 1 ; + $val = acos($val); + chk_rparen("Missing right parenthesis", $lc); + } + elsif (s/^atan//i) { + chk_lparen("atan"); + $val = expr(); + $val = atan($val); + chk_rparen("Missing right parenthesis", $lc); + } + elsif (s/^cos//i) { + chk_lparen("cos"); + $val = expr(); + $val = cos($val); + chk_rparen("Missing right parenthesis", $lc); + } + elsif (s/^directiondeg//i) { + chk_lparen("directiondeg",$lc); + my $point_1 = get_point($lc); + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1}); + my $point_2 = get_point($lc); + my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2}); + my $x3 = $x1+1; + if ( ($y2 - $y1) >= 0) { + $val = Angle($x3, $y1, $x1, $y1, $x2, $y2); + $val = 0 if $val == -500; + } + else { + $val = 360 - Angle($x3, $y1, $x1, $y1, $x2, $y2); + $val = 0 if $val == -500; + } + chk_rparen("Missing right parenthesis", $lc); + } + elsif (s/^direction//i) { + chk_lparen("direction",$lc); + my $point_1 = get_point($lc); + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1}); + my $point_2 = get_point($lc); + my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2}); + my $x3 = $x1+1; + if ( ($y2 - $y1) >= 0) { + $val = Angle($x3, $y1, $x1, $y1, $x2, $y2); + $val = 0 if $val == -500; + $val = D2R * $val; + } + else { + $val = 360 - Angle($x3, $y1, $x1, $y1, $x2, $y2); + $val = 0 if $val == -500; + $val = D2R * $val; + } + chk_rparen("Missing right parenthesis", $lc); + } + elsif (s/^exp//i) { + chk_lparen("exp"); + $val = expr(); + $val = exp($val); + chk_rparen("Missing right parenthesis", $lc); + } + elsif (s/^int//i) { + chk_lparen("int"); + $val = expr(); + $val = int($val); + chk_rparen("Missing right parenthesis", $lc); + } + elsif (s/^log//i) { + chk_lparen("log"); + $val = expr(); + PrintFatalError("Can't take log of $val", $lc) if $val <= 0; + $val = log($val); + chk_rparen("Missing right parenthesis", $lc); + } + elsif (s/^sin//i) { + chk_lparen("sin"); + $val = expr(); + $val = sin($val); + chk_rparen("Missing right parenthesis", $lc); + } + elsif (s/^sgn//i) { + chk_lparen("sgn"); + $val = expr(); + if ($val > 0) { + $val = 1; + } + elsif ($val == 0) { + $val = 0; + } + else { + $val = -1; + } + chk_rparen("Missing right parenthesis", $lc); + } + elsif (s/^sqrt//i) { + chk_lparen("sqrt"); + $val = expr(); + $val = sqrt($val); + chk_rparen("Missing right parenthesis", $lc); + } + elsif (s/^tan//i) { + chk_lparen("tan"); + $val = expr(); + $val = sin($val)/cos($val); + chk_rparen("Missing right parenthesis", $lc); + } + elsif (s/^xcoord//i) { + chk_lparen("xcoord"); + my $point_name = get_point; + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_name}); + $val = $x1; + chk_rparen("Missing right parenthesis", $lc); + } + elsif (s/^ycoord//i) { + chk_lparen("ycoord"); + my $point_name = get_point; + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_name}); + $val = $y1; + chk_rparen("Missing right parenthesis", $lc); + } + elsif (s/^_pi_//i) { + $val = PI; + } + elsif (s/^_e_//i) { + $val = 2.71828182845905; + } + elsif (s/^_linethickness_//i) { + $val = $LineThickness / $xunits; + } + else { + my $err_code; + ($val,$err_code) = ComputeDist($lc); + } + s/\s*//; + return $val; + } + + sub memberOf { + my $elem = shift(@_); + + my $found = 0; + foreach $item (@_){ + if ($item eq $elem){ + $found = 1; + last; + } + } + return $found; + } + + sub midpoint { + my ($x1, $y1, $x2, $y2)=@_; + return ($x1 + ($x2 - $x1)/2, + $y1 + ($y2 - $y1)/2); + } + + + sub tand { + my $d = $_[0]; + $d = $d * PI / 180; + return sin($d)/cos($d); + } + + sub get_string { + my $string = shift; + my $lc = shift; + + $string =~ s/^\s+//; + if ($string !~ s/^\"//) { + PrintErrorMessage("No starting \" found",$lc); + return (1,$string,$string); + } + my @ch = split //,$string; + my @cmd; + while (@ch and $ch[0] ne "\"") { + if ($ch[0] eq "\\" and (defined $ch[1]) and $ch[1] eq "\"") { + shift @ch; + push @cmd, $ch[0]; + shift @ch; + } + else { + push @cmd, $ch[0]; + shift @ch; + } + } + if (! defined $ch[0]) { + PrintErrorMessage("No closing \" found",$lc); + return (1,join("",@cmd), join("",@ch)) + } + else { + shift @ch; + return (0, join("",@cmd), join("",@ch)) + } + } + + sub is_tainted { + my $arg = shift; + my $nada = substr($arg,0,0); + local $@; + eval { eval "# $nada"}; + return length($@) != 0; + } + + sub noOfDigits { + my $num = $_[0]; + + if ($num =~ /^[\+-]?\d+(?!\.)/) { + return 0; + } + elsif ($num =~ /^[\+-]\d+\.(\d+)?/) { + return length($1); + } + } + + sub drawsquare { + my $s = $_[0]; + #$s *= sqrt(2); + $s = sprintf "%.5f", $s; + my $code = "\\setlength{\\unitlength}{$xunits}%\n"; + $code .= "\\begin{picture}($s,$s)\\put(0,0)" . + "{\\framebox($s,$s){}}\\end{picture}"; + return $code; + } + + sub X2sp { + my $LT = shift; + my $units = shift; + + if ($units eq "pc") { + return $LT * 786432; + } + elsif ($units eq "pt") { + return $LT * 65536; + } + elsif ($units eq "in") { + return $LT * 4736286.72; + } + elsif ($units eq "bp") { + return $LT * 65781.76; + } + elsif ($units eq "cm") { + return $LT * 1864679.811023622; + } + elsif ($units eq "mm") { + return $LT * 186467.981102362; + } + elsif ($units eq "dd") { + return $LT * 70124.086430424; + } + elsif ($units eq "cc") { + return $LT * 841489.037165082; + } + elsif ($units eq "sp") { + return $LT; + } + } + + + sub sp2X { + my $LT = shift; + my $units = shift; + + if ($units eq "pc") { + return $LT / 786432; + } + elsif ($units eq "pt") { + return $LT / 65536; + } + elsif ($units eq "in") { + return $LT / 4736286.72; + } + elsif ($units eq "bp") { + return $LT / 65781.76; + } + elsif ($units eq "cm") { + return $LT / 1864679.811023622; + } + elsif ($units eq "mm") { + return $LT / 186467.981102362; + } + elsif ($units eq "dd") { + return $LT / 70124.086430424; + } + elsif ($units eq "cc") { + return $LT / 841489.037165082; + } + elsif ($units eq "sp") { + return $LT; + } + } + + sub setLineThickness { + my $Xunits = shift; + my $LT = shift; + $Xunits =~ s/^((\+|-)?\d+(\.\d+)?([eE](\+|-)?\d+)?)//; + my $xlength = "$1"; + $Xunits =~ s/^\s*($units)//; + my $x_in_units = $1; + $LT =~ s/^((\+|-)?\d+(\.\d+)?([eE](\+|-)?\d+)?)//; + my $LTlength = "$1"; + $LT =~ s/^\s*($units)//; + my $LT_in_units = $1; + $LTlength = X2sp($LTlength,$LT_in_units); + $LTlength = sp2X($LTlength,$x_in_units); + return $LTlength; + } + + sub process_input { + my ($INFILE,$currInFile) = @_; + my $lc = 0; + my $no_output = 0; + $curr_in_file = $currInFile; + LINE: while(<$INFILE>) { + $lc++; + chomp($command = $_); + s/^\s+//; + if (/^beginSkip\s*/i) { + $no_output = 1; + print OUT "%%$_" if $comments_on; + next LINE; + } + elsif (/^endSkip\s*/i) { + if ($no_output == 0) { + PrintErrorMessage("endSkip without beginSkip",$lc); + } + else { + $no_output = 0; + } + print OUT "%%$_" if $comments_on and !$no_output; + next LINE; + } + elsif ($no_output == 1) { + next LINE; + } + else { + if (/^[^\\]/) { + my $out_line = mpp($command,$lc) unless /^\\/; #call macro pre-processor + $_ = "$out_line\n"; + } + + if (/^\s*%/) + { + print OUT "$_" if $comments_on; + } + elsif (s/^\s*(beginloop(?=\W))//i) { + s/\s+//; + my $times = expr($lc); + print OUT "%% BEGINLOOP $times\n" if $comments_on; + my @C = (); + REPEATCOMMS: while (<$INFILE>) { + if (/^\s*endloop/i) { + last REPEATCOMMS; + } + else { + push @C, $_; + } + } + if (! /^\s*endloop/i) { + PrintFatalError("unexpected end of file",$lc); + } + else { + s/^\s*endloop//i; + for(my $i=1; $i<=$times; $i++) { + tie *DUMMY, 'DummyFH', \@C; + process_input(DUMMY, $currInFile); + untie *DUMMY; + } + print OUT "%% ENDLOOP\n" if $comments_on; + } + } + elsif (s/^\s*(ArrowShape(?=\W))//i) + { + my $cmd = $1; + print OUT "%% $cmd$_" if $comments_on; + + chk_lparen("$cmd",$lc); + if (s/^default//i) { + $arrowLength = 2; + $arrowLengthUnits = "mm"; + $arrowAngleB = 30; + $arrowAngleC = 40; + } + else { + my ($LocalArrowLength, $LocalArrowAngleB ,$LocalArrowAngleC) = (0,0,0); + $LocalArrowLength = expr($lc); + if (s/^\s*($units)//i) { + $arrowLengthUnits = "$1"; + } + else { + $xunits =~ /(\d+(\.\d+)?)\s*($units)/; + $LocalArrowLength *= $1; + $arrowLengthUnits = "$3"; + } + chk_comma($lc); + $LocalArrowAngleB = expr($lc); + chk_comma($lc); + $LocalArrowAngleC = expr($lc); + $arrowLength = ($LocalArrowLength == 0 ? 2 : $LocalArrowLength); + $arrowLengthUnits = ($LocalArrowLength == 0 ? "mm" : $arrowLengthUnits); + $arrowAngleB = ($LocalArrowAngleB == 0 ? 30 : $LocalArrowAngleB); + $arrowAngleC = ($LocalArrowAngleC == 0 ? 40 : $LocalArrowAngleC); + } + chk_rparen("after $cmd arguments",$lc); + chk_comment("after $cmd command",$lc); + print OUT "%% arrowLength = $arrowLength$arrowLengthUnits, ", + "arrowAngleB = $arrowAngleB ", + "and arrowAngleC = $arrowAngleC\n" if $comments_on; + + } + elsif (s/^\s*(const(?=\W))//i) + { + print OUT "%% $1$_" if $comments_on; + do{ + s/\s*//; + PrintErrorMessage("no identifier found after token const",$lc) + if $_ !~ s/^([^\W\d_]\d{0,4})//i; + my $Constname = $1; + my $constname = lc($Constname); + if (exists $ConstTable{$constname}) { + PrintErrorMessage("Redefinition of constant $constname",$lc); + } + s/\s*//; #remove leading white space + PrintErrorMessage("did not find expected = sign",$lc) + if $_ !~ s/^[=]//i; + my $val = expr($lc); + $VarTable{$constname} = $val; + $ConstTable{$constname} = 1; + print OUT "%% $Constname = $val\n" if $comments_on; + }while (s/^,//); + chk_comment($lc); + s/\s*//; + if (/^[^%]/) { + PrintWarningMessage("Trailing text is ignored",$lc); + } + + } + elsif (s/^\s*(dasharray(?=\W))//i) + { + my ($cmd) = $1; + print OUT "%% $cmd$_" if $comments_on; + chk_lparen($cmd,$lc); + my @DashArray = (); + my $dash = ""; + my $dashpattern = ""; + PATTERN: while (1) { + $dash = sprintf("%.5f", expr($lc)); + if (s/^\s*($units)//i) { + push (@DashArray, "$dash$1"); + } + else { + PrintErrorMessage("Did not found unit after expression", $lc); + } + s/\s*//; + if (/^[^,]/) { + last PATTERN; + } + else { + s/^,\s*//; + } + } + print OUT "\\setdashpattern <"; + while (@DashArray) { + $dashpattern .= shift @DashArray; + $dashpattern .= ","; + } + $dashpattern =~ s/,$//; + print OUT $dashpattern, ">\n"; + chk_rparen("arguments of $cmd",$lc); + chk_comment($lc); + + } + elsif (s/^\s*(drawAngleArc(?=\W))//i or s/^\s*(drawAngleArrow(?=\W))//i ) + { + my $cmd = $1; + print OUT "%% $cmd$_" if $comments_on; + + chk_lcb($cmd,$lc); + my ($P1, $P2, $P3); + if (s/^angle(?=\W)//i) { + chk_lparen("token angle of command $cmd",$lc); + $P1 = get_point($lc); + next LINE if $P1 eq "_undef_"; + $P2 = get_point($lc); + next LINE if $P2 eq "_undef_"; + $P3 = get_point($lc); + next LINE if $P3 eq "_undef_"; + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$P1}); + my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$P2}); + my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$P3}); + my $Angle = Angle($x1, $y1, $x2, $y2, $x3, $y3); + if ($Angle <= 0) { + if ($Angle == 0) { + PrintErrorMessage("Angle is equal to zero",$lc); + next LINE; + } + elsif ($Angle < -400) { + PrintErrorMessage("Something is wrong with the points",$lc); + next LINE; + } + } + chk_rparen("angle part of command $cmd",$lc); + } + else { + PrintErrorMessage("Did not find expected angle part",$lc); + next LINE; + } + + s/^,\s*// or s/\s*//; #parse optional comma + + my $radius; + if (s/^radius(?=\W)//i) { + chk_lparen("token radius of command $cmd",$lc); + $radius = expr($lc); + chk_rparen("radius part of command $cmd",$lc); + } + else { + PrintErrorMessage("Did not found expected angle part",$lc); + next LINE; + } + + s/^,\s*// or s/\s*//; #parse optional comma + my $inout = ""; + if (s/^(internal(?=\W))//i or s/^(external(?=\W))//i) { + $inout = $1; + } + else { + PrintErrorMessage("Did not find expected 'internal' specifier", $lc); + next LINE; + } + s/^,\s*// or s/\s*//; #parse optional comma + my $direction = ""; + if (s/^(clockwise(?=\W))//i or s/^(anticlockwise(?=\W))//i) { + $direction = $1; + } + else { + PrintErrorMessage("Did not find expected 'direction' specifier", $lc); + next LINE; + } + chk_rcb("arguments of $cmd",$lc); + chk_comment($lc); + my $code; + if (lc($cmd) eq "drawanglearc") { + $code = drawAngleArc($P1, $P2, $P3, $radius, $inout, $direction); + } + else { + $code = drawAngleArrow($P1, $P2, $P3, $radius, $inout, $direction); + } + print OUT $code if $code ne ""; + + } + elsif (s/^\s*(drawArrow(?=\W))//i) + { + my ($cmd) = $1; + print OUT "%% $cmd$_" if $comments_on; + DrawLineOrArrow(0,$lc); + } + elsif (s/^\s*(drawcircle(?=\W))//i) + { + my ($cmd) = $1; + print OUT "%% $cmd$_" if $comments_on; + chk_lparen("drawcircle",$lc); + my $Point = get_point($lc); + next LINE if $Point eq "_undef_"; + chk_comma($lc); + my $R = expr($lc); + if ($R <= 0) { + PrintErrorMessage("Radius must be greater than zero",$lc); + next LINE; + } + my ($x,$y,$pSV,$pS)=unpack("d3A*",$PointTable{lc($Point)}); + printf OUT "\\circulararc 360 degrees from %.5f %.5f center at %.5f %.5f\n", + $x+$R, $y, $x, $y; + chk_rparen("arguments of $cmd",$lc); + chk_comment($lc); + + } + elsif (s/^\s*(drawcurve(?=\W))//i) + { + my ($cmd) = $1; + print OUT "%% $cmd$_" if $comments_on; + DrawLineOrArrow(2,$lc); + } + elsif (s/^\s*(drawcircumcircle(?=\W))//i) + { + my ($cmd) = $1; + print OUT "%% $cmd$_" if $comments_on; + chk_lparen("drawcircumcircle",$lc); + my $point1 = get_point($lc); + next LINE if $point1 eq "_undef_"; + my $point2 = get_point($lc); + next LINE if $point2 eq "_undef_"; + my $point3 = get_point($lc); + next LINE if $point3 eq "_undef_"; + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point1}); + my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point2}); + my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point3}); + my ($xc, $yc,$r) = circumCircleCenter($x1,$y1,$x2,$y2,$x3,$y3,$lc); + next LINE if $xc == 0 and $yc == 0 and $r == 0; + print OUT "%% circumcircle center = ($xc,$yc), radius = $r\n" if $comments_on; + printf OUT "\\circulararc 360 degrees from %.5f %.5f center at %.5f %.5f\n", + $xc+$r, $yc, $xc, $yc; + chk_rparen("arguments of $cmd",$lc); + chk_comment($lc); + + } + elsif (s/^\s*(drawexcircle(?=\W))//i) + { + my ($cmd) = $1; + print OUT "%% $cmd$_" if $comments_on; + chk_lparen("drawexcircle",$lc); + my $point1 = get_point($lc); + next LINE if $point1 eq "_undef_"; + my $point2 = get_point($lc); + next LINE if $point2 eq "_undef_"; + my $point3 = get_point($lc); + next LINE if $point3 eq "_undef_"; + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point1}); + my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point2}); + my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point3}); + if (triangleArea($x1, $y1, $x2, $y2, $x3, $y3) < 0.0001) { + PrintErrorMessage("Area of triangle is zero!",$lc); + next LINE; + } + chk_comma($lc); + my $point4 = get_point($lc); + if (!memberOf($point4, $point1, $point2, $point3)) { + PrintErrorMessage("Current point isn't a side point",$lc); + next LINE; + } + next LINE if $point4 eq "_undef_"; + my $point5 = get_point($lc); + next LINE if $point5 eq "_undef_"; + if (!memberOf($point5, $point1, $point2, $point3)) { + PrintErrorMessage("Current point isn't a side point",$lc); + next LINE; + } + if ($point4 eq $point5) { + PrintErrorMessage("Side points are identical",$lc); + next LINE; + } + chk_rparen("arguments of $cmd",$lc); + my ($xc, $yc, $r) = excircle($point1, $point2, $point3, + $point4, $point5); + my $R=$r; + if (s/^\s*\[\s*//) { + $R += expr($lc); + if ($R < 0.0001) { + PrintErrorMessage("Radius has become equal to zero!",$lc); + next LINE; + } + chk_rsb($lc); + } + if ($R > (500 / 2.845)) { + PrintErrorMessage("Radius is greater than 175mm!",$lc); + next LINE; + } + print OUT "%% excircle center = ($xc,$yc) radius = $R\n" if $comments_on; + printf OUT "\\circulararc 360 degrees from %.5f %.5f center at %.5f %.5f\n", + $xc+$R, $yc, $xc, $yc; + chk_comment($lc); + + } + elsif (s/^\s*(drawincircle(?=\W))//i) + { + my ($cmd) = $1; + print OUT "%% $cmd$_" if $comments_on; + chk_lparen("drawincircle",$lc); + my $point1 = get_point($lc); + next LINE if $point1 eq "_undef_"; + my $point2 = get_point($lc); + next LINE if $point2 eq "_undef_"; + my $point3 = get_point($lc); + next LINE if $point3 eq "_undef_"; + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point1}); + my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point2}); + my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point3}); + if (triangleArea($x1, $y1, $x2, $y2, $x3, $y3) < 0.0001) { + PrintErrorMessage("Area of triangle is zero!",$lc); + next LINE; + } + my ($xc, $yc, $r) = IncircleCenter($x1,$y1,$x2,$y2,$x3,$y3); + my $R=$r; + if (s/^\s*\[\s*//) { + $R += expr($lc); + if ($R < 0.0001) { + PrintErrorMessage("Radius has become equal to zero!",$lc); + next LINE; + } + chk_rsb($lc); + } + if ($R > (500 / 2.845)) { + PrintErrorMessage("Radius is greater than 175mm!",$lc); + next LINE; + } + print OUT "%% incircle center = ($xc,$yc) radius = $R\n" if $comments_on; + printf OUT "\\circulararc 360 degrees from %.5f %.5f center at %.5f %.5f\n", + $xc+$R, $yc, $xc, $yc; + chk_rparen("arguments of $cmd",$lc); + chk_comment($lc); + + } + elsif (s/^\s*(drawline(?=\W))//i) + { + my ($cmd) = $1; + print OUT "%% $cmd$_" if $comments_on; + DrawLineOrArrow(1,$lc); + } + elsif (s/^\s*(drawthickarrow(?=\W))//i) + { + my ($cmd) = $1; + print OUT "%% $cmd$_" if $comments_on; + print OUT "\\setplotsymbol ({\\usefont{OT1}{cmr}{m}{n}\\large .})%\n"; + print OUT "{\\setbox1=\\hbox{\\usefont{OT1}{cmr}{m}{n}\\large .}%\n"; + print OUT " \\global\\linethickness=0.31\\wd1}%\n"; + DrawLineOrArrow(0,$lc); + print OUT "\\setlength{\\linethickness}{0.4pt}%\n"; + print OUT "\\setplotsymbol ({\\usefont{OT1}{cmr}{m}{n}\\tiny .})%\n"; + } + elsif (s/^\s*(drawthickline(?=\W))//i) + { + my ($cmd) = $1; + print OUT "%% $cmd$_" if $comments_on; + print OUT "\\setplotsymbol ({\\usefont{OT1}{cmr}{m}{n}\\large .})%\n"; + print OUT "{\\setbox1=\\hbox{\\usefont{OT1}{cmr}{m}{n}\\large .}%\n"; + print OUT " \\global\\linethickness=0.31\\wd1}%\n"; + DrawLineOrArrow(1,$lc); + print OUT "\\setlength{\\linethickness}{0.4pt}%\n"; + print OUT "\\setplotsymbol ({\\usefont{OT1}{cmr}{m}{n}\\tiny .})%\n"; + } + elsif (s/^\s*(drawperpendicular(?=\W))//i) + { + my ($cmd) = $1; + print OUT "%% $cmd$_" if $comments_on; + + chk_lparen($cmd,$lc); + my $A = get_point($lc); + next LINE if $A eq "_undef_"; + chk_comma($lc); + my $B = get_point($lc); + next LINE if $A eq "_undef_"; + s/\s*//; #ignore white space + my $C = get_point($lc); + next LINE if $A eq "_undef_"; + chk_rparen("arguments of $cmd",$lc); + chk_comment($lc); + # + #start actual computation + # + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$A}); + my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$B}); + my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$C}); + my ($xF, $yF) = perpendicular($x1, $y1, $x2, $y2, $x3, $y3); + printf OUT "\\plot %.5f %.5f %.5f %.5f /\n", + $x1, $y1, $xF, $yF; + + } + elsif (s/^\s*(drawpoint(?=\W))//i) + { + my ($cmd) = $1; + print OUT "%% $cmd$_" if $comments_on; + my ($stacklen); + chk_lparen("$cmd",$lc); + if (/^\)/) { + PrintErrorMessage("There are no point to draw",$lc); + next LINE; + } + my(@PP); + DRAWPOINTS:while(1) { + if (s/^([^\W\d_]\d{0,4})//i) { #point name + $P = $1; + if (!exists($PointTable{lc($P)})) { + PrintErrorMessage("Undefined point $P",$lc); + next DRAWPOINTS; + } + else { + push (@PP,$P); + s/\s*//; + } + } + else { + last DRAWPOINTS; + } + } + drawpoints(@PP); + chk_rparen("arguments of $cmd",$lc); + chk_comment($lc); + + } + elsif (s/^\s*(drawRightAngle(?=\W))//i) + { + my ($cmd) = $1; + print OUT "%% $cmd$_" if $comments_on; + + chk_lparen("drawRightAngle",$lc); + my $point1 = get_point($lc); + next LINE if $point1 eq "_undef_"; + my $point2 = get_point($lc); + next LINE if $point2 eq "_undef_"; + my $point3 = get_point($lc); + next LINE if $point3 eq "_undef_"; + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point1}); + my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point2}); + my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point3}); + chk_comma($lc); + my $dist = expr($lc); + chk_rparen("arguments of $cmd",$lc); + chk_comment($lc); + # + #actual computation + # + my ($Px, $Py) = pointOnLine($x2, $y2, $x1, $y1, $dist); + my ($Qx, $Qy) = pointOnLine($x2, $y2, $x3, $y3, $dist); + my ($Tx, $Ty) = midpoint($Px, $Py, $Qx, $Qy); + my ($Ux, $Uy) = pointOnLine($x2, $y2, $Tx, $Ty, 2*Length($x2, $y2, $Tx, $Ty)); + if ($Px == $Ux || $Py == $Uy) { + printf OUT "\\putrule from %.5f %.5f to %.5f %.5f \n", $Px,$Py,$Ux,$Uy; + } + else { + printf OUT "\\plot %.5f %.5f\t%.5f %.5f / \n", $Px, $Py,$Ux,$Uy; + } + if ($Ux == $Qx || $Uy == $Qy) { + printf OUT "\\putrule from %.5f %.5f to %.5f %.5f \n", $Ux,$Uy,$Qx,$Qy; + } + else { + printf OUT "\\plot %.5f %.5f\t%.5f %.5f / \n", $Ux, $Uy,$Qx,$Qy; + } + + + } + elsif (s/^\s*(drawsquare(?=\W))//i) + { + my ($cmd) = $1; + print OUT "%% $cmd$_" if $comments_on; + chk_lparen("drawSquare",$lc); + my $p = get_point($lc); + chk_comma($lc); + my $side = expr($lc); + $side = $side - (1.1 * $LineThickness/$xunits); #Suggested by RWDN + my ($x,$y,$pSV,$pS) = unpack("d3A*",$PointTable{$p}); + printf OUT "\\put {%s} at %.5f %.5f %%drawsquare\n", drawsquare($side), $x, $y; + chk_rparen("arguments of $cmd",$lc); + chk_comment($lc); + + } + elsif (s/^\s*inputfile\*//i) + { + chk_lparen("inputfile*",$lc); + my $row_in = ""; + if (s/^((\w|-|\.)+)//) { + $row_in = $1; + } + else { + PrintErrorMessage("No input file name found",$lc); + next LINE; + } + if (!(-e $row_in)) { + PrintErrorMessage("File $row_in does not exist",$lc); + next LINE; + } + open(ROW, "$row_in")|| die "Can't open file $row_in\n"; + while (defined($in_line=)) { print OUT $in_line; } + print OUT "%% ... end of input file <$row_in>\n"; + close ROW; + chk_rparen("input file name",$lc); + chk_comment($lc); + + + } + elsif (s/^\s*(inputfile(?=\W))//i) + { + my ($cmd) = $1; + print OUT "%% $cmd$_" if $comments_on; + + chk_lparen("inputfile",$lc); + my $comm_in = ""; + if (s/^((\w|-|\.)+)//) { + $comm_in = $1; + } + else { + PrintErrorMessage("No input file name found",$lc); + next LINE; + } + if (!(-e $comm_in)) { + PrintErrorMessage("File $comm_in does not exist",$lc); + next LINE; + } + chk_rparen("input file name",$lc); + my $input_times = 1; #default value + if (s/^\[//) { + $input_times = expr($lc); + chk_rsb("optional argument",$lc); + } + print OUT "%% ... start of file <$comm_in> loop [$input_times]\n"; + for (my $i=0; $i loop [$input_times]\n"; + chk_comment($lc); + + } + elsif (s/^\s*(linethickness(?=\W))//i) + { + my $cmd = $1; + print OUT "%% $cmd$_" if $comments_on; + chk_lparen("linethickness", $lc); + if (s/^default//i) { + print OUT "\\linethickness=0.4pt\\Linethickness{0.4pt}%%\n"; + print OUT "\\setplotsymbol ({\\usefont{OT1}{cmr}{m}{n}\\tiny .})%\n"; + $LineThickness = setLineThickness($xunits,"0.4pt"); + } + else { + my $length = expr($lc); + if (s/^\s*($units)//i) { + my $units = $1; + printf OUT "\\linethickness=%.5f%s\\Linethickness{%.5f%s}%%\n", + $length, $units, $length, $units; + $LineThickness = setLineThickness($xunits,"$length$units"); + my $mag; + if ($units eq "pc") { + $mag = $length * 12; + } + elsif ($units eq "in") { + $mag = $length * 72.27; + } + elsif ($units eq "bp") { + $mag = $length * 1.00375; + } + elsif ($units eq "cm") { + $mag = $length * 28.45275; + } + elsif ($units eq "mm") { + $mag = $length * 2.845275; + } + elsif ($units eq "dd") { + $mag = $length * 1.07001; + } + elsif ($units eq "cc") { + $mag = $length * 0.08917; + } + elsif ($units eq "sp") { + $mag = $length * 0.000015259; + } + elsif ($units eq "pt") { + $mag = $length; + } + $mag = 10 * $mag / 1.00278219; + printf OUT "\\font\\CM=cmr10 at %.5fpt%%\n", $mag; + print OUT "\\setplotsymbol ({\\CM .})%\n"; + } + else { + PrintErrorMessage("Did not found expect units part",$lc); + } + } + chk_rparen("linethickness", $lc); + chk_comment($lc); + + + } + elsif (s/^\s*(paper(?=\W))//i) + { + my ($cmd) = $1; + print OUT "%% $cmd$_" if $comments_on; + chk_lcb("paper", $lc); + if (s/^units(?=\W)//i) + { + + chk_lparen("units",$lc); + if(s/^\)//) + { + PrintWarningMessage("Missing value in \"units\"--default is 1pt", + $lc); + $xunits = "1pt"; + } + else { + $xunits = expr($lc); + s/\s*//; + if (s/^($units)//i) { + $xunits .= "$1"; + $LineThickness = setLineThickness($xunits,"0.4pt"); + } + elsif(s/^(\w)+//i) { + PrintErrorMessage("$1 is not a valid mathspic unit",$lc); + $xunits = "1pt"; + } + else { + PrintErrorMessage("No x-units found",$lc); + $xunits = "1pt"; + } + s/\s*//; #ignore white space + if (s/^,//) { # there is a comma so expect an y-units + s/\s*//; #ignore white space + $yunits = expr($lc); + s/\s*//; #ignore white space + if (s/^($units)//i) { + $yunits .= "$1"; + } + elsif(s/^(\w)+//i) { + PrintErrorMessage("$1 is not a valid mathspic unit",$lc); + $yunits = "1pt"; + } + else { + PrintErrorMessage("No y-units found",$lc); + $yunits = $xunits; + } + } + else { + $yunits = $xunits; + } + chk_rparen("units",$lc); + } + + $nounits = 0; + } + else + { + $nounits = 1; + } + s/^,\s*// or s/\s*//; + if (s/^xrange//i) + { + + chk_lparen("xrange",$lc); + my $ec; + ($xlow,$ec) = ComputeDist($lc); + next LINE if $ec == 0; + chk_comma($lc); + ($xhigh,$ec) = ComputeDist($lc); + next LINE if $ec == 0; + if ($xlow >= $xhigh) + { + PrintErrorMessage("xlow >= xhigh in xrange",$lc); + next LINE; + } + chk_rparen("$xhigh",$lc); + + $noxrange = 0; + } + else + { + $noxrange = 1; + } + s/^,\s*// or s/\s*//; + if (s/^yrange//i) + { + + chk_lparen("yrange",$lc); + my $ec; + ($ylow,$ec) = ComputeDist($lc); + next LINE if $ec == 0; + chk_comma($lc); + ($yhigh,$ec) = ComputeDist($lc); + next LINE if $ec == 0; + if ($ylow >= $yhigh) + { + PrintErrorMessage("ylow >= yhigh in yrange",$lc); + next LINE; + } + chk_rparen("$yhigh",$lc); + + $noyrange = 0; + } + else + { + $noyrange = 1; + } + + if (!$nounits) + { + printf OUT "\\setcoordinatesystem units <%s,%s>\n", + $xunits,$yunits; + } + if(!$noxrange && !$noyrange) + { + printf OUT "\\setplotarea x from %.5f to %.5f, y from %.5f to %.5f\n", + $xlow, $xhigh, $ylow, $yhigh; + + } + + s/^,\s*// or s/\s*//; + $axis = ""; + if (s/^ax[ei]s(?=\W)//i) + { + + chk_lparen("axis",$lc); + while(/^[^\)]/) + { + if (s/^([lrtbxy]{1}\*?)//i) + { + $axis .= $1; + } + elsif (s/^([^lrtbxy])//i) + { + PrintErrorMessage("Non-valid character \"$1\" in axis()",$lc); + } + s/\s*//; + } + chk_rparen("axis(arguments",$lc); + + } + $axis = uc($axis); + s/^,\s*// or s/\s*//; + if (s/^ticks(?=\W)//i) + { + chk_lparen("ticks",$lc); + my $ec; + ($xticks,$ec) = ComputeDist($lc); + next LINE if $ec == 0; + chk_comma($lc); + ($yticks,$ec) = ComputeDist($lc); + next LINE if $ec == 0; + chk_rparen("ticks(arguments",$lc); + + } + else + { + $xticks = $yticks = 0; + } + chk_rcb("paper", $lc); + YBRANCH: { + if (index($axis, "Y")>-1) + { + if (index($axis, "Y*")>-1) + { + print OUT "\\axis left shiftedto x=0 / \n"; + last YBRANCH; + } + if ($yticks > 0) + { + if (index($axis, "T")>-1 && index($axis, "B")==-1) + { + print OUT "\\axis left shiftedto x=0 ticks numbered from "; + print OUT "$ylow to -$yticks by $yticks\n from $yticks to "; + print OUT $yhigh-$yticks," by $yticks /\n"; + } + elsif (index($axis, "T")==-1 && index($axis, "B")>-1) + { + print OUT "\\axis left shiftedto x=0 ticks numbered from "; + print OUT $ylow+$yticks," to -$yticks by $yticks\n from "; + print OUT "$yticks to $yhigh by $yticks /\n"; + } + elsif (index($axis, "T")>-1 && index($axis, "B")>-1) + { + print OUT "\\axis left shiftedto x=0 ticks numbered from "; + print OUT $ylow+$yticks," to -$yticks by $yticks\n from "; + print OUT "$yticks to ",$yhigh-$yticks," by $yticks /\n"; + } + else + { + print OUT "\\axis left shiftedto x=0 ticks numbered from "; + print OUT "$ylow to -$yticks by $yticks\n from "; + print OUT "$yticks to $yhigh by $yticks /\n"; + } + } + else + { + print OUT "\\axis left shiftedto x=0 /\n"; + } + } + } + XBRANCH: { if (index($axis, "X")>-1) + { + if (index($axis, "X*")>-1) + { + print OUT "\\axis bottom shiftedto y=0 /\n"; + last XBRANCH; + } + if ($xticks > 0) + { + if (index($axis, "L")>-1 && index($axis, "R")==1) + { + print OUT "\\axis bottom shiftedto y=0 ticks numbered from "; + print OUT $xlow + $xticks," to -$xticks by $xticks\n from"; + print OUT " $xticks to $xhigh by $xticks /\n"; + } + elsif (index($axis, "L")==-1 && index($axis, "R")>-1) + { + print OUT "\\axis bottom shiftedto y=0 ticks numbered from "; + print OUT "$xlow to -$xticks by $xticks\n from "; + print OUT "$xticks to ",$xhigh-$xticks," by $xticks /\n"; + } + elsif (index($axis, "L")>-1 && index($axis, "R")>-1) + { + print OUT "\\axis bottom shiftedto y=0 ticks numbered from "; + print OUT $xlow + $xticks," to -$xticks by $xticks\n from "; + print OUT "$xticks to ",$xhigh - $xticks," by $xticks /\n"; + } + else + { + print OUT "\\axis bottom shiftedto y=0 ticks numbered from "; + print OUT "$xlow to -$xticks by $xticks\n from "; + print OUT "$xticks to $xhigh by $xticks /\n"; + } + } + else + { + print OUT "\\axis bottom shiftedto y=0 /\n"; + } + } } + LBRANCH: {if (index($axis, "L")>-1) + { + if (index($axis, "L")>-1) + { + if (index($axis, "L*")>-1) + { + print OUT "\\axis left /\n"; + last LBRANCH; + } + if ($yticks > 0) + { + print OUT "\\axis left ticks numbered from "; + print OUT "$ylow to $yhigh by $yticks /\n"; + } + else + { + print OUT "\\axis left /\n"; + } + } + } } + RBRANCH: { if (index($axis, "R")>-1) + { + if (index($axis, "R*")>-1) + { + print OUT "\\axis right /\n"; + last RBRANCH; + } + if ($yticks > 0) + { + print OUT "\\axis right ticks numbered from $ylow to $yhigh by "; + print OUT "$yticks /\n"; + } + else + { + print OUT "\\axis right /\n"; + } + } } + TBRANCH: { if (index($axis, "T")>-1) + { + if (index($axis, "T*")>-1) + { + print OUT "\\axis top /\n"; + last TBRANCH; + } + if ($xticks > 0) + { + print OUT "\\axis top ticks numbered from $xlow to $xhigh by "; + print OUT "$xticks /\n"; + } + else + { + print OUT "\\axis top /\n"; + } + } } + BBRANCH: { if (index($axis, "B")>-1) + { + if (index($axis, "B*")>-1) + { + print OUT "\\axis bottom /\n"; + last BBRANCH; + } + if ($xticks > 0) + { + print OUT "\\axis bottom ticks numbered from $xlow to $xhigh by "; + print OUT "$xticks /\n"; + } + else + { + print OUT "\\axis bottom /\n"; + } + } } + + + chk_comment($lc); + + } + elsif (s/^\s*(PointSymbol(?=\W))//i) + { + my $cmd = $1; + print OUT "%% $cmd$_" if $comments_on; + + chk_lparen("$cmd",$lc); + if (s/^default//i) #default point symbol + { + $defaultsymbol = "\$\\bullet\$"; + } + elsif (s/^(circle|square)//i) { + $defaultsymbol = $1; + chk_lparen($defaultsymbol, $lc); + $GlobalDimOfPoints = expr($lc); + chk_rparen("expression", $lc); + } + elsif (s/^(((\\,){1}|(\\\)){1}|(\\\s){1}|[^\),\s])+)//) #arbitrary LaTeX point + { + $defaultsymbol = $1; + $defaultsymbol=~ s/\\\)/\)/g; + $defaultsymbol=~ s/\\,/,/g; + $defaultsymbol=~ s/\\ / /g; + } + else + { + PrintErrorMessage("unrecognized point symbol",$lc); + } + if (s/\s*,\s*//) { + $defaultLFradius = expr($lc); + } + chk_rparen("after $cmd arguments",$lc); + chk_comment("after $cmd command",$lc); + + } + elsif (s/^\s*point(?=\W)//i) + { + my ($Point_Line); + chomp($Point_Line=$_); + my ($pointStar, $PointName, $origPN); + $pointStar = 0; # default value: he have a point command + $pointStar = 1 if s/^\*//; + chk_lparen("point" . (($pointStar)?"*":""),$lc); + if (s/^([^\W\d_](?![^\W\d_])\d{0,4})//i) { + # + # Note: the regular expression (foo)(?!bar) means that we are + # looking a foo not followed by a bar. Moreover, the regular + # expression [^\W\d_] means that we are looking for letter. + # + $origPN = $1; + $PointName = lc($1); + } + else { + PrintErrorMessage("Invalid point name",$lc); + next LINE; + } + #if ($pointStar and !exists($PointTable{$PointName})) { + # PrintWarningMessage("Point $origPN has not been defined",$lc); + #} + if (!$pointStar and exists($PointTable{$PointName})) { + PrintWarningMessage("Point $origPN has been used already",$lc); + } + chk_rparen("point" . (($pointStar)?"*":""). "($origPN",$lc); + chk_lcb("point" . (($pointStar)?"*":""). "($origPN)",$lc); + my ($Px, $Py); + if (s/^perpendicular(?=\W)//i) { + chk_lparen("perpendicular",$lc); + my $FirstPoint = &get_point($lc); + next LINE if $FirstPoint eq "_undef_"; + chk_comma($lc); + my $SecondPoint = &get_point($lc); + next LINE if $SecondPoint eq "_undef_"; + my $ThirdPoint = &get_point($lc); + next LINE if $ThirdPoint eq "_undef_"; + chk_rparen("No closing parenthesis found",$lc); + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$FirstPoint}); + my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$SecondPoint}); + my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$ThirdPoint}); + ($Px, $Py) = perpendicular($x1,$y1,$x2,$y2,$x3,$y3); + + } + elsif (s/^intersection(?=\W)//i) { + chk_lparen("intersection",$lc); + my $FirstPoint = get_point($lc); + next LINE if $FirstPoint eq "_undef_"; + my $SecondPoint = get_point($lc); + next LINE if $SecondPoint eq "_undef_"; + chk_comma($lc); + my $ThirdPoint = get_point($lc); + next LINE if $ThirdPoint eq "_undef_"; + my $ForthPoint = get_point($lc); + next LINE if $ForthPoint eq "_undef_"; + chk_rparen("No closing parenthesis found",$lc); + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$FirstPoint}); + my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$SecondPoint}); + my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$ThirdPoint}); + my ($x4,$y4,$pSV4,$pS4)=unpack("d3A*",$PointTable{$ForthPoint}); + ($Px, $Py) = intersection4points($x1,$y1,$x2,$y2,$x3,$y3,$x4,$y4); + + + } + elsif (s/^midpoint(?=\W)//i) { + chk_lparen("midpoint",$lc); + my $FirstPoint = &get_point($lc); + next LINE if $FirstPoint eq "_undef_"; + my $SecondPoint = &get_point($lc); + next LINE if $SecondPoint eq "_undef_"; + chk_rparen("No closing parenthesis found",$lc); + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$FirstPoint}); + my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$SecondPoint}); + ($Px, $Py) = midpoint($x1, $y1, $x2, $y2); + + } + elsif (s/^pointonline(?=\W)//i) { + chk_lparen("pointonline",$lc); + my $FirstPoint = &get_point($lc); + next LINE if $FirstPoint eq "_undef_"; + my $SecondPoint = &get_point($lc); + next LINE if $SecondPoint eq "_undef_"; + chk_comma($lc); + # now get the distance + my $distance = expr($lc); + chk_rparen("No closing parenthesis found",$lc); + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$FirstPoint}); + my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$SecondPoint}); + ($Px, $Py) = pointOnLine($x1,$y1,$x2,$y2,$distance); + + } + elsif (s/^circumcircleCenter(?=\W)//i) { + chk_lparen("circumCircleCenter",$lc); + my $FirstPoint = &get_point($lc); + next LINE if $FirstPoint eq "_undef_"; + my $SecondPoint = &get_point($lc); + next LINE if $SecondPoint eq "_undef_"; + my $ThirdPoint = &get_point($lc); + next LINE if $ThirdPoint eq "_undef_"; + chk_rparen("No closing parenthesis found",$lc); + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$FirstPoint}); + my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$SecondPoint}); + my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$ThirdPoint}); + ($Px, $Py,$r) = &circumCircleCenter($x1,$y1,$x2,$y2,$x3,$y3,$lc); + next LINE if $Px == 0 and $Py == 0 and $r == 0; + + } + elsif (s/^IncircleCenter(?=\W)//i) { + chk_lparen("IncircleCenter",$lc); + my $FirstPoint = &get_point($lc); + next LINE if $FirstPoint eq "_undef_"; + my $SecondPoint = &get_point($lc); + next LINE if $SecondPoint eq "_undef_"; + my $ThirdPoint = &get_point($lc); + next LINE if $ThirdPoint eq "_undef_"; + chk_rparen("No closing parenthesis found",$lc); + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$FirstPoint}); + my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$SecondPoint}); + my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$ThirdPoint}); + ($Px, $Py, $r) = IncircleCenter($x1,$y1,$x2,$y2,$x3,$y3); + + } + elsif (s/^ExcircleCenter(?=\W)//i) { + chk_lparen("ExcircleCenter",$lc); + my $PointA = get_point($lc); + next LINE if $PointA eq "_undef_"; + my $PointB = get_point($lc); + next LINE if $PointB eq "_undef_"; + my $PointC = get_point($lc); + next LINE if $PointC eq "_undef_"; + chk_comma($lc); + my $PointD = &get_point($lc); + next LINE if $PointD eq "_undef_"; + if (!memberOf($PointD, $PointA, $PointB, $PointC)) { + PrintErrorMessage("Current point isn't a side point",$lc); + next LINE; + } + my $PointE = get_point($lc); + next LINE if $PointE eq "_undef_"; + if (!memberOf($PointE, $PointA, $PointB, $PointC)) { + PrintErrorMessage("Current point isn't a side point",$lc); + next LINE; + } + if ($PointD eq $PointE) { + PrintErrorMessage("Side points are identical",$lc); + next LINE; + } + ($Px, $Py, $r) = excircle($PointA, $PointB, $PointC, + $PointD, $PointE); + chk_rparen("after coordinates part",$lc); + + } + elsif (/^[^\W\d_]\d{0,4}\s*[^,\w]/) { + m/^([^\W\d_]\d{0,4})\s*/i; + if (exists($PointTable{lc($1)})) { + my $Tcoord = get_point($lc); + my ($x,$y,$pSV,$pS)=unpack("d3A*",$PointTable{$Tcoord}); + $Px = $x; + $Py = $y; + } + else { + $Px = expr(); + chk_comma($lc); + $Py = expr(); + } + } + elsif (/[^\W\d_]\d{0,4}\s*,\s*shift|polar|rotate|vector/i) { #a point? + s/^([^\W\d_]\d{0,4})//i; + my $PointA = $1; + if (exists($PointTable{lc($PointA)})) { + s/\s*//; + if (s/^,//) { + s/\s*//; + if (s/^shift(?=\W)//i) { + + chk_lparen("shift",$lc); + my $dist1 = expr($lc); + chk_comma($lc); + my $dist2 = expr($lc); + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{lc($PointA)}); + $Px = $x1 + $dist1; + $Py = $y1 + $dist2; + chk_rparen("shift part",$lc); + + } + elsif (s/^polar(?=\W)//i) { + chk_lparen("polar",$lc); + my ($R1, $Theta1); + $R1 = expr($lc); + chk_comma($lc); + $Theta1 = expr($lc); + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{lc($PointA)}); + s/\s*//; + if (s/^rad(?=\W)//i) { + # do nothing! + } + elsif (s/^deg(?=\W)//i) { + $Theta1 = $Theta1 * PI / 180; + } + else { + #$Theta1 = $Theta1 * PI / 180; + } + $Px = $x1 + $R1 * cos($Theta1); + $Py = $y1 + $R1 * sin($Theta1); + chk_rparen("after polar part",$lc); + + } + elsif (s/^rotate(?=\W)//i) { + chk_lparen("rotate",$lc); + my $Q = lc($PointA); + my $P = get_point($lc); + next LINE if $P eq "_undef_"; + chk_comma($lc); + my $Theta1 = expr($lc); + my ($xP,$yP,$pSV1,$pS1)=unpack("d3A*",$PointTable{$P}); + my ($xQ,$yQ,$pSV2,$pS2)=unpack("d3A*",$PointTable{$Q}); + s/\s*//; + if (s/^rad(?=\W)//i) + { + # do nothing! + } + elsif (s/^deg(?=\W)//i) + { + $Theta1 = $Theta1 * PI / 180; + } + else + { + $Theta1 = $Theta1 * PI / 180; + } + # shift origin to P + $xQ -= $xP; + $yQ -= $yP; + # do the rotation + $Px = $xQ * cos($Theta1) - $yQ * sin($Theta1); + $Py = $xQ * sin($Theta1) + $yQ * cos($Theta1); + # return origin back to original origin + $Px += $xP; + $Py += $yP; + chk_rparen("after rotate part",$lc); + + } + elsif (s/^vector(?=\W)//i) { + chk_lparen("vector",$lc); + my ($x0,$y0,$pSV0,$pS0) = unpack("d3A*",$PointTable{lc($PointA)}); + my $P = get_point($lc); + my $Q = get_point($lc); + my ($x1,$y1,$pSV1,$pS1) = unpack("d3A*",$PointTable{$P}); + my ($x2,$y2,$pSV2,$pS2) = unpack("d3A*",$PointTable{$Q}); + $Px = $x0 + $x2 - $x1; + $Py = $y0 + $y2 - $y1; + chk_rparen("vector part",$lc); + + + } + else { + PrintErrorMessage("unexpected token",$lc); + next LINE; + } + } + else { + my ($xA,$yA,$pSVA,$pSA)=unpack("d3A*",$PointTable{lc($PointA)}); + $Px = $xA; + $Py = $yA; + } + } + else { + PrintErrorMessage("Undefined point $PointA",$lc); + next LINE; + } + } + else { + $Px = expr(); + chk_comma($lc); + $Py = expr(); + } + + chk_rcb("coordinates part",$lc); + my $sv = $defaultsymbol; + my $sh = $defaultLFradius; + my $side_or_radius = undef; + if (s/^\[\s*//) { # the user has opted to specify the optional part + if (/^(symbol|radius|side)\s*/i) { + my @previous_options = (); + my $number_of_options = 1; + my $symbol_set = 0; + while (s/^(symbol|radius)\s*//i and $number_of_options <= 2) { + my $option = lc($1); + if (s/^=\s*//) { + if (memberOf($option,@previous_options)) { + PrintErrorMessage("Option \"$option\" has been already defined", $lc); + my $dummy = expr($lc); + } + elsif ($option eq "radius") { + $sh = expr($lc); + $sv = $defaultsymbol if ! $symbol_set; + } + elsif ($option eq "symbol") { + if (s/^circle\s*//i) { + $sv = "circle"; + chk_lparen("after token circle",$lc); + $side_or_radius = expr($lc); + chk_rparen("expression",$lc); + } + elsif (s/^square\s*//i) { + $sv = "square"; + chk_lparen("after token square",$lc); + $side_or_radius = expr($lc); + chk_rparen("expression",$lc); + } + elsif (s/^(((\\\]){1}|(\\,){1}|(\\\s){1}|[^\],\s])+)//) { + $sv = $1; + $sv =~ s/\\\]/\]/g; + $sv =~ s/\\,/,/g; + $sv =~ s/\\ / /g; + s/\s*//; + } + $symbol_set = 1; + } + } + else { + PrintErrorMessage("unexpected token", $lc); + next LINE; + } + $number_of_options++; + push (@previous_options, $option); + s/^,\s*//; + } + } + else { + PrintErrorMessage("unexpected token", $lc); + next LINE; + } + + chk_rsb("optional part",$lc); + } + # to avoid truncation problems introduced by the pack function, we + # round each number up to five decimal digits + $Px = sprintf("%.5f", $Px); + $Py = sprintf("%.5f", $Py); + print OUT "%% point$Point_Line \t$origPN = ($Px, $Py)\n" if $comments_on; + chk_comment($lc); + $PointTable{$PointName} = pack("d3A*",$Px,$Py,$sh,$sv); + if (defined($side_or_radius)) { + $DimOfPoint{$PointName} = $side_or_radius; + } + + } + elsif (/^\s*setPointNumber(?=\W)/i) + { + PrintWarningMessage("Command setPointNumber is ignored",$lc); + next LINE; + } + elsif (s/^\s*(showAngle(?=\W))//i) + { + chk_lparen("showangle",$lc); + my $point_1 = get_point($lc); + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1}); + my $point_2 = get_point($lc); + my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2}); + my $point_3 = get_point($lc); + my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point_3}); + my $angle = Angle($x1, $y1, $x2, $y2, $x3, $y3); + $angle = 0 if $angle == -500; + printf OUT "%%%% angle(%s%s%s) = %.5f deg ( %.5f rad)\n", $point_1, + $point_2, $point_3, $angle, $angle*D2R; + chk_rparen("Missing right parenthesis", $lc); + + } + elsif (s/^\s*(showArea(?=\W))//i) + { + chk_lparen("showarea",$lc); + my $point_1 = get_point($lc); + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1}); + my $point_2 = get_point($lc); + my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2}); + my $point_3 = get_point($lc); + my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point_3}); + print OUT "%% area($point_1$point_2$point_3) = ", + triangleArea($x1, $y1, $x2, $y2, $x3, $y3), "\n"; + chk_rparen("Missing right parenthesis", $lc); + + } + elsif (s/^\s*(showLength(?=\W))//i) + { + chk_lparen("showlength",$lc); + my $point_1 = get_point($lc); + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1}); + my $point_2 = get_point($lc); + my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2}); + print OUT "%% length($point_1$point_2) = ", + Length($x1, $y1, $x2, $y2), "\n"; + chk_rparen("Missing right parenthesis", $lc); + + + } + elsif (/^\s*showPoints(?=\W)/i) + { + print OUT "%%-------------------------------------------------\n"; + print OUT "%% L I S T O F P O I N T S \n"; + print OUT "%%-------------------------------------------------\n"; + foreach my $p (keys(%PointTable)) { + my ($x, $y, $pSV, $pS) = unpack("d3A*",$PointTable{$p}); + printf OUT "%%%%\t%s\t= ( %.5f, %.5f ), LF-radius = %.5f, symbol = %s\n", + $p, $x, $y, $pSV, $pS; + } + print OUT "%%-------------------------------------------------\n"; + print OUT "%% E N D O F L I S T O F P O I N T S \n"; + print OUT "%%-------------------------------------------------\n"; + next LINE; + } + elsif (/^\s*showVariables(?=\W)/i) + { + print OUT "%%-------------------------------------------------\n"; + print OUT "%% L I S T O F V A R I A B L E S \n"; + print OUT "%%-------------------------------------------------\n"; + foreach my $var (keys(%VarTable)) { + print OUT "%%\t", $var, "\t=\t", $VarTable{$var}, "\n"; + } + print OUT "%%-------------------------------------------------\n"; + print OUT "%% E N D O F L I S T O F V A R I A B L E S \n"; + print OUT "%%-------------------------------------------------\n"; + next LINE; + } + elsif (s/^\s*(system(?=\W))//i) + { + print OUT "%% $1$_" if $comments_on; + + chk_lparen("$cmd",$lc); + my ($error, $command, $rest) = get_string($_); + next LINE if $error == 1; + $_ = $rest; + if (! is_tainted($command)) { + system($command); + } + else { + PrintErrorMessage("String \"$command\" has tainted data", $lc); + next LINE; + } + chk_rparen("after $cmd arguments",$lc); + chk_comment("after $cmd command",$lc); + + } + elsif (s/^\s*(text(?=\W))//i) + { + print OUT "%% $1$_" if $comments_on; + + chk_lparen("text",$lc); + my ($level,$text)=(1,""); + TEXTLOOP: while (1) + { + $level++ if /^\(/; + $level-- if /^\)/; + s/^(.)//; + last TEXTLOOP if $level==0; + $text .= $1; + } + chk_lcb("text part",$lc); + my ($Px, $Py,$dummy,$pos); + $pos=""; + s/\s*//; + + if (/^[^\W\d_]\d{0,4}\s*[^,\w]/) { + my $Tcoord = get_point($lc); + my ($x,$y,$pSV,$pS)=unpack("d3A*",$PointTable{$Tcoord}); + $Px = $x; + $Py = $y; + } + elsif (/[^\W\d_]\d{0,4}\s*,\s*shift|polar/i) { + s/^([^\W\d_]\d{0,4})//i; + my $PointA = $1; + if (exists($PointTable{lc($PointA)})) { + s/\s*//; + if (s/^,//) { + s/\s*//; + if (s/^shift(?=\W)//i) { + + chk_lparen("shift",$lc); + my $dist1 = expr($lc); + chk_comma($lc); + my $dist2 = expr($lc); + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{lc($PointA)}); + $Px = $x1 + $dist1; + $Py = $y1 + $dist2; + chk_rparen("shift part",$lc); + + } + elsif (s/^polar(?=\W)//i) { + chk_lparen("polar",$lc); + my ($R1, $Theta1); + $R1 = expr($lc); + chk_comma($lc); + $Theta1 = expr($lc); + my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{lc($PointA)}); + s/\s*//; + if (s/^rad(?=\W)//i) { + # do nothing! + } + elsif (s/^deg(?=\W)//i) { + $Theta1 = $Theta1 * PI / 180; + } + else { + #$Theta1 = $Theta1 * PI / 180; + } + $Px = $x1 + $R1 * cos($Theta1); + $Py = $y1 + $R1 * sin($Theta1); + chk_rparen("after polar part",$lc); + + } + } + } + else { + PrintErrorMessage("undefined point/var",$lc); + next LINE; + } + } + else { + $Px = expr(); + chk_comma($lc); + $Py = expr(); + } + + chk_rcb("coordinates part of text command",$lc); + if (s/^\[//) + { + s/\s*//; + + if (s/^(\w{1})\s*//) { + $pos .= $1; + if (memberOf($pos, "l", "r")) { + if (s/^(\w{1})\s*//) { + my $np = $1; + if (memberOf($np, "t", "b", "B")) { + $pos .= $np; + } + else { + if (memberOf($np, "l", "r")) { + PrintErrorMessage("$np can't follow 'l' or 'r'", $lc); + } + else { + PrintErrorMessage("$np is not a valid positioning option", $lc); + } + next LINE; + } + } + } + elsif (memberOf($pos, "t", "b", "B")) { + if (s/^(\w{1})\s*//) { + my $np = $1; + if (memberOf($np, "l", "r")) { + $pos .= $np; + } + else { + if (memberOf($np, "t", "b", "B")) { + PrintErrorMessage("$np can't follow 't', 'b', or 'B'", $lc); + } + else { + PrintErrorMessage("$np is not a valid positioning option", $lc); + } + next LINE; + } + } + } + else { + PrintErrorMessage("$pos is not a valid positioning option", $lc); + next LINE; + } + } + else { + PrintErrorMessage("illegal token in optional part of text command",$lc); + next LINE; + } + + s/\s*//; + chk_rsb("optional part of text command",$lc); + } + chk_comment($lc); + if ($pos eq "") + { + printf OUT "\\put {%s} at %f %f\n", $text, $Px, $Py; + } + else + { + printf OUT "\\put {%s} [%s] at %f %f\n", $text, $pos, $Px, $Py; + } + + } + elsif (s/^\s*(var(?=\W))//i) + { + print OUT "%% $1$_" if $comments_on; + do{ + s/\s*//; + PrintErrorMessage("no identifier found after token var",$lc) + if $_ !~ s/^([^\W\d_]\d{0,4})//i; + my $Varname = $1; + my $varname = lc($Varname); + if (exists $ConstTable{$varname}) { + PrintErrorMessage("Redefinition of constant $varname",$lc); + } + s/\s*//; #remove leading white space + PrintErrorMessage("did not find expected = sign",$lc) + if $_ !~ s/^[=]//i; + my $val = expr($lc); + $VarTable{$varname} = $val; + print OUT "%% $Varname = $val\n" if $comments_on; + }while (s/^,//); + chk_comment($lc); + s/\s*//; + if (/^[^%]/) { + PrintWarningMessage("Trailing text is ignored",$lc); + } + } + elsif (/^\s*\\(.+)/) + { + my $line = $1; + if ($line =~ /^\s+(.+)/) + { + print OUT " $line\n"; + } + else + { + print OUT "\\$line\n"; + } + next LINE; + } + elsif (0==length) #empty line + { + next LINE; + } + else { + PrintErrorMessage("command not recognized",$lc); + next LINE; + } + + } + } + } + + +our $alarm=""; +our $comments_on=1; +our $out_file="default"; +our $argc=@ARGV; +if ($argc == 0 || $argc > 5 ){ # no command line arguments or more than 4 + # arguments + die "\nmathspic version $version_number\n" . + "Usage: mathspic [-h] [-b] [-c] [-o ] \n\n"; +} +else { + our $file = ""; + SWITCHES: + while($_ = $ARGV[0]) { + shift; + if (/^-h$/) { + die "\nThis is mathspic version $version_number\n" . + "Type \"man mathspic\" for detailed help\n". + "Usage:\tmathspic [-h] [-b] [-c] [-o ] \n" . + "\twhere,\n" . + "\t[-b]\tenables bell sound if error exists\n" . + "\t[-c]\tdisables comments in output file\n" . + "\t[-h]\tgives this help listing\n" . + "\t[-o]\tcreates specified output file\n\n"; + } + elsif (/^-b$/) { + $alarm = chr(7); + } + elsif (/^-c$/) { + $comments_on = 0; + } + elsif (/^-o$/) { + die "No output file specified!\n" if !@ARGV; + $out_file = $ARGV[0]; + shift; + } + elsif (/^-\w+/) { + die "$_: Illegal command line switch!\n"; + } + else { + $file = $_; + } + }my ($xA, $yA, $xB, $yB, $dist)=@_; + die "No input file specified!\n" if $file eq ""; + + print "This is mathspic version $version_number\n"; +} + our ($source_file, $log_file); + if (! -e $file) { + die "$file: no such file!\n" if (! (-e "$file.m")); + $source_file = "$file.m"; + } + else { + $source_file = $file; + $file = $1 if $file =~ /(\w[\w-\.]+)\.\w+/; + } + $out_file= "$file.mt" if $out_file eq "default"; + $log_file= "$file.mlg"; + + + open(IN,"$source_file")||die "Can't open source file: $source_file\n"; + open(OUT,">$out_file")||die "Can't open output file: $out_file\n"; + open(LOG,">$log_file")||die "Can't open log file: $log_file\n"; + print_headers; + process_input(IN,""); + +print $alarm if $no_errors > 0; +__END__ + diff --git a/Master/texmf-dist/scripts/mathspic/mathspic113.pl b/Master/texmf-dist/scripts/mathspic/mathspic113.pl deleted file mode 100755 index 5c3ed4ec1f9..00000000000 --- a/Master/texmf-dist/scripts/mathspic/mathspic113.pl +++ /dev/null @@ -1,3336 +0,0 @@ -#!/usr/bin/perl -# -#(c) Copyright 2005-2010 VERSION 1.13 April 26, 2010 -# Apostolos Syropoulos & R.W.D. Nickalls -# asyropoulos@yahoo.com dick@nickalls.org -# -# This program can be redistributed and/or modified under the terms -# of the LaTeX Project Public License Distributed from CTAN -# archives in directory macros/latex/base/lppl.txt; either -# version 1 of the License, or any later version. -# -package DummyFH; -my $index = 0; -sub TIEHANDLE { - my $class = shift; - my $self= shift; - bless $self, $class; -} -sub READLINE { - my $self = shift; - #shift @$self; - if ($index > $#$self) { - $index = 0; - return undef; - } - else { - return $self->[$index++]; - } -} - -package main; -use Math::Trig; -our $version_number = "1.13 Apr 26, 2010"; -our $commandLineArgs = join(" ", @ARGV); -our $command = ""; -our $curr_in_file = ""; -our %PointTable = (); -our %VarTable = (); -our %ConstTable = (); -our $no_errors = 0; -our $xunits = "1pt"; -our $yunits = "1pt"; -our $units = "pt|pc|in|bp|cm|mm|dd|cc|sp"; -our $defaultsymbol = "\$\\bullet\$"; -our $defaultLFradius = 0; -use constant PI => atan2(1,1)*4; -use constant R2D => 180 / PI; -use constant D2R => PI / 180; -our $arrowLength = 2; -our $arrowLengthUnits = "mm"; -our $arrowAngleB = 30; -our $arrowAngleC = 40; -our %DimOfPoint = (); -our $GlobalDimOfPoints = 0; -our @Macros = (); -our $LineThickness = 0.4; - - sub mpp { - my $in_line; - chomp($in_line = shift); - my $LC = shift; - my $out_line = $in_line; - my $macro_name = ""; - my @macro_param = (); - my $macro_code = ""; - if ($in_line =~ s/^%def\s*//) { - if ($in_line =~ s/^(\w+)\s*//){ - $macro_name = $1; - } - else { - PrintErrorMessage("No macro name has been found",$LC); - return "" - } - if ($in_line =~ s/^\(\s*//) { - # do nothing - } - else { - PrintErrorMessage("No left parenthesis after macro name has been found",$LC); - return ""; - } - if ($in_line =~ s/^\)//) { - # Macro has no parameters! - } - else { - MACROS: while (1) { - if ($in_line =~ s/^(\w+)\s*//) { - push (@macro_param, $1); - } - else { - PrintErrorMessage("No macro parameter name has been found",$LC); - return ""; - } - if ($in_line =~ s/^,\s*//) { - next MACROS; - } - else { - last MACROS; - } - } - if ($in_line =~ s/^\)//) { - # do nothing! - } - else { - PrintErrorMessage("No closing parenthesis after macro parameters",$LC); - return ""; - } - } - $in_line =~ s/([^%]+)(%.*)/$1/; - $macro_code = $in_line; - push ( @Macros , { 'macro_name' => $macro_name, - 'macro_code' => $macro_code, - 'macro_param' => \@macro_param }); - return $out_line; - } - elsif ($in_line =~ s/^%undef\s*//) { - if ($in_line =~ s/^(\w+)//) { - my $undef_macro = $1; - for(my $i = $#Macros; $i >= 0; $i--) { - if ($Macros[$i]->{'macro_name'} eq $undef_macro) { - splice(@Macros,$i,1); - } - } - } - return $out_line; - } - elsif ($in_line =~ s/^\s*%//) { - return $out_line; - } - else { - my $comment = $2 if $in_line =~ s/([^%]+)(%.+)/$1/; - EXPANSIONLOOP: while () { - my $org_in_line = $in_line; - for(my $i = $#Macros; $i >= 0; $i--) { - my $macro_name = $Macros[$i]->{'macro_name'}; - if ($in_line =~ /&$macro_name\b/) { ############################ - my $num_of_macro_args = @{$Macros[$i]->{'macro_param'}}; - if ( $num_of_macro_args > 0 ) { - # Macro with parameters - my $pattern = "&$macro_name\\("; - foreach my $p ( 1..$num_of_macro_args ) { - my $comma = ($p == $num_of_macro_args) ? "\\s*" : "\\s*,\\s*"; - $pattern .= "\\s*[^\\s\\)]+$comma"; - } - $pattern .= "\\)"; - while($in_line =~ /&$macro_name\b/) { - if ($in_line =~ /$pattern/) { - my $before = $`; - my $after = $'; - my $match = $&; - my $new_code = $Macros[$i]->{'macro_code'}; - $match =~ s/^&$macro_name\(\s*//; - $match =~ s/\)$//; - foreach my $arg ( 0..($num_of_macro_args - 1) ) { - my $old = $Macros[$i]->{'macro_param'}->[$arg]; - my $comma = ($arg == ($num_of_macro_args - 1)) ? "" : ","; - $match =~ s/^\s*([^\s,]+)\s*$comma//; - my $new = $1; - # 'g': Parameter may occur several times - # in $new_code. - # '\b': Substitute only whole words - # not x in xA - $new_code =~ s/\b$old\b/$new/g; - } - $in_line = "$before$new_code$after"; - } - else { - PrintErrorMessage("Usage of macro &$macro_name does not " . - "match its definition", $LC); - return ""; - } - } - } - else { - # Macro without parameters - my $replacement = $Macros[$i]->{'macro_code'}; - # '\b': Substitute only whole words - # not x in xA - $in_line =~ s/&$macro_name\b/$replacement/g; - } - } - } - last EXPANSIONLOOP if ( $org_in_line eq $in_line ); - } - return "$in_line$comment"; - } - } - - sub PrintErrorMessage { - my $errormessage = shift; - my $error_line = shift; - my ($l,$A); - $l = 1+length($command)-length; - $A = substr($command,0,$l); - $l += 7 +length($error_line); - - for my $fh (STDOUT, LOG) { - print $fh "$curr_in_file", "Line $error_line: $A\n"; - print $fh " " x $l ,$_,"***Error: $errormessage\n"; - } - if ($comments_on) { #print to output file file - print OUT "%% *** $curr_in_file", "Line $error_line: $A\n"; - print OUT "%% *** "," " x $l ,$_,"%% ... Error: $errormessage\n"; - } - $no_errors++; - } - - sub PrintWarningMessage { - my $warningMessage = shift; - my $warning_line = shift; - my ($l,$A); - $l = 1+length($command)-length; - $A = substr($command,0,$l); - $l += 7 +length($warning_line); - - for my $fh (STDOUT, LOG) { - print $fh "$curr_in_file", "Line $warning_line: $A\n"; - print $fh " " x $l ,$_,"***Warning: $warningMessage\n"; - } - if ($comments_on) { #print to output file file - print OUT "%% *** $curr_in_file", "Line $warning_line: $A\n"; - print OUT "%% *** "," " x $l ,$_,"%% ... Warning: $warningMessage\n"; - } - } - - sub PrintFatalError { - my $FatalMessage = shift; - my $fatal_line = shift; - my ($l,$A); - $l = 1+length($command)-length; - $A = substr($command,0,$l); - $l += 7 +length($fatal_line); - - die "$curr_in_file", "Line $fatal_line: $A\n" . - (" " x $l) . $_ . "***Fatal Error: $FatalMessage\n"; - } - - sub chk_lparen { - my $token = $_[0]; - my $lc = $_[1]; - s/\s*//; - if (/^[^\(]/) { - PrintErrorMessage("Missing ( after $token",$lc); - } - else { - s/^\(\s*//; - } - } - - sub chk_rparen { - my $token = $_[0]; - my $lc = $_[1]; - s/\s*//; - if (s/^\)//) { - s/\s*//; - } - else { - PrintErrorMessage("Missing ) after $token",$lc); - } - } - - - sub chk_lcb { - my $token = $_[0]; - my $lc = $_[1]; - s/\s*//; - if ($_ !~ /^\{/) { - PrintErrorMessage("Missing { after $token",$lc); - } - else { - s/^{\s*//; - } - } - - sub chk_rcb { - my $token = $_[0]; - my $lc = $_[1]; - if ($_ !~ /^\s*\}/) { - PrintErrorMessage("Missing } after $token",$lc); - } - else { - s/^\s*}\s*//; - } - } - - sub chk_lsb { - my $token = $_[0]; - my $lc = $_[1]; - - s/\s*//; - if ($_ !~ /^\[/) { - PrintErrorMessage("Missing [ after $token",$lc); - } - else { - s/^\[\s*//; - } - } - - sub chk_rsb { - my $token = $_[0]; - my $lc = $_[1]; - - s/\s*//; - if ($_ !~ /^\]/) { - PrintErrorMessage("Missing ] after $token",$lc); - } - else { - s/^\]\s*//; - } - } - - sub chk_comma { - my $lc = $_[0]; - - s/\s*//; - if (/^[^,]/) { - PrintErrorMessage("Did not find expected comma",$lc); - } - else { - s/^,\s*//; - } - } - - sub chk_comment { - my $lc = $_[0]; - - s/\s*//; - if (/^%/) { - # do nothing! - } - elsif (/^[^%]/) { - PrintWarningMessage("Trailing text is ignored",$lc); - } - } - - sub print_headers - { - my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; - $year+=1900; - $mon+=1; - $now_string = "$year/" . ($mon>9 ? "$mon/" : "0$mon/") . - ($mday>9 ? "$mday " : "0$mday ") . - ($hour>9 ? "$hour:" : "0$hour:") . - ($min>9 ? "$min:" : "0$min:") . - ($sec>9 ? "$sec" : "0$sec"); - print OUT "%* -----------------------------------------------\n"; - print OUT "%* mathspic (Perl version $version_number)\n"; - print OUT "%* A filter program for use with PiCTeX\n"; - print OUT "%* Copyright (c) 2005-2010 A Syropoulos & RWD Nickalls \n"; - print OUT "%* Command line: $0 $commandLineArgs\n"; - print OUT "%* Input filename : $source_file\n"; - print OUT "%* Output filename: $out_file\n"; - print OUT "%* Date & time: $now_string\n"; - print OUT "%* -----------------------------------------------\n"; - # - print LOG "----\n"; - print LOG "$now_string\n"; - print LOG "mathspic (Perl version $version_number)\n"; - print LOG "Copyright (c) 2005-2010 A Syropoulos & RWD Nickalls \n"; - print LOG "Input file = $source_file\n"; - print LOG "Output file = $out_file\n"; - print LOG "Log file = $log_file\n"; - print LOG "----\n"; - } - - sub get_point { - - my ($lc) = $_[0]; - my ($PointName); - - if (s/^([^\W\d_]\d{0,4})\s*//i) { #point name - $PointName = $1; - if (!exists($PointTable{lc($PointName)})) { - PrintErrorMessage("Undefined point $PointName",$lc); - return "_undef_"; - } - else { - return lc($PointName); - } - } - else { - PrintErrorMessage("Point name expected",$lc); - return "_undef_"; - } - } - - sub perpendicular { - my ($xP, $yP, $xA, $yA, $xB, $yB) = @_; - my ($xF, $yF, $deltax, $deltay, $m1, $m2, $c1, $c2, $factor); - - $deltax = $xA - $xB; - return ($xA, $yP) if abs($deltax) < 0.0000001; - $deltay = $yA - $yB; - return ($xP, $yA) if abs($deltay) < 0.0000001; - $m1 = $deltay / $deltax; - eval { $m2 = (-1) / $m1;}; - PrintFatalError("Division by zero",$lc) if $@; - $c1 = $yA - $m1 * $xA; - $c2 = $yP - $m2 * $xP; - eval { $factor = 1 / ($m1 - $m2)}; - PrintFatalError("Division by zero",$lc) if $@; - return (($c2 - $c1) * $factor, ($m1 * $c2 - $m2 * $c1) * $factor); - } - - sub Length { - my ($xA, $yA, $xB, $yB)=@_; - return sqrt(($xB - $xA)**2 + ($yB - $yA)**2); - } - - sub triangleArea { - my ($xA, $yA, $xB, $yB, $xC, $yC)=@_; - my ($lenAB, $lenBC, $lenCA, $s); - - $lenAB = Length($xA,$yA,$xB,$yB); - $lenBC = Length($xB,$yB,$xC,$yC); - $lenCA = Length($xC,$yC,$xA,$yA); - $s = ($lenAB + $lenBC + $lenCA) / 2; - return sqrt($s * ($s - $lenAB)*($s - $lenBC)*($s - $lenCA)); - } - - sub pointOnLine { - my ($xA, $yA, $xB, $yB, $dist)=@_; - my ($deltax, $deltay, $xPol, $yPol); - - $deltax = $xB - $xA; - $deltay = $yB - $yA; - $xPol = $xA + ($dist * $deltax / &Length($xA,$yA,$xB,$yB)); - $yPol = $yA + ($dist * $deltay / &Length($xA,$yA,$xB,$yB)); - return ($xPol, $yPol); - } - - - - sub circumCircleCenter { - my ($xA, $yA, $xB, $yB, $xC, $yC, $lc)=@_; - my ($deltay12, $deltax12, $xs12, $ys12); - my ($deltay23, $deltax23, $xs23, $ys23); - my ($xcc, $ycc); - my ($m23, $mr23, $c23, $m12, $mr12, $c12); - my ($sideA, $sideB, $sideC, $a, $radius); - - if (abs(triangleArea($xA, $yA, $xB, $yB, $xC, $yC)) < 0.0000001) - { - PrintErrorMessage("Area of triangle is zero!",$lc); - return (0,0,0); - } - $deltay12 = $yB - $yA; - $deltax12 = $xB - $xA; - $xs12 = $xA + $deltax12 / 2; - $ys12 = $yA + $deltay12 / 2; - # - $deltay23 = $yC - $yB; - $deltax23 = $xC - $xB; - $xs23 = $xB + $deltax23 / 2; - $ys23 = $yB + $deltay23 / 2; - # - CCXYLINE:{ - if (abs($deltay12) < 0.0000001) - { - $xcc = $xs12; - if (abs($deltax23) < 0.0000001) - { - $ycc = $ys23; - last CCXYLINE; - } - else - { - $m23 = $deltay23 / $deltax23; - $mr23 = -1 / $m23; - $c23 = $ys23 - $mr23 * $xs23; - $ycc = $mr23 * $xs12 + $c23; - last CCXYLINE; - } - } - if (abs($deltax12) < 0.0000001) - { - $ycc = $ys12; - if (abs($deltay23) < 0.0000001) - { - $xcc = $xs23; - last CCXYLINE; - } - else - { - $m23 = $deltay23 / $deltax23; - $mr23 = -1 / $m23; - $c23 = $ys23 - $mr23 * $xs23; - $xcc = ($ys12 - $c23) / $mr23; - last CCXYLINE; - } - } - if (abs($deltay23) < 0.0000001) - { - $xcc = $xs23; - if (abs($deltax12) < 0.0000001) - { - $ycc = $ys12; - last CCXYLINE; - } - else - { - $m12 = $deltay12 / $deltax12; - $mr12 = -1 / $m12; - $c12 = $ys12 - $mr12 * $xs12; - $ycc = $mr12 * $xcc + $c12; - last CCXYLINE; - } - } - if (abs($deltax23) < 0.0000001) - { - $ycc = $ys23; - if (abs($deltay12) < 0.0000001) - { - $xcc = $xs12; - last CCXYLINE; - } - else - { - $m12 = $deltay12 / $deltax12; - $mr12 = -1 / $m12; - $c12 = $ys12 - $mr12 * $xs12; - $xcc = ($ycc - $c12) / $mr12; - last CCXYLINE; - } - } - $m12 = $deltay12 / $deltax12; - $mr12 = -1 / $m12; - $c12 = $ys12 - $mr12 * $xs12; - #----- - $m23 = $deltay23 / $deltax23; - $mr23 = -1 / $m23; - $c23 = $ys23 - $mr23 * $xs23; - $xcc = ($c23 - $c12) / ($mr12 - $mr23); - $ycc = ($c23 * $mr12 - $c12 * $mr23) / ($mr12 - $mr23); - } - # - $sideA = &Length($xA,$yA,$xB,$yB); - $sideB = &Length($xB,$yB,$xC,$yC); - $sideC = &Length($xC,$yC,$xA,$yA); - $a = triangleArea($xA, $yA, $xB, $yB, $xC, $yC); - $radius = ($sideA * $sideB * $sideC) / (4 * $a); - # - return ($xcc, $ycc, $radius); - } - - sub ComputeDist { - my ($lc) = $_[0]; - my ($v1, $v2); - - if (s/^((\+|-)?\d+(\.\d+)?([eE](\+|-)?\d+)?)//) #is it a number? - { - return ($1, 1); - } - elsif (/^[^\W\d_]\d{0,4}[^\W\d_]\d{0,4}/) #it is a pair of IDs? - { - s/^([^\W\d_]\d{0,4})//i; - $v1 = $1; - if (!exists($PointTable{lc($v1)})) { - if (exists($VarTable{lc($v1)})) { - return ($VarTable{lc($v1)}, 1); - } - PrintErrorMessage("Point $v1 has not been defined", $lc); - s/^\s*[^\W\d_]\d{0,4}//i; - return (0,0); - } - $v1 = lc($v1); - s/^\s*([^\W\d_]\d{0,4})//i; - $v2 = $1; - if (!exists($PointTable{lc($v2)})) - { - PrintErrorMessage("Point $v2 has not been defined", $lc); - return (0,0); - } - $v2 = lc($v2); - my ($x1,$y1,$pSV1,$pS1) = unpack("d3A*",$PointTable{$v1}); - my ($x2,$y2,$pSV2,$pS2) = unpack("d3A*",$PointTable{$v2}); - return (Length($x1,$y1,$x2,$y2), 1); - } - elsif (s/^([^\W\d_]\d{0,4})//i) # it is a single id - { - $v1 = $1; - if (!exists($VarTable{lc($v1)})) #it isn't a variable - { - PrintErrorMessage("Variable $v1 has not been defined", $lc); - return (0,0); - } - return ($VarTable{lc($v1)}, 1); - } - else - { - PrintErrorMessage("Unexpected token", $lc); - return (0,0); - } - } - - sub intersection4points { - my ($x1, $y1, $x2, $y2, $x3, $y3, $x4, $y4) = @_; - my ($deltay12, $deltax12, $deltay34, $deltax34); - my ($xcc, $ycc, $m34, $c34, $m12, $c12); - - $deltay12 = $y2 - $y1; - $deltax12 = $x2 - $x1; - # - $deltay34 = $y4 - $y3; - $deltax34 = $x4 - $x3; - I4PXYLINE:{ - if (abs($deltay12) < 0.0000001) - { - $ycc = $y1; - if (abs($deltax34) < 0.0000001) - { - $xcc = $x3; - last I4PXYLINE; - } - else - { - $m34 = $deltay34 / $deltax34; - $c34 = $y3 - $m34 * $x3; - $xcc = ($ycc - $c34) / $m34; - last I4PXYLINE; - } - } - if (abs($deltax12) < 0.0000001) - { - $xcc = $x1; - if (abs($deltay34) < 0.0000001) - { - $ycc = $y3; - last I4PXYLINE; - } - else - { - $m34 = $deltay34 / $deltax34; - $c34 = $y3 - $m34 * $x3; - $ycc = $m34 * $xcc + $c34; - last I4PXYLINE; - } - } - if (abs($deltay34) < 0.0000001) - { - $ycc = $y3; - if (abs($deltax12) < 0.0000001) - { - $xcc = $x1; - last I4PXYLINE; - } - else - { - $m12 = $deltay12 / $deltax12; - $c12 = $y1 - $m12 * $x1; - $xcc = ($ycc - $c12) / $m12; - last I4PXYLINE; - } - } - if (abs($deltax34) < 0.0000001) - { - $xcc = $x3; - if (abs($deltay12) < 0.0000001) - { - $ycc = $y1; - last I4PXYLINE; - } - else - { - $m12 = $deltay12 / $deltax12; - $c12 = $y1 - $m12 * $x1; - $ycc = $m12 * $xcc + $c12; - last I4PXYLINE; - } - } - $m12 = $deltay12 / $deltax12; - $c12 = $y1 - $m12 * $x1; - $m34 = $deltay34 / $deltax34; - $c34 = $y3 - $m34 * $x3; - $xcc = ($c34 - $c12) / ($m12 - $m34); - $ycc = ($c34 * $m12 - $c12 * $m34) / ($m12 - $m34); - } - return ($xcc, $ycc); - } - - sub IncircleCenter { - my ($Ax, $Ay, $Bx, $By, $Cx, $Cy) = @_; - my ($sideA, $sideB, $sideC); - my ($ba1, $xA1, $yA1, $cb1, $ac1, $xB1, $yB1, $xC1, $yC1, $a, $s, $r); - - #determine the lengths of the sides - $sideA = Length($Bx, $By, $Cx, $Cy); - $sideB = Length($Cx, $Cy, $Ax, $Ay); - $sideC = Length($Ax, $Ay, $Bx, $By); - # - $ba1 = ($sideC * $sideA) / ($sideB + $sideC); - ($xA1, $yA1) = pointOnLine($Bx, $By, $Cx, $Cy, $ba1); - $cb1 = ($sideA * $sideB) / ($sideC + $sideA); - ($xB1, $yB1) = pointOnLine($Cx, $Cy, $Ax, $Ay, $cb1); - $ac1 = ($sideB * $sideC) / ($sideA + $sideB); - ($xC1, $yC1) = pointOnLine($Ax, $Ay, $Bx, $By, $ac1); - ($xcenter, $ycenter) = &intersection4points($Ax, $Ay, $xA1, $yA1, - $Bx, $By, $xB1, $yB1); - # get radius - $a = &triangleArea($Ax, $Ay, $Bx, $By, $Cx, $Cy); - $s = ($sideA + $sideB +$sideC) / 2; - $r = $a / $s; - return ($xcenter, $ycenter, $r); - } - - sub Angle { - my ($Ax, $Ay, $Bx, $By, $Cx, $Cy) = @_; - my ($RAx, $RAy, $RBx, $RBy, $RCx, $RCy, $deltax, $deltay); - my ($lineBA, $lineBC, $lineAC, $k, $kk, $angle); - my ($T, $cosT, $sinT) = (0.3, cos(0.3), sin(0.3)); - - $RAx = $Ax * $cosT + $Ay * $sinT; - $RAy = -$Ax * $sinT + $Ay * $cosT; - $RBx = $Bx * $cosT + $By * $sinT; - $RBy = -$Bx * $sinT + $By * $cosT; - $RCx = $Cx * $cosT + $Cy * $sinT; - $RCy = -$Cx * $sinT + $Cy * $cosT; - $deltax = $RBx - $RAx; - $deltay = $RBy - $RAy; - $lineBA = sqrt($deltax*$deltax + $deltay*$deltay); - if ($lineBA < 0.0000001) - { - return -500; - } - $deltax = $RBx - $RCx; - $deltay = $RBy - $RCy; - $lineBC = sqrt($deltax*$deltax + $deltay*$deltay); - if ($lineBC < 0.0000001) - { - return -500; - } - $deltax = $RAx - $RCx; - $deltay = $RAy - $RCy; - $lineAC = sqrt($deltax*$deltax + $deltay*$deltay); - if ($lineAC < 0.0000001) - { - return -500; - } - $k = ($lineBA*$lineBA + $lineBC*$lineBC - $lineAC*$lineAC ) / - (2 * $lineBA * $lineBC); - $k = -1 if $k < -0.99999; - $k = 1 if $k > 0.99999; - $kk = $k * $k; - if (($kk * $kk) == 1) - { - $angle = PI if $k == -1; - $angle = 0 if $k == 1; - } - else - { - $angle = (PI / 2) - atan2($k / sqrt(1 - $kk),1); - } - return $angle * 180 / PI; - } - - sub excircle { - my ($A, $B, $C, $D, $E) = @_; - my ($Ax,$Ay,$Bx,$By,$Dx,$Dy,$Ex,$Ey,$ASVA,$ASA); - ($Ax,$Ay,$ASVA,$ASA)=unpack("d3A*",$PointTable{$A}); - ($Bx,$By,$ASVA,$ASA)=unpack("d3A*",$PointTable{$B}); - ($Cx,$Cy,$ASVA,$ASA)=unpack("d3A*",$PointTable{$C}); - ($Dx,$Dy,$ASVA,$ASA)=unpack("d3A*",$PointTable{$D}); - ($Ex,$Ey,$ASVA,$ASA)=unpack("d3A*",$PointTable{$E}); - my ($sideA, $sideB, $sideC, $s, $R, $theAdeg, $d); - my ($Xmypoint, $Ymypoint, $deltax, $deltay, $mylength, $xc, $yc); - - $sideA = &Length($Bx, $By, $Cx, $Cy); - $sideB = &Length($Cx, $Cy, $Ax, $Ay); - $sideC = &Length($Ax, $Ay, $Bx, $By); - $s = ($sideA + $sideB + $sideC) / 2; - $R = triangleArea($Ax, $Ay, $Bx, $By, $Cx, $Cy) / - ($s - &Length($Dx, $Dy, $Ex, $Ey)); - if (($D eq $A && $E eq $B) || ($D eq $B && $E eq $A)) - { - $theAdeg = &Angle($Bx, $By, $Cx, $Cy, $Ax, $Ay); - $Xmypoint = $Cx; - $Ymypoint = $Cy; - } - elsif (($D eq $B && $E eq $C) || ($D eq $C && $E eq $B)) - { - $theAdeg = &Angle($Cx, $Cy, $Ax, $Ay, $Bx, $By); - $Xmypoint = $Ax; - $Ymypoint = $Ay; - } - elsif (($D eq $C && $E eq $A) || ($D eq $A && $E eq $C)) - { - $theAdeg = &Angle($Ax, $Ay, $Bx, $By, $Cx, $Cy); - $Xmypoint = $Bx; - $Ymypoint = $By; - } - else - { - return (0,0,0); - } - $d = $R / sin($theAdeg * PI / 180 / 2); - my ($xIn, $yIn, $rin) = &IncircleCenter($Ax, $Ay, $Bx, $By, $Cx, $Cy); - $deltax = $xIn - $Xmypoint; - $deltay = $yIn - $Ymypoint; - $mylength = sqrt($deltax*$deltax + $deltay*$deltay); - $xc = $Xmypoint + $d * $deltax / $mylength; - $yc = $Ymypoint + $d * $deltay / $mylength; - return ($xc, $yc, $R); - } - - sub DrawLineOrArrow { - my $draw_Line = shift; - my $lc = shift; - my $lineLength = -1; - my $stacklen = 0; - my @PP = (); - # if ($draw_Line != 2) { - # s/\s*//; - # if (s/^\[\s*//) { # optional length specifier - # $lineLength = expr($lc); - # if ($lineLength <= 0) { - # PrintErrorMessage("length must greater than zero",$lc); - # $lineLength = -1; - # } - # chk_rsb("optional part",$lc); - # } - # } - chk_lparen("$cmd",$lc); - DRAWLINES:while(1) { - @PP = () ; - while(1) { - if (s/^([^\W\d_]\d{0,4})\s*//i) { #point name - $P = $1; - if (!exists($PointTable{lc($P)})) { - PrintErrorMessage("Undefined point $P",$lc); - } - else { - push (@PP,$P); - } - } - else { - $stacklen = @PP; - if ($draw_Line != 2) { - if ($stacklen <= 1) { - PrintErrorMessage("Wrong number of points",$lc); - } - else { - push(@PP,$lc); - if ($draw_Line == 0) { - drawarrows(@PP); - } - elsif ($draw_Line == 1) { - drawlines(@PP); - } - } - } - if (s/^,\s*// and $draw_Line != 2) { - next DRAWLINES; - } - else { - last DRAWLINES; - } - } - } - } - if ($draw_Line == 2) { - $stacklen = @PP; - if ($stacklen < 2) { - PrintErrorMessage("Wrong number of points",$lc); - } - elsif ($stacklen % 2 == 0) { - PrintErrorMessage("Number of points must be odd",$lc); - } - else { - drawCurve(@PP); - } - } - chk_rparen("arguments of $cmd",$lc); - chk_comment($lc); - } - - sub drawarrows { - my ($NoArgs); - $NoArgs = @_; - my ($lc) = $_[$NoArgs-1]; #line number is the last argument - my ($NumberOfPoints, $p, $q, $r12, $d12); - my ($px,$py,$pSV,$pS, $qx,$qy,$qSV,$qS); - - $NumberOfPoints = $NoArgs - 1; - LOOP: for(my $i=0; $i < $NumberOfPoints - 1; $i++) - { - $p = $_[$i]; - $q = $_[$i+1]; - ($px,$py,$pSV,$pS) = unpack("d3A*",$PointTable{lc($p)}); - ($qx,$qy,$qSV,$qS) = unpack("d3A*",$PointTable{lc($q)}); - $pSV = $defaultLFradius if $pSV == 0; - $qSV = $defaultLFradius if $qSV == 0; - $r12 = $pSV + $qSV; - $d12 = Length($px,$py,$qx,$qy); - if ($d12 <= $r12) - { - if($d12 == 0) - { - PrintErrorMessage("points $p and $q are the same", $lc); - next LOOP; - } - PrintWarningMessage("arrow $p$q not drawn: points too close or ". - "radii too big", $lc); - next LOOP; - } - ($px, $py) = pointOnLine($px, $py, $qx, $qy, $pSV) if $pSV > 0; - ($qx, $qy) = pointOnLine($qx, $qy, $px, $py, $qSV) if $qSV > 0; - my ($beta, $gamma); - $beta = tan($arrowAngleB * D2R / 2); - $gamma = 2 * tan($arrowAngleC * D2R / 2); - printf OUT "\\arrow <%.5f%s> [%.5f,%.5f] from %.5f %.5f to %.5f %.5f\n", - $arrowLength, $arrowLengthUnits, $beta, $gamma, $px, $py, $qx, $qy; - } - } - - sub drawlines { - my ($NoArgs); - $NoArgs = @_; - my ($lc) = $_[$NoArgs-1]; #line number is the last argument - my ($NumberOfPoints, $p, $q, $r12, $d12); - my ($px,$py,$pSV,$pS, $qx,$qy,$qSV,$qS); - - $NumberOfPoints = $NoArgs - 1; - LOOP: for(my $i=0; $i < $NumberOfPoints - 1; $i++) - { - $p = $_[$i]; - $q = $_[$i+1]; - ($px,$py,$pSV,$pS) = unpack("d3A*",$PointTable{lc($p)}); - ($qx,$qy,$qSV,$qS) = unpack("d3A*",$PointTable{lc($q)}); - $pSV = $defaultLFradius if $pSV == 0; - $qSV = $defaultLFradius if $qSV == 0; - $r12 = $pSV + $qSV; - $d12 = Length($px,$py,$qx,$qy); - if ($d12 <= $r12) - { - if($d12 == 0) - { - PrintErrorMessage("points $p and $q are the same", $lc); - next LOOP; - } - PrintWarningMessage("line $p$q not drawn: points too close or ". - "radii too big", $lc); - next LOOP; - } - ($px, $py) = pointOnLine($px, $py, $qx, $qy, $pSV) if $pSV > 0; - ($qx, $qy) = pointOnLine($qx, $qy, $px, $py, $qSV) if $qSV > 0; - if ($px == $qx || $py == $qy) - { - printf OUT "\\putrule from %.5f %.5f to %.5f %.5f %%%% %s%s\n", - $px,$py,$qx,$qy,$p,$q; - } - else - { - printf OUT "\\plot %.5f %.5f\t%.5f %.5f / %%%% %s%s\n", - $px, $py,$qx,$qy,$p,$q; - } - } - } - - sub drawCurve { - my ($NoArgs); - $NoArgs = @_; - my ($lc) = $_[$NoArgs-1]; #line number is the last argument - my ($NumberOfPoints, $p); - - $NumberOfPoints = $NoArgs - 1; - print OUT "\\setquadratic\n\\plot\n"; - for(my $i=0; $i <= $NumberOfPoints; $i++) - { - $p = $_[$i]; - my ($px,$py,$pSV,$pS) = unpack("d3A*",$PointTable{lc($p)}); - printf OUT "\t%0.5f %0.5f", $px, $py; - print OUT (($i == $NumberOfPoints) ? " / %$p\n" : " %$p\n"); - } - print OUT "\\setlinear\n"; - } - - sub drawpoints { - my ($NumberOfPoints,$p); - $NumberOfPoints = @_; - my ($px,$py,$pSV,$pS); - - for($i=0; $i < $NumberOfPoints; $i++) - { - $p = $_[$i]; - ($px,$py,$pSV,$pS) = unpack("d3A*",$PointTable{lc($p)}); - if ($pS eq "" and $defaultsymbol =~ /circle|square/) { - $pS = $defaultsymbol; - } - POINTSWITCH: { - if ($pS eq "") # no plot symbol specified - { - printf OUT "\\put {%s} at %.5f %.5f %%%% %s\n", - $defaultsymbol, $px, $py, $p; - last POINTSWITCH; - } - if ($pS eq "circle") # plot symbol is a circle - { - my $radius = (defined($DimOfPoint{lc($p)})) ? $DimOfPoint{lc($p)} : - $GlobalDimOfPoints; - if ($radius > 0) # draw a circle using the current units - { - if ($radius == 1.5) # use \bigcirc - { - printf OUT "\\put {\$\\bigcirc\$} at %.5f %.5f %%%% %s\n", - $px, $py, $p; - } - else - { - printf OUT "\\circulararc 360 degrees from %.5f %.5f center at %.5f %.5f %%%% %s\n", - $px+$radius, $py, $px, $py, $p; - } - } - else #use \circ symbol - { - printf OUT "\\put {\$\\circ\$} at %.5f %.5f %%%% %s\n", - $px,$py,$p; - } - last POINTSWITCH; - } - if ($pS eq "square") - { - my $side = (defined($DimOfPoint{lc($p)})) ? $DimOfPoint{lc($p)} : - $GlobalDimOfPoints; - printf OUT "\\put {%s} at %.5f %.5f %%%% %s\n", - drawsquare($side), $px, $py, $p; - last POINTSWITCH; - } - printf OUT "\\put {%s} at %.5f %.5f %%%% %s\n", $pS,$px,$py,$p; - } - } - } - - sub drawAngleArc { - my ($P1, $P2, $P3, $radius, $inout, $direction) = @_; - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$P1}); - my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$P2}); - my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$P3}); - - my $internalAngle = Angle($x1, $y1, $x2, $y2, $x3, $y3); - my $externalAngle = 360 - $internalAngle; - my ($x, $y) = pointOnLine($x2, $y2, $x1, $y1, $radius); - my $code = ""; - if ($inout eq "internal" and $direction eq "clockwise" ) { - $code = sprintf "\\circulararc %.5f degrees from %.5f %.5f center at %.5f %.5f\n", - -1 * $internalAngle, $x, $y, $x2, $y2; - } - elsif ($inout eq "internal" and $direction eq "anticlockwise" ) { - $code = sprintf "\\circulararc %.5f degrees from %.5f %.5f center at %.5f %.5f\n", - $internalAngle, $x, $y, $x2, $y2; - } - elsif ($inout eq "external" and $direction eq "clockwise" ) { - $code = sprintf "\\circulararc %.5f degrees from %.5f %.5f center at %.5f %.5f\n", - -1 * $externalAngle, $x, $y, $x2, $y2; - } - elsif ($inout eq "external" and $direction eq "anticlockwise" ) { - $code = sprintf "\\circulararc %.5f degrees from %.5f %.5f center at %.5f %.5f\n", - $externalAngle, $x, $y, $x2, $y2; - } - return $code; - } - - sub drawAngleArrow { - my ($P1, $P2, $P3, $radius, $inout, $direction) = @_; - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$P1}); - my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$P2}); - my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$P3}); - - my $code = drawAngleArc($P1, $P2, $P3, $radius, $inout, $direction); - - my ($xqp, $yqp) = pointOnLine($x2, $y2, $x1, $y1, $radius); - my ($deltax, $deltay) = ($x1 - $x2, $y1 - $y2); - my $AL; - - if ($xunits =~ /mm/) { - $AL = 1; - } - elsif ($xunits =~ /cm/) { - $AL = 0.1; - } - elsif ($xunits =~ /pt/) { - $AL = 2.845; - } - elsif ($xunits =~ /bp/) { - $AL = 2.835; - } - elsif ($xunits =~ /pc/) { - $AL = 0.2371; - } - elsif ($xunits =~ /in/) { - $AL = 0.03937; - } - elsif ($xunits =~ /dd/) { - $AL = 2.659; - } - elsif ($xunits =~ /cc/) { - $AL = 0.2216; - } - elsif ($xunits =~ /sp/) { - $AL = 186467.98; - } - my $halfAL = $AL / 2; - my $d = sqrt($radius * $radius - $halfAL * $halfAL); - my $alpha = atan2($d / $halfAL, 1) * R2D; - my $beta = 2 * (90 - $alpha); - my $thetaqr; - if (abs($deltay) < 0.00001) { - if ($deltax > 0 ) {$thetaqr = 0 } - elsif ($deltax < 0) {$thetaqr = -180} - } - else { - if (abs($deltax) < 0.00001) { - $thetaqr = 90; - } - else { - $thetaqr = atan2($deltay / $deltax, 1) * R2D; - } - } - my ($xqr, $yqr) = pointOnLine($x2, $y2, $x3, $y3, $radius); - $deltax = $x3 - $x2; - $deltay = $y3 - $y2; - $alpha = atan2(sqrt($radius * $radius - $halfAL * $halfAL) / $halfAL, 1) / - D2R; - $beta = 2 * (90 - $alpha); - LINE2 : { - if (abs($deltax) < 0.00001) { - if ($deltay > 0) { $thetaqr = 90 } - elsif ($deltay < 0) { $thetaqr = - 90 } - last LINE2; - } - else { - $thetaqr = atan2($deltay / $deltax, 1) * R2D; - } - if (abs($deltay) < 0.00001) { - if ($deltax > 0) { $thetaqr = 0 } - elsif ($deltax < 0) { $thetaqr = -180 } - last LINE2; - } - else { - $thetaqr = atan2($deltay / $deltax, 1) * R2D; - } - if ($deltax < 0 and $deltay > 0) { $thetaqr += 180 } - elsif ($deltax < 0 and $deltay < 0) { $thetaqr += 180 } - elsif ($deltax > 0 and $deltay < 0) { $thetaqr += 360 } - } - my $xqrleft = $x2 + $radius * cos(($thetaqr + $beta) * D2R); - my $yqrleft = $y2 + $radius * sin(($thetaqr + $beta) * D2R); - my $xqrright = $x2 + $radius * cos(($thetaqr - $beta) * D2R); - my $yqrright = $y2 + $radius * sin(($thetaqr - $beta) * D2R); - if ($inout eq "internal" and $direction eq "clockwise") { - $code .= sprintf "\\arrow <1.5mm> [0.5, 1] from %.5f %.5f to %.5f %.5f\n", - $xqrleft, $yqrleft, $xqr, $yqr; - } - elsif ($inout eq "internal" and $direction eq "anticlockwise") { - $code .= sprintf "\\arrow <1.5mm> [0.5, 1] from %.5f %.5f to %.5f %.5f\n", - $xqrright, $yqrright, $xqr, $yqr; - } - elsif ($inout eq "external" and $direction eq "clockwise") { - $code .= sprintf "\\arrow <1.5mm> [0.5, 1] from %.5f %.5f to %.5f %.5f\n", - $xqrleft, $yqrleft, $xqr, $yqr; - } - elsif ($inout eq "external" and $direction eq "anticlockwise") { - $code .= sprintf "\\arrow <1.5mm> [0.5, 1] from %.5f %.5f to %.5f %.5f\n", - $xqrright, $yqrright, $xqr, $yqr; - } - return $code; - } - - sub expr { - my $lc = $_[0]; - my($left,$op,$right); - - $left = term($lc); - while ($op = addop()) { - $right = term($lc); - if ($op eq '+') - { $left += $right } - else - { $left -= $right } - } - return $left; - } - - sub addop { - s/^([+-])// && $1; - } - - sub term { - my $lc = $_[0]; - my ($left, $op, $right); - $left = factor($lc); - while ($op = mulop()) { - $right = factor($lc); - if ($op eq '*') - { $left *= $right } - elsif ($op =~ /rem/i) { - eval {$left %= $right}; - PrintFatalError("Division by zero", $lc) if $@; - } - else { - eval {$left /= $right}; - PrintFatalError("Division by zero", $lc) if $@; - } - } - return $left; - } - - sub mulop { - (s#^([*/])## || s/^(rem)//i) && lc($1); - } - - sub factor { - my $lc = $_[0]; - my ($left); - - $left = primitive($lc); - if (s/^\*\*//) { - $left **= factor($lc); - } - return $left; - } - - sub primitive { - my $lc = $_[0]; - my $val; - s/\s*//; - if (s/^\(//) { #is it an expr in parentheses - $val = expr($lc); - s/^\)// || PrintErrorMessage("Missing right parenthesis", $lc); - } - elsif (s/^-//) { # is it a negated primitive - $val = - primitive(); - } - elsif (s/^\+//) { # is it a positive primitive - $val = primitive(); - } - elsif (s/^angledeg//i) { - chk_lparen("angledeg",$lc); - my $point_1 = get_point($lc); - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1}); - my $point_2 = get_point($lc); - my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2}); - my $point_3 = get_point($lc); - my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point_3}); - my $d12 = Length($x1, $y1, $x2, $y2); - my $d23 = Length($x2, $y2, $x3, $y3); - my $d31 = Length($x3, $y3, $x1, $y1); - if ( $d12 == 0 ) { - PrintErrorMessage("points `$point_1' and `$point_2' are the same", $lc); - $val = 0; - } - elsif ( $d23 == 0 ) { - PrintErrorMessage("points `$point_2' and `$point_3' are the same", $lc); - $val = 0; - } - elsif ( $d31 == 0 ) { - PrintErrorMessage("points `$point_1' and `$point_3' are the same", $lc); - $val = 0; - } - else { - $val = Angle($x1, $y1, $x2, $y2, $x3, $y3); - $val = 0 if $val == -500; - } - chk_rparen("Missing right parenthesis", $lc); - } - elsif (s/^angle//i) { - chk_lparen("angle",$lc); - my $point_1 = get_point($lc); - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1}); - my $point_2 = get_point($lc); - my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2}); - my $point_3 = get_point($lc); - my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point_3}); - my $d12 = Length($x1, $y1, $x2, $y2); - my $d23 = Length($x2, $y2, $x3, $y3); - my $d31 = Length($x3, $y3, $x1, $y1); - if ( $d12 == 0 ) { - PrintErrorMessage("points `$point_1' and `$point_2' are the same", $lc); - $val = 0; - } - elsif ( $d23 == 0 ) { - PrintErrorMessage("points `$point_2' and `$point_3' are the same", $lc); - $val = 0; - } - elsif ( $d31 == 0 ) { - PrintErrorMessage("points `$point_1' and `$point_3' are the same", $lc); - $val = 0; - } - else { - $val = Angle($x1, $y1, $x2, $y2, $x3, $y3); - if ($val == -500) { - $val = 0; - } - else { - $val = D2R * $val; - } - } - chk_rparen("Missing right parenthesis", $lc); - } - elsif (s/^area//i) { - chk_lparen("angledeg",$lc); - my $point_1 = get_point($lc); - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1}); - my $point_2 = get_point($lc); - my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2}); - my $point_3 = get_point($lc); - my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point_3}); - $val = triangleArea($x1, $y1, $x2, $y2, $x3, $y3); - chk_rparen("Missing right parenthesis", $lc); - } - elsif (s/^asin//i) { - chk_lparen("asin"); - $val = expr(); - PrintFatalError("Can't take asin of $val", $lc) if $val < -1 || $val > 1; - $val = asin($val); - chk_rparen("Missing right parenthesis", $lc); - } - elsif (s/^acos//i) { - chk_lparen("acos"); - $val = expr(); - PrintFatalError("Can't take acos of $val", $lc) if $val < -1 || $val > 1 ; - $val = acos($val); - chk_rparen("Missing right parenthesis", $lc); - } - elsif (s/^atan//i) { - chk_lparen("atan"); - $val = expr(); - $val = atan($val); - chk_rparen("Missing right parenthesis", $lc); - } - elsif (s/^cos//i) { - chk_lparen("cos"); - $val = expr(); - $val = cos($val); - chk_rparen("Missing right parenthesis", $lc); - } - elsif (s/^directiondeg//i) { - chk_lparen("directiondeg",$lc); - my $point_1 = get_point($lc); - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1}); - my $point_2 = get_point($lc); - my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2}); - my $x3 = $x1+1; - if ( ($y2 - $y1) >= 0) { - $val = Angle($x3, $y1, $x1, $y1, $x2, $y2); - $val = 0 if $val == -500; - } - else { - $val = 360 - Angle($x3, $y1, $x1, $y1, $x2, $y2); - $val = 0 if $val == -500; - } - chk_rparen("Missing right parenthesis", $lc); - } - elsif (s/^direction//i) { - chk_lparen("direction",$lc); - my $point_1 = get_point($lc); - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1}); - my $point_2 = get_point($lc); - my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2}); - my $x3 = $x1+1; - if ( ($y2 - $y1) >= 0) { - $val = Angle($x3, $y1, $x1, $y1, $x2, $y2); - $val = 0 if $val == -500; - $val = D2R * $val; - } - else { - $val = 360 - Angle($x3, $y1, $x1, $y1, $x2, $y2); - $val = 0 if $val == -500; - $val = D2R * $val; - } - chk_rparen("Missing right parenthesis", $lc); - } - elsif (s/^exp//i) { - chk_lparen("exp"); - $val = expr(); - $val = exp($val); - chk_rparen("Missing right parenthesis", $lc); - } - elsif (s/^int//i) { - chk_lparen("int"); - $val = expr(); - $val = int($val); - chk_rparen("Missing right parenthesis", $lc); - } - elsif (s/^log//i) { - chk_lparen("log"); - $val = expr(); - PrintFatalError("Can't take log of $val", $lc) if $val <= 0; - $val = log($val); - chk_rparen("Missing right parenthesis", $lc); - } - elsif (s/^sin//i) { - chk_lparen("sin"); - $val = expr(); - $val = sin($val); - chk_rparen("Missing right parenthesis", $lc); - } - elsif (s/^sgn//i) { - chk_lparen("sgn"); - $val = expr(); - if ($val > 0) { - $val = 1; - } - elsif ($val == 0) { - $val = 0; - } - else { - $val = -1; - } - chk_rparen("Missing right parenthesis", $lc); - } - elsif (s/^sqrt//i) { - chk_lparen("sqrt"); - $val = expr(); - $val = sqrt($val); - chk_rparen("Missing right parenthesis", $lc); - } - elsif (s/^tan//i) { - chk_lparen("tan"); - $val = expr(); - $val = sin($val)/cos($val); - chk_rparen("Missing right parenthesis", $lc); - } - elsif (s/^xcoord//i) { - chk_lparen("xcoord"); - my $point_name = get_point; - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_name}); - $val = $x1; - chk_rparen("Missing right parenthesis", $lc); - } - elsif (s/^ycoord//i) { - chk_lparen("ycoord"); - my $point_name = get_point; - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_name}); - $val = $y1; - chk_rparen("Missing right parenthesis", $lc); - } - elsif (s/^_pi_//i) { - $val = PI; - } - elsif (s/^_e_//i) { - $val = 2.71828182845905; - } - elsif (s/^_linethickness_//i) { - $val = $LineThickness / $xunits; - } - else { - my $err_code; - ($val,$err_code) = ComputeDist($lc); - } - s/\s*//; - return $val; - } - - sub memberOf { - my $elem = shift(@_); - - my $found = 0; - foreach $item (@_){ - if ($item eq $elem){ - $found = 1; - last; - } - } - return $found; - } - - sub midpoint { - my ($x1, $y1, $x2, $y2)=@_; - return ($x1 + ($x2 - $x1)/2, - $y1 + ($y2 - $y1)/2); - } - - - sub tand { - my $d = $_[0]; - $d = $d * PI / 180; - return sin($d)/cos($d); - } - - sub get_string { - my $string = shift; - my $lc = shift; - - $string =~ s/^\s+//; - if ($string !~ s/^\"//) { - PrintErrorMessage("No starting \" found",$lc); - return (1,$string,$string); - } - my @ch = split //,$string; - my @cmd; - while (@ch and $ch[0] ne "\"") { - if ($ch[0] eq "\\" and (defined $ch[1]) and $ch[1] eq "\"") { - shift @ch; - push @cmd, $ch[0]; - shift @ch; - } - else { - push @cmd, $ch[0]; - shift @ch; - } - } - if (! defined $ch[0]) { - PrintErrorMessage("No closing \" found",$lc); - return (1,join("",@cmd), join("",@ch)) - } - else { - shift @ch; - return (0, join("",@cmd), join("",@ch)) - } - } - - sub is_tainted { - my $arg = shift; - my $nada = substr($arg,0,0); - local $@; - eval { eval "# $nada"}; - return length($@) != 0; - } - - sub noOfDigits { - my $num = $_[0]; - - if ($num =~ /^[\+-]?\d+(?!\.)/) { - return 0; - } - elsif ($num =~ /^[\+-]\d+\.(\d+)?/) { - return length($1); - } - } - - sub drawsquare { - my $s = $_[0]; - #$s *= sqrt(2); - $s = sprintf "%.5f", $s; - my $code = "\\setlength{\\unitlength}{$xunits}%\n"; - $code .= "\\begin{picture}($s,$s)\\put(0,0)" . - "{\\framebox($s,$s){}}\\end{picture}"; - return $code; - } - - sub X2sp { - my $LT = shift; - my $units = shift; - - if ($units eq "pc") { - return $LT * 786432; - } - elsif ($units eq "pt") { - return $LT * 65536; - } - elsif ($units eq "in") { - return $LT * 4736286.72; - } - elsif ($units eq "bp") { - return $LT * 65781.76; - } - elsif ($units eq "cm") { - return $LT * 1864679.811023622; - } - elsif ($units eq "mm") { - return $LT * 186467.981102362; - } - elsif ($units eq "dd") { - return $LT * 70124.086430424; - } - elsif ($units eq "cc") { - return $LT * 841489.037165082; - } - elsif ($units eq "sp") { - return $LT; - } - } - - - sub sp2X { - my $LT = shift; - my $units = shift; - - if ($units eq "pc") { - return $LT / 786432; - } - elsif ($units eq "pt") { - return $LT / 65536; - } - elsif ($units eq "in") { - return $LT / 4736286.72; - } - elsif ($units eq "bp") { - return $LT / 65781.76; - } - elsif ($units eq "cm") { - return $LT / 1864679.811023622; - } - elsif ($units eq "mm") { - return $LT / 186467.981102362; - } - elsif ($units eq "dd") { - return $LT / 70124.086430424; - } - elsif ($units eq "cc") { - return $LT / 841489.037165082; - } - elsif ($units eq "sp") { - return $LT; - } - } - - sub setLineThickness { - my $Xunits = shift; - my $LT = shift; - $Xunits =~ s/^((\+|-)?\d+(\.\d+)?([eE](\+|-)?\d+)?)//; - my $xlength = "$1"; - $Xunits =~ s/^\s*($units)//; - my $x_in_units = $1; - $LT =~ s/^((\+|-)?\d+(\.\d+)?([eE](\+|-)?\d+)?)//; - my $LTlength = "$1"; - $LT =~ s/^\s*($units)//; - my $LT_in_units = $1; - $LTlength = X2sp($LTlength,$LT_in_units); - $LTlength = sp2X($LTlength,$x_in_units); - return $LTlength; - } - - sub process_input { - my ($INFILE,$currInFile) = @_; - my $lc = 0; - my $no_output = 0; - $curr_in_file = $currInFile; - LINE: while(<$INFILE>) { - $lc++; - chomp($command = $_); - s/^\s+//; - if (/^beginSkip\s*/i) { - $no_output = 1; - print OUT "%%$_" if $comments_on; - next LINE; - } - elsif (/^endSkip\s*/i) { - if ($no_output == 0) { - PrintErrorMessage("endSkip without beginSkip",$lc); - } - else { - $no_output = 0; - } - print OUT "%%$_" if $comments_on and !$no_output; - next LINE; - } - elsif ($no_output == 1) { - next LINE; - } - else { - if (/^[^\\]/) { - my $out_line = mpp($command,$lc) unless /^\\/; #call macro pre-processor - $_ = "$out_line\n"; - } - - if (/^\s*%/) - { - print OUT "$_" if $comments_on; - } - elsif (s/^\s*(beginloop(?=\W))//i) { - s/\s+//; - my $times = expr($lc); - print OUT "%% BEGINLOOP $times\n" if $comments_on; - my @C = (); - REPEATCOMMS: while (<$INFILE>) { - if (/^\s*endloop/i) { - last REPEATCOMMS; - } - else { - push @C, $_; - } - } - if (! /^\s*endloop/i) { - PrintFatalError("unexpected end of file",$lc); - } - else { - s/^\s*endloop//i; - for(my $i=1; $i<=$times; $i++) { - tie *DUMMY, 'DummyFH', \@C; - process_input(DUMMY, $currInFile); - untie *DUMMY; - } - print OUT "%% ENDLOOP\n" if $comments_on; - } - } - elsif (s/^\s*(ArrowShape(?=\W))//i) - { - my $cmd = $1; - print OUT "%% $cmd$_" if $comments_on; - - chk_lparen("$cmd",$lc); - if (s/^default//i) { - $arrowLength = 2; - $arrowLengthUnits = "mm"; - $arrowAngleB = 30; - $arrowAngleC = 40; - } - else { - my ($LocalArrowLength, $LocalArrowAngleB ,$LocalArrowAngleC) = (0,0,0); - $LocalArrowLength = expr($lc); - if (s/^\s*($units)//i) { - $arrowLengthUnits = "$1"; - } - else { - $xunits =~ /(\d+(\.\d+)?)\s*($units)/; - $LocalArrowLength *= $1; - $arrowLengthUnits = "$3"; - } - chk_comma($lc); - $LocalArrowAngleB = expr($lc); - chk_comma($lc); - $LocalArrowAngleC = expr($lc); - $arrowLength = ($LocalArrowLength == 0 ? 2 : $LocalArrowLength); - $arrowLengthUnits = ($LocalArrowLength == 0 ? "mm" : $arrowLengthUnits); - $arrowAngleB = ($LocalArrowAngleB == 0 ? 30 : $LocalArrowAngleB); - $arrowAngleC = ($LocalArrowAngleC == 0 ? 40 : $LocalArrowAngleC); - } - chk_rparen("after $cmd arguments",$lc); - chk_comment("after $cmd command",$lc); - print OUT "%% arrowLength = $arrowLength$arrowLengthUnits, ", - "arrowAngleB = $arrowAngleB ", - "and arrowAngleC = $arrowAngleC\n" if $comments_on; - - } - elsif (s/^\s*(const(?=\W))//i) - { - print OUT "%% $1$_" if $comments_on; - do{ - s/\s*//; - PrintErrorMessage("no identifier found after token const",$lc) - if $_ !~ s/^([^\W\d_]\d{0,4})//i; - my $Constname = $1; - my $constname = lc($Constname); - if (exists $ConstTable{$constname}) { - PrintErrorMessage("Redefinition of constant $constname",$lc); - } - s/\s*//; #remove leading white space - PrintErrorMessage("did not find expected = sign",$lc) - if $_ !~ s/^[=]//i; - my $val = expr($lc); - $VarTable{$constname} = $val; - $ConstTable{$constname} = 1; - print OUT "%% $Constname = $val\n" if $comments_on; - }while (s/^,//); - chk_comment($lc); - s/\s*//; - if (/^[^%]/) { - PrintWarningMessage("Trailing text is ignored",$lc); - } - - } - elsif (s/^\s*(dasharray(?=\W))//i) - { - my ($cmd) = $1; - print OUT "%% $cmd$_" if $comments_on; - chk_lparen($cmd,$lc); - my @DashArray = (); - my $dash = ""; - my $dashpattern = ""; - PATTERN: while (1) { - $dash = sprintf("%.5f", expr($lc)); - if (s/^\s*($units)//i) { - push (@DashArray, "$dash$1"); - } - else { - PrintErrorMessage("Did not found unit after expression", $lc); - } - s/\s*//; - if (/^[^,]/) { - last PATTERN; - } - else { - s/^,\s*//; - } - } - print OUT "\\setdashpattern <"; - while (@DashArray) { - $dashpattern .= shift @DashArray; - $dashpattern .= ","; - } - $dashpattern =~ s/,$//; - print OUT $dashpattern, ">\n"; - chk_rparen("arguments of $cmd",$lc); - chk_comment($lc); - - } - elsif (s/^\s*(drawAngleArc(?=\W))//i or s/^\s*(drawAngleArrow(?=\W))//i ) - { - my $cmd = $1; - print OUT "%% $cmd$_" if $comments_on; - - chk_lcb($cmd,$lc); - my ($P1, $P2, $P3); - if (s/^angle(?=\W)//i) { - chk_lparen("token angle of command $cmd",$lc); - $P1 = get_point($lc); - next LINE if $P1 eq "_undef_"; - $P2 = get_point($lc); - next LINE if $P2 eq "_undef_"; - $P3 = get_point($lc); - next LINE if $P3 eq "_undef_"; - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$P1}); - my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$P2}); - my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$P3}); - my $Angle = Angle($x1, $y1, $x2, $y2, $x3, $y3); - if ($Angle <= 0) { - if ($Angle == 0) { - PrintErrorMessage("Angle is equal to zero",$lc); - next LINE; - } - elsif ($Angle < -400) { - PrintErrorMessage("Something is wrong with the points",$lc); - next LINE; - } - } - chk_rparen("angle part of command $cmd",$lc); - } - else { - PrintErrorMessage("Did not find expected angle part",$lc); - next LINE; - } - - s/^,\s*// or s/\s*//; #parse optional comma - - my $radius; - if (s/^radius(?=\W)//i) { - chk_lparen("token radius of command $cmd",$lc); - $radius = expr($lc); - chk_rparen("radius part of command $cmd",$lc); - } - else { - PrintErrorMessage("Did not found expected angle part",$lc); - next LINE; - } - - s/^,\s*// or s/\s*//; #parse optional comma - my $inout = ""; - if (s/^(internal(?=\W))//i or s/^(external(?=\W))//i) { - $inout = $1; - } - else { - PrintErrorMessage("Did not find expected 'internal' specifier", $lc); - next LINE; - } - s/^,\s*// or s/\s*//; #parse optional comma - my $direction = ""; - if (s/^(clockwise(?=\W))//i or s/^(anticlockwise(?=\W))//i) { - $direction = $1; - } - else { - PrintErrorMessage("Did not find expected 'direction' specifier", $lc); - next LINE; - } - chk_rcb("arguments of $cmd",$lc); - chk_comment($lc); - my $code; - if (lc($cmd) eq "drawanglearc") { - $code = drawAngleArc($P1, $P2, $P3, $radius, $inout, $direction); - } - else { - $code = drawAngleArrow($P1, $P2, $P3, $radius, $inout, $direction); - } - print OUT $code if $code ne ""; - - } - elsif (s/^\s*(drawArrow(?=\W))//i) - { - my ($cmd) = $1; - print OUT "%% $cmd$_" if $comments_on; - DrawLineOrArrow(0,$lc); - } - elsif (s/^\s*(drawcircle(?=\W))//i) - { - my ($cmd) = $1; - print OUT "%% $cmd$_" if $comments_on; - chk_lparen("drawcircle",$lc); - my $Point = get_point($lc); - next LINE if $Point eq "_undef_"; - chk_comma($lc); - my $R = expr($lc); - if ($R <= 0) { - PrintErrorMessage("Radius must be greater than zero",$lc); - next LINE; - } - my ($x,$y,$pSV,$pS)=unpack("d3A*",$PointTable{lc($Point)}); - printf OUT "\\circulararc 360 degrees from %.5f %.5f center at %.5f %.5f\n", - $x+$R, $y, $x, $y; - chk_rparen("arguments of $cmd",$lc); - chk_comment($lc); - - } - elsif (s/^\s*(drawcurve(?=\W))//i) - { - my ($cmd) = $1; - print OUT "%% $cmd$_" if $comments_on; - DrawLineOrArrow(2,$lc); - } - elsif (s/^\s*(drawcircumcircle(?=\W))//i) - { - my ($cmd) = $1; - print OUT "%% $cmd$_" if $comments_on; - chk_lparen("drawcircumcircle",$lc); - my $point1 = get_point($lc); - next LINE if $point1 eq "_undef_"; - my $point2 = get_point($lc); - next LINE if $point2 eq "_undef_"; - my $point3 = get_point($lc); - next LINE if $point3 eq "_undef_"; - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point1}); - my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point2}); - my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point3}); - my ($xc, $yc,$r) = circumCircleCenter($x1,$y1,$x2,$y2,$x3,$y3,$lc); - next LINE if $xc == 0 and $yc == 0 and $r == 0; - print OUT "%% circumcircle center = ($xc,$yc), radius = $r\n" if $comments_on; - printf OUT "\\circulararc 360 degrees from %.5f %.5f center at %.5f %.5f\n", - $xc+$r, $yc, $xc, $yc; - chk_rparen("arguments of $cmd",$lc); - chk_comment($lc); - - } - elsif (s/^\s*(drawexcircle(?=\W))//i) - { - my ($cmd) = $1; - print OUT "%% $cmd$_" if $comments_on; - chk_lparen("drawexcircle",$lc); - my $point1 = get_point($lc); - next LINE if $point1 eq "_undef_"; - my $point2 = get_point($lc); - next LINE if $point2 eq "_undef_"; - my $point3 = get_point($lc); - next LINE if $point3 eq "_undef_"; - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point1}); - my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point2}); - my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point3}); - if (triangleArea($x1, $y1, $x2, $y2, $x3, $y3) < 0.0001) { - PrintErrorMessage("Area of triangle is zero!",$lc); - next LINE; - } - chk_comma($lc); - my $point4 = get_point($lc); - if (!memberOf($point4, $point1, $point2, $point3)) { - PrintErrorMessage("Current point isn't a side point",$lc); - next LINE; - } - next LINE if $point4 eq "_undef_"; - my $point5 = get_point($lc); - next LINE if $point5 eq "_undef_"; - if (!memberOf($point5, $point1, $point2, $point3)) { - PrintErrorMessage("Current point isn't a side point",$lc); - next LINE; - } - if ($point4 eq $point5) { - PrintErrorMessage("Side points are identical",$lc); - next LINE; - } - chk_rparen("arguments of $cmd",$lc); - my ($xc, $yc, $r) = excircle($point1, $point2, $point3, - $point4, $point5); - my $R=$r; - if (s/^\s*\[\s*//) { - $R += expr($lc); - if ($R < 0.0001) { - PrintErrorMessage("Radius has become equal to zero!",$lc); - next LINE; - } - chk_rsb($lc); - } - if ($R > (500 / 2.845)) { - PrintErrorMessage("Radius is greater than 175mm!",$lc); - next LINE; - } - print OUT "%% excircle center = ($xc,$yc) radius = $R\n" if $comments_on; - printf OUT "\\circulararc 360 degrees from %.5f %.5f center at %.5f %.5f\n", - $xc+$R, $yc, $xc, $yc; - chk_comment($lc); - - } - elsif (s/^\s*(drawincircle(?=\W))//i) - { - my ($cmd) = $1; - print OUT "%% $cmd$_" if $comments_on; - chk_lparen("drawincircle",$lc); - my $point1 = get_point($lc); - next LINE if $point1 eq "_undef_"; - my $point2 = get_point($lc); - next LINE if $point2 eq "_undef_"; - my $point3 = get_point($lc); - next LINE if $point3 eq "_undef_"; - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point1}); - my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point2}); - my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point3}); - if (triangleArea($x1, $y1, $x2, $y2, $x3, $y3) < 0.0001) { - PrintErrorMessage("Area of triangle is zero!",$lc); - next LINE; - } - my ($xc, $yc, $r) = IncircleCenter($x1,$y1,$x2,$y2,$x3,$y3); - my $R=$r; - if (s/^\s*\[\s*//) { - $R += expr($lc); - if ($R < 0.0001) { - PrintErrorMessage("Radius has become equal to zero!",$lc); - next LINE; - } - chk_rsb($lc); - } - if ($R > (500 / 2.845)) { - PrintErrorMessage("Radius is greater than 175mm!",$lc); - next LINE; - } - print OUT "%% incircle center = ($xc,$yc) radius = $R\n" if $comments_on; - printf OUT "\\circulararc 360 degrees from %.5f %.5f center at %.5f %.5f\n", - $xc+$R, $yc, $xc, $yc; - chk_rparen("arguments of $cmd",$lc); - chk_comment($lc); - - } - elsif (s/^\s*(drawline(?=\W))//i) - { - my ($cmd) = $1; - print OUT "%% $cmd$_" if $comments_on; - DrawLineOrArrow(1,$lc); - } - elsif (s/^\s*(drawthickarrow(?=\W))//i) - { - my ($cmd) = $1; - print OUT "%% $cmd$_" if $comments_on; - print OUT "\\setplotsymbol ({\\usefont{OT1}{cmr}{m}{n}\\large .})%\n"; - print OUT "{\\setbox1=\\hbox{\\usefont{OT1}{cmr}{m}{n}\\large .}%\n"; - print OUT " \\global\\linethickness=0.31\\wd1}%\n"; - DrawLineOrArrow(0,$lc); - print OUT "\\setlength{\\linethickness}{0.4pt}%\n"; - print OUT "\\setplotsymbol ({\\usefont{OT1}{cmr}{m}{n}\\tiny .})%\n"; - } - elsif (s/^\s*(drawthickline(?=\W))//i) - { - my ($cmd) = $1; - print OUT "%% $cmd$_" if $comments_on; - print OUT "\\setplotsymbol ({\\usefont{OT1}{cmr}{m}{n}\\large .})%\n"; - print OUT "{\\setbox1=\\hbox{\\usefont{OT1}{cmr}{m}{n}\\large .}%\n"; - print OUT " \\global\\linethickness=0.31\\wd1}%\n"; - DrawLineOrArrow(1,$lc); - print OUT "\\setlength{\\linethickness}{0.4pt}%\n"; - print OUT "\\setplotsymbol ({\\usefont{OT1}{cmr}{m}{n}\\tiny .})%\n"; - } - elsif (s/^\s*(drawperpendicular(?=\W))//i) - { - my ($cmd) = $1; - print OUT "%% $cmd$_" if $comments_on; - - chk_lparen($cmd,$lc); - my $A = get_point($lc); - next LINE if $A eq "_undef_"; - chk_comma($lc); - my $B = get_point($lc); - next LINE if $A eq "_undef_"; - s/\s*//; #ignore white space - my $C = get_point($lc); - next LINE if $A eq "_undef_"; - chk_rparen("arguments of $cmd",$lc); - chk_comment($lc); - # - #start actual computation - # - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$A}); - my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$B}); - my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$C}); - my ($xF, $yF) = perpendicular($x1, $y1, $x2, $y2, $x3, $y3); - printf OUT "\\plot %.5f %.5f %.5f %.5f /\n", - $x1, $y1, $xF, $yF; - - } - elsif (s/^\s*(drawpoint(?=\W))//i) - { - my ($cmd) = $1; - print OUT "%% $cmd$_" if $comments_on; - my ($stacklen); - chk_lparen("$cmd",$lc); - if (/^\)/) { - PrintErrorMessage("There are no point to draw",$lc); - next LINE; - } - my(@PP); - DRAWPOINTS:while(1) { - if (s/^([^\W\d_]\d{0,4})//i) { #point name - $P = $1; - if (!exists($PointTable{lc($P)})) { - PrintErrorMessage("Undefined point $P",$lc); - next DRAWPOINTS; - } - else { - push (@PP,$P); - s/\s*//; - } - } - else { - last DRAWPOINTS; - } - } - drawpoints(@PP); - chk_rparen("arguments of $cmd",$lc); - chk_comment($lc); - - } - elsif (s/^\s*(drawRightAngle(?=\W))//i) - { - my ($cmd) = $1; - print OUT "%% $cmd$_" if $comments_on; - - chk_lparen("drawRightAngle",$lc); - my $point1 = get_point($lc); - next LINE if $point1 eq "_undef_"; - my $point2 = get_point($lc); - next LINE if $point2 eq "_undef_"; - my $point3 = get_point($lc); - next LINE if $point3 eq "_undef_"; - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point1}); - my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point2}); - my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point3}); - chk_comma($lc); - my $dist = expr($lc); - chk_rparen("arguments of $cmd",$lc); - chk_comment($lc); - # - #actual computation - # - my ($Px, $Py) = pointOnLine($x2, $y2, $x1, $y1, $dist); - my ($Qx, $Qy) = pointOnLine($x2, $y2, $x3, $y3, $dist); - my ($Tx, $Ty) = midpoint($Px, $Py, $Qx, $Qy); - my ($Ux, $Uy) = pointOnLine($x2, $y2, $Tx, $Ty, 2*Length($x2, $y2, $Tx, $Ty)); - if ($Px == $Ux || $Py == $Uy) { - printf OUT "\\putrule from %.5f %.5f to %.5f %.5f \n", $Px,$Py,$Ux,$Uy; - } - else { - printf OUT "\\plot %.5f %.5f\t%.5f %.5f / \n", $Px, $Py,$Ux,$Uy; - } - if ($Ux == $Qx || $Uy == $Qy) { - printf OUT "\\putrule from %.5f %.5f to %.5f %.5f \n", $Ux,$Uy,$Qx,$Qy; - } - else { - printf OUT "\\plot %.5f %.5f\t%.5f %.5f / \n", $Ux, $Uy,$Qx,$Qy; - } - - - } - elsif (s/^\s*(drawsquare(?=\W))//i) - { - my ($cmd) = $1; - print OUT "%% $cmd$_" if $comments_on; - chk_lparen("drawSquare",$lc); - my $p = get_point($lc); - chk_comma($lc); - my $side = expr($lc); - $side = $side - (1.1 * $LineThickness/$xunits); #Suggested by RWDN - my ($x,$y,$pSV,$pS) = unpack("d3A*",$PointTable{$p}); - printf OUT "\\put {%s} at %.5f %.5f %%drawsquare\n", drawsquare($side), $x, $y; - chk_rparen("arguments of $cmd",$lc); - chk_comment($lc); - - } - elsif (s/^\s*inputfile\*//i) - { - chk_lparen("inputfile*",$lc); - my $row_in = ""; - if (s/^((\w|-|\.)+)//) { - $row_in = $1; - } - else { - PrintErrorMessage("No input file name found",$lc); - next LINE; - } - if (!(-e $row_in)) { - PrintErrorMessage("File $row_in does not exist",$lc); - next LINE; - } - open(ROW, "$row_in")|| die "Can't open file $row_in\n"; - while (defined($in_line=)) { print OUT $in_line; } - print OUT "%% ... end of input file <$row_in>\n"; - close ROW; - chk_rparen("input file name",$lc); - chk_comment($lc); - - - } - elsif (s/^\s*(inputfile(?=\W))//i) - { - my ($cmd) = $1; - print OUT "%% $cmd$_" if $comments_on; - - chk_lparen("inputfile",$lc); - my $comm_in = ""; - if (s/^((\w|-|\.)+)//) { - $comm_in = $1; - } - else { - PrintErrorMessage("No input file name found",$lc); - next LINE; - } - if (!(-e $comm_in)) { - PrintErrorMessage("File $comm_in does not exist",$lc); - next LINE; - } - chk_rparen("input file name",$lc); - my $input_times = 1; #default value - if (s/^\[//) { - $input_times = expr($lc); - chk_rsb("optional argument",$lc); - } - print OUT "%% ... start of file <$comm_in> loop [$input_times]\n"; - for (my $i=0; $i loop [$input_times]\n"; - chk_comment($lc); - - } - elsif (s/^\s*(linethickness(?=\W))//i) - { - my $cmd = $1; - print OUT "%% $cmd$_" if $comments_on; - chk_lparen("linethickness", $lc); - if (s/^default//i) { - print OUT "\\linethickness=0.4pt\\Linethickness{0.4pt}%%\n"; - print OUT "\\setplotsymbol ({\\usefont{OT1}{cmr}{m}{n}\\tiny .})%\n"; - $LineThickness = setLineThickness($xunits,"0.4pt"); - } - else { - my $length = expr($lc); - if (s/^\s*($units)//i) { - my $units = $1; - printf OUT "\\linethickness=%.5f%s\\Linethickness{%.5f%s}%%\n", - $length, $units, $length, $units; - $LineThickness = setLineThickness($xunits,"$length$units"); - my $mag; - if ($units eq "pc") { - $mag = $length * 12; - } - elsif ($units eq "in") { - $mag = $length * 72.27; - } - elsif ($units eq "bp") { - $mag = $length * 1.00375; - } - elsif ($units eq "cm") { - $mag = $length * 28.45275; - } - elsif ($units eq "mm") { - $mag = $length * 2.845275; - } - elsif ($units eq "dd") { - $mag = $length * 1.07001; - } - elsif ($units eq "cc") { - $mag = $length * 0.08917; - } - elsif ($units eq "sp") { - $mag = $length * 0.000015259; - } - elsif ($units eq "pt") { - $mag = $length; - } - $mag = 10 * $mag / 1.00278219; - printf OUT "\\font\\CM=cmr10 at %.5fpt%%\n", $mag; - print OUT "\\setplotsymbol ({\\CM .})%\n"; - } - else { - PrintErrorMessage("Did not found expect units part",$lc); - } - } - chk_rparen("linethickness", $lc); - chk_comment($lc); - - - } - elsif (s/^\s*(paper(?=\W))//i) - { - my ($cmd) = $1; - print OUT "%% $cmd$_" if $comments_on; - chk_lcb("paper", $lc); - if (s/^units(?=\W)//i) - { - - chk_lparen("units",$lc); - if(s/^\)//) - { - PrintWarningMessage("Missing value in \"units\"--default is 1pt", - $lc); - $xunits = "1pt"; - } - else { - $xunits = expr($lc); - s/\s*//; - if (s/^($units)//i) { - $xunits .= "$1"; - $LineThickness = setLineThickness($xunits,"0.4pt"); - } - elsif(s/^(\w)+//i) { - PrintErrorMessage("$1 is not a valid mathspic unit",$lc); - $xunits = "1pt"; - } - else { - PrintErrorMessage("No x-units found",$lc); - $xunits = "1pt"; - } - s/\s*//; #ignore white space - if (s/^,//) { # there is a comma so expect an y-units - s/\s*//; #ignore white space - $yunits = expr($lc); - s/\s*//; #ignore white space - if (s/^($units)//i) { - $yunits .= "$1"; - } - elsif(s/^(\w)+//i) { - PrintErrorMessage("$1 is not a valid mathspic unit",$lc); - $yunits = "1pt"; - } - else { - PrintErrorMessage("No y-units found",$lc); - $yunits = $xunits; - } - } - else { - $yunits = $xunits; - } - chk_rparen("units",$lc); - } - - $nounits = 0; - } - else - { - $nounits = 1; - } - s/^,\s*// or s/\s*//; - if (s/^xrange//i) - { - - chk_lparen("xrange",$lc); - my $ec; - ($xlow,$ec) = ComputeDist($lc); - next LINE if $ec == 0; - chk_comma($lc); - ($xhigh,$ec) = ComputeDist($lc); - next LINE if $ec == 0; - if ($xlow >= $xhigh) - { - PrintErrorMessage("xlow >= xhigh in xrange",$lc); - next LINE; - } - chk_rparen("$xhigh",$lc); - - $noxrange = 0; - } - else - { - $noxrange = 1; - } - s/^,\s*// or s/\s*//; - if (s/^yrange//i) - { - - chk_lparen("yrange",$lc); - my $ec; - ($ylow,$ec) = ComputeDist($lc); - next LINE if $ec == 0; - chk_comma($lc); - ($yhigh,$ec) = ComputeDist($lc); - next LINE if $ec == 0; - if ($ylow >= $yhigh) - { - PrintErrorMessage("ylow >= yhigh in yrange",$lc); - next LINE; - } - chk_rparen("$yhigh",$lc); - - $noyrange = 0; - } - else - { - $noyrange = 1; - } - - if (!$nounits) - { - printf OUT "\\setcoordinatesystem units <%s,%s>\n", - $xunits,$yunits; - } - if(!$noxrange && !$noyrange) - { - printf OUT "\\setplotarea x from %.5f to %.5f, y from %.5f to %.5f\n", - $xlow, $xhigh, $ylow, $yhigh; - - } - - s/^,\s*// or s/\s*//; - $axis = ""; - if (s/^ax[ei]s(?=\W)//i) - { - - chk_lparen("axis",$lc); - while(/^[^\)]/) - { - if (s/^([lrtbxy]{1}\*?)//i) - { - $axis .= $1; - } - elsif (s/^([^lrtbxy])//i) - { - PrintErrorMessage("Non-valid character \"$1\" in axis()",$lc); - } - s/\s*//; - } - chk_rparen("axis(arguments",$lc); - - } - $axis = uc($axis); - s/^,\s*// or s/\s*//; - if (s/^ticks(?=\W)//i) - { - chk_lparen("ticks",$lc); - my $ec; - ($xticks,$ec) = ComputeDist($lc); - next LINE if $ec == 0; - chk_comma($lc); - ($yticks,$ec) = ComputeDist($lc); - next LINE if $ec == 0; - chk_rparen("ticks(arguments",$lc); - - } - else - { - $xticks = $yticks = 0; - } - chk_rcb("paper", $lc); - YBRANCH: { - if (index($axis, "Y")>-1) - { - if (index($axis, "Y*")>-1) - { - print OUT "\\axis left shiftedto x=0 / \n"; - last YBRANCH; - } - if ($yticks > 0) - { - if (index($axis, "T")>-1 && index($axis, "B")==-1) - { - print OUT "\\axis left shiftedto x=0 ticks numbered from "; - print OUT "$ylow to -$yticks by $yticks\n from $yticks to "; - print OUT $yhigh-$yticks," by $yticks /\n"; - } - elsif (index($axis, "T")==-1 && index($axis, "B")>-1) - { - print OUT "\\axis left shiftedto x=0 ticks numbered from "; - print OUT $ylow+$yticks," to -$yticks by $yticks\n from "; - print OUT "$yticks to $yhigh by $yticks /\n"; - } - elsif (index($axis, "T")>-1 && index($axis, "B")>-1) - { - print OUT "\\axis left shiftedto x=0 ticks numbered from "; - print OUT $ylow+$yticks," to -$yticks by $yticks\n from "; - print OUT "$yticks to ",$yhigh-$yticks," by $yticks /\n"; - } - else - { - print OUT "\\axis left shiftedto x=0 ticks numbered from "; - print OUT "$ylow to -$yticks by $yticks\n from "; - print OUT "$yticks to $yhigh by $yticks /\n"; - } - } - else - { - print OUT "\\axis left shiftedto x=0 /\n"; - } - } - } - XBRANCH: { if (index($axis, "X")>-1) - { - if (index($axis, "X*")>-1) - { - print OUT "\\axis bottom shiftedto y=0 /\n"; - last XBRANCH; - } - if ($xticks > 0) - { - if (index($axis, "L")>-1 && index($axis, "R")==1) - { - print OUT "\\axis bottom shiftedto y=0 ticks numbered from "; - print OUT $xlow + $xticks," to -$xticks by $xticks\n from"; - print OUT " $xticks to $xhigh by $xticks /\n"; - } - elsif (index($axis, "L")==-1 && index($axis, "R")>-1) - { - print OUT "\\axis bottom shiftedto y=0 ticks numbered from "; - print OUT "$xlow to -$xticks by $xticks\n from "; - print OUT "$xticks to ",$xhigh-$xticks," by $xticks /\n"; - } - elsif (index($axis, "L")>-1 && index($axis, "R")>-1) - { - print OUT "\\axis bottom shiftedto y=0 ticks numbered from "; - print OUT $xlow + $xticks," to -$xticks by $xticks\n from "; - print OUT "$xticks to ",$xhigh - $xticks," by $xticks /\n"; - } - else - { - print OUT "\\axis bottom shiftedto y=0 ticks numbered from "; - print OUT "$xlow to -$xticks by $xticks\n from "; - print OUT "$xticks to $xhigh by $xticks /\n"; - } - } - else - { - print OUT "\\axis bottom shiftedto y=0 /\n"; - } - } } - LBRANCH: {if (index($axis, "L")>-1) - { - if (index($axis, "L")>-1) - { - if (index($axis, "L*")>-1) - { - print OUT "\\axis left /\n"; - last LBRANCH; - } - if ($yticks > 0) - { - print OUT "\\axis left ticks numbered from "; - print OUT "$ylow to $yhigh by $yticks /\n"; - } - else - { - print OUT "\\axis left /\n"; - } - } - } } - RBRANCH: { if (index($axis, "R")>-1) - { - if (index($axis, "R*")>-1) - { - print OUT "\\axis right /\n"; - last RBRANCH; - } - if ($yticks > 0) - { - print OUT "\\axis right ticks numbered from $ylow to $yhigh by "; - print OUT "$yticks /\n"; - } - else - { - print OUT "\\axis right /\n"; - } - } } - TBRANCH: { if (index($axis, "T")>-1) - { - if (index($axis, "T*")>-1) - { - print OUT "\\axis top /\n"; - last TBRANCH; - } - if ($xticks > 0) - { - print OUT "\\axis top ticks numbered from $xlow to $xhigh by "; - print OUT "$xticks /\n"; - } - else - { - print OUT "\\axis top /\n"; - } - } } - BBRANCH: { if (index($axis, "B")>-1) - { - if (index($axis, "B*")>-1) - { - print OUT "\\axis bottom /\n"; - last BBRANCH; - } - if ($xticks > 0) - { - print OUT "\\axis bottom ticks numbered from $xlow to $xhigh by "; - print OUT "$xticks /\n"; - } - else - { - print OUT "\\axis bottom /\n"; - } - } } - - - chk_comment($lc); - - } - elsif (s/^\s*(PointSymbol(?=\W))//i) - { - my $cmd = $1; - print OUT "%% $cmd$_" if $comments_on; - - chk_lparen("$cmd",$lc); - if (s/^default//i) #default point symbol - { - $defaultsymbol = "\$\\bullet\$"; - } - elsif (s/^(circle|square)//i) { - $defaultsymbol = $1; - chk_lparen($defaultsymbol, $lc); - $GlobalDimOfPoints = expr($lc); - chk_rparen("expression", $lc); - } - elsif (s/^(((\\,){1}|(\\\)){1}|(\\\s){1}|[^\),\s])+)//) #arbitrary LaTeX point - { - $defaultsymbol = $1; - $defaultsymbol=~ s/\\\)/\)/g; - $defaultsymbol=~ s/\\,/,/g; - $defaultsymbol=~ s/\\ / /g; - } - else - { - PrintErrorMessage("unrecognized point symbol",$lc); - } - if (s/\s*,\s*//) { - $defaultLFradius = expr($lc); - } - chk_rparen("after $cmd arguments",$lc); - chk_comment("after $cmd command",$lc); - - } - elsif (s/^\s*point(?=\W)//i) - { - my ($Point_Line); - chomp($Point_Line=$_); - my ($pointStar, $PointName, $origPN); - $pointStar = 0; # default value: he have a point command - $pointStar = 1 if s/^\*//; - chk_lparen("point" . (($pointStar)?"*":""),$lc); - if (s/^([^\W\d_](?![^\W\d_])\d{0,4})//i) { - # - # Note: the regular expression (foo)(?!bar) means that we are - # looking a foo not followed by a bar. Moreover, the regular - # expression [^\W\d_] means that we are looking for letter. - # - $origPN = $1; - $PointName = lc($1); - } - else { - PrintErrorMessage("Invalid point name",$lc); - next LINE; - } - #if ($pointStar and !exists($PointTable{$PointName})) { - # PrintWarningMessage("Point $origPN has not been defined",$lc); - #} - if (!$pointStar and exists($PointTable{$PointName})) { - PrintWarningMessage("Point $origPN has been used already",$lc); - } - chk_rparen("point" . (($pointStar)?"*":""). "($origPN",$lc); - chk_lcb("point" . (($pointStar)?"*":""). "($origPN)",$lc); - my ($Px, $Py); - if (s/^perpendicular(?=\W)//i) { - chk_lparen("perpendicular",$lc); - my $FirstPoint = &get_point($lc); - next LINE if $FirstPoint eq "_undef_"; - chk_comma($lc); - my $SecondPoint = &get_point($lc); - next LINE if $SecondPoint eq "_undef_"; - my $ThirdPoint = &get_point($lc); - next LINE if $ThirdPoint eq "_undef_"; - chk_rparen("No closing parenthesis found",$lc); - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$FirstPoint}); - my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$SecondPoint}); - my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$ThirdPoint}); - ($Px, $Py) = perpendicular($x1,$y1,$x2,$y2,$x3,$y3); - - } - elsif (s/^intersection(?=\W)//i) { - chk_lparen("intersection",$lc); - my $FirstPoint = get_point($lc); - next LINE if $FirstPoint eq "_undef_"; - my $SecondPoint = get_point($lc); - next LINE if $SecondPoint eq "_undef_"; - chk_comma($lc); - my $ThirdPoint = get_point($lc); - next LINE if $ThirdPoint eq "_undef_"; - my $ForthPoint = get_point($lc); - next LINE if $ForthPoint eq "_undef_"; - chk_rparen("No closing parenthesis found",$lc); - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$FirstPoint}); - my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$SecondPoint}); - my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$ThirdPoint}); - my ($x4,$y4,$pSV4,$pS4)=unpack("d3A*",$PointTable{$ForthPoint}); - ($Px, $Py) = intersection4points($x1,$y1,$x2,$y2,$x3,$y3,$x4,$y4); - - - } - elsif (s/^midpoint(?=\W)//i) { - chk_lparen("midpoint",$lc); - my $FirstPoint = &get_point($lc); - next LINE if $FirstPoint eq "_undef_"; - my $SecondPoint = &get_point($lc); - next LINE if $SecondPoint eq "_undef_"; - chk_rparen("No closing parenthesis found",$lc); - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$FirstPoint}); - my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$SecondPoint}); - ($Px, $Py) = midpoint($x1, $y1, $x2, $y2); - - } - elsif (s/^pointonline(?=\W)//i) { - chk_lparen("pointonline",$lc); - my $FirstPoint = &get_point($lc); - next LINE if $FirstPoint eq "_undef_"; - my $SecondPoint = &get_point($lc); - next LINE if $SecondPoint eq "_undef_"; - chk_comma($lc); - # now get the distance - my $distance = expr($lc); - chk_rparen("No closing parenthesis found",$lc); - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$FirstPoint}); - my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$SecondPoint}); - ($Px, $Py) = pointOnLine($x1,$y1,$x2,$y2,$distance); - - } - elsif (s/^circumcircleCenter(?=\W)//i) { - chk_lparen("circumCircleCenter",$lc); - my $FirstPoint = &get_point($lc); - next LINE if $FirstPoint eq "_undef_"; - my $SecondPoint = &get_point($lc); - next LINE if $SecondPoint eq "_undef_"; - my $ThirdPoint = &get_point($lc); - next LINE if $ThirdPoint eq "_undef_"; - chk_rparen("No closing parenthesis found",$lc); - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$FirstPoint}); - my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$SecondPoint}); - my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$ThirdPoint}); - ($Px, $Py,$r) = &circumCircleCenter($x1,$y1,$x2,$y2,$x3,$y3,$lc); - next LINE if $Px == 0 and $Py == 0 and $r == 0; - - } - elsif (s/^IncircleCenter(?=\W)//i) { - chk_lparen("IncircleCenter",$lc); - my $FirstPoint = &get_point($lc); - next LINE if $FirstPoint eq "_undef_"; - my $SecondPoint = &get_point($lc); - next LINE if $SecondPoint eq "_undef_"; - my $ThirdPoint = &get_point($lc); - next LINE if $ThirdPoint eq "_undef_"; - chk_rparen("No closing parenthesis found",$lc); - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$FirstPoint}); - my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$SecondPoint}); - my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$ThirdPoint}); - ($Px, $Py, $r) = IncircleCenter($x1,$y1,$x2,$y2,$x3,$y3); - - } - elsif (s/^ExcircleCenter(?=\W)//i) { - chk_lparen("ExcircleCenter",$lc); - my $PointA = get_point($lc); - next LINE if $PointA eq "_undef_"; - my $PointB = get_point($lc); - next LINE if $PointB eq "_undef_"; - my $PointC = get_point($lc); - next LINE if $PointC eq "_undef_"; - chk_comma($lc); - my $PointD = &get_point($lc); - next LINE if $PointD eq "_undef_"; - if (!memberOf($PointD, $PointA, $PointB, $PointC)) { - PrintErrorMessage("Current point isn't a side point",$lc); - next LINE; - } - my $PointE = get_point($lc); - next LINE if $PointE eq "_undef_"; - if (!memberOf($PointE, $PointA, $PointB, $PointC)) { - PrintErrorMessage("Current point isn't a side point",$lc); - next LINE; - } - if ($PointD eq $PointE) { - PrintErrorMessage("Side points are identical",$lc); - next LINE; - } - ($Px, $Py, $r) = excircle($PointA, $PointB, $PointC, - $PointD, $PointE); - chk_rparen("after coordinates part",$lc); - - } - elsif (/^[^\W\d_]\d{0,4}\s*[^,\w]/) { - m/^([^\W\d_]\d{0,4})\s*/i; - if (exists($PointTable{lc($1)})) { - my $Tcoord = get_point($lc); - my ($x,$y,$pSV,$pS)=unpack("d3A*",$PointTable{$Tcoord}); - $Px = $x; - $Py = $y; - } - else { - $Px = expr(); - chk_comma($lc); - $Py = expr(); - } - } - elsif (/[^\W\d_]\d{0,4}\s*,\s*shift|polar|rotate|vector/i) { #a point? - s/^([^\W\d_]\d{0,4})//i; - my $PointA = $1; - if (exists($PointTable{lc($PointA)})) { - s/\s*//; - if (s/^,//) { - s/\s*//; - if (s/^shift(?=\W)//i) { - - chk_lparen("shift",$lc); - my $dist1 = expr($lc); - chk_comma($lc); - my $dist2 = expr($lc); - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{lc($PointA)}); - $Px = $x1 + $dist1; - $Py = $y1 + $dist2; - chk_rparen("shift part",$lc); - - } - elsif (s/^polar(?=\W)//i) { - chk_lparen("polar",$lc); - my ($R1, $Theta1); - $R1 = expr($lc); - chk_comma($lc); - $Theta1 = expr($lc); - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{lc($PointA)}); - s/\s*//; - if (s/^rad(?=\W)//i) { - # do nothing! - } - elsif (s/^deg(?=\W)//i) { - $Theta1 = $Theta1 * PI / 180; - } - else { - #$Theta1 = $Theta1 * PI / 180; - } - $Px = $x1 + $R1 * cos($Theta1); - $Py = $y1 + $R1 * sin($Theta1); - chk_rparen("after polar part",$lc); - - } - elsif (s/^rotate(?=\W)//i) { - chk_lparen("rotate",$lc); - my $Q = lc($PointA); - my $P = get_point($lc); - next LINE if $P eq "_undef_"; - chk_comma($lc); - my $Theta1 = expr($lc); - my ($xP,$yP,$pSV1,$pS1)=unpack("d3A*",$PointTable{$P}); - my ($xQ,$yQ,$pSV2,$pS2)=unpack("d3A*",$PointTable{$Q}); - s/\s*//; - if (s/^rad(?=\W)//i) - { - # do nothing! - } - elsif (s/^deg(?=\W)//i) - { - $Theta1 = $Theta1 * PI / 180; - } - else - { - $Theta1 = $Theta1 * PI / 180; - } - # shift origin to P - $xQ -= $xP; - $yQ -= $yP; - # do the rotation - $Px = $xQ * cos($Theta1) - $yQ * sin($Theta1); - $Py = $xQ * sin($Theta1) + $yQ * cos($Theta1); - # return origin back to original origin - $Px += $xP; - $Py += $yP; - chk_rparen("after rotate part",$lc); - - } - elsif (s/^vector(?=\W)//i) { - chk_lparen("vector",$lc); - my ($x0,$y0,$pSV0,$pS0) = unpack("d3A*",$PointTable{lc($PointA)}); - my $P = get_point($lc); - my $Q = get_point($lc); - my ($x1,$y1,$pSV1,$pS1) = unpack("d3A*",$PointTable{$P}); - my ($x2,$y2,$pSV2,$pS2) = unpack("d3A*",$PointTable{$Q}); - $Px = $x0 + $x2 - $x1; - $Py = $y0 + $y2 - $y1; - chk_rparen("vector part",$lc); - - - } - else { - PrintErrorMessage("unexpected token",$lc); - next LINE; - } - } - else { - my ($xA,$yA,$pSVA,$pSA)=unpack("d3A*",$PointTable{lc($PointA)}); - $Px = $xA; - $Py = $yA; - } - } - else { - PrintErrorMessage("Undefined point $PointA",$lc); - next LINE; - } - } - else { - $Px = expr(); - chk_comma($lc); - $Py = expr(); - } - - chk_rcb("coordinates part",$lc); - my $sv = $defaultsymbol; - my $sh = $defaultLFradius; - my $side_or_radius = undef; - if (s/^\[\s*//) { # the user has opted to specify the optional part - if (/^(symbol|radius|side)\s*/i) { - my @previous_options = (); - my $number_of_options = 1; - my $symbol_set = 0; - while (s/^(symbol|radius)\s*//i and $number_of_options <= 2) { - my $option = lc($1); - if (s/^=\s*//) { - if (memberOf($option,@previous_options)) { - PrintErrorMessage("Option \"$option\" has been already defined", $lc); - my $dummy = expr($lc); - } - elsif ($option eq "radius") { - $sh = expr($lc); - $sv = $defaultsymbol if ! $symbol_set; - } - elsif ($option eq "symbol") { - if (s/^circle\s*//i) { - $sv = "circle"; - chk_lparen("after token circle",$lc); - $side_or_radius = expr($lc); - chk_rparen("expression",$lc); - } - elsif (s/^square\s*//i) { - $sv = "square"; - chk_lparen("after token square",$lc); - $side_or_radius = expr($lc); - chk_rparen("expression",$lc); - } - elsif (s/^(((\\\]){1}|(\\,){1}|(\\\s){1}|[^\],\s])+)//) { - $sv = $1; - $sv =~ s/\\\]/\]/g; - $sv =~ s/\\,/,/g; - $sv =~ s/\\ / /g; - s/\s*//; - } - $symbol_set = 1; - } - } - else { - PrintErrorMessage("unexpected token", $lc); - next LINE; - } - $number_of_options++; - push (@previous_options, $option); - s/^,\s*//; - } - } - else { - PrintErrorMessage("unexpected token", $lc); - next LINE; - } - - chk_rsb("optional part",$lc); - } - # to avoid truncation problems introduced by the pack function, we - # round each number up to five decimal digits - $Px = sprintf("%.5f", $Px); - $Py = sprintf("%.5f", $Py); - print OUT "%% point$Point_Line \t$origPN = ($Px, $Py)\n" if $comments_on; - chk_comment($lc); - $PointTable{$PointName} = pack("d3A*",$Px,$Py,$sh,$sv); - if (defined($side_or_radius)) { - $DimOfPoint{$PointName} = $side_or_radius; - } - - } - elsif (/^\s*setPointNumber(?=\W)/i) - { - PrintWarningMessage("Command setPointNumber is ignored",$lc); - next LINE; - } - elsif (s/^\s*(showAngle(?=\W))//i) - { - chk_lparen("showangle",$lc); - my $point_1 = get_point($lc); - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1}); - my $point_2 = get_point($lc); - my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2}); - my $point_3 = get_point($lc); - my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point_3}); - my $angle = Angle($x1, $y1, $x2, $y2, $x3, $y3); - $angle = 0 if $angle == -500; - printf OUT "%%%% angle(%s%s%s) = %.5f deg ( %.5f rad)\n", $point_1, - $point_2, $point_3, $angle, $angle*D2R; - chk_rparen("Missing right parenthesis", $lc); - - } - elsif (s/^\s*(showArea(?=\W))//i) - { - chk_lparen("showarea",$lc); - my $point_1 = get_point($lc); - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1}); - my $point_2 = get_point($lc); - my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2}); - my $point_3 = get_point($lc); - my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point_3}); - print OUT "%% area($point_1$point_2$point_3) = ", - triangleArea($x1, $y1, $x2, $y2, $x3, $y3), "\n"; - chk_rparen("Missing right parenthesis", $lc); - - } - elsif (s/^\s*(showLength(?=\W))//i) - { - chk_lparen("showlength",$lc); - my $point_1 = get_point($lc); - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1}); - my $point_2 = get_point($lc); - my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2}); - print OUT "%% length($point_1$point_2) = ", - Length($x1, $y1, $x2, $y2), "\n"; - chk_rparen("Missing right parenthesis", $lc); - - - } - elsif (/^\s*showPoints(?=\W)/i) - { - print OUT "%%-------------------------------------------------\n"; - print OUT "%% L I S T O F P O I N T S \n"; - print OUT "%%-------------------------------------------------\n"; - foreach my $p (keys(%PointTable)) { - my ($x, $y, $pSV, $pS) = unpack("d3A*",$PointTable{$p}); - printf OUT "%%%%\t%s\t= ( %.5f, %.5f ), LF-radius = %.5f, symbol = %s\n", - $p, $x, $y, $pSV, $pS; - } - print OUT "%%-------------------------------------------------\n"; - print OUT "%% E N D O F L I S T O F P O I N T S \n"; - print OUT "%%-------------------------------------------------\n"; - next LINE; - } - elsif (/^\s*showVariables(?=\W)/i) - { - print OUT "%%-------------------------------------------------\n"; - print OUT "%% L I S T O F V A R I A B L E S \n"; - print OUT "%%-------------------------------------------------\n"; - foreach my $var (keys(%VarTable)) { - print OUT "%%\t", $var, "\t=\t", $VarTable{$var}, "\n"; - } - print OUT "%%-------------------------------------------------\n"; - print OUT "%% E N D O F L I S T O F V A R I A B L E S \n"; - print OUT "%%-------------------------------------------------\n"; - next LINE; - } - elsif (s/^\s*(system(?=\W))//i) - { - print OUT "%% $1$_" if $comments_on; - - chk_lparen("$cmd",$lc); - my ($error, $command, $rest) = get_string($_); - next LINE if $error == 1; - $_ = $rest; - if (! is_tainted($command)) { - system($command); - } - else { - PrintErrorMessage("String \"$command\" has tainted data", $lc); - next LINE; - } - chk_rparen("after $cmd arguments",$lc); - chk_comment("after $cmd command",$lc); - - } - elsif (s/^\s*(text(?=\W))//i) - { - print OUT "%% $1$_" if $comments_on; - - chk_lparen("text",$lc); - my ($level,$text)=(1,""); - TEXTLOOP: while (1) - { - $level++ if /^\(/; - $level-- if /^\)/; - s/^(.)//; - last TEXTLOOP if $level==0; - $text .= $1; - } - chk_lcb("text part",$lc); - my ($Px, $Py,$dummy,$pos); - $pos=""; - s/\s*//; - - if (/^[^\W\d_]\d{0,4}\s*[^,\w]/) { - my $Tcoord = get_point($lc); - my ($x,$y,$pSV,$pS)=unpack("d3A*",$PointTable{$Tcoord}); - $Px = $x; - $Py = $y; - } - elsif (/[^\W\d_]\d{0,4}\s*,\s*shift|polar/i) { - s/^([^\W\d_]\d{0,4})//i; - my $PointA = $1; - if (exists($PointTable{lc($PointA)})) { - s/\s*//; - if (s/^,//) { - s/\s*//; - if (s/^shift(?=\W)//i) { - - chk_lparen("shift",$lc); - my $dist1 = expr($lc); - chk_comma($lc); - my $dist2 = expr($lc); - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{lc($PointA)}); - $Px = $x1 + $dist1; - $Py = $y1 + $dist2; - chk_rparen("shift part",$lc); - - } - elsif (s/^polar(?=\W)//i) { - chk_lparen("polar",$lc); - my ($R1, $Theta1); - $R1 = expr($lc); - chk_comma($lc); - $Theta1 = expr($lc); - my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{lc($PointA)}); - s/\s*//; - if (s/^rad(?=\W)//i) { - # do nothing! - } - elsif (s/^deg(?=\W)//i) { - $Theta1 = $Theta1 * PI / 180; - } - else { - #$Theta1 = $Theta1 * PI / 180; - } - $Px = $x1 + $R1 * cos($Theta1); - $Py = $y1 + $R1 * sin($Theta1); - chk_rparen("after polar part",$lc); - - } - } - } - else { - PrintErrorMessage("undefined point/var",$lc); - next LINE; - } - } - else { - $Px = expr(); - chk_comma($lc); - $Py = expr(); - } - - chk_rcb("coordinates part of text command",$lc); - if (s/^\[//) - { - s/\s*//; - - if (s/^(\w{1})\s*//) { - $pos .= $1; - if (memberOf($pos, "l", "r")) { - if (s/^(\w{1})\s*//) { - my $np = $1; - if (memberOf($np, "t", "b", "B")) { - $pos .= $np; - } - else { - if (memberOf($np, "l", "r")) { - PrintErrorMessage("$np can't follow 'l' or 'r'", $lc); - } - else { - PrintErrorMessage("$np is not a valid positioning option", $lc); - } - next LINE; - } - } - } - elsif (memberOf($pos, "t", "b", "B")) { - if (s/^(\w{1})\s*//) { - my $np = $1; - if (memberOf($np, "l", "r")) { - $pos .= $np; - } - else { - if (memberOf($np, "t", "b", "B")) { - PrintErrorMessage("$np can't follow 't', 'b', or 'B'", $lc); - } - else { - PrintErrorMessage("$np is not a valid positioning option", $lc); - } - next LINE; - } - } - } - else { - PrintErrorMessage("$pos is not a valid positioning option", $lc); - next LINE; - } - } - else { - PrintErrorMessage("illegal token in optional part of text command",$lc); - next LINE; - } - - s/\s*//; - chk_rsb("optional part of text command",$lc); - } - chk_comment($lc); - if ($pos eq "") - { - printf OUT "\\put {%s} at %f %f\n", $text, $Px, $Py; - } - else - { - printf OUT "\\put {%s} [%s] at %f %f\n", $text, $pos, $Px, $Py; - } - - } - elsif (s/^\s*(var(?=\W))//i) - { - print OUT "%% $1$_" if $comments_on; - do{ - s/\s*//; - PrintErrorMessage("no identifier found after token var",$lc) - if $_ !~ s/^([^\W\d_]\d{0,4})//i; - my $Varname = $1; - my $varname = lc($Varname); - if (exists $ConstTable{$varname}) { - PrintErrorMessage("Redefinition of constant $varname",$lc); - } - s/\s*//; #remove leading white space - PrintErrorMessage("did not find expected = sign",$lc) - if $_ !~ s/^[=]//i; - my $val = expr($lc); - $VarTable{$varname} = $val; - print OUT "%% $Varname = $val\n" if $comments_on; - }while (s/^,//); - chk_comment($lc); - s/\s*//; - if (/^[^%]/) { - PrintWarningMessage("Trailing text is ignored",$lc); - } - } - elsif (/^\s*\\(.+)/) - { - my $line = $1; - if ($line =~ /^\s+(.+)/) - { - print OUT " $line\n"; - } - else - { - print OUT "\\$line\n"; - } - next LINE; - } - elsif (0==length) #empty line - { - next LINE; - } - else { - PrintErrorMessage("command not recognized",$lc); - next LINE; - } - - } - } - } - - -our $alarm=""; -our $comments_on=1; -our $out_file="default"; -our $argc=@ARGV; -if ($argc == 0 || $argc > 5 ){ # no command line arguments or more than 4 - # arguments - die "\nmathspic version $version_number\n" . - "Usage: mathspic [-h] [-b] [-c] [-o ] \n\n"; -} -else { - our $file = ""; - SWITCHES: - while($_ = $ARGV[0]) { - shift; - if (/^-h$/) { - die "\nThis is mathspic version $version_number\n" . - "Type \"man mathspic\" for detailed help\n". - "Usage:\tmathspic [-h] [-b] [-c] [-o ] \n" . - "\twhere,\n" . - "\t[-b]\tenables bell sound if error exists\n" . - "\t[-c]\tdisables comments in output file\n" . - "\t[-h]\tgives this help listing\n" . - "\t[-o]\tcreates specified output file\n\n"; - } - elsif (/^-b$/) { - $alarm = chr(7); - } - elsif (/^-c$/) { - $comments_on = 0; - } - elsif (/^-o$/) { - die "No output file specified!\n" if !@ARGV; - $out_file = $ARGV[0]; - shift; - } - elsif (/^-\w+/) { - die "$_: Illegal command line switch!\n"; - } - else { - $file = $_; - } - }my ($xA, $yA, $xB, $yB, $dist)=@_; - die "No input file specified!\n" if $file eq ""; - - print "This is mathspic version $version_number\n"; -} - our ($source_file, $log_file); - if (! -e $file) { - die "$file: no such file!\n" if (! (-e "$file.m")); - $source_file = "$file.m"; - } - else { - $source_file = $file; - $file = $1 if $file =~ /(\w[\w-\.]+)\.\w+/; - } - $out_file= "$file.mt" if $out_file eq "default"; - $log_file= "$file.mlg"; - - - open(IN,"$source_file")||die "Can't open source file: $source_file\n"; - open(OUT,">$out_file")||die "Can't open output file: $out_file\n"; - open(LOG,">$log_file")||die "Can't open log file: $log_file\n"; - print_headers; - process_input(IN,""); - -print $alarm if $no_errors > 0; -__END__ - -- cgit v1.2.3