1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 4154 4155 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 4395 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 4408 4409 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 4480 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500 4501 4502 4503 4504 4505 4506 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 4521 4522 4523 4524 4525 4526 4527 4528 4529 4530 4531 4532 4533 4534 4535 4536 4537 4538 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 4552 4553 4554 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 4585 4586 4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 4808 4809 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 4836 4837 4838 4839 4840 4841 4842 4843 4844 4845 4846 4847 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 4862 4863 4864 4865 4866 4867 4868 4869 4870 4871 4872 4873 4874 4875 4876 4877 4878 4879 4880 4881 4882 4883 4884 4885 4886 4887 4888 4889 4890 4891 4892 4893 4894 4895 4896 4897 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 4915 4916 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 4938 4939 4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 4998 4999 5000 5001 5002 5003 5004 5005 5006 5007 5008 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 5024 5025 5026 5027 5028 5029 5030 5031 5032 5033 5034 5035 5036 5037 5038 5039 5040 5041 5042 5043 5044 5045 5046 5047 5048 5049 5050 5051 5052 5053 5054 5055 5056 5057 5058 5059 5060 5061 5062 5063 5064 5065 5066 5067 5068 5069 5070 5071 5072 5073 5074 5075 5076 5077 5078 5079 5080 5081 5082 5083 5084 5085 5086 5087 5088 5089 5090 5091 5092 5093 5094 5095 5096 5097 5098 5099 5100 5101 5102 5103 5104 5105 5106 5107 5108 5109 5110 5111 5112 5113 5114 5115 5116 5117 5118 5119 5120 5121 5122 5123 5124 5125 5126 5127 5128
|
<!-- this file was generated automatically by noweave; better not edit it-->
<html><head><title>mathsPIC.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/>
Consultant in Anaesthesia & Intensive Care (retired)<br/>
c/o Department of Anaesthesia<br/>
Nottingham University Hospitals<br/>
<a name="NWDCUvTi-1">City Hospital Campus</a><br/>
Hucknall Road<br/>
Nottingham NG5 1PB, UK<br/>
email:<tt>dick@nickalls.org</tt>
</address></td>
</table></h2>
version 1.13 Apr 26, 2010
</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="NWDCUvTi-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="NWCUvTi-1p0Y9w-1" href="#NWDCUvTi-2"><dfn><*>=</dfn></a>
#!/usr/bin/perl
#
#(c) Copyright 2005-2010
# Apostolos Syropoulos & R.W.D. Nickalls
# asyropoulos@yahoo.com dick@nickalls.org
#
# This program can be redistributed and/or modified under the terms
# of the LaTeX Project Public License Distributed from CTAN
# archives in directory macros/latex/base/lppl.txt; either
# version 1 of the License, or any later version.
#
<a name="NWCUvTi-1p0Y9w-1-u1" href="#NWDCUvTi-3"><i><package <tt>DummyFH</tt> ></i></a>
package main;
use Math::Trig;
<a name="NWCUvTi-1p0Y9w-1-u2" href="#NWDCUvTi-8"><i><Define global variables></i></a>
<a name="NWCUvTi-1p0Y9w-1-u3" href="#NWDCUvTi-9"><i><subroutine definitions></i></a>
<a name="NWCUvTi-1p0Y9w-1-u4" href="#NWDCUvTi-4"><i><Check for command line arguments></i></a>
<a name="NWCUvTi-1p0Y9w-1-u5" href="#NWDCUvTi-7"><i><process file></i></a>
print $alarm if $no_errors > 0;
__END__
</pre><p><a name="NWDCUvTi-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="NWCUvTi-2YwRNH-1" href="#NWDCUvTi-3"><dfn><package <tt>DummyFH</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-2"><-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 > $#$self) {
$index = 0;
return undef;
}
else {
return $self->[$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="NWDCUvTi-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="NWCUvTi-122Dzz-1" href="#NWDCUvTi-4"><dfn><Check for command line arguments>=</dfn></a> <b>(<a href="#NWDCUvTi-2"><-U</a>)</b>
our $alarm="";
our $comments_on=1;
our $out_file="default";
our $argc=@ARGV;
if ($argc == 0 || $argc > 5 ){ # no command line arguments or more than 4
# arguments
die "\nmathspic version $version_number\n" .
"Usage: mathspic [-h] [-b] [-c] [-o <out file>] <in file>\n\n";
}
else {
<a name="NWCUvTi-122Dzz-1-u1" href="#NWDCUvTi-5"><i><Process command line arguments></i></a>
print "This is mathspic version $version_number\n";
}
<a name="NWCUvTi-122Dzz-1-u2" href="#NWDCUvTi-6"><i><Check if .m file exists></i></a>
</pre><p><a name="NWDCUvTi-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="NWCUvTi-LnOV9-1" href="#NWDCUvTi-5"><dfn><Process command line arguments>=</dfn></a> <b>(<a href="#NWDCUvTi-4"><-U</a>)</b>
our $file = "";
SWITCHES:
while($_ = $ARGV[0]) {
shift;
if (/^-h$/) {
die "\nThis is mathspic version $version_number\n" .
"Type \"man mathspic\" for detailed help\n".
"Usage:\tmathspic [-h] [-b] [-c] [-o <out file>] <in file>\n" .
"\twhere,\n" .
"\t[-b]\tenables bell sound if error exists\n" .
"\t[-c]\tdisables comments in ouput file\n" .
"\t[-h]\tgives this help listing\n" .
"\t[-o]\tcreates specified output file\n\n";
}
elsif (/^-b$/) {
$alarm = chr(7);
}
elsif (/^-c$/) {
$comments_on = 0;
}
elsif (/^-o$/) {
die "No output file specified!\n" if !@ARGV;
$out_file = $ARGV[0];
shift;
}
elsif (/^-\w+/) {
die "$_: Illegal command line switch!\n";
}
else {
$file = $_;
}
}my ($xA, $yA, $xB, $yB, $dist)=@_;
die "No input file specified!\n" if $file eq "";
</pre><p><a name="NWDCUvTi-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="NWCUvTi-2K3CIm-1" href="#NWDCUvTi-6"><dfn><Check if .m file exists>=</dfn></a> <b>(<a href="#NWDCUvTi-4"><-U</a>)</b>
our ($source_file, $log_file);
if (! -e $file) {
die "$file: no such file!\n" if (! (-e "$file.m"));
$source_file = "$file.m";
}
else {
$source_file = $file;
$file = $1 if $file =~ /(\w[\w-\.]+)\.\w+/;
}
$out_file= "$file.mt" if $out_file eq "default";
$log_file= "$file.mlg";
</pre><p><a name="NWDCUvTi-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="NWCUvTi-EP1QE-1" href="#NWDCUvTi-7"><dfn><process file>=</dfn></a> <b>(<a href="#NWDCUvTi-2"><-U</a>)</b>
open(IN,"$source_file")||die "Can't open source file: $source_file\n";
open(OUT,">$out_file")||die "Can't open output file: $out_file\n";
open(LOG,">$log_file")||die "Can't open log file: $log_file\n";
print_headers;
process_input(IN,"");
</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="NWDCUvTi-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 pt).
<pre><a name="NWCUvTi-xIn58-1" href="#NWDCUvTi-8"><dfn><Define global variables>=</dfn></a> <b>(<a href="#NWDCUvTi-2"><-U</a>)</b>
our $version_number = "1.13 Apr 26, 2010";
our $commandLineArgs = join(" ", @ARGV);
our $command = "";
our $curr_in_file = "";
our %PointTable = ();
our %VarTable = ();
our %ConstTable = ();
our $no_errors = 0;
our $xunits = "1pt";
our $yunits = "1pt";
our $units = "pt|pc|in|bp|cm|mm|dd|cc|sp";
our $defaultsymbol = "\$\\bullet\$";
our $defaultLFradius = 0;
use constant PI => atan2(1,1)*4;
use constant R2D => 180 / PI;
use constant D2R => PI / 180;
our $arrowLength = 2;
our $arrowLengthUnits = "mm";
our $arrowAngleB = 30;
our $arrowAngleC = 40;
our %DimOfPoint = ();
our $GlobalDimOfPoints = 0;
our @Macros = ();
our $LineThickness = 0.4;
</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>midpoint</code> computes the midpoint of two points.
<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="NWDCUvTi-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="NWCUvTi-2AA3uL-1" href="#NWDCUvTi-9"><dfn><subroutine definitions>=</dfn></a> <b>(<a href="#NWDCUvTi-2"><-U</a>)</b>
<a name="NWCUvTi-2AA3uL-1-u1" href="#NWDCUvTi-A"><i><subroutine <tt>mpp</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u2" href="#NWDCUvTi-B"><i><subroutine <tt>PrintErrorMessage</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u3" href="#NWDCUvTi-C"><i><subroutine <tt>PrintWarningMessage</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u4" href="#NWDCUvTi-D"><i><subroutine <tt>PrintFatalError</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u5" href="#NWDCUvTi-E"><i><subroutine <tt>chk_lparen</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u6" href="#NWDCUvTi-F"><i><subroutine <tt>chk_rparen</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u7" href="#NWDCUvTi-G"><i><subroutine <tt>chk_lcb</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u8" href="#NWDCUvTi-H"><i><subroutine <tt>chk_rcb</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u9" href="#NWDCUvTi-I"><i><subroutine <tt>chk_lsb</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u10" href="#NWDCUvTi-J"><i><subroutine <tt>chk_rsb</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u11" href="#NWDCUvTi-K"><i><subroutine <tt>chk_comma</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u12" href="#NWDCUvTi-L"><i><subroutine <tt>chk_comment</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u13" href="#NWDCUvTi-M"><i><subroutine <tt>print_headers</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u14" href="#NWDCUvTi-N"><i><subroutine <tt>get_point</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u15" href="#NWDCUvTi-O"><i><subroutine <tt>perpendicular</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u16" href="#NWDCUvTi-P"><i><subroutine <tt>Length</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u17" href="#NWDCUvTi-Q"><i><subroutine <tt>triangleArea</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u18" href="#NWDCUvTi-R"><i><subroutine <tt>pointOnLine</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u19" href="#NWDCUvTi-S"><i><subroutine <tt>circumCircleCenter</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u20" href="#NWDCUvTi-T"><i><subroutine <tt>ComputeDist</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u21" href="#NWDCUvTi-U"><i><subroutine <tt>intersection4points</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u22" href="#NWDCUvTi-V"><i><subroutine <tt>IncircleCenter</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u23" href="#NWDCUvTi-W"><i><subroutine <tt>Angle</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u24" href="#NWDCUvTi-X"><i><subroutine <tt>excircle</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u25" href="#NWDCUvTi-Y"><i><subroutine <tt>DrawLineOrArrow</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u26" href="#NWDCUvTi-Z"><i><subroutine <tt>drawarrows</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u27" href="#NWDCUvTi-a"><i><subroutine <tt>drawlines</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u28" href="#NWDCUvTi-b"><i><subroutine <tt>drawCurve</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u29" href="#NWDCUvTi-c"><i><subroutine <tt>drawpoints</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u30" href="#NWDCUvTi-d"><i><subroutine <tt>drawAngleArc</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u31" href="#NWDCUvTi-e"><i><subroutine <tt>drawAngleArrow</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u32" href="#NWDCUvTi-f"><i><subroutine <tt>expr</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u33" href="#NWDCUvTi-g"><i><subroutine <tt>memberOf</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u34" href="#NWDCUvTi-h"><i><subroutine <tt>midpoint</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u35" href="#NWDCUvTi-i"><i><subroutine <tt>tand</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u36" href="#NWDCUvTi-j"><i><subroutine <tt>get_string</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u37" href="#NWDCUvTi-k"><i><subroutine <tt>is_tainted</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u38" href="#NWDCUvTi-l"><i><subroutine <tt>noOfDigits</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u39" href="#NWDCUvTi-m"><i><subroutine <tt>drawsquare</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u40" href="#NWDCUvTi-n"><i><subroutine <tt>X2sp</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u41" href="#NWDCUvTi-o"><i><subroutine <tt>sp2X</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u42" href="#NWDCUvTi-p"><i><subroutine <tt>setLineThickness</tt> ></i></a>
<a name="NWCUvTi-2AA3uL-1-u43" href="#NWDCUvTi-q"><i><subroutine <tt>process_input</tt> ></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="NWDCUvTi-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="NWCUvTi-2rq75n-1" href="#NWDCUvTi-A"><dfn><subroutine <tt>mpp</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub mpp {
my $in_line;
chomp($in_line = shift);
my $LC = shift;
my $out_line = $in_line;
my $macro_name = "";
my @macro_param = ();
my $macro_code = "";
if ($in_line =~ s/^%def\s*//) {
if ($in_line =~ s/^(\w+)\s*//){
$macro_name = $1;
}
else {
PrintErrorMessage("No macro name has been found",$LC);
return ""
}
if ($in_line =~ s/^\(\s*//) {
# do nothing
}
else {
PrintErrorMessage("No left parenthesis after macro name has been found",$LC);
return "";
}
if ($in_line =~ s/^\)//) {
# Macro has no parameters!
}
else {
MACROS: while (1) {
if ($in_line =~ s/^(\w+)\s*//) {
push (@macro_param, $1);
}
else {
PrintErrorMessage("No macro parameter name has been found",$LC);
return "";
}
if ($in_line =~ s/^,\s*//) {
next MACROS;
}
else {
last MACROS;
}
}
if ($in_line =~ s/^\)//) {
# do nothing!
}
else {
PrintErrorMessage("No closing parenthesis after macro parameters",$LC);
return "";
}
}
$in_line =~ s/([^%]+)(%.*)/$1/;
$macro_code = $in_line;
push ( @Macros , { 'macro_name' => $macro_name,
'macro_code' => $macro_code,
'macro_param' => \@macro_param });
return $out_line;
}
elsif ($in_line =~ s/^%undef\s*//) {
if ($in_line =~ s/^(\w+)//) {
my $undef_macro = $1;
for(my $i = $#Macros; $i >= 0; $i--) {
if ($Macros[$i]->{'macro_name'} eq $undef_macro) {
splice(@Macros,$i,1);
}
}
}
return $out_line;
}
elsif ($in_line =~ s/^\s*%//) {
return $out_line;
}
else {
my $comment = $2 if $in_line =~ s/([^%]+)(%.+)/$1/;
EXPANSIONLOOP: while () {
my $org_in_line = $in_line;
for(my $i = $#Macros; $i >= 0; $i--) {
my $macro_name = $Macros[$i]->{'macro_name'};
if ($in_line =~ /&$macro_name\b/) { ############################
my $num_of_macro_args = @{$Macros[$i]->{'macro_param'}};
if ( $num_of_macro_args > 0 ) {
# Macro with parameters
my $pattern = "&$macro_name\\(";
foreach my $p ( 1..$num_of_macro_args ) {
my $comma = ($p == $num_of_macro_args) ? "\\s*" : "\\s*,\\s*";
$pattern .= "\\s*[^\\s\\)]+$comma";
}
$pattern .= "\\)";
while($in_line =~ /&$macro_name\b/) {
if ($in_line =~ /$pattern/) {
my $before = $`;
my $after = $';
my $match = $&;
my $new_code = $Macros[$i]->{'macro_code'};
$match =~ s/^&$macro_name\(\s*//;
$match =~ s/\)$//;
foreach my $arg ( 0..($num_of_macro_args - 1) ) {
my $old = $Macros[$i]->{'macro_param'}->[$arg];
my $comma = ($arg == ($num_of_macro_args - 1)) ? "" : ",";
$match =~ s/^\s*([^\s,]+)\s*$comma//;
my $new = $1;
# 'g': Parameter may occur several times
# in $new_code.
# '\b': Substitute only whole words
# not x in xA
$new_code =~ s/\b$old\b/$new/g;
}
$in_line = "$before$new_code$after";
}
else {
PrintErrorMessage("Usage of macro &$macro_name does not " .
"match its definition", $LC);
return "";
}
}
}
else {
# Macro without parameters
my $replacement = $Macros[$i]->{'macro_code'};
# '\b': Substitute only whole words
# not x in xA
$in_line =~ s/&$macro_name\b/$replacement/g;
}
}
}
last EXPANSIONLOOP if ( $org_in_line eq $in_line );
}
return "$in_line$comment";
}
}
</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="NWDCUvTi-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="NWCUvTi-1m1522-1" href="#NWDCUvTi-B"><dfn><subroutine <tt>PrintErrorMessage</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-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 "$curr_in_file", "Line $error_line: $A\n";
print $fh " " x $l ,$_,"***Error: $errormessage\n";
}
if ($comments_on) { #print to output file file
print OUT "%% *** $curr_in_file", "Line $error_line: $A\n";
print OUT "%% *** "," " x $l ,$_,"%% ... Error: $errormessage\n";
}
$no_errors++;
}
</pre><p><a name="NWDCUvTi-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="NWCUvTi-3Lpu7M-1" href="#NWDCUvTi-C"><dfn><subroutine <tt>PrintWarningMessage</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-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 "$curr_in_file", "Line $warning_line: $A\n";
print $fh " " x $l ,$_,"***Warning: $warningMessage\n";
}
if ($comments_on) { #print to output file file
print OUT "%% *** $curr_in_file", "Line $warning_line: $A\n";
print OUT "%% *** "," " x $l ,$_,"%% ... Warning: $warningMessage\n";
}
}
</pre><p><a name="NWDCUvTi-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="NWCUvTi-4RPeBe-1" href="#NWDCUvTi-D"><dfn><subroutine <tt>PrintFatalError</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-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 "$curr_in_file", "Line $fatal_line: $A\n" .
(" " x $l) . $_ . "***Fatal Error: $FatalMessage\n";
}
</pre><p><a name="NWDCUvTi-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="NWCUvTi-4Y5BUt-1" href="#NWDCUvTi-E"><dfn><subroutine <tt>chk_lparen</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub chk_lparen {
my $token = $_[0];
my $lc = $_[1];
s/\s*//;
if (/^[^\(]/) {
PrintErrorMessage("Missing ( after $token",$lc);
}
else {
s/^\(\s*//;
}
}
</pre><p><a name="NWDCUvTi-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="NWCUvTi-3fTYkz-1" href="#NWDCUvTi-F"><dfn><subroutine <tt>chk_rparen</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub chk_rparen {
my $token = $_[0];
my $lc = $_[1];
s/\s*//;
if (s/^\)//) {
s/\s*//;
}
else {
PrintErrorMessage("Missing ) after $token",$lc);
}
}
</pre><p><a name="NWDCUvTi-G">The subroutine </a><tt>chk_lcb</tt> behaves in a similar way to the subroutine
<tt>chk_lparen</tt>.
<pre><a name="NWCUvTi-2vMx6j-1" href="#NWDCUvTi-G"><dfn><subroutine <tt>chk_lcb</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub chk_lcb {
my $token = $_[0];
my $lc = $_[1];
s/\s*//;
if ($_ !~ /^\{/) {
PrintErrorMessage("Missing { after $token",$lc);
}
else {
s/^{\s*//;
}
}
</pre><p><a name="NWDCUvTi-H">Subroutine </a><tt>chk_rcb</tt> behaves in a similar way to the subroutine
<tt>chk_rparen</tt>.
<pre><a name="NWCUvTi-FE9Ax-1" href="#NWDCUvTi-H"><dfn><subroutine <tt>chk_rcb</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub chk_rcb {
my $token = $_[0];
my $lc = $_[1];
if ($_ !~ /^\s*\}/) {
PrintErrorMessage("Missing } after $token",$lc);
}
else {
s/^\s*}\s*//;
}
}
</pre><p><a name="NWDCUvTi-I">Subroutine </a><tt>chk_lsb</tt> behaves in a similar way to the subroutine
<tt>chk_lparen</tt>.
<pre><a name="NWCUvTi-3N30ZF-1" href="#NWDCUvTi-I"><dfn><subroutine <tt>chk_lsb</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub chk_lsb {
my $token = $_[0];
my $lc = $_[1];
s/\s*//;
if ($_ !~ /^\[/) {
PrintErrorMessage("Missing [ after $token",$lc);
}
else {
s/^\[\s*//;
}
}
</pre><p><a name="NWDCUvTi-J">Subroutine </a><tt>chk_rsb</tt> behaves in a similar way to the subroutine
<tt>chk_rparen</tt>.
<pre><a name="NWCUvTi-ma6zf-1" href="#NWDCUvTi-J"><dfn><subroutine <tt>chk_rsb</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub chk_rsb {
my $token = $_[0];
my $lc = $_[1];
s/\s*//;
if ($_ !~ /^\]/) {
PrintErrorMessage("Missing ] after $token",$lc);
}
else {
s/^\]\s*//;
}
}
</pre><p><a name="NWDCUvTi-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="NWCUvTi-UyyUp-1" href="#NWDCUvTi-K"><dfn><subroutine <tt>chk_comma</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub chk_comma {
my $lc = $_[0];
s/\s*//;
if (/^[^,]/) {
PrintErrorMessage("Did not find expected comma",$lc);
}
else {
s/^,\s*//;
}
}
</pre><p><a name="NWDCUvTi-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="NWCUvTi-wLKY1-1" href="#NWDCUvTi-L"><dfn><subroutine <tt>chk_comment</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub chk_comment {
my $lc = $_[0];
s/\s*//;
if (/^%/) {
# do nothing!
}
elsif (/^[^%]/) {
PrintWarningMessage("Trailing text is ignored",$lc);
}
}
</pre><p><a name="NWDCUvTi-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="NWCUvTi-3iVliS-1" href="#NWDCUvTi-M"><dfn><subroutine <tt>print_headers</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub print_headers
{
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
$year+=1900;
$mon+=1;
$now_string = "$year/" . ($mon>9 ? "$mon/" : "0$mon/") .
($mday>9 ? "$mday " : "0$mday ") .
($hour>9 ? "$hour:" : "0$hour:") .
($min>9 ? "$min:" : "0$min:") .
($sec>9 ? "$sec" : "0$sec");
print OUT "%* -----------------------------------------------\n";
print OUT "%* mathspic (Perl version $version_number)\n";
print OUT "%* A filter program for use with PiCTeX\n";
print OUT "%* Copyright (c) 2005-2010 A Syropoulos & RWD Nickalls \n";
print OUT "%* Command line: $0 $commandLineArgs\n";
print OUT "%* Input filename : $source_file\n";
print OUT "%* Output filename: $out_file\n";
print OUT "%* Date & time: $now_string\n";
print OUT "%* -----------------------------------------------\n";
#
print LOG "----\n";
print LOG "$now_string\n";
print LOG "mathspic (Perl version $version_number)\n";
print LOG "Copyright (c) 2005-2010 A Syropoulos & RWD Nickalls \n";
print LOG "Input file = $source_file\n";
print LOG "Output file = $out_file\n";
print LOG "Log file = $log_file\n";
print LOG "----\n";
}
</pre><p><a name="NWDCUvTi-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="NWCUvTi-1h5ef9-1" href="#NWDCUvTi-N"><dfn><subroutine <tt>get_point</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub get_point {
my ($lc) = $_[0];
my ($PointName);
if (s/^([^\W\d_]\d{0,4})\s*//i) { #point name
$PointName = $1;
if (!exists($PointTable{lc($PointName)})) {
PrintErrorMessage("Undefined point $PointName",$lc);
return "_undef_";
}
else {
return lc($PointName);
}
}
else {
PrintErrorMessage("Point name expected",$lc);
return "_undef_";
}
}
</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="NWDCUvTi-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="NWCUvTi-1GxwYt-1" href="#NWDCUvTi-O"><dfn><subroutine <tt>perpendicular</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-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) < 0.0000001;
$deltay = $yA - $yB;
return ($xP, $yA) if abs($deltay) < 0.0000001;
$m1 = $deltay / $deltax;
eval { $m2 = (-1) / $m1;};
PrintFatalError("Division by zero",$lc) if $@;
$c1 = $yA - $m1 * $xA;
$c2 = $yP - $m2 * $xP;
eval { $factor = 1 / ($m1 - $m2)};
PrintFatalError("Division by zero",$lc) if $@;
return (($c2 - $c1) * $factor, ($m1 * $c2 - $m2 * $c1) * $factor);
}
</pre><p> <a name="NWDCUvTi-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="NWCUvTi-4XEuZg-1" href="#NWDCUvTi-P"><dfn><subroutine <tt>Length</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub Length {
my ($xA, $yA, $xB, $yB)=@_;
return sqrt(($xB - $xA)**2 + ($yB - $yA)**2);
}
</pre><p><a name="NWDCUvTi-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="NWCUvTi-4DwBs6-1" href="#NWDCUvTi-Q"><dfn><subroutine <tt>triangleArea</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-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="NWDCUvTi-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="NWCUvTi-VFnEE-1" href="#NWDCUvTi-R"><dfn><subroutine <tt>pointOnLine</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-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 / &Length($xA,$yA,$xB,$yB));
$yPol = $yA + ($dist * $deltay / &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="NWDCUvTi-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="NWCUvTi-lKNKf-1" href="#NWDCUvTi-S"><dfn><subroutine <tt>circumCircleCenter</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-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)) < 0.0000001)
{
PrintErrorMessage("Area of triangle is zero!",$lc);
return (0,0,0);
}
$deltay12 = $yB - $yA;
$deltax12 = $xB - $xA;
$xs12 = $xA + $deltax12 / 2;
$ys12 = $yA + $deltay12 / 2;
#
$deltay23 = $yC - $yB;
$deltax23 = $xC - $xB;
$xs23 = $xB + $deltax23 / 2;
$ys23 = $yB + $deltay23 / 2;
#
CCXYLINE:{
if (abs($deltay12) < 0.0000001)
{
$xcc = $xs12;
if (abs($deltax23) < 0.0000001)
{
$ycc = $ys23;
last CCXYLINE;
}
else
{
$m23 = $deltay23 / $deltax23;
$mr23 = -1 / $m23;
$c23 = $ys23 - $mr23 * $xs23;
$ycc = $mr23 * $xs12 + $c23;
last CCXYLINE;
}
}
if (abs($deltax12) < 0.0000001)
{
$ycc = $ys12;
if (abs($deltay23) < 0.0000001)
{
$xcc = $xs23;
last CCXYLINE;
}
else
{
$m23 = $deltay23 / $deltax23;
$mr23 = -1 / $m23;
$c23 = $ys23 - $mr23 * $xs23;
$xcc = ($ys12 - $c23) / $mr23;
last CCXYLINE;
}
}
if (abs($deltay23) < 0.0000001)
{
$xcc = $xs23;
if (abs($deltax12) < 0.0000001)
{
$ycc = $ys12;
last CCXYLINE;
}
else
{
$m12 = $deltay12 / $deltax12;
$mr12 = -1 / $m12;
$c12 = $ys12 - $mr12 * $xs12;
$ycc = $mr12 * $xcc + $c12;
last CCXYLINE;
}
}
if (abs($deltax23) < 0.0000001)
{
$ycc = $ys23;
if (abs($deltay12) < 0.0000001)
{
$xcc = $xs12;
last CCXYLINE;
}
else
{
$m12 = $deltay12 / $deltax12;
$mr12 = -1 / $m12;
$c12 = $ys12 - $mr12 * $xs12;
$xcc = ($ycc - $c12) / $mr12;
last CCXYLINE;
}
}
$m12 = $deltay12 / $deltax12;
$mr12 = -1 / $m12;
$c12 = $ys12 - $mr12 * $xs12;
#-----
$m23 = $deltay23 / $deltax23;
$mr23 = -1 / $m23;
$c23 = $ys23 - $mr23 * $xs23;
$xcc = ($c23 - $c12) / ($mr12 - $mr23);
$ycc = ($c23 * $mr12 - $c12 * $mr23) / ($mr12 - $mr23);
}
#
$sideA = &Length($xA,$yA,$xB,$yB);
$sideB = &Length($xB,$yB,$xC,$yC);
$sideC = &Length($xC,$yC,$xA,$yA);
$a = triangleArea($xA, $yA, $xB, $yB, $xC, $yC);
$radius = ($sideA * $sideB * $sideC) / (4 * $a);
#
return ($xcc, $ycc, $radius);
}
</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="NWDCUvTi-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="NWCUvTi-3GSnCT-1" href="#NWDCUvTi-T"><dfn><subroutine <tt>ComputeDist</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-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,4}[^\W\d_]\d{0,4}/) #it is a pair of IDs?
{
s/^([^\W\d_]\d{0,4})//i;
$v1 = $1;
if (!exists($PointTable{lc($v1)})) {
if (exists($VarTable{lc($v1)})) {
return ($VarTable{lc($v1)}, 1);
}
PrintErrorMessage("Point $v1 has not been defined", $lc);
s/^\s*[^\W\d_]\d{0,4}//i;
return (0,0);
}
$v1 = lc($v1);
s/^\s*([^\W\d_]\d{0,4})//i;
$v2 = $1;
if (!exists($PointTable{lc($v2)}))
{
PrintErrorMessage("Point $v2 has not been defined", $lc);
return (0,0);
}
$v2 = lc($v2);
my ($x1,$y1,$pSV1,$pS1) = unpack("d3A*",$PointTable{$v1});
my ($x2,$y2,$pSV2,$pS2) = unpack("d3A*",$PointTable{$v2});
return (Length($x1,$y1,$x2,$y2), 1);
}
elsif (s/^([^\W\d_]\d{0,4})//i) # it is a single id
{
$v1 = $1;
if (!exists($VarTable{lc($v1)})) #it isn't a variable
{
PrintErrorMessage("Variable $v1 has not been defined", $lc);
return (0,0);
}
return ($VarTable{lc($v1)}, 1);
}
else
{
PrintErrorMessage("Unexpected token", $lc);
return (0,0);
}
}
</pre><p><a name="NWDCUvTi-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="NWCUvTi-106ivL-1" href="#NWDCUvTi-U"><dfn><subroutine <tt>intersection4points</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-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) < 0.0000001)
{
$ycc = $y1;
if (abs($deltax34) < 0.0000001)
{
$xcc = $x3;
last I4PXYLINE;
}
else
{
$m34 = $deltay34 / $deltax34;
$c34 = $y3 - $m34 * $x3;
$xcc = ($ycc - $c34) / $m34;
last I4PXYLINE;
}
}
if (abs($deltax12) < 0.0000001)
{
$xcc = $x1;
if (abs($deltay34) < 0.0000001)
{
$ycc = $y3;
last I4PXYLINE;
}
else
{
$m34 = $deltay34 / $deltax34;
$c34 = $y3 - $m34 * $x3;
$ycc = $m34 * $xcc + $c34;
last I4PXYLINE;
}
}
if (abs($deltay34) < 0.0000001)
{
$ycc = $y3;
if (abs($deltax12) < 0.0000001)
{
$xcc = $x1;
last I4PXYLINE;
}
else
{
$m12 = $deltay12 / $deltax12;
$c12 = $y1 - $m12 * $x1;
$xcc = ($ycc - $c12) / $m12;
last I4PXYLINE;
}
}
if (abs($deltax34) < 0.0000001)
{
$xcc = $x3;
if (abs($deltay12) < 0.0000001)
{
$ycc = $y1;
last I4PXYLINE;
}
else
{
$m12 = $deltay12 / $deltax12;
$c12 = $y1 - $m12 * $x1;
$ycc = $m12 * $xcc + $c12;
last I4PXYLINE;
}
}
$m12 = $deltay12 / $deltax12;
$c12 = $y1 - $m12 * $x1;
$m34 = $deltay34 / $deltax34;
$c34 = $y3 - $m34 * $x3;
$xcc = ($c34 - $c12) / ($m12 - $m34);
$ycc = ($c34 * $m12 - $c12 * $m34) / ($m12 - $m34);
}
return ($xcc, $ycc);
}
</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="NWDCUvTi-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="NWCUvTi-Kxdzt-1" href="#NWDCUvTi-V"><dfn><subroutine <tt>IncircleCenter</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-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) = &intersection4points($Ax, $Ay, $xA1, $yA1,
$Bx, $By, $xB1, $yB1);
# get radius
$a = &triangleArea($Ax, $Ay, $Bx, $By, $Cx, $Cy);
$s = ($sideA + $sideB +$sideC) / 2;
$r = $a / $s;
return ($xcenter, $ycenter, $r);
}
</pre><p><a name="NWDCUvTi-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="NWCUvTi-3xteda-1" href="#NWDCUvTi-W"><dfn><subroutine <tt>Angle</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-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 < 0.0000001)
{
return -500;
}
$deltax = $RBx - $RCx;
$deltay = $RBy - $RCy;
$lineBC = sqrt($deltax*$deltax + $deltay*$deltay);
if ($lineBC < 0.0000001)
{
return -500;
}
$deltax = $RAx - $RCx;
$deltay = $RAy - $RCy;
$lineAC = sqrt($deltax*$deltax + $deltay*$deltay);
if ($lineAC < 0.0000001)
{
return -500;
}
$k = ($lineBA*$lineBA + $lineBC*$lineBC - $lineAC*$lineAC ) /
(2 * $lineBA * $lineBC);
$k = -1 if $k < -0.99999;
$k = 1 if $k > 0.99999;
$kk = $k * $k;
if (($kk * $kk) == 1)
{
$angle = PI if $k == -1;
$angle = 0 if $k == 1;
}
else
{
$angle = (PI / 2) - atan2($k / sqrt(1 - $kk),1);
}
return $angle * 180 / PI;
}
</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="NWDCUvTi-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="NWCUvTi-cchrT-1" href="#NWDCUvTi-X"><dfn><subroutine <tt>excircle</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-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("d3A*",$PointTable{$A});
($Bx,$By,$ASVA,$ASA)=unpack("d3A*",$PointTable{$B});
($Cx,$Cy,$ASVA,$ASA)=unpack("d3A*",$PointTable{$C});
($Dx,$Dy,$ASVA,$ASA)=unpack("d3A*",$PointTable{$D});
($Ex,$Ey,$ASVA,$ASA)=unpack("d3A*",$PointTable{$E});
my ($sideA, $sideB, $sideC, $s, $R, $theAdeg, $d);
my ($Xmypoint, $Ymypoint, $deltax, $deltay, $mylength, $xc, $yc);
$sideA = &Length($Bx, $By, $Cx, $Cy);
$sideB = &Length($Cx, $Cy, $Ax, $Ay);
$sideC = &Length($Ax, $Ay, $Bx, $By);
$s = ($sideA + $sideB + $sideC) / 2;
$R = triangleArea($Ax, $Ay, $Bx, $By, $Cx, $Cy) /
($s - &Length($Dx, $Dy, $Ex, $Ey));
if (($D eq $A && $E eq $B) || ($D eq $B && $E eq $A))
{
$theAdeg = &Angle($Bx, $By, $Cx, $Cy, $Ax, $Ay);
$Xmypoint = $Cx;
$Ymypoint = $Cy;
}
elsif (($D eq $B && $E eq $C) || ($D eq $C && $E eq $B))
{
$theAdeg = &Angle($Cx, $Cy, $Ax, $Ay, $Bx, $By);
$Xmypoint = $Ax;
$Ymypoint = $Ay;
}
elsif (($D eq $C && $E eq $A) || ($D eq $A && $E eq $C))
{
$theAdeg = &Angle($Ax, $Ay, $Bx, $By, $Cx, $Cy);
$Xmypoint = $Bx;
$Ymypoint = $By;
}
else
{
return (0,0,0);
}
$d = $R / sin($theAdeg * PI / 180 / 2);
my ($xIn, $yIn, $rin) = &IncircleCenter($Ax, $Ay, $Bx, $By, $Cx, $Cy);
$deltax = $xIn - $Xmypoint;
$deltay = $yIn - $Ymypoint;
$mylength = sqrt($deltax*$deltax + $deltay*$deltay);
$xc = $Xmypoint + $d * $deltax / $mylength;
$yc = $Ymypoint + $d * $deltay / $mylength;
return ($xc, $yc, $R);
}
</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="NWDCUvTi-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="NWCUvTi-cviH2-1" href="#NWDCUvTi-Y"><dfn><subroutine <tt>DrawLineOrArrow</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-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 <= 0) {
# PrintErrorMessage("length must greater than zero",$lc);
# $lineLength = -1;
# }
# chk_rsb("optional part",$lc);
# }
# }
chk_lparen("$cmd",$lc);
DRAWLINES:while(1) {
@PP = () ;
while(1) {
if (s/^([^\W\d_]\d{0,4})\s*//i) { #point name
$P = $1;
if (!exists($PointTable{lc($P)})) {
PrintErrorMessage("Undefined point $P",$lc);
}
else {
push (@PP,$P);
}
}
else {
$stacklen = @PP;
if ($draw_Line != 2) {
if ($stacklen <= 1) {
PrintErrorMessage("Wrong number of points",$lc);
}
else {
push(@PP,$lc);
if ($draw_Line == 0) {
drawarrows(@PP);
}
elsif ($draw_Line == 1) {
drawlines(@PP);
}
}
}
if (s/^,\s*// and $draw_Line != 2) {
next DRAWLINES;
}
else {
last DRAWLINES;
}
}
}
}
if ($draw_Line == 2) {
$stacklen = @PP;
if ($stacklen < 2) {
PrintErrorMessage("Wrong number of points",$lc);
}
elsif ($stacklen % 2 == 0) {
PrintErrorMessage("Number of points must be odd",$lc);
}
else {
drawCurve(@PP);
}
}
chk_rparen("arguments of $cmd",$lc);
chk_comment($lc);
}
</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="NWDCUvTi-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="NWCUvTi-4STZZz-1" href="#NWDCUvTi-Z"><dfn><subroutine <tt>drawarrows</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-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 < $NumberOfPoints - 1; $i++)
{
$p = $_[$i];
$q = $_[$i+1];
($px,$py,$pSV,$pS) = unpack("d3A*",$PointTable{lc($p)});
($qx,$qy,$qSV,$qS) = unpack("d3A*",$PointTable{lc($q)});
$pSV = $defaultLFradius if $pSV == 0;
$qSV = $defaultLFradius if $qSV == 0;
$r12 = $pSV + $qSV;
$d12 = Length($px,$py,$qx,$qy);
if ($d12 <= $r12)
{
if($d12 == 0)
{
PrintErrorMessage("points $p and $q are the same", $lc);
next LOOP;
}
PrintWarningMessage("arrow $p$q not drawn: points too close or ".
"radii too big", $lc);
next LOOP;
}
($px, $py) = pointOnLine($px, $py, $qx, $qy, $pSV) if $pSV > 0;
($qx, $qy) = pointOnLine($qx, $qy, $px, $py, $qSV) if $qSV > 0;
my ($beta, $gamma);
$beta = tan($arrowAngleB * D2R / 2);
$gamma = 2 * tan($arrowAngleC * D2R / 2);
printf OUT "\\arrow <%.5f%s> [%.5f,%.5f] from %.5f %.5f to %.5f %.5f\n",
$arrowLength, $arrowLengthUnits, $beta, $gamma, $px, $py, $qx, $qy;
}
}
</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="NWDCUvTi-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="NWCUvTi-3KtTfB-1" href="#NWDCUvTi-a"><dfn><subroutine <tt>drawlines</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-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 < $NumberOfPoints - 1; $i++)
{
$p = $_[$i];
$q = $_[$i+1];
($px,$py,$pSV,$pS) = unpack("d3A*",$PointTable{lc($p)});
($qx,$qy,$qSV,$qS) = unpack("d3A*",$PointTable{lc($q)});
$pSV = $defaultLFradius if $pSV == 0;
$qSV = $defaultLFradius if $qSV == 0;
$r12 = $pSV + $qSV;
$d12 = Length($px,$py,$qx,$qy);
if ($d12 <= $r12)
{
if($d12 == 0)
{
PrintErrorMessage("points $p and $q are the same", $lc);
next LOOP;
}
PrintWarningMessage("line $p$q not drawn: points too close or ".
"radii too big", $lc);
next LOOP;
}
($px, $py) = pointOnLine($px, $py, $qx, $qy, $pSV) if $pSV > 0;
($qx, $qy) = pointOnLine($qx, $qy, $px, $py, $qSV) if $qSV > 0;
if ($px == $qx || $py == $qy)
{
printf OUT "\\putrule from %.5f %.5f to %.5f %.5f %%%% %s%s\n",
$px,$py,$qx,$qy,$p,$q;
}
else
{
printf OUT "\\plot %.5f %.5f\t%.5f %.5f / %%%% %s%s\n",
$px, $py,$qx,$qy,$p,$q;
}
}
}
</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="NWDCUvTi-b">\setquadratic</a>
\plot
X1 Y1
X2 Y2
X3 Y3
\setlinear
</pre>
<pre><a name="NWCUvTi-3c2Tgd-1" href="#NWDCUvTi-b"><dfn><subroutine <tt>drawCurve</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-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 "\\setquadratic\n\\plot\n";
for(my $i=0; $i <= $NumberOfPoints; $i++)
{
$p = $_[$i];
my ($px,$py,$pSV,$pS) = unpack("d3A*",$PointTable{lc($p)});
printf OUT "\t%0.5f %0.5f", $px, $py;
print OUT (($i == $NumberOfPoints) ? " / %$p\n" : " %$p\n");
}
print OUT "\\setlinear\n";
}
</pre><p>The subroutine <code>drawpoints</code> is used to draw one or more points. The subroutine
<a name="NWDCUvTi-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="NWCUvTi-1NgToL-1" href="#NWDCUvTi-c"><dfn><subroutine <tt>drawpoints</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub drawpoints {
my ($NumberOfPoints,$p);
$NumberOfPoints = @_;
my ($px,$py,$pSV,$pS);
for($i=0; $i < $NumberOfPoints; $i++)
{
$p = $_[$i];
($px,$py,$pSV,$pS) = unpack("d3A*",$PointTable{lc($p)});
if ($pS eq "" and $defaultsymbol =~ /circle|square/) {
$pS = $defaultsymbol;
}
POINTSWITCH: {
if ($pS eq "") # no plot symbol specified
{
printf OUT "\\put {%s} at %.5f %.5f %%%% %s\n",
$defaultsymbol, $px, $py, $p;
last POINTSWITCH;
}
if ($pS eq "circle") # plot symbol is a circle
{
my $radius = (defined($DimOfPoint{lc($p)})) ? $DimOfPoint{lc($p)} :
$GlobalDimOfPoints;
if ($radius > 0) # draw a circle using the current units
{
if ($radius == 1.5) # use \bigcirc
{
printf OUT "\\put {\$\\bigcirc\$} at %.5f %.5f %%%% %s\n",
$px, $py, $p;
}
else
{
printf OUT "\\circulararc 360 degrees from %.5f %.5f center at %.5f %.5f %%%% %s\n",
$px+$radius, $py, $px, $py, $p;
}
}
else #use \circ symbol
{
printf OUT "\\put {\$\\circ\$} at %.5f %.5f %%%% %s\n",
$px,$py,$p;
}
last POINTSWITCH;
}
if ($pS eq "square")
{
my $side = (defined($DimOfPoint{lc($p)})) ? $DimOfPoint{lc($p)} :
$GlobalDimOfPoints;
printf OUT "\\put {%s} at %.5f %.5f %%%% %s\n",
drawsquare($side), $px, $py, $p;
last POINTSWITCH;
}
printf OUT "\\put {%s} at %.5f %.5f %%%% %s\n", $pS,$px,$py,$p;
}
}
}
</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="NWDCUvTi-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="NWCUvTi-497AQD-1" href="#NWDCUvTi-d"><dfn><subroutine <tt>drawAngleArc</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub drawAngleArc {
my ($P1, $P2, $P3, $radius, $inout, $direction) = @_;
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$P1});
my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$P2});
my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$P3});
my $internalAngle = Angle($x1, $y1, $x2, $y2, $x3, $y3);
my $externalAngle = 360 - $internalAngle;
my ($x, $y) = pointOnLine($x2, $y2, $x1, $y1, $radius);
my $code = "";
if ($inout eq "internal" and $direction eq "clockwise" ) {
$code = sprintf "\\circulararc %.5f degrees from %.5f %.5f center at %.5f %.5f\n",
-1 * $internalAngle, $x, $y, $x2, $y2;
}
elsif ($inout eq "internal" and $direction eq "anticlockwise" ) {
$code = sprintf "\\circulararc %.5f degrees from %.5f %.5f center at %.5f %.5f\n",
$internalAngle, $x, $y, $x2, $y2;
}
elsif ($inout eq "external" and $direction eq "clockwise" ) {
$code = sprintf "\\circulararc %.5f degrees from %.5f %.5f center at %.5f %.5f\n",
-1 * $externalAngle, $x, $y, $x2, $y2;
}
elsif ($inout eq "external" and $direction eq "anticlockwise" ) {
$code = sprintf "\\circulararc %.5f degrees from %.5f %.5f center at %.5f %.5f\n",
$externalAngle, $x, $y, $x2, $y2;
}
return $code;
}
</pre><p><a name="NWDCUvTi-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="NWCUvTi-4UPwva-1" href="#NWDCUvTi-e"><dfn><subroutine <tt>drawAngleArrow</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub drawAngleArrow {
my ($P1, $P2, $P3, $radius, $inout, $direction) = @_;
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$P1});
my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$P2});
my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$P3});
my $code = drawAngleArc($P1, $P2, $P3, $radius, $inout, $direction);
my ($xqp, $yqp) = pointOnLine($x2, $y2, $x1, $y1, $radius);
my ($deltax, $deltay) = ($x1 - $x2, $y1 - $y2);
my $AL;
if ($xunits =~ /mm/) {
$AL = 1;
}
elsif ($xunits =~ /cm/) {
$AL = 0.1;
}
elsif ($xunits =~ /pt/) {
$AL = 2.845;
}
elsif ($xunits =~ /bp/) {
$AL = 2.835;
}
elsif ($xunits =~ /pc/) {
$AL = 0.2371;
}
elsif ($xunits =~ /in/) {
$AL = 0.03937;
}
elsif ($xunits =~ /dd/) {
$AL = 2.659;
}
elsif ($xunits =~ /cc/) {
$AL = 0.2216;
}
elsif ($xunits =~ /sp/) {
$AL = 186467.98;
}
my $halfAL = $AL / 2;
my $d = sqrt($radius * $radius - $halfAL * $halfAL);
my $alpha = atan2($d / $halfAL, 1) * R2D;
my $beta = 2 * (90 - $alpha);
my $thetaqr;
if (abs($deltay) < 0.00001) {
if ($deltax > 0 ) {$thetaqr = 0 }
elsif ($deltax < 0) {$thetaqr = -180}
}
else {
if (abs($deltax) < 0.00001) {
$thetaqr = 90;
}
else {
$thetaqr = atan2($deltay / $deltax, 1) * R2D;
}
}
my ($xqr, $yqr) = pointOnLine($x2, $y2, $x3, $y3, $radius);
$deltax = $x3 - $x2;
$deltay = $y3 - $y2;
$alpha = atan2(sqrt($radius * $radius - $halfAL * $halfAL) / $halfAL, 1) /
D2R;
$beta = 2 * (90 - $alpha);
LINE2 : {
if (abs($deltax) < 0.00001) {
if ($deltay > 0) { $thetaqr = 90 }
elsif ($deltay < 0) { $thetaqr = - 90 }
last LINE2;
}
else {
$thetaqr = atan2($deltay / $deltax, 1) * R2D;
}
if (abs($deltay) < 0.00001) {
if ($deltax > 0) { $thetaqr = 0 }
elsif ($deltax < 0) { $thetaqr = -180 }
last LINE2;
}
else {
$thetaqr = atan2($deltay / $deltax, 1) * R2D;
}
if ($deltax < 0 and $deltay > 0) { $thetaqr += 180 }
elsif ($deltax < 0 and $deltay < 0) { $thetaqr += 180 }
elsif ($deltax > 0 and $deltay < 0) { $thetaqr += 360 }
}
my $xqrleft = $x2 + $radius * cos(($thetaqr + $beta) * D2R);
my $yqrleft = $y2 + $radius * sin(($thetaqr + $beta) * D2R);
my $xqrright = $x2 + $radius * cos(($thetaqr - $beta) * D2R);
my $yqrright = $y2 + $radius * sin(($thetaqr - $beta) * D2R);
if ($inout eq "internal" and $direction eq "clockwise") {
$code .= sprintf "\\arrow <1.5mm> [0.5, 1] from %.5f %.5f to %.5f %.5f\n",
$xqrleft, $yqrleft, $xqr, $yqr;
}
elsif ($inout eq "internal" and $direction eq "anticlockwise") {
$code .= sprintf "\\arrow <1.5mm> [0.5, 1] from %.5f %.5f to %.5f %.5f\n",
$xqrright, $yqrright, $xqr, $yqr;
}
elsif ($inout eq "external" and $direction eq "clockwise") {
$code .= sprintf "\\arrow <1.5mm> [0.5, 1] from %.5f %.5f to %.5f %.5f\n",
$xqrleft, $yqrleft, $xqr, $yqr;
}
elsif ($inout eq "external" and $direction eq "anticlockwise") {
$code .= sprintf "\\arrow <1.5mm> [0.5, 1] from %.5f %.5f to %.5f %.5f\n",
$xqrright, $yqrright, $xqr, $yqr;
}
return $code;
}
</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="NWDCUvTi-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="NWCUvTi-1aVxdI-1" href="#NWDCUvTi-f"><dfn><subroutine <tt>expr</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-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/^([+-])// && $1;
}
sub term {
my $lc = $_[0];
my ($left, $op, $right);
$left = factor($lc);
while ($op = mulop()) {
$right = factor($lc);
if ($op eq '*')
{ $left *= $right }
elsif ($op =~ /rem/i) {
eval {$left %= $right};
PrintFatalError("Division by zero", $lc) if $@;
}
else {
eval {$left /= $right};
PrintFatalError("Division by zero", $lc) if $@;
}
}
return $left;
}
sub mulop {
(s#^([*/])## || s/^(rem)//i) && lc($1);
}
sub factor {
my $lc = $_[0];
my ($left);
$left = primitive($lc);
if (s/^\*\*//) {
$left **= factor($lc);
}
return $left;
}
sub primitive {
my $lc = $_[0];
my $val;
s/\s*//;
if (s/^\(//) { #is it an expr in parentheses
$val = expr($lc);
s/^\)// || PrintErrorMessage("Missing right parenthesis", $lc);
}
elsif (s/^-//) { # is it a negated primitive
$val = - primitive();
}
elsif (s/^\+//) { # is it a positive primitive
$val = primitive();
}
elsif (s/^angledeg//i) {
chk_lparen("angledeg",$lc);
my $point_1 = get_point($lc);
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1});
my $point_2 = get_point($lc);
my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2});
my $point_3 = get_point($lc);
my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point_3});
my $d12 = Length($x1, $y1, $x2, $y2);
my $d23 = Length($x2, $y2, $x3, $y3);
my $d31 = Length($x3, $y3, $x1, $y1);
if ( $d12 == 0 ) {
PrintErrorMessage("points `$point_1' and `$point_2' are the same", $lc);
$val = 0;
}
elsif ( $d23 == 0 ) {
PrintErrorMessage("points `$point_2' and `$point_3' are the same", $lc);
$val = 0;
}
elsif ( $d31 == 0 ) {
PrintErrorMessage("points `$point_1' and `$point_3' are the same", $lc);
$val = 0;
}
else {
$val = Angle($x1, $y1, $x2, $y2, $x3, $y3);
$val = 0 if $val == -500;
}
chk_rparen("Missing right parenthesis", $lc);
}
elsif (s/^angle//i) {
chk_lparen("angle",$lc);
my $point_1 = get_point($lc);
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1});
my $point_2 = get_point($lc);
my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2});
my $point_3 = get_point($lc);
my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point_3});
my $d12 = Length($x1, $y1, $x2, $y2);
my $d23 = Length($x2, $y2, $x3, $y3);
my $d31 = Length($x3, $y3, $x1, $y1);
if ( $d12 == 0 ) {
PrintErrorMessage("points `$point_1' and `$point_2' are the same", $lc);
$val = 0;
}
elsif ( $d23 == 0 ) {
PrintErrorMessage("points `$point_2' and `$point_3' are the same", $lc);
$val = 0;
}
elsif ( $d31 == 0 ) {
PrintErrorMessage("points `$point_1' and `$point_3' are the same", $lc);
$val = 0;
}
else {
$val = Angle($x1, $y1, $x2, $y2, $x3, $y3);
if ($val == -500) {
$val = 0;
}
else {
$val = D2R * $val;
}
}
chk_rparen("Missing right parenthesis", $lc);
}
elsif (s/^area//i) {
chk_lparen("angledeg",$lc);
my $point_1 = get_point($lc);
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1});
my $point_2 = get_point($lc);
my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2});
my $point_3 = get_point($lc);
my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point_3});
$val = triangleArea($x1, $y1, $x2, $y2, $x3, $y3);
chk_rparen("Missing right parenthesis", $lc);
}
elsif (s/^asin//i) {
chk_lparen("asin");
$val = expr();
PrintFatalError("Can't take asin of $val", $lc) if $val < -1 || $val > 1;
$val = asin($val);
chk_rparen("Missing right parenthesis", $lc);
}
elsif (s/^acos//i) {
chk_lparen("acos");
$val = expr();
PrintFatalError("Can't take acos of $val", $lc) if $val < -1 || $val > 1 ;
$val = acos($val);
chk_rparen("Missing right parenthesis", $lc);
}
elsif (s/^atan//i) {
chk_lparen("atan");
$val = expr();
$val = atan($val);
chk_rparen("Missing right parenthesis", $lc);
}
elsif (s/^cos//i) {
chk_lparen("cos");
$val = expr();
$val = cos($val);
chk_rparen("Missing right parenthesis", $lc);
}
elsif (s/^directiondeg//i) {
chk_lparen("directiondeg",$lc);
my $point_1 = get_point($lc);
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1});
my $point_2 = get_point($lc);
my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2});
my $x3 = $x1+1;
if ( ($y2 - $y1) >= 0) {
$val = Angle($x3, $y1, $x1, $y1, $x2, $y2);
$val = 0 if $val == -500;
}
else {
$val = 360 - Angle($x3, $y1, $x1, $y1, $x2, $y2);
$val = 0 if $val == -500;
}
chk_rparen("Missing right parenthesis", $lc);
}
elsif (s/^direction//i) {
chk_lparen("direction",$lc);
my $point_1 = get_point($lc);
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1});
my $point_2 = get_point($lc);
my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2});
my $x3 = $x1+1;
if ( ($y2 - $y1) >= 0) {
$val = Angle($x3, $y1, $x1, $y1, $x2, $y2);
$val = 0 if $val == -500;
$val = D2R * $val;
}
else {
$val = 360 - Angle($x3, $y1, $x1, $y1, $x2, $y2);
$val = 0 if $val == -500;
$val = D2R * $val;
}
chk_rparen("Missing right parenthesis", $lc);
}
elsif (s/^exp//i) {
chk_lparen("exp");
$val = expr();
$val = exp($val);
chk_rparen("Missing right parenthesis", $lc);
}
elsif (s/^int//i) {
chk_lparen("int");
$val = expr();
$val = int($val);
chk_rparen("Missing right parenthesis", $lc);
}
elsif (s/^log//i) {
chk_lparen("log");
$val = expr();
PrintFatalError("Can't take log of $val", $lc) if $val <= 0;
$val = log($val);
chk_rparen("Missing right parenthesis", $lc);
}
elsif (s/^sin//i) {
chk_lparen("sin");
$val = expr();
$val = sin($val);
chk_rparen("Missing right parenthesis", $lc);
}
elsif (s/^sgn//i) {
chk_lparen("sgn");
$val = expr();
if ($val > 0) {
$val = 1;
}
elsif ($val == 0) {
$val = 0;
}
else {
$val = -1;
}
chk_rparen("Missing right parenthesis", $lc);
}
elsif (s/^sqrt//i) {
chk_lparen("sqrt");
$val = expr();
$val = sqrt($val);
chk_rparen("Missing right parenthesis", $lc);
}
elsif (s/^tan//i) {
chk_lparen("tan");
$val = expr();
$val = sin($val)/cos($val);
chk_rparen("Missing right parenthesis", $lc);
}
elsif (s/^xcoord//i) {
chk_lparen("xcoord");
my $point_name = get_point;
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_name});
$val = $x1;
chk_rparen("Missing right parenthesis", $lc);
}
elsif (s/^ycoord//i) {
chk_lparen("ycoord");
my $point_name = get_point;
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_name});
$val = $y1;
chk_rparen("Missing right parenthesis", $lc);
}
elsif (s/^_pi_//i) {
$val = PI;
}
elsif (s/^_e_//i) {
$val = 2.71828182845905;
}
elsif (s/^_linethickness_//i) {
$val = $LineThickness / $xunits;
}
else {
my $err_code;
($val,$err_code) = ComputeDist($lc);
}
s/\s*//;
return $val;
}
</pre><p><a name="NWDCUvTi-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="NWCUvTi-2tc9Fr-1" href="#NWDCUvTi-g"><dfn><subroutine <tt>memberOf</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-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="NWDCUvTi-h">The subroutine </a><code>midpoint</code> computes the coordinates of the midpoint of two points
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="NWCUvTi-2wh1NN-1" href="#NWDCUvTi-h"><dfn><subroutine <tt>midpoint</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub midpoint {
my ($x1, $y1, $x2, $y2)=@_;
return ($x1 + ($x2 - $x1)/2,
$y1 + ($y2 - $y1)/2);
}
</pre><p><a name="NWDCUvTi-i">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="NWCUvTi-22jtMr-1" href="#NWDCUvTi-i"><dfn><subroutine <tt>tand</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-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>"</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="NWDCUvTi-j">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="NWCUvTi-ufkvF-1" href="#NWDCUvTi-j"><dfn><subroutine <tt>get_string</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub get_string {
my $string = shift;
my $lc = shift;
$string =~ s/^\s+//;
if ($string !~ s/^\"//) {
PrintErrorMessage("No starting \" found",$lc);
return (1,$string,$string);
}
my @ch = split //,$string;
my @cmd;
while (@ch and $ch[0] ne "\"") {
if ($ch[0] eq "\\" and (defined $ch[1]) and $ch[1] eq "\"") {
shift @ch;
push @cmd, $ch[0];
shift @ch;
}
else {
push @cmd, $ch[0];
shift @ch;
}
}
if (! defined $ch[0]) {
PrintErrorMessage("No closing \" found",$lc);
return (1,join("",@cmd), join("",@ch))
}
else {
shift @ch;
return (0, join("",@cmd), join("",@ch))
}
}
</pre><p><a name="NWDCUvTi-k">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="NWCUvTi-1MGdDt-1" href="#NWDCUvTi-k"><dfn><subroutine <tt>is_tainted</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub is_tainted {
my $arg = shift;
my $nada = substr($arg,0,0);
local $@;
eval { eval "# $nada"};
return length($@) != 0;
}
</pre><p><a name="NWDCUvTi-l">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="NWCUvTi-3mBo7s-1" href="#NWDCUvTi-l"><dfn><subroutine <tt>noOfDigits</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub noOfDigits {
my $num = $_[0];
if ($num =~ /^[\+-]?\d+(?!\.)/) {
return 0;
}
elsif ($num =~ /^[\+-]\d+\.(\d+)?/) {
return length($1);
}
}
</pre><p><a name="NWDCUvTi-m">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="NWCUvTi-3ywJ89-1" href="#NWDCUvTi-m"><dfn><subroutine <tt>drawsquare</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub drawsquare {
my $s = $_[0];
#$s *= sqrt(2);
$s = sprintf "%.5f", $s;
my $code = "\\setlength{\\unitlength}{$xunits}%\n";
$code .= "\\begin{picture}($s,$s)\\put(0,0)" .
"{\\framebox($s,$s){}}\\end{picture}";
return $code;
}
</pre><p><a name="NWDCUvTi-n">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="NWCUvTi-39f7o8-1" href="#NWDCUvTi-n"><dfn><subroutine <tt>X2sp</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub X2sp {
my $LT = shift;
my $units = shift;
if ($units eq "pc") {
return $LT * 786432;
}
elsif ($units eq "pt") {
return $LT * 65536;
}
elsif ($units eq "in") {
return $LT * 4736286.72;
}
elsif ($units eq "bp") {
return $LT * 65781.76;
}
elsif ($units eq "cm") {
return $LT * 1864679.811023622;
}
elsif ($units eq "mm") {
return $LT * 186467.981102362;
}
elsif ($units eq "dd") {
return $LT * 70124.086430424;
}
elsif ($units eq "cc") {
return $LT * 841489.037165082;
}
elsif ($units eq "sp") {
return $LT;
}
}
</pre><p><a name="NWDCUvTi-o">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="NWCUvTi-3wV39i-1" href="#NWDCUvTi-o"><dfn><subroutine <tt>sp2X</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub sp2X {
my $LT = shift;
my $units = shift;
if ($units eq "pc") {
return $LT / 786432;
}
elsif ($units eq "pt") {
return $LT / 65536;
}
elsif ($units eq "in") {
return $LT / 4736286.72;
}
elsif ($units eq "bp") {
return $LT / 65781.76;
}
elsif ($units eq "cm") {
return $LT / 1864679.811023622;
}
elsif ($units eq "mm") {
return $LT / 186467.981102362;
}
elsif ($units eq "dd") {
return $LT / 70124.086430424;
}
elsif ($units eq "cc") {
return $LT / 841489.037165082;
}
elsif ($units eq "sp") {
return $LT;
}
}
</pre><p><a name="NWDCUvTi-p">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="NWCUvTi-4XWBBY-1" href="#NWDCUvTi-p"><dfn><subroutine <tt>setLineThickness</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub setLineThickness {
my $Xunits = shift;
my $LT = shift;
$Xunits =~ s/^((\+|-)?\d+(\.\d+)?([eE](\+|-)?\d+)?)//;
my $xlength = "$1";
$Xunits =~ s/^\s*($units)//;
my $x_in_units = $1;
$LT =~ s/^((\+|-)?\d+(\.\d+)?([eE](\+|-)?\d+)?)//;
my $LTlength = "$1";
$LT =~ s/^\s*($units)//;
my $LT_in_units = $1;
$LTlength = X2sp($LTlength,$LT_in_units);
$LTlength = sp2X($LTlength,$x_in_units);
return $LTlength;
}
</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="NWDCUvTi-q">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="NWCUvTi-1RrLPF-1" href="#NWDCUvTi-q"><dfn><subroutine <tt>process_input</tt> >=</dfn></a> <b>(<a href="#NWDCUvTi-9"><-U</a>)</b>
sub process_input {
my ($INFILE,$currInFile) = @_;
my $lc = 0;
my $no_output = 0;
$curr_in_file = $currInFile;
LINE: while(<$INFILE>) {
$lc++;
chomp($command = $_);
s/^\s+//;
if (/^beginSkip\s*/i) {
$no_output = 1;
print OUT "%%$_" if $comments_on;
next LINE;
}
elsif (/^endSkip\s*/i) {
if ($no_output == 0) {
PrintErrorMessage("endSkip without beginSkip",$lc);
}
else {
$no_output = 0;
}
print OUT "%%$_" if $comments_on and !$no_output;
next LINE;
}
elsif ($no_output == 1) {
next LINE;
}
else {
if (/^[^\\]/) {
my $out_line = mpp($command,$lc) unless /^\\/; #call macro pre-processor
$_ = "$out_line\n";
}
<a name="NWCUvTi-1RrLPF-1-u1" href="#NWDCUvTi-r"><i><process input line></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="NWDCUvTi-r">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="NWCUvTi-RKDir-1" href="#NWDCUvTi-r"><dfn><process input line>=</dfn></a> <b>(<a href="#NWDCUvTi-q"><-U</a>)</b>
if (/^\s*%/)
{
print OUT "$_" if $comments_on;
}
elsif (s/^\s*(beginloop(?=\W))//i) {
s/\s+//;
my $times = expr($lc);
print OUT "%% BEGINLOOP $times\n" if $comments_on;
my @C = ();
REPEATCOMMS: while (<$INFILE>) {
if (/^\s*endloop/i) {
last REPEATCOMMS;
}
else {
push @C, $_;
}
}
if (! /^\s*endloop/i) {
PrintFatalError("unexpected end of file",$lc);
}
else {
s/^\s*endloop//i;
for(my $i=1; $i<=$times; $i++) {
tie *DUMMY, 'DummyFH', \@C;
process_input(DUMMY, $currInFile);
untie *DUMMY;
}
print OUT "%% ENDLOOP\n" if $comments_on;
}
}
elsif (s/^\s*(ArrowShape(?=\W))//i)
{
my $cmd = $1;
print OUT "%% $cmd$_" if $comments_on;
<a name="NWCUvTi-RKDir-1-u1" href="#NWDCUvTi-1W"><i><process <tt>ArrowShape</tt> command></i></a>
}
elsif (s/^\s*(const(?=\W))//i)
{
print OUT "%% $1$_" if $comments_on;
<a name="NWCUvTi-RKDir-1-u2" href="#NWDCUvTi-1c"><i><process <tt>const</tt> command></i></a>
}
elsif (s/^\s*(dasharray(?=\W))//i)
{
my ($cmd) = $1;
print OUT "%% $cmd$_" if $comments_on;
<a name="NWCUvTi-RKDir-1-u3" href="#NWDCUvTi-s"><i><process <tt>dasharray</tt> command></i></a>
}
elsif (s/^\s*(drawAngleArc(?=\W))//i or s/^\s*(drawAngleArrow(?=\W))//i )
{
my $cmd = $1;
print OUT "%% $cmd$_" if $comments_on;
<a name="NWCUvTi-RKDir-1-u4" href="#NWDCUvTi-t"><i><process <tt>drawAngleArcOrArrow</tt> command></i></a>
}
elsif (s/^\s*(drawArrow(?=\W))//i)
{
my ($cmd) = $1;
print OUT "%% $cmd$_" if $comments_on;
DrawLineOrArrow(0,$lc);
}
elsif (s/^\s*(drawcircle(?=\W))//i)
{
my ($cmd) = $1;
print OUT "%% $cmd$_" if $comments_on;
<a name="NWCUvTi-RKDir-1-u5" href="#NWDCUvTi-w"><i><process <tt>drawcircle</tt> command></i></a>
}
elsif (s/^\s*(drawcurve(?=\W))//i)
{
my ($cmd) = $1;
print OUT "%% $cmd$_" if $comments_on;
DrawLineOrArrow(2,$lc);
}
elsif (s/^\s*(drawcircumcircle(?=\W))//i)
{
my ($cmd) = $1;
print OUT "%% $cmd$_" if $comments_on;
<a name="NWCUvTi-RKDir-1-u6" href="#NWDCUvTi-x"><i><process <tt>drawcircumcircle</tt> command></i></a>
}
elsif (s/^\s*(drawexcircle(?=\W))//i)
{
my ($cmd) = $1;
print OUT "%% $cmd$_" if $comments_on;
<a name="NWCUvTi-RKDir-1-u7" href="#NWDCUvTi-y"><i><process <tt>drawexcircle</tt> command></i></a>
}
elsif (s/^\s*(drawincircle(?=\W))//i)
{
my ($cmd) = $1;
print OUT "%% $cmd$_" if $comments_on;
<a name="NWCUvTi-RKDir-1-u8" href="#NWDCUvTi-z"><i><process <tt>drawincircle</tt> command></i></a>
}
elsif (s/^\s*(drawline(?=\W))//i)
{
my ($cmd) = $1;
print OUT "%% $cmd$_" if $comments_on;
DrawLineOrArrow(1,$lc);
}
elsif (s/^\s*(drawthickarrow(?=\W))//i)
{
my ($cmd) = $1;
print OUT "%% $cmd$_" if $comments_on;
print OUT "\\setplotsymbol ({\\usefont{OT1}{cmr}{m}{n}\\large .})%\n";
print OUT "{\\setbox1=\\hbox{\\usefont{OT1}{cmr}{m}{n}\\large .}%\n";
print OUT " \\global\\linethickness=0.31\\wd1}%\n";
DrawLineOrArrow(0,$lc);
print OUT "\\setlength{\\linethickness}{0.4pt}%\n";
print OUT "\\setplotsymbol ({\\usefont{OT1}{cmr}{m}{n}\\tiny .})%\n";
}
elsif (s/^\s*(drawthickline(?=\W))//i)
{
my ($cmd) = $1;
print OUT "%% $cmd$_" if $comments_on;
print OUT "\\setplotsymbol ({\\usefont{OT1}{cmr}{m}{n}\\large .})%\n";
print OUT "{\\setbox1=\\hbox{\\usefont{OT1}{cmr}{m}{n}\\large .}%\n";
print OUT " \\global\\linethickness=0.31\\wd1}%\n";
DrawLineOrArrow(1,$lc);
print OUT "\\setlength{\\linethickness}{0.4pt}%\n";
print OUT "\\setplotsymbol ({\\usefont{OT1}{cmr}{m}{n}\\tiny .})%\n";
}
elsif (s/^\s*(drawperpendicular(?=\W))//i)
{
my ($cmd) = $1;
print OUT "%% $cmd$_" if $comments_on;
<a name="NWCUvTi-RKDir-1-u9" href="#NWDCUvTi-10"><i><process <tt>drawPerpendicular</tt> command></i></a>
}
elsif (s/^\s*(drawpoint(?=\W))//i)
{
my ($cmd) = $1;
print OUT "%% $cmd$_" if $comments_on;
<a name="NWCUvTi-RKDir-1-u10" href="#NWDCUvTi-11"><i><process <tt>drawpoint</tt> command></i></a>
}
elsif (s/^\s*(drawRightAngle(?=\W))//i)
{
my ($cmd) = $1;
print OUT "%% $cmd$_" if $comments_on;
<a name="NWCUvTi-RKDir-1-u11" href="#NWDCUvTi-12"><i><process <tt>drawRightAngle</tt> command></i></a>
}
elsif (s/^\s*(drawsquare(?=\W))//i)
{
my ($cmd) = $1;
print OUT "%% $cmd$_" if $comments_on;
<a name="NWCUvTi-RKDir-1-u12" href="#NWDCUvTi-13"><i><process <tt>drawsquare</tt> command></i></a>
}
elsif (s/^\s*inputfile\*//i)
{
<a name="NWCUvTi-RKDir-1-u13" href="#NWDCUvTi-14"><i><process <tt>inputfile*</tt> command></i></a>
}
elsif (s/^\s*(inputfile(?=\W))//i)
{
my ($cmd) = $1;
print OUT "%% $cmd$_" if $comments_on;
<a name="NWCUvTi-RKDir-1-u14" href="#NWDCUvTi-15"><i><process <tt>inputfile</tt> command></i></a>
}
elsif (s/^\s*(linethickness(?=\W))//i)
{
my $cmd = $1;
print OUT "%% $cmd$_" if $comments_on;
<a name="NWCUvTi-RKDir-1-u15" href="#NWDCUvTi-16"><i><process <tt>linethickness</tt> command></i></a>
}
elsif (s/^\s*(paper(?=\W))//i)
{
my ($cmd) = $1;
print OUT "%% $cmd$_" if $comments_on;
<a name="NWCUvTi-RKDir-1-u16" href="#NWDCUvTi-17"><i><process <tt>paper</tt> command></i></a>
}
elsif (s/^\s*(PointSymbol(?=\W))//i)
{
my $cmd = $1;
print OUT "%% $cmd$_" if $comments_on;
<a name="NWCUvTi-RKDir-1-u17" href="#NWDCUvTi-1X"><i><process <tt>PointSymbol</tt> command></i></a>
}
elsif (s/^\s*point(?=\W)//i)
{
my ($Point_Line);
chomp($Point_Line=$_);
<a name="NWCUvTi-RKDir-1-u18" href="#NWDCUvTi-1I"><i><process <tt>point/point*</tt> commands></i></a>
}
elsif (/^\s*setPointNumber(?=\W)/i)
{
PrintWarningMessage("Command setPointNumber is ignored",$lc);
next LINE;
}
elsif (s/^\s*(showAngle(?=\W))//i)
{
<a name="NWCUvTi-RKDir-1-u19" href="#NWDCUvTi-1B"><i><process <tt>showAngle</tt> command></i></a>
}
elsif (s/^\s*(showArea(?=\W))//i)
{
<a name="NWCUvTi-RKDir-1-u20" href="#NWDCUvTi-1C"><i><process <tt>showArea</tt> command></i></a>
}
elsif (s/^\s*(showLength(?=\W))//i)
{
<a name="NWCUvTi-RKDir-1-u21" href="#NWDCUvTi-1D"><i><process <tt>showLength</tt> command></i></a>
}
elsif (/^\s*showPoints(?=\W)/i)
{
print OUT "%%-------------------------------------------------\n";
print OUT "%% L I S T O F P O I N T S \n";
print OUT "%%-------------------------------------------------\n";
foreach my $p (keys(%PointTable)) {
my ($x, $y, $pSV, $pS) = unpack("d3A*",$PointTable{$p});
printf OUT "%%%%\t%s\t= ( %.5f, %.5f ), LF-radius = %.5f, symbol = %s\n",
$p, $x, $y, $pSV, $pS;
}
print OUT "%%-------------------------------------------------\n";
print OUT "%% E N D O F L I S T O F P O I N T S \n";
print OUT "%%-------------------------------------------------\n";
next LINE;
}
elsif (/^\s*showVariables(?=\W)/i)
{
print OUT "%%-------------------------------------------------\n";
print OUT "%% L I S T O F V A R I A B L E S \n";
print OUT "%%-------------------------------------------------\n";
foreach my $var (keys(%VarTable)) {
print OUT "%%\t", $var, "\t=\t", $VarTable{$var}, "\n";
}
print OUT "%%-------------------------------------------------\n";
print OUT "%% E N D O F L I S T O F V A R I A B L E S \n";
print OUT "%%-------------------------------------------------\n";
next LINE;
}
elsif (s/^\s*(system(?=\W))//i)
{
print OUT "%% $1$_" if $comments_on;
<a name="NWCUvTi-RKDir-1-u22" href="#NWDCUvTi-1Y"><i><process <tt>system</tt> command></i></a>
}
elsif (s/^\s*(text(?=\W))//i)
{
print OUT "%% $1$_" if $comments_on;
<a name="NWCUvTi-RKDir-1-u23" href="#NWDCUvTi-1Z"><i><process <tt>text</tt> command></i></a>
}
elsif (s/^\s*(var(?=\W))//i)
{
print OUT "%% $1$_" if $comments_on;
<a name="NWCUvTi-RKDir-1-u24" href="#NWDCUvTi-1d"><i><process <tt>var</tt> command></i></a>
}
elsif (/^\s*\\(.+)/)
{
my $line = $1;
if ($line =~ /^\s+(.+)/)
{
print OUT " $line\n";
}
else
{
print OUT "\\$line\n";
}
next LINE;
}
elsif (0==length) #empty line
{
next LINE;
}
else {
PrintErrorMessage("command not recognized",$lc);
next LINE;
}
</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="NWDCUvTi-s">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 < d<sub>1</sub>, g<sub>1</sub>, d<sub>2</sub>,
g<sub>2</sub>, ...></tt>
</center>
<pre><a name="NWCUvTi-19jqyn-1" href="#NWDCUvTi-s"><dfn><process <tt>dasharray</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
chk_lparen($cmd,$lc);
my @DashArray = ();
my $dash = "";
my $dashpattern = "";
PATTERN: while (1) {
$dash = sprintf("%.5f", expr($lc));
if (s/^\s*($units)//i) {
push (@DashArray, "$dash$1");
}
else {
PrintErrorMessage("Did not found unit after expression", $lc);
}
s/\s*//;
if (/^[^,]/) {
last PATTERN;
}
else {
s/^,\s*//;
}
}
print OUT "\\setdashpattern <";
while (@DashArray) {
$dashpattern .= shift @DashArray;
$dashpattern .= ",";
}
$dashpattern =~ s/,$//;
print OUT $dashpattern, ">\n";
chk_rparen("arguments of $cmd",$lc);
chk_comment($lc);
</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="NWDCUvTi-t">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="NWCUvTi-12lwO-1" href="#NWDCUvTi-t"><dfn><process <tt>drawAngleArcOrArrow</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
chk_lcb($cmd,$lc);
<a name="NWCUvTi-12lwO-1-u1" href="#NWDCUvTi-u"><i><process <tt>angle</tt> part of command></i></a>
s/^,\s*// or s/\s*//; #parse optional comma
<a name="NWCUvTi-12lwO-1-u2" href="#NWDCUvTi-v"><i><process <tt>radius</tt> part of command></i></a>
s/^,\s*// or s/\s*//; #parse optional comma
my $inout = "";
if (s/^(internal(?=\W))//i or s/^(external(?=\W))//i) {
$inout = $1;
}
else {
PrintErrorMessage("Did not find expected 'internal' specifier", $lc);
next LINE;
}
s/^,\s*// or s/\s*//; #parse optional comma
my $direction = "";
if (s/^(clockwise(?=\W))//i or s/^(anticlockwise(?=\W))//i) {
$direction = $1;
}
else {
PrintErrorMessage("Did not find expected 'direction' specifier", $lc);
next LINE;
}
chk_rcb("arguments of $cmd",$lc);
chk_comment($lc);
my $code;
if (lc($cmd) eq "drawanglearc") {
$code = drawAngleArc($P1, $P2, $P3, $radius, $inout, $direction);
}
else {
$code = drawAngleArrow($P1, $P2, $P3, $radius, $inout, $direction);
}
print OUT $code if $code ne "";
</pre><p><a name="NWDCUvTi-u">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="NWCUvTi-4X9wPg-1" href="#NWDCUvTi-u"><dfn><process <tt>angle</tt> part of command>=</dfn></a> <b>(<a href="#NWDCUvTi-t"><-U</a>)</b>
my ($P1, $P2, $P3);
if (s/^angle(?=\W)//i) {
chk_lparen("token angle of command $cmd",$lc);
$P1 = get_point($lc);
next LINE if $P1 eq "_undef_";
$P2 = get_point($lc);
next LINE if $P2 eq "_undef_";
$P3 = get_point($lc);
next LINE if $P3 eq "_undef_";
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$P1});
my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$P2});
my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$P3});
my $Angle = Angle($x1, $y1, $x2, $y2, $x3, $y3);
if ($Angle <= 0) {
if ($Angle == 0) {
PrintErrorMessage("Angle is equal to zero",$lc);
next LINE;
}
elsif ($Angle < -400) {
PrintErrorMessage("Something is wrong with the points",$lc);
next LINE;
}
}
chk_rparen("angle part of command $cmd",$lc);
}
else {
PrintErrorMessage("Did not find expected angle part",$lc);
next LINE;
}
</pre><p><a name="NWDCUvTi-v">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="NWCUvTi-2mAaDL-1" href="#NWDCUvTi-v"><dfn><process <tt>radius</tt> part of command>=</dfn></a> <b>(<a href="#NWDCUvTi-t"><-U</a>)</b>
my $radius;
if (s/^radius(?=\W)//i) {
chk_lparen("token radius of command $cmd",$lc);
$radius = expr($lc);
chk_rparen("radius part of command $cmd",$lc);
}
else {
PrintErrorMessage("Did not found expected angle part",$lc);
next LINE;
}
</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="NWDCUvTi-w">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="NWCUvTi-EIAAh-1" href="#NWDCUvTi-w"><dfn><process <tt>drawcircle</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
chk_lparen("drawcircle",$lc);
my $Point = get_point($lc);
next LINE if $Point eq "_undef_";
chk_comma($lc);
my $R = expr($lc);
if ($R <= 0) {
PrintErrorMessage("Radius must be greater than zero",$lc);
next LINE;
}
my ($x,$y,$pSV,$pS)=unpack("d3A*",$PointTable{lc($Point)});
printf OUT "\\circulararc 360 degrees from %.5f %.5f center at %.5f %.5f\n",
$x+$R, $y, $x, $y;
chk_rparen("arguments of $cmd",$lc);
chk_comment($lc);
</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="NWDCUvTi-x">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="NWCUvTi-1HqG4z-1" href="#NWDCUvTi-x"><dfn><process <tt>drawcircumcircle</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
chk_lparen("drawcircumcircle",$lc);
my $point1 = get_point($lc);
next LINE if $point1 eq "_undef_";
my $point2 = get_point($lc);
next LINE if $point2 eq "_undef_";
my $point3 = get_point($lc);
next LINE if $point3 eq "_undef_";
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point1});
my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point2});
my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point3});
my ($xc, $yc,$r) = circumCircleCenter($x1,$y1,$x2,$y2,$x3,$y3,$lc);
next LINE if $xc == 0 and $yc == 0 and $r == 0;
print OUT "%% circumcircle center = ($xc,$yc), radius = $r\n" if $comments_on;
printf OUT "\\circulararc 360 degrees from %.5f %.5f center at %.5f %.5f\n",
$xc+$r, $yc, $xc, $yc;
chk_rparen("arguments of $cmd",$lc);
chk_comment($lc);
</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="NWDCUvTi-y">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="NWCUvTi-Wbuba-1" href="#NWDCUvTi-y"><dfn><process <tt>drawexcircle</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
chk_lparen("drawexcircle",$lc);
my $point1 = get_point($lc);
next LINE if $point1 eq "_undef_";
my $point2 = get_point($lc);
next LINE if $point2 eq "_undef_";
my $point3 = get_point($lc);
next LINE if $point3 eq "_undef_";
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point1});
my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point2});
my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point3});
if (triangleArea($x1, $y1, $x2, $y2, $x3, $y3) < 0.0001) {
PrintErrorMessage("Area of triangle is zero!",$lc);
next LINE;
}
chk_comma($lc);
my $point4 = get_point($lc);
if (!memberOf($point4, $point1, $point2, $point3)) {
PrintErrorMessage("Current point isn't a side point",$lc);
next LINE;
}
next LINE if $point4 eq "_undef_";
my $point5 = get_point($lc);
next LINE if $point5 eq "_undef_";
if (!memberOf($point5, $point1, $point2, $point3)) {
PrintErrorMessage("Current point isn't a side point",$lc);
next LINE;
}
if ($point4 eq $point5) {
PrintErrorMessage("Side points are identical",$lc);
next LINE;
}
chk_rparen("arguments of $cmd",$lc);
my ($xc, $yc, $r) = excircle($point1, $point2, $point3,
$point4, $point5);
my $R=$r;
if (s/^\s*\[\s*//) {
$R += expr($lc);
if ($R < 0.0001) {
PrintErrorMessage("Radius has become equal to zero!",$lc);
next LINE;
}
chk_rsb($lc);
}
if ($R > (500 / 2.845)) {
PrintErrorMessage("Radius is greater than 175mm!",$lc);
next LINE;
}
print OUT "%% excircle center = ($xc,$yc) radius = $R\n" if $comments_on;
printf OUT "\\circulararc 360 degrees from %.5f %.5f center at %.5f %.5f\n",
$xc+$R, $yc, $xc, $yc;
chk_comment($lc);
</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="NWDCUvTi-z">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="NWCUvTi-3GJ2p7-1" href="#NWDCUvTi-z"><dfn><process <tt>drawincircle</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
chk_lparen("drawincircle",$lc);
my $point1 = get_point($lc);
next LINE if $point1 eq "_undef_";
my $point2 = get_point($lc);
next LINE if $point2 eq "_undef_";
my $point3 = get_point($lc);
next LINE if $point3 eq "_undef_";
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point1});
my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point2});
my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point3});
if (triangleArea($x1, $y1, $x2, $y2, $x3, $y3) < 0.0001) {
PrintErrorMessage("Area of triangle is zero!",$lc);
next LINE;
}
my ($xc, $yc, $r) = IncircleCenter($x1,$y1,$x2,$y2,$x3,$y3);
my $R=$r;
if (s/^\s*\[\s*//) {
$R += expr($lc);
if ($R < 0.0001) {
PrintErrorMessage("Radius has become equal to zero!",$lc);
next LINE;
}
chk_rsb($lc);
}
if ($R > (500 / 2.845)) {
PrintErrorMessage("Radius is greater than 175mm!",$lc);
next LINE;
}
print OUT "%% incircle center = ($xc,$yc) radius = $R\n" if $comments_on;
printf OUT "\\circulararc 360 degrees from %.5f %.5f center at %.5f %.5f\n",
$xc+$R, $yc, $xc, $yc;
chk_rparen("arguments of $cmd",$lc);
chk_comment($lc);
</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="NWDCUvTi-10">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="NWCUvTi-4OiWfi-1" href="#NWDCUvTi-10"><dfn><process <tt>drawPerpendicular</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
chk_lparen($cmd,$lc);
my $A = get_point($lc);
next LINE if $A eq "_undef_";
chk_comma($lc);
my $B = get_point($lc);
next LINE if $A eq "_undef_";
s/\s*//; #ignore white space
my $C = get_point($lc);
next LINE if $A eq "_undef_";
chk_rparen("arguments of $cmd",$lc);
chk_comment($lc);
#
#start actual computation
#
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$A});
my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$B});
my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$C});
my ($xF, $yF) = perpendicular($x1, $y1, $x2, $y2, $x3, $y3);
printf OUT "\\plot %.5f %.5f %.5f %.5f /\n",
$x1, $y1, $xF, $yF;
</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="NWDCUvTi-11">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="NWCUvTi-2EC5Ei-1" href="#NWDCUvTi-11"><dfn><process <tt>drawpoint</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
my ($stacklen);
chk_lparen("$cmd",$lc);
if (/^\)/) {
PrintErrorMessage("There are no point to draw",$lc);
next LINE;
}
my(@PP);
DRAWPOINTS:while(1) {
if (s/^([^\W\d_]\d{0,4})//i) { #point name
$P = $1;
if (!exists($PointTable{lc($P)})) {
PrintErrorMessage("Undefined point $P",$lc);
next DRAWPOINTS;
}
else {
push (@PP,$P);
s/\s*//;
}
}
else {
last DRAWPOINTS;
}
}
drawpoints(@PP);
chk_rparen("arguments of $cmd",$lc);
chk_comment($lc);
</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="NWDCUvTi-12">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="NWCUvTi-2KJKP6-1" href="#NWDCUvTi-12"><dfn><process <tt>drawRightAngle</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
chk_lparen("drawRightAngle",$lc);
my $point1 = get_point($lc);
next LINE if $point1 eq "_undef_";
my $point2 = get_point($lc);
next LINE if $point2 eq "_undef_";
my $point3 = get_point($lc);
next LINE if $point3 eq "_undef_";
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point1});
my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point2});
my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point3});
chk_comma($lc);
my $dist = expr($lc);
chk_rparen("arguments of $cmd",$lc);
chk_comment($lc);
#
#actual computation
#
my ($Px, $Py) = pointOnLine($x2, $y2, $x1, $y1, $dist);
my ($Qx, $Qy) = pointOnLine($x2, $y2, $x3, $y3, $dist);
my ($Tx, $Ty) = midpoint($Px, $Py, $Qx, $Qy);
my ($Ux, $Uy) = pointOnLine($x2, $y2, $Tx, $Ty, 2*Length($x2, $y2, $Tx, $Ty));
if ($Px == $Ux || $Py == $Uy) {
printf OUT "\\putrule from %.5f %.5f to %.5f %.5f \n", $Px,$Py,$Ux,$Uy;
}
else {
printf OUT "\\plot %.5f %.5f\t%.5f %.5f / \n", $Px, $Py,$Ux,$Uy;
}
if ($Ux == $Qx || $Uy == $Qy) {
printf OUT "\\putrule from %.5f %.5f to %.5f %.5f \n", $Ux,$Uy,$Qx,$Qy;
}
else {
printf OUT "\\plot %.5f %.5f\t%.5f %.5f / \n", $Ux, $Uy,$Qx,$Qy;
}
</pre><p><a name="NWDCUvTi-13">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="NWCUvTi-2lxjRF-1" href="#NWDCUvTi-13"><dfn><process <tt>drawsquare</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
chk_lparen("drawSquare",$lc);
my $p = get_point($lc);
chk_comma($lc);
my $side = expr($lc);
$side = $side - (1.1 * $LineThickness/$xunits); #Suggested by RWDN
my ($x,$y,$pSV,$pS) = unpack("d3A*",$PointTable{$p});
printf OUT "\\put {%s} at %.5f %.5f %%drawsquare\n", drawsquare($side), $x, $y;
chk_rparen("arguments of $cmd",$lc);
chk_comment($lc);
</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="NWDCUvTi-14">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="NWCUvTi-fJuCf-1" href="#NWDCUvTi-14"><dfn><process <tt>inputfile*</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
chk_lparen("inputfile*",$lc);
my $row_in = "";
if (s/^((\w|-|\.)+)//) {
$row_in = $1;
}
else {
PrintErrorMessage("No input file name found",$lc);
next LINE;
}
if (!(-e $row_in)) {
PrintErrorMessage("File $row_in does not exist",$lc);
next LINE;
}
open(ROW, "$row_in")|| die "Can't open file $row_in\n";
while (defined($in_line=<ROW>)) { print OUT $in_line; }
print OUT "%% ... end of input file <$row_in>\n";
close ROW;
chk_rparen("input file name",$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="NWDCUvTi-15">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="NWCUvTi-2EQO3c-1" href="#NWDCUvTi-15"><dfn><process <tt>inputfile</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
chk_lparen("inputfile",$lc);
my $comm_in = "";
if (s/^((\w|-|\.)+)//) {
$comm_in = $1;
}
else {
PrintErrorMessage("No input file name found",$lc);
next LINE;
}
if (!(-e $comm_in)) {
PrintErrorMessage("File $comm_in does not exist",$lc);
next LINE;
}
chk_rparen("input file name",$lc);
my $input_times = 1; #default value
if (s/^\[//) {
$input_times = expr($lc);
chk_rsb("optional argument",$lc);
}
print OUT "%% ... start of file <$comm_in> loop [$input_times]\n";
for (my $i=0; $i<int($input_times); $i++) {
open(COMM,"$comm_in") or die "Can't open file $comm_in\n";
print OUT "%%% Iteration number: ",$i+1,"\n";
my $old_file_name = $curr_in_file;
process_input(COMM,"File $comm_in, ");
$curr_in_file = $old_file_name;
close COMM;
}
print OUT "%% ... end of file <$comm_in> loop [$input_times]\n";
chk_comment($lc);
</pre><p><a name="NWDCUvTi-16">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="NWCUvTi-1t58ZF-1" href="#NWDCUvTi-16"><dfn><process <tt>linethickness</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
chk_lparen("linethickness", $lc);
if (s/^default//i) {
print OUT "\\linethickness=0.4pt\\Linethickness{0.4pt}%%\n";
print OUT "\\setplotsymbol ({\\usefont{OT1}{cmr}{m}{n}\\tiny .})%\n";
$LineThickness = setLineThickness($xunits,"0.4pt");
}
else {
my $length = expr($lc);
if (s/^\s*($units)//i) {
my $units = $1;
printf OUT "\\linethickness=%.5f%s\\Linethickness{%.5f%s}%%\n",
$length, $units, $length, $units;
$LineThickness = setLineThickness($xunits,"$length$units");
my $mag;
if ($units eq "pc") {
$mag = $length * 12;
}
elsif ($units eq "in") {
$mag = $length * 72.27;
}
elsif ($units eq "bp") {
$mag = $length * 1.00375;
}
elsif ($units eq "cm") {
$mag = $length * 28.45275;
}
elsif ($units eq "mm") {
$mag = $length * 2.845275;
}
elsif ($units eq "dd") {
$mag = $length * 1.07001;
}
elsif ($units eq "cc") {
$mag = $length * 0.08917;
}
elsif ($units eq "sp") {
$mag = $length * 0.000015259;
}
elsif ($units eq "pt") {
$mag = $length;
}
$mag = 10 * $mag / 1.00278219;
printf OUT "\\font\\CM=cmr10 at %.5fpt%%\n", $mag;
print OUT "\\setplotsymbol ({\\CM .})%\n";
}
else {
PrintErrorMessage("Did not found expect units part",$lc);
}
}
chk_rparen("linethickness", $lc);
chk_comment($lc);
</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="NWDCUvTi-17">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="NWCUvTi-1Pby5X-1" href="#NWDCUvTi-17"><dfn><process <tt>paper</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
chk_lcb("paper", $lc);
if (s/^units(?=\W)//i)
{
<a name="NWCUvTi-1Pby5X-1-u1" href="#NWDCUvTi-18"><i><process <tt>unit</tt> part></i></a>
$nounits = 0;
}
else
{
$nounits = 1;
}
s/^,\s*// or s/\s*//;
if (s/^xrange//i)
{
<a name="NWCUvTi-1Pby5X-1-u2" href="#NWDCUvTi-19"><i><process <tt>xrange</tt> part></i></a>
$noxrange = 0;
}
else
{
$noxrange = 1;
}
s/^,\s*// or s/\s*//;
if (s/^yrange//i)
{
<a name="NWCUvTi-1Pby5X-1-u3" href="#NWDCUvTi-1A"><i><process <tt>yrange</tt> part></i></a>
$noyrange = 0;
}
else
{
$noyrange = 1;
}
<a name="NWCUvTi-1Pby5X-1-u4" href="#NWDCUvTi-1E"><i><generate plot area related commands></i></a>
s/^,\s*// or s/\s*//;
$axis = "";
if (s/^ax[ei]s(?=\W)//i)
{
<a name="NWCUvTi-1Pby5X-1-u5" href="#NWDCUvTi-1F"><i><process <tt>axis</tt> part></i></a>
}
$axis = uc($axis);
s/^,\s*// or s/\s*//;
if (s/^ticks(?=\W)//i)
{
<a name="NWCUvTi-1Pby5X-1-u6" href="#NWDCUvTi-1G"><i><process <tt>ticks</tt> part></i></a>
}
else
{
$xticks = $yticks = 0;
}
chk_rcb("paper", $lc);
<a name="NWCUvTi-1Pby5X-1-u7" href="#NWDCUvTi-1H"><i><generate the rest of the code for the <tt>paper</tt> command></i></a>
chk_comment($lc);
</pre><p><a name="NWDCUvTi-18">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="NWCUvTi-15UlOC-1" href="#NWDCUvTi-18"><dfn><process <tt>unit</tt> part>=</dfn></a> <b>(<a href="#NWDCUvTi-17"><-U</a>)</b>
chk_lparen("units",$lc);
if(s/^\)//)
{
PrintWarningMessage("Missing value in \"units\"--default is 1pt",
$lc);
$xunits = "1pt";
}
else {
$xunits = expr($lc);
s/\s*//;
if (s/^($units)//i) {
$xunits .= "$1";
$LineThickness = setLineThickness($xunits,"0.4pt");
}
elsif(s/^(\w)+//i) {
PrintErrorMessage("$1 is not a valid mathspic unit",$lc);
$xunits = "1pt";
}
else {
PrintErrorMessage("No x-units found",$lc);
$xunits = "1pt";
}
s/\s*//; #ignore white space
if (s/^,//) { # there is a comma so expect an y-units
s/\s*//; #ignore white space
$yunits = expr($lc);
s/\s*//; #ignore white space
if (s/^($units)//i) {
$yunits .= "$1";
}
elsif(s/^(\w)+//i) {
PrintErrorMessage("$1 is not a valid mathspic unit",$lc);
$yunits = "1pt";
}
else {
PrintErrorMessage("No y-units found",$lc);
$yunits = $xunits;
}
}
else {
$yunits = $xunits;
}
chk_rparen("units",$lc);
}
</pre><p><a name="NWDCUvTi-19">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="NWCUvTi-39noUt-1" href="#NWDCUvTi-19"><dfn><process <tt>xrange</tt> part>=</dfn></a> <b>(<a href="#NWDCUvTi-17"><-U</a>)</b>
chk_lparen("xrange",$lc);
my $ec;
($xlow,$ec) = ComputeDist($lc);
next LINE if $ec == 0;
chk_comma($lc);
($xhigh,$ec) = ComputeDist($lc);
next LINE if $ec == 0;
if ($xlow >= $xhigh)
{
PrintErrorMessage("xlow >= xhigh in xrange",$lc);
next LINE;
}
chk_rparen("$xhigh",$lc);
</pre><p><a name="NWDCUvTi-1A">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="NWCUvTi-3SApmu-1" href="#NWDCUvTi-1A"><dfn><process <tt>yrange</tt> part>=</dfn></a> <b>(<a href="#NWDCUvTi-17"><-U</a>)</b>
chk_lparen("yrange",$lc);
my $ec;
($ylow,$ec) = ComputeDist($lc);
next LINE if $ec == 0;
chk_comma($lc);
($yhigh,$ec) = ComputeDist($lc);
next LINE if $ec == 0;
if ($ylow >= $yhigh)
{
PrintErrorMessage("ylow >= yhigh in yrange",$lc);
next LINE;
}
chk_rparen("$yhigh",$lc);
</pre><p><a name="NWDCUvTi-1B">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="NWCUvTi-2ObcXb-1" href="#NWDCUvTi-1B"><dfn><process <tt>showAngle</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
chk_lparen("showangle",$lc);
my $point_1 = get_point($lc);
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1});
my $point_2 = get_point($lc);
my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2});
my $point_3 = get_point($lc);
my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point_3});
my $angle = Angle($x1, $y1, $x2, $y2, $x3, $y3);
$angle = 0 if $angle == -500;
printf OUT "%%%% angle(%s%s%s) = %.5f deg ( %.5f rad)\n", $point_1,
$point_2, $point_3, $angle, $angle*D2R;
chk_rparen("Missing right parenthesis", $lc);
</pre><p><a name="NWDCUvTi-1C">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="NWCUvTi-2THNRJ-1" href="#NWDCUvTi-1C"><dfn><process <tt>showArea</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
chk_lparen("showarea",$lc);
my $point_1 = get_point($lc);
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1});
my $point_2 = get_point($lc);
my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2});
my $point_3 = get_point($lc);
my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$point_3});
print OUT "%% area($point_1$point_2$point_3) = ",
triangleArea($x1, $y1, $x2, $y2, $x3, $y3), "\n";
chk_rparen("Missing right parenthesis", $lc);
</pre><p><a name="NWDCUvTi-1D">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="NWCUvTi-Ofe1b-1" href="#NWDCUvTi-1D"><dfn><process <tt>showLength</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
chk_lparen("showlength",$lc);
my $point_1 = get_point($lc);
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$point_1});
my $point_2 = get_point($lc);
my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$point_2});
print OUT "%% length($point_1$point_2) = ",
Length($x1, $y1, $x2, $y2), "\n";
chk_rparen("Missing right parenthesis", $lc);
</pre><p><a name="NWDCUvTi-1E">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="NWCUvTi-2SitZA-1" href="#NWDCUvTi-1E"><dfn><generate plot area related commands>=</dfn></a> <b>(<a href="#NWDCUvTi-17"><-U</a>)</b>
if (!$nounits)
{
printf OUT "\\setcoordinatesystem units <%s,%s>\n",
$xunits,$yunits;
}
if(!$noxrange && !$noyrange)
{
printf OUT "\\setplotarea x from %.5f to %.5f, y from %.5f to %.5f\n",
$xlow, $xhigh, $ylow, $yhigh;
}
</pre><p>We first check to see whether there is an opening left parenthesis. Next
<a name="NWDCUvTi-1F">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="NWCUvTi-19Hy2D-1" href="#NWDCUvTi-1F"><dfn><process <tt>axis</tt> part>=</dfn></a> <b>(<a href="#NWDCUvTi-17"><-U</a>)</b>
chk_lparen("axis",$lc);
while(/^[^\)]/)
{
if (s/^([lrtbxy]{1}\*?)//i)
{
$axis .= $1;
}
elsif (s/^([^lrtbxy])//i)
{
PrintErrorMessage("Non-valid character \"$1\" in axis()",$lc);
}
s/\s*//;
}
chk_rparen("axis(arguments",$lc);
</pre><p>As usual we start by skipping white space. Next we check whether there is
<a name="NWDCUvTi-1G">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="NWCUvTi-1isLLJ-1" href="#NWDCUvTi-1G"><dfn><process <tt>ticks</tt> part>=</dfn></a> <b>(<a href="#NWDCUvTi-17"><-U</a>)</b>
chk_lparen("ticks",$lc);
my $ec;
($xticks,$ec) = ComputeDist($lc);
next LINE if $ec == 0;
chk_comma($lc);
($yticks,$ec) = ComputeDist($lc);
next LINE if $ec == 0;
chk_rparen("ticks(arguments",$lc);
</pre><p><a name="NWDCUvTi-1H">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="NWCUvTi-2gFm3I-1" href="#NWDCUvTi-1H"><dfn><generate the rest of the code for the <tt>paper</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-17"><-U</a>)</b>
YBRANCH: {
if (index($axis, "Y")>-1)
{
if (index($axis, "Y*")>-1)
{
print OUT "\\axis left shiftedto x=0 / \n";
last YBRANCH;
}
if ($yticks > 0)
{
if (index($axis, "T")>-1 && index($axis, "B")==-1)
{
print OUT "\\axis left shiftedto x=0 ticks numbered from ";
print OUT "$ylow to -$yticks by $yticks\n from $yticks to ";
print OUT $yhigh-$yticks," by $yticks /\n";
}
elsif (index($axis, "T")==-1 && index($axis, "B")>-1)
{
print OUT "\\axis left shiftedto x=0 ticks numbered from ";
print OUT $ylow+$yticks," to -$yticks by $yticks\n from ";
print OUT "$yticks to $yhigh by $yticks /\n";
}
elsif (index($axis, "T")>-1 && index($axis, "B")>-1)
{
print OUT "\\axis left shiftedto x=0 ticks numbered from ";
print OUT $ylow+$yticks," to -$yticks by $yticks\n from ";
print OUT "$yticks to ",$yhigh-$yticks," by $yticks /\n";
}
else
{
print OUT "\\axis left shiftedto x=0 ticks numbered from ";
print OUT "$ylow to -$yticks by $yticks\n from ";
print OUT "$yticks to $yhigh by $yticks /\n";
}
}
else
{
print OUT "\\axis left shiftedto x=0 /\n";
}
}
}
XBRANCH: { if (index($axis, "X")>-1)
{
if (index($axis, "X*")>-1)
{
print OUT "\\axis bottom shiftedto y=0 /\n";
last XBRANCH;
}
if ($xticks > 0)
{
if (index($axis, "L")>-1 && index($axis, "R")==1)
{
print OUT "\\axis bottom shiftedto y=0 ticks numbered from ";
print OUT $xlow + $xticks," to -$xticks by $xticks\n from";
print OUT " $xticks to $xhigh by $xticks /\n";
}
elsif (index($axis, "L")==-1 && index($axis, "R")>-1)
{
print OUT "\\axis bottom shiftedto y=0 ticks numbered from ";
print OUT "$xlow to -$xticks by $xticks\n from ";
print OUT "$xticks to ",$xhigh-$xticks," by $xticks /\n";
}
elsif (index($axis, "L")>-1 && index($axis, "R")>-1)
{
print OUT "\\axis bottom shiftedto y=0 ticks numbered from ";
print OUT $xlow + $xticks," to -$xticks by $xticks\n from ";
print OUT "$xticks to ",$xhigh - $xticks," by $xticks /\n";
}
else
{
print OUT "\\axis bottom shiftedto y=0 ticks numbered from ";
print OUT "$xlow to -$xticks by $xticks\n from ";
print OUT "$xticks to $xhigh by $xticks /\n";
}
}
else
{
print OUT "\\axis bottom shiftedto y=0 /\n";
}
} }
LBRANCH: {if (index($axis, "L")>-1)
{
if (index($axis, "L")>-1)
{
if (index($axis, "L*")>-1)
{
print OUT "\\axis left /\n";
last LBRANCH;
}
if ($yticks > 0)
{
print OUT "\\axis left ticks numbered from ";
print OUT "$ylow to $yhigh by $yticks /\n";
}
else
{
print OUT "\\axis left /\n";
}
}
} }
RBRANCH: { if (index($axis, "R")>-1)
{
if (index($axis, "R*")>-1)
{
print OUT "\\axis right /\n";
last RBRANCH;
}
if ($yticks > 0)
{
print OUT "\\axis right ticks numbered from $ylow to $yhigh by ";
print OUT "$yticks /\n";
}
else
{
print OUT "\\axis right /\n";
}
} }
TBRANCH: { if (index($axis, "T")>-1)
{
if (index($axis, "T*")>-1)
{
print OUT "\\axis top /\n";
last TBRANCH;
}
if ($xticks > 0)
{
print OUT "\\axis top ticks numbered from $xlow to $xhigh by ";
print OUT "$xticks /\n";
}
else
{
print OUT "\\axis top /\n";
}
} }
BBRANCH: { if (index($axis, "B")>-1)
{
if (index($axis, "B*")>-1)
{
print OUT "\\axis bottom /\n";
last BBRANCH;
}
if ($xticks > 0)
{
print OUT "\\axis bottom ticks numbered from $xlow to $xhigh by ";
print OUT "$xticks /\n";
}
else
{
print OUT "\\axis bottom /\n";
}
} }
</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="NWDCUvTi-1I">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="NWCUvTi-2bvYBY-1" href="#NWDCUvTi-1I"><dfn><process <tt>point/point*</tt> commands>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
my ($pointStar, $PointName, $origPN);
$pointStar = 0; # default value: he have a point command
$pointStar = 1 if s/^\*//;
chk_lparen("point" . (($pointStar)?"*":""),$lc);
if (s/^([^\W\d_](?![^\W\d_])\d{0,4})//i) {
#
# Note: the regular expression (foo)(?!bar) means that we are
# looking a foo not followed by a bar. Moreover, the regular
# expression [^\W\d_] means that we are looking for letter.
#
$origPN = $1;
$PointName = lc($1);
}
else {
PrintErrorMessage("Invalid point name",$lc);
next LINE;
}
#if ($pointStar and !exists($PointTable{$PointName})) {
# PrintWarningMessage("Point $origPN has not been defined",$lc);
#}
if (!$pointStar and exists($PointTable{$PointName})) {
PrintWarningMessage("Point $origPN has been used already",$lc);
}
chk_rparen("point" . (($pointStar)?"*":""). "($origPN",$lc);
chk_lcb("point" . (($pointStar)?"*":""). "($origPN)",$lc);
my ($Px, $Py);
<a name="NWCUvTi-2bvYBY-1-u1" href="#NWDCUvTi-1J"><i><process coordinates></i></a>
chk_rcb("coordinates part",$lc);
my $sv = $defaultsymbol;
my $sh = $defaultLFradius;
my $side_or_radius = undef;
if (s/^\[\s*//) { # the user has opted to specify the optional part
<a name="NWCUvTi-2bvYBY-1-u2" href="#NWDCUvTi-1V"><i><process optional point shape part></i></a>
chk_rsb("optional part",$lc);
}
# to avoid truncation problems introduced by the pack function, we
# round each number up to five decimal digits
$Px = sprintf("%.5f", $Px);
$Py = sprintf("%.5f", $Py);
print OUT "%% point$Point_Line \t$origPN = ($Px, $Py)\n" if $comments_on;
chk_comment($lc);
$PointTable{$PointName} = pack("d3A*",$Px,$Py,$sh,$sv);
if (defined($side_or_radius)) {
$DimOfPoint{$PointName} = $side_or_radius;
}
</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="NWDCUvTi-1J">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="NWCUvTi-3bnmlP-1" href="#NWDCUvTi-1J"><dfn><process coordinates>=</dfn></a> <b>(<a href="#NWDCUvTi-1I"><-U</a>)</b>
if (s/^perpendicular(?=\W)//i) {
<a name="NWCUvTi-3bnmlP-1-u1" href="#NWDCUvTi-1K"><i><process <tt>perpendicular</tt> case></i></a>
}
elsif (s/^intersection(?=\W)//i) {
<a name="NWCUvTi-3bnmlP-1-u2" href="#NWDCUvTi-1L"><i><process <tt>intersection</tt> case></i></a>
}
elsif (s/^midpoint(?=\W)//i) {
<a name="NWCUvTi-3bnmlP-1-u3" href="#NWDCUvTi-1M"><i><process <tt>midpoint</tt> case></i></a>
}
elsif (s/^pointonline(?=\W)//i) {
<a name="NWCUvTi-3bnmlP-1-u4" href="#NWDCUvTi-1N"><i><process <tt>pointonline</tt> case></i></a>
}
elsif (s/^circumcircleCenter(?=\W)//i) {
<a name="NWCUvTi-3bnmlP-1-u5" href="#NWDCUvTi-1O"><i><process <tt>circumcircleCenter</tt> case></i></a>
}
elsif (s/^IncircleCenter(?=\W)//i) {
<a name="NWCUvTi-3bnmlP-1-u6" href="#NWDCUvTi-1P"><i><process <tt>IncircleCenter</tt> case></i></a>
}
elsif (s/^ExcircleCenter(?=\W)//i) {
<a name="NWCUvTi-3bnmlP-1-u7" href="#NWDCUvTi-1Q"><i><process <tt>ExcircleCenter</tt> case></i></a>
}
elsif (/^[^\W\d_]\d{0,4}\s*[^,\w]/) {
m/^([^\W\d_]\d{0,4})\s*/i;
if (exists($PointTable{lc($1)})) {
my $Tcoord = get_point($lc);
my ($x,$y,$pSV,$pS)=unpack("d3A*",$PointTable{$Tcoord});
$Px = $x;
$Py = $y;
}
else {
$Px = expr();
chk_comma($lc);
$Py = expr();
}
}
elsif (/[^\W\d_]\d{0,4}\s*,\s*shift|polar|rotate|vector/i) { #a point?
s/^([^\W\d_]\d{0,4})//i;
my $PointA = $1;
if (exists($PointTable{lc($PointA)})) {
s/\s*//;
if (s/^,//) {
s/\s*//;
if (s/^shift(?=\W)//i) {
<a name="NWCUvTi-3bnmlP-1-u8" href="#NWDCUvTi-1R"><i><process <tt>shift</tt> case></i></a>
}
elsif (s/^polar(?=\W)//i) {
<a name="NWCUvTi-3bnmlP-1-u9" href="#NWDCUvTi-1S"><i><process <tt>polar</tt> case></i></a>
}
elsif (s/^rotate(?=\W)//i) {
<a name="NWCUvTi-3bnmlP-1-u10" href="#NWDCUvTi-1T"><i><process <tt>rotate</tt> case></i></a>
}
elsif (s/^vector(?=\W)//i) {
<a name="NWCUvTi-3bnmlP-1-u11" href="#NWDCUvTi-1U"><i><process <tt>vector</tt> case></i></a>
}
else {
PrintErrorMessage("unexpected token",$lc);
next LINE;
}
}
else {
my ($xA,$yA,$pSVA,$pSA)=unpack("d3A*",$PointTable{lc($PointA)});
$Px = $xA;
$Py = $yA;
}
}
else {
PrintErrorMessage("Undefined point $PointA",$lc);
next LINE;
}
}
else {
$Px = expr();
chk_comma($lc);
$Py = expr();
}
</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="NWDCUvTi-1K">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="NWCUvTi-s2gHc-1" href="#NWDCUvTi-1K"><dfn><process <tt>perpendicular</tt> case>=</dfn></a> <b>(<a href="#NWDCUvTi-1J"><-U</a>)</b>
chk_lparen("perpendicular",$lc);
my $FirstPoint = &get_point($lc);
next LINE if $FirstPoint eq "_undef_";
chk_comma($lc);
my $SecondPoint = &get_point($lc);
next LINE if $SecondPoint eq "_undef_";
my $ThirdPoint = &get_point($lc);
next LINE if $ThirdPoint eq "_undef_";
chk_rparen("No closing parenthesis found",$lc);
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$FirstPoint});
my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$SecondPoint});
my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$ThirdPoint});
($Px, $Py) = perpendicular($x1,$y1,$x2,$y2,$x3,$y3);
</pre><p><a name="NWDCUvTi-1L">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="NWCUvTi-1uJA3A-1" href="#NWDCUvTi-1L"><dfn><process <tt>intersection</tt> case>=</dfn></a> <b>(<a href="#NWDCUvTi-1J"><-U</a>)</b>
chk_lparen("intersection",$lc);
my $FirstPoint = get_point($lc);
next LINE if $FirstPoint eq "_undef_";
my $SecondPoint = get_point($lc);
next LINE if $SecondPoint eq "_undef_";
chk_comma($lc);
my $ThirdPoint = get_point($lc);
next LINE if $ThirdPoint eq "_undef_";
my $ForthPoint = get_point($lc);
next LINE if $ForthPoint eq "_undef_";
chk_rparen("No closing parenthesis found",$lc);
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$FirstPoint});
my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$SecondPoint});
my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$ThirdPoint});
my ($x4,$y4,$pSV4,$pS4)=unpack("d3A*",$PointTable{$ForthPoint});
($Px, $Py) = intersection4points($x1,$y1,$x2,$y2,$x3,$y3,$x4,$y4);
</pre><p><a name="NWDCUvTi-1M">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 with function <code>midpoint</code>.
<pre><a name="NWCUvTi-3udkns-1" href="#NWDCUvTi-1M"><dfn><process <tt>midpoint</tt> case>=</dfn></a> <b>(<a href="#NWDCUvTi-1J"><-U</a>)</b>
chk_lparen("midpoint",$lc);
my $FirstPoint = &get_point($lc);
next LINE if $FirstPoint eq "_undef_";
my $SecondPoint = &get_point($lc);
next LINE if $SecondPoint eq "_undef_";
chk_rparen("No closing parenthesis found",$lc);
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$FirstPoint});
my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$SecondPoint});
($Px, $Py) = midpoint($x1, $y1, $x2, $y2);
</pre><p><a name="NWDCUvTi-1N">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="NWCUvTi-2ahy6i-1" href="#NWDCUvTi-1N"><dfn><process <tt>pointonline</tt> case>=</dfn></a> <b>(<a href="#NWDCUvTi-1J"><-U</a>)</b>
chk_lparen("pointonline",$lc);
my $FirstPoint = &get_point($lc);
next LINE if $FirstPoint eq "_undef_";
my $SecondPoint = &get_point($lc);
next LINE if $SecondPoint eq "_undef_";
chk_comma($lc);
# now get the distance
my $distance = expr($lc);
chk_rparen("No closing parenthesis found",$lc);
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$FirstPoint});
my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$SecondPoint});
($Px, $Py) = pointOnLine($x1,$y1,$x2,$y2,$distance);
</pre><p><a name="NWDCUvTi-1O">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="NWCUvTi-2TpCLC-1" href="#NWDCUvTi-1O"><dfn><process <tt>circumcircleCenter</tt> case>=</dfn></a> <b>(<a href="#NWDCUvTi-1J"><-U</a>)</b>
chk_lparen("circumCircleCenter",$lc);
my $FirstPoint = &get_point($lc);
next LINE if $FirstPoint eq "_undef_";
my $SecondPoint = &get_point($lc);
next LINE if $SecondPoint eq "_undef_";
my $ThirdPoint = &get_point($lc);
next LINE if $ThirdPoint eq "_undef_";
chk_rparen("No closing parenthesis found",$lc);
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$FirstPoint});
my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$SecondPoint});
my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$ThirdPoint});
($Px, $Py,$r) = &circumCircleCenter($x1,$y1,$x2,$y2,$x3,$y3,$lc);
next LINE if $Px == 0 and $Py == 0 and $r == 0;
</pre><p><a name="NWDCUvTi-1P">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="NWCUvTi-4fhWIW-1" href="#NWDCUvTi-1P"><dfn><process <tt>IncircleCenter</tt> case>=</dfn></a> <b>(<a href="#NWDCUvTi-1J"><-U</a>)</b>
chk_lparen("IncircleCenter",$lc);
my $FirstPoint = &get_point($lc);
next LINE if $FirstPoint eq "_undef_";
my $SecondPoint = &get_point($lc);
next LINE if $SecondPoint eq "_undef_";
my $ThirdPoint = &get_point($lc);
next LINE if $ThirdPoint eq "_undef_";
chk_rparen("No closing parenthesis found",$lc);
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{$FirstPoint});
my ($x2,$y2,$pSV2,$pS2)=unpack("d3A*",$PointTable{$SecondPoint});
my ($x3,$y3,$pSV3,$pS3)=unpack("d3A*",$PointTable{$ThirdPoint});
($Px, $Py, $r) = IncircleCenter($x1,$y1,$x2,$y2,$x3,$y3);
</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="NWDCUvTi-1Q">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="NWCUvTi-13KcO0-1" href="#NWDCUvTi-1Q"><dfn><process <tt>ExcircleCenter</tt> case>=</dfn></a> <b>(<a href="#NWDCUvTi-1J"><-U</a>)</b>
chk_lparen("ExcircleCenter",$lc);
my $PointA = get_point($lc);
next LINE if $PointA eq "_undef_";
my $PointB = get_point($lc);
next LINE if $PointB eq "_undef_";
my $PointC = get_point($lc);
next LINE if $PointC eq "_undef_";
chk_comma($lc);
my $PointD = &get_point($lc);
next LINE if $PointD eq "_undef_";
if (!memberOf($PointD, $PointA, $PointB, $PointC)) {
PrintErrorMessage("Current point isn't a side point",$lc);
next LINE;
}
my $PointE = get_point($lc);
next LINE if $PointE eq "_undef_";
if (!memberOf($PointE, $PointA, $PointB, $PointC)) {
PrintErrorMessage("Current point isn't a side point",$lc);
next LINE;
}
if ($PointD eq $PointE) {
PrintErrorMessage("Side points are identical",$lc);
next LINE;
}
($Px, $Py, $r) = excircle($PointA, $PointB, $PointC,
$PointD, $PointE);
chk_rparen("after coordinates part",$lc);
</pre><p> <a name="NWDCUvTi-1R">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="NWCUvTi-aOKf8-1" href="#NWDCUvTi-1R"><dfn><process <tt>shift</tt> case>=</dfn></a> <b>(<a href="#NWDCUvTi-1J"><-U</a> <a href="#NWDCUvTi-1a">U-></a>)</b>
chk_lparen("shift",$lc);
my $dist1 = expr($lc);
chk_comma($lc);
my $dist2 = expr($lc);
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{lc($PointA)});
$Px = $x1 + $dist1;
$Py = $y1 + $dist2;
chk_rparen("shift part",$lc);
</pre><p><a name="NWDCUvTi-1S">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="NWCUvTi-2GUwzc-1" href="#NWDCUvTi-1S"><dfn><process <tt>polar</tt> case>=</dfn></a> <b>(<a href="#NWDCUvTi-1J"><-U</a> <a href="#NWDCUvTi-1a">U-></a>)</b>
chk_lparen("polar",$lc);
my ($R1, $Theta1);
$R1 = expr($lc);
chk_comma($lc);
$Theta1 = expr($lc);
my ($x1,$y1,$pSV1,$pS1)=unpack("d3A*",$PointTable{lc($PointA)});
s/\s*//;
if (s/^rad(?=\W)//i) {
# do nothing!
}
elsif (s/^deg(?=\W)//i) {
$Theta1 = $Theta1 * PI / 180;
}
else {
#$Theta1 = $Theta1 * PI / 180;
}
$Px = $x1 + $R1 * cos($Theta1);
$Py = $y1 + $R1 * sin($Theta1);
chk_rparen("after polar part",$lc);
</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="NWDCUvTi-1T">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="NWCUvTi-42YuKP-1" href="#NWDCUvTi-1T"><dfn><process <tt>rotate</tt> case>=</dfn></a> <b>(<a href="#NWDCUvTi-1J"><-U</a>)</b>
chk_lparen("rotate",$lc);
my $Q = lc($PointA);
my $P = get_point($lc);
next LINE if $P eq "_undef_";
chk_comma($lc);
my $Theta1 = expr($lc);
my ($xP,$yP,$pSV1,$pS1)=unpack("d3A*",$PointTable{$P});
my ($xQ,$yQ,$pSV2,$pS2)=unpack("d3A*",$PointTable{$Q});
s/\s*//;
if (s/^rad(?=\W)//i)
{
# do nothing!
}
elsif (s/^deg(?=\W)//i)
{
$Theta1 = $Theta1 * PI / 180;
}
else
{
$Theta1 = $Theta1 * PI / 180;
}
# shift origin to P
$xQ -= $xP;
$yQ -= $yP;
# do the rotation
$Px = $xQ * cos($Theta1) - $yQ * sin($Theta1);
$Py = $xQ * sin($Theta1) + $yQ * cos($Theta1);
# return origin back to original origin
$Px += $xP;
$Py += $yP;
chk_rparen("after rotate part",$lc);
</pre><p> <code><a name="NWDCUvTi-1U">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="NWCUvTi-3FiNXu-1" href="#NWDCUvTi-1U"><dfn><process <tt>vector</tt> case>=</dfn></a> <b>(<a href="#NWDCUvTi-1J"><-U</a>)</b>
chk_lparen("vector",$lc);
my ($x0,$y0,$pSV0,$pS0) = unpack("d3A*",$PointTable{lc($PointA)});
my $P = get_point($lc);
my $Q = get_point($lc);
my ($x1,$y1,$pSV1,$pS1) = unpack("d3A*",$PointTable{$P});
my ($x2,$y2,$pSV2,$pS2) = unpack("d3A*",$PointTable{$Q});
$Px = $x0 + $x2 - $x1;
$Py = $y0 + $y2 - $y1;
chk_rparen("vector part",$lc);
</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="NWDCUvTi-1V">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="NWCUvTi-48J1W6-1" href="#NWDCUvTi-1V"><dfn><process optional point shape part>=</dfn></a> <b>(<a href="#NWDCUvTi-1I"><-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 <= 2) {
my $option = lc($1);
if (s/^=\s*//) {
if (memberOf($option,@previous_options)) {
PrintErrorMessage("Option \"$option\" has been already defined", $lc);
my $dummy = expr($lc);
}
elsif ($option eq "radius") {
$sh = expr($lc);
$sv = $defaultsymbol if ! $symbol_set;
}
elsif ($option eq "symbol") {
if (s/^circle\s*//i) {
$sv = "circle";
chk_lparen("after token circle",$lc);
$side_or_radius = expr($lc);
chk_rparen("expression",$lc);
}
elsif (s/^square\s*//i) {
$sv = "square";
chk_lparen("after token square",$lc);
$side_or_radius = expr($lc);
chk_rparen("expression",$lc);
}
elsif (s/^(((\\\]){1}|(\\,){1}|(\\\s){1}|[^\],\s])+)//) {
$sv = $1;
$sv =~ s/\\\]/\]/g;
$sv =~ s/\\,/,/g;
$sv =~ s/\\ / /g;
s/\s*//;
}
$symbol_set = 1;
}
}
else {
PrintErrorMessage("unexpected token", $lc);
next LINE;
}
$number_of_options++;
push (@previous_options, $option);
s/^,\s*//;
}
}
else {
PrintErrorMessage("unexpected token", $lc);
next LINE;
}
</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="NWDCUvTi-1W">"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="NWCUvTi-4T61Ms-1" href="#NWDCUvTi-1W"><dfn><process <tt>ArrowShape</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
chk_lparen("$cmd",$lc);
if (s/^default//i) {
$arrowLength = 2;
$arrowLengthUnits = "mm";
$arrowAngleB = 30;
$arrowAngleC = 40;
}
else {
my ($LocalArrowLength, $LocalArrowAngleB ,$LocalArrowAngleC) = (0,0,0);
$LocalArrowLength = expr($lc);
if (s/^\s*($units)//i) {
$arrowLengthUnits = "$1";
}
else {
$xunits =~ /(\d+(\.\d+)?)\s*($units)/;
$LocalArrowLength *= $1;
$arrowLengthUnits = "$3";
}
chk_comma($lc);
$LocalArrowAngleB = expr($lc);
chk_comma($lc);
$LocalArrowAngleC = expr($lc);
$arrowLength = ($LocalArrowLength == 0 ? 2 : $LocalArrowLength);
$arrowLengthUnits = ($LocalArrowLength == 0 ? "mm" : $arrowLengthUnits);
$arrowAngleB = ($LocalArrowAngleB == 0 ? 30 : $LocalArrowAngleB);
$arrowAngleC = ($LocalArrowAngleC == 0 ? 40 : $LocalArrowAngleC);
}
chk_rparen("after $cmd arguments",$lc);
chk_comment("after $cmd command",$lc);
print OUT "%% arrowLength = $arrowLength$arrowLengthUnits, ",
"arrowAngleB = $arrowAngleB ",
"and arrowAngleC = $arrowAngleC\n" if $comments_on;
</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="NWDCUvTi-1X">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="NWCUvTi-iKtUD-1" href="#NWDCUvTi-1X"><dfn><process <tt>PointSymbol</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
chk_lparen("$cmd",$lc);
if (s/^default//i) #default point symbol
{
$defaultsymbol = "\$\\bullet\$";
}
elsif (s/^(circle|square)//i) {
$defaultsymbol = $1;
chk_lparen($defaultsymbol, $lc);
$GlobalDimOfPoints = expr($lc);
chk_rparen("expression", $lc);
}
elsif (s/^(((\\,){1}|(\\\)){1}|(\\\s){1}|[^\),\s])+)//) #arbitrary LaTeX point
{
$defaultsymbol = $1;
$defaultsymbol=~ s/\\\)/\)/g;
$defaultsymbol=~ s/\\,/,/g;
$defaultsymbol=~ s/\\ / /g;
}
else
{
PrintErrorMessage("unrecognized point symbol",$lc);
}
if (s/\s*,\s*//) {
$defaultLFradius = expr($lc);
}
chk_rparen("after $cmd arguments",$lc);
chk_comment("after $cmd command",$lc);
</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="NWDCUvTi-1Y">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="NWCUvTi-4C0pFV-1" href="#NWDCUvTi-1Y"><dfn><process <tt>system</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
chk_lparen("$cmd",$lc);
my ($error, $command, $rest) = get_string($_);
next LINE if $error == 1;
$_ = $rest;
if (! is_tainted($command)) {
system($command);
}
else {
PrintErrorMessage("String \"$command\" has tainted data", $lc);
next LINE;
}
chk_rparen("after $cmd arguments",$lc);
chk_comment("after $cmd command",$lc);
</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="NWDCUvTi-1Z">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="NWCUvTi-z25eX-1" href="#NWDCUvTi-1Z"><dfn><process <tt>text</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
chk_lparen("text",$lc);
my ($level,$text)=(1,"");
TEXTLOOP: while (1)
{
$level++ if /^\(/;
$level-- if /^\)/;
s/^(.)//;
last TEXTLOOP if $level==0;
$text .= $1;
}
chk_lcb("text part",$lc);
my ($Px, $Py,$dummy,$pos);
$pos="";
s/\s*//;
<a name="NWCUvTi-z25eX-1-u1" href="#NWDCUvTi-1a"><i><process coordinates part of text command></i></a>
chk_rcb("coordinates part of text command",$lc);
if (s/^\[//)
{
s/\s*//;
<a name="NWCUvTi-z25eX-1-u2" href="#NWDCUvTi-1b"><i><process optional part of text command></i></a>
s/\s*//;
chk_rsb("optional part of text command",$lc);
}
chk_comment($lc);
if ($pos eq "")
{
printf OUT "\\put {%s} at %f %f\n", $text, $Px, $Py;
}
else
{
printf OUT "\\put {%s} [%s] at %f %f\n", $text, $pos, $Px, $Py;
}
</pre><p> In this section we define the code that handles the coordinates part
<a name="NWDCUvTi-1a">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="NWCUvTi-Ee8Ug-1" href="#NWDCUvTi-1a"><dfn><process coordinates part of text command>=</dfn></a> <b>(<a href="#NWDCUvTi-1Z"><-U</a>)</b>
if (/^[^\W\d_]\d{0,4}\s*[^,\w]/) {
my $Tcoord = get_point($lc);
my ($x,$y,$pSV,$pS)=unpack("d3A*",$PointTable{$Tcoord});
$Px = $x;
$Py = $y;
}
elsif (/[^\W\d_]\d{0,4}\s*,\s*shift|polar/i) {
s/^([^\W\d_]\d{0,4})//i;
my $PointA = $1;
if (exists($PointTable{lc($PointA)})) {
s/\s*//;
if (s/^,//) {
s/\s*//;
if (s/^shift(?=\W)//i) {
<a name="NWCUvTi-Ee8Ug-1-u1" href="#NWDCUvTi-1R"><i><process <tt>shift</tt> case></i></a>
}
elsif (s/^polar(?=\W)//i) {
<a name="NWCUvTi-Ee8Ug-1-u2" href="#NWDCUvTi-1S"><i><process <tt>polar</tt> case></i></a>
}
}
}
else {
PrintErrorMessage("undefined point/var",$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="NWDCUvTi-1b">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="NWCUvTi-RSg70-1" href="#NWDCUvTi-1b"><dfn><process optional part of text command>=</dfn></a> <b>(<a href="#NWDCUvTi-1Z"><-U</a>)</b>
if (s/^(\w{1})\s*//) {
$pos .= $1;
if (memberOf($pos, "l", "r")) {
if (s/^(\w{1})\s*//) {
my $np = $1;
if (memberOf($np, "t", "b", "B")) {
$pos .= $np;
}
else {
if (memberOf($np, "l", "r")) {
PrintErrorMessage("$np can't follow 'l' or 'r'", $lc);
}
else {
PrintErrorMessage("$np is not a valid positioning option", $lc);
}
next LINE;
}
}
}
elsif (memberOf($pos, "t", "b", "B")) {
if (s/^(\w{1})\s*//) {
my $np = $1;
if (memberOf($np, "l", "r")) {
$pos .= $np;
}
else {
if (memberOf($np, "t", "b", "B")) {
PrintErrorMessage("$np can't follow 't', 'b', or 'B'", $lc);
}
else {
PrintErrorMessage("$np is not a valid positioning option", $lc);
}
next LINE;
}
}
}
else {
PrintErrorMessage("$pos is not a valid positioning option", $lc);
next LINE;
}
}
else {
PrintErrorMessage("illegal token in optional part of text command",$lc);
next LINE;
}
</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="NWDCUvTi-1c">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="NWCUvTi-4F0xHm-1" href="#NWDCUvTi-1c"><dfn><process <tt>const</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
do{
s/\s*//;
PrintErrorMessage("no identifier found after token const",$lc)
if $_ !~ s/^([^\W\d_]\d{0,4})//i;
my $Constname = $1;
my $constname = lc($Constname);
if (exists $ConstTable{$constname}) {
PrintErrorMessage("Redefinition of constant $constname",$lc);
}
s/\s*//; #remove leading white space
PrintErrorMessage("did not find expected = sign",$lc)
if $_ !~ s/^[=]//i;
my $val = expr($lc);
$VarTable{$constname} = $val;
$ConstTable{$constname} = 1;
print OUT "%% $Constname = $val\n" if $comments_on;
}while (s/^,//);
chk_comment($lc);
s/\s*//;
if (/^[^%]/) {
PrintWarningMessage("Trailing text is ignored",$lc);
}
</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="NWDCUvTi-1d">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="NWCUvTi-2NFa6I-1" href="#NWDCUvTi-1d"><dfn><process <tt>var</tt> command>=</dfn></a> <b>(<a href="#NWDCUvTi-r"><-U</a>)</b>
do{
s/\s*//;
PrintErrorMessage("no identifier found after token var",$lc)
if $_ !~ s/^([^\W\d_]\d{0,4})//i;
my $Varname = $1;
my $varname = lc($Varname);
if (exists $ConstTable{$varname}) {
PrintErrorMessage("Redefinition of constant $varname",$lc);
}
s/\s*//; #remove leading white space
PrintErrorMessage("did not find expected = sign",$lc)
if $_ !~ s/^[=]//i;
my $val = expr($lc);
$VarTable{$varname} = $val;
print OUT "%% $Varname = $val\n" if $comments_on;
}while (s/^,//);
chk_comment($lc);
s/\s*//;
if (/^[^%]/) {
PrintWarningMessage("Trailing text is ignored",$lc);
}
</pre>
<ul>
<li><a href="#NWDCUvTi-2"><i><*></i></a>: <a href="#NWDCUvTi-2">D1</a>
<li><a href="#NWDCUvTi-4"><i><Check for command line arguments></i></a>: <a href="#NWDCUvTi-2">U1</a>, <a href="#NWDCUvTi-4">D2</a>
<li><a href="#NWDCUvTi-6"><i><Check if .m file exists></i></a>: <a href="#NWDCUvTi-4">U1</a>, <a href="#NWDCUvTi-6">D2</a>
<li><a href="#NWDCUvTi-8"><i><Define global variables></i></a>: <a href="#NWDCUvTi-2">U1</a>, <a href="#NWDCUvTi-8">D2</a>
<li><a href="#NWDCUvTi-1E"><i><generate plot area related commands></i></a>: <a href="#NWDCUvTi-17">U1</a>, <a href="#NWDCUvTi-1E">D2</a>
<li><a href="#NWDCUvTi-1H"><i><generate the rest of the code for the <tt>paper</tt> command></i></a>: <a href="#NWDCUvTi-17">U1</a>, <a href="#NWDCUvTi-1H">D2</a>
<li><a href="#NWDCUvTi-3"><i><package <tt>DummyFH</tt> ></i></a>: <a href="#NWDCUvTi-2">U1</a>, <a href="#NWDCUvTi-3">D2</a>
<li><a href="#NWDCUvTi-u"><i><process <tt>angle</tt> part of command></i></a>: <a href="#NWDCUvTi-t">U1</a>, <a href="#NWDCUvTi-u">D2</a>
<li><a href="#NWDCUvTi-1W"><i><process <tt>ArrowShape</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-1W">D2</a>
<li><a href="#NWDCUvTi-1F"><i><process <tt>axis</tt> part></i></a>: <a href="#NWDCUvTi-17">U1</a>, <a href="#NWDCUvTi-1F">D2</a>
<li><a href="#NWDCUvTi-1O"><i><process <tt>circumcircleCenter</tt> case></i></a>: <a href="#NWDCUvTi-1J">U1</a>, <a href="#NWDCUvTi-1O">D2</a>
<li><a href="#NWDCUvTi-1c"><i><process <tt>const</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-1c">D2</a>
<li><a href="#NWDCUvTi-s"><i><process <tt>dasharray</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-s">D2</a>
<li><a href="#NWDCUvTi-t"><i><process <tt>drawAngleArcOrArrow</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-t">D2</a>
<li><a href="#NWDCUvTi-w"><i><process <tt>drawcircle</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-w">D2</a>
<li><a href="#NWDCUvTi-x"><i><process <tt>drawcircumcircle</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-x">D2</a>
<li><a href="#NWDCUvTi-y"><i><process <tt>drawexcircle</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-y">D2</a>
<li><a href="#NWDCUvTi-z"><i><process <tt>drawincircle</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-z">D2</a>
<li><a href="#NWDCUvTi-10"><i><process <tt>drawPerpendicular</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-10">D2</a>
<li><a href="#NWDCUvTi-11"><i><process <tt>drawpoint</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-11">D2</a>
<li><a href="#NWDCUvTi-12"><i><process <tt>drawRightAngle</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-12">D2</a>
<li><a href="#NWDCUvTi-13"><i><process <tt>drawsquare</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-13">D2</a>
<li><a href="#NWDCUvTi-1Q"><i><process <tt>ExcircleCenter</tt> case></i></a>: <a href="#NWDCUvTi-1J">U1</a>, <a href="#NWDCUvTi-1Q">D2</a>
<li><a href="#NWDCUvTi-1P"><i><process <tt>IncircleCenter</tt> case></i></a>: <a href="#NWDCUvTi-1J">U1</a>, <a href="#NWDCUvTi-1P">D2</a>
<li><a href="#NWDCUvTi-14"><i><process <tt>inputfile*</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-14">D2</a>
<li><a href="#NWDCUvTi-15"><i><process <tt>inputfile</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-15">D2</a>
<li><a href="#NWDCUvTi-1L"><i><process <tt>intersection</tt> case></i></a>: <a href="#NWDCUvTi-1J">U1</a>, <a href="#NWDCUvTi-1L">D2</a>
<li><a href="#NWDCUvTi-16"><i><process <tt>linethickness</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-16">D2</a>
<li><a href="#NWDCUvTi-1M"><i><process <tt>midpoint</tt> case></i></a>: <a href="#NWDCUvTi-1J">U1</a>, <a href="#NWDCUvTi-1M">D2</a>
<li><a href="#NWDCUvTi-17"><i><process <tt>paper</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-17">D2</a>
<li><a href="#NWDCUvTi-1K"><i><process <tt>perpendicular</tt> case></i></a>: <a href="#NWDCUvTi-1J">U1</a>, <a href="#NWDCUvTi-1K">D2</a>
<li><a href="#NWDCUvTi-1I"><i><process <tt>point/point*</tt> commands></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-1I">D2</a>
<li><a href="#NWDCUvTi-1N"><i><process <tt>pointonline</tt> case></i></a>: <a href="#NWDCUvTi-1J">U1</a>, <a href="#NWDCUvTi-1N">D2</a>
<li><a href="#NWDCUvTi-1X"><i><process <tt>PointSymbol</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-1X">D2</a>
<li><a href="#NWDCUvTi-1S"><i><process <tt>polar</tt> case></i></a>: <a href="#NWDCUvTi-1J">U1</a>, <a href="#NWDCUvTi-1S">D2</a>, <a href="#NWDCUvTi-1a">U3</a>
<li><a href="#NWDCUvTi-v"><i><process <tt>radius</tt> part of command></i></a>: <a href="#NWDCUvTi-t">U1</a>, <a href="#NWDCUvTi-v">D2</a>
<li><a href="#NWDCUvTi-1T"><i><process <tt>rotate</tt> case></i></a>: <a href="#NWDCUvTi-1J">U1</a>, <a href="#NWDCUvTi-1T">D2</a>
<li><a href="#NWDCUvTi-1R"><i><process <tt>shift</tt> case></i></a>: <a href="#NWDCUvTi-1J">U1</a>, <a href="#NWDCUvTi-1R">D2</a>, <a href="#NWDCUvTi-1a">U3</a>
<li><a href="#NWDCUvTi-1B"><i><process <tt>showAngle</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-1B">D2</a>
<li><a href="#NWDCUvTi-1C"><i><process <tt>showArea</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-1C">D2</a>
<li><a href="#NWDCUvTi-1D"><i><process <tt>showLength</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-1D">D2</a>
<li><a href="#NWDCUvTi-1Y"><i><process <tt>system</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-1Y">D2</a>
<li><a href="#NWDCUvTi-1Z"><i><process <tt>text</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-1Z">D2</a>
<li><a href="#NWDCUvTi-1G"><i><process <tt>ticks</tt> part></i></a>: <a href="#NWDCUvTi-17">U1</a>, <a href="#NWDCUvTi-1G">D2</a>
<li><a href="#NWDCUvTi-18"><i><process <tt>unit</tt> part></i></a>: <a href="#NWDCUvTi-17">U1</a>, <a href="#NWDCUvTi-18">D2</a>
<li><a href="#NWDCUvTi-1d"><i><process <tt>var</tt> command></i></a>: <a href="#NWDCUvTi-r">U1</a>, <a href="#NWDCUvTi-1d">D2</a>
<li><a href="#NWDCUvTi-1U"><i><process <tt>vector</tt> case></i></a>: <a href="#NWDCUvTi-1J">U1</a>, <a href="#NWDCUvTi-1U">D2</a>
<li><a href="#NWDCUvTi-19"><i><process <tt>xrange</tt> part></i></a>: <a href="#NWDCUvTi-17">U1</a>, <a href="#NWDCUvTi-19">D2</a>
<li><a href="#NWDCUvTi-1A"><i><process <tt>yrange</tt> part></i></a>: <a href="#NWDCUvTi-17">U1</a>, <a href="#NWDCUvTi-1A">D2</a>
<li><a href="#NWDCUvTi-5"><i><Process command line arguments></i></a>: <a href="#NWDCUvTi-4">U1</a>, <a href="#NWDCUvTi-5">D2</a>
<li><a href="#NWDCUvTi-1J"><i><process coordinates></i></a>: <a href="#NWDCUvTi-1I">U1</a>, <a href="#NWDCUvTi-1J">D2</a>
<li><a href="#NWDCUvTi-1a"><i><process coordinates part of text command></i></a>: <a href="#NWDCUvTi-1Z">U1</a>, <a href="#NWDCUvTi-1a">D2</a>
<li><a href="#NWDCUvTi-7"><i><process file></i></a>: <a href="#NWDCUvTi-2">U1</a>, <a href="#NWDCUvTi-7">D2</a>
<li><a href="#NWDCUvTi-r"><i><process input line></i></a>: <a href="#NWDCUvTi-q">U1</a>, <a href="#NWDCUvTi-r">D2</a>
<li><a href="#NWDCUvTi-1b"><i><process optional part of text command></i></a>: <a href="#NWDCUvTi-1Z">U1</a>, <a href="#NWDCUvTi-1b">D2</a>
<li><a href="#NWDCUvTi-1V"><i><process optional point shape part></i></a>: <a href="#NWDCUvTi-1I">U1</a>, <a href="#NWDCUvTi-1V">D2</a>
<li><a href="#NWDCUvTi-W"><i><subroutine <tt>Angle</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-W">D2</a>
<li><a href="#NWDCUvTi-K"><i><subroutine <tt>chk_comma</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-K">D2</a>
<li><a href="#NWDCUvTi-L"><i><subroutine <tt>chk_comment</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-L">D2</a>
<li><a href="#NWDCUvTi-G"><i><subroutine <tt>chk_lcb</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-G">D2</a>
<li><a href="#NWDCUvTi-E"><i><subroutine <tt>chk_lparen</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-E">D2</a>
<li><a href="#NWDCUvTi-I"><i><subroutine <tt>chk_lsb</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-I">D2</a>
<li><a href="#NWDCUvTi-H"><i><subroutine <tt>chk_rcb</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-H">D2</a>
<li><a href="#NWDCUvTi-F"><i><subroutine <tt>chk_rparen</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-F">D2</a>
<li><a href="#NWDCUvTi-J"><i><subroutine <tt>chk_rsb</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-J">D2</a>
<li><a href="#NWDCUvTi-S"><i><subroutine <tt>circumCircleCenter</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-S">D2</a>
<li><a href="#NWDCUvTi-T"><i><subroutine <tt>ComputeDist</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-T">D2</a>
<li><a href="#NWDCUvTi-d"><i><subroutine <tt>drawAngleArc</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-d">D2</a>
<li><a href="#NWDCUvTi-e"><i><subroutine <tt>drawAngleArrow</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-e">D2</a>
<li><a href="#NWDCUvTi-Z"><i><subroutine <tt>drawarrows</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-Z">D2</a>
<li><a href="#NWDCUvTi-b"><i><subroutine <tt>drawCurve</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-b">D2</a>
<li><a href="#NWDCUvTi-Y"><i><subroutine <tt>DrawLineOrArrow</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-Y">D2</a>
<li><a href="#NWDCUvTi-a"><i><subroutine <tt>drawlines</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-a">D2</a>
<li><a href="#NWDCUvTi-c"><i><subroutine <tt>drawpoints</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-c">D2</a>
<li><a href="#NWDCUvTi-m"><i><subroutine <tt>drawsquare</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-m">D2</a>
<li><a href="#NWDCUvTi-X"><i><subroutine <tt>excircle</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-X">D2</a>
<li><a href="#NWDCUvTi-f"><i><subroutine <tt>expr</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-f">D2</a>
<li><a href="#NWDCUvTi-N"><i><subroutine <tt>get_point</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-N">D2</a>
<li><a href="#NWDCUvTi-j"><i><subroutine <tt>get_string</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-j">D2</a>
<li><a href="#NWDCUvTi-V"><i><subroutine <tt>IncircleCenter</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-V">D2</a>
<li><a href="#NWDCUvTi-U"><i><subroutine <tt>intersection4points</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-U">D2</a>
<li><a href="#NWDCUvTi-k"><i><subroutine <tt>is_tainted</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-k">D2</a>
<li><a href="#NWDCUvTi-P"><i><subroutine <tt>Length</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-P">D2</a>
<li><a href="#NWDCUvTi-g"><i><subroutine <tt>memberOf</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-g">D2</a>
<li><a href="#NWDCUvTi-h"><i><subroutine <tt>midpoint</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-h">D2</a>
<li><a href="#NWDCUvTi-A"><i><subroutine <tt>mpp</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-A">D2</a>
<li><a href="#NWDCUvTi-l"><i><subroutine <tt>noOfDigits</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-l">D2</a>
<li><a href="#NWDCUvTi-O"><i><subroutine <tt>perpendicular</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-O">D2</a>
<li><a href="#NWDCUvTi-R"><i><subroutine <tt>pointOnLine</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-R">D2</a>
<li><a href="#NWDCUvTi-M"><i><subroutine <tt>print_headers</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-M">D2</a>
<li><a href="#NWDCUvTi-B"><i><subroutine <tt>PrintErrorMessage</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-B">D2</a>
<li><a href="#NWDCUvTi-D"><i><subroutine <tt>PrintFatalError</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-D">D2</a>
<li><a href="#NWDCUvTi-C"><i><subroutine <tt>PrintWarningMessage</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-C">D2</a>
<li><a href="#NWDCUvTi-q"><i><subroutine <tt>process_input</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-q">D2</a>
<li><a href="#NWDCUvTi-p"><i><subroutine <tt>setLineThickness</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-p">D2</a>
<li><a href="#NWDCUvTi-o"><i><subroutine <tt>sp2X</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-o">D2</a>
<li><a href="#NWDCUvTi-i"><i><subroutine <tt>tand</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-i">D2</a>
<li><a href="#NWDCUvTi-Q"><i><subroutine <tt>triangleArea</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-Q">D2</a>
<li><a href="#NWDCUvTi-n"><i><subroutine <tt>X2sp</tt> ></i></a>: <a href="#NWDCUvTi-9">U1</a>, <a href="#NWDCUvTi-n">D2</a>
<li><a href="#NWDCUvTi-9"><i><subroutine definitions></i></a>: <a href="#NWDCUvTi-2">U1</a>, <a href="#NWDCUvTi-9">D2</a>
</ul>
</body></html>
|