summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/doc/latex/mathspic/sourcecode.html
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2011-08-21 23:57:09 +0000
committerKarl Berry <karl@freefriends.org>2011-08-21 23:57:09 +0000
commit9ee7cfba1625748e157c7cda3091549eb0701cbf (patch)
tree54d32aa0aa0b6b3b21ae16cbbd63f38242590549 /Master/texmf-dist/doc/latex/mathspic/sourcecode.html
parentcc6dec43bed861394613828f8ed1351b0952d702 (diff)
mathspic (7jun11 and earlier)
git-svn-id: svn://tug.org/texlive/trunk@23640 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/doc/latex/mathspic/sourcecode.html')
-rw-r--r--Master/texmf-dist/doc/latex/mathspic/sourcecode.html5124
1 files changed, 0 insertions, 5124 deletions
diff --git a/Master/texmf-dist/doc/latex/mathspic/sourcecode.html b/Master/texmf-dist/doc/latex/mathspic/sourcecode.html
deleted file mode 100644
index 5d963ef76dd..00000000000
--- a/Master/texmf-dist/doc/latex/mathspic/sourcecode.html
+++ /dev/null
@@ -1,5124 +0,0 @@
-<!-- this file was generated automatically by noweave; better not edit it-->
-<html><head><title>sourcecode.nw</title></head><body><center><h1> <tt>mathspic</tt> in Perl </h1></center>
-<center><h2>
-<table>
-<tr><td><address>
-<b>Apostolos Syropoulos</b><br>
-366, 28th October Str.<br>
-GR-671 00 Xanthi<br>
-Greece<br>
-email: <tt>asyropoulos@yahoo.com</tt>
-</address></td>
-<td><address>
-<b>R.W.D. Nickalls</b><br>
- Department of Anaesthesia<br>
-Nottingham City Hospital NHS Trust<br>
-<a name="NWD21HcNW-1">Hucknall Road</a><br>
-Nottingham, NG5-1PB<br>
-United Kingdom<br>
-email: <tt>dicknickalls@compuserve.com</tt>
-</address></td>
-</table></h2>
-version 1.10 Feb 18, 2007
-</center>
-
-<h3><b>Introduction</b></h3><p>
-<tt>mathspic</tt> is a graphics program which implements a simple
-programming notation, <i>mathspic</i>, suitable for the
-creation of diagrams or mathematical figures.
-<tt>mathspic</tt>'s input is a LaTeX file containing
-<tt>mathspic</tt> plotting commands.
-<tt>mathspic</tt>'s output is the equivalent LaTeX file
-containing PiCTeX plotting commands.
-Technically, therefore, <tt>mathspic</tt>
-is a preprocessor or `filter' for use with the PiCTeX drawing engine.
-<tt>mathspic</tt> was originally written in PowerBASIC 3.5, a
-DOS-based programming language. Since, many
-potential users are working in rather different programming environments,
-the authors thought of porting <tt>mathspic</tt> into another programming
-cross-platform language which would be widely available.
-The authors decided to rewrite <tt>mathspic</tt> in Perl
-since not only is Perl pretty stable, but it has
-extensive mathematical support.<p>
-
-<h3><b>Program Structure</b></h3><p>
-<a name="NWD21HcNW-2">Initially, we define a little package that is used to implement the </a><code>loop</code>
-command. Then, we must do is to check the possible command line arguments.
-Next, we process the input file.
-If the user has used the <code>-b</code> (see below), the program will `beep'
-if any errors are found during processing.
-We need some auxiliary subroutines in order to properly parse the input
-file and of course to handle the various commands. We also need a
-few global variables.
-
-<pre><a name="NW21HcNW-1p0Y9w-1" href="#NWD21HcNW-2"><dfn>&lt;*&gt;=</dfn></a>
-#!/usr/bin/perl
-#
-#(c) Copyright 2005-2007
-# Apostolos Syropoulos &amp; R.W.D. Nickalls
-# asyropoulos@yahoo.com dicknickalls@compuserve.com
-#
-# 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.
-#
-<a name="NW21HcNW-1p0Y9w-1-u1" href="#NWD21HcNW-3"><i>&lt;package <tt>DummyFH</tt> &gt;</i></a>
-package main;
-use Math::Trig;
-<a name="NW21HcNW-1p0Y9w-1-u2" href="#NWD21HcNW-8"><i>&lt;Define global variables&gt;</i></a>
-<a name="NW21HcNW-1p0Y9w-1-u3" href="#NWD21HcNW-9"><i>&lt;subroutine definitions&gt;</i></a>
-<a name="NW21HcNW-1p0Y9w-1-u4" href="#NWD21HcNW-4"><i>&lt;Check for command line arguments&gt;</i></a>
-<a name="NW21HcNW-1p0Y9w-1-u5" href="#NWD21HcNW-7"><i>&lt;process file&gt;</i></a>
-print $alarm if $no_errors &gt; 0;
-__END__
-
-</pre><p><a name="NWD21HcNW-3">The package </a><code>DummyFH</code> is used in the implementation of the <code>loop</code> command.
-It creates a dummy filehandle that is associated with an array of strings. Since
-we only read data from this dummy filehandle, we implement the <code>READLINE</code> subroutine.
-When we read a line from this dummy filehandle, we actually requesting the next entry
-of the array (if any). That is why we use the package variable <code>$index</code>. When there
-are no more entries in the array, subroutine <code>READLINE</code> returns the value <code>undef</code>
-so to falsify loop that controls the consumption of input from this dummy filehandle.
-
-<pre><a name="NW21HcNW-2YwRNH-1" href="#NWD21HcNW-3"><dfn>&lt;package <tt>DummyFH</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-2">&lt;-U</a>)</b>
-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 &gt; $#$self) {
- $index = 0;
- return undef;
- }
- else {
- return $self-&gt;[$index++];
- }
-}
-
-</pre><p><tt>mathspic</tt> accepts at most four command-line switches, namely
-<tt>-b</tt> for enabling the beep, <tt>-s</tt> for automatic
-screen viewing of the output-file,
-<tt>-c</tt> for cleaning out all comment-lines,
-and <tt>-o</tt> with a following file-name
-for specifying the output file-name.
-<tt><a name="NWD21HcNW-4">mathspic</a></tt> requires the name of an existing input-file
-(the so-called <tt>mathspic</tt>-file) containing
-<tt>mathspic</tt>commands.
-If no command-line arguments are supplied, we print a
-suitable usage message indicating the syntax.
-For each command-line argument we set a global
-variable. The default behavior is that the `bell' does not beep
-and comment-lines are not removed from the output-file.
-
-<pre><a name="NW21HcNW-122Dzz-1" href="#NWD21HcNW-4"><dfn>&lt;Check for command line arguments&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-2">&lt;-U</a>)</b>
-our $alarm=&quot;&quot;;
-our $comments_on=1;
-our $out_file=&quot;default&quot;;
-our $argc=@ARGV;
-if ($argc == 0 || $argc &gt; 5 ){ # no command line arguments or more than 4
- # arguments
- die &quot;\nmathspic version $version_number\n&quot; .
- &quot;Usage: mathspic [-h] [-b] [-c] [-o &lt;out file&gt;] &lt;in file&gt;\n\n&quot;;
-}
-else {
- <a name="NW21HcNW-122Dzz-1-u1" href="#NWD21HcNW-5"><i>&lt;Process command line arguments&gt;</i></a>
- print &quot;This is mathspic version $version_number\n&quot;;
-}
-<a name="NW21HcNW-122Dzz-1-u2" href="#NWD21HcNW-6"><i>&lt;Check if .m file exists&gt;</i></a>
-
-</pre><p><a name="NWD21HcNW-5">In order to get the various command-line arguments we use a simple</a>
-<code>while</code> loop that checks each element of the array <code>@ARGV</code>. We check
-for all the switches, and we get the name of the input-file.
-
-<pre><a name="NW21HcNW-LnOV9-1" href="#NWD21HcNW-5"><dfn>&lt;Process command line arguments&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-4">&lt;-U</a>)</b>
- our $file = &quot;&quot;;
- SWITCHES:
- while($_ = $ARGV[0]) {
- shift;
- if (/^-h$/) {
- die &quot;\nThis is mathspic version $version_number\n&quot; .
- &quot;Type \&quot;man mathspic\&quot; for detailed help\n&quot;.
- &quot;Usage:\tmathspic [-h] [-b] [-c] [-o &lt;out file&gt;] &lt;in file&gt;\n&quot; .
- &quot;\twhere,\n&quot; .
- &quot;\t[-b]\tenables bell sound if error exists\n&quot; .
- &quot;\t[-c]\tdisables comments in ouput file\n&quot; .
- &quot;\t[-h]\tgives this help listing\n&quot; .
- &quot;\t[-o]\tcreates specified output file\n\n&quot;;
- }
- elsif (/^-b$/) {
- $alarm = chr(7);
- }
- elsif (/^-c$/) {
- $comments_on = 0;
- }
- elsif (/^-o$/) {
- die &quot;No output file specified!\n&quot; if !@ARGV;
- $out_file = $ARGV[0];
- shift;
- }
- elsif (/^-\w+/) {
- die &quot;$_: Illegal command line switch!\n&quot;;
- }
- else {
- $file = $_;
- }
- }
- die &quot;No input file specified!\n&quot; if $file eq &quot;&quot;;
-
-</pre><p><a name="NWD21HcNW-6">In order to check whether the input-file exists, we simply use the</a>
-<code>-e</code> operator. First we check to see if <code>$file</code> exits.
-If the input-file does exist then the variable <code>$file</code> contains
-the file name. In case the user has not specified an output
-file, the default output file name is the name of the input file with
-extension <code>.mt</code>. Finally, the program outputs all error messages to
-the screen and to a log file. The name of the log file consists of
-the contents of the variable <code>$file</code> and the extension <code>.mlg</code>.
-
-<pre><a name="NW21HcNW-2K3CIm-1" href="#NWD21HcNW-6"><dfn>&lt;Check if .m file exists&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-4">&lt;-U</a>)</b>
- our ($source_file, $log_file);
- if (! -e $file) {
- die &quot;$file: no such file!\n&quot; if (! (-e &quot;$file.m&quot;));
- $source_file = &quot;$file.m&quot;;
- }
- else {
- $source_file = $file;
- $file = $1 if $file =~ /(\w[\w-\.]+)\.\w+/;
- }
- $out_file= &quot;$file.mt&quot; if $out_file eq &quot;default&quot;;
- $log_file= &quot;$file.mlg&quot;;
-
-</pre><p><a name="NWD21HcNW-7">Now that we have all the command line arguments, we can start processing</a>
-the input file. This is done by calling the subroutine <code>process_input</code>.
-Before that we must open all necessary files. Next,
-we print some `header' information to the output file and to the log file.
-
-<pre><a name="NW21HcNW-EP1QE-1" href="#NWD21HcNW-7"><dfn>&lt;process file&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-2">&lt;-U</a>)</b>
- open(IN,&quot;$source_file&quot;)||die &quot;Can't open source file: $source_file\n&quot;;
- open(OUT,&quot;&gt;$out_file&quot;)||die &quot;Can't open output file: $out_file\n&quot;;
- open(LOG,&quot;&gt;$log_file&quot;)||die &quot;Can't open log file: $log_file\n&quot;;
- print_headers;
- process_input(IN,&quot;&quot;);
-
-</pre><p>In this section we define a few global variables. More specifically:
-the variable <code>$version_number</code> contains the current version number of the
-program, the variable <code>$commandLineArgs</code> contains the command line arguments.
-These two variables are used in the <code>print_headers</code> subroutine.
-The variable <code>$command</code> will contain the whole current input line.
-Hash <code>%PointTable</code> is used to store point names and related
-information. Hash <code>%VarTable</code> is used to store mathspic variable names
-and related information, while the associative array <code>%ConstTable</code> contains the
-names of constants. Note that the values of both constants and variables are
-kept in <code>%VarTable</code>.
-The variable <code>$no_errors</code> is incremented whenever the
-program encounters an error in the input file. The variables <code>$xunits</code>,
-<code>$yunits</code> and <code>$units</code> are related to the <code>paper</code> command.
-In particular, the variable <code>$units</code> is used to parse the unit part of the
-<code>unit</code> part of the <code>paper</code> command. The variable <code>$defaultsymbol</code> is used to
-set the point shape. The constant <code>PI</code> holds the value of the mathematical
- constant pi.
-The constant <code>R2D</code> holds the transformation factor to transform radians to
-degrees. The constant <code>D2R</code> holds the transformation factor
-to transform degrees to radians, i.e., the value <code>1/R2D</code>. The global variables
-<code>$arrowLength</code>, <code>$arrowAngleB</code> and <code>$arrowAngleC</code> are actually parameters that
-<a name="NWD21HcNW-8">are used by the subroutines that draw arrows. Since </a><code>$arrowLength</code> is actually
-a length, variable <code>$arrowLenghtUnits</code> holds the units of measure in which
-this length is expressed. The hash table <code>%DimOfPoint</code> contains the side or the
-radius of a point whose plot-symbol is a square or a circle, respectively. In case the
-default point symbol is a circle or a square, variable <code>$GlobalDimOfPoints</code> is used
-to store the length of the radius or the length of the side of default point symbol,
-respectively. Variable <code>$LineThickness</code> holds the current line thickness (the
-default value is 0.4&nbsp;pt).
-
-<pre><a name="NW21HcNW-xIn58-1" href="#NWD21HcNW-8"><dfn>&lt;Define global variables&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-2">&lt;-U</a>)</b>
-our $version_number = &quot;1.10 Feb 18, 2007&quot;;
-our $commandLineArgs = join(&quot; &quot;, @ARGV);
-our $command = &quot;&quot;;
-our $curr_in_file = &quot;&quot;;
-our %PointTable = ();
-our %VarTable = ();
-our %ConstTable = ();
-our $no_errors = 0;
-our $xunits = &quot;1pt&quot;;
-our $yunits = &quot;1pt&quot;;
-our $units = &quot;pt|pc|in|bp|cm|mm|dd|cc|sp&quot;;
-our $defaultsymbol = &quot;\$\\bullet\$&quot;;
-our $defaultLFradius = 0;
-use constant PI =&gt; atan2(1,1)*4;
-use constant R2D =&gt; 180 / PI;
-use constant D2R =&gt; PI / 180;
-our $arrowLength = 2;
-our $arrowLengthUnits = &quot;mm&quot;;
-our $arrowAngleB = 30;
-our $arrowAngleC = 40;
-our %DimOfPoint = ();
-our $GlobalDimOfPoints = 0;
-our @Macros = ();
-our $LineThickness = 0.4;
-
-</pre><p>In this section we define the various subroutines that are needed in order
-to process the input file.
-
-<p> Subroutine <tt>mpp</tt> is a mathspic preprocessor that allows the definition
-and use of macros with or without arguments. For the moment it is an experimental
-feature and it should be used with care.
-
-<p> Subroutine <tt>PrintErrorMessage</tt> is used to print error messages
-to the screen, to the output file and to the log file.
-
-<p> Subroutine <tt>PrintWarningMessage</tt> is used to print warning messages
-to the screen, to the output file and to the log file.
-
-<p> Subroutine <tt>PrintFatalError</tt> is used to print an error message
-to the screen and to abort execution, where the error is considered fatal
-and not recoverable.
-
-<p>Subroutine <tt>chk_lparen</tt> checks whether the next input
-character is a left parenthesis. Subroutine <tt>chk_rparen</tt>
-checks whether the next input character is a right parenthesis. Subroutine
-<tt>chk_comment</tt> checks whether a given command is followed by a trailing
-comment. In the same spirit, we define the subroutines <tt>chk_lcb</tt>,
-<tt>chk_rcb</tt>, <tt>chk_lsb</tt>, and <tt>chk_rsb</tt> which check for
-opening and closing curly and square brackets respectively.
-The subroutine <code>chk_comma</code> checks whether the next token is a comma.
-
-<p> Subroutine <code>print_headers</code> is used to print a header to the output file,
-so a user knows that the file has been generated by <tt>mathspic</tt>.
-
-<p> Subroutine <code>get_point</code> is used to parse a point name and to
-check whether the point exists (i.e whether the point has been defined).
-
-<p> Subroutine <code>perpendicular</code> is used to compute the coordinates of the
-foot of perpendicular line from some point P to a line AB.
-
-<p> Subroutine <code>Length</code> is used to compute the distance between two
-points A and B.
-
-<p> Subroutine <code>triangleArea</code> computes the area of a triangle defined
-by three points.
-
-<p> Subroutine <code>PointOnLine</code> is used to compute the coordinates of
-a point on a line segment AB and a distance d units from A towards B.
-
-<p> Subroutine <code>circumCircleCenter</code> takes six arguments that are the
-coordinates of three points and computes the center of the circle that
-passes through the three points which define the triangle.
-
-<p> Subroutine <code>ComputeDist</code> is used to compute a numeric value that is
-specified by either a variable name, a pair of points, or just a number.
-
-<p> Subroutine <code>intersection4points</code> is used to compute the coordinates
-of the point of intersection of two lines specified by the four arguments
-(i.e. two arguments for each point).
-
-<p> Subroutine <code>IncircleCenter</code> is used to compute the center and
-the radius of a circle that touches internally the sides of a triangle,
-the coordinates of the three points which define the triangle
-being the arguments of the subroutine.
-
-<p> Subroutine <code>Angle</code> determines the opening in degrees of an angle
-defined by three points which are the arguments of this subroutine.
-
-<p> Subroutine <code>excircle</code> computes the center and the radius of
-a circle that externally touches a given side (4th and 5th arguments) of
-triangle (determined by the 1st, the 2nd and the 3rd argument).
-
-<p> Subroutine <code>DrawLineOrArrow</code> is used to parse the arguments of the commands
- <code>drawline</code>, <code>drawthickline</code>, <code>drawarrow</code>, <code>drawthickarrow</code> and
- <code>drawCurve</code>.
-
-<p> Subroutine <code>drawarrows</code> is used to draw one or more arrows between points.
-
-<p> Subroutine <code>drawlines</code> is used to draw one or more lines between points.
-
-<p> Subroutine <code>drawCurve</code> is used to draw a curve between an odd number of points.
-
-<p> Subroutine <code>drawpoints</code> is used to draw the point symbol of one or more points.
-
-<p> Subroutine <code>drawAngleArc</code> is used to draw an arc line within an angle.
-
-<p> Subroutine <code>drawAngleArrow</code> is used to draw an arc line with an arrow on the end,
-within an angle.
-
-<p> Subroutine <code>expr</code> and subroutines <code>term</code>, <code>factor</code> and
-<code>primitive</code> are used to parse an expression that follows a variable
-declaration.
-
-<p> Subroutine <code>memberOf</code> is used to determine whether a string is a
-member of a list of strings.
-
-<p> Subroutine <code>tand</code> computes the tangent of an angle, where the
-angle is expressed in degrees.
-
-<p> Subroutine <code>get_string</code> scans a string in order to extract a
-valid mathspic string.
-
-<p> Subroutine <code>is_tainted</code> checks whether a string contains data that
-may be proved harmful if used as arguments to a shell escape.
-
-<p> Subroutine <code>noOfDigits</code> has one argument which is a number and
-returns the number of decimal digits it has.
-
-<p> Subroutine <code>drawsquare</code> has one argument which is the radius of point
-and yields LaTeX code that draws a square.
-
-<p> Subroutine <code>X2sp</code> can be used to transform a length to sp units.
-
-<p> <a name="NWD21HcNW-9">Subroutine </a><code>sp2X</code> can be used to transform a length expressed in sp units
- to any other acceptable unit.
-
-<p> Subroutine <code>setLineThickness</code> is used to determine the length of the
- linethickness in the current paper units.
-
-<p> Subroutine <code>process_input</code> parses the input file and any other file
- being included in the main file, and generates output.
-
-<pre><a name="NW21HcNW-2AA3uL-1" href="#NWD21HcNW-9"><dfn>&lt;subroutine definitions&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-2">&lt;-U</a>)</b>
- <a name="NW21HcNW-2AA3uL-1-u1" href="#NWD21HcNW-A"><i>&lt;subroutine <tt>mpp</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u2" href="#NWD21HcNW-B"><i>&lt;subroutine <tt>PrintErrorMessage</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u3" href="#NWD21HcNW-C"><i>&lt;subroutine <tt>PrintWarningMessage</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u4" href="#NWD21HcNW-D"><i>&lt;subroutine <tt>PrintFatalError</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u5" href="#NWD21HcNW-E"><i>&lt;subroutine <tt>chk_lparen</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u6" href="#NWD21HcNW-F"><i>&lt;subroutine <tt>chk_rparen</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u7" href="#NWD21HcNW-G"><i>&lt;subroutine <tt>chk_lcb</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u8" href="#NWD21HcNW-H"><i>&lt;subroutine <tt>chk_rcb</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u9" href="#NWD21HcNW-I"><i>&lt;subroutine <tt>chk_lsb</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u10" href="#NWD21HcNW-J"><i>&lt;subroutine <tt>chk_rsb</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u11" href="#NWD21HcNW-K"><i>&lt;subroutine <tt>chk_comma</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u12" href="#NWD21HcNW-L"><i>&lt;subroutine <tt>chk_comment</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u13" href="#NWD21HcNW-M"><i>&lt;subroutine <tt>print_headers</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u14" href="#NWD21HcNW-N"><i>&lt;subroutine <tt>get_point</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u15" href="#NWD21HcNW-O"><i>&lt;subroutine <tt>perpendicular</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u16" href="#NWD21HcNW-P"><i>&lt;subroutine <tt>Length</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u17" href="#NWD21HcNW-Q"><i>&lt;subroutine <tt>triangleArea</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u18" href="#NWD21HcNW-R"><i>&lt;subroutine <tt>pointOnLine</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u19" href="#NWD21HcNW-S"><i>&lt;subroutine <tt>circumCircleCenter</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u20" href="#NWD21HcNW-T"><i>&lt;subroutine <tt>ComputeDist</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u21" href="#NWD21HcNW-U"><i>&lt;subroutine <tt>intersection4points</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u22" href="#NWD21HcNW-V"><i>&lt;subroutine <tt>IncircleCenter</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u23" href="#NWD21HcNW-W"><i>&lt;subroutine <tt>Angle</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u24" href="#NWD21HcNW-X"><i>&lt;subroutine <tt>excircle</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u25" href="#NWD21HcNW-Y"><i>&lt;subroutine <tt>DrawLineOrArrow</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u26" href="#NWD21HcNW-Z"><i>&lt;subroutine <tt>drawarrows</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u27" href="#NWD21HcNW-a"><i>&lt;subroutine <tt>drawlines</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u28" href="#NWD21HcNW-b"><i>&lt;subroutine <tt>drawCurve</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u29" href="#NWD21HcNW-c"><i>&lt;subroutine <tt>drawpoints</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u30" href="#NWD21HcNW-d"><i>&lt;subroutine <tt>drawAngleArc</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u31" href="#NWD21HcNW-e"><i>&lt;subroutine <tt>drawAngleArrow</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u32" href="#NWD21HcNW-f"><i>&lt;subroutine <tt>expr</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u33" href="#NWD21HcNW-g"><i>&lt;subroutine <tt>memberOf</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u34" href="#NWD21HcNW-h"><i>&lt;subroutine <tt>tand</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u35" href="#NWD21HcNW-i"><i>&lt;subroutine <tt>get_string</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u36" href="#NWD21HcNW-j"><i>&lt;subroutine <tt>is_tainted</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u37" href="#NWD21HcNW-k"><i>&lt;subroutine <tt>noOfDigits</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u38" href="#NWD21HcNW-l"><i>&lt;subroutine <tt>drawsquare</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u39" href="#NWD21HcNW-m"><i>&lt;subroutine <tt>X2sp</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u40" href="#NWD21HcNW-n"><i>&lt;subroutine <tt>sp2X</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u41" href="#NWD21HcNW-o"><i>&lt;subroutine <tt>setLineThickness</tt> &gt;</i></a>
- <a name="NW21HcNW-2AA3uL-1-u42" href="#NWD21HcNW-p"><i>&lt;subroutine <tt>process_input</tt> &gt;</i></a>
-
-</pre><p>Subroutine <tt>mpp</tt> is an implementation of a mathspic preprocessor that allows
-the definition of one-line macros with or without arguments. Macro definition has the
-following syntax:
-<center>
- <tt>"%def" macro_name "(" [ parameters ] ")" macro_code
-</center>
-where parameters is a list of comma separated strings (e.g., x,y,z). Once a macro is
-defined it can be used or it can be undefined. To undefine a macro one has to use
-the following command:
-<center>
- <tt>"%undef" [ macro_name ]
-</center
-This means that an undef command without an accompanying macro name has no effect
-at all. In order to use a macro we simply type its name and its arguments in
-parentheses. Note that macro arguments should not contain spaces. If a macro has no
-argument, there is no need to type any parentheses. We will now describe briefly how
-the macro processor operates.
-<p> If the current input line starts with <tt>%def</tt>, then we assume that we have
-a macro definition. We parse each component of the macro definition and finally we
-store the macro name, the macro code and the macro parameters (if any) in an anonymous
-hash that eventually becomes part of an array. If we encounter any error, we simply
-<a name="NWD21HcNW-A">skip to the next line after printing a suitable error message. Now, if the first tokens</a>
-of an input line are <tt>%undef</tt>, we assume the user wants to delete a macro.
-In case these tokens are not followed by a macro name or the macro name has not been
-defined we simply go on. Otherwise, we delete the corresponding macro data from the
-global array <code>@Macros</code> that contains all the macro information. Macro expansion is
-more difficult and it will be described in detail in a separate document. At this point
-we would like to thank Joachim Schneider <joachim at hal dot rhein-necker dot de>
-for a suggestion on improving macro expansion.
-
-<pre><a name="NW21HcNW-2rq75n-1" href="#NWD21HcNW-A"><dfn>&lt;subroutine <tt>mpp</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
-sub mpp {
- my $in_line;
- chomp($in_line = shift);
- my $LC = shift;
- my $out_line = $in_line;
- my $macro_name = &quot;&quot;;
- my @macro_param = ();
- my $macro_code = &quot;&quot;;
- if ($in_line =~ s/^%def\s*//) {
- if ($in_line =~ s/^(\w+)\s*//){
- $macro_name = $1;
- }
- else {
- PrintErrorMessage(&quot;No macro name has been found&quot;,$LC);
- return &quot;&quot;
- }
- if ($in_line =~ s/^\(\s*//) {
- # do nothing
- }
- else {
- PrintErrorMessage(&quot;No left parenthesis after macro name has been found&quot;,$LC);
- return &quot;&quot;;
- }
- if ($in_line =~ s/^\)//) {
- # Macro has no parameters!
- }
- else {
- MACROS: while (1) {
- if ($in_line =~ s/^(\w+)\s*//) {
- push (@macro_param, $1);
- }
- else {
- PrintErrorMessage(&quot;No macro parameter name has been found&quot;,$LC);
- return &quot;&quot;;
- }
- if ($in_line =~ s/^,\s*//) {
- next MACROS;
- }
- else {
- last MACROS;
- }
- }
- if ($in_line =~ s/^\)//) {
- # do nothing!
- }
- else {
- PrintErrorMessage(&quot;No closing parenthesis after macro parameters&quot;,$LC);
- return &quot;&quot;;
- }
- }
- $in_line =~ s/([^%]+)(%.*)/$1/;
- $macro_code = $in_line;
- push ( @Macros , { 'macro_name' =&gt; $macro_name,
- 'macro_code' =&gt; $macro_code,
- 'macro_param' =&gt; \@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 &gt;= 0; $i--) {
- if ($Macros[$i]-&gt;{'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 &gt;= 0; $i--) {
- my $macro_name = $Macros[$i]-&gt;{'macro_name'};
- if ($in_line =~ /&amp;$macro_name\b/) { ############################
- my $num_of_macro_args = @{$Macros[$i]-&gt;{'macro_param'}};
- if ( $num_of_macro_args &gt; 0 ) {
- # Macro with parameters
- my $pattern = &quot;&amp;$macro_name\\(&quot;;
- foreach my $p ( 1..$num_of_macro_args ) {
- my $comma = ($p == $num_of_macro_args) ? &quot;\\s*&quot; : &quot;\\s*,\\s*&quot;;
- $pattern .= &quot;\\s*[^\\s\\)]+$comma&quot;;
- }
- $pattern .= &quot;\\)&quot;;
- while($in_line =~ /&amp;$macro_name\b/) {
- if ($in_line =~ /$pattern/) {
- my $before = $`;
- my $after = $';
- my $match = $&amp;;
- my $new_code = $Macros[$i]-&gt;{'macro_code'};
- $match =~ s/^&amp;$macro_name\(\s*//;
- $match =~ s/\)$//;
- foreach my $arg ( 0..($num_of_macro_args - 1) ) {
- my $old = $Macros[$i]-&gt;{'macro_param'}-&gt;[$arg];
- my $comma = ($arg == ($num_of_macro_args - 1)) ? &quot;&quot; : &quot;,&quot;;
- $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 = &quot;$before$new_code$after&quot;;
- }
- else {
- PrintErrorMessage(&quot;Usage of macro &amp;$macro_name does not &quot; .
- &quot;match its definition&quot;, $LC);
- return &quot;&quot;;
- }
- }
- }
- else {
- # Macro without parameters
- my $replacement = $Macros[$i]-&gt;{'macro_code'};
- # '\b': Substitute only whole words
- # not x in xA
- $in_line =~ s/&amp;$macro_name\b/$replacement/g;
- }
- }
- }
- last EXPANSIONLOOP if ( $org_in_line eq $in_line );
- }
- return &quot;$in_line$comment&quot;;
- }
-}
-
-</pre><p>Subroutine <tt>PrintErrorMessage</tt> has two parameters: the
-error message that will be printed on the screen, the log file and
-the output file, and the line number of the line containing the
-error was detected.
-The general form of the error message is the following:
-<pre>
-line X: paper{units(
- ,mm)xrange(0,20)yrange(0,30)axes(B)ticks(10,10)}
-
-***Error: Error_Message
-</pre>
-where <code>X</code> denotes the line number and <code>Error_Message</code> is the
-actual error message. Note, that we print the tokens processed so far
-and on the text line the unprocessed tokens, so that the user knows
-<a name="NWD21HcNW-B">exactly where the error is. In the variable </a><code>$A</code> we store the processed
-tokens, while the variable <code>$l</code> holds the length of <code>$A</code> plus the
-length of the <code>$error_line</code> (that is the number of the input line where
-the error occurred) plus 7, i.e., 4 (the length of the word
-<code>line</code>) plus 2 (the two blank spaces) plus 1 (the symbol <code>:</code>).
-Finally, we increment the error counter (variable <code>$no_errors</code>). Note, that
-in case the user has specified the <code>-c</code> command line switch, we will not
-print any messages to the output file.
-
-<pre><a name="NW21HcNW-1m1522-1" href="#NWD21HcNW-B"><dfn>&lt;subroutine <tt>PrintErrorMessage</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
- 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 &quot;$curr_in_file&quot;, &quot;Line $error_line: $A\n&quot;;
- print $fh &quot; &quot; x $l ,$_,&quot;***Error: $errormessage\n&quot;;
- }
- if ($comments_on) { #print to output file file
- print OUT &quot;%% *** $curr_in_file&quot;, &quot;Line $error_line: $A\n&quot;;
- print OUT &quot;%% *** &quot;,&quot; &quot; x $l ,$_,&quot;%% ... Error: $errormessage\n&quot;;
- }
- $no_errors++;
- }
-
-</pre><p><a name="NWD21HcNW-C">Subroutine </a><tt>PrintWarningMessage</tt> behaves exactly like the subroutine
-<tt>PrintErrorMessage</tt>. The only difference is that the second
-subroutine prints only a warning message. A warning is issued when
-the system detects parameters that do nothing.
-
-<pre><a name="NW21HcNW-3Lpu7M-1" href="#NWD21HcNW-C"><dfn>&lt;subroutine <tt>PrintWarningMessage</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
- 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 &quot;$curr_in_file&quot;, &quot;Line $warning_line: $A\n&quot;;
- print $fh &quot; &quot; x $l ,$_,&quot;***Warning: $warningMessage\n&quot;;
- }
- if ($comments_on) { #print to output file file
- print OUT &quot;%% *** $curr_in_file&quot;, &quot;Line $warning_line: $A\n&quot;;
- print OUT &quot;%% *** &quot;,&quot; &quot; x $l ,$_,&quot;%% ... Warning: $warningMessage\n&quot;;
- }
- }
-
-</pre><p><a name="NWD21HcNW-D">The subroutine </a><tt>PrintFatalError</tt> behaves similarly to the subroutine
-<tt>PrintErrorMessage</tt>. It prints an error message to the
-screen and aborts execution.
-
-<pre><a name="NW21HcNW-4RPeBe-1" href="#NWD21HcNW-D"><dfn>&lt;subroutine <tt>PrintFatalError</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
- 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 &quot;$curr_in_file&quot;, &quot;Line $fatal_line: $A\n&quot; .
- (&quot; &quot; x $l) . $_ . &quot;***Fatal Error: $FatalMessage\n&quot;;
- }
-
-</pre><p><a name="NWD21HcNW-E">The subroutine </a><tt>chk_lparen</tt> accepts two arguments: the name
-of the token that should be immediately before the left parenthesis (variable
-<code>$token</code>), and the current line number (variable <code>$lc</code>). First we
-skip any leading white space and then check whether the next
-input character is a left parenthesis, then the subroutine skips any
-trailing white space; otherwise it prints an error message.
-
-<pre><a name="NW21HcNW-4Y5BUt-1" href="#NWD21HcNW-E"><dfn>&lt;subroutine <tt>chk_lparen</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
-sub chk_lparen {
- my $token = $_[0];
- my $lc = $_[1];
- s/\s*//;
- if (/^[^\(]/) {
- PrintErrorMessage(&quot;Missing ( after $token&quot;,$lc);
- }
- else {
- s/^\(\s*//;
- }
-}
-
-</pre><p><a name="NWD21HcNW-F">The subroutine </a><tt>chk_rparen</tt> accepts two parameters: the name
-of the token that should be immediately after a right parenthesis (variable
-<code>$token</code>), and the current line number (variable <code>$lc</code>). Initially, we
-skip any leading white space and then we check whether the next input
-token is a right parenthesis. If it is not we issue a error message and
-return, otherwise we skip the parenthesis and any trailing white space.
-
-<pre><a name="NW21HcNW-3fTYkz-1" href="#NWD21HcNW-F"><dfn>&lt;subroutine <tt>chk_rparen</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
-sub chk_rparen {
- my $token = $_[0];
- my $lc = $_[1];
- s/\s*//;
- if (s/^\)//) {
- s/\s*//;
- }
- else {
- PrintErrorMessage(&quot;Missing ) after $token&quot;,$lc);
- }
-}
-
-
-</pre><p><a name="NWD21HcNW-G">The subroutine </a><tt>chk_lcb</tt> behaves in a similar way to the subroutine
-<tt>chk_lparen</tt>.
-
-<pre><a name="NW21HcNW-2vMx6j-1" href="#NWD21HcNW-G"><dfn>&lt;subroutine <tt>chk_lcb</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
-sub chk_lcb {
- my $token = $_[0];
- my $lc = $_[1];
- s/\s*//;
- if ($_ !~ /^\{/) {
- PrintErrorMessage(&quot;Missing { after $token&quot;,$lc);
- }
- else {
- s/^{\s*//;
- }
-}
-
-</pre><p><a name="NWD21HcNW-H">Subroutine </a><tt>chk_rcb</tt> behaves in a similar way to the subroutine
-<tt>chk_rparen</tt>.
-
-<pre><a name="NW21HcNW-FE9Ax-1" href="#NWD21HcNW-H"><dfn>&lt;subroutine <tt>chk_rcb</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
-sub chk_rcb {
- my $token = $_[0];
- my $lc = $_[1];
- if ($_ !~ /^\s*\}/) {
- PrintErrorMessage(&quot;Missing } after $token&quot;,$lc);
- }
- else {
- s/^\s*}\s*//;
- }
-}
-
-</pre><p><a name="NWD21HcNW-I">Subroutine </a><tt>chk_lsb</tt> behaves in a similar way to the subroutine
-<tt>chk_lparen</tt>.
-
-<pre><a name="NW21HcNW-3N30ZF-1" href="#NWD21HcNW-I"><dfn>&lt;subroutine <tt>chk_lsb</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
-sub chk_lsb {
- my $token = $_[0];
- my $lc = $_[1];
-
- s/\s*//;
- if ($_ !~ /^\[/) {
- PrintErrorMessage(&quot;Missing [ after $token&quot;,$lc);
- }
- else {
- s/^\[\s*//;
- }
-}
-
-</pre><p><a name="NWD21HcNW-J">Subroutine </a><tt>chk_rsb</tt> behaves in a similar way to the subroutine
-<tt>chk_rparen</tt>.
-
-<pre><a name="NW21HcNW-ma6zf-1" href="#NWD21HcNW-J"><dfn>&lt;subroutine <tt>chk_rsb</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
-sub chk_rsb {
- my $token = $_[0];
- my $lc = $_[1];
-
- s/\s*//;
- if ($_ !~ /^\]/) {
- PrintErrorMessage(&quot;Missing ] after $token&quot;,$lc);
- }
- else {
- s/^\]\s*//;
- }
-}
-
-</pre><p><a name="NWD21HcNW-K">The subroutine </a><code>chk_comma</code> checks whether the next token is a comma.
-If it is not then it prints an error message, otherwise it consumes the
-comma and any white space that follows the comma.
-
-<pre><a name="NW21HcNW-UyyUp-1" href="#NWD21HcNW-K"><dfn>&lt;subroutine <tt>chk_comma</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
-sub chk_comma {
- my $lc = $_[0];
-
- s/\s*//;
- if (/^[^,]/) {
- PrintErrorMessage(&quot;Did not find expected comma&quot;,$lc);
- }
- else {
- s/^,\s*//;
- }
-}
-
-</pre><p><a name="NWD21HcNW-L">The subroutine </a><code>chk_comment</code> has only one parameter which is the current
-line number. It checks whether the next input character is a comment
-character and in this case it does nothing!. Otherwise, if there is some trailing text
-it simply prints a warning to the screen.
-
-<pre><a name="NW21HcNW-wLKY1-1" href="#NWD21HcNW-L"><dfn>&lt;subroutine <tt>chk_comment</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
-sub chk_comment {
- my $lc = $_[0];
-
- s/\s*//;
- if (/^%/) {
- # do nothing!
- }
- elsif (/^[^%]/) {
- PrintWarningMessage(&quot;Trailing text is ignored&quot;,$lc);
- }
-}
-
-</pre><p><a name="NWD21HcNW-M">The subroutine </a><code>print_headers</code> prints a header to the output file, as
-well as a header to the LOG file.
-The header contains information regarding the version of the
-program, a copyright notice, the command line, date and time information,
-and the names of the various files processed/generated.
-
-<pre><a name="NW21HcNW-3iVliS-1" href="#NWD21HcNW-M"><dfn>&lt;subroutine <tt>print_headers</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
- sub print_headers
- {
- my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
- $year+=1900;
- $mon+=1;
- $now_string = &quot;$year/&quot; . ($mon&gt;9 ? &quot;$mon/&quot; : &quot;0$mon/&quot;) .
- ($mday&gt;9 ? &quot;$mday &quot; : &quot;0$mday &quot;) .
- ($hour&gt;9 ? &quot;$hour:&quot; : &quot;0$hour:&quot;) .
- ($min&gt;9 ? &quot;$min:&quot; : &quot;0$min:&quot;) .
- ($sec&gt;9 ? &quot;$sec&quot; : &quot;0$sec&quot;);
- print OUT &quot;%* -----------------------------------------------\n&quot;;
- print OUT &quot;%* mathspic (Perl version $version_number)\n&quot;;
- print OUT &quot;%* A filter program for use with PiCTeX\n&quot;;
- print OUT &quot;%* Copyright (c) 2005 A Syropoulos &amp; RWD Nickalls \n&quot;;
- print OUT &quot;%* Command line: $0 $commandLineArgs\n&quot;;
- print OUT &quot;%* Input filename : $source_file\n&quot;;
- print OUT &quot;%* Output filename: $out_file\n&quot;;
- print OUT &quot;%* Date &amp; time: $now_string\n&quot;;
- print OUT &quot;%* -----------------------------------------------\n&quot;;
- #
- print LOG &quot;----\n&quot;;
- print LOG &quot;$now_string\n&quot;;
- print LOG &quot;mathspic (Perl version $version_number)\n&quot;;
- print LOG &quot;Copyright (c) 2005 A Syropoulos &amp; RWD Nickalls \n&quot;;
- print LOG &quot;Input file = $source_file\n&quot;;
- print LOG &quot;Output file = $out_file\n&quot;;
- print LOG &quot;Log file = $log_file\n&quot;;
- print LOG &quot;----\n&quot;;
- }
-
-</pre><p><a name="NWD21HcNW-N">The subroutine </a><code>get_point</code> parses an individual point name.
-If the next token is also a point name then it returns the point name
- (but only if the only if
-the point name exists in the PointTable). In all other cases it returns
-the string <code>_undef_</code> to indicate that something is wrong.
-
-<pre><a name="NW21HcNW-1h5ef9-1" href="#NWD21HcNW-N"><dfn>&lt;subroutine <tt>get_point</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
- sub get_point {
-
- my ($lc) = $_[0];
- my ($PointName);
-
- if (s/^([^\W\d_]\d{0,3})\s*//i) { #point name
- $PointName = $1;
- if (!exists($PointTable{lc($PointName)})) {
- PrintErrorMessage(&quot;Undefined point $PointName&quot;,$lc);
- return &quot;_undef_&quot;;
- }
- else {
- return lc($PointName);
- }
- }
- else {
- PrintErrorMessage(&quot;Point name expected&quot;,$lc);
- return &quot;_undef_&quot;;
- }
- }
-
-</pre><p>The subroutine <code>perpendicular</code> has 6 parameters that correspond to the
-coordinates of some point P and to the coordinates of two points A and
-B that define a line. The subroutine returns
-a pair of numbers that correspond to the coordinates of a point that lies
-at the foot of the perpendicular to the line AB that passes through point P.
-The slope of line AB is m<sub>1</sub> and so its equation is
-y=m<sub>1</sub>x+c<sub>1</sub>. Similarly, the slope of the line PF is
-m<sub>2</sub>=-1/m<sub>1</sub> and its equation is
-y=m<sub>2</sub>x+c<sub>2</sub>. Since the line AB passes through A, then
-c<sub>1</sub>=y<sub>A</sub>-m<sub>1</sub>x<sub>A</sub>. Similarly, as P is
-on line PF, then c<sub>2</sub>=y<sub>P</sub>-m<sub>2</sub>x<sub>P</sub>.
-Now point F is on both lines, therefore
-<a name="NWD21HcNW-O">y</a><sub>F</sub>=m<sub>2</sub>x<sub>F</sub>+c<sub>2</sub> and
-y<sub>F</sub>=m<sub>1</sub>x<sub>F</sub>+c<sub>1</sub>. Solving these
-equations for x<sub>F</sub> and y<sub>F</sub> gives:
-<center>
-x<sub>F</sub>=(c<sub>2</sub>-c<sub>1</sub>)/(m<sub>1</sub>-m<sub>2</sub>)<br>
-y<sub>F</sub>=(m<sub>1</sub>c<sub>2</sub>-m<sub>2</sub>c<sub>1</sub>)/
-(m<sub>1</sub>-m<sub>2</sub>)
-</center>
-
-<pre><a name="NW21HcNW-1GxwYt-1" href="#NWD21HcNW-O"><dfn>&lt;subroutine <tt>perpendicular</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
- 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) &lt; 0.0000001;
- $deltay = $yA - $yB;
- return ($xP, $yA) if abs($deltay) &lt; 0.0000001;
- $m1 = $deltay / $deltax;
- eval { $m2 = (-1) / $m1;};
- PrintFatalError(&quot;Division by zero&quot;,$lc) if $@;
- $c1 = $yA - $m1 * $xA;
- $c2 = $yP - $m2 * $xP;
- eval { $factor = 1 / ($m1 - $m2)};
- PrintFatalError(&quot;Division by zero&quot;,$lc) if $@;
- return (($c2 - $c1) * $factor, ($m1 * $c2 - $m2 * $c1) * $factor);
- }
-
-</pre><p> <a name="NWD21HcNW-P">The subroutine </a><code>Length</code> computes the distance between two points A and B.
-Notice, that the name of the subroutine starts with a capital L, just
-to avoid conflict with the predefined Perl function. The subroutine
-requires four parameters which are the coordinates of the two points.
-
-<pre><a name="NW21HcNW-4XEuZg-1" href="#NWD21HcNW-P"><dfn>&lt;subroutine <tt>Length</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
- sub Length {
- my ($xA, $yA, $xB, $yB)=@_;
- return sqrt(($xB - $xA)**2 + ($yB - $yA)**2);
- }
-
-</pre><p><a name="NWD21HcNW-Q">The subroutine </a><code>triangleArea</code> computes the area of a triangle by using
-Heron's formula, i.e., given a triangle ABC, we first compute
-s=(AB+BC+CA)/2 and then the area of the triangle is equal to the
-square root of s times (s-AB) times (s-BC) times (s-BA), where AB, BC, and CA
-are the lengths of the three sides of the triangle. The subroutine accepts 6
-parameters, which correspond to the coordinates of three points that define
-the triangle.
-
-<pre><a name="NW21HcNW-4DwBs6-1" href="#NWD21HcNW-Q"><dfn>&lt;subroutine <tt>triangleArea</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
- 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));
- }
-
-</pre><p><a name="NWD21HcNW-R">The subroutine </a><code>poinOnLine</code> accepts five arguments: the coordinates of two
-points and the decimal number which corresponds to the distance from the
-first point towards the second one. The way we compute the coordinates of
-the point is fairly simple.
-
-<pre><a name="NW21HcNW-VFnEE-1" href="#NWD21HcNW-R"><dfn>&lt;subroutine <tt>pointOnLine</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
- sub pointOnLine {
- my ($xA, $yA, $xB, $yB, $dist)=@_;
- my ($deltax, $deltay, $xPol, $yPol);
-
- $deltax = $xB - $xA;
- $deltay = $yB - $yA;
- $xPol = $xA + ($dist * $deltax / &amp;Length($xA,$yA,$xB,$yB));
- $yPol = $yA + ($dist * $deltay / &amp;Length($xA,$yA,$xB,$yB));
- return ($xPol, $yPol);
- }
-
-
-</pre><p>As we have mentioned above the subroutine <code>circumCircleCenter</code> takes six
-arguments that correspond to the coordinates of three points that
-define a triangle. The subroutine computes the coordinates of
-the center of a circle that passes through these three points, and the radius of
-the circle. We now describe how the subroutine computes the center
-of the circle and its radius. Let the triangle points be <code>t1</code>, <code>t2</code>
-and <code>t3</code>. We use the two pairs of points to define two sides,
-i.e., <code>t1t2</code> and <code>t2t3</code>. For each
-<a name="NWD21HcNW-S">side we locate the midpoints and get the their coordinates. We check</a>
-whether either of these two lines is either vertical or horizontal. If this
-is true, we know that one of the coordinates of the center of the circumcircle
-is the same as that of the midpoints of the horizontal or vertical line.
-Next, we determine the slopes of the lines <code>t1t2</code> and <code>t2t3</code>.
-We now determine the slope of lines at right-angles to these lines. We solve the
-resulting equations and obtain the center of the circumcircle. Now we get the
-radius, and then we are done.
-
-<pre><a name="NW21HcNW-lKNKf-1" href="#NWD21HcNW-S"><dfn>&lt;subroutine <tt>circumCircleCenter</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
-
- 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)) &lt; 0.0000001)
- {
- PrintErrorMessage(&quot;Area of triangle is zero!&quot;,$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) &lt; 0.0000001)
- {
- $xcc = $xs12;
- if (abs($deltax23) &lt; 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) &lt; 0.0000001)
- {
- $ycc = $ys12;
- if (abs($deltay23) &lt; 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) &lt; 0.0000001)
- {
- $xcc = $xs23;
- if (abs($deltax12) &lt; 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) &lt; 0.0000001)
- {
- $ycc = $ys23;
- if (abs($deltay12) &lt; 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 = &amp;Length($xA,$yA,$xB,$yB);
- $sideB = &amp;Length($xB,$yB,$xC,$yC);
- $sideC = &amp;Length($xC,$yC,$xA,$yA);
- $a = triangleArea($xA, $yA, $xB, $yB, $xC, $yC);
- $radius = ($sideA * $sideB * $sideC) / (4 * $a);
- #
- return ($xcc, $ycc, $radius);
- }
-
-</pre><p>The subroutine <code>ComputeDist</code> is used to compute a distance that is
-specified by either a float number, a pair of points, or a variable
-name. In case we have a pair of identifiers, we check whether the first
-one is a point. If it isn't a point we assume we have a variable followed
-by a keyword. Otherwise, i.e., if it is a point name, we check whether
-the second identifier is also a point name. If it is, we simply return
-the distance between them, otherwise we issue an error message.
-<a name="NWD21HcNW-T">If we have only a single identifier, we check whether it is a</a>
-variable that has already been defined, and if so we return its value.
- Since, this
-subroutine is heavily used, it actually returns a pair of numbers:
-the first one being the computed distance and the second one being an
-error indicator. If the value of this indicator is 0, then there is no
-error. If its value is 1, then there is an error. Moreover, in case there
-is an error the distance is assumed to be equal to zero.
-
-<pre><a name="NW21HcNW-3GSnCT-1" href="#NWD21HcNW-T"><dfn>&lt;subroutine <tt>ComputeDist</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
- 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,3}[^\W\d_]\d{0,3}/) #it is a pair of IDs?
- {
- s/^([^\W\d_]\d{0,3})//i;
- $v1 = $1;
- if (!exists($PointTable{lc($v1)})) {
- if (exists($VarTable{lc($v1)})) {
- return ($VarTable{lc($v1)}, 1);
- }
- PrintErrorMessage(&quot;Point $v1 has not been defined&quot;, $lc);
- s/^\s*[^\W\d_]\d{0,3}//i;
- return (0,0);
- }
- $v1 = lc($v1);
- s/^\s*([^\W\d_]\d{0,3})//i;
- $v2 = $1;
- if (!exists($PointTable{lc($v2)}))
- {
- PrintErrorMessage(&quot;Point $v2 has not been defined&quot;, $lc);
- return (0,0);
- }
- $v2 = lc($v2);
- my ($x1,$y1,$pSV1,$pS1) = unpack(&quot;d3A*&quot;,$PointTable{$v1});
- my ($x2,$y2,$pSV2,$pS2) = unpack(&quot;d3A*&quot;,$PointTable{$v2});
- return (Length($x1,$y1,$x2,$y2), 1);
- }
- elsif (s/^([^\W\d_]\d{0,3})//i) # it is a single id
- {
- $v1 = $1;
- if (!exists($VarTable{lc($v1)})) #it isn't a variable
- {
- PrintErrorMessage(&quot;Variable $v1 has not been defined&quot;, $lc);
- return (0,0);
- }
- return ($VarTable{lc($v1)}, 1);
- }
- else
- {
- PrintErrorMessage(&quot;Unexpected token&quot;, $lc);
- return (0,0);
- }
- }
-
-</pre><p><a name="NWD21HcNW-U">The subroutine </a><code>intersection4points</code> has 8 parameters that correspond to the
-coordinates of four points that uniquely determine two lines, and computes the
-the point of intersection of these two lines.
-
-<pre><a name="NW21HcNW-106ivL-1" href="#NWD21HcNW-U"><dfn>&lt;subroutine <tt>intersection4points</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
- 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) &lt; 0.0000001)
- {
- $ycc = $y1;
- if (abs($deltax34) &lt; 0.0000001)
- {
- $xcc = $x3;
- last I4PXYLINE;
- }
- else
- {
- $m34 = $deltay34 / $deltax34;
- $c34 = $y3 - $m34 * $x3;
- $xcc = ($ycc - $c34) / $m34;
- last I4PXYLINE;
- }
- }
- if (abs($deltax12) &lt; 0.0000001)
- {
- $xcc = $x1;
- if (abs($deltay34) &lt; 0.0000001)
- {
- $ycc = $y3;
- last I4PXYLINE;
- }
- else
- {
- $m34 = $deltay34 / $deltax34;
- $c34 = $y3 - $m34 * $x3;
- $ycc = $m34 * $xcc + $c34;
- last I4PXYLINE;
- }
- }
- if (abs($deltay34) &lt; 0.0000001)
- {
- $ycc = $y3;
- if (abs($deltax12) &lt; 0.0000001)
- {
- $xcc = $x1;
- last I4PXYLINE;
- }
- else
- {
- $m12 = $deltay12 / $deltax12;
- $c12 = $y1 - $m12 * $x1;
- $xcc = ($ycc - $c12) / $m12;
- last I4PXYLINE;
- }
- }
- if (abs($deltax34) &lt; 0.0000001)
- {
- $xcc = $x3;
- if (abs($deltay12) &lt; 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);
- }
-
-</pre><p>The subroutine <code>IncircleCenter</code> computes the center and the
-radius of the circle that is inside a triangle and touches the sides of
-the triangle. The subroutine has six arguments that correspond to the
-coordinates of three points that uniquely determine the triangle. Here are
-the details:
-<ul>
-<li> Let the triangle points be A, B, C and sides a, b, c, where side B
-is opposite angle B, etc. </li>
-<li> Use angles A and B only.</li>
-<li> Let the bisector of angle A meet side a in point A1, and let the
-distance of A1 from B be designated BA1</li>
-<li> Using the sine rule, one gets: BA1/c = a/(b+c), that is
-BA1 = c * a/(b+c).</li>
-<li> Now do the same for side b, and determine equivalent point B1.
-<a name="NWD21HcNW-V">CB1/a = b/(b+c), that is CB1 = a * b/(b+c).</a></li>
-<li> We can now find the intersection of the line from point A to point A1,
-and the line from point B to point B1. We have four points, so we use the
-mathspic internal <code>intersection4points</code> subroutine to return the
-coordinates of the intersection X<sub>i</sub>, Y<sub>i</sub>.</li>
-<li> Now get the radius: R=(area of triangle)/(a+b+c)/2</li>
-<li>Finally, return the radius and the coordinates of the center.
-</ul>
-
-<pre><a name="NW21HcNW-Kxdzt-1" href="#NWD21HcNW-V"><dfn>&lt;subroutine <tt>IncircleCenter</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
- 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) = &amp;intersection4points($Ax, $Ay, $xA1, $yA1,
- $Bx, $By, $xB1, $yB1);
- # get radius
- $a = &amp;triangleArea($Ax, $Ay, $Bx, $By, $Cx, $Cy);
- $s = ($sideA + $sideB +$sideC) / 2;
- $r = $a / $s;
- return ($xcenter, $ycenter, $r);
- }
-
-</pre><p><a name="NWD21HcNW-W">The subroutine </a><code>Angle</code> takes six arguments which correspond to the
-coordinates of three points that define an angle. The subroutine computes
-the opening of the angle in degrees. In case there is an error it returns
-the number -500. ****EXPLAIN THE ALGORITHM****
-
-<pre><a name="NW21HcNW-3xteda-1" href="#NWD21HcNW-W"><dfn>&lt;subroutine <tt>Angle</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
- 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 &lt; 0.0000001)
- {
- return -500;
- }
- $deltax = $RBx - $RCx;
- $deltay = $RBy - $RCy;
- $lineBC = sqrt($deltax*$deltax + $deltay*$deltay);
- if ($lineBC &lt; 0.0000001)
- {
- return -500;
- }
- $deltax = $RAx - $RCx;
- $deltay = $RAy - $RCy;
- $lineAC = sqrt($deltax*$deltax + $deltay*$deltay);
- if ($lineAC &lt; 0.0000001)
- {
- return -500;
- }
- $k = ($lineBA*$lineBA + $lineBC*$lineBC - $lineAC*$lineAC ) /
- (2 * $lineBA * $lineBC);
- $k = -1 if $k &lt; -0.99999;
- $k = 1 if $k &gt; 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;
- }
-
-</pre><p>The subroutine <code>excircle</code> computes the center and the radius of a circle that
-externally touches a given side (4th and 5th arguments) of triangle (determined
-by the 1rst, the 2nd and 3rd argument). Here are the details:
-<ul>
-<li> Let the triangle points be A, B, C, and the given side be BC.</li>
-<li> Now calculate the radius of Excircle = (triangle area)/(s - side length),
-where s = (a+b+c)/2</li>
-<li><a name="NWD21HcNW-X">Calculate the distance from the angle (A) (opposite the given side BC)</a>
- to the excircle center = radius/sin(A/2)</li>
-<li> Now determine the the Excircle center by locating it on the angle bisector
-(i.e., same line that the IncircleCenter is on), but at distance d further
-away from angle A. So, we now have the Incircle center (I),
- determine deltaX and deltaY from I to A, calculate the distance AI,
- and then extend the line from I by distance d to Excenter Xc, Yc.</li>
-</ul>
-
-<pre><a name="NW21HcNW-cchrT-1" href="#NWD21HcNW-X"><dfn>&lt;subroutine <tt>excircle</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
- sub excircle {
- my ($A, $B, $C, $D, $E) = @_;
- my ($Ax,$Ay,$Bx,$By,$Dx,$Dy,$Ex,$Ey,$ASVA,$ASA);
- ($Ax,$Ay,$ASVA,$ASA)=unpack(&quot;d3A*&quot;,$PointTable{$A});
- ($Bx,$By,$ASVA,$ASA)=unpack(&quot;d3A*&quot;,$PointTable{$B});
- ($Cx,$Cy,$ASVA,$ASA)=unpack(&quot;d3A*&quot;,$PointTable{$C});
- ($Dx,$Dy,$ASVA,$ASA)=unpack(&quot;d3A*&quot;,$PointTable{$D});
- ($Ex,$Ey,$ASVA,$ASA)=unpack(&quot;d3A*&quot;,$PointTable{$E});
- my ($sideA, $sideB, $sideC, $s, $R, $theAdeg, $d);
- my ($Xmypoint, $Ymypoint, $deltax, $deltay, $mylength, $xc, $yc);
-
- $sideA = &amp;Length($Bx, $By, $Cx, $Cy);
- $sideB = &amp;Length($Cx, $Cy, $Ax, $Ay);
- $sideC = &amp;Length($Ax, $Ay, $Bx, $By);
- $s = ($sideA + $sideB + $sideC) / 2;
- $R = triangleArea($Ax, $Ay, $Bx, $By, $Cx, $Cy) /
- ($s - &amp;Length($Dx, $Dy, $Ex, $Ey));
- if (($D eq $A &amp;&amp; $E eq $B) || ($D eq $B &amp;&amp; $E eq $A))
- {
- $theAdeg = &amp;Angle($Bx, $By, $Cx, $Cy, $Ax, $Ay);
- $Xmypoint = $Cx;
- $Ymypoint = $Cy;
- }
- elsif (($D eq $B &amp;&amp; $E eq $C) || ($D eq $C &amp;&amp; $E eq $B))
- {
- $theAdeg = &amp;Angle($Cx, $Cy, $Ax, $Ay, $Bx, $By);
- $Xmypoint = $Ax;
- $Ymypoint = $Ay;
- }
- elsif (($D eq $C &amp;&amp; $E eq $A) || ($D eq $A &amp;&amp; $E eq $C))
- {
- $theAdeg = &amp;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) = &amp;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);
- }
-
-</pre><p>The <code>DrawLineOrArrow</code> subroutine is used to parse the arguments of the commands
-<code>drawline</code>, <code>drawthickline</code>, <code>drawarrow</code>, <code>drawthickarrow</code> and
-<code>drawCurve</code>. In general, these commands have as arguments a list of points separated by
-commas that are used to draw a set of lines. The list of points is
-enclosed in parentheses. Here we give only the syntax of the <code>drawline</code>
-comma, as the syntax of the other commands is identical:
-<pre>
- drawline ::= "drawline" "(" Points { "," Points } ")"
- Points ::= Point { separator Point}
- separator ::= blank | empty
-</pre>
-<a name="NWD21HcNW-Y">In the following code we</a>
-scan a list of points (possibly separated by blanks) and we stop when
-we encounter either a comma or some other character. In case we have found
-a comma, we check whether we have a <code>drawline</code> command and if this is
-the case we plot the list of points. We continue with the next list of points,
-until there are no more points. The inner while-loop is used to control the
-consumption of point tokens and the external to reset the array <code>PP</code> which
-holds the point names.
-
-<pre><a name="NW21HcNW-cviH2-1" href="#NWD21HcNW-Y"><dfn>&lt;subroutine <tt>DrawLineOrArrow</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
- 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 &lt;= 0) {
-# PrintErrorMessage(&quot;length must greater than zero&quot;,$lc);
-# $lineLength = -1;
-# }
-# chk_rsb(&quot;optional part&quot;,$lc);
-# }
-# }
- chk_lparen(&quot;$cmd&quot;,$lc);
- DRAWLINES:while(1) {
- @PP = () ;
- while(1) {
- if (s/^([^\W\d_]\d{0,3})\s*//i) { #point name
- $P = $1;
- if (!exists($PointTable{lc($P)})) {
- PrintErrorMessage(&quot;Undefined point $P&quot;,$lc);
- }
- else {
- push (@PP,$P);
- }
- }
- else {
- $stacklen = @PP;
- if ($draw_Line != 2) {
- if ($stacklen &lt;= 1) {
- PrintErrorMessage(&quot;Wrong number of points&quot;,$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 &lt; 2) {
- PrintErrorMessage(&quot;Wrong number of points&quot;,$lc);
- }
- elsif ($stacklen % 2 == 0) {
- PrintErrorMessage(&quot;Number of points must be odd&quot;,$lc);
- }
- else {
- drawCurve(@PP);
- }
- }
- chk_rparen(&quot;arguments of $cmd&quot;,$lc);
- chk_comment($lc);
- }
-
-</pre><p>The subroutine <code>drawarrows</code> is used to draw one or more lines. The subroutine
-accepts as argument an array which contains the names of the points which
-<a name="NWD21HcNW-Z">define the lines, plus the current program line number. Each arrow is printed</a>
-using the following code:
-<center>
-<tt>\arrow < </tt>ArrowLength <tt> mm> [</tt> beta <tt>,</tt> gamma <tt>] from
-x1 y1 to x2 y2 </tt>
-</center>
-where beta is equal to tan(<code>$arrowAngleB</code> * <code>d2r</code> /2) and gamma is equal to
-2*tan(<code>$arrowAngleC</code> * <code>d2r</code> / 2).
-
-<pre><a name="NW21HcNW-4STZZz-1" href="#NWD21HcNW-Z"><dfn>&lt;subroutine <tt>drawarrows</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
- 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 &lt; $NumberOfPoints - 1; $i++)
- {
- $p = $_[$i];
- $q = $_[$i+1];
- ($px,$py,$pSV,$pS) = unpack(&quot;d3A*&quot;,$PointTable{lc($p)});
- ($qx,$qy,$qSV,$qS) = unpack(&quot;d3A*&quot;,$PointTable{lc($q)});
- $pSV = $defaultLFradius if $pSV == 0;
- $qSV = $defaultLFradius if $qSV == 0;
- $r12 = $pSV + $qSV;
- $d12 = Length($px,$py,$qx,$qy);
- if ($d12 &lt;= $r12)
- {
- if($d12 == 0)
- {
- PrintErrorMessage(&quot;points $p and $q are the same&quot;, $lc);
- next LOOP;
- }
- PrintWarningMessage(&quot;arrow $p$q not drawn: points too close or &quot;.
- &quot;radii too big&quot;, $lc);
- next LOOP;
- }
- ($px, $py) = pointOnLine($px, $py, $qx, $qy, $pSV) if $pSV &gt; 0;
- ($qx, $qy) = pointOnLine($qx, $qy, $px, $py, $qSV) if $qSV &gt; 0;
- my ($beta, $gamma);
- $beta = tan($arrowAngleB * D2R / 2);
- $gamma = 2 * tan($arrowAngleC * D2R / 2);
- printf OUT &quot;\\arrow &lt;%.5f%s&gt; [%.5f,%.5f] from %.5f %.5f to %.5f %.5f\n&quot;,
- $arrowLength, $arrowLengthUnits, $beta, $gamma, $px, $py, $qx, $qy;
- }
- }
-
-</pre><p>The subroutine <code>drawlines</code> is used to draw one or more lines. The subroutine
-accepts as argument an array which contains the names of the points which
-define the lines, plus the current program line number. If there are only
-two points (i.e., only one line), then we output the following PiCTeX code:
-<center>
-<tt> \plot x1 y1 x2 y2 / %% pointname1 pointname2</tt>
-</center>
-If there are more than two points, then we need to write the PiCTeX code in
-pairs with two points on each line (just to keep things simple) as follows:
-<center>
-<tt> \plot x1 y1 x2 y2 / %% pointname1 pointname2</tt>
-<tt> \plot x2 y2 x3 y3 / %% pointname2 pointname3</tt>
-<tt> \plot x3 y3 x4 y4 / %% pointname3 pointname4</tt>
-</center>
-<a name="NWD21HcNW-a">An important part of the subroutine is devoted to checking whether either</a>
-or both of the pairs of points are associated with a line-free zone, and if
-so, then we must take care not to draw the line inside the line-free zone. If
-a point does have a line-free zone, then we use the <code>pointOnLine</code>
-subroutine to determine the point on the line which is just on the line-free
-boundary, and draw the line to the that point instead of to the exact
-point-location.
-
-<pre><a name="NW21HcNW-3KtTfB-1" href="#NWD21HcNW-a"><dfn>&lt;subroutine <tt>drawlines</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
- 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 &lt; $NumberOfPoints - 1; $i++)
- {
- $p = $_[$i];
- $q = $_[$i+1];
- ($px,$py,$pSV,$pS) = unpack(&quot;d3A*&quot;,$PointTable{lc($p)});
- ($qx,$qy,$qSV,$qS) = unpack(&quot;d3A*&quot;,$PointTable{lc($q)});
- $pSV = $defaultLFradius if $pSV == 0;
- $qSV = $defaultLFradius if $qSV == 0;
- $r12 = $pSV + $qSV;
- $d12 = Length($px,$py,$qx,$qy);
- if ($d12 &lt;= $r12)
- {
- if($d12 == 0)
- {
- PrintErrorMessage(&quot;points $p and $q are the same&quot;, $lc);
- next LOOP;
- }
- PrintWarningMessage(&quot;line $p$q not drawn: points too close or &quot;.
- &quot;radii too big&quot;, $lc);
- next LOOP;
- }
- ($px, $py) = pointOnLine($px, $py, $qx, $qy, $pSV) if $pSV &gt; 0;
- ($qx, $qy) = pointOnLine($qx, $qy, $px, $py, $qSV) if $qSV &gt; 0;
- if ($px == $qx || $py == $qy)
- {
- printf OUT &quot;\\putrule from %.5f %.5f to %.5f %.5f %%%% %s%s\n&quot;,
- $px,$py,$qx,$qy,$p,$q;
- }
- else
- {
- printf OUT &quot;\\plot %.5f %.5f\t%.5f %.5f / %%%% %s%s\n&quot;,
- $px, $py,$qx,$qy,$p,$q;
- }
- }
- }
-
-</pre><p>The subroutine <code>drawCurve</code> is used to draw a curve that passes through an odd
-number of points. The subroutine has as argument an array which contains the names of the
-points which define the lines plus the current program line number. The subroutine
-emits code that has the following general form:
-<pre>
- <a name="NWD21HcNW-b">\setquadratic</a>
- \plot
- X1 Y1
- X2 Y2
- X3 Y3
- \setlinear
-</pre>
-
-
-<pre><a name="NW21HcNW-3c2Tgd-1" href="#NWD21HcNW-b"><dfn>&lt;subroutine <tt>drawCurve</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
- sub drawCurve {
- my ($NoArgs);
- $NoArgs = @_;
- my ($lc) = $_[$NoArgs-1]; #line number is the last argument
- my ($NumberOfPoints, $p);
-
- $NumberOfPoints = $NoArgs - 1;
- print OUT &quot;\\setquadratic\n\\plot\n&quot;;
- for(my $i=0; $i &lt;= $NumberOfPoints; $i++)
- {
- $p = $_[$i];
- my ($px,$py,$pSV,$pS) = unpack(&quot;d3A*&quot;,$PointTable{lc($p)});
- printf OUT &quot;\t%0.5f %0.5f&quot;, $px, $py;
- print OUT (($i == $NumberOfPoints) ? &quot; / %$p\n&quot; : &quot; %$p\n&quot;);
- }
- print OUT &quot;\\setlinear\n&quot;;
- }
-
-</pre><p>The subroutine <code>drawpoints</code> is used to draw one or more points. The subroutine
-<a name="NWD21HcNW-c">has as arguments a list of points. For each point we produce code that has</a>
-the following general form:
-<center>
-<tt> \put {SYMBOL} at Px PY</tt>
-</center>
-where <code>SYMBOL</code> is either the default plot symbol, i.e., <code>$\bullet$</code>,
-whatever the user has set with the <code>PointSymbol</code> command, or the plot
-symbol specified in the definition of the point.
-
-<pre><a name="NW21HcNW-1NgToL-1" href="#NWD21HcNW-c"><dfn>&lt;subroutine <tt>drawpoints</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
- sub drawpoints {
- my ($NumberOfPoints,$p);
- $NumberOfPoints = @_;
- my ($px,$py,$pSV,$pS);
-
- for($i=0; $i &lt; $NumberOfPoints; $i++)
- {
- $p = $_[$i];
- ($px,$py,$pSV,$pS) = unpack(&quot;d3A*&quot;,$PointTable{lc($p)});
- if ($pS eq &quot;&quot; and $defaultsymbol =~ /circle|square/) {
- $pS = $defaultsymbol;
- }
- POINTSWITCH: {
- if ($pS eq &quot;&quot;) # no plot symbol specified
- {
- printf OUT &quot;\\put {%s} at %.5f %.5f %%%% %s\n&quot;,
- $defaultsymbol, $px, $py, $p;
- last POINTSWITCH;
- }
- if ($pS eq &quot;circle&quot;) # plot symbol is a circle
- {
- my $radius = (defined($DimOfPoint{lc($p)})) ? $DimOfPoint{lc($p)} :
- $GlobalDimOfPoints;
- if ($radius &gt; 0) # draw a circle using the current units
- {
- if ($radius == 1.5) # use \bigcirc
- {
- printf OUT &quot;\\put {\$\\bigcirc\$} at %.5f %.5f %%%% %s\n&quot;,
- $px, $py, $p;
- }
- else
- {
- printf OUT &quot;\\circulararc 360 degrees from %.5f %.5f center at %.5f %.5f %%%% %s\n&quot;,
- $px+$radius, $py, $px, $py, $p;
- }
- }
- else #use \circ symbol
- {
- printf OUT &quot;\\put {\$\\circ\$} at %.5f %.5f %%%% %s\n&quot;,
- $px,$py,$p;
- }
- last POINTSWITCH;
- }
- if ($pS eq &quot;square&quot;)
- {
- my $side = (defined($DimOfPoint{lc($p)})) ? $DimOfPoint{lc($p)} :
- $GlobalDimOfPoints;
- printf OUT &quot;\\put {%s} at %.5f %.5f %%%% %s\n&quot;,
- drawsquare($side), $px, $py, $p;
- last POINTSWITCH;
- }
- printf OUT &quot;\\put {%s} at %.5f %.5f %%%% %s\n&quot;, $pS,$px,$py,$p;
- }
- }
- }
-
-</pre><p>The subroutine <code>drawAngleArc</code> gets six arguments which correspond to
-three points defining an angle (variables <code>$P1</code>, <code>$P2</code> and <code>$P3</code>),
-the radius, the internal/external specification and the direction
-specification (clockwise or anticlockwise).
-Depending on the values of these arguments, the subroutine
-returns the corresponding PiCTeX code, the general format of
-which is <pre>
- \circulararc Angle degrees from x y center at x2 y2
-</pre>
-<a name="NWD21HcNW-d">where </a><code>Angle</code> is the angle that the three points P1 P2 P3 define
-(computed by subroutine <code>Angle</code>),
-and <code>x</code> and <code>y</code> are the coordinates of a point
-residing on line P2P1 at distance equal to a <code>$radius</code> from
-point <code>$P2</code>; and <code>x2</code>, <code>y2</code> are the coordinates of the
-center of the circle about which the arc is drawn,
-i.e., point <code>$P2</code>.
-
-<pre><a name="NW21HcNW-497AQD-1" href="#NWD21HcNW-d"><dfn>&lt;subroutine <tt>drawAngleArc</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
-sub drawAngleArc {
- my ($P1, $P2, $P3, $radius, $inout, $direction) = @_;
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$P1});
- my ($x2,$y2,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$PointTable{$P2});
- my ($x3,$y3,$pSV3,$pS3)=unpack(&quot;d3A*&quot;,$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 = &quot;&quot;;
- if ($inout eq &quot;internal&quot; and $direction eq &quot;clockwise&quot; ) {
- $code = sprintf &quot;\\circulararc %.5f degrees from %.5f %.5f center at %.5f %.5f\n&quot;,
- -1 * $internalAngle, $x, $y, $x2, $y2;
- }
- elsif ($inout eq &quot;internal&quot; and $direction eq &quot;anticlockwise&quot; ) {
- $code = sprintf &quot;\\circulararc %.5f degrees from %.5f %.5f center at %.5f %.5f\n&quot;,
- $internalAngle, $x, $y, $x2, $y2;
- }
- elsif ($inout eq &quot;external&quot; and $direction eq &quot;clockwise&quot; ) {
- $code = sprintf &quot;\\circulararc %.5f degrees from %.5f %.5f center at %.5f %.5f\n&quot;,
- -1 * $externalAngle, $x, $y, $x2, $y2;
- }
- elsif ($inout eq &quot;external&quot; and $direction eq &quot;anticlockwise&quot; ) {
- $code = sprintf &quot;\\circulararc %.5f degrees from %.5f %.5f center at %.5f %.5f\n&quot;,
- $externalAngle, $x, $y, $x2, $y2;
- }
- return $code;
-}
-
-</pre><p><a name="NWD21HcNW-e">The subroutine </a><code>drawAngleArrow</code> gets six arguments which correspond to
-three points defining an angle (variables <code>$P1</code>, <code>$P2</code> and <code>$P3</code>),
-the radius, the internal/external specification and the direction
-specification. The subroutine mainly draws the arrowhead, and
-calls the subroutine <code>drawAngleArc</code> to draw the
-arc part of the arrow.
-
-<pre><a name="NW21HcNW-4UPwva-1" href="#NWD21HcNW-e"><dfn>&lt;subroutine <tt>drawAngleArrow</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
-sub drawAngleArrow {
- my ($P1, $P2, $P3, $radius, $inout, $direction) = @_;
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$P1});
- my ($x2,$y2,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$PointTable{$P2});
- my ($x3,$y3,$pSV3,$pS3)=unpack(&quot;d3A*&quot;,$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) &lt; 0.00001) {
- if ($deltax &gt; 0 ) {$thetaqr = 0 }
- elsif ($deltax &lt; 0) {$thetaqr = -180}
- }
- else {
- if (abs($deltax) &lt; 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) &lt; 0.00001) {
- if ($deltay &gt; 0) { $thetaqr = 90 }
- elsif ($deltay &lt; 0) { $thetaqr = - 90 }
- last LINE2;
- }
- else {
- $thetaqr = atan2($deltay / $deltax, 1) * R2D;
- }
- if (abs($deltay) &lt; 0.00001) {
- if ($deltax &gt; 0) { $thetaqr = 0 }
- elsif ($deltax &lt; 0) { $thetaqr = -180 }
- last LINE2;
- }
- else {
- $thetaqr = atan2($deltay / $deltax, 1) * R2D;
- }
- if ($deltax &lt; 0 and $deltay &gt; 0) { $thetaqr += 180 }
- elsif ($deltax &lt; 0 and $deltay &lt; 0) { $thetaqr += 180 }
- elsif ($deltax &gt; 0 and $deltay &lt; 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 &quot;internal&quot; and $direction eq &quot;clockwise&quot;) {
- $code .= sprintf &quot;\\arrow &lt;1.5mm&gt; [0.5, 1] from %.5f %.5f to %.5f %.5f\n&quot;,
- $xqrleft, $yqrleft, $xqr, $yqr;
- }
- elsif ($inout eq &quot;internal&quot; and $direction eq &quot;anticlockwise&quot;) {
- $code .= sprintf &quot;\\arrow &lt;1.5mm&gt; [0.5, 1] from %.5f %.5f to %.5f %.5f\n&quot;,
- $xqrright, $yqrright, $xqr, $yqr;
- }
- elsif ($inout eq &quot;external&quot; and $direction eq &quot;clockwise&quot;) {
- $code .= sprintf &quot;\\arrow &lt;1.5mm&gt; [0.5, 1] from %.5f %.5f to %.5f %.5f\n&quot;,
- $xqrleft, $yqrleft, $xqr, $yqr;
- }
- elsif ($inout eq &quot;external&quot; and $direction eq &quot;anticlockwise&quot;) {
- $code .= sprintf &quot;\\arrow &lt;1.5mm&gt; [0.5, 1] from %.5f %.5f to %.5f %.5f\n&quot;,
- $xqrright, $yqrright, $xqr, $yqr;
- }
- return $code;
-}
-
-</pre><p>The subroutine <code>expr</code> is used to parse an expression. We are using a
-recursive descent parser to parse and evaluate an expression. The
-general syntax of an expression is as follows:
-<pre>
-expr ::= term { addop term }
-addop ::= "+" | "-"
-term ::= factor { mulop factor }
-mulop ::= "*" | "/" | "rem"
-factor ::= primitive [ ** factor ]
-primitive ::= [ "+" | "-"] primitive | number | variable |
- pair-of-points | "(" expr ")" |
- "sin (" expr ")" | "cos (" expr ")" | "area (" ThreePoints ")" |
- "tan (" expr ")" | "exp (" expr ")" | "int" "(" expr ")" |
- "log (" expr ")" | "atan (" expr ")" | "sgn" "(" expr ")" |
- <a name="NWD21HcNW-f">"sqrt (" expr ")" | "acos (" expr ")" | "asin (" expr ")" |</a>
- "atan (" expr ")" | "_pi_" | "_e_" |
- "xcoord (" point ")" | "ycoord (" point ")" | "angle "(" ThreePoints ")"|
- "angledeg" "(" ThreePoints ")" | "direction" "(" TwoPoints ")" |
- "directiondeg" "(" TwoPoints ")" | "_linethickness_"
-</pre>
-Note that <code>_pi_</code> and <code>_e_</code> can be used to access the value of the constants
-Pi and e.
-
-<pre><a name="NW21HcNW-1aVxdI-1" href="#NWD21HcNW-f"><dfn>&lt;subroutine <tt>expr</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
-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/^([+-])// &amp;&amp; $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(&quot;Division by zero&quot;, $lc) if $@;
- }
- else {
- eval {$left /= $right};
- PrintFatalError(&quot;Division by zero&quot;, $lc) if $@;
- }
- }
- return $left;
-}
-
-sub mulop {
- (s#^([*/])## || s/^(rem)//i) &amp;&amp; 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(&quot;Missing right parenthesis&quot;, $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(&quot;angledeg&quot;,$lc);
- my $point_1 = get_point($lc);
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$point_1});
- my $point_2 = get_point($lc);
- my ($x2,$y2,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$PointTable{$point_2});
- my $point_3 = get_point($lc);
- my ($x3,$y3,$pSV3,$pS3)=unpack(&quot;d3A*&quot;,$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(&quot;points `$point_1' and `$point_2' are the same&quot;, $lc);
- $val = 0;
- }
- elsif ( $d23 == 0 ) {
- PrintErrorMessage(&quot;points `$point_2' and `$point_3' are the same&quot;, $lc);
- $val = 0;
- }
- elsif ( $d31 == 0 ) {
- PrintErrorMessage(&quot;points `$point_1' and `$point_3' are the same&quot;, $lc);
- $val = 0;
- }
- else {
- $val = Angle($x1, $y1, $x2, $y2, $x3, $y3);
- $val = 0 if $val == -500;
- }
- chk_rparen(&quot;Missing right parenthesis&quot;, $lc);
- }
- elsif (s/^angle//i) {
- chk_lparen(&quot;angle&quot;.$lc);
- my $point_1 = get_point($lc);
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$point_1});
- my $point_2 = get_point($lc);
- my ($x2,$y2,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$PointTable{$point_2});
- my $point_3 = get_point($lc);
- my ($x3,$y3,$pSV3,$pS3)=unpack(&quot;d3A*&quot;,$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(&quot;points `$point_1' and `$point_2' are the same&quot;, $lc);
- $val = 0;
- }
- elsif ( $d23 == 0 ) {
- PrintErrorMessage(&quot;points `$point_2' and `$point_3' are the same&quot;, $lc);
- $val = 0;
- }
- elsif ( $d31 == 0 ) {
- PrintErrorMessage(&quot;points `$point_1' and `$point_3' are the same&quot;, $lc);
- $val = 0;
- }
- else {
- $val = Angle($x1, $y1, $x2, $y2, $x3, $y3);
- if ($val == -500) {
- $val = 0;
- }
- else {
- $val = D2R * $val;
- }
- }
- chk_rparen(&quot;Missing right parenthesis&quot;, $lc);
- }
- elsif (s/^area//i) {
- chk_lparen(&quot;angledeg&quot;,$lc);
- my $point_1 = get_point($lc);
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$point_1});
- my $point_2 = get_point($lc);
- my ($x2,$y2,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$PointTable{$point_2});
- my $point_3 = get_point($lc);
- my ($x3,$y3,$pSV3,$pS3)=unpack(&quot;d3A*&quot;,$PointTable{$point_3});
- $val = triangleArea($x1, $y1, $x2, $y2, $x3, $y3);
- chk_rparen(&quot;Missing right parenthesis&quot;, $lc);
- }
- elsif (s/^asin//i) {
- chk_lparen(&quot;asin&quot;);
- $val = expr();
- PrintFatalError(&quot;Can't take asin of $val&quot;, $lc) if $val &lt; -1 || $val &gt; 1;
- $val = asin($val);
- chk_rparen(&quot;Missing right parenthesis&quot;, $lc);
- }
- elsif (s/^acos//i) {
- chk_lparen(&quot;acos&quot;);
- $val = expr();
- PrintFatalError(&quot;Can't take acos of $val&quot;, $lc) if $val &lt; -1 || $val &gt; 1 ;
- $val = acos($val);
- chk_rparen(&quot;Missing right parenthesis&quot;, $lc);
- }
- elsif (s/^atan//i) {
- chk_lparen(&quot;atan&quot;);
- $val = expr();
- $val = atan($val);
- chk_rparen(&quot;Missing right parenthesis&quot;, $lc);
- }
- elsif (s/^cos//i) {
- chk_lparen(&quot;cos&quot;);
- $val = expr();
- $val = cos($val);
- chk_rparen(&quot;Missing right parenthesis&quot;, $lc);
- }
- elsif (s/^directiondeg//i) {
- chk_lparen(&quot;directiondeg&quot;,$lc);
- my $point_1 = get_point($lc);
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$point_1});
- my $point_2 = get_point($lc);
- my ($x2,$y2,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$PointTable{$point_2});
- my $x3 = $x1+1;
- if ( ($y2 - $y1) &gt;= 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(&quot;Missing right parenthesis&quot;, $lc);
- }
- elsif (s/^direction//i) {
- chk_lparen(&quot;direction&quot;,$lc);
- my $point_1 = get_point($lc);
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$point_1});
- my $point_2 = get_point($lc);
- my ($x2,$y2,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$PointTable{$point_2});
- my $x3 = $x1+1;
- if ( ($y2 - $y1) &gt;= 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(&quot;Missing right parenthesis&quot;, $lc);
- }
- elsif (s/^exp//i) {
- chk_lparen(&quot;exp&quot;);
- $val = expr();
- $val = exp($val);
- chk_rparen(&quot;Missing right parenthesis&quot;, $lc);
- }
- elsif (s/^int//i) {
- chk_lparen(&quot;int&quot;);
- $val = expr();
- $val = int($val);
- chk_rparen(&quot;Missing right parenthesis&quot;, $lc);
- }
- elsif (s/^log//i) {
- chk_lparen(&quot;log&quot;);
- $val = expr();
- PrintFatalError(&quot;Can't take log of $val&quot;, $lc) if $val &lt;= 0;
- $val = log($val);
- chk_rparen(&quot;Missing right parenthesis&quot;, $lc);
- }
- elsif (s/^sin//i) {
- chk_lparen(&quot;sin&quot;);
- $val = expr();
- $val = sin($val);
- chk_rparen(&quot;Missing right parenthesis&quot;, $lc);
- }
- elsif (s/^sgn//i) {
- chk_lparen(&quot;sgn&quot;);
- $val = expr();
- if ($val &gt; 0) {
- $val = 1;
- }
- elsif ($val == 0) {
- $val = 0;
- }
- else {
- $val = -1;
- }
- chk_rparen(&quot;Missing right parenthesis&quot;, $lc);
- }
- elsif (s/^sqrt//i) {
- chk_lparen(&quot;sqrt&quot;);
- $val = expr();
- $val = sqrt($val);
- chk_rparen(&quot;Missing right parenthesis&quot;, $lc);
- }
- elsif (s/^tan//i) {
- chk_lparen(&quot;tan&quot;);
- $val = expr();
- $val = sin($val)/cos($val);
- chk_rparen(&quot;Missing right parenthesis&quot;, $lc);
- }
- elsif (s/^xcoord//i) {
- chk_lparen(&quot;xcoord&quot;);
- my $point_name = get_point;
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$point_name});
- $val = $x1;
- chk_rparen(&quot;Missing right parenthesis&quot;, $lc);
- }
- elsif (s/^ycoord//i) {
- chk_lparen(&quot;ycoord&quot;);
- my $point_name = get_point;
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$point_name});
- $val = $y1;
- chk_rparen(&quot;Missing right parenthesis&quot;, $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;
-}
-
-</pre><p><a name="NWD21HcNW-g">The subroutine </a><code>memberOf</code> is used to check whether a string is part of
-a list of strings. We assume that the first argument is the string in
-question. We compare each list element against the string in question and
-if we find it we stop and return the value <code>1</code> (denoting truth). Otherwise,
-we simply return the value <code>0</code> (denoting false).
-
-<pre><a name="NW21HcNW-2tc9Fr-1" href="#NWD21HcNW-g"><dfn>&lt;subroutine <tt>memberOf</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
-sub memberOf {
- my $elem = shift(@_);
-
- my $found = 0;
- foreach $item (@_){
- if ($item eq $elem){
- $found = 1;
- last;
- }
- }
- return $found;
-}
-
-</pre><p><a name="NWD21HcNW-h">The subroutine </a><code>tand</code> computes the tangent of an angle. The angle is
-supposed to be in degrees. We simply transform it into radians and then
-compute the actual result.
-
-<pre><a name="NW21HcNW-22jtMr-1" href="#NWD21HcNW-h"><dfn>&lt;subroutine <tt>tand</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
-sub tand {
- my $d = $_[0];
- $d = $d * PI / 180;
- return sin($d)/cos($d);
-}
-
-</pre><p>The subroutine <code>get_string</code> is used to extract a leading valid mathspic string
-from the input line. A string must start with a quotation mark, i.e., <code>&quot;</code>,
-and must end with the same symbol. A string may contain quotation marks which
-must be escaped with a backslash, i.e., <code>\</code>. Initially, we remove all
-leading white space. If the next character of the string is not a quotation
-mark we print an error message and stop. Otherwise, we split the string into
-an array of characters and store the characters up to the next quotation
-mark to the array <code>@cmd</code>. In case the next character is a backslash and
-we aren't at the end of the input string and the next character is a
-quotation mark, we have an escape sequence. This means that we store these
-two characters in the <code>@cmd</code> array and skip to characters after the quotation
-mark. Otherwise, we simply store the character in the <code>@cmd</code> array and
-<a name="NWD21HcNW-i">skip to the next character. This process is repeated until either we consume</a>
-all the characters of the string or until we find a sole quotation mark.
-Since we are not sure what has forced the loop to exit, we check whether
-there are still characters in the input string and we check whether this
-is a quotation mark. If these tests fail we have a string without a
-closing quotation mark. In all cases we return a triplet consisting of
-a number denoting success (1) or failure (0) and what we have consumed
-from the input string, and what is left from the input string.
-
-<pre><a name="NW21HcNW-ufkvF-1" href="#NWD21HcNW-i"><dfn>&lt;subroutine <tt>get_string</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
-sub get_string {
- my $string = shift;
- my $lc = shift;
-
- $string =~ s/^\s+//;
- if ($string !~ s/^\&quot;//) {
- PrintErrorMessage(&quot;No starting \&quot; found&quot;,$lc);
- return (1,$string,$string);
- }
- my @ch = split //,$string;
- my @cmd;
- while (@ch and $ch[0] ne &quot;\&quot;&quot;) {
- if ($ch[0] eq &quot;\\&quot; and (defined $ch[1]) and $ch[1] eq &quot;\&quot;&quot;) {
- shift @ch;
- push @cmd, $ch[0];
- shift @ch;
- }
- else {
- push @cmd, $ch[0];
- shift @ch;
- }
- }
- if (! defined $ch[0]) {
- PrintErrorMessage(&quot;No closing \&quot; found&quot;,$lc);
- return (1,join(&quot;&quot;,@cmd), join(&quot;&quot;,@ch))
- }
- else {
- shift @ch;
- return (0, join(&quot;&quot;,@cmd), join(&quot;&quot;,@ch))
- }
-}
-
-</pre><p><a name="NWD21HcNW-j">The definition as well as an explanation of the functionality of the</a>
-following subroutine can be found in "Programming Perl", 3rd edition.
-
-<pre><a name="NW21HcNW-1MGdDt-1" href="#NWD21HcNW-j"><dfn>&lt;subroutine <tt>is_tainted</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
-sub is_tainted {
- my $arg = shift;
- my $nada = substr($arg,0,0);
- local $@;
- eval { eval &quot;# $nada&quot;};
- return length($@) != 0;
-}
-
-</pre><p><a name="NWD21HcNW-k">The subroutine </a><code>noOfDigits</code> has one argument which is a number and returns
-the number of decimal digits it has. If the number matches the regular
-expression <code>^\d+(?!\.)</code> (a series of digits <i>not</i> followed by a
-period), then the number of decimal digits is zero. If the
-number matches the
-regular expression <code>^\d+\.(\d+)?</code>, then number of decimal digits equals
-<code>length($1)</code>. Naturally, it maybe zero!
-
-<pre><a name="NW21HcNW-3mBo7s-1" href="#NWD21HcNW-k"><dfn>&lt;subroutine <tt>noOfDigits</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
-sub noOfDigits {
- my $num = $_[0];
-
- if ($num =~ /^[\+-]?\d+(?!\.)/) {
- return 0;
- }
- elsif ($num =~ /^[\+-]\d+\.(\d+)?/) {
- return length($1);
- }
-}
-
-</pre><p><a name="NWD21HcNW-l">Subroutine </a><code>drawsquare</code> is use by the <code>drawpoints</code> routine to plot a
-point whose point symbol is a square. The subroutine has one argument, which is
-equal to the radius of the point. From this argument it computes the side of
-the square.
-
-<pre><a name="NW21HcNW-3ywJ89-1" href="#NWD21HcNW-l"><dfn>&lt;subroutine <tt>drawsquare</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
-sub drawsquare {
- my $s = $_[0];
- #$s *= sqrt(2);
- $s = sprintf &quot;%.5f&quot;, $s;
- my $code = &quot;\\setlength{\\unitlength}{$xunits}%\n&quot;;
- $code .= &quot;\\begin{picture}($s,$s)\\put(0,0)&quot; .
- &quot;{\\framebox($s,$s){}}\\end{picture}&quot;;
- return $code;
-}
-
-</pre><p><a name="NWD21HcNW-m">Subroutine </a><code>X2sp</code> has two arguments: a number and a length unit. It returns
-the length expresssed in sp units.
-
-<pre><a name="NW21HcNW-39f7o8-1" href="#NWD21HcNW-m"><dfn>&lt;subroutine <tt>X2sp</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
-sub X2sp {
- my $LT = shift;
- my $units = shift;
-
- if ($units eq &quot;pc&quot;) {
- return $LT * 786432;
- }
- elsif ($units eq &quot;pt&quot;) {
- return $LT * 65536;
- }
- elsif ($units eq &quot;in&quot;) {
- return $LT * 4736286.72;
- }
- elsif ($units eq &quot;bp&quot;) {
- return $LT * 65781.76;
- }
- elsif ($units eq &quot;cm&quot;) {
- return $LT * 1864679.811023622;
- }
- elsif ($units eq &quot;mm&quot;) {
- return $LT * 186467.981102362;
- }
- elsif ($units eq &quot;dd&quot;) {
- return $LT * 70124.086430424;
- }
- elsif ($units eq &quot;cc&quot;) {
- return $LT * 841489.037165082;
- }
- elsif ($units eq &quot;sp&quot;) {
- return $LT;
- }
-}
-
-
-</pre><p><a name="NWD21HcNW-n">Subroutine </a><code>sp2X</code> has two arguments: a number that denotes a length in sp units
- and a length unit. It returns the length expresssed in units that are specified by
- the second argument.
-
-<pre><a name="NW21HcNW-3wV39i-1" href="#NWD21HcNW-n"><dfn>&lt;subroutine <tt>sp2X</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
-sub sp2X {
- my $LT = shift;
- my $units = shift;
-
- if ($units eq &quot;pc&quot;) {
- return $LT / 786432;
- }
- elsif ($units eq &quot;pt&quot;) {
- return $LT / 65536;
- }
- elsif ($units eq &quot;in&quot;) {
- return $LT / 4736286.72;
- }
- elsif ($units eq &quot;bp&quot;) {
- return $LT / 65781.76;
- }
- elsif ($units eq &quot;cm&quot;) {
- return $LT / 1864679.811023622;
- }
- elsif ($units eq &quot;mm&quot;) {
- return $LT / 186467.981102362;
- }
- elsif ($units eq &quot;dd&quot;) {
- return $LT / 70124.086430424;
- }
- elsif ($units eq &quot;cc&quot;) {
- return $LT / 841489.037165082;
- }
- elsif ($units eq &quot;sp&quot;) {
- return $LT;
- }
-}
-
-</pre><p><a name="NWD21HcNW-o">Subroutine </a><code>setLineThickness</code> takes two arguments: the value of the variable
- <code>$xunits</code> and a string denoting the linethickness. It returns the linthickness
- expressed in the units of the <code>$xunits</code>.
-
-<pre><a name="NW21HcNW-4XWBBY-1" href="#NWD21HcNW-o"><dfn>&lt;subroutine <tt>setLineThickness</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
-sub setLineThickness {
- my $Xunits = shift;
- my $LT = shift;
- $Xunits =~ s/^((\+|-)?\d+(\.\d+)?([eE](\+|-)?\d+)?)//;
- my $xlength = &quot;$1&quot;;
- $Xunits =~ s/^\s*($units)//;
- my $x_in_units = $1;
- $LT =~ s/^((\+|-)?\d+(\.\d+)?([eE](\+|-)?\d+)?)//;
- my $LTlength = &quot;$1&quot;;
- $LT =~ s/^\s*($units)//;
- my $LT_in_units = $1;
- $LTlength = X2sp($LTlength,$LT_in_units);
- $LTlength = sp2X($LTlength,$x_in_units);
- return $LTlength;
-}
-
-</pre><p>The subroutine <code>process_input</code> accepts one argument which is a file handle
-that corresponds to the file that the subroutine is supposed to process.
-The processing cycle is fairly simple: we input one line at the time, remove
-any leading space characters and the trailing new line character, and then
-start the actual processing. The variable <code>$INFILE</code> contains the name of
-the input file and the variable <code>$lc</code> is the local line counter. The
-commands <code>beginSkip</code> and <code>endSkip</code> can be used to ignore blocks
-of code and so we need to process them here. The variable <code>$no_output</code>
-is used as a switch to toggle from process mode to no-precess mode.
-<a name="NWD21HcNW-p">If the first token is </a><code>beginSkip</code>, we set the variable <code>$no_output</code> to 1,
-print a comment to the output file and continue with the next input line.
-If the first token is <code>endSkip</code>, we check whether we are in a no-process
-mode. If this is the case, we revert to process mode; otherwise we print
-an error message. Finally, depending on whether we are in process or no-process
-mode we process the input text or simply printed commented out to the output
-file. Note, that we don't allow nested comment blocks, as this makes really
-no sense!
-
-<pre><a name="NW21HcNW-1RrLPF-1" href="#NWD21HcNW-p"><dfn>&lt;subroutine <tt>process_input</tt> &gt;=</dfn></a> <b>(<a href="#NWD21HcNW-9">&lt;-U</a>)</b>
- sub process_input {
- my ($INFILE,$currInFile) = @_;
- my $lc = 0;
- my $no_output = 0;
- $curr_in_file = $currInFile;
- LINE: while(&lt;$INFILE&gt;) {
- $lc++;
- chomp($command = $_);
- s/^\s+//;
- if (/^beginSkip\s*/i) {
- $no_output = 1;
- print OUT &quot;%%$_&quot; if $comments_on;
- next LINE;
- }
- elsif (/^endSkip\s*/i) {
- if ($no_output == 0) {
- PrintErrorMessage(&quot;endSkip without beginSkip&quot;,$lc);
- }
- else {
- $no_output = 0;
- }
- print OUT &quot;%%$_&quot; 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
- $_ = &quot;$out_line\n&quot;;
- }
- <a name="NW21HcNW-1RrLPF-1-u1" href="#NWD21HcNW-q"><i>&lt;process input line&gt;</i></a>
- }
- }
- }
-
-</pre><p>Each command line starts with a particular <i>token</i> and depending on
-which one we have we perform different actions. If the first character
-is <code>%</code> we have a comment line, and depending on the value of the variable
-<code>$comments_on</code> we either output the comment on the output file (default
-action) or just ignore it and continue with the next input line. In case the
-first token is the name of a valid command we process the command and
-output the corresponding code. Otherwise, we print an error message to
-the screen and to the log file and continue with the next input line.
-Note that the input language is case-insensitive and so one is free to write a
-command name using any combination of upper and lower case
-letters, e.g., the tokens <code>lAtEx</code>,
-<code>LaTeX</code>, and <code>latex</code> are considered exactly the same.
-The valid <i>MathsPIC</i> commands are the following (don't pay attention
-to the case!):
-<ul>
-<li>
-Commands <code>drawAngleArc</code> and <code>drawAngleArrow</code> are used to draw an arc and an
-arrow, respectively. Since, their user interface is identical, we process
-them as if they were identical commands.
-</li>
-<li>
-Command <code>drawcircle</code> is used to draw a circle with a specified radius.
-</li>
-<li>
-Command <code>drawCircumCircle</code> is used to draw the circumcircle of triangle
-specified by three points.
-</li>
-<li>
-Command <code>drawexcircle</code> is used to draw the excircle of triangle
-relative to a given side of the triangle.
-</li>
-<li>
-Command <code>drawincircle</code> is used to draw the incircle of triangle.
-</li>
-<li>
-Command <code>drawincurve</code> is used to draw a curve that passes through a number of points.
-</li>
-<li> Command <code>drawline</code> is used to draw either
-a line (not necessarily a straight one) or a number of lines from a list
-or lists of points. The lines are specified as pairs of points that can
-be separated by blank spaces.
-<li> Command <code>drawthickline</code> is used to draw either
-a thick line (not necessarily a straight one) or a number of lines from a list
-or lists of points. The lines are specified as pairs of points that can
-be separated by blank spaces.
-</li>
-<li>
-Command <code>drawPerpendicular</code> draws a perpendicular line from point A to
-line BC.
-</li>
-<li> Command <code>drawpoint</code> is used to draw one, two or more points.
-The point names can be separated by blanks.
-</li>
-<li>
-Command <code>drawRightAngle</code> draws an angle, specified by three points,
-of a size specified by a side length.
-</li>
-<li>
-Command <code>drawsquare</code> draws a square, centered at the coordinates of the
-first arguments, which is assumed to be a point, with side equal to the
-second argument.
-</li>
-<li>
-Command <code>inputfile*</code> is used to verbatim include a file into the output
-file.
-</li>
-<li>
-Command <code>inputfile</code> is used to include a <i>MathsPIC</i> program file
-into the main file.
-</li>
-<li>
-Command <code>linethickness</code> should be used to set the thickness of lines.
-</li>
-<li>
-The <code>paper</code> command sets the paper scale, size, axes, etc. The most
-general format of the command follows:
-<center>
-<tt>paper{units(mm), xrange(0,120), yrange(0,100),axes(LRTB)}</tt>
-</center>
-Note, that one may opt not to write the commas between the different
-parts of command.
-</li>
-<li>
-Command <code>point*</code> allocates <i>new</i> co-ordinates and optionally
-a T<sub>E</sub>X point-name, to an existing point-name.
-Command <code>point</code> allocates co-ordinates and, optionally a T<sub>E</sub>X
-point character, to a <i>new</i> point-name. Since, both commands have
-identical syntax, we handle them together.
-</li>
-<li> Command <code>PointSymbol</code> is used to set or reset the default
-point symbol, i.e., when one plots a point this is the symbol that will
-appear on the final DVI/PostScript file.
-</li>
-<li>
-In the original DOS version of <tt>mathspic</tt> the command
-<code>setPointNumber</code> was used to set the length of the arrays that keep the
-various point related information. Since, in Perl arrays are dynamic objects
-and one can push as many objects as he/she wants, the command is implemented
-as an no-op. For reasons of compatibility, we only check the syntax of the
-command.
-</li>
-<li>
-Commands <code>showAngle</code> and <code>showArea</code> can be used to get
-the angle or the area determined by three points. In addition, the command
-<code>showLenght</code> can be used to get the length between two points. These three
-commands produce a comment to the output file.
-</li>
-<li> The <code>system</code> command provides a shell escape.
-</li>
-<li>
-The <code>text</code> command is used to put a symbol/text at a
-particular point location.
-</li>
-<li>
-Command <code>var</code> is used to store a numeric value into a comma separated
-list of variables.
-</li>
-<li>
-Command <code>const</code> is used to store a numeric value into a comma separated
-list of variables, whose value cannot be altered.
-</li>
-<li>
-<a name="NWD21HcNW-q">If a line starts with a backslash, </a><code>\</code>, then we copy verbatim this
-line to the output file. In case the second character is a space character,
-then we simply output a copy of the line without the leading backslash.
-</li>
-</ul>
-Empty lines are always ignored.
-
-<pre><a name="NW21HcNW-RKDir-1" href="#NWD21HcNW-q"><dfn>&lt;process input line&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-p">&lt;-U</a>)</b>
-
- if (/^\s*%/)
- {
- print OUT &quot;$_&quot; if $comments_on;
- }
- elsif (s/^\s*(beginloop(?=\W))//i) {
- s/\s+//;
- my $times = expr($lc);
- print OUT &quot;%% BEGINLOOP $times\n&quot; if $comments_on;
- my @C = ();
- REPEATCOMMS: while (&lt;$INFILE&gt;) {
- if (/^\s*endloop/i) {
- last REPEATCOMMS;
- }
- else {
- push @C, $_;
- }
- }
- if (! /^\s*endloop/i) {
- PrintFatalError(&quot;unexpected end of file&quot;,$lc);
- }
- else {
- s/^\s*endloop//i;
- for(my $i=1; $i&lt;=$times; $i++) {
- tie *DUMMY, 'DummyFH', \@C;
- process_input(DUMMY, $currInFile);
- untie *DUMMY;
- }
- print OUT &quot;%% ENDLOOP\n&quot; if $comments_on;
- }
- }
- elsif (s/^\s*(ArrowShape(?=\W))//i)
- {
- my $cmd = $1;
- print OUT &quot;%% $cmd$_&quot; if $comments_on;
- <a name="NW21HcNW-RKDir-1-u1" href="#NWD21HcNW-1V"><i>&lt;process <tt>ArrowShape</tt> command&gt;</i></a>
- }
- elsif (s/^\s*(const(?=\W))//i)
- {
- print OUT &quot;%% $1$_&quot; if $comments_on;
- <a name="NW21HcNW-RKDir-1-u2" href="#NWD21HcNW-1b"><i>&lt;process <tt>const</tt> command&gt;</i></a>
- }
- elsif (s/^\s*(dasharray(?=\W))//i)
- {
- my ($cmd) = $1;
- print OUT &quot;%% $cmd$_&quot; if $comments_on;
- <a name="NW21HcNW-RKDir-1-u3" href="#NWD21HcNW-r"><i>&lt;process <tt>dasharray</tt> command&gt;</i></a>
- }
- elsif (s/^\s*(drawAngleArc(?=\W))//i or s/^\s*(drawAngleArrow(?=\W))//i )
- {
- my $cmd = $1;
- print OUT &quot;%% $cmd$_&quot; if $comments_on;
- <a name="NW21HcNW-RKDir-1-u4" href="#NWD21HcNW-s"><i>&lt;process <tt>drawAngleArcOrArrow</tt> command&gt;</i></a>
- }
- elsif (s/^\s*(drawArrow(?=\W))//i)
- {
- my ($cmd) = $1;
- print OUT &quot;%% $cmd$_&quot; if $comments_on;
- DrawLineOrArrow(0,$lc);
- }
- elsif (s/^\s*(drawcircle(?=\W))//i)
- {
- my ($cmd) = $1;
- print OUT &quot;%% $cmd$_&quot; if $comments_on;
- <a name="NW21HcNW-RKDir-1-u5" href="#NWD21HcNW-v"><i>&lt;process <tt>drawcircle</tt> command&gt;</i></a>
- }
- elsif (s/^\s*(drawcurve(?=\W))//i)
- {
- my ($cmd) = $1;
- print OUT &quot;%% $cmd$_&quot; if $comments_on;
- DrawLineOrArrow(2,$lc);
- }
- elsif (s/^\s*(drawcircumcircle(?=\W))//i)
- {
- my ($cmd) = $1;
- print OUT &quot;%% $cmd$_&quot; if $comments_on;
- <a name="NW21HcNW-RKDir-1-u6" href="#NWD21HcNW-w"><i>&lt;process <tt>drawcircumcircle</tt> command&gt;</i></a>
- }
- elsif (s/^\s*(drawexcircle(?=\W))//i)
- {
- my ($cmd) = $1;
- print OUT &quot;%% $cmd$_&quot; if $comments_on;
- <a name="NW21HcNW-RKDir-1-u7" href="#NWD21HcNW-x"><i>&lt;process <tt>drawexcircle</tt> command&gt;</i></a>
- }
- elsif (s/^\s*(drawincircle(?=\W))//i)
- {
- my ($cmd) = $1;
- print OUT &quot;%% $cmd$_&quot; if $comments_on;
- <a name="NW21HcNW-RKDir-1-u8" href="#NWD21HcNW-y"><i>&lt;process <tt>drawincircle</tt> command&gt;</i></a>
- }
- elsif (s/^\s*(drawline(?=\W))//i)
- {
- my ($cmd) = $1;
- print OUT &quot;%% $cmd$_&quot; if $comments_on;
- DrawLineOrArrow(1,$lc);
- }
- elsif (s/^\s*(drawthickarrow(?=\W))//i)
- {
- my ($cmd) = $1;
- print OUT &quot;%% $cmd$_&quot; if $comments_on;
- print OUT &quot;\\setplotsymbol ({\\usefont{OT1}{cmr}{m}{n}\\large .})%\n&quot;;
- print OUT &quot;{\\setbox1=\\hbox{\\usefont{OT1}{cmr}{m}{n}\\large .}%\n&quot;;
- print OUT &quot; \\global\\linethickness=0.31\\wd1}%\n&quot;;
- DrawLineOrArrow(0,$lc);
- print OUT &quot;\\setlength{\\linethickness}{0.4pt}%\n&quot;;
- print OUT &quot;\\setplotsymbol ({\\usefont{OT1}{cmr}{m}{n}\\tiny .})%\n&quot;;
- }
- elsif (s/^\s*(drawthickline(?=\W))//i)
- {
- my ($cmd) = $1;
- print OUT &quot;%% $cmd$_&quot; if $comments_on;
- print OUT &quot;\\setplotsymbol ({\\usefont{OT1}{cmr}{m}{n}\\large .})%\n&quot;;
- print OUT &quot;{\\setbox1=\\hbox{\\usefont{OT1}{cmr}{m}{n}\\large .}%\n&quot;;
- print OUT &quot; \\global\\linethickness=0.31\\wd1}%\n&quot;;
- DrawLineOrArrow(1,$lc);
- print OUT &quot;\\setlength{\\linethickness}{0.4pt}%\n&quot;;
- print OUT &quot;\\setplotsymbol ({\\usefont{OT1}{cmr}{m}{n}\\tiny .})%\n&quot;;
- }
- elsif (s/^\s*(drawperpendicular(?=\W))//i)
- {
- my ($cmd) = $1;
- print OUT &quot;%% $cmd$_&quot; if $comments_on;
- <a name="NW21HcNW-RKDir-1-u9" href="#NWD21HcNW-z"><i>&lt;process <tt>drawPerpendicular</tt> command&gt;</i></a>
- }
- elsif (s/^\s*(drawpoint(?=\W))//i)
- {
- my ($cmd) = $1;
- print OUT &quot;%% $cmd$_&quot; if $comments_on;
- <a name="NW21HcNW-RKDir-1-u10" href="#NWD21HcNW-10"><i>&lt;process <tt>drawpoint</tt> command&gt;</i></a>
- }
- elsif (s/^\s*(drawRightAngle(?=\W))//i)
- {
- my ($cmd) = $1;
- print OUT &quot;%% $cmd$_&quot; if $comments_on;
- <a name="NW21HcNW-RKDir-1-u11" href="#NWD21HcNW-11"><i>&lt;process <tt>drawRightAngle</tt> command&gt;</i></a>
- }
- elsif (s/^\s*(drawsquare(?=\W))//i)
- {
- my ($cmd) = $1;
- print OUT &quot;%% $cmd$_&quot; if $comments_on;
- <a name="NW21HcNW-RKDir-1-u12" href="#NWD21HcNW-12"><i>&lt;process <tt>drawsquare</tt> command&gt;</i></a>
- }
- elsif (s/^\s*inputfile\*//i)
- {
- <a name="NW21HcNW-RKDir-1-u13" href="#NWD21HcNW-13"><i>&lt;process <tt>inputfile*</tt> command&gt;</i></a>
- }
- elsif (s/^\s*(inputfile(?=\W))//i)
- {
- my ($cmd) = $1;
- print OUT &quot;%% $cmd$_&quot; if $comments_on;
- <a name="NW21HcNW-RKDir-1-u14" href="#NWD21HcNW-14"><i>&lt;process <tt>inputfile</tt> command&gt;</i></a>
- }
- elsif (s/^\s*(linethickness(?=\W))//i)
- {
- my $cmd = $1;
- print OUT &quot;%% $cmd$_&quot; if $comments_on;
- <a name="NW21HcNW-RKDir-1-u15" href="#NWD21HcNW-15"><i>&lt;process <tt>linethickness</tt> command&gt;</i></a>
- }
- elsif (s/^\s*(paper(?=\W))//i)
- {
- my ($cmd) = $1;
- print OUT &quot;%% $cmd$_&quot; if $comments_on;
- <a name="NW21HcNW-RKDir-1-u16" href="#NWD21HcNW-16"><i>&lt;process <tt>paper</tt> command&gt;</i></a>
- }
- elsif (s/^\s*(PointSymbol(?=\W))//i)
- {
- my $cmd = $1;
- print OUT &quot;%% $cmd$_&quot; if $comments_on;
- <a name="NW21HcNW-RKDir-1-u17" href="#NWD21HcNW-1W"><i>&lt;process <tt>PointSymbol</tt> command&gt;</i></a>
- }
- elsif (s/^\s*point(?=\W)//i)
- {
- my ($Point_Line);
- chomp($Point_Line=$_);
- <a name="NW21HcNW-RKDir-1-u18" href="#NWD21HcNW-1H"><i>&lt;process <tt>point/point*</tt> commands&gt;</i></a>
- }
- elsif (/^\s*setPointNumber(?=\W)/i)
- {
- PrintWarningMessage(&quot;Command setPointNumber is ignored&quot;,$lc);
- next LINE;
- }
- elsif (s/^\s*(showAngle(?=\W))//i)
- {
- <a name="NW21HcNW-RKDir-1-u19" href="#NWD21HcNW-1A"><i>&lt;process <tt>showAngle</tt> command&gt;</i></a>
- }
- elsif (s/^\s*(showArea(?=\W))//i)
- {
- <a name="NW21HcNW-RKDir-1-u20" href="#NWD21HcNW-1B"><i>&lt;process <tt>showArea</tt> command&gt;</i></a>
- }
- elsif (s/^\s*(showLength(?=\W))//i)
- {
- <a name="NW21HcNW-RKDir-1-u21" href="#NWD21HcNW-1C"><i>&lt;process <tt>showLength</tt> command&gt;</i></a>
- }
- elsif (/^\s*showPoints(?=\W)/i)
- {
- print OUT &quot;%%-------------------------------------------------\n&quot;;
- print OUT &quot;%% L I S T O F P O I N T S \n&quot;;
- print OUT &quot;%%-------------------------------------------------\n&quot;;
- foreach my $p (keys(%PointTable)) {
- my ($x, $y, $pSV, $pS) = unpack(&quot;d3A*&quot;,$PointTable{$p});
- printf OUT &quot;%%%%\t%s\t= ( %.5f, %.5f ), LF-radius = %.5f, symbol = %s\n&quot;,
- $p, $x, $y, $pSV, $pS;
- }
- print OUT &quot;%%-------------------------------------------------\n&quot;;
- print OUT &quot;%% E N D O F L I S T O F P O I N T S \n&quot;;
- print OUT &quot;%%-------------------------------------------------\n&quot;;
- next LINE;
- }
- elsif (/^\s*showVariables(?=\W)/i)
- {
- print OUT &quot;%%-------------------------------------------------\n&quot;;
- print OUT &quot;%% L I S T O F V A R I A B L E S \n&quot;;
- print OUT &quot;%%-------------------------------------------------\n&quot;;
- foreach my $var (keys(%VarTable)) {
- print OUT &quot;%%\t&quot;, $var, &quot;\t=\t&quot;, $VarTable{$var}, &quot;\n&quot;;
- }
- print OUT &quot;%%-------------------------------------------------\n&quot;;
- print OUT &quot;%% E N D O F L I S T O F V A R I A B L E S \n&quot;;
- print OUT &quot;%%-------------------------------------------------\n&quot;;
- next LINE;
- }
- elsif (s/^\s*(system(?=\W))//i)
- {
- print OUT &quot;%% $1$_&quot; if $comments_on;
- <a name="NW21HcNW-RKDir-1-u22" href="#NWD21HcNW-1X"><i>&lt;process <tt>system</tt> command&gt;</i></a>
- }
- elsif (s/^\s*(text(?=\W))//i)
- {
- print OUT &quot;%% $1$_&quot; if $comments_on;
- <a name="NW21HcNW-RKDir-1-u23" href="#NWD21HcNW-1Y"><i>&lt;process <tt>text</tt> command&gt;</i></a>
- }
- elsif (s/^\s*(var(?=\W))//i)
- {
- print OUT &quot;%% $1$_&quot; if $comments_on;
- <a name="NW21HcNW-RKDir-1-u24" href="#NWD21HcNW-1c"><i>&lt;process <tt>var</tt> command&gt;</i></a>
- }
- elsif (/^\s*\\(.+)/)
- {
- my $line = $1;
- if ($line =~ /^\s+(.+)/)
- {
- print OUT &quot; $line\n&quot;;
- }
- else
- {
- print OUT &quot;\\$line\n&quot;;
- }
- next LINE;
- }
- elsif (0==length) #empty line
- {
- next LINE;
- }
- else {
- PrintErrorMessage(&quot;command not recognized&quot;,$lc);
- next LINE;
- }
-
-</pre><p>Command <code>dasharray</code> takes an arbitrary number of arguments that are used to
-specify a dash pattern. Its general syntax follows:
-<center>
- <tt> "dasharray" "(" d<sub>1</sub> "," g<sub>1</sub> "," d<sub>2</sub> ","
- g<sub>2</sub> "," ... ")"</tt>
-</center>
-where <tt>d<sub>i</sub></tt> denotes the length of a dash and <tt>g<sub>i</sub></tt>
-<a name="NWD21HcNW-r">denotes the length of gap between two consecutive dashes. Each </a><tt>d<sub>i</sub></tt>
-and <tt>g<sub>i</sub></tt> is a length (i.e., a number accompanied by a length of unit).
-Since we do not a priori know the number of arguments, we push them onto a stack and
-then we produce a command of the form
-<center>
- <tt> \setdashpattern &lt; d<sub>1</sub>, g<sub>1</sub>, d<sub>2</sub>,
- g<sub>2</sub>, ...&gt;</tt>
-</center>
-
-<pre><a name="NW21HcNW-19jqyn-1" href="#NWD21HcNW-r"><dfn>&lt;process <tt>dasharray</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
- chk_lparen($cmd,$lc);
- my @DashArray = ();
- my $dash = &quot;&quot;;
- my $dashpattern = &quot;&quot;;
- PATTERN: while (1) {
- $dash = sprintf(&quot;%.5f&quot;, expr($lc));
- if (s/^\s*($units)//i) {
- push (@DashArray, &quot;$dash$1&quot;);
- }
- else {
- PrintErrorMessage(&quot;Did not found unit after expression&quot;, $lc);
- }
- s/\s*//;
- if (/^[^,]/) {
- last PATTERN;
- }
- else {
- s/^,\s*//;
- }
- }
- print OUT &quot;\\setdashpattern &lt;&quot;;
- while (@DashArray) {
- $dashpattern .= shift @DashArray;
- $dashpattern .= &quot;,&quot;;
- }
- $dashpattern =~ s/,$//;
- print OUT $dashpattern, &quot;&gt;\n&quot;;
- chk_rparen(&quot;arguments of $cmd&quot;,$lc);
- chk_comment($lc);
-
-</pre><p>The command <code>drawAngleArc</code> draws an arc in the specified angle, a
-distance <i>radius</i> from the angle. The angle is either <i>internal</i>
-(<= 180 degrees) or <i>external</i> (>180 degrees). The direction of the
-arc is either <i>clockwise</i> or <i>anticlockwise</i>. The command
-<code>drawAngleArrow</code> draws an arrow just like the command <code>drawAngleArc</code>
-draws an arc. The syntax of these commands is as follows:
-<pre>
- cmds ::= ( "drawAngleArc" | "drawAngleArrow" ) args
- args ::= "{" angle comma radius comma internal comma clockwise "}"
- angle ::= "angle" "(" three-points ")"
- radius ::= "radius" "(" distance ")"
- distance ::= expression
- internal ::= "internal" | "external"
- clockwise ::= "clockwise" | "anticlockwise"
- comma ::= "," | empty
-</pre>
-We first collect all relevant information by parsing the <code>args</code> and then
-call the either the subroutine <code>drawAngleArc</code> or the subroutine
-<code>drawAngleArrow</code> to produce the actual code
-which is then printed into the output file. In order to be able to distinguish
-which command we are dealing with we simply use the variable <code>$cmd</code>.
-<a name="NWD21HcNW-s">We now start parsing the input line. We first check whether there is a</a>
-left curly bracket. Next, we parse the <code>angle</code>, the <code>distance</code>, the
-<code>internal</code> and the <code>clockwise</code> parts of the command. Finally, we check
-for right curly bracket and a trailing comment. Depending on
-the value of
-the variable <code>$cmd</code> we call either the subroutine <code>drawAngleArc</code> or the
-subroutine <code>drawAngleArrow</code>. These subroutines return the code that will be
-finally output to the output file.
-
-<pre><a name="NW21HcNW-12lwO-1" href="#NWD21HcNW-s"><dfn>&lt;process <tt>drawAngleArcOrArrow</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
-
- chk_lcb($cmd,$lc);
- <a name="NW21HcNW-12lwO-1-u1" href="#NWD21HcNW-t"><i>&lt;process <tt>angle</tt> part of command&gt;</i></a>
- s/^,\s*// or s/\s*//; #parse optional comma
- <a name="NW21HcNW-12lwO-1-u2" href="#NWD21HcNW-u"><i>&lt;process <tt>radius</tt> part of command&gt;</i></a>
- s/^,\s*// or s/\s*//; #parse optional comma
- my $inout = &quot;&quot;;
- if (s/^(internal(?=\W))//i or s/^(external(?=\W))//i) {
- $inout = $1;
- }
- else {
- PrintErrorMessage(&quot;Did not find expected 'internal' specifier&quot;, $lc);
- next LINE;
- }
- s/^,\s*// or s/\s*//; #parse optional comma
- my $direction = &quot;&quot;;
- if (s/^(clockwise(?=\W))//i or s/^(anticlockwise(?=\W))//i) {
- $direction = $1;
- }
- else {
- PrintErrorMessage(&quot;Did not find expected 'direction' specifier&quot;, $lc);
- next LINE;
- }
- chk_rcb(&quot;arguments of $cmd&quot;,$lc);
- chk_comment($lc);
- my $code;
- if (lc($cmd) eq &quot;drawanglearc&quot;) {
- $code = drawAngleArc($P1, $P2, $P3, $radius, $inout, $direction);
- }
- else {
- $code = drawAngleArrow($P1, $P2, $P3, $radius, $inout, $direction);
- }
- print OUT $code if $code ne &quot;&quot;;
-
-</pre><p><a name="NWD21HcNW-t">We first check whether the first token is the word </a><code>angle</code>. In case it
-isn't, this yields an unrecoverable error. In case the expected word is
-there, we check for a left parenthesis. Next, we parse the three points that
-must follow. For this purpose we use the user-defined subroutine
-<code>get_point</code>. Now we check that the angle has a reasonable value, i.e., if
-it is less than -400 or equal to zero, the value yields an unrecoverable error.
-We finish by checking whether there is a right parenthesis.
-
-<pre><a name="NW21HcNW-4X9wPg-1" href="#NWD21HcNW-t"><dfn>&lt;process <tt>angle</tt> part of command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-s">&lt;-U</a>)</b>
- my ($P1, $P2, $P3);
- if (s/^angle(?=\W)//i) {
- chk_lparen(&quot;token angle of command $cmd&quot;,$lc);
- $P1 = get_point($lc);
- next LINE if $P1 eq &quot;_undef_&quot;;
- $P2 = get_point($lc);
- next LINE if $P2 eq &quot;_undef_&quot;;
- $P3 = get_point($lc);
- next LINE if $P3 eq &quot;_undef_&quot;;
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$P1});
- my ($x2,$y2,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$PointTable{$P2});
- my ($x3,$y3,$pSV3,$pS3)=unpack(&quot;d3A*&quot;,$PointTable{$P3});
- my $Angle = Angle($x1, $y1, $x2, $y2, $x3, $y3);
- if ($Angle &lt;= 0) {
- if ($Angle == 0) {
- PrintErrorMessage(&quot;Angle is equal to zero&quot;,$lc);
- next LINE;
- }
- elsif ($Angle &lt; -400) {
- PrintErrorMessage(&quot;Something is wrong with the points&quot;,$lc);
- next LINE;
- }
- }
- chk_rparen(&quot;angle part of command $cmd&quot;,$lc);
- }
- else {
- PrintErrorMessage(&quot;Did not find expected angle part&quot;,$lc);
- next LINE;
- }
-
-</pre><p><a name="NWD21HcNW-u">In this section we parse the </a><code>radius</code> part of the <code>drawAngleArc</code> or the
-<code>drawAngleArrow</code> command. We first check whether the next token is the word
-<code>radius</code>. If it is not, then we continue with the next line.
-
-<pre><a name="NW21HcNW-2mAaDL-1" href="#NWD21HcNW-u"><dfn>&lt;process <tt>radius</tt> part of command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-s">&lt;-U</a>)</b>
-
- my $radius;
- if (s/^radius(?=\W)//i) {
- chk_lparen(&quot;token radius of command $cmd&quot;,$lc);
- $radius = expr($lc);
- chk_rparen(&quot;radius part of command $cmd&quot;,$lc);
- }
- else {
- PrintErrorMessage(&quot;Did not found expected angle part&quot;,$lc);
- next LINE;
- }
-
-</pre><p>Command <code>drawcircle</code> accepts two arguments--a point name that is
-used to specify the center of the circle and the radius of the circle.
-The radius is simply an expression, whose value must be greater than zero.
-Otherwise, we print an error message and continue with the next input line.
-The general syntax of the command is as follows:
-<pre>
- "drawcircle" "(" point-name "," rad ")"
-</pre>
-The code we emit for a point with coordinates <code>x</code> and <code>y</code> and for radius
-equal to <code>R</code> is:
-<pre>
- \circulararc 360 degrees from X y center at x y
-</pre>
-where <code>X = x+R</code>.<p>
-<a name="NWD21HcNW-v">Initially, we check whether there is an opening left parenthesis. Next,</a>
-we get the point name by using the subroutine <code>get_point</code> which
-issues an error message if the point hasn't been defined. In this
-case we stop processing the command, as there is absolutely no reason to
-do otherwise. Next, we parse the comma and then the radius by using
-the subroutine <code>ComputeDist</code>. If there is no problem, we emit the code
-and finally we check for a closing right parenthesis and for
-possible garbage that may follow the command.
-
-<pre><a name="NW21HcNW-EIAAh-1" href="#NWD21HcNW-v"><dfn>&lt;process <tt>drawcircle</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
- chk_lparen(&quot;drawcircle&quot;,$lc);
- my $Point = get_point($lc);
- next LINE if $Point eq &quot;_undef_&quot;;
- chk_comma($lc);
- my $R = expr($lc);
- if ($R &lt;= 0) {
- PrintErrorMessage(&quot;Radius must be greater than zero&quot;,$lc);
- next LINE;
- }
- my ($x,$y,$pSV,$pS)=unpack(&quot;d3A*&quot;,$PointTable{lc($Point)});
- printf OUT &quot;\\circulararc 360 degrees from %.5f %.5f center at %.5f %.5f\n&quot;,
- $x+$R, $y, $x, $y;
- chk_rparen(&quot;arguments of $cmd&quot;,$lc);
- chk_comment($lc);
-
-</pre><p>Command <code>drawcircumcircle</code> is used to draw the circumcircle of triangle
-specified by three points which are the arguments of the command. We start
-by parsing the opening left parenthesis. Next, we get the three points
-that define the triangle. We are now able to compute the center and
-the radius of the circumcircle by calling the subroutine <code>circumCircleCenter</code>.
-If the triangle area is equal to zero, then this subroutine will return
-the array <code>(0,0,0)</code> to indicate this fact.
-We now have all necessary information to draw the circumcircle. We use the
-<a name="NWD21HcNW-w">following code to do the job:</a>
-<pre>
- \circulararc 360 degrees from X y center x y
-</pre>
-where <code>x</code> and <code>y</code> are the coordinates of the center, <code>R</code> its
-radius and <code>X=x+R</code>. What is left is to check whether there is a
-closing right parenthesis and any trailing garbage.
-
-
-<pre><a name="NW21HcNW-1HqG4z-1" href="#NWD21HcNW-w"><dfn>&lt;process <tt>drawcircumcircle</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
- chk_lparen(&quot;drawcircumcircle&quot;,$lc);
- my $point1 = get_point($lc);
- next LINE if $point1 eq &quot;_undef_&quot;;
- my $point2 = get_point($lc);
- next LINE if $point2 eq &quot;_undef_&quot;;
- my $point3 = get_point($lc);
- next LINE if $point3 eq &quot;_undef_&quot;;
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$point1});
- my ($x2,$y2,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$PointTable{$point2});
- my ($x3,$y3,$pSV3,$pS3)=unpack(&quot;d3A*&quot;,$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 &quot;%% circumcircle center = ($xc,$yc), radius = $r\n&quot; if $comments_on;
- printf OUT &quot;\\circulararc 360 degrees from %.5f %.5f center at %.5f %.5f\n&quot;,
- $xc+$r, $yc, $xc, $yc;
- chk_rparen(&quot;arguments of $cmd&quot;,$lc);
- chk_comment($lc);
-
-</pre><p>The syntax of the <code>drawexcircle</code> command is as follows:
-<pre>
- drawexcircle ::= "drawexcircle" "(" ThreePoints "," TwoPoints ")"
- [ modifier ]
- modifier ::= "[" expr "]"
-
-</pre>
-The <code>modifier</code> is an expression that is used to modify the radius of the
-excicle. We start by checking whether there is a left parenthesis. Then we
-get names of the three points. In case any of the points is not defined
-we issue an error message and continue with the next input line. Next, we
-check whether there is a comma that separates the three points defining the
-triangle from the two points defining a side of the triangle (variables
-<code>$point1</code>, <code>$point2</code>, and <code>$point3</code>). Moreover, we must ensure that
-the area of the area defined by these points is not equal to
-zero. If it is we issue an error message and we continue with the next
-input line. Now, we are ready to get the two
-point names that define the side of the triangle (variables <code>$point3</code> and
-<code>$point5</code>). At this point we must make sure that these points are different
-points and that they are members of the list of points that define the triangle.
-We make this check by calling the subroutine <code>memberOf</code>. Next, we check
-whether there is a closing right parenthesis. We now compute the center
-and the radius of the excircle by calling the subroutine <code>excircle</code>. The
-coordinates of the center are stored in the variables <code>$xc</code> and <code>$yc</code>,
-while the radius is stored in the variable <code>$r</code>. If the next
-non-blank input character is a left square bracket, then we know the user has
-specified the optional part. We use the subroutine <code>expr</code> to get the value of
-the optional part. The value of the optional part is stored in the variable <code>$R</code>.
-At this point we check whether the sum of the radius
-plus the optional part is equal to zero and if it is we continue with the
-next input line. Next, we check for a closing right square bracket. We are
-<a name="NWD21HcNW-x">now ready to emit the source code. The first thing we must check is that</a>
-the radius is not too big for PiCTeX, i.e., not greater than 500/2.845.
-Then we print some informative text to the output file and of course the
-actual code. We use the following code to do the job:
-<pre>
- \circulararc 360 degrees from (xc+R) yc center xc yc
-</pre>
-The last thing we check is whether there is some trailing garbage.
-
-<pre><a name="NW21HcNW-Wbuba-1" href="#NWD21HcNW-x"><dfn>&lt;process <tt>drawexcircle</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
- chk_lparen(&quot;drawexcircle&quot;,$lc);
- my $point1 = get_point($lc);
- next LINE if $point1 eq &quot;_undef_&quot;;
- my $point2 = get_point($lc);
- next LINE if $point2 eq &quot;_undef_&quot;;
- my $point3 = get_point($lc);
- next LINE if $point3 eq &quot;_undef_&quot;;
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$point1});
- my ($x2,$y2,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$PointTable{$point2});
- my ($x3,$y3,$pSV3,$pS3)=unpack(&quot;d3A*&quot;,$PointTable{$point3});
- if (triangleArea($x1, $y1, $x2, $y2, $x3, $y3) &lt; 0.0001) {
- PrintErrorMessage(&quot;Area of triangle is zero!&quot;,$lc);
- next LINE;
- }
- chk_comma($lc);
- my $point4 = get_point($lc);
- if (!memberOf($point4, $point1, $point2, $point3)) {
- PrintErrorMessage(&quot;Current point isn't a side point&quot;,$lc);
- next LINE;
- }
- next LINE if $point4 eq &quot;_undef_&quot;;
- my $point5 = get_point($lc);
- next LINE if $point5 eq &quot;_undef_&quot;;
- if (!memberOf($point5, $point1, $point2, $point3)) {
- PrintErrorMessage(&quot;Current point isn't a side point&quot;,$lc);
- next LINE;
- }
- if ($point4 eq $point5) {
- PrintErrorMessage(&quot;Side points are identical&quot;,$lc);
- next LINE;
- }
- chk_rparen(&quot;arguments of $cmd&quot;,$lc);
- my ($xc, $yc, $r) = excircle($point1, $point2, $point3,
- $point4, $point5);
- my $R=$r;
- if (s/^\s*\[\s*//) {
- $R += expr($lc);
- if ($R &lt; 0.0001) {
- PrintErrorMessage(&quot;Radius has become equal to zero!&quot;,$lc);
- next LINE;
- }
- chk_rsb($lc);
- }
- if ($R &gt; (500 / 2.845)) {
- PrintErrorMessage(&quot;Radius is greater than 175mm!&quot;,$lc);
- next LINE;
- }
- print OUT &quot;%% excircle center = ($xc,$yc) radius = $R\n&quot; if $comments_on;
- printf OUT &quot;\\circulararc 360 degrees from %.5f %.5f center at %.5f %.5f\n&quot;,
- $xc+$R, $yc, $xc, $yc;
- chk_comment($lc);
-
-</pre><p>The syntax of the <code>drawincircle</code> command is as follows:
-<pre>
- drawincircle ::= "drawincircle" "(" ThreePoints ")" [ modifier]
- modifier ::= "[" expr "]"
-</pre>
-where <code>ThreePoints</code> correspond to the points defining the triangle and
-<code>modifier</code> is an optional modification factor.
-The first thing we do is to check whether
-there is an opening left parenthesis. Then we get the names of the three
-points that define the triangle (variables <code>$point1</code>, <code>$point2</code>,
-and <code>$point3</code>). Next, we make sure that the area of the
-triangle defined by these three points is not equal to zero. If it is, then
-we issue an error message and continue with the next input line. Now, we
-compute the center and the radius of the incircle (variables <code>$xc</code>, <code>$yc</code>,
-and <code>$r</code>). If the next non-blank input character is a left square bracket,
-then we now the user has specified the optional part. We use subroutine
-<code>expr</code> to get the value of the optional part. The value of
-the optional part
-is stored in the variable <code>$R</code>. At this point we check whether the sum of the
-radius plus the optional part is equal to zero and if it is we continue with
-the next input line. Next, we check for a closing right square bracket.
-<a name="NWD21HcNW-y">We are now ready to emit the source code. The first thing we must check is</a>
-that the radius is not too big for PiCTeX, i.e., not greater than 500/2.845.
-Then we print some informative text to the output file and of course the
-actual code. We use the following code to do the job:
-<pre>
- \circulararc 360 degrees from (xc+R) yc center xc yc
-</pre>
-The last thing we check is whether there is some trailing garbage.
-
-<pre><a name="NW21HcNW-3GJ2p7-1" href="#NWD21HcNW-y"><dfn>&lt;process <tt>drawincircle</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
- chk_lparen(&quot;drawincircle&quot;,$lc);
- my $point1 = get_point($lc);
- next LINE if $point1 eq &quot;_undef_&quot;;
- my $point2 = get_point($lc);
- next LINE if $point2 eq &quot;_undef_&quot;;
- my $point3 = get_point($lc);
- next LINE if $point3 eq &quot;_undef_&quot;;
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$point1});
- my ($x2,$y2,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$PointTable{$point2});
- my ($x3,$y3,$pSV3,$pS3)=unpack(&quot;d3A*&quot;,$PointTable{$point3});
- if (triangleArea($x1, $y1, $x2, $y2, $x3, $y3) &lt; 0.0001) {
- PrintErrorMessage(&quot;Area of triangle is zero!&quot;,$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 &lt; 0.0001) {
- PrintErrorMessage(&quot;Radius has become equal to zero!&quot;,$lc);
- next LINE;
- }
- chk_rsb($lc);
- }
- if ($R &gt; (500 / 2.845)) {
- PrintErrorMessage(&quot;Radius is greater than 175mm!&quot;,$lc);
- next LINE;
- }
- print OUT &quot;%% incircle center = ($xc,$yc) radius = $R\n&quot; if $comments_on;
- printf OUT &quot;\\circulararc 360 degrees from %.5f %.5f center at %.5f %.5f\n&quot;,
- $xc+$R, $yc, $xc, $yc;
- chk_rparen(&quot;arguments of $cmd&quot;,$lc);
- chk_comment($lc);
-
-</pre><p>The command <code>drawPerpendicular</code> command draws a line from point A to line
-BC, such that it is perpendicular to line BC. The general syntax of the
-command is as follows:
-<pre>
- drawPenpedicular ::= "drawPenpedicular" "(" Point "," TwoPoints ")"
-</pre>
-The first thing we do is to parse the left parenthesis. Then we parse
-the name of the first point, namely <code>$A$</code>. If this point is undefined
-we print an error message and continue with the next line. Next, we parse
-the expected leading comma and the names of the other two points. Certainly,
-in case either of these two points has not been defined, we simply print an
-error message and continue with the next input line. Finally, we check for
-a closing right parenthesis and a possible trailing comment. Now we are
-ready to compute the coordinates of the foot of the
-perpendicular line. We do so my calling subroutine
-<code><a name="NWD21HcNW-z">perpendicular</a></code>. Certainly, before we do this we have to get the
-coordinates of the points that we have parsed. Finally, we output the
-PiCTeX code:
-<pre>
- \plot x1 y1 xF xY /
-</pre>
-where <code>x1</code> and <code>y1</code> are coordinates of the point A and <code>xF</code> and <code>yF</code>
-the coordinates of the foot.
-
-<pre><a name="NW21HcNW-4OiWfi-1" href="#NWD21HcNW-z"><dfn>&lt;process <tt>drawPerpendicular</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
-
- chk_lparen($cmd,$lc);
- my $A = get_point($lc);
- next LINE if $A eq &quot;_undef_&quot;;
- chk_comma($lc);
- my $B = get_point($lc);
- next LINE if $A eq &quot;_undef_&quot;;
- s/\s*//; #ignore white space
- my $C = get_point($lc);
- next LINE if $A eq &quot;_undef_&quot;;
- chk_rparen(&quot;arguments of $cmd&quot;,$lc);
- chk_comment($lc);
- #
- #start actual computation
- #
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$A});
- my ($x2,$y2,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$PointTable{$B});
- my ($x3,$y3,$pSV3,$pS3)=unpack(&quot;d3A*&quot;,$PointTable{$C});
- my ($xF, $yF) = perpendicular($x1, $y1, $x2, $y2, $x3, $y3);
- printf OUT &quot;\\plot %.5f %.5f %.5f %.5f /\n&quot;,
- $x1, $y1, $xF, $yF;
-
-</pre><p>The <code>drawpoint</code> command has a number of points as arguments and produces
-PiCTeX code that draws a plot symbol at the coordinates of each point. The
-syntax of the command is as follows:
-<pre>
- drawpoint ::= "drawpoint" "(" Point { separator Point } ")"
-</pre>
-The <code>while</code> loop is used to consume all points that are
-<a name="NWD21HcNW-10">between an opening left parenthesis and a closing right parenthesis. All</a>
-points are pushed on the local array <code>PP</code>. When we have parsed the lists
-of points, we call the subroutine <code>drawpoints</code> to emit the actual PiCTeX code.
-Finally, we check whether there is a closing parenthesis
-parenthesis, and whether
-there is some trailing text that makes no sense. In case there are no points
-between the parentheses, then we issue an appropriate error message and
-we continue with the next input line.
-
-<pre><a name="NW21HcNW-2EC5Ei-1" href="#NWD21HcNW-10"><dfn>&lt;process <tt>drawpoint</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
- my ($stacklen);
- chk_lparen(&quot;$cmd&quot;,$lc);
- if (/^\)/) {
- PrintErrorMessage(&quot;There are no point to draw&quot;,$lc);
- next LINE;
- }
- my(@PP);
- DRAWPOINTS:while(1) {
- if (s/^([^\W\d_]\d{0,3})//i) { #point name
- $P = $1;
- if (!exists($PointTable{lc($P)})) {
- PrintErrorMessage(&quot;Undefined point $P&quot;,$lc);
- next DRAWPOINTS;
- }
- else {
- push (@PP,$P);
- s/\s*//;
- }
- }
- else {
- last DRAWPOINTS;
- }
- }
- drawpoints(@PP);
- chk_rparen(&quot;arguments of $cmd&quot;,$lc);
- chk_comment($lc);
-
-</pre><p>The syntax of the <code>drawRightAngle</code> command is as follows:
-<pre>
- drawRightAngle "(" ThreePoints "," dist ")"
- dist ::= expr | TwoPoints
-</pre>
-Before we proceed with the actual computation we parse the left parenthesis,
-the three points, the comma, the <code>dist</code>, and the right parenthesis. In case
-we have neither three points nor a <code>dist</code> we print an error message and
-continue with the next input line, i.e., these errors are irrecoverable.
-The names of the three points are stored in variables <code>$point1</code>,
-<code>$point2</code>, and <code>$point3</code>. The value of the distance is stored
-in the variable <code>$dist</code>.
-Let's now explain the semantics of this command.<p>
-
-Our aim is to draw lines S<sub>1</sub>-S, S<sub>2</sub>-S (S<sub>1</sub>
-and S<sub>2</sub> are at distance d from B). All the relevant points are
-depicted in the following figure:
-<center>
-<img src="fig1.jpg">
-</center>
-Some notes are in order:
-<ol>
-<li> BS bisects angle ABC, and meets AC in Q, so start by determining point
-Q, then determine S, and then S<sub>1</sub> and S<sub>2</sub>, and then
-draw S<sub>1</sub>-S and S<sub>2</sub>-S.</li>
-<li> Distance AQ is given by AC/(1+tan(BCA))</li>
-<li> The coordinates of Q are computed using the subroutine <code>pointOnLine</code>.</li>
-<li> Now we compute the coordinates of S on line BQ.</li>
-<li> We compute the coordinates of S<sub>1</sub> and S<sub>2</sub> by using
-The subroutine <code>pointOnLine</code>.</li>
-</ol>
-<a name="NWD21HcNW-11">In order to implement the above steps we first compute the length of the line</a>
-AB. Note that A is <code>$point1</code>, etc. Next we compute the angle BAC. Now
-we compute the distance AQ (variable <code>$line1</code>). The coordinates of point
-Q are stored in variables <code>$xQ</code> and <code>$yQ</code>. The coordinates of point
-S are stored in variables <code>$xS</code> and <code>$yS</code>. Now we have to determine the
-coordinates of points S<sub>1</sub> and S<sub>2</sub>. These coordinates
-are stored in variables <code>$xS1</code>, <code>$yS1</code> and <code>$xS2</code>, <code>$yS2</code>,
-respectively. Finally, we emit the PiCTeX target code.
-
-<pre><a name="NW21HcNW-2KJKP6-1" href="#NWD21HcNW-11"><dfn>&lt;process <tt>drawRightAngle</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
-
- chk_lparen(&quot;drawRightAngle&quot;,lc);
- my $point1 = get_point($lc);
- next LINE if $point1 eq &quot;_undef_&quot;;
- my $point2 = get_point($lc);
- next LINE if $point2 eq &quot;_undef_&quot;;
- my $point3 = get_point($lc);
- next LINE if $point3 eq &quot;_undef_&quot;;
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$point1});
- my ($x2,$y2,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$PointTable{$point2});
- my ($x3,$y3,$pSV3,$pS3)=unpack(&quot;d3A*&quot;,$PointTable{$point3});
- chk_comma($lc);
- my $dist = expr($lc);
- chk_rparen(&quot;arguments of $cmd&quot;,$lc);
- chk_comment($lc);
- #
- #actual computation
- #
- my $lengthAC = Length($x1, $y1, $x3, $y3);
- my $angleBAC = Angle($x2, $y2, $x1, $y1, $x3, $y3);
- my $line1 = $lengthAC / (1 + tand($angleBAC));
- #
- # determine coordinates of point Q
- #
- my ($xQ, $yQ) = pointOnLine($x1, $y1, $x3, $y3, $line1);
- #
- # determine coordinates of point S
- #
- my $deltax = $xQ - $x2;
- my $deltay = $yQ - $y2;
- my $lengthBQ = sqrt($deltax * $deltax + $deltay * $deltay);
- my $xS = $x2 + ($dist * sqrt(2) * $deltax / $lengthBQ);
- my $yS = $y2 + ($dist * sqrt(2) * $deltay / $lengthBQ);
- #
- # determine coordinates of points S1 and S2
- #
- my ($xS1, $yS1) = pointOnLine($x2, $y2, $x3, $y3, $dist);
- ($xS2, $yS2) = ($xS, $yS);
- #
- # emit PiCTeX code
- #
- printf OUT &quot;\\plot %.5f %.5f %.5f %.5f /\n&quot;,
- $xS1, $yS1, $xS2, $yS2;
- ($xS1, $yS1) = pointOnLine($x2, $y2, $x1, $y1, $dist);
- printf OUT &quot;\\plot %.5f %.5f %.5f %.5f /\n&quot;,
- $xS1, $yS1, $xS2, $yS2;
-
-</pre><p><a name="NWD21HcNW-12">The command </a><code>drawsquare</code> has two arguments: a point, which specifies the
-coordinates of the point where the square will be placed, and a number, which
-specifies the length of the side of the square. The syntax of the command is as follows:
-<center>
- <tt> "drawSquare" "(" Point "," expression ")" </tt>
-</center>
-Note that RWDN has suggested to alter the value of the <code>$side</code> variable (see the
-line with <code>RWDN</code> comment).
-
-<pre><a name="NW21HcNW-2lxjRF-1" href="#NWD21HcNW-12"><dfn>&lt;process <tt>drawsquare</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
- chk_lparen(&quot;drawSquare&quot;,$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(&quot;d3A*&quot;,$PointTable{$p});
- printf OUT &quot;\\put {%s} at %.5f %.5f %%drawsquare\n&quot;, drawsquare($side), $x, $y;
- chk_rparen(&quot;arguments of $cmd&quot;,$lc);
- chk_comment($lc);
-
-</pre><p>The argument of the <code>inputfile*</code> command is a file name that is always
-enclosed in parentheses:
-<pre>
- starred-input-file ::= "inputfile*" "(" file-name ")"
- file-name ::= (alpha | period) { alpha | period }
- alpha ::= letter | digit | "_" | "-"
-</pre>
-<a name="NWD21HcNW-13">Note, that the input file is assumed to contain TeX code.</a>
-We first check to see if there is a left parenthesis. Then we consume
-the file name. We check if the file exists and then we copy verbatim the
-input file to the output file. Next, we check for the closing parenthesis.
-Now, if there is a trailing comment we copy it to the output file depending
-on the value of the variable <code>$comments_on</code>, else if there is some other
-text we simply ignore it and issue a warning message.
-
-<pre><a name="NW21HcNW-fJuCf-1" href="#NWD21HcNW-13"><dfn>&lt;process <tt>inputfile*</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
- chk_lparen(&quot;inputfile*&quot;,$lc);
- my $row_in = &quot;&quot;;
- if (s/^((\w|-|\.)+)//) {
- $row_in = $1;
- }
- else {
- PrintErrorMessage(&quot;No input file name found&quot;,$lc);
- next LINE;
- }
- if (!(-e $row_in)) {
- PrintErrorMessage(&quot;File $row_in does not exist&quot;,$lc);
- next LINE;
- }
- open(ROW, &quot;$row_in&quot;)|| die &quot;Can't open file $row_in\n&quot;;
- while (defined($in_line=&lt;ROW&gt;)) { print OUT $in_line; }
- print OUT &quot;%% ... end of input file &lt;$row_in&gt;\n&quot;;
- close ROW;
- chk_rparen(&quot;input file name&quot;,$lc);
- chk_comment($lc);
-
-
-</pre><p>The <code>inputfile</code> command has at most two arguments, second being
-optional: a file name enclosed in curly brackets and the number of
-times this file should be included in square brackets:
-<pre>
- inputfile ::= "inputfile" "(" file-name ")" [ Times ]
- <a name="NWD21HcNW-14">Times ::= "[" expr "]"</a>
-</pre>
-Note that the input file is assumed to contain mathspic commands. In addition, if
-the expression is equal to a decimal number, it is truncated.
-As in the case of the <code>inputfile*</code> command we parse the left parenthesis,
-the file name, the right parenthesis and the optional argument if it exists.
-In order to process the commands contained in the input file, we call
-The subroutine <code>process_input</code>.
-
-<pre><a name="NW21HcNW-2EQO3c-1" href="#NWD21HcNW-14"><dfn>&lt;process <tt>inputfile</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
-
- chk_lparen(&quot;inputfile&quot;,$lc);
- my $comm_in = &quot;&quot;;
- if (s/^((\w|-|\.)+)//) {
- $comm_in = $1;
- }
- else {
- PrintErrorMessage(&quot;No input file name found&quot;,$lc);
- next LINE;
- }
- if (!(-e $comm_in)) {
- PrintErrorMessage(&quot;File $comm_in does not exist&quot;,$lc);
- next LINE;
- }
- chk_rparen(&quot;input file name&quot;,$lc);
- my $input_times = 1; #default value
- if (s/^\[//) {
- $input_times = expr($lc);
- chk_rsb(&quot;optional argument&quot;,$lc);
- }
- print OUT &quot;%% ... start of file &lt;$comm_in&gt; loop [$input_times]\n&quot;;
- for (my $i=0; $i&lt;int($input_times); $i++) {
- open(COMM,&quot;$comm_in&quot;) or die &quot;Can't open file $comm_in\n&quot;;
- print OUT &quot;%%% Iteration number: &quot;,$i+1,&quot;\n&quot;;
- my $old_file_name = $curr_in_file;
- process_input(COMM,&quot;File $comm_in, &quot;);
- $curr_in_file = $old_file_name;
- close COMM;
- }
- print OUT &quot;%% ... end of file &lt;$comm_in&gt; loop [$input_times]\n&quot;;
- chk_comment($lc);
-
-</pre><p><a name="NWD21HcNW-15">The </a><code>linethickness</code> command should be used to set the thickness of lines.
-The command has one argument, which is a length or the word <code>default</code>.
-The default line thickness is 0.4 pt.
-
-<pre><a name="NW21HcNW-1t58ZF-1" href="#NWD21HcNW-15"><dfn>&lt;process <tt>linethickness</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
- chk_lparen(&quot;linethickness&quot;, $lc);
- if (s/^default//i) {
- print OUT &quot;\\linethickness=0.4pt\\Linethickness{0.4pt}%%\n&quot;;
- print OUT &quot;\\setplotsymbol ({\\usefont{OT1}{cmr}{m}{n}\\tiny .})%\n&quot;;
- $LineThickness = setLineThickness($xunits,&quot;0.4pt&quot;);
- }
- else {
- my $length = expr($lc);
- if (s/^\s*($units)//i) {
- my $units = $1;
- printf OUT &quot;\\linethickness=%.5f%s\\Linethickness{%.5f%s}%%\n&quot;,
- $length, $units, $length, $units;
- $LineThickness = setLineThickness($xunits,&quot;$length$units&quot;);
- my $mag;
- if ($units eq &quot;pc&quot;) {
- $mag = $length * 12;
- }
- elsif ($units eq &quot;in&quot;) {
- $mag = $length * 72.27;
- }
- elsif ($units eq &quot;bp&quot;) {
- $mag = $length * 1.00375;
- }
- elsif ($units eq &quot;cm&quot;) {
- $mag = $length * 28.45275;
- }
- elsif ($units eq &quot;mm&quot;) {
- $mag = $length * 2.845275;
- }
- elsif ($units eq &quot;dd&quot;) {
- $mag = $length * 1.07001;
- }
- elsif ($units eq &quot;cc&quot;) {
- $mag = $length * 0.08917;
- }
- elsif ($units eq &quot;sp&quot;) {
- $mag = $length * 0.000015259;
- }
- elsif ($units eq &quot;pt&quot;) {
- $mag = $length;
- }
- $mag = 10 * $mag / 1.00278219;
- printf OUT &quot;\\font\\CM=cmr10 at %.5fpt%%\n&quot;, $mag;
- print OUT &quot;\\setplotsymbol ({\\CM .})%\n&quot;;
- }
- else {
- PrintErrorMessage(&quot;Did not found expect units part&quot;,$lc);
- }
- }
- chk_rparen(&quot;linethickness&quot;, $lc);
- chk_comment($lc);
-
-
-</pre><p>We first output the input line as a comment into the output file. Now,
-after the <code>paper</code> token we look for an opening brace. Then we process
-the <code>units</code> part of the command, if the token <code>units</code> is present. Note
-that the <code>units</code> part is optional. Next we process the <code>xrange</code> and the
-<code>yrange</code> part of the command, which are also optional parts of the command.
-We are now ready to process the <code>axis</code> part. Note, that the user is allowed
-to alternatively specify this part with the word <code>axes</code>.
-<a name="NWD21HcNW-16">The variable </a><code>$axis</code>
-is supposed to hold the various data relate to the <code>axis</code> part. The last
-thing we check is the <code>ticks</code> part. In case the user has not specified
-this part we assume that both ticks are equal to zero. If everything is
-according to the language syntax, we expect a closing right curly bracket.
-Now, that we have all relevant information we can output the rest of the code,
-as some parts of it have already been output during parsing. The last thing we
-do is to check whether there is any trailing comment.
-
-<pre><a name="NW21HcNW-1Pby5X-1" href="#NWD21HcNW-16"><dfn>&lt;process <tt>paper</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
- chk_lcb(&quot;paper&quot;, $lc);
- if (s/^units(?=\W)//i)
- {
- <a name="NW21HcNW-1Pby5X-1-u1" href="#NWD21HcNW-17"><i>&lt;process <tt>unit</tt> part&gt;</i></a>
- $nounits = 0;
- }
- else
- {
- $nounits = 1;
- }
- s/^,\s*// or s/\s*//;
- if (s/^xrange//i)
- {
- <a name="NW21HcNW-1Pby5X-1-u2" href="#NWD21HcNW-18"><i>&lt;process <tt>xrange</tt> part&gt;</i></a>
- $noxrange = 0;
- }
- else
- {
- $noxrange = 1;
- }
- s/^,\s*// or s/\s*//;
- if (s/^yrange//i)
- {
- <a name="NW21HcNW-1Pby5X-1-u3" href="#NWD21HcNW-19"><i>&lt;process <tt>yrange</tt> part&gt;</i></a>
- $noyrange = 0;
- }
- else
- {
- $noyrange = 1;
- }
- <a name="NW21HcNW-1Pby5X-1-u4" href="#NWD21HcNW-1D"><i>&lt;generate plot area related commands&gt;</i></a>
- s/^,\s*// or s/\s*//;
- $axis = &quot;&quot;;
- if (s/^ax[ei]s(?=\W)//i)
- {
- <a name="NW21HcNW-1Pby5X-1-u5" href="#NWD21HcNW-1E"><i>&lt;process <tt>axis</tt> part&gt;</i></a>
- }
- $axis = uc($axis);
- s/^,\s*// or s/\s*//;
- if (s/^ticks(?=\W)//i)
- {
- <a name="NW21HcNW-1Pby5X-1-u6" href="#NWD21HcNW-1F"><i>&lt;process <tt>ticks</tt> part&gt;</i></a>
- }
- else
- {
- $xticks = $yticks = 0;
- }
- chk_rcb(&quot;paper&quot;, $lc);
- <a name="NW21HcNW-1Pby5X-1-u7" href="#NWD21HcNW-1G"><i>&lt;generate the rest of the code for the <tt>paper</tt> command&gt;</i></a>
- chk_comment($lc);
-
-</pre><p><a name="NWD21HcNW-17">We first check whether there is a left parenthesis. Next, we check</a>
-whether there is decimal number or a variable name. In case there isn't one we assume it
-is the number 1. Now, we get the units. If there is no valid unit, we issue
-an error and the x-unit is set to its default value. In case, there is
-a trailing comma, we assume the user wants also to specify the y-unit and
-we process this part just like we did with the x-unit part. Finally, we
-output the corresponding PiCTeX command. In case there is no y-unit
-we assume it is equal to the x-unit.
-
-<pre><a name="NW21HcNW-15UlOC-1" href="#NWD21HcNW-17"><dfn>&lt;process <tt>unit</tt> part&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-16">&lt;-U</a>)</b>
-
- chk_lparen(&quot;units&quot;,$lc);
- if(s/^\)//)
- {
- PrintWarningMessage(&quot;Missing value in \&quot;units\&quot;--default is 1pt&quot;,
- $lc);
- $xunits = &quot;1pt&quot;;
- }
- else {
- $xunits = expr($lc);
- s/\s*//;
- if (s/^($units)//i) {
- $xunits .= &quot;$1&quot;;
- $LineThickness = setLineThickness($xunits,&quot;0.4pt&quot;);
- }
- elsif(s/^(\w)+//i) {
- PrintErrorMessage(&quot;$1 is not a valid mathspic unit&quot;,$lc);
- $xunits = &quot;1pt&quot;;
- }
- else {
- PrintErrorMessage(&quot;No x-units found&quot;,$lc);
- $xunits = &quot;1pt&quot;;
- }
- 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 .= &quot;$1&quot;;
- }
- elsif(s/^(\w)+//i) {
- PrintErrorMessage(&quot;$1 is not a valid mathspic unit&quot;,$lc);
- $yunits = &quot;1pt&quot;;
- }
- else {
- PrintErrorMessage(&quot;No y-units found&quot;,$lc);
- $yunits = $xunits;
- }
- }
- else {
- $yunits = $xunits;
- }
- chk_rparen(&quot;units&quot;,$lc);
- }
-
-</pre><p><a name="NWD21HcNW-18">The </a><code>xrange</code> token must be followed by a left parenthesis, so we
-check whether the next token is a left parenthesis. We store in the variables
-<code>$xlow</code> and <code>$xhigh</code> the values of the range. The range is specified
-as pair of decimal numbers/variable/pair of points, separated by a
-comma. We use the subroutine <code>ComputeDist</code> to get the value of the lower
-end and the upper end of the range. The last thing we check is whether
-the lower end is less than the upper end. If this isn't the case we
-issue an error message and we skip into the next input line.
-
-<pre><a name="NW21HcNW-39noUt-1" href="#NWD21HcNW-18"><dfn>&lt;process <tt>xrange</tt> part&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-16">&lt;-U</a>)</b>
-
- chk_lparen(&quot;xrange&quot;,$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 &gt;= $xhigh)
- {
- PrintErrorMessage(&quot;xlow &gt;= xhigh in xrange&quot;,$lc);
- next LINE;
- }
- chk_rparen(&quot;$xhigh&quot;,$lc);
-
-</pre><p><a name="NWD21HcNW-19">The </a><code>yrange</code> token must be followed by a left parenthesis, so we
-check whether the next token is a left parenthesis. We store in the variables
-<code>$ylow</code> and <code>$yhigh</code> the values of the range. The range is specified
-as pair of decimal numbers/variable/pair of points, separated by a
-comma. We use the subroutine <code>ComputeDist</code> to get the value of the lower
-end and the upper end of the range. The last thing we check is whether
-the lower end is less than the upper end. If this isn't the case we
-issue an error message and we skip into the next input line.
-
-<pre><a name="NW21HcNW-3SApmu-1" href="#NWD21HcNW-19"><dfn>&lt;process <tt>yrange</tt> part&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-16">&lt;-U</a>)</b>
-
- chk_lparen(&quot;yrange&quot;,$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 &gt;= $yhigh)
- {
- PrintErrorMessage(&quot;ylow &gt;= yhigh in yrange&quot;,$lc);
- next LINE;
- }
- chk_rparen(&quot;$yhigh&quot;,$lc);
-
-</pre><p><a name="NWD21HcNW-1A">The </a><code>showAngle</code> command has three arguments that correspond to three distinct
-points and emits a comment of the form:
-<center>
-<tt>%% angle(ABC) = 45</tt>
-</center>
-Note that the computed angle is expressed in degrees.
-
-<pre><a name="NW21HcNW-2ObcXb-1" href="#NWD21HcNW-1A"><dfn>&lt;process <tt>showAngle</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
- chk_lparen(&quot;showangle&quot;,$lc);
- my $point_1 = get_point($lc);
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$point_1});
- my $point_2 = get_point($lc);
- my ($x2,$y2,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$PointTable{$point_2});
- my $point_3 = get_point($lc);
- my ($x3,$y3,$pSV3,$pS3)=unpack(&quot;d3A*&quot;,$PointTable{$point_3});
- my $angle = Angle($x1, $y1, $x2, $y2, $x3, $y3);
- $angle = 0 if $angle == -500;
- printf OUT &quot;%%%% angle(%s%s%s) = %.5f deg ( %.5f rad)\n&quot;, $point_1,
- $point_2, $point_3, $angle, $angle*D2R;
- chk_rparen(&quot;Missing right parenthesis&quot;, $lc);
-
-</pre><p><a name="NWD21HcNW-1B">The </a><code>showArea</code> command has three arguments that correspond to three distinct
-points and emits a comment of the form:
-<center>
-<tt>%% area(ABC) = 45</tt>
-</center>
-Note that the computed angle is expressed in degrees.
-
-<pre><a name="NW21HcNW-2THNRJ-1" href="#NWD21HcNW-1B"><dfn>&lt;process <tt>showArea</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
- chk_lparen(&quot;showarea&quot;,$lc);
- my $point_1 = get_point($lc);
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$point_1});
- my $point_2 = get_point($lc);
- my ($x2,$y2,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$PointTable{$point_2});
- my $point_3 = get_point($lc);
- my ($x3,$y3,$pSV3,$pS3)=unpack(&quot;d3A*&quot;,$PointTable{$point_3});
- print OUT &quot;%% area($point_1$point_2$point_3) = &quot;,
- triangleArea($x1, $y1, $x2, $y2, $x3, $y3), &quot;\n&quot;;
- chk_rparen(&quot;Missing right parenthesis&quot;, $lc);
-
-</pre><p><a name="NWD21HcNW-1C">The </a><code>showLength</code> command has two arguments that correspond to two distinct
-points and emits a comment of the form:
-<center>
-<tt>%% length(AB) = 45</tt>
-</center>
-Note that the computed angle is expressed in degrees.
-
-<pre><a name="NW21HcNW-Ofe1b-1" href="#NWD21HcNW-1C"><dfn>&lt;process <tt>showLength</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
- chk_lparen(&quot;showlength&quot;,$lc);
- my $point_1 = get_point($lc);
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$point_1});
- my $point_2 = get_point($lc);
- my ($x2,$y2,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$PointTable{$point_2});
- print OUT &quot;%% length($point_1$point_2) = &quot;,
- Length($x1, $y1, $x2, $y2), &quot;\n&quot;;
- chk_rparen(&quot;Missing right parenthesis&quot;, $lc);
-
-
-</pre><p><a name="NWD21HcNW-1D">If the user hasn't specified units then we use the previous values to</a>
-set the coordinate system. If the user hasn't specified either the
-<code>xunits</code> part or the <code>yunits</code>, then we don't emit code. In case he/she
-has specified both parts we generate the command that sets the plot area.
-
-<pre><a name="NW21HcNW-2SitZA-1" href="#NWD21HcNW-1D"><dfn>&lt;generate plot area related commands&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-16">&lt;-U</a>)</b>
-
- if (!$nounits)
- {
- printf OUT &quot;\\setcoordinatesystem units &lt;%s,%s&gt;\n&quot;,
- $xunits,$yunits;
- }
- if(!$noxrange &amp;&amp; !$noyrange)
- {
- printf OUT &quot;\\setplotarea x from %.5f to %.5f, y from %.5f to %.5f\n&quot;,
- $xlow, $xhigh, $ylow, $yhigh;
-
- }
-
-</pre><p>We first check to see whether there is an opening left parenthesis. Next
-<a name="NWD21HcNW-1E">we get the various options the user may have entered. The valid options</a>
-are the letters L, R, T, B, X, and Y. These letters may be followed by
-an optional star <code>*</code> with space characters between the letter and the star.
-We use a loop, that stops when a right parenthesis is found, to
-go through all
-possible arguments and append each argument in the string <code>$axis</code>. Note
-one can have blank space between different arguments. The last thing we do is
-to check for the closing right parenthesis.
-
-<pre><a name="NW21HcNW-19Hy2D-1" href="#NWD21HcNW-1E"><dfn>&lt;process <tt>axis</tt> part&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-16">&lt;-U</a>)</b>
-
- chk_lparen(&quot;axis&quot;,$lc);
- while(/^[^\)]/)
- {
- if (s/^([lrtbxy]{1}\*?)//i)
- {
- $axis .= $1;
- }
- elsif (s/^([^lrtbxy])//i)
- {
- PrintErrorMessage(&quot;Non-valid character \&quot;$1\&quot; in axis()&quot;,$lc);
- }
- s/\s*//;
- }
- chk_rparen(&quot;axis(arguments&quot;,$lc);
-
-</pre><p>As usual we start by skipping white space. Next we check whether there is
-<a name="NWD21HcNW-1F">an opening left parenthesis. Now, we expect two numbers/variables/pair of</a>
-point representing the <code>ticks</code> increment value. These <code>ticks</code> increment
-values must be separated by a comma (and possibly some white space around
-them). We use the subroutine <code>ComputeDist</code> to get the value of the <code>ticks</code>
-increment value and we assign to the variables <code>$xticks</code> and <code>$yticks</code>
-the value of x-ticks and y-ticks increment value. In case there is a
-problem we issue an error message and continue with the next line. The last
-thing we check is whether there is a closing right parenthesis.
-
-<pre><a name="NW21HcNW-1isLLJ-1" href="#NWD21HcNW-1F"><dfn>&lt;process <tt>ticks</tt> part&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-16">&lt;-U</a>)</b>
- chk_lparen(&quot;ticks&quot;,$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(&quot;ticks(arguments&quot;,$lc);
-
-</pre><p><a name="NWD21HcNW-1G">We actually emit code if the user has specified either the </a><code>X</code> or
-<code>Y</code> option in the <code>axis</code> part. If the user has specified the
-<code>Y*</code> or the <code>X*</code> option in the axis part, we just emit the commands
-<code>\axis left shiftedto x=0</code> or <code>\axis bottom shiftedto y=0</code> respectively
-and exit. If the use has specified ticks, then, depending on the options
-he had supplied with the <code>axis</code> part, we emit code that
-implements the user's wishes.
-**** HERE WE MUST EXPLAIN THE MEANING OF THE CODE EMITTED!!! *****
-
-<pre><a name="NW21HcNW-2gFm3I-1" href="#NWD21HcNW-1G"><dfn>&lt;generate the rest of the code for the <tt>paper</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-16">&lt;-U</a>)</b>
-YBRANCH: {
- if (index($axis, &quot;Y&quot;)&gt;-1)
- {
- if (index($axis, &quot;Y*&quot;)&gt;-1)
- {
- print OUT &quot;\\axis left shiftedto x=0 / \n&quot;;
- last YBRANCH;
- }
- if ($yticks &gt; 0)
- {
- if (index($axis, &quot;T&quot;)&gt;-1 &amp;&amp; index($axis, &quot;B&quot;)==-1)
- {
- print OUT &quot;\\axis left shiftedto x=0 ticks numbered from &quot;;
- print OUT &quot;$ylow to -$yticks by $yticks\n from $yticks to &quot;;
- print OUT $yhigh-$yticks,&quot; by $yticks /\n&quot;;
- }
- elsif (index($axis, &quot;T&quot;)==-1 &amp;&amp; index($axis, &quot;B&quot;)&gt;-1)
- {
- print OUT &quot;\\axis left shiftedto x=0 ticks numbered from &quot;;
- print OUT $ylow+$yticks,&quot; to -$yticks by $yticks\n from &quot;;
- print OUT &quot;$yticks to $yhigh by $yticks /\n&quot;;
- }
- elsif (index($axis, &quot;T&quot;)&gt;-1 &amp;&amp; index($axis, &quot;B&quot;)&gt;-1)
- {
- print OUT &quot;\\axis left shiftedto x=0 ticks numbered from &quot;;
- print OUT $ylow+$yticks,&quot; to -$yticks by $yticks\n from &quot;;
- print OUT &quot;$yticks to &quot;,$yhigh-$yticks,&quot; by $yticks /\n&quot;;
- }
- else
- {
- print OUT &quot;\\axis left shiftedto x=0 ticks numbered from &quot;;
- print OUT &quot;$ylow to -$yticks by $yticks\n from &quot;;
- print OUT &quot;$yticks to $yhigh by $yticks /\n&quot;;
- }
- }
- else
- {
- print OUT &quot;\\axis left shiftedto x=0 /\n&quot;;
- }
- }
- }
- XBRANCH: { if (index($axis, &quot;X&quot;)&gt;-1)
- {
- if (index($axis, &quot;X*&quot;)&gt;-1)
- {
- print OUT &quot;\\axis bottom shiftedto y=0 /\n&quot;;
- last XBRANCH;
- }
- if ($xticks &gt; 0)
- {
- if (index($axis, &quot;L&quot;)&gt;-1 &amp;&amp; index($axis, &quot;R&quot;)==1)
- {
- print OUT &quot;\\axis bottom shiftedto y=0 ticks numbered from &quot;;
- print OUT $xlow + $xticks,&quot; to -$xticks by $xticks\n from&quot;;
- print OUT &quot; $xticks to $xhigh by $xticks /\n&quot;;
- }
- elsif (index($axis, &quot;L&quot;)==-1 &amp;&amp; index($axis, &quot;R&quot;)&gt;-1)
- {
- print OUT &quot;\\axis bottom shiftedto y=0 ticks numbered from &quot;;
- print OUT &quot;$xlow to -$xticks by $xticks\n from &quot;;
- print OUT &quot;$xticks to &quot;,$xhigh-$xticks,&quot; by $xticks /\n&quot;;
- }
- elsif (index($axis, &quot;L&quot;)&gt;-1 &amp;&amp; index($axis, &quot;R&quot;)&gt;-1)
- {
- print OUT &quot;\\axis bottom shiftedto y=0 ticks numbered from &quot;;
- print OUT $xlow + $xticks,&quot; to -$xticks by $xticks\n from &quot;;
- print OUT &quot;$xticks to &quot;,$xhigh - $xticks,&quot; by $xticks /\n&quot;;
- }
- else
- {
- print OUT &quot;\\axis bottom shiftedto y=0 ticks numbered from &quot;;
- print OUT &quot;$xlow to -$xticks by $xticks\n from &quot;;
- print OUT &quot;$xticks to $xhigh by $xticks /\n&quot;;
- }
- }
- else
- {
- print OUT &quot;\\axis bottom shiftedto y=0 /\n&quot;;
- }
- } }
- LBRANCH: {if (index($axis, &quot;L&quot;)&gt;-1)
- {
- if (index($axis, &quot;L&quot;)&gt;-1)
- {
- if (index($axis, &quot;L*&quot;)&gt;-1)
- {
- print OUT &quot;\\axis left /\n&quot;;
- last LBRANCH;
- }
- if ($yticks &gt; 0)
- {
- print OUT &quot;\\axis left ticks numbered from &quot;;
- print OUT &quot;$ylow to $yhigh by $yticks /\n&quot;;
- }
- else
- {
- print OUT &quot;\\axis left /\n&quot;;
- }
- }
- } }
- RBRANCH: { if (index($axis, &quot;R&quot;)&gt;-1)
- {
- if (index($axis, &quot;R*&quot;)&gt;-1)
- {
- print OUT &quot;\\axis right /\n&quot;;
- last RBRANCH;
- }
- if ($yticks &gt; 0)
- {
- print OUT &quot;\\axis right ticks numbered from $ylow to $yhigh by &quot;;
- print OUT &quot;$yticks /\n&quot;;
- }
- else
- {
- print OUT &quot;\\axis right /\n&quot;;
- }
- } }
- TBRANCH: { if (index($axis, &quot;T&quot;)&gt;-1)
- {
- if (index($axis, &quot;T*&quot;)&gt;-1)
- {
- print OUT &quot;\\axis top /\n&quot;;
- last TBRANCH;
- }
- if ($xticks &gt; 0)
- {
- print OUT &quot;\\axis top ticks numbered from $xlow to $xhigh by &quot;;
- print OUT &quot;$xticks /\n&quot;;
- }
- else
- {
- print OUT &quot;\\axis top /\n&quot;;
- }
- } }
- BBRANCH: { if (index($axis, &quot;B&quot;)&gt;-1)
- {
- if (index($axis, &quot;B*&quot;)&gt;-1)
- {
- print OUT &quot;\\axis bottom /\n&quot;;
- last BBRANCH;
- }
- if ($xticks &gt; 0)
- {
- print OUT &quot;\\axis bottom ticks numbered from $xlow to $xhigh by &quot;;
- print OUT &quot;$xticks /\n&quot;;
- }
- else
- {
- print OUT &quot;\\axis bottom /\n&quot;;
- }
- } }
-
-
-</pre><p>The syntax of the <code>point</code> commands follows:
-<pre>
-point[*](PointName){Coordinates}[PointSymbol]
-</pre>
-where <code>PointName</code> is valid point name, <code>Coordinates</code> is either a
-pair of numbers denoting the coordinates of the point or an expression
-by means of which the system computes the coordinates of the point, and
-the <code>PointSymbol</code> is a valid T<sub><font size=+1>E</font></sub>X
-command denoting a point symbol. A valid point name consists of a
-letter and at most two trailing digits. That is, the names <code>a11</code>,
-<code>b2</code> and <code>c</code> are valid names while <code>qw</code> and <code>s123</code> are not.
-The first thing we do is to set the point shape to the default symbol
-(this has been initialized in the main program). Next, we check whether
-we have a <code>point</code>command or a <code>point*</code> simply by inspecting the very
-next token. Note that there must be no blank spaces between the token
-<code>point</code> and the star symbol. Next, we get the point name: remember that
-<a name="NWD21HcNW-1H">the point name is surrounded by parentheses. In case we don't find a valid</a>
-point name we issue an error message and continue with the next line of
-input. Suppose the point name was a valid one. If we have a <code>point*</code>
-command we must ensure that the this particular point name has been defined.
-If we have a <code>point</code> command we must ensure that this particular point
-name has not been defined. Point names are stored in the hash <code>%PointTable</code>.
-We are now ready to process the coordinates part and the optional
-plot symbol part.
-
-<pre><a name="NW21HcNW-2bvYBY-1" href="#NWD21HcNW-1H"><dfn>&lt;process <tt>point/point*</tt> commands&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
- my ($pointStar, $PointName, $origPN);
- $pointStar = 0; # default value: he have a point command
- $pointStar = 1 if s/^\*//;
- chk_lparen(&quot;point&quot; . (($pointStar)?&quot;*&quot;:&quot;&quot;),$lc);
- if (s/^([^\W\d_](?![^\W\d_])\d{0,3})//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(&quot;Invalid point name&quot;,$lc);
- next LINE;
- }
- #if ($pointStar and !exists($PointTable{$PointName})) {
- # PrintWarningMessage(&quot;Point $origPN has not been defined&quot;,$lc);
- #}
- if (!$pointStar and exists($PointTable{$PointName})) {
- PrintWarningMessage(&quot;Point $origPN has been used already&quot;,$lc);
- }
- chk_rparen(&quot;point&quot; . (($pointStar)?&quot;*&quot;:&quot;&quot;). &quot;($origPN&quot;,$lc);
- chk_lcb(&quot;point&quot; . (($pointStar)?&quot;*&quot;:&quot;&quot;). &quot;($origPN)&quot;,$lc);
- my ($Px, $Py);
- <a name="NW21HcNW-2bvYBY-1-u1" href="#NWD21HcNW-1I"><i>&lt;process coordinates&gt;</i></a>
- chk_rcb(&quot;coordinates part&quot;,$lc);
- my $sv = $defaultsymbol;
- my $sh = $defaultLFradius;
- my $side_or_radius = undef;
- if (s/^\[\s*//) { # the user has opted to specify the optional part
- <a name="NW21HcNW-2bvYBY-1-u2" href="#NWD21HcNW-1U"><i>&lt;process optional point shape part&gt;</i></a>
- chk_rsb(&quot;optional part&quot;,$lc);
- }
- # to avoid truncation problems introduced by the pack function, we
- # round each number up to five decimal digits
- $Px = sprintf(&quot;%.5f&quot;, $Px);
- $Py = sprintf(&quot;%.5f&quot;, $Py);
- print OUT &quot;%% point$Point_Line \t$origPN = ($Px, $Py)\n&quot; if $comments_on;
- chk_comment($lc);
- $PointTable{$PointName} = pack(&quot;d3A*&quot;,$Px,$Py,$sh,$sv);
- if (defined($side_or_radius)) {
- $DimOfPoint{$PointName} = $side_or_radius;
- }
-
-</pre><p>In this section we parse the <code>Coordinates</code> part of the <code>point</code> command.
-The complete syntax of the <code>Coordinates</code> part follows:
-<pre>
-Coordinates ::= Variable |
- Distance "," Distance |
- "midpoint" "(" Point-Name Point-Name ")" |
- "pointOnLine" "(" Two-Points "," Distance ")" |
- "intersection" "(" Two-Points "," Two-Points ")" |
- "perpendicular" "(" Point-Name "," Two-Points ")" |
- "circumCircleCenter" "(" Three-Points ") |
- "incircleCenter" "(" Three-Points ")" |
- "excircleCenter" "(" Three-Points "," Two-Points ")" |
- Point-Name [ "," Modifier ]
-
-Modifier ::= "shift" "(" Distance "," Distance ")" |
- "polar" "(" Distance, Distance [ "deg" | "rad" ] ")" |
- "rotate" "(" Point-Name, Distance [ "deg" | "rad" ] ")" |
- "vector" "(" Two-Points ")"
-
-Distance ::= expression
-
-Two-Points ::= Point-Name Point-Name
-
-Three-Points ::= Point-Name Two-Points
-</pre>
-We now briefly explain the functionality of each option:
-<ul>
-<li>midpoint(AB): the midpoint between points A and B</li>
-<li>pointOnLine(AB,d): point at distance d from A towards B</li>
-<li>intersection(AB,CD): intersection of lines defined by AB and CD</li>
-<li>perpendicular(A,BC): point of the foot of the perpendicular from A to line BC</li>
-<li>circumCircleCenter(ABC): center of circumcircle of triangle ABC</li>
-<li>incircleCenter(ABC):center of incircle of triangle ABC</li>
-<li>excircleCenter(ABC,BC): center of excircle of triangle ABC, touching
-side BC</li>
-<li>A, shift(x,y): Point displaced from A by x and y along the X and Y
-axes</li>
-<li>A, polar(r,d): Point displaced from A by distance r in direction d</li>
-<li>A, rotate(B,d): Rotate A about B by d</li>
-</ul>
-We now explain how the following piece of code operates. In case the first
-token is a number, we assume that the coordinates are specified by a
-number and another number, a variable or a pair of points. So, we check
-whether there is a comma and use the subroutine <code>ComputeDist</code> to get the
-second coordinate. In case the next token is one of the words
-<code>perpendicular</code>, <code>intersection</code>, <code>midpoint</code>, <code>pointonline</code>,
-<code>circumcircleCenter</code>, <code>IncircleCenter</code>, or <code>ExcircleCenter</code>
-we consume the corresponding token and process the corresponding case.
-In case the first two tokens are two identifiers, then we assume that we
-have a pair of numbers. We compute their distance, check whether there is
-a leading comma and compute the y-coordinate by calling subroutine
-<code>ComputeDist</code>. In case the next token is a single identifier, we store
-its name in the variable <code>$PointA</code>. If this identifier is a defined point name,
-we check whether the next token is a comma. In case it is, we check whether
-he token after the comma is either the token <code>shift</code>, <code>polar</code>, or
-<code>rotate</code> and process each case accordingly. If it is
-<a name="NWD21HcNW-1I">none of these tokens we issue an error message and continue with the next</a>
-input line. Now, if the token after the identifier isn't a comma, we assume
-that the coordinates of the point will be identical to those of the point
-whose name has been stored in the variable <code>$PointA</code>. If the identifier is a
-variable name, we assume that the x-coordinate is the value of this variable.
-We check whether the next token is a comma, and compute the y-coordinate by
-calling the subroutine <code>ComputeDist</code>. The x-coordinate is stored in the variable
-<code>$Px</code> and the y-coordinate in the variable <code>$Py</code>.
-
-<pre><a name="NW21HcNW-3bnmlP-1" href="#NWD21HcNW-1I"><dfn>&lt;process coordinates&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-1H">&lt;-U</a>)</b>
- if (s/^perpendicular(?=\W)//i) {
- <a name="NW21HcNW-3bnmlP-1-u1" href="#NWD21HcNW-1J"><i>&lt;process <tt>perpendicular</tt> case&gt;</i></a>
- }
- elsif (s/^intersection(?=\W)//i) {
- <a name="NW21HcNW-3bnmlP-1-u2" href="#NWD21HcNW-1K"><i>&lt;process <tt>intersection</tt> case&gt;</i></a>
- }
- elsif (s/^midpoint(?=\W)//i) {
- <a name="NW21HcNW-3bnmlP-1-u3" href="#NWD21HcNW-1L"><i>&lt;process <tt>midpoint</tt> case&gt;</i></a>
- }
- elsif (s/^pointonline(?=\W)//i) {
- <a name="NW21HcNW-3bnmlP-1-u4" href="#NWD21HcNW-1M"><i>&lt;process <tt>pointonline</tt> case&gt;</i></a>
- }
- elsif (s/^circumcircleCenter(?=\W)//i) {
- <a name="NW21HcNW-3bnmlP-1-u5" href="#NWD21HcNW-1N"><i>&lt;process <tt>circumcircleCenter</tt> case&gt;</i></a>
- }
- elsif (s/^IncircleCenter(?=\W)//i) {
- <a name="NW21HcNW-3bnmlP-1-u6" href="#NWD21HcNW-1O"><i>&lt;process <tt>IncircleCenter</tt> case&gt;</i></a>
- }
- elsif (s/^ExcircleCenter(?=\W)//i) {
- <a name="NW21HcNW-3bnmlP-1-u7" href="#NWD21HcNW-1P"><i>&lt;process <tt>ExcircleCenter</tt> case&gt;</i></a>
- }
- elsif (/^[^\W\d_]\d{0,3}\s*[^,\w]/) {
- m/^([^\W\d_]\d{0,3})\s*/i;
- if (exists($PointTable{lc($1)})) {
- my $Tcoord = get_point($lc);
- my ($x,$y,$pSV,$pS)=unpack(&quot;d3A*&quot;,$PointTable{$Tcoord});
- $Px = $x;
- $Py = $y;
- }
- else {
- $Px = expr();
- chk_comma($lc);
- $Py = expr();
- }
- }
- elsif (/[^\W\d_]\d{0,3}\s*,\s*shift|polar|rotate|vector/i) { #a point?
- s/^([^\W\d_]\d{0,3})//i;
- my $PointA = $1;
- if (exists($PointTable{lc($PointA)})) {
- s/\s*//;
- if (s/^,//) {
- s/\s*//;
- if (s/^shift(?=\W)//i) {
- <a name="NW21HcNW-3bnmlP-1-u8" href="#NWD21HcNW-1Q"><i>&lt;process <tt>shift</tt> case&gt;</i></a>
- }
- elsif (s/^polar(?=\W)//i) {
- <a name="NW21HcNW-3bnmlP-1-u9" href="#NWD21HcNW-1R"><i>&lt;process <tt>polar</tt> case&gt;</i></a>
- }
- elsif (s/^rotate(?=\W)//i) {
- <a name="NW21HcNW-3bnmlP-1-u10" href="#NWD21HcNW-1S"><i>&lt;process <tt>rotate</tt> case&gt;</i></a>
- }
- elsif (s/^vector(?=\W)//i) {
- <a name="NW21HcNW-3bnmlP-1-u11" href="#NWD21HcNW-1T"><i>&lt;process <tt>vector</tt> case&gt;</i></a>
- }
- else {
- PrintErrorMessage(&quot;unexpected token&quot;,$lc);
- next LINE;
- }
- }
- else {
- my ($xA,$yA,$pSVA,$pSA)=unpack(&quot;d3A*&quot;,$PointTable{lc($PointA)});
- $Px = $xA;
- $Py = $yA;
- }
- }
- else {
- PrintErrorMessage(&quot;Undefined point $PointA&quot;,$lc);
- next LINE;
- }
- }
- else {
- $Px = expr();
- chk_comma($lc);
- $Py = expr();
- }
-
-</pre><p>In the following piece of code we process the <code>perpendicular</code>
-case of the <code>point</code> specification. We first check whether there is an
-<a name="NWD21HcNW-1J">opening left parenthesis. Next, we get the first point name. In case</a>
-there is no point name, we simply abandon the processing of this
-line and continue with the next one. Then we see whether there is
-a trailing comma. Omitting this token yields a non-fatal error.
-Then we get two more points. As before, if we can't find any of these
-points this yields a fatal-error. Note, that each time we check that the
-point names correspond to existing point names. Then, we call subroutine
-<code>perpendicular</code> to calculate the coordinates of the point.
-
-<pre><a name="NW21HcNW-s2gHc-1" href="#NWD21HcNW-1J"><dfn>&lt;process <tt>perpendicular</tt> case&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-1I">&lt;-U</a>)</b>
- chk_lparen(&quot;perpendicular&quot;,$lc);
- my $FirstPoint = &amp;get_point($lc);
- next LINE if $FirstPoint eq &quot;_undef_&quot;;
- chk_comma($lc);
- my $SecondPoint = &amp;get_point($lc);
- next LINE if $SecondPoint eq &quot;_undef_&quot;;
- my $ThirdPoint = &amp;get_point($lc);
- next LINE if $ThirdPoint eq &quot;_undef_&quot;;
- chk_rparen(&quot;No closing parenthesis found&quot;,$lc);
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$FirstPoint});
- my ($x2,$y2,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$PointTable{$SecondPoint});
- my ($x3,$y3,$pSV3,$pS3)=unpack(&quot;d3A*&quot;,$PointTable{$ThirdPoint});
- ($Px, $Py) = perpendicular($x1,$y1,$x2,$y2,$x3,$y3);
-
-</pre><p><a name="NWD21HcNW-1K">In the following piece of code we process the </a><code>intersection</code> case of the
-<code>point</code> specification. We get the four point names and if there is
-no error we compute the intersection point by calling subroutine
-<code>intersection</code>.
-
-<pre><a name="NW21HcNW-1uJA3A-1" href="#NWD21HcNW-1K"><dfn>&lt;process <tt>intersection</tt> case&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-1I">&lt;-U</a>)</b>
- chk_lparen(&quot;intersection&quot;,$lc);
- my $FirstPoint = get_point($lc);
- next LINE if $FirstPoint eq &quot;_undef_&quot;;
- my $SecondPoint = get_point($lc);
- next LINE if $SecondPoint eq &quot;_undef_&quot;;
- chk_comma($lc);
- my $ThirdPoint = get_point($lc);
- next LINE if $ThirdPoint eq &quot;_undef_&quot;;
- my $ForthPoint = get_point($lc);
- next LINE if $ForthPoint eq &quot;_undef_&quot;;
- chk_rparen(&quot;No closing parenthesis found&quot;,$lc);
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$FirstPoint});
- my ($x2,$y2,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$PointTable{$SecondPoint});
- my ($x3,$y3,$pSV3,$pS3)=unpack(&quot;d3A*&quot;,$PointTable{$ThirdPoint});
- my ($x4,$y4,$pSV4,$pS4)=unpack(&quot;d3A*&quot;,$PointTable{$ForthPoint});
- ($Px, $Py) = intersection4points($x1,$y1,$x2,$y2,$x3,$y3,$x4,$y4);
-
-
-</pre><p><a name="NWD21HcNW-1L">Given two points A and B, the midpoint option computes the coordinates</a>
-of a third point that lies on the middle of the line segment defined by
-these two points. We get the the two points, and then we compute the
-coordinates of the midpoint by means of the simple formula:
-<center>
-m<sub>x</sub>=x<sub>1</sub>+(y<sub>2</sub> - y<sub>1</sub>)/2 <br>
-m<sub>y</sub>=y<sub>1</sub>+(x<sub>2</sub> - x<sub>1</sub>)/2
-</center>
-
-<pre><a name="NW21HcNW-3udkns-1" href="#NWD21HcNW-1L"><dfn>&lt;process <tt>midpoint</tt> case&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-1I">&lt;-U</a>)</b>
- chk_lparen(&quot;midpoint&quot;,$lc);
- my $FirstPoint = &amp;get_point($lc);
- next LINE if $FirstPoint eq &quot;_undef_&quot;;
- my $SecondPoint = &amp;get_point($lc);
- next LINE if $SecondPoint eq &quot;_undef_&quot;;
- chk_rparen(&quot;No closing parenthesis found&quot;,$lc);
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$FirstPoint});
- my ($x2,$y2,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$PointTable{$SecondPoint});
- $Px = $x1 + ($x2 - $x1)/2;
- $Py = $y1 + ($y2 - $y1)/2;
-
-</pre><p><a name="NWD21HcNW-1M">Given two points A and B and length d, the </a><code>PointOnLine</code> option
-computes the coordinates of a point that lies d units in the direction from
-A towards B. We first get the coordinates of the two points that define
-the line and then we get the distance, which can be a number, a variable,
-or a pair of points.
-
-<pre><a name="NW21HcNW-2ahy6i-1" href="#NWD21HcNW-1M"><dfn>&lt;process <tt>pointonline</tt> case&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-1I">&lt;-U</a>)</b>
- chk_lparen(&quot;pointonline&quot;,$lc);
- my $FirstPoint = &amp;get_point($lc);
- next LINE if $FirstPoint eq &quot;_undef_&quot;;
- my $SecondPoint = &amp;get_point($lc);
- next LINE if $SecondPoint eq &quot;_undef_&quot;;
- chk_comma($lc);
- # now get the distance
- my $distance = expr($lc);
- chk_rparen(&quot;No closing parenthesis found&quot;,$lc);
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$FirstPoint});
- my ($x2,$y2,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$PointTable{$SecondPoint});
- ($Px, $Py) = pointOnLine($x1,$y1,$x2,$y2,$distance);
-
-</pre><p><a name="NWD21HcNW-1N">The </a><code>circumcircleCenter</code> is used when one wants to compute the coordinates
-of the center of circle that passes through the three points
-of a triangle defined
-by the three arguments of the option. All we do is get the coordinates
-of the three points and then we call the subroutine <code>circumCircleCenter</code>
-to compute the center.
-
-<pre><a name="NW21HcNW-2TpCLC-1" href="#NWD21HcNW-1N"><dfn>&lt;process <tt>circumcircleCenter</tt> case&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-1I">&lt;-U</a>)</b>
- chk_lparen(&quot;circumCircleCenter&quot;,$lc);
- my $FirstPoint = &amp;get_point($lc);
- next LINE if $FirstPoint eq &quot;_undef_&quot;;
- my $SecondPoint = &amp;get_point($lc);
- next LINE if $SecondPoint eq &quot;_undef_&quot;;
- my $ThirdPoint = &amp;get_point($lc);
- next LINE if $ThirdPoint eq &quot;_undef_&quot;;
- chk_rparen(&quot;No closing parenthesis found&quot;,$lc);
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$FirstPoint});
- my ($x2,$y2,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$PointTable{$SecondPoint});
- my ($x3,$y3,$pSV3,$pS3)=unpack(&quot;d3A*&quot;,$PointTable{$ThirdPoint});
- ($Px, $Py,$r) = &amp;circumCircleCenter($x1,$y1,$x2,$y2,$x3,$y3,$lc);
- next LINE if $Px == 0 and $Py == 0 and $r == 0;
-
-</pre><p><a name="NWD21HcNW-1O">The </a><code>IncircleCenter</code> option is to determine the coordinates of a point
-that is the center of circle that internally touches the sides
-of a triangle defined by three given points.
-The coordinates are computed by the subroutine <code>IncircleCenter</code>.
-
-<pre><a name="NW21HcNW-4fhWIW-1" href="#NWD21HcNW-1O"><dfn>&lt;process <tt>IncircleCenter</tt> case&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-1I">&lt;-U</a>)</b>
- chk_lparen(&quot;IncircleCenter&quot;,$lc);
- my $FirstPoint = &amp;get_point($lc);
- next LINE if $FirstPoint eq &quot;_undef_&quot;;
- my $SecondPoint = &amp;get_point($lc);
- next LINE if $SecondPoint eq &quot;_undef_&quot;;
- my $ThirdPoint = &amp;get_point($lc);
- next LINE if $ThirdPoint eq &quot;_undef_&quot;;
- chk_rparen(&quot;No closing parenthesis found&quot;,$lc);
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$FirstPoint});
- my ($x2,$y2,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$PointTable{$SecondPoint});
- my ($x3,$y3,$pSV3,$pS3)=unpack(&quot;d3A*&quot;,$PointTable{$ThirdPoint});
- ($Px, $Py, $r) = IncircleCenter($x1,$y1,$x2,$y2,$x3,$y3);
-
-</pre><p>The <code>ExcircleCenter</code> option is used to define the coordinates of point
-that is the center of an excircle of a triangle. We first check
-whether there is an opening left parenthesis. Next, we get the names of the
-<a name="NWD21HcNW-1P">three points that define the triangle. Then, we</a>
-check whether there is a comma. Now we get the names of the two points that
-define one side of the triangle. We check whether the two points we
-get are of the set of the triangle points. If not we issue
-an error message and continue with the next input line. Then we make sure
-that these two points are not identical. We compute the actual
-coordinates by calling the subroutine <code>excircle</code>. Finally, we
-make sure there is a closing right parenthesis.
-
-<pre><a name="NW21HcNW-13KcO0-1" href="#NWD21HcNW-1P"><dfn>&lt;process <tt>ExcircleCenter</tt> case&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-1I">&lt;-U</a>)</b>
- chk_lparen(&quot;ExcircleCenter&quot;,$lc);
- my $PointA = get_point($lc);
- next LINE if $PointA eq &quot;_undef_&quot;;
- my $PointB = get_point($lc);
- next LINE if $PointB eq &quot;_undef_&quot;;
- my $PointC = get_point($lc);
- next LINE if $PointC eq &quot;_undef_&quot;;
- chk_comma($lc);
- my $PointD = &amp;get_point($lc);
- next LINE if $PointD eq &quot;_undef_&quot;;
- if (!memberOf($PointD, $PointA, $PointB, $PointC)) {
- PrintErrorMessage(&quot;Current point isn't a side point&quot;,$lc);
- next LINE;
- }
- my $PointE = get_point($lc);
- next LINE if $PointE eq &quot;_undef_&quot;;
- if (!memberOf($PointE, $PointA, $PointB, $PointC)) {
- PrintErrorMessage(&quot;Current point isn't a side point&quot;,$lc);
- next LINE;
- }
- if ($PointD eq $PointE) {
- PrintErrorMessage(&quot;Side points are identical&quot;,$lc);
- next LINE;
- }
- ($Px, $Py, $r) = excircle($PointA, $PointB, $PointC,
- $PointD, $PointE);
- chk_rparen(&quot;after coordinates part&quot;,$lc);
-
-</pre><p> <a name="NWD21HcNW-1Q">The </a><code>shift</code> option allows us to define a point's coordinates relative
-to the coordinates of an existing point by using two shift parameters. Each
-parameter can be either a float, a variable name, or a pair of points.
-
-<pre><a name="NW21HcNW-aOKf8-1" href="#NWD21HcNW-1Q"><dfn>&lt;process <tt>shift</tt> case&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-1I">&lt;-U</a> <a href="#NWD21HcNW-1Z">U-&gt;</a>)</b>
-
- chk_lparen(&quot;shift&quot;,$lc);
- my $dist1 = expr($lc);
- chk_comma($lc);
- my $dist2 = expr($lc);
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{lc($PointA)});
- $Px = $x1 + $dist1;
- $Py = $y1 + $dist2;
- chk_rparen(&quot;shift part&quot;,$lc);
-
-</pre><p><a name="NWD21HcNW-1R">The </a><code>polar</code> option allows us to define a point's coordinates relative
-to the coordinates of an existing point using the polar coordinates of some
-other point. We first check whether there is a left parenthesis,
-Then we parse the various parts of the <code>polar</code> option.
-In case the user has specified the angle in degrees, we have
-to transform it into radians, as all trigonometric function expect their
-arguments to be radians. Next, we compute the coordinates of the point.
-We conclude by checking whether there is a closing parenthesis.
-
-<pre><a name="NW21HcNW-2GUwzc-1" href="#NWD21HcNW-1R"><dfn>&lt;process <tt>polar</tt> case&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-1I">&lt;-U</a> <a href="#NWD21HcNW-1Z">U-&gt;</a>)</b>
- chk_lparen(&quot;polar&quot;,$lc);
- my ($R1, $Theta1);
- $R1 = expr($lc);
- chk_comma($lc);
- $Theta1 = expr($lc);
- my ($x1,$y1,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$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(&quot;after polar part&quot;,$lc);
-
-</pre><p>The <code>rotate</code> option allows us to define a point's coordinates by
-rotating an existing point, Q, about a third point, P, by a
-specified angle.
-The method to achieve this is to first get the coordinates of points
-P and Q and then
-<ol>
-<li> <a name="NWD21HcNW-1S">translate origin to P</a></li>
-<li> rotate about P</li>
-<li> translate from P back to origin, etc</li>
-</ol>
-As in the case of the <code>polar</code> option, we check for an opening parenthesis.
-Next, we parse the point name and the angle. At this point we are able to
-compute the coordinates of the rotated point. We conclude by checking
-whether there is a closing parenthesis.
-
-<pre><a name="NW21HcNW-42YuKP-1" href="#NWD21HcNW-1S"><dfn>&lt;process <tt>rotate</tt> case&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-1I">&lt;-U</a>)</b>
- chk_lparen(&quot;rotate&quot;,$lc);
- my $Q = lc($PointA);
- my $P = get_point($lc);
- next LINE if $P eq &quot;_undef_&quot;;
- chk_comma($lc);
- my $Theta1 = expr($lc);
- my ($xP,$yP,$pSV1,$pS1)=unpack(&quot;d3A*&quot;,$PointTable{$P});
- my ($xQ,$yQ,$pSV2,$pS2)=unpack(&quot;d3A*&quot;,$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(&quot;after rotate part&quot;,$lc);
-
-</pre><p> <code><a name="NWD21HcNW-1T">vector(PQ)</a></code> is actually is a shorthand of <code>shift(xQ-xP,yQ-yP)</code>. Thus, it
-is implemented by borrowing code from the <code>shift</code> modifier.
-
-<pre><a name="NW21HcNW-3FiNXu-1" href="#NWD21HcNW-1T"><dfn>&lt;process <tt>vector</tt> case&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-1I">&lt;-U</a>)</b>
- chk_lparen(&quot;vector&quot;,$lc);
- my ($x0,$y0,$pSV0,$pS0) = unpack(&quot;d3A*&quot;,$PointTable{lc($PointA)});
- my $P = get_point($lc);
- my $Q = get_point($lc);
- my ($x1,$y1,$pSV1,$pS1) = unpack(&quot;d3A*&quot;,$PointTable{$P});
- my ($x2,$y2,$pSV2,$pS2) = unpack(&quot;d3A*&quot;,$PointTable{$Q});
- $Px = $x0 + $x2 - $x1;
- $Py = $y0 + $y2 - $y1;
- chk_rparen(&quot;vector part&quot;,$lc);
-
-
-</pre><p> When lines are drawn to a point, the line will (unless otherwise
-specified) extend to the point location. However, this can be prevented by
-allocating an optional circular line-free zone to a point by specifying the
-radius (in square brackets) of the optional point shape part. Currently, in this part
-we are allowed to describe the point shape and the radius value. If only the
-radius is specified, e.g., <tt>[radius=5]</tt>, then the line-free zone will be
-applied to the default point character, i.e., <tt>$\bullet$</tt> or whatever it
-has been set to. Here is the syntax we employ:
-<pre>
-Optional_point_shape_part ::= "[" [ symbol_part ] [","] [ radius_part ]"
-<a name="NWD21HcNW-1U">symbol_part ::= "symbol" "=" symbol</a>
-symbol ::= "circle" "(" expression ")" |
- "square" "(" expression ")" |
- LaTeX_Code
-radius_part ::= "radius" "=" expression
-</pre>
-Note that it is possible to have right square bracket in the <tt>LaTeX_Code</tt> but it
-has to be escaped (i.e., <tt>\]</tt>).
-
-<pre><a name="NW21HcNW-48J1W6-1" href="#NWD21HcNW-1U"><dfn>&lt;process optional point shape part&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-1H">&lt;-U</a>)</b>
- 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 &lt;= 2) {
- my $option = lc($1);
- if (s/^=\s*//) {
- if (memberOf($option,@previous_options)) {
- PrintErrorMessage(&quot;Option \&quot;$option\&quot; has been already defined&quot;, $lc);
- my $dummy = expr($lc);
- }
- elsif ($option eq &quot;radius&quot;) {
- $sh = expr($lc);
- $sv = $defaultsymbol if ! $symbol_set;
- }
- elsif ($option eq &quot;symbol&quot;) {
- if (s/^circle\s*//i) {
- $sv = &quot;circle&quot;;
- chk_lparen(&quot;after token circle&quot;,$lc);
- $side_or_radius = expr($lc);
- chk_rparen(&quot;expression&quot;,$lc);
- }
- elsif (s/^square\s*//i) {
- $sv = &quot;square&quot;;
- chk_lparen(&quot;after token square&quot;,$lc);
- $side_or_radius = expr($lc);
- chk_rparen(&quot;expression&quot;,$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(&quot;unexpected token&quot;, $lc);
- next LINE;
- }
- $number_of_options++;
- push (@previous_options, $option);
- s/^,\s*//;
- }
- }
- else {
- PrintErrorMessage(&quot;unexpected token&quot;, $lc);
- next LINE;
- }
-
-</pre><p>The <code>ArrowShape</code> command has either one or three arguments. If the only argument of
-the command is the token <code>default</code>, then the parameters associated with the
-arrow shape resume their default values. Now, if there are three arguments, these are
-used to specify the shape of an arrow. The command actually sets the three global variables
-<code>$arrowLength</code>, <code>$arrowAngleB</code> and <code>$arrowAngleC</code>. Arguments whose value is equal
-to zero, do not affect the value of the corresponding global variables. To reset the
-values of the global variables one should use the commane with <code>default</code> as it
-only argument. The syntax of the command is as follows:
-<center>
-<tt><a name="NWD21HcNW-1V">"ArrowShape" "(" expr [ units ] "," expr "," expr ")"</a></tt> or<br>
-<tt>"ArrowShape" "(" "default" ")" </tt>
-</center>>
-Here <code>units</code> is any valid TeX unit (e.g., "mm", "cm", etc.). Note that if
-any of the three expressions is equal to zero, the default value is taken
-instead. As direct consequence, if the value of the first expression is zero,
-the units part is actually ignored.
-
-<pre><a name="NW21HcNW-4T61Ms-1" href="#NWD21HcNW-1V"><dfn>&lt;process <tt>ArrowShape</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
-
- chk_lparen(&quot;$cmd&quot;,$lc);
- if (s/^default//i) {
- $arrowLength = 2;
- $arrowLengthUnits = &quot;mm&quot;;
- $arrowAngleB = 30;
- $arrowAngleC = 40;
- }
- else {
- my ($LocalArrowLength, $LocalArrowAngleB ,$LocalArrowAngleC) = (0,0,0);
- $LocalArrowLength = expr($lc);
- if (s/^\s*($units)//i) {
- $arrowLengthUnits = &quot;$1&quot;;
- }
- else {
- $xunits =~ /(\d+(\.\d+)?)\s*($units)/;
- $LocalArrowLength *= $1;
- $arrowLengthUnits = &quot;$3&quot;;
- }
- chk_comma($lc);
- $LocalArrowAngleB = expr($lc);
- chk_comma($lc);
- $LocalArrowAngleC = expr($lc);
- $arrowLength = ($LocalArrowLength == 0 ? 2 : $LocalArrowLength);
- $arrowLengthUnits = ($LocalArrowLength == 0 ? &quot;mm&quot; : $arrowLengthUnits);
- $arrowAngleB = ($LocalArrowAngleB == 0 ? 30 : $LocalArrowAngleB);
- $arrowAngleC = ($LocalArrowAngleC == 0 ? 40 : $LocalArrowAngleC);
- }
- chk_rparen(&quot;after $cmd arguments&quot;,$lc);
- chk_comment(&quot;after $cmd command&quot;,$lc);
- print OUT &quot;%% arrowLength = $arrowLength$arrowLengthUnits, &quot;,
- &quot;arrowAngleB = $arrowAngleB &quot;,
- &quot;and arrowAngleC = $arrowAngleC\n&quot; if $comments_on;
-
-</pre><p>The <code>PointSymbol</code> command is used to set the point symbol and possibly its
-line-free radius. The point symbol can be either a LaTeX symbol or the word <code>default</code>
-which corresponds to the default point symbol, i.e., <tt>$\bullet$</tt>. The line-free
-radius can be an expression. Here is the complete syntax:
-<pre>
- <a name="NWD21HcNW-1W">pointsymbol ::= "pointsymbol" ( symbol [ "," radius])</a>
- symbol ::= "default" | circle | square | LaTeX_Code
- circle ::= "circle" "(" expression ")"
- square ::= "square" "(" expression ")"
- radius ::= expression
-</pre>
-Note that the <tt>LaTeX_Code</tt> can contain the symbols <tt>\,</tt> and
-<tt>\)</tt> which are escape sequences for a comma and right parenthesis, respectively.
-
-<pre><a name="NW21HcNW-iKtUD-1" href="#NWD21HcNW-1W"><dfn>&lt;process <tt>PointSymbol</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
-
- chk_lparen(&quot;$cmd&quot;,$lc);
- if (s/^default//i) #default point symbol
- {
- $defaultsymbol = &quot;\$\\bullet\$&quot;;
- }
- elsif (s/^(circle|square)//i) {
- $defaultsymbol = $1;
- chk_lparen($defaultsymbol, $lc);
- $GlobalDimOfPoints = expr($lc);
- chk_rparen(&quot;expression&quot;, $lc);
- }
- elsif (s/^(((\\,){1}|(\\\)){1}|(\\\s){1}|[^\),\s])+)//) #arbitrary LaTeX point
- {
- $defaultsymbol = $1;
- $defaultsymbol=~ s/\\\)/\)/g;
- $defaultsymbol=~ s/\\,/,/g;
- $defaultsymbol=~ s/\\ / /g;
- }
- else
- {
- PrintErrorMessage(&quot;unrecognized point symbol&quot;,$lc);
- }
- if (s/\s*,\s*//) {
- $defaultLFradius = expr($lc);
- }
- chk_rparen(&quot;after $cmd arguments&quot;,$lc);
- chk_comment(&quot;after $cmd command&quot;,$lc);
-
-</pre><p>The <code>system</code> command provides a shell escape. However, we use a subroutine
-to check whether the argument of the command contains tainted data. If this
-is the case, then we simply ignore this command. The syntax of the command
-is as follows:
-<pre>
- system-cmd ::= "system" "(" string ")"
-</pre>
-<a name="NWD21HcNW-1X">where string is just a sequence of characters enclosed in quotation marks.</a>
-We start by parsing a left parenthesis and then we get the command by
-calling the subroutine <code>get_string</code>. If there is an error we skip this
-command. Otherwise, we assign to the variable <code>$_</code> what is left. Now we check
-if the variable <code>$command</code> contains any tainted data. If it doesn't, we
-execute the command, otherwise we print an error message and skip to the
-next input line. Next, we check for closing right parenthesis and a possible
-trailing comment.
-
-<pre><a name="NW21HcNW-4C0pFV-1" href="#NWD21HcNW-1X"><dfn>&lt;process <tt>system</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
-
- chk_lparen(&quot;$cmd&quot;,$lc);
- my ($error, $command, $rest) = get_string($_);
- next LINE if $error == 1;
- $_ = $rest;
- if (! is_tainted($command)) {
- system($command);
- }
- else {
- PrintErrorMessage(&quot;String \&quot;$command\&quot; has tainted data&quot;, $lc);
- next LINE;
- }
- chk_rparen(&quot;after $cmd arguments&quot;,$lc);
- chk_comment(&quot;after $cmd command&quot;,$lc);
-
-</pre><p>The <code>text</code> command is used to put a piece of text or a symbol on
-a particular point of the resulting graph. The syntax of the command is
-as follows:
-<pre>
- text-comm ::= "text" "(" text ")" "{"coords"} "[" pos-code "]"
- text ::= ascii string
- coords ::= Coord "," Coord |
- Point-Name "," "shift" "(" Coord "," Coord ")" |
- Point-Name "," "polar" "(" Coord "," Coord [angle-unit] ")"
- Coord ::= decimal number | variable | pair-of-Point-Names
- pair-of-Point-Names ::= Point-Name Point-Name
- angle-unit ::= "deg" | "rad"
- pos-code ::= lr-code [tb-code] | tb-code [lr-code]
- lr-code ::= "l" | "r"
- tb-code ::= "t" | "b" | "B"
-</pre>
-Initially, we parse the <code>text</code>. Since the text may contain parentheses
-we assume that the user enters pairs of matching parentheses. Note, that
-this is a flaw in the original design of the language, which may be remedied
-in future releases of the software. Then, we check the <code>coords</code> part. Next,
-<a name="NWD21HcNW-1Y">if there is a left square bracket, we assume the user has specified the</a>
-<code>pos-code</code>. We conclude by checking a possible trailing comment.
-The next thing we do is to generate the PiCTeX code. The two possible
-forms follow:
-<center>
-<tt>\put {TEXT} [POS] at Px Py</tt><br>
-<tt>\put {TEXT} at Px Py</tt><br>
-</center>
-
-<pre><a name="NW21HcNW-z25eX-1" href="#NWD21HcNW-1Y"><dfn>&lt;process <tt>text</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
-
- chk_lparen(&quot;text&quot;,$lc);
- my ($level,$text)=(1,&quot;&quot;);
- TEXTLOOP: while (1)
- {
- $level++ if /^\(/;
- $level-- if /^\)/;
- s/^(.)//;
- last TEXTLOOP if $level==0;
- $text .= $1;
- }
- chk_lcb(&quot;text part&quot;,$lc);
- my ($Px, $Py,$dummy,$pos);
- $pos=&quot;&quot;;
- s/\s*//;
- <a name="NW21HcNW-z25eX-1-u1" href="#NWD21HcNW-1Z"><i>&lt;process coordinates part of text command&gt;</i></a>
- chk_rcb(&quot;coordinates part of text command&quot;,$lc);
- if (s/^\[//)
- {
- s/\s*//;
- <a name="NW21HcNW-z25eX-1-u2" href="#NWD21HcNW-1a"><i>&lt;process optional part of text command&gt;</i></a>
- s/\s*//;
- chk_rsb(&quot;optional part of text command&quot;,$lc);
- }
- chk_comment($lc);
- if ($pos eq &quot;&quot;)
- {
- printf OUT &quot;\\put {%s} at %f %f\n&quot;, $text, $Px, $Py;
- }
- else
- {
- printf OUT &quot;\\put {%s} [%s] at %f %f\n&quot;, $text, $pos, $Px, $Py;
- }
-
-</pre><p> In this section we define the code that handles the coordinates part
-<a name="NWD21HcNW-1Z">of the </a><code>text</code> command. The code just implements the grammar given above.
-If the first token is a number, we assume this is the x-coordinate. If
-it is a variable, we assume its value is the x-coordinate. However, if
-it is a point name, we check whether the next token is another point name.
-In this case we compute the distance between the two points. In case we
-have a single point followed by a comma, we expect to have either a polar
-or a shift part, which we process the same we processed them in the point
-command.
-
-<pre><a name="NW21HcNW-Ee8Ug-1" href="#NWD21HcNW-1Z"><dfn>&lt;process coordinates part of text command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-1Y">&lt;-U</a>)</b>
-
- if (/^[^\W\d_]\d{0,3}\s*[^,\w]/) {
- my $Tcoord = get_point($lc);
- my ($x,$y,$pSV,$pS)=unpack(&quot;d3A*&quot;,$PointTable{$Tcoord});
- $Px = $x;
- $Py = $y;
- }
- elsif (/[^\W\d_]\d{0,3}\s*,\s*shift|polar/i) {
- s/^([^\W\d_]\d{0,3})//i;
- my $PointA = $1;
- if (exists($PointTable{lc($PointA)})) {
- s/\s*//;
- if (s/^,//) {
- s/\s*//;
- if (s/^shift(?=\W)//i) {
- <a name="NW21HcNW-Ee8Ug-1-u1" href="#NWD21HcNW-1Q"><i>&lt;process <tt>shift</tt> case&gt;</i></a>
- }
- elsif (s/^polar(?=\W)//i) {
- <a name="NW21HcNW-Ee8Ug-1-u2" href="#NWD21HcNW-1R"><i>&lt;process <tt>polar</tt> case&gt;</i></a>
- }
- }
- }
- else {
- PrintErrorMessage(&quot;undefined point/var&quot;,$lc);
- next LINE;
- }
- }
- else {
- $Px = expr();
- chk_comma($lc);
- $Py = expr();
- }
-
-</pre><p>In this section we process the optional part of the <code>text</code> command.
-The general rule is that we are allowed to have up to two options one
-from the characters <code>l</code> and <code>r</code> and one from the the characters
-<code>B</code>, <code>b</code>, and <code>t</code>. We first check whether the next character is
-letter, if it isn't we issue an error message and continue with the next
-input line. If it is a letter we check whether it belongs to one of the
-two groups and if it doesn't we issue an error message and continue with the
-next input line. If the next character belongs to first group, i.e., it is
-either <code>l</code> or <code>r</code>, we store this character into the variable <code>$pos</code>. Next,
-<a name="NWD21HcNW-1a">we check whether there is another letter. If it is a letter, we store it</a>
-in the variable <code>$np</code>. Now we make sure that this character belongs to the
-other group, i.e., it is either <code>b</code>, <code>B</code>, or <code>t</code>. In case it belongs
-to the other group, we append the value of <code>$np</code> to the string stored in
-the variable <code>$pos</code>. Otherwise we issue an error message and continue with the
-next input line. We work similarly for the other case. In order to check
-whether a character belongs to some group of characters, we use the user
-defined function <code>memberOf</code>.
-
-<pre><a name="NW21HcNW-RSg70-1" href="#NWD21HcNW-1a"><dfn>&lt;process optional part of text command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-1Y">&lt;-U</a>)</b>
-
- if (s/^(\w{1})\s*//) {
- $pos .= $1;
- if (memberOf($pos, &quot;l&quot;, &quot;r&quot;)) {
- if (s/^(\w{1})\s*//) {
- my $np = $1;
- if (memberOf($np, &quot;t&quot;, &quot;b&quot;, &quot;B&quot;)) {
- $pos .= $np;
- }
- else {
- if (memberOf($np, &quot;l&quot;, &quot;r&quot;)) {
- PrintErrorMessage(&quot;$np can't follow 'l' or 'r'&quot;, $lc);
- }
- else {
- PrintErrorMessage(&quot;$np is not a valid positioning option&quot;, $lc);
- }
- next LINE;
- }
- }
- }
- elsif (memberOf($pos, &quot;t&quot;, &quot;b&quot;, &quot;B&quot;)) {
- if (s/^(\w{1})\s*//) {
- my $np = $1;
- if (memberOf($np, &quot;l&quot;, &quot;r&quot;)) {
- $pos .= $np;
- }
- else {
- if (memberOf($np, &quot;t&quot;, &quot;b&quot;, &quot;B&quot;)) {
- PrintErrorMessage(&quot;$np can't follow 't', 'b', or 'B'&quot;, $lc);
- }
- else {
- PrintErrorMessage(&quot;$np is not a valid positioning option&quot;, $lc);
- }
- next LINE;
- }
- }
- }
- else {
- PrintErrorMessage(&quot;$pos is not a valid positioning option&quot;, $lc);
- next LINE;
- }
- }
- else {
- PrintErrorMessage(&quot;illegal token in optional part of text command&quot;,$lc);
- next LINE;
- }
-
-</pre><p>The <code>const</code> command is used to store values into a comma separated
-list of named constants. Constant names have the same format as point names,
-i.e., they start with a letter and are followed by up to two digits. The
-<a name="NWD21HcNW-1b">whole operation is performed by a </a><code>do-while</code> construct that checks that
-there is a valid constant name, a <code>=</code> sign, and an expression. The
-<code>do-while</code> construct terminates if the next token isn't a comma. Variable
-<code>$Constname</code> is used to store the initial variable name, while we store
-in variable <code>$varname</code> the lowercase version of the variable name. In addition,
-we make sure a constant is not redefined (or else it wouldn't be a constant:-).
-The last thing we do is to check whether there is a trailing comment.
-In case there, we simply ignore itl; otherwise we print a warning message.
-
-<pre><a name="NW21HcNW-4F0xHm-1" href="#NWD21HcNW-1b"><dfn>&lt;process <tt>const</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
- do{
- s/\s*//;
- PrintErrorMessage(&quot;no identifier found after token const&quot;,$lc)
- if $_ !~ s/^([^\W\d_]\d{0,3})//i;
- my $Constname = $1;
- my $constname = lc($Constname);
- if (exists $ConstTable{$constname}) {
- PrintErrorMessage(&quot;Redefinition of constant $constname&quot;,$lc);
- }
- s/\s*//; #remove leading white space
- PrintErrorMessage(&quot;did not find expected = sign&quot;,$lc)
- if $_ !~ s/^[=]//i;
- my $val = expr($lc);
- $VarTable{$constname} = $val;
- $ConstTable{$constname} = 1;
- print OUT &quot;%% $Constname = $val\n&quot; if $comments_on;
- }while (s/^,//);
- chk_comment($lc);
- s/\s*//;
- if (/^[^%]/) {
- PrintWarningMessage(&quot;Trailing text is ignored&quot;,$lc);
- }
-
-</pre><p>The <code>var</code> command is used to store values into a comma separated
-list of named variables. Variable names have the same format as point names,
-<a name="NWD21HcNW-1c">i.e., they start with a letter and are followed by up to two digits. The</a>
-whole operation is performed by a <code>do-while</code> construct that checks that
-there is a valid variable name, a <code>=</code> sign, and an expression. The
-<code>do-while</code> construct terminates if the next token isn't a comma. The variable
-<code>$Varname</code> is used to store the initial variable name, while we store
-in the variable <code>$varname</code> the lowercase version of the variable name.
-The last thing we do is to check whether there is a trailing comment.
-In case there, we simply ignore itl; otherwise we print a warning message.
-
-<pre><a name="NW21HcNW-2NFa6I-1" href="#NWD21HcNW-1c"><dfn>&lt;process <tt>var</tt> command&gt;=</dfn></a> <b>(<a href="#NWD21HcNW-q">&lt;-U</a>)</b>
- do{
- s/\s*//;
- PrintErrorMessage(&quot;no identifier found after token var&quot;,$lc)
- if $_ !~ s/^([^\W\d_]\d{0,3})//i;
- my $Varname = $1;
- my $varname = lc($Varname);
- if (exists $ConstTable{$varname}) {
- PrintErrorMessage(&quot;Redefinition of constant $varname&quot;,$lc);
- }
- s/\s*//; #remove leading white space
- PrintErrorMessage(&quot;did not find expected = sign&quot;,$lc)
- if $_ !~ s/^[=]//i;
- my $val = expr($lc);
- $VarTable{$varname} = $val;
- print OUT &quot;%% $Varname = $val\n&quot; if $comments_on;
- }while (s/^,//);
- chk_comment($lc);
- s/\s*//;
- if (/^[^%]/) {
- PrintWarningMessage(&quot;Trailing text is ignored&quot;,$lc);
- }
-</pre>
-
-<ul>
-<li><a href="#NWD21HcNW-2"><i>&lt;*&gt;</i></a>: <a href="#NWD21HcNW-2">D1</a>
-<li><a href="#NWD21HcNW-4"><i>&lt;Check for command line arguments&gt;</i></a>: <a href="#NWD21HcNW-2">U1</a>, <a href="#NWD21HcNW-4">D2</a>
-<li><a href="#NWD21HcNW-6"><i>&lt;Check if .m file exists&gt;</i></a>: <a href="#NWD21HcNW-4">U1</a>, <a href="#NWD21HcNW-6">D2</a>
-<li><a href="#NWD21HcNW-8"><i>&lt;Define global variables&gt;</i></a>: <a href="#NWD21HcNW-2">U1</a>, <a href="#NWD21HcNW-8">D2</a>
-<li><a href="#NWD21HcNW-1D"><i>&lt;generate plot area related commands&gt;</i></a>: <a href="#NWD21HcNW-16">U1</a>, <a href="#NWD21HcNW-1D">D2</a>
-<li><a href="#NWD21HcNW-1G"><i>&lt;generate the rest of the code for the <tt>paper</tt> command&gt;</i></a>: <a href="#NWD21HcNW-16">U1</a>, <a href="#NWD21HcNW-1G">D2</a>
-<li><a href="#NWD21HcNW-3"><i>&lt;package <tt>DummyFH</tt> &gt;</i></a>: <a href="#NWD21HcNW-2">U1</a>, <a href="#NWD21HcNW-3">D2</a>
-<li><a href="#NWD21HcNW-t"><i>&lt;process <tt>angle</tt> part of command&gt;</i></a>: <a href="#NWD21HcNW-s">U1</a>, <a href="#NWD21HcNW-t">D2</a>
-<li><a href="#NWD21HcNW-1V"><i>&lt;process <tt>ArrowShape</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-1V">D2</a>
-<li><a href="#NWD21HcNW-1E"><i>&lt;process <tt>axis</tt> part&gt;</i></a>: <a href="#NWD21HcNW-16">U1</a>, <a href="#NWD21HcNW-1E">D2</a>
-<li><a href="#NWD21HcNW-1N"><i>&lt;process <tt>circumcircleCenter</tt> case&gt;</i></a>: <a href="#NWD21HcNW-1I">U1</a>, <a href="#NWD21HcNW-1N">D2</a>
-<li><a href="#NWD21HcNW-1b"><i>&lt;process <tt>const</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-1b">D2</a>
-<li><a href="#NWD21HcNW-r"><i>&lt;process <tt>dasharray</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-r">D2</a>
-<li><a href="#NWD21HcNW-s"><i>&lt;process <tt>drawAngleArcOrArrow</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-s">D2</a>
-<li><a href="#NWD21HcNW-v"><i>&lt;process <tt>drawcircle</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-v">D2</a>
-<li><a href="#NWD21HcNW-w"><i>&lt;process <tt>drawcircumcircle</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-w">D2</a>
-<li><a href="#NWD21HcNW-x"><i>&lt;process <tt>drawexcircle</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-x">D2</a>
-<li><a href="#NWD21HcNW-y"><i>&lt;process <tt>drawincircle</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-y">D2</a>
-<li><a href="#NWD21HcNW-z"><i>&lt;process <tt>drawPerpendicular</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-z">D2</a>
-<li><a href="#NWD21HcNW-10"><i>&lt;process <tt>drawpoint</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-10">D2</a>
-<li><a href="#NWD21HcNW-11"><i>&lt;process <tt>drawRightAngle</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-11">D2</a>
-<li><a href="#NWD21HcNW-12"><i>&lt;process <tt>drawsquare</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-12">D2</a>
-<li><a href="#NWD21HcNW-1P"><i>&lt;process <tt>ExcircleCenter</tt> case&gt;</i></a>: <a href="#NWD21HcNW-1I">U1</a>, <a href="#NWD21HcNW-1P">D2</a>
-<li><a href="#NWD21HcNW-1O"><i>&lt;process <tt>IncircleCenter</tt> case&gt;</i></a>: <a href="#NWD21HcNW-1I">U1</a>, <a href="#NWD21HcNW-1O">D2</a>
-<li><a href="#NWD21HcNW-13"><i>&lt;process <tt>inputfile*</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-13">D2</a>
-<li><a href="#NWD21HcNW-14"><i>&lt;process <tt>inputfile</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-14">D2</a>
-<li><a href="#NWD21HcNW-1K"><i>&lt;process <tt>intersection</tt> case&gt;</i></a>: <a href="#NWD21HcNW-1I">U1</a>, <a href="#NWD21HcNW-1K">D2</a>
-<li><a href="#NWD21HcNW-15"><i>&lt;process <tt>linethickness</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-15">D2</a>
-<li><a href="#NWD21HcNW-1L"><i>&lt;process <tt>midpoint</tt> case&gt;</i></a>: <a href="#NWD21HcNW-1I">U1</a>, <a href="#NWD21HcNW-1L">D2</a>
-<li><a href="#NWD21HcNW-16"><i>&lt;process <tt>paper</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-16">D2</a>
-<li><a href="#NWD21HcNW-1J"><i>&lt;process <tt>perpendicular</tt> case&gt;</i></a>: <a href="#NWD21HcNW-1I">U1</a>, <a href="#NWD21HcNW-1J">D2</a>
-<li><a href="#NWD21HcNW-1H"><i>&lt;process <tt>point/point*</tt> commands&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-1H">D2</a>
-<li><a href="#NWD21HcNW-1M"><i>&lt;process <tt>pointonline</tt> case&gt;</i></a>: <a href="#NWD21HcNW-1I">U1</a>, <a href="#NWD21HcNW-1M">D2</a>
-<li><a href="#NWD21HcNW-1W"><i>&lt;process <tt>PointSymbol</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-1W">D2</a>
-<li><a href="#NWD21HcNW-1R"><i>&lt;process <tt>polar</tt> case&gt;</i></a>: <a href="#NWD21HcNW-1I">U1</a>, <a href="#NWD21HcNW-1R">D2</a>, <a href="#NWD21HcNW-1Z">U3</a>
-<li><a href="#NWD21HcNW-u"><i>&lt;process <tt>radius</tt> part of command&gt;</i></a>: <a href="#NWD21HcNW-s">U1</a>, <a href="#NWD21HcNW-u">D2</a>
-<li><a href="#NWD21HcNW-1S"><i>&lt;process <tt>rotate</tt> case&gt;</i></a>: <a href="#NWD21HcNW-1I">U1</a>, <a href="#NWD21HcNW-1S">D2</a>
-<li><a href="#NWD21HcNW-1Q"><i>&lt;process <tt>shift</tt> case&gt;</i></a>: <a href="#NWD21HcNW-1I">U1</a>, <a href="#NWD21HcNW-1Q">D2</a>, <a href="#NWD21HcNW-1Z">U3</a>
-<li><a href="#NWD21HcNW-1A"><i>&lt;process <tt>showAngle</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-1A">D2</a>
-<li><a href="#NWD21HcNW-1B"><i>&lt;process <tt>showArea</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-1B">D2</a>
-<li><a href="#NWD21HcNW-1C"><i>&lt;process <tt>showLength</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-1C">D2</a>
-<li><a href="#NWD21HcNW-1X"><i>&lt;process <tt>system</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-1X">D2</a>
-<li><a href="#NWD21HcNW-1Y"><i>&lt;process <tt>text</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-1Y">D2</a>
-<li><a href="#NWD21HcNW-1F"><i>&lt;process <tt>ticks</tt> part&gt;</i></a>: <a href="#NWD21HcNW-16">U1</a>, <a href="#NWD21HcNW-1F">D2</a>
-<li><a href="#NWD21HcNW-17"><i>&lt;process <tt>unit</tt> part&gt;</i></a>: <a href="#NWD21HcNW-16">U1</a>, <a href="#NWD21HcNW-17">D2</a>
-<li><a href="#NWD21HcNW-1c"><i>&lt;process <tt>var</tt> command&gt;</i></a>: <a href="#NWD21HcNW-q">U1</a>, <a href="#NWD21HcNW-1c">D2</a>
-<li><a href="#NWD21HcNW-1T"><i>&lt;process <tt>vector</tt> case&gt;</i></a>: <a href="#NWD21HcNW-1I">U1</a>, <a href="#NWD21HcNW-1T">D2</a>
-<li><a href="#NWD21HcNW-18"><i>&lt;process <tt>xrange</tt> part&gt;</i></a>: <a href="#NWD21HcNW-16">U1</a>, <a href="#NWD21HcNW-18">D2</a>
-<li><a href="#NWD21HcNW-19"><i>&lt;process <tt>yrange</tt> part&gt;</i></a>: <a href="#NWD21HcNW-16">U1</a>, <a href="#NWD21HcNW-19">D2</a>
-<li><a href="#NWD21HcNW-5"><i>&lt;Process command line arguments&gt;</i></a>: <a href="#NWD21HcNW-4">U1</a>, <a href="#NWD21HcNW-5">D2</a>
-<li><a href="#NWD21HcNW-1I"><i>&lt;process coordinates&gt;</i></a>: <a href="#NWD21HcNW-1H">U1</a>, <a href="#NWD21HcNW-1I">D2</a>
-<li><a href="#NWD21HcNW-1Z"><i>&lt;process coordinates part of text command&gt;</i></a>: <a href="#NWD21HcNW-1Y">U1</a>, <a href="#NWD21HcNW-1Z">D2</a>
-<li><a href="#NWD21HcNW-7"><i>&lt;process file&gt;</i></a>: <a href="#NWD21HcNW-2">U1</a>, <a href="#NWD21HcNW-7">D2</a>
-<li><a href="#NWD21HcNW-q"><i>&lt;process input line&gt;</i></a>: <a href="#NWD21HcNW-p">U1</a>, <a href="#NWD21HcNW-q">D2</a>
-<li><a href="#NWD21HcNW-1a"><i>&lt;process optional part of text command&gt;</i></a>: <a href="#NWD21HcNW-1Y">U1</a>, <a href="#NWD21HcNW-1a">D2</a>
-<li><a href="#NWD21HcNW-1U"><i>&lt;process optional point shape part&gt;</i></a>: <a href="#NWD21HcNW-1H">U1</a>, <a href="#NWD21HcNW-1U">D2</a>
-<li><a href="#NWD21HcNW-W"><i>&lt;subroutine <tt>Angle</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-W">D2</a>
-<li><a href="#NWD21HcNW-K"><i>&lt;subroutine <tt>chk_comma</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-K">D2</a>
-<li><a href="#NWD21HcNW-L"><i>&lt;subroutine <tt>chk_comment</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-L">D2</a>
-<li><a href="#NWD21HcNW-G"><i>&lt;subroutine <tt>chk_lcb</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-G">D2</a>
-<li><a href="#NWD21HcNW-E"><i>&lt;subroutine <tt>chk_lparen</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-E">D2</a>
-<li><a href="#NWD21HcNW-I"><i>&lt;subroutine <tt>chk_lsb</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-I">D2</a>
-<li><a href="#NWD21HcNW-H"><i>&lt;subroutine <tt>chk_rcb</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-H">D2</a>
-<li><a href="#NWD21HcNW-F"><i>&lt;subroutine <tt>chk_rparen</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-F">D2</a>
-<li><a href="#NWD21HcNW-J"><i>&lt;subroutine <tt>chk_rsb</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-J">D2</a>
-<li><a href="#NWD21HcNW-S"><i>&lt;subroutine <tt>circumCircleCenter</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-S">D2</a>
-<li><a href="#NWD21HcNW-T"><i>&lt;subroutine <tt>ComputeDist</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-T">D2</a>
-<li><a href="#NWD21HcNW-d"><i>&lt;subroutine <tt>drawAngleArc</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-d">D2</a>
-<li><a href="#NWD21HcNW-e"><i>&lt;subroutine <tt>drawAngleArrow</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-e">D2</a>
-<li><a href="#NWD21HcNW-Z"><i>&lt;subroutine <tt>drawarrows</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-Z">D2</a>
-<li><a href="#NWD21HcNW-b"><i>&lt;subroutine <tt>drawCurve</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-b">D2</a>
-<li><a href="#NWD21HcNW-Y"><i>&lt;subroutine <tt>DrawLineOrArrow</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-Y">D2</a>
-<li><a href="#NWD21HcNW-a"><i>&lt;subroutine <tt>drawlines</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-a">D2</a>
-<li><a href="#NWD21HcNW-c"><i>&lt;subroutine <tt>drawpoints</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-c">D2</a>
-<li><a href="#NWD21HcNW-l"><i>&lt;subroutine <tt>drawsquare</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-l">D2</a>
-<li><a href="#NWD21HcNW-X"><i>&lt;subroutine <tt>excircle</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-X">D2</a>
-<li><a href="#NWD21HcNW-f"><i>&lt;subroutine <tt>expr</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-f">D2</a>
-<li><a href="#NWD21HcNW-N"><i>&lt;subroutine <tt>get_point</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-N">D2</a>
-<li><a href="#NWD21HcNW-i"><i>&lt;subroutine <tt>get_string</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-i">D2</a>
-<li><a href="#NWD21HcNW-V"><i>&lt;subroutine <tt>IncircleCenter</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-V">D2</a>
-<li><a href="#NWD21HcNW-U"><i>&lt;subroutine <tt>intersection4points</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-U">D2</a>
-<li><a href="#NWD21HcNW-j"><i>&lt;subroutine <tt>is_tainted</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-j">D2</a>
-<li><a href="#NWD21HcNW-P"><i>&lt;subroutine <tt>Length</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-P">D2</a>
-<li><a href="#NWD21HcNW-g"><i>&lt;subroutine <tt>memberOf</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-g">D2</a>
-<li><a href="#NWD21HcNW-A"><i>&lt;subroutine <tt>mpp</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-A">D2</a>
-<li><a href="#NWD21HcNW-k"><i>&lt;subroutine <tt>noOfDigits</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-k">D2</a>
-<li><a href="#NWD21HcNW-O"><i>&lt;subroutine <tt>perpendicular</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-O">D2</a>
-<li><a href="#NWD21HcNW-R"><i>&lt;subroutine <tt>pointOnLine</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-R">D2</a>
-<li><a href="#NWD21HcNW-M"><i>&lt;subroutine <tt>print_headers</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-M">D2</a>
-<li><a href="#NWD21HcNW-B"><i>&lt;subroutine <tt>PrintErrorMessage</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-B">D2</a>
-<li><a href="#NWD21HcNW-D"><i>&lt;subroutine <tt>PrintFatalError</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-D">D2</a>
-<li><a href="#NWD21HcNW-C"><i>&lt;subroutine <tt>PrintWarningMessage</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-C">D2</a>
-<li><a href="#NWD21HcNW-p"><i>&lt;subroutine <tt>process_input</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-p">D2</a>
-<li><a href="#NWD21HcNW-o"><i>&lt;subroutine <tt>setLineThickness</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-o">D2</a>
-<li><a href="#NWD21HcNW-n"><i>&lt;subroutine <tt>sp2X</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-n">D2</a>
-<li><a href="#NWD21HcNW-h"><i>&lt;subroutine <tt>tand</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-h">D2</a>
-<li><a href="#NWD21HcNW-Q"><i>&lt;subroutine <tt>triangleArea</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-Q">D2</a>
-<li><a href="#NWD21HcNW-m"><i>&lt;subroutine <tt>X2sp</tt> &gt;</i></a>: <a href="#NWD21HcNW-9">U1</a>, <a href="#NWD21HcNW-m">D2</a>
-<li><a href="#NWD21HcNW-9"><i>&lt;subroutine definitions&gt;</i></a>: <a href="#NWD21HcNW-2">U1</a>, <a href="#NWD21HcNW-9">D2</a>
-</ul>
-</body></html>
-