/usr/share/texmf-texlive/scripts/a2ping/a2ping.pl is in texlive-extra-utils 2009-10ubuntu1.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
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 | #! /bin/sh
eval '(exit $?0)' && eval 'PERL_BADLANG=x;export PERL_BADLANG;: \
;exec perl -x -S -- "$0" ${1+"$@"};#'if 0;
eval 'setenv PERL_BADLANG x;exec perl -x -S -- "$0" $argv:q;#'.q+
#!perl -w
package Htex::a2ping; $0=~/(.*)/s;unshift@INC,'.';do($1);die$@if$@;__END__+if !1;
# This Perl script was generated by JustLib2 at Wed Apr 23 09:14:13 2003.
# Don't touch/remove any lines above; http://www.inf.bme.hu/~pts/justlib
#
# This program is free software, licensed under the GNU GPL, >=2.0.
# This software comes with absolutely NO WARRANTY. Use at your own risk!
#
# !! Imp: merge back to a2ping.pa
# !! Ghostcript compute pipe too slow
# $ a2ping.pl -v debrecen-hyph.ps de brecen-hyph.pdf
# a2ping.pl 2.77p, 2004-04-28 -- Written by <pts@fazekas.hu> from April 2003.
# This is free software, GNU GPL >=2.0. There is NO WARRANTY.
# (epstopdf 2.7 Copyright 1998-2001 by Sebastian Rahtz et al.)
# * Strongest BoundingBox comment: %%HiResBoundingBox:
# * Doing --PaperSize unchanged
# * Output filename: debrecen-hyph.pdf
# * Output FileFormat: PDF
# * Ghostscript ps2pdf command: gs -dSAFER
# * Compression: zip
# * Input filename: debrecen-hyph.ps
# * Computing BBox info from non-EPS PS file
# * Ghostscript compute pipe: gs -dSAFER -dWRITESYSTEMDICT -dNOPAUSE -sDEVICE=bbox -sFN=debrecen-hyph.ps /tmp/a2ping_pl-16977-298938572-c.tgs 2>&1
# * Applying BoundingBox from Compute-GS T-: 71 81 539 769
# * Applying HiResBoundingBox from Compute-GS T-H: 71.837998 81.971997 538.235984 768.113977
# * Scanning header for BoundingBox
# * Applying BoundingBox from ADSC T-: 0 0 596 842
# * Final BoundingBox: 0 0 596 842
# * Ghostscript ps2pdf pipe: gs -dSAFER -q -dBATCH -sDEVICE=pdfwrite -sOutputFile =debrecen-hyph.pdf -
# * Done OK, created PDF file debrecen-hyph.pdf (338451 bytes)
#
package just; BEGIN{$INC{'just.pm'}='just.pm'}
BEGIN{ $just::VERSION=2 }
sub end(){1}
sub main(){}
BEGIN{$ INC{'strict.pm'}='strict.pm'} {
package strict;
use just;
# by pts@fazekas.hu at Wed Jan 10 12:42:08 CET 2001
require 5.002;
sub bits {
(grep{'refs'eq$_}@_ && 2)|
(grep{'subs'eq$_}@_ && 0x200)|
(grep{'vars'eq$_}@_ && 0x400)|
($@ || 0x602)
}
sub import { shift; $^H |= bits @_ }
sub unimport { shift; $^H &= ~ bits @_ }
just::end}
BEGIN{$ INC{'integer.pm'}='integer.pm'} {
package integer;
use just;
# by pts@fazekas.hu at Wed Jan 10 12:42:08 CET 2001
sub import { $^H |= 1 }
sub unimport { $^H &= ~1 }
just::end}
BEGIN{$ INC{'Pts/string.pm'}='Pts/string.pm'} {
package Pts::string;
# by pts@fazekas.hu at Sat Dec 21 21:32:18 CET 2002
use just;
use integer;
use strict;
#** @param $_[0] a string
#** @param $_[1] index of first bit to return. Bit 128 of byte 0 is index 0.
#** @param $_[2] number of bits to return (<=32)
#** @return an integer (negative on overflow), bit at $_[1] is its MSB
sub get_bits_msb($$$) {
# assume: use integer;
my $loop=$_[1];
my $count=$_[2];
my $ret=0;
($ret+=$ret+(1&(vec($_[0],$loop>>3,8)>>(7-($loop&7)))), $loop++) while $count--!=0;
$ret
}
#** @param $_[0] a string
#** @return value if $_[0] represents a floating point numeric constant
#** in the C language (without the LU etc. modifiers) -- or undef. Returns
#** undef for integer constants
sub c_floatval($) {
my $S=$_[0];
no integer; # very important; has local scope
return 0.0+$S if $S=~/\A[+-]?(?:[0-9]*\.[0-9]+|[0-9]+\.])(?:[eE][+-]?[0-9]+)?\Z(?!\n)/;
undef
}
#** @param $_[0] a string
#** @return value if $_[0] represents a floating point or integer numeric
#** constant in the C language (without the LU etc. modifiers) -- or undef
sub c_numval($) {
my $S=$_[0];
no integer; # very important; has local scope
return 0+$S if $S=~/\A[+-]?(?:[0-9]*\.[0-9]+(?:[eE][+-]?[0-9]+)?|[0-9]+\.?)\Z(?!\n)/;
undef
}
#** @param $_[0] a string
#** @return the integer value of $_[0] in C -- or undef
sub c_intval($) {
my $S=$_[0];
my $neg=1;
$neg=-1 if $S=~s@\A([+-])@@ and '-'eq$1;
return $neg*hex $1 if $S=~/\A0[xX]([0-9a-fA-F]+)\Z(?!\n)/;
return $neg*oct $1 if $S=~/\A0([0-7]+)\Z(?!\n)/;
return $neg*$1 if $S=~/\A([0-9]+)\Z(?!\n)/;
undef
}
sub import {
no strict 'refs';
my $package = (caller())[0];
shift; # my package
for my $p (@_ ? @_ : qw{get_bits_msb c_floatval c_numval c_intval}) { *{$package."::$p"}=\&{$p} }
}
just::end}
BEGIN{$ INC{'Htex/dimen.pm'}='Htex/dimen.pm'} {
package Htex::dimen;
# by pts@fazekas.hu at Sat Dec 21 21:26:15 CET 2002
use just;
use integer;
use strict;
use Pts::string qw(c_numval);
my %bp_mul;
{ no integer; %bp_mul=(
'bp'=>1, # 1 bp = 1 bp (big point)
'in'=>72, # 1 in = 72 bp (inch)
'pt'=>72/72.27, # 1 pt = 72/72.27 bp (point)
'pc'=>12*72/72.27, # 1 pc = 12*72/72.27 bp (pica)
'dd'=>1238/1157*72/72.27, # 1 dd = 1238/1157*72/72.27 bp (didot point) [about 1.06601110141206 bp]
'cc'=>12*1238/1157*72/72.27, # 1 cc = 12*1238/1157*72/72.27 bp (cicero)
'sp'=>72/72.27/65536, # 1 sp = 72/72.27/65536 bp (scaled point)
'cm'=>72/2.54, # 1 cm = 72/2.54 bp (centimeter)
'mm'=>7.2/2.54, # 1 mm = 7.2/2.54 bp (millimeter)
) }
#** @param $_[0] a (real or integer) number, optionally postfixed by a
#** TeX dimension specifier (default=bp)
#** @return the number in bp, or undef
sub dimen2bp($) {
no integer;
my $S=$_[0];
my $mul;
$mul=$bp_mul{$1} if $S=~s/\s*([a-z][a-z0-9]+)\Z(?!\n)// and exists $bp_mul{$1};
my $val=c_numval($S);
$val*=$mul if defined $val and defined $mul;
$val
}
just::end}
BEGIN{$ INC{'Htex/papers.pm'}='Htex/papers.pm'} {
package Htex::papers;
# contains paper size information
# by pts@fazekas.hu at Sun Dec 22 00:30:58 CET 2002
use just;
use integer;
use strict;
use Htex::dimen;
my @papers=(
#
# paper.txt
# by pts@fazekas.hu at Tue Jan 16 18:21:59 CET 2001
# by pts@fazekas.hu at Tue Jan 16 19:13:16 CET 2001
#
# Examined: dvips, gs, libpaperg
#
# all units are measured in Big Points (bp)
# 72 bp == 1 in
# 2.54 cm == 1 in
#
# papername width height
qw{Comm10 297 684},
qw{Monarch 279 540},
qw{halfexecutive 378 522},
qw{Legal 612 1008},
qw{Statement 396 612},
qw{Tabloid 792 1224},
qw{Ledger 1224 792},
qw{Folio 612 936},
qw{Quarto 610 780},
qw{7x9 504 648},
qw{9x11 648 792},
qw{9x12 648 864},
qw{10x13 720 936},
qw{10x14 720 1008},
qw{Executive 540 720},
qw{ISOB0 2835 4008},
qw{ISOB1 2004 2835},
qw{ISOB2 1417 2004},
qw{ISOB3 1001 1417},
qw{ISOB4 709 1001},
qw{ISOB5 499 709},
qw{ISOB6 354 499},
qw{ISOB7 249 354},
qw{ISOB8 176 249},
qw{ISOB9 125 176},
qw{ISOB10 88 125},
qw{jisb0 2916 4128},
qw{jisb1 2064 2916},
qw{jisb2 1458 2064},
qw{jisb3 1032 1458},
qw{jisb4 729 1032},
qw{jisb5 516 729},
qw{jisb6 363 516},
qw{C7 230 323},
qw{DL 312 624},
qw{a3 842 1190}, # defined by Adobe
qw{a4 595 842}, # defined by Adobe; must precede a4small
# a4small should be a4 with an ImagingBBox of [25 25 570 817].},
qw{a4small 595 842},
qw{letter 612 792}, # must precede lettersmall
# lettersmall should be letter with an ImagingBBox of [25 25 587 767].
qw{lettersmall 612 792},
# note should be letter (or some other size) with the ImagingBBox
# shrunk by 25 units on all 4 sides.
qw{note 612 792},
qw{letterLand 792 612},
# End of Adobe-defined page sizes
qw{a0 2380 3368},
qw{a1 1684 2380},
qw{a2 1190 1684},
qw{a5 421 595},
qw{a6 297 421},
qw{a7 210 297},
qw{a8 148 210},
qw{a9 105 148},
qw{a10 74 105},
qw{b0 2836 4008},
qw{b1 2004 2836},
qw{b2 1418 2004},
qw{b3 1002 1418},
qw{b4 709 1002},
qw{b5 501 709}, # defined by Adobe
qw{a0Land 3368 2380},
qw{a1Land 2380 1684},
qw{a2Land 1684 1190},
qw{a3Land 1190 842},
qw{a4Land 842 595},
qw{a5Land 595 421},
qw{a6Land 421 297},
qw{a7Land 297 210},
qw{a8Land 210 148},
qw{a9Land 148 105},
qw{a10Land 105 74},
qw{b0Land 4008 2836},
qw{b1Land 2836 2004},
qw{b2Land 2004 1418},
qw{b3Land 1418 1002},
qw{b4Land 1002 709},
qw{b5Land 709 501},
qw{c0 2600 3677},
qw{c1 1837 2600},
qw{c2 1298 1837},
qw{c3 918 1298},
qw{c4 649 918},
qw{c5 459 649},
qw{c6 323 459},
# vvv U.S. CAD standard paper sizes
qw{archE 2592 3456},
qw{archD 1728 2592},
qw{archC 1296 1728},
qw{archB 864 1296},
qw{archA 648 864},
qw{flsa 612 936}, # U.S. foolscap
qw{flse 612 936}, # European foolscap
qw{halfletter 396 612},
qw{csheet 1224 1584}, # ANSI C 17x22
qw{dsheet 1584 2448}, # ANSI D 22x34
qw{esheet 2448 3168}, # ANSI E 34x44
qw{17x22 1224 1584}, # ANSI C 17x22
qw{22x34 1584 2448}, # ANSI D 22x34
qw{34x44 2448 3168}, # ANSI E 34x44
);
#** Converts a numeric paper size to a well-defined paper name. Tolerance is
#** 8.5bp
#** @param $_[0] width, in bp
#** @param $_[1] height, in bp
#** @return () or ("papername", ret.paper.width.bp, ret.paper.height.bp)
sub valid_bp($$;$$) {
no integer;
my ($W1,$H1)=(defined$_[2]?$_[2]:0,defined$_[3]?$_[3]:0);
my ($WW,$HH)=(Htex::dimen::dimen2bp($_[0])-$W1, Htex::dimen::dimen2bp($_[1])-$H1);
# Dat: 1mm == 720/254bp; 3mm =~ 8.5bp
no integer;
for (my $I=0; $I<@papers; $I+=3) {
return @papers[$I,$I+1,$I+2] if abs($papers[$I+1]-$WW)<=8.5 and abs($papers[$I+2]-$HH)<=8.5;
}
()
}
#** @param $_[0] (width width_unit "," height height_unit)
#** @return () or ("papername", width.bp, height.bp)
sub valid($) { # valid_papersize
my $S=lc$_[0];
$S=~/^\s*(\d+(\.\d+)?)\s*([a-z][a-z0-9]+)\s*,\s*(\d+(\.\d+)?)\s*([a-z][a-z0-9]+)\s*\Z(?!\n)/ ?
valid_bp("$1$3","$4$6") : ();
}
#** @param $_[0] (width width_unit? ("," || "x") height height_unit?) || (papername)
#** @return () or ("papername"?, width.bp, height.bp)
sub any($) {
my $S=lc$_[0];
if ($S=~/\A[a-z]\w+\Z(?!\n)/) {
for (my $I=0; $I<@papers; $I+=3) {
return @papers[$I,$I+1,$I+2] if lc($papers[$I]) eq $S;
}
}
return () if $S!~/^\s*(\d+(\.\d+)?)\s*((?:[a-z][a-z0-9]+)?)\s*[,xX]\s*(\d+(\.\d+)?)\s*((?:[a-z][a-z0-9]+)?)\s*\Z(?!\n)/;
# ^^^ Dat: [xX] is xdvi-style, [,] is dvips-style spec
my($w,$h)=($1.$3, $4.$6);
my @L=valid_bp($w,$h);
@L ? @L : (undef,Htex::dimen::dimen2bp($w),Htex::dimen::dimen2bp($h))
}
just::end}
BEGIN{$ INC{'Htex/a2ping.pm'}='Htex/a2ping.pm'}
package Htex::a2ping;
# a2ping.pl -- convert between PS, EPS and PDF and other page description formats
# by pts@fazekas.hu et al. at Wed Apr 16 14:54:13 CEST 2003
# a2ping.pa created at Sun Apr 20 22:25:47 2003
#
# This file contains perldoc(1) documentation. Search for `=head1'.
# See revision history at end of this file.
#
use just +1; # a JustLib application
use strict;
use integer;
use Htex::papers;
BEGIN { $Htex::a2ping::VERSION="2.77p" }
# Imp: option to ignore `%%Orientation: Portrait', which gs respects and rotates by 90 degrees if necessary
# Imp: gs(704?!) sometimes finds too small bbox, see Univers.eps
# Imp: respect bbox in METAPOST %! (not EPS), don't use Compute-GS T-
# Imp: -sPDFPassword=...
# Imp: `a2ping.pl -v jf.eps pdf1: t.pdf' PDF1: must be forced to have --below
# Imp: option to `clip' an EPS to the specified bbox -- does file size decrease?
# Imp: fix bug a2ping -v ~/a2ping_bug.ps a2ping_bug.pdf; running type1fix on
# all fonts with dff.pl has fixed the problem
# Imp: post-process PNG etc. written by sam2p
# Imp: better help and docs
# Imp: respect full /MediaBox for a PDF -> EPS|PDF1 conversion
# Imp: --ll x,y command line option
# Imp: Htex/a2ping.pa -v ../image/tuzv.ps t.pdf (1st and second page different)
# Imp: also save+restore /pdfmark ??
# Imp: fix /MediaBox an all PDF pages if !$ll_zero
# Imp: PDF -> PDF1 conversion with gs -sDEVICE=pdfwrite
# Imp: direct PDF to PCL5 conversion with gs
# Imp: remove %%BeginDefaults | %%PageMedia: plain | %%EndDefaults (pdftops(1))
# Imp: fix completely bogus margin and papersize handling:
# ../justlib2/Htex/a2ping.pa --duplex=force-short -v -p:a3 -r force-unknown tuzv.ps t.pdf
# Imp: careful distinction between PDF and PDF1
# Imp: psnup support (-1 -2 -3 -4 ...)
# Imp: idempotent PS -> PS, add other header
# Imp: use convert(1) etc.
# Imp: possibly disable compute-pipe
# Imp: $header_remove_p ??
# Imp: --leftright option instead of --below
# Imp: pdfboxes.pl, get offset from gs
# Imp: detect error messages from GS, abort...
# Imp: use all pdftops + gs + acroread
# Imp: possibly accept /PageSize from %%DocumentMedia
# Imp: /DocumentMedia seems to screw up sub-pt placement in gv(1)
#
# Dat: example: a2ping.pl --extra=-c:ijg:50 -r86 nn1.eps nn1.jpg
# Dat: calling ``showpage'' is not required for -sDEVICE=pdfwrite with gs 6.50,
# but -sDEVICE=pgmraw depends on it
# Dat: the functionality of pdfboxes.pl cannot be provided here with a shorter
# implementation, because gs always outputs the content stream of the PDF
# objects first
# Dat: pdftops -eps writes negative bbox correctly
# Dat: markedEPS: include pdfmarks
# Dat: gs 7.04 gdevdjet.[ch], gdevdljm.[ch]
# Dat: to be undeffed in setpagedevice: /.MarginsHWResolution /PageSize
# /ImagingBBox /HWResolution /HWSize /.MediaSize (we undef all)
### program identification
my $program = "a2ping.pl";
my $filedate="2006-11-15"; # my $filedate="2001/03/05";
my $copyright = "Written by <pts\@fazekas.hu> from April 2003.
This is free software, GNU GPL >=2.0. There is NO WARRANTY.
(epstopdf 2.7 Copyright 1998-2001 by Sebastian Rahtz et al.)\n";
# "Contains modifications by pts\@fazekas.hu";
my $title = "$program $Htex::a2ping::VERSION, $filedate -- $copyright\n";
### ghostscript command name
my($quote,$GS)=("'","gs");
($quote,$GS) = ("\"","gswin32c") if $^O eq 'MSWin32' or $^O =~ /cygwin/i;
# --- help functions
sub fnq($) {
my $fn=$_[0];
return $fn if $fn!~y@-a-zA-Z0-9/.+_@@c;
$fn=~s@'@\\'@g if $quote eq "'";
$quote.$fn.$quote
}
sub debug {
print STDERR "* @_\n" if $::opt_verbose;
}
sub warning {
print STDERR "$0: warning: @_\n";
}
sub error {
my $s=$title; $title="";
die "$s$0: @_\n";
}
# unlink temporary files?
my $tmpunlink_p=1;
my $tmpsig=1;
my %tmpfiles;
my $tmpdir=exists $ENV{TMPDIR} ? $ENV{TMPDIR} : '/tmp';
$tmpdir="." if (!-d $tmpdir or !-w $tmpdir) and -w '.';
sub cleanup() {
unlink keys %tmpfiles;
exit 125;
}
END { unlink keys %tmpfiles; }
sub temp_unlink($) {
if (defined $_[0] and exists $tmpfiles{$_[0]}) {
unlink $_[0] if $tmpunlink_p;
delete $tmpfiles{$_[0]};
}
}
sub temp_prefix() {
my $prog0=$program;
$prog0=~y@a-zA-Z0-9@_@c;
if ($tmpsig) {
$tmpsig=0;
$SIG{INT}=$SIG{TERM}=$SIG{HUP}=$SIG{QUIT}=\&cleanup;
}
return "$tmpdir/$prog0-$$-".int(rand(1<<30))."-"; # 30: nonnegative
}
#** @return arg rounded down to int
sub myfloor($) {
# Dat: Perl int() rounds towards zero
no integer;
$_[0]==int($_[0]) ? $_[0] : $_[0] < 0 ? -int(1-$_[0]) : int($_[0])
}
#** @return arg rounded up to int
sub myceil($) {
no integer; #### BUGFIX at Wed Nov 15 17:23:29 CET 2006
$_[0]==int($_[0]) ? $_[0] : 1+ ($_[0] < 0 ? -int(-$_[0]) : int($_[0]));
}
just::main;
# ---
sub FL_PAGE1_STOP(){1} # is file format single-page?
sub FL_SET_PAGESIZE_OK(){2}
sub FL_PDFMARK(){4}
sub FL_NEED_SHOWPAGE(){8} # does gs -sDEVICE=... need showpage?
sub FL_SAMPLED(){16} # is it a sampled (raster, pixel-based)
sub FL_ANY_ORIGIN_OK(){32} # (llx,lly) may be anything, not just (0,0)
sub FL_HAS_ANTIALIAS(){64}
sub FL_VIA_SAM2P(){128} # sam2p(1) should convert PNM to such a format
sub FL_OK_SAM2P(){256} # sam2p(1) can convert PNM to such a format
my %fmts=( # Name=>[flags]
'EPS'=>[FL_PAGE1_STOP],
'markedEPS'=>[FL_PAGE1_STOP|FL_PDFMARK], # Imp: should we have FL_SET_PAGESIZE_OK?
'PDF1'=>[FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_PDFMARK],
'PDF'=>[FL_SET_PAGESIZE_OK|FL_PDFMARK|FL_ANY_ORIGIN_OK],
'PS'=>[FL_SET_PAGESIZE_OK|FL_ANY_ORIGIN_OK],
'markedPS'=>[FL_SET_PAGESIZE_OK|FL_PDFMARK|FL_ANY_ORIGIN_OK],
'PCL5'=>[FL_SET_PAGESIZE_OK|FL_ANY_ORIGIN_OK],
# ^^^ Dat: no FL_HAS_ANTIALIAS -- would need lj5gray, which is loonger
# ^^^ Dat: no FL_SAMPLED, because cannot set resolution
'PBM'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_OK_SAM2P], # Dat FL_HAS_ANTIALIAS produces obscure image
'PGM'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_OK_SAM2P],
'PPM'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_OK_SAM2P],
# Now come the FileFormats supported via sam2p
'PNG'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P],
'XWD'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P],
'BMP'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P],
'TIFF'=>[FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P],
'JPEG'=>[FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P],
'GIF'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P], # Imp: disable antialias for few colors?
'XPM'=> [FL_PAGE1_STOP|FL_SET_PAGESIZE_OK|FL_NEED_SHOWPAGE|FL_SAMPLED|FL_HAS_ANTIALIAS|FL_VIA_SAM2P], # Imp: disable antialias for few colors?
);
my %fmt_aliases=qw(MARKEDPS markedPS MARKEDEPS markedEPS PCL PCL5
UNMARKEDPS PS UNMARKEDEPS EPS EPDF PDF1 MEPS markedEPS);
# Dat: .ps will be unmarked PS
# Imp: sometimes markedEPS for .eps?
my %fmt_exts=qw(eps EPS epsi EPS epsf EPS eps2 EPS ps PS ps2 PS
pcl PCL5 pcl5 PCL5 pbm PBM pgm PGM pnm PPM ppm PPM pdf PDF png PNG
xwd XWD bmp BMP rle BMP tif TIFF tiff TIFF jpg JPEG jpe JPEG
jpg JPEG gif GIF xpm XPM);
### usage
# vvv deprecated options:
# --outfile=<file>: write result to <file>
# --debug: verbose debug informations (default: $bool[$::opt_verbose])
# --(no)filter: d. read standard input (default: false)
# --(no)gs d. run Ghostscript to create PDF
my $usage=
"${title}Usage: $program [options] <inputfile> [[<outformat>:] <outputfile>]
Run with --doc to read documentation as a UNIX man(1) page.
Options: --help print this help message
--(no)compress use compression (def: best)
--(no)hires scan HiResBoundingBox (def: yes)
--(no)exact scan ExactBoundingBox (def: no)
--(no)verbose verbose debug informations (def: no)
--(no)below allow below+left_from baseline (def: no)
--(no)tmpunlink unlink temporary files (def: yes)
--(no)antialias render shades at outlines (def: scale3no) (=scale3yes =no =yes)
--(no)lossy allow lossy image filters (EPS->PDF) (def: yes)
--(no)keepoldmediabox keep only old, [0 0]-based MediaBox in PDF (def: no)
--gs-cmd= path to Ghostscript (def: gs or gswin32c)
--gs-ccmd= path to Ghostscript, 4 bbox calc (def: gs or gswin32c)
--gsextra= extra arg to gs
--extra= extra arg to external prg (i.e pdftops)
--bboxfrom= adsc|compute-gs|pagesize (def: guess)
--papersize= unchanged|force-unknown|600bpx5cm (def: default) (bp)
--threshold= min color for 1 in 8->1 bit conv (def: 128)
Possible input formats: PS EPS PDF JPEG GIF TIFF PNG PNM PCX BMP LBM XPM TGA
Possible output formats: @{[sort keys %fmts]}
Examples for producing 'test.pdf':
* $program test.eps
* produce postscript | $program -v - test.pdf
Example: look for HiResBoundingBox and produce corrected PostScript:
* $program -d --nogs -hires test.ps>testcorr.ps
";
sub errorUsage {
die "$usage\U!\E!\U!\E Error: @_\n";
}
# --- @ARGV parsing
### default option values
my @extra=();
my @gsextra=();
#** Output file format (string)
my $FileFormat=undef;
$::opt_help=0;
$::opt_verbose=0;
my %vals_compression=map{$_=>1} qw(best none flate zip);
$::opt_compression='best';
#** Prefer %%HiResBoundingBox over %%BoundingBox, but emit both
$::opt_hires=1;
$::opt_exact=0;
# $::opt_filter=0; # deprecated
# $::opt_outputfile=undef; # deprecated
$::opt_below=undef;
$::opt_keepoldmediabox=0;
$::opt_lossy=1;
$::opt_antialias=undef; # render shades at path outlines for better readability
$::opt_gs_cmd=undef;
$::opt_extra="";
$::opt_duplex="default";
$::opt_threshold=128;
my %vals_antialias=map{$_=>1} qw(no yes scale3yes scale3no);
my %vals_duplex=map{$_=>1} qw(force-unknown force-simplex force-long
force-short unchanged default-simplex default-long default-short);
# ^^^ short: duplex printing, will bind short edge of paper (ideal for
# duplexing psnup -2)
#** Dat: force-unknown is forced by /setpagedevice/load def
$::opt_resolution="default"; # unchanged force-unknown 600x600 (DPI)
$::opt_papersize="default"; # unchanged force-unknown 600bpx600cm (bp)
#** --bboxfrom=adsc sets %%BoundingBox from the 1st page if no ADSC comment in non-EPS ps
my %vals_bboxfrom=map{$_=>1} qw(adsc compute-gs guess pagesize);
$::opt_bboxfrom="guess";
my $InputFilename;
my $OutputFilename;
sub is_page1_stop() { 0!=($fmts{$FileFormat}[0]&FL_PAGE1_STOP) }
sub is_set_pagesize_ok() { 0!=($fmts{$FileFormat}[0]&FL_SET_PAGESIZE_OK) }
sub is_pdfmark() { 0!=($fmts{$FileFormat}[0]&FL_PDFMARK) }
sub is_need_showpage() { 0!=($fmts{$FileFormat}[0]&FL_NEED_SHOWPAGE) }
sub is_sampled() { 0!=($fmts{$FileFormat}[0]&FL_SAMPLED) }
sub is_any_origin_ok() { 0!=($fmts{$FileFormat}[0]&FL_ANY_ORIGIN_OK) }
sub is_has_antialias() { 0!=($fmts{$FileFormat}[0]&FL_HAS_ANTIALIAS) }
sub is_via_sam2p() { 0!=($fmts{$FileFormat}[0]&FL_VIA_SAM2P) }
sub is_ok_sam2p() { 0!=($fmts{$FileFormat}[0]&FL_OK_SAM2P) }
# ---
sub show_doc() {
# run `pod2man __FILE__ | man -l -', same as `perldoc __FILE', but perldoc(1)
# is missing from some Debian sites that have pod2man.
my @path=split/:+/,$ENV{PATH};
my $pod2man_='pod2man --center="a2ping: advanced PS, PDF, EPS converter" ';
$pod2man_=q~perl -ne 'if($a>1){print}elsif($a&&/^=head1/){$a=2}else{$a=!/\S/}' ~
if !grep { -x "$_/pod2man" } @path;
my $pager='';
for my $pageri ((defined $ENV{PAGER} ? $ENV{PAGER}: ''),'less','most','more','view - ','vim -R - ','vi - ','joe -rdonly -asis -','pager') {
next if $pageri!~/^(\S+)/;
my $pagert="/$1";
if (grep { -x $_.$pagert } @path) { $pager=$pageri; last }
}
$pager=q~perl -pe 's@\010_@@g;s@.\010@@gs' | ~.$pager
if substr($pager,-2)eq' ' or $pager=~/\A(?:view|vim?|joe|emacs|mcedit|nano|nano-tiny|ae)\b/;
# ^^^ Dat: these cannot handle underline/bold backspace directly
$ENV{PAGER}=$pager;
my $man='';
if (substr($pod2man_,0,5)ne 'perl ') {
$man=' | man -l -'; # calls $PAGER
if ((!grep { -x "$_/man" } @path) or qx(man -l 2>&1)=~/\binvalid option\b/) {
$man=' | nroff -Tlatin1 -mandoc'; # Linux, no need for eqn(1), tbl(1) etc.
if (!grep { -x "$_/nroff" } @path) { $man='' } # just write it
}
}
my $cmd=$pod2man_.fnq(__FILE__).$man;
if ($cmd!~/[|] man -l -\Z(?!\n)/) {
if (!length $pager) {
die unless open PIPE, "$cmd|";
print while sysread PIPE, $_, 4096;
die "$0: error showing doc\n" unless close PIPE;
exit 0;
}
$cmd.=' | $PAGER';
}
##die $cmd;
$ENV{LESS}="" if !defined $ENV{LESS};
$ENV{LESS}="$ENV{LESS}R"; # show ANSI escapes
die "$0: exec ($cmd) failed: $!\n" if !exec $cmd;
}
die $usage if !@ARGV or (1==@ARGV and $ARGV[0] eq '-h' or $ARGV[0] eq '--help'
or $ARGV[0] eq 'help');
show_doc() if 1==@ARGV and $ARGV[0] eq '--doc' or $ARGV[0] eq 'doc';
{ my($I,$optname,$optval);
my %optmap=qw(o outputfile outfile outputfile r resolution h help
f filter d verbose v verbose debug verbose p papersize
c compression compress compression h hires b below e exact x extra);
#** Options that have a mandatory argument
my %argopt1=qw(outputfile 1 duplex 1 resolution 1 extra 1 compression 1 gs-cmd 1
gs-ccmd 1
papersize 1 paper 1 bboxfrom 1 antialias 1 gsextra 1 threshold 1); # 1 arg
my %argnone=qw(help 1 verbose 1 noverbose 1 nocompress 1 noantialias 1); # 0 arg
my %argmaybe=qw(); # 0 or 1 arg
my %argbool=qw(hires 1 exact 1 below 1 gs 1 filter 1 tmpunlink 1
approx 1 lossy 1 keepoldmediabox 1); # boolean arg
# Dat: --noverbose --nocompress
my $opts_ok=1;
for ($I=0; $I<@ARGV; $I++) {
if ($ARGV[$I]eq '--') {
$OutputFilename=$InputFilename if defined $InputFilename and
!defined $OutputFilename and $opts_ok;
$opts_ok=0;
} elsif ($opts_ok and $ARGV[$I]=~/\A--+(\w[\w-]*)(?:[:=](.*))?\Z(?!\n)/s) {
$optname=lc$1; $optval=$2;
} elsif ($opts_ok and $ARGV[$I]=~/\A-(\w)(.*)\Z(?!\n)/s) {
$optname=lc$1;
if (length($2)==0) { $optval=undef }
elsif (index(":=",substr($2,0,1))>=0) { $optval=substr($2,1) }
else { $optval=$2 }
} elsif ($opts_ok and !defined $FileFormat and defined $InputFilename and $ARGV[$I]=~s@\A(\w+):@@) {
my $fmtag=uc$1;
# errorUsage "invalid FileFormat tag: $fmtag" if $fmtag!~s@:\Z(?!\n)@@;
if (exists $fmts{$fmtag}) { $FileFormat=$fmtag }
elsif (exists $fmt_aliases{$fmtag}) { $FileFormat=$fmt_aliases{$fmtag} }
else { errorUsage "Unknown FileFormat tag: $fmtag" }
if (0!=length($ARGV[$I])) {
errorUsage "Multiple output filenames" if defined $OutputFilename;
$OutputFilename=$ARGV[$I];
}
next
} elsif (!defined $InputFilename) { $InputFilename=$ARGV[$I]; next }
elsif (!defined $OutputFilename) { $OutputFilename=$ARGV[$I]; next }
else { errorUsage "Too many arguments (multiple input/output files?)" }
$optname=$optmap{$optname} if exists $optmap{$optname};
if (exists $argopt1{$optname} and !defined $optval) {
errorUsage "Argument expected for --$optname" if $I==@ARGV;
$optval=$ARGV[++$I];
}
# Dat: $optname and $optval are now correct
errorUsage "No argument expected for --$optname=$optval" if exists $argnone{$optname} and defined $optval;
if (substr($optname,0,2)eq"no" and exists $argbool{substr($optname,2)}) {
$optname=substr($optname,2);
errorUsage "No argument expected for no --no$optname=$optval" if defined $optval;
$optval="no";
}
if (exists $argbool{$optname}) {
# same as sam2p GenBuffer::parseBool, understands:
# on true yes ja igen oui enable 1 true vrai? right sure allowed
# off false no nein nem non disable 0 false faux? wrong nope disallowed
$optval=(!defined($optval) or 0==length($optval)
or $optval=~/\Ao[nu]/i or $optval!~/\A[fndw0]/i) ? 1 : 0;
} elsif (!exists $argopt1{$optname} and !exists $argnone{$optname} and !exists $argmaybe{$optname}) {
errorUsage "Unknown option --$optname, see --help"
}
# vvv application-specific
if ($optname eq "help") { die $usage }
elsif ($optname eq "help") { show_doc() }
elsif ($optname eq "noverbose") { $::opt_verbose=0 }
elsif ($optname eq "nocompress") { $::opt_compression='none' }
elsif ($optname eq "verbose") { $::opt_verbose++ }
elsif ($optname eq "hires") { $::opt_hires =$optval }
elsif ($optname eq "exact") { $::opt_exact =$optval }
elsif ($optname eq "below") { $::opt_below =$optval }
elsif ($optname eq "keepoldmediabox") { $::opt_keepoldmediabox=$optval }
elsif ($optname eq "lossy") { $::opt_lossy =$optval }
elsif ($optname eq "approx") { $::opt_approx=$optval }
elsif ($optname eq "threshold") { $::opt_threshold=$optval+0 } # Imp: accept only int 0..256
elsif ($optname eq "filter") {
# errorUsage "Multiple input filenames" if defined $InputFilename;
# $InputFilename='-';
errorUsage "Multiple output filenames" if defined $OutputFilename;
$OutputFilename='-';
} elsif ($optname eq "tmpunlink") { $tmpunlink_p=$optval }
elsif ($optname eq "gs") { $FileFormat=$optval ? 'PDF1' : 'markedEPS' }
elsif ($optname eq "compression") {
errorUsage "--$optname expects one of: @{[keys%vals_compression]}" if !exists $vals_compression{$optval};
$::opt_compression=$optval;
$::opt_compression='zip' if $::opt_compression eq 'flate';
} elsif ($optname eq "outputfile") {
errorUsage "Multiple output filenames" if defined $OutputFilename;
$OutputFilename=$optval;
} elsif ($optname eq "gs-cmd") {
errorUsage "Multiple --gs-cmd" if defined $::opt_gs_cmd;
$::opt_gs_cmd=$optval;
} elsif ($optname eq "gs-ccmd") {
errorUsage "Multiple --gs-ccmd" if defined $::opt_gs_ccmd;
$::opt_gs_ccmd=$optval;
} elsif ($optname eq "extra") { push @extra, $optval }
elsif ($optname eq "gsextra") { push @gsextra, $optval }
elsif ($optname eq "duplex") {
errorUsage "--$optname expects one of: @{[keys%vals_duplex]}" if !exists $vals_duplex{$optval};
$::opt_duplex=$optval
} elsif ($optname eq "bboxfrom") {
errorUsage "--$optname expects one of: @{[keys%vals_bboxfrom]}" if !exists $vals_bboxfrom{$optval};
$::opt_bboxfrom=$optval
} elsif ($optname eq "noantialias") {
$::opt_antialias='no'
} elsif ($optname eq "antialias") {
errorUsage "--$optname expects one of: @{[keys%vals_antialias]}" if !exists $vals_antialias{$optval};
$::opt_antialias=$optval
} elsif ($optname eq "resolution") {
if ($optval eq "unchanged" or $optval eq "force-unknown") { }
elsif ($optval=~/^(\d+(?:[.]\d+)?)\Z(?!\n)/) { $optval="$1x$1" }
elsif ($optval=~/^(\d+(?:[.]\d+)?[x,]\d+(?:[.]\d+)?)\Z(?!\n)/) { }
else { errorUsage "--Resultion expects unchanged | force-unknown | DPI | XDPIxYDPI" }
$::opt_resolution=$optval
} elsif ($optname eq "papersize" or $optname eq"paper") {
if ($optval eq "unchanged" or $optval eq "force-unknown") { $::opt_papersize=$optval }
else {
my @L=Htex::papers::any($optval);
errorUsage "invalid or unknown for --papersize" if !@L;
$::opt_papersize="$L[1],$L[2]" # width, height
}
} else { die } # unreachable
} # NEXT opt
errorUsage "Too many arguments (multiple input/output files?)" if $I!=@ARGV;
# splice @ARGV, 0, $I;
}
$GS=$::opt_gs_cmd if defined $::opt_gs_cmd;
my $CGS=$GS;
$CGS=$::opt_gs_ccmd if defined $::opt_gs_ccmd;
# vvv SUXX: (r) file doesn't work with gs 8.5x -DSAFER
#$GS.= " -dSAFER"; # -dWRITESYSTEMDICT
#$CGS.=" -dSAFER"; # -dWRITESYSTEMDICT
### get input and output filename
if (!defined $InputFilename and defined $OutputFilename) { # --filter
$InputFilename='-';
} elsif (!defined $InputFilename) {
errorUsage "Input filename missing"
} elsif (!defined $OutputFilename) {
$FileFormat='PDF1' if !defined $FileFormat;
if ($FileFormat eq 'PDF1' or $FileFormat eq 'PDF') {
if (($OutputFilename=$InputFilename) ne '-') {
$OutputFilename =~ s/\.[^\.]*$//;
$OutputFilename .= ".pdf";
}
} else {
$OutputFilename = '-'; # standard output
}
}
print STDERR $title if $::opt_verbose;
$title="";
# Dat: no more @ARGV
errorUsage "please specify <outformat>" if
!defined $FileFormat and ($OutputFilename!~m@[.]([^/.]+)\Z(?!\n)@ or
!defined($FileFormat=$fmt_exts{lc$1}));
$::opt_below=is_any_origin_ok() if !defined $::opt_below;
error "--below=1 invalid for FileFormat $FileFormat" if $::opt_below and
!is_any_origin_ok() and $FileFormat ne 'PDF1' and $FileFormat ne 'EPS' and
$FileFormat ne 'markedEPS';
error "--below=0 invalid for FileFormat $FileFormat" if !$::opt_below and
is_any_origin_ok();
$::opt_antialias=is_has_antialias() ?
(is_sampled() ? 'scale3no' : 'yes') : 'no' if
!defined $::opt_antialias;
if ($FileFormat eq 'PBM' and ($::opt_antialias eq 'scale3yes' or
$::opt_antialias eq 'scale3no')) {
} elsif ($::opt_antialias ne 'no' and !is_has_antialias()) {
$::opt_antialias='no';
warning "--AntiAlias ignored for FileFormat $FileFormat"
}
if ($::opt_antialias eq 'scale3no' or $::opt_antialias eq 'scale3yes') {
$::opt_resolution="72,72" if $::opt_resolution eq 'unchanged' or $::opt_resolution eq 'force-unknown' or $::opt_resolution eq 'default';
# ^^^ GS raster default
my @L=split/[,x]/,$::opt_resolution;
@L=(@L,@L); # Imp: ..
$L[0]*=3; $L[1]*=3;
$::opt_resolution="$L[0],$L[0]";
}
### option compress
my $GSOPTS=join(" ",map{fnq$_}@gsextra);
# $GSOPTS.=" -r72 -sPAPERSIZE=a4 "; # default -- will be overridden by `setpagedevice'
# ^^^ Dat: default does only harm; user should specify on command line
### option BoundingBox types
#**** pts ****
# scan all of them and find the best
{ my $BBprint = "%%BoundingBox:";
$BBprint = "%%HiResBoundingBox:" if $::opt_hires;
$BBprint = "%%ExactBoundingBox:" if $::opt_exact;
debug "Strongest BoundingBox comment:", $BBprint;
}
my $BBregex='%%(Hi[Rr]es|Exact|)BoundingBox:';
if (!is_set_pagesize_ok()) {
if ($::opt_papersize ne'default' and $::opt_papersize ne'force-unknown') {
error "Cannot set --PaperSize for FileFormat $FileFormat"
} else { $::opt_papersize='force-unknown' }
} elsif ($::opt_papersize eq'default') { $::opt_papersize='unchanged' }
if ($::opt_resolution eq'default') { $::opt_resolution='force-unknown' }
error "Cannot set --Resolution for FileFormat $FileFormat (must be markedPS or sampled)"
if $FileFormat ne 'markedPS' and !is_sampled()
and $::opt_resolution ne'force-unknown';
error "Bad --Resolution=$::opt_resolution" if $::opt_resolution ne 'unchanged'
and $::opt_resolution ne 'force-unknown' and $::opt_resolution!~/\A(\d+)+[,x](\d+)\Z(?!\n)/;
if ($FileFormat ne 'markedPS' and $FileFormat ne 'PCL5') {
if ($::opt_duplex ne'default' and $::opt_duplex ne'force-unknown') {
error "Cannot set --Duplex for FileFormat $FileFormat (must be markedPS or PCL5)"
} else { $::opt_duplex='force-unknown' }
} elsif ($::opt_duplex eq'default') { $::opt_duplex='force-unknown' }
debug "Doing --PaperSize $::opt_papersize" if $::opt_papersize ne 'force-unknown';
debug "Doing --Duplex $::opt_duplex" if $::opt_duplex ne 'force-unknown';
debug "Doing --Resolution $::opt_resolution" if $::opt_resolution ne 'force-unknown';
debug "Doing --AntiAlias=$::opt_antialias" if $::opt_antialias ne 'no';
### option outfile
if ($OutputFilename eq '-') {
debug "Output file: standard output";
} else {
debug "Output filename: $OutputFilename";
#error "$OutputFilename: won't overwrite input file with itself"
# if $OutputFilename eq $InputFilename;
}
### option gs
debug "Output FileFormat: $FileFormat";
$::opt_compression='zip' if $::opt_compression ne 'none';
if ($FileFormat eq 'PDF' or $FileFormat eq 'PDF1') {
debug "Ghostscript ps2pdf command: $GS $GSOPTS";
debug "Compression: $::opt_compression";
} elsif ($FileFormat eq 'PCL5') {
debug "Ghostscript ps2ljet command: $GS $GSOPTS";
} elsif (is_sampled()) {
debug "Ghostscript ps2sampled command: $GS $GSOPTS";
}
#**** pts ****
sub read_error() { error "read $InputFilename: $!" }
my $in_mac_p=0; # 0: "\n" or "\r\n" is line terminator; 1: "\r" is line terminator
my $bytes_left=-1; # -1==unlimited
my $already_read=0;
sub dem1($){defined$_[0]?$_[0]:-1}
#** @param $_[0] number of bytes to read, or undef to read a line
#** @return the string read
sub readIN(;$) {
my $S;
## return "" if $bytes_left==0;
## print STDERR "READ($_[0])\n";
if (defined $_[0]) { read_error if 0>dem1 read IN, $S, $_[0] }
else {
$!=0; # clean up error code
if ($in_mac_p) {
local $/="\r";
$S=~s@\r\Z(?!\n)@\n@ if defined($S=<IN>);
} else { $S=<IN> }
read_error if !defined($S) and $!;
$S="" if !defined $S; # EOF
}
if ($bytes_left<0) { # unlimited
} elsif (length($S)>=$bytes_left) {
$S=substr($S, 0, $bytes_left);
$bytes_left=0;
} else { $bytes_left-=length($S) }
$already_read+=length($S);
$S
}
sub open_OUT() {
error "Cannot write outfile '$OutputFilename'" unless
open(OUT, $OutputFilename eq '-' ? ">-" : "> $OutputFilename")
}
#** @param $_[0] temp file extension (e.g ".img")
#** @param $_[1] preprint
#** @param $_[2] bool: force pipe even if seekable?
sub fix_pipe_in($$$) {
my $c="";
if ($_[2] or (length($c=readIN(1))!=0 and !seek IN,-1,1)) { # we cannot seek back
# Dat: ^^^ test seekability instead of $InputFilename eq '-'
my($ext,$preprint)=@_;
my $tifn;
# $ext=$1 if $InputFilename=~/[.](\w+)\Z(?!\n)/; # never true
$tifn=temp_prefix()."M$ext";
error "Cannot open temp input: $tifn" unless open TI, "> $tifn";
$tmpfiles{$tifn}=1;
die unless print TI $preprint, $c;
print TI or die while length($_=readIN 4096);
die unless close TI;
$InputFilename=$tifn;
debug "Temp input file: $InputFilename";
die unless open IN, "< $tifn";
die unless seek IN, length($preprint), 0;
$already_read=length($preprint);
$bytes_left=-1; # unlimited, since readIN() has copied only part
# $bytes_left++ if $bytes_left>=0; # ungetc($c)
# temp_unlink $tifn; # do it later (at END{})
} else {
$already_read--; $bytes_left++ if $bytes_left>=0; # BUGFIX at Fri May 14 00:21:18 CEST 2004
}
}
my $temp_out_fn;
#** Does overwrite $temp_out_fn. Fine.
sub fix_force_out($) {
my($ext)=$_[0];
# $ext=$1 if $InputFilename=~/[.](\w+)\Z(?!\n)/; # never true
$temp_out_fn=temp_prefix()."O$ext";
# error "Cannot save output: $!" unless open SAVEOUT, ">&OUT"; # always STDOUT; maybe not open yet
error "Cannot open temp output: $temp_out_fn" unless open OUT, "> $temp_out_fn";
$tmpfiles{$temp_out_fn}=1;
# $OutputFilename=$temp_out_fn;
debug "Temp output file: $temp_out_fn";
# temp_unlink $temp_out_fn; # do it later (at END{})
return $temp_out_fn;
}
#** @param $_[0] temp file extension (e.g ".img")
#** @return new output filename
sub fix_pipe_out($) {
if (!defined $temp_out_fn) {
return $OutputFilename if $OutputFilename ne '-';
return fix_force_out($_[0]);
}
$temp_out_fn
}
sub fix_close_out() {
# error "closing filter out: $? $!" unless close OUT;
if (defined $temp_out_fn) {
my $buf;
die unless open FCO, "< $temp_out_fn";
print STDOUT $buf while sysread FCO, $buf, 4096;
die unless close FCO;
temp_unlink $temp_out_fn;
undef $temp_out_fn;
}
}
sub do_system {
my($progname)=splice@_,0,1;
debug "Running: $progname @extra @_";
error "prog $progname failed: $? $!"
if 0!=system $progname, @extra, @_; # Dat: non-zero exit() or not found
}
sub do_exec {
my($progname)=splice@_,0,1;
if (scalar keys %tmpfiles) {
# Cannot exec() right now, because we have to unlink some temporary files
# later.
do_system $progname, @_;
} else {
debug "Execing: $progname @extra @_";
1 if exec $progname, @extra, @_;
# ^^^ Dat: $OutputFilename eq '-' should be OK
error "exec failed: $!";
}
exit(0);
}
#sub shq($) {
# my $S=$_[0];
# return $S if $S!~y@A-Za-z0-9_,:./-@@c and length($S)>0;
# $S=~s@'@'\\''@g;
# return "'$S'"
#}
### open input file
if ($InputFilename eq '-') {
debug "Input file: standard input";
open(IN, "<&STDIN") or error "cannot open standard input";
} else {
# -f $InputFilename or error "input file missing: $InputFilename"; # Imp: named pipe?
open(IN,"< $InputFilename") or error "cannot open input file: $InputFilename";
debug "Input filename:", $InputFilename;
if ($InputFilename eq $OutputFilename) {
# error "same input and output file: $InputFilename";
my $ext=$InputFilename=~m@([.][^./]+)\Z(?!\n)@ ? $1 : "";
binmode IN; $bytes_left=-1;
fix_pipe_in($ext, "", 1); # Dat: defined later
}
}
binmode IN;
#** Dat: uses $FileFormat, $InputFileName, $OutputFileName
#** @param $S prepend to pipe
sub run_sam2p($$) {
my($approx_p,$S)=@_;
# Imp: why isn't sam2p(1) PNG -> PNG idempotent?
my $tfmt=$FileFormat eq'markedEPS' || $FileFormat eq 'EPS' ? 'EPS'
: $FileFormat eq'markedPS' || $FileFormat eq 'PS' ? 'PS' # Dat: emits no /PageSize
: $FileFormat eq'PDF1' || $FileFormat eq 'PDF' ? 'PDF'
: undef;
if (defined $tfmt) {}
elsif (is_via_sam2p() or is_ok_sam2p()) {$tfmt=$FileFormat; $::opt_approx=1}
else { error "sam2p doesn't support our FileFormat $FileFormat" }
fix_pipe_in ".img", $S, 0;
if ($approx_p) {
if ($tfmt eq 'GIF') {
# Dat: reduce palette to 8-bit if necessary
my @args=('sam2p',@extra,"$tfmt:",'--',$InputFilename,$OutputFilename);
debug "Running: @args";
my $cmd=join(' ',map{fnq$_}@args)." 2>&1";
my $res=readpipe($cmd);
if ($res=~/\binvalid combination, no applicable OutputRule\b/) {
# Dat: reduce palette to 8-bit
#die "NOR";
my $have_convert_p;
my $have_pnmquant_p=0;
for my $dir (split/:/,$ENV{PATH}) {
if ((-f"$dir/pnmquant")) { $have_pnmquant_p=1 }
}
if (!$have_pnmquant_p) {
$have_convert_p=0;
for my $dir (split/:/,$ENV{PATH}) {
if ((-f"$dir/convert")) { $have_convert_p=1 }
}
}
my $cmd;
if ($have_pnmquant_p) {
my @args1=('sam2p','PPM:','--',$InputFilename,'-');
my @args2=('sam2p',@extra,"$tfmt:",'--','-',$OutputFilename);
$cmd=join(' ',map{fnq$_}@args1)." | pnmquant 256 | ".
join(' ',map{fnq$_}@args2);
} elsif ($have_convert_p) {
my @args1=('sam2p','PPM:','--',$InputFilename,'-');
my @args2=('sam2p',@extra,"$tfmt:",'--','-',$OutputFilename);
# vvv Dat: `convert - GIF:-' does quantize (and emits GIF)
$cmd=join(' ',map{fnq$_}@args1)." | convert - GIF:- | ".
join(' ',map{fnq$_}@args2);
}
debug "Running pipe: $cmd";
exec($cmd);
} elsif ($? !=0) { die $res }
# die $cmd;
#debug "Running: $progname @extra @_";
#error "prog $progname failed: $? $!"
#if 0!=system $progname, @extra, @_; # Dat: non-zero exit() or not found
}
do_exec('sam2p', ("$tfmt:", '--', $InputFilename, $OutputFilename));
} else {
warning "post-processing of sam2p PDF output increases file size" if $tfmt eq 'PDF';
$tfmt='EPS' if $tfmt eq 'PDF'; # Imp: PDF1<->PDF
close IN;
my $tpfn=temp_prefix()."Psimg";
error "Cannot open temp pipe dest: $tpfn" unless open TP, "> $tpfn";
$tmpfiles{$tpfn}=1;
die unless close TP;
do_system('sam2p', ("$tfmt:", '--', $InputFilename, $tpfn));
error "Cannot open temp pipe src: $tpfn" unless open IN, "< $tpfn";
$already_read=0; $bytes_left=-1;
$InputFilename=$tpfn; # '-'
goto SCAN_AGAIN
}
}
#** Force this value for %%HiResBoundingBox if a %BoundingBox is read
my $force_hiresbbox_value;
### scan first line, check for DOS EPSF (and remove DOS headers)
my $header;
{ SCAN_AGAIN:
my $S;
$_=$header="";
read_error if 0>read IN, $S, 4;
error "$InputFilename: empty file" if 0==length($S);
$already_read+=length($S);
##print tell(IN)." bar=$already_read\n";
my $iff="?"; # Input File Format
# vvv be permissive, since we have only 4 chars
if ($S eq "\211PNG") { $iff="PNG" }
elsif ($S=~/\A(\377+\330)\377/) { $iff="JPEG" }
elsif ($S eq "MM\000\052" or $S eq "II\052\000") { $iff="TIFF" }
elsif ($S=~m@\AP([1-6])[\s#]@) { $iff="PNM" }
elsif ($S=~/\ABM/) { $iff="BMP" }
elsif ($S eq "GIF8") { $iff="GIF" }
elsif ($S eq "FORM") { $iff="LBM" }
elsif ($S eq "/* X" or $S eq "/*XP") { $iff="XPM" }
elsif ($S=~/\A\12[\0-\005]\001[\001-\10]/) { $iff="PCX" }
elsif ($S=~/\A[\36-\77](?:\001[\001\11]|\0[\002\12\003\13])\0/) { $iff="TGA" }
elsif ($S eq "\305\320\323\306") { $iff="DOS-EPSF" }
elsif ($S eq "\033%-1") { $iff="UEL" }
elsif (substr($S,0,1)eq'%') { $iff="P" } # PS, EPS or PDF
# PNG JPEG TIFF PNM BMP GIF LBM XPM PCX TGA
if ($iff eq "DOS-EPSF") { # DOS EPSF header
read_error if 30-4>read IN, $S, 30-4, 4;
my ($eheader,$ps_ofs,$ps_len,$wmf_ofs,$wmf_len,$tif_ofs,$tif_len,$checksum)=
unpack"A4VVVVVVv", $S;
$already_read+=30-4;
error "$InputFilename: bad DOS EPS" if $eheader ne "\305\320\323\306" or $ps_ofs<30;
my($ps_end, $wmf_end, $tif_end)=($ps_ofs+$ps_len, $wmf_ofs+$wmf_len, $tif_ofs+$tif_len);
$ps_ofs-=30;
if (!seek IN, $ps_ofs, 1) {
while ($ps_ofs>4096) { $ps_ofs-=4096; readIN 4096 }
read_in $ps_ofs if $ps_ofs>0;
}
$bytes_left=($ps_end>$wmf_end and $ps_end>$tif_end) ? -1 : $ps_len;
$S=readIN(1);
} elsif ($iff eq "UEL") { # HP PJL UEL, untested
$S.=readIN;
$S=substr($S,1);
error "$InputFilename: bad HP PJL UEL header: ".(~chomp($S)&&$S)
if $S!~/\A\\e?%-12345X\@PJL ENTER LANGUAGE\s*=\s*POSTSCRIPT\s*\r?$/i;
1 while length($S=readIN())!=0 and substr($S,0,4)ne'%!PS';
die "$InputFilename: premature HP PJL UEL header" if length($S)==0;
} elsif ($iff eq "P") {
# no-op yet, see later
} elsif ($iff eq "?") {
error "unknown input image format: $InputFilename";
} else { # source file is in some raster graphics format
run_sam2p($::opt_approx,$S);
goto SCAN_AGAIN
}
# now deal with PS, EPS and PDF
if (substr($S,0,1) eq '%') {
{ my $max=128;
my $C;
while (length($S)<$max and defined($C=readIN(1)) and
$C ne "\n" and $C ne "\r") { $S.=$C }
error "couldn't find end of PS/PDF header line in $max bytes\n" if
length($S)>=$max or !defined($C);
$C=($C eq "\r") ? readIN(1) : "NONE";
if (!defined$C or ($C ne "\n" and $C ne "NONE")) {
use IO::Handle; # Dat: needed for ungetc
IN->ungetc(ord($C)) if defined $C;
debug "MAC \\r detected";
$in_mac_p=1;
} elsif ($C eq "\n") { # Dat: \r\n, DOS CRLF
$in_mac_p=0; $S.="\r";
} else { $in_mac_p=0 }
$S.="\n";
} # $S.=readIN;
if (substr($S,0,4)eq'%PDF') {
# error "$InputFilename: won't read a PDF file";
if ($FileFormat eq 'PDF') { # convert PDF to PDF
# !! PDF->PS->PDF
open_OUT();
$_=$S;
debug "Doing a bit-by-bit copy";
do {
error "input error: $!" unless print OUT;
} while (length($_=readIN 4096));
close OUT; close IN;
exit 0;
} elsif ($FileFormat eq 'PDF1') { # Dat: remove extra pages by running pdftops and gs -sDEVICE=pdfwrite
# !! Imp: possibly Run MetaPost output through full dvips (texc.pro) when prologues:=0
# !! Imp: add full dvips %* font comment when prologues:=1 (design sizes missing :-()
# Dat: no way to use $::opt_approx, because it doesn't remove extra pages
fix_pipe_in ".pdf", $S, 0; # in case of stdin
# Imp: option to open pdftops pipe instead of temp file
# Dat: we rather use a temp file here for safety and early error detection
do_input_pdftops: # come from EPS: and markedEPS:
close IN; # after fix_pipe_in()
my $tpfn=temp_prefix()."Peps";
error "Cannot open temp pipe dest: $tpfn" unless open TP, "> $tpfn";
$tmpfiles{$tpfn}=1;
die unless close TP;
do_system qw(pdftops -f 1 -l 1 -eps -- ), $InputFilename, $tpfn;
error "Cannot open temp pipe src: $tpfn" unless open IN, "< $tpfn";
$already_read=0; $bytes_left=-1;
$InputFilename=$tpfn; # '-'
goto SCAN_AGAIN
} elsif ($FileFormat eq 'EPS' or $FileFormat eq 'markedEPS') { # convert PDF to EPS
# Dat: limitation: markedEPS and EPS are treated the same
# vvv Dat: pdftops(1) is part of the xpdf package
# vvv Dat: pdftops(1) can emit to stdout
fix_pipe_in ".pdf", $S, 0;
if ($::opt_approx) {
do_exec qw(pdftops -f 1 -l 1 -eps --), $InputFilename, $OutputFilename;
} else { goto do_input_pdftops }
} elsif ($FileFormat eq 'PS' or $FileFormat eq 'markedPS') {
# Dat: limitation: markedEPS and EPS are treated the same
fix_pipe_in ".pdf", $S, 0;
close IN;
# vvv we must query the BoundingBox first
my $cmd="pdftops -f 1 -l 1 -eps ".fnq($InputFilename)." -";
debug "pdftops bbox pipe: $cmd";
error "pipe: $!" unless open PIPE, "$cmd |";
my $line;
error "expected PS document" if !defined($line=<PIPE>) or $line!~/^%!PS-Adobe-\d.*EPSF-\d/;
my @L; # $papersize_x, $papersize_y
while (<PIPE>) {
last if /^%%EndComments/ or !/^%/;
@L=($1,$2) if /^%%(?:Hires|Exact)BoundingBox:\s*\S+\s*\S+\s*(\S+)\s*(\S+)\s*$/i;
@L=($1,$2) if /^%%BoundingBox:\s*\S+\s*\S+\s*(\S+)\s*(\S+)\s*$/i and !@L;
# ^^^ Dat: HiRes has priority
# ^^^ Dat: ignore llx and lly coordinates
}
1 while read PIPE, $line, 4096;
error "closing PIPE: $?" unless close PIPE;
error "BoundingBox not found in pdftops output" if !@L;
debug "Got PaperSize: @L";
# vvv Dat: pdftops without -eps doesn't report HiResBoundingBox,
# so we force it here
# at Wed Nov 15 17:19:23 CET 2006
$::opt_bboxfrom='adsc' if $::opt_bboxfrom eq 'guess';
$force_hiresbbox_value="0 0 @L";
#die defined $L[1];
$L[0]=myceil $L[0]; $L[1]=myceil $L[1]; # Dat: pdftops expects integer papersize :-( )
if ($::opt_approx) {
# vvv Dat: even pdftops 3.01 accepts only integer for -paperw and paperh
do_exec 'pdftops', '-paperw', myfloor($L[0]+0.5), '-paperh', myfloor($L[1]+0.5), $InputFilename, $OutputFilename;
} else {
my $tpfn=temp_prefix()."Pps";
error "Cannot open temp pipe dest: $tpfn" unless open TP, "> $tpfn";
$tmpfiles{$tpfn}=1;
die unless close TP;
do_system 'pdftops', '-paperw', myfloor($L[0]+0.5), '-paperh', myfloor($L[1]+0.5), $InputFilename, $tpfn;
error "Cannot open temp pipe src: $tpfn" unless open IN, "< $tpfn";
$already_read=0; $bytes_left=-1;
$InputFilename=$tpfn; # '-'
goto SCAN_AGAIN
}
} elsif (is_ok_sam2p() or is_via_sam2p()) {
# Dat: PDF to GIF conversion
run_sam2p(1,$S);
}
error "cannot create from PDF: FileFormat $FileFormat";
OK:
}
error "$InputFilename: EPS DSC must be %!PS-Adobe" if substr($S,0,4)ne'%!PS';
# ^^^ Dat: mpost outputs "%!PS\n"
} else {
warning "$InputFilename: no PS ADSC header, BoundingBox not found\n"
}
$header=$S;
}
# Dat: Now we are converting from PS|EPS to EPS|markedEPS|PDF|PCL5|PGM
# So we're converting from PS|EPS with Ghostscript
### variables and pattern for BoundingBox search
my $bbxpatt = '[0-9eE\.\-]';
my $BBValues = "\\s*($bbxpatt+)\\s+($bbxpatt+)\\s+($bbxpatt+)\\s+($bbxpatt+)"; # protect backslashes: "\\" gets '\'
my $ll_zero=0; # ($llx,$lly)==(0,0) in the output file
my $need_grestore=0; # 0 v 1
#** Applies %%*BoundingBox, %%EndComments, special setpagedevice, gsave..translate
#** @param $_[0] llx, may be undef to signify that bbox is undetected
#** @param $_[1] lly
#** @param $_[2] urx
#** @param $_[3] ury
#** @param $_[4] after_correct PostScript code (resolution, page size)
#** @return PostScript code to be printed after the header
sub CorrectBoundingBox($$$$$$$) {
no integer;
my $bbx="";
my $pagedev_mark="";
my $translate="";
my ($llx, $lly, $urx, $ury, $after_correct, $fontsdefs, $is_restored) = @_;
if (defined $llx) {
my ($xoffset, $yoffset) = (0, 0);
my $old_bbox="$llx $lly $urx $ury"; # debug "Old BoundingBox: $old_bbox";
# my ($width, $height) = ($urx - $llx, $ury - $lly);
($xoffset, $yoffset) = (-$llx, -$lly);
# $::opt_below=0 if $lly>=0; # always move to (0,0)
# my ($urxh,$uryh)=($urx,$ury);
# my $no_translate=$::opt_below;
#die $no_translate;
($llx,$lly,$urx,$ury)=(0,0,$urx-$llx,$ury-$lly) if !$::opt_below;
$urx=1 if $urx<=0; # Dat: GS dislikes empty image; fix also negative image
$ury=1 if $ury<=0;
my($px,$py)=($urx,$ury);
($px,$py)=($1+0,$2+0) if $after_correct=~m@/PageSize\s*\[(\S+)\s+(\S+)+\]@;
my @paper=Htex::papers::any("$px,$py");
$paper[0]=defined $paper[0] ? "%%DocumentPaperSizes: $paper[0]\n" : "";
$bbx.="%%BoundingBox: ".myfloor($llx)." ".myfloor($lly)." ".
myceil($urx)." ". myceil($ury)."\n";
$bbx.="%%HiResBoundingBox: $llx $lly $urx $ury\n".
"%%ExactBoundingBox: $llx $lly $urx $ury\n" if myfloor($llx)!=$llx
or myfloor($lly)!=$lly or myceil($urx)!=$urx or myceil($ury)!=$ury;
$bbx.="%%DocumentMedia: plain $px $py 0 () ()\n". # like pdftops(1)
"$paper[0]";
# ^^^ Imp: can DocumentMedia be non-integer? As of us, it can.
# vvv we output a second /MediaBox here, and we'll remove the first one
# (written by GS) later
# vvv Dat: old version of Ghostscript insisted on an integer /CropBox (??).
# we do not force it now
$pagedev_mark.="mark /CropBox [$llx $lly $urx $ury] /PAGE pdfmark\n" if is_pdfmark();
# die "$xoffset $yoffset $::opt_below";
if ($xoffset==0 and $yoffset==0) { #**** pts ****
$need_grestore=0;
$ll_zero=1; # Dat: we do not insert extra /MediaBox here, gs -sDEVICE=pdfwrite will do
} elsif ($::opt_below) {
# Do not translate (set (0,0) to the origin) with --below or multi-page
# file formats.
$need_grestore=0;
$ll_zero=0; # fix /MediaBox because it become non-(0,0)-based
$pagedev_mark.="mark /MediaBox [$llx $lly $urx $ury] /PAGE pdfmark\n" if
is_pdfmark(); # $FileFormat eq 'markedEPS' or $FileFormat eq 'markedPS';
# Dat: markedPS and contains pdfmark!
} else {
# debug "Offset:", $xoffset, $yoffset; # no new information, see -$llx, -$lly
$xoffset=0 if $xoffset==0; # get rid of `-0'
$yoffset=0 if $yoffset==0; # get rid of `-0'
if ($is_restored) { $translate="" } # save..restore does gsave..grestore
else { $translate="gsave "; $need_grestore=1 }
$ll_zero=0;
# vvv the /MediaBox is different from what gs dumps
# $pagedev_mark=~s@/PageSize\s*\[[^\]]*]@/PageSize [$urx $ury]@; # BUGFIX at Tue Apr 22 10:08:17 CEST 2003
$pagedev_mark.="mark /MediaBox [$llx $lly $urx $ury] /PAGE pdfmark\n" if is_pdfmark();
$translate.="$xoffset $yoffset translate\n"
}
my $new_bbox="$llx $lly $urx $ury";
if ($old_bbox eq $new_bbox) {
debug "Final (HiRes)BoundingBox: $new_bbox";
} else {
debug "Old (HiRes)BoundingBox: $old_bbox";
debug "Final corrected (HiRes)BoundingBox: $new_bbox";
}
$pagedev_mark="/pdfmark where{pop}{/pdfmark/cleartomark load def}ifelse\n$pagedev_mark"
if length($pagedev_mark)!=0;
}
# vvv Imp: `<<' -> `dict'
# Dat: it is inherently impossible to tell GS that it shouldn't
# recompress the images already compressed in the EPS file, but keep
# them in their original, compressed form. So we rather instruct GS to
# recompress
# !! Dat: /CompatibilityLevel 1.3 %PDF-1.2 -- Dat: 1.2 won't embed Courier
my $markpagedevices="";
my $imagesopts=($::opt_lossy ? "
/AutoFilterMonoImages true
/AutoFilterGrayImages true
/AutoFilterColorImages true
/MonoImageFilter /CCITTFaxEncode
/GrayImageFilter /DCTEncode
/ColorImageFilter /DCTEncode
" : "
/AutoFilterMonoImages false
/AutoFilterGrayImages false
/AutoFilterColorImages false
/MonoImageFilter /LZWEncode
/GrayImageFilter /LZWEncode
/ColorImageFilter /LZWEncode
"); # Dat: assumes new, patent-free LZW
if (is_pdfmark()) {
# Dat: CompatibilityLevel 1.3 is required for font embedding & all /FlateDecode
$markpagedevices="
/CompatibilityLevel 1.3 %PDF-1.3
/EmbedAllFonts true
/Optimize true % ignored by gs-6.70
/AutoRotatePages /None
/UseFlateCompression ".($::opt_compression ne 'none'?"true":"false")."
/AutoPositionEPSFiles false
/ConvertImagesToIndexed false
/DownsampleMonoImages false
/DownsampleGrayImages false
/DownsampleColorImages false
/EncodeMonoImages true
/EncodeGrayImages true
/EncodeColorImages true
/AntiAliasMonoImages false
/AntiAliasGrayImages false
/AntiAliasColorImages false\n$imagesopts";
$markpagedevices=(length($markpagedevices)!=0 ? "<< $markpagedevices >> setpagedevice\n" : "");
$markpagedevices.="1 dict dup /ImagingBBox null put setpagedevice\n";
$markpagedevices.="1 dict dup /Policies 1 dict dup /PageSize 3 put put setpagedevice\n"; # ripped from pdftops(1)
}
my $setpagesize="";
# die defined $urx;
# die is_set_pagesize_ok();
# die $after_correct;
if (defined $urx and is_set_pagesize_ok()
and $::opt_papersize ne'force-unknown'
and $after_correct!~m@/PageSize\s*\[@) { # Imp: m@/Pagesize ugly
# Dat: true for FileFormat PGM
# Dat: emit /PageSize even for PDF1
# Dat: Ghostscript 6.70 rounds /PageSize down, but we need up when creating /MediaBox for PDF
$setpagesize="2 dict dup /PageSize [".myceil($urx)." ".myceil($ury)."] put setpagedevice\n";
# ^^^ Dat: PLRM.pdf doesn't forbid a non-integer /PageSize
}
my $bsetup=is_page1_stop()?"":"%%BeginSetup\n%%EndSetup\n";
# ^^^ Dat: CUPS inserts its setpagedevice calls for /Duplex and /PageSize
# etc. just after the %%BeginSetup line (or, if missing, puts it in
# front of the first %%Page). We'd like this execution order: CUPS,
# ours, PStoPS (or psnup). (When we come after CUPS, we'll have a
# chance to override its settings.) So we emit a fake
# %%BeginSetup..%%EndSetup pair just before our code doing
# `setpagedevice'.
# !! ?? run pstops first, and then a2ping.pl
# !! why does a PDF -> PS conversion need $is_restored?
# vvv Dat: `mark' is necessary, because pstops 1.17 from xpdf(1) emits lines
# lines leaving `false' on the stack:
# %%BeginResource: font SKPOPP+LMRoman12-Regular
# %!PS-AdobeFont-1.0: LMRoman12-Regular 0.86
# %%CreationDate: 4th August (Monday) 2003
# % Generated by MetaType1 (a MetaPost-based engine)
# % CM sources: copyright (C) 1997 AMS, all rights reserved; METATYPE1/Type 1 ver
# % ADL: 694 194 112
# %%EndComments
# FontDirectory/LMRoman12-Regular known{/LMRoman12-Regular findfont dup/UniqueID
# /UniqueID get 0 eq exch/FontType get 1 eq and}{pop false}ifelse
# {save true}{false}ifelse}{false}ifelse
my $save=$is_restored?"save mark\n":"";
$bbx.$fontsdefs."%%EndComments\n".$bsetup.$setpagesize.$markpagedevices.$pagedev_mark.$after_correct.$save.$translate
}
### scan header
my $to_OUT="";
my $after_code="";
my $do_fix_tumble=0;
my $is_restored=0;
if (1<length($header)) {
my($llx,$lly,$urx,$ury);
my($bbtype)='-'; # None
my $allow_adsc_bb=1;
my $after_correct="";
my $do_bb_line=sub { # sub do_bbline($$)
no integer;
# Decreasing precedence of various BoundingBoxes:
# The last valid *bbox entry has effect.
# Active policy:
# normal mode : BoundingBox ExactBoundingBox HiResBoundingBox
# --hires mode: HiResBoundingBox BoundingBox ExactBoundingBox
# --exact mode: ExactBoundingBox BoundingBox HiResBoundingBox
# -hi -ex mode: ExactBoundingBox HiResBoundingBox BoundingBox
# Another possible policy:
# normal mode : BoundingBox HiResBoundingBox==ExactBoundingBox
# --hires mode: HiResBoundingBox ExactBoundingBox BoundingBox
# --exact mode: ExactBoundingBox HiResBoundingBox BoundingBox
# -hi -ex mode: ExactBoundingBox==HiResBoundingBox BoundingBox
my($S,$from)=@_;
return if $S!~/^(?:$BBregex|set)$BBValues/oi;
# print STDERR "($S)\n";
my $E1=defined$1 ? $1 : "+";
my $T=!defined($1) ? 'S' : uc substr $1,0,1; # '' || 'H' || 'E'
# debug "Trying BoundingBox T-$bbtype: $llx $lly $urx $ury";
if ($T eq 'S'
or !$::opt_hires and !$::opt_exact and ($T eq '' or ($bbtype ne '' and ($T eq 'E' or $bbtype ne 'E')))
or $::opt_hires and !$::opt_exact and ($T eq 'H' or ($bbtype ne 'H' and ($T eq '' or $bbtype ne '')))
or $::opt_exact and !$::opt_hires and ($T eq 'E' or ($bbtype ne 'E' and ($T eq '' or $bbtype ne '')))
or $::opt_exact and $::opt_hires and ($T eq 'E' or ($bbtype ne 'E' and ($T eq 'H' or $bbtype ne 'H')))
) {
# if ($allow_bb) {
($bbtype,$llx,$lly,$urx,$ury)=($T,$2+0,$3+0,$4+0,$5+0);
debug "Applying ${E1}BoundingBox$from T-$bbtype: $llx $lly $urx $ury";
# }
} else {
my @L=($2+0,$3+0,$4+0,$5+0); # convert 0.00 to 0
debug "Ignoring ${E1}BoundingBox$from T-$bbtype: @L";
}
# Dat: don't do $do_bb_line=sub{};# same as $allow_bb=0;
};
$header=~s@\r\n?\Z(?!\n)@@;
my $after_comments=""; # after %%EndComments
# my $res;
{ my $headEPSF;
my $headPS="PS-Adobe-3.0";
# vvv Imp: run this correction even w/o input EPS header
if ($header!~s/\s+(EPSF-[.\d]+)$// or $::opt_bboxfrom ne 'guess') { # a PS not an EPS already
# This is the compute-pipe routine.
# To convert an [E]PS to an EPS:
# -- find the end of the 1st page in the code, and remove everything after it
# -- `pop' off the execution stack after the 1st page
# -- `end' the dictionary stack after the 1st page
# -- change the ADSC magic `%!PS-Adobe-...' to `%!PS-Adobe-3.0 EPSF-3.0'
# -- remove the `%%Pages', `%%DocumentPaperSizes', `%%PageOrder:'
# (Ascending) comment from the ADSC header
# -- possibly remove the `%%Page' ADSC comment [no]
# -- ignore calls to = setpage setpagemargin setpageparams .setpagesize
# setpagedevice setpagetype setprintername setresolution a4 letter ...
# -- surround the code by save ... pop* end* restore (implies gsave ... grestore)
# -- possibly ignore calls to showpage [showpage is forced]
$headEPSF=" EPSF-3.0";
debug "Computing BBox info from non-EPS PS file";
fix_pipe_in 'i.ps', "%!$headPS\n", 0;
my $tfn=temp_prefix()."c.tgs";
error "temp open $tfn: $!" unless open F, "> $tfn";
$tmpfiles{$tfn}=1;
##print tell(IN)." car=$already_read\n";
die "$0: $!\n" unless print F "% this is temporary gs command file created by $program".'
/DOCUT true def
/MAINFILE FN (r) file def
/DICTCOUNT countdictstack def
count /OPCOUNT exch def
<</BeginPage { % <PageCount> BeginPage -
dup 1 eq {
count OPCOUNT sub 1 sub (pop-count==) ..print ===
countdictstack DICTCOUNT sub (end-count==) ..print ===
DOCUT { (cut-offset==) ..print MAINFILE fileposition === flush } if
(bbox-success\n) ..print
quit
} if
.callbeginpage
}
>> setpagedevice
% vvv do these after our call to /setpagedevice
.currentglobal true .setglobal
systemdict begin
/..paper.redef<< >>def
/..print/print load def
/setpageparams{pop pop pop pop (\nset-called-4==/setpageparams\n) ..print flush}def
/setpage{pop pop pop (\nset-called-3==/setpage\n) ..print flush}def
/setpagesize{pop pop (\nset-called-2==/setpagesize\n) ..print flush}def
/.setpagesize{pop pop (\nset-called-2==/.setpagesize\n) ..print flush}def
/setpagemargin{pop (\nset-called-1==/setpagemargin\n) ..print flush}def
{% anti-Windows-printer-driver `%%[ ProductName:` etc.
dup type/stringtype eq{
dup length 3 ge{
dup 0 3 getinterval (%%[) eq{
(\nset-called-1==/=\n) ..print flush
(\nset-called-1==/print\n) ..print flush
}if}if}if
pop
}
dup/= exch def /print exch def
/setpagedevice{pop (\nset-called-1==/setpagedevice\n) ..print flush}def
/..sdict <<
/PageSize { % [. .] PageSize -
dup type /arraytype eq {
dup length 2 ge {
dup 0 get type dup /integertype eq exch /realtype eq or {
dup 1 get type dup /integertype eq exch /realtype eq or {
(\npapersize-x==) ..print dup 0 get ===
(\npapersize-y==) ..print dup 1 get === (\n) ..print
} if
} if
} if
} if
pop
}
/HWResolution { % [. .] PageSize -
dup type /arraytype eq {
dup length 2 ge {
dup 0 get type dup /integertype eq exch /realtype eq or {
dup 1 get type dup /integertype eq exch /realtype eq or {
(\nresolution-x==) ..print dup 0 get ===
(\nresolution-y==) ..print dup 1 get === (\n) ..print
} if
} if
} if
} if
pop
}
/Duplex { % [. .] PageSize -
dup type /booleantype eq {
(\nsides-duplex==) ..print dup === (\n) ..print
} if
pop
}
/Tumble { % [. .] PageSize -
dup type /booleantype eq {
(\nsides-tumble==) ..print dup === (\n) ..print
} if
pop
}
>> def
%/.setpagesize{pop pop (hehehe\n) print} def
% /a4{(hehehe\n) ..print} def % doesn"t work, has to be put into userdict
/setpagedevice{
{ % <key> <val>
exch dup ..sdict exch known { % run all keys known in ..sdict
..sdict exch get exec
} {pop pop} ifelse
} forall
(\nset-called-1==/setpagedevice\n) ..print flush
}def
/setpagetype{pop (\nset-called-1==/setpagetype\n) ..print flush}def
/setprintername{pop (\nset-called-1==/setprintername\n) ..print flush}def
/setresolution{pop (\nset-called-1==/setresolution\n) ..print flush}def
[ % Dat: fixed at Mon May 19 14:32:31 CEST 2003
statusdict /.pagetypenames 2 copy known {get}{pop pop{}}ifelse
% ^^^ Dat: may be {/a4 STRICT {(%END SIZES) .skipeof} if /a5}
{ /11x17/a3/a4/a4small/b5/ledger/legal/letter % GS 7.04
/lettersmall/note/a0/a1/a2/a5/a6/a7/a8/a9/c0/c1/c2/c3/c4/c5/c6
/a10/b0/b1/b2/b3/b4/b5/b6
/isob0/isob1/isob2/isob3/isob4/isob5/isob6
/jisb0/jisb1/jisb2/jisb3/jisb4/jisb5/jisb6
/archE/archD/archC/archB/archA/flsa/flse/halfletter
/tabloid/csheet/dsheet/esheet/executivepage/com10envelope
/monarchenvelope/c5envelope/dlenvelope/folio/quarto
}
]{{
dup type /nametype eq { dup xcheck not { % Dat: fixed
% dup ===
dup ..paper.redef exch known {pop} {
dup ..paper.redef exch null put
dup userdict exch 2 copy known { 2 copy get
1 index userdict exch undef
% Stack: /a4 userdict /a4 {...}
% 3 copy pop undef
4 2 roll exch undef
} { exch pop pop {} } ifelse
% Stack: /a4 {595 842 //.setpagesize --exec--}
% Stack: /a4 {595 842 {/statusdict --.systemvar-- --begin-- .setpagesize --end--} --exec--}
{ /get exec /pop (\nset-called-0==) ..print === flush } % dump
dup length array copy cvx % make a copy for subsequent invocations
2 copy exch 0 exch put exch pop % change /get to {...}
2 copy exch 2 exch put % change /pop to /a4
def % overwrite it in systemdict
} ifelse
true
} if } if
pop
}forall} forall
end % systemdict
.setglobal
systemdict readonly pop
(bbox-begin\n) ..print
MAINFILE cvx exec
(add-showpage==1\n) ..print
/DOCUT false def
showpage quit
';
die unless close F;
# vvv Imp: make it work on Win32 (no >&1 redirection)
my $gs3=$CGS. # "-dPAGE1QUIT=".($FileFormat eq 'EPS' or $FileFormat eq 'markedEPS' ? 'quit' : '{}').
" -dWRITESYSTEMDICT -dNOPAUSE -sDEVICE=bbox -sFN=".fnq($InputFilename)." ".fnq($tfn)." 2>&1";
debug "Ghostscript compute pipe: $gs3";
my $res=`$gs3`;
## die $res;
temp_unlink $tfn;
## print STDERR $res;
error $?==11 ? "segmentation fault in $GS" : "not a GS output from $GS ($?)"
if !defined $res # BUGFIX at Sun Mar 7 18:51:34 CET 2004
or $res!~s/\A(?:\w+ Ghostscript \d|Copyright .* artofcode ).*\n// # AFPL Ghostscript 6.50 (2000-12-02)
or $res!~s/.*?^bbox-begin\n//m;
if ($res!~s/\nbbox-success\n\Z(?!\n)/\n/) {
warning # not `error', mpost(1) `prologues:=0; ... btex fonts' output won't compile
"BBox discovery was not successful";
# !! continue only if MetaPost output?
goto SKIP_BBOX_DISC;
}
#: Copyright (C) 2000 Aladdin Enterprises, Menlo Park, CA. All rights reserved.
#: This software comes with NO WARRANTY: see the file PUBLIC for details.
#: set-called-0==/a4
#: %%BoundingBox: 56 41 539 783
#: %%HiResBoundingBox: 56.645998 41.849999 538.811984 782.351976
#: pop-count==0
#: end-count==1
#: cut-offset==81898
my $pop_count=0;
my $end_count=0;
my $cut_offset=-1;
my $papersize_x=undef; # page_width
my $papersize_y=undef; # page_height
my $resolution_x=undef;
my $resolution_y=undef;
my $duplexi=0;
my $tumblei=0;
my %H;
my $undefs="";
my $bbc=0; # required
for my $line (split/\n/, $res) {
if ($line=~/^$BBregex$BBValues/oi) { $do_bb_line->($line," from Compute-GS"); $bbc++ }
elsif ($line=~m@^set-called-(\d+)==/(\S+)$@) {
if (not exists $H{$2}) {
$H{$2}=1;
$undefs.="/$2".(
$1==0 ? "{}def\n" :
$1==1 ? "/pop load def\n" :
"{".("pop "x$1)."}bind def\n"
);
}
# Dat: Safe, restorable, EPS-wise: /setpagedevice {pop} def
# Dat: Smart, documentwise /a4 dup where{dup wcheck{exch{}put}{pop{}def}ifelse}{pop}ifelse
}
elsif ($line=~/^pop-count==(\d+)$/) { $pop_count=$1+0 }
elsif ($line=~/^end-count==(\d+)$/) { $end_count=$1+0 }
elsif ($line=~/^cut-offset==(\d+)$/) { $cut_offset=$1+0 }
elsif ($line=~/^papersize-x==([-+0-9eE.]+)$/) { no integer; $papersize_x=$1+0 }
elsif ($line=~/^papersize-y==([-+0-9eE.]+)$/) { no integer; $papersize_y=$1+0 }
elsif ($line=~/^resolution-x==([-+0-9eE.]+)$/) { no integer; $resolution_x=$1+0 }
elsif ($line=~/^resolution-y==([-+0-9eE.]+)$/) { no integer; $resolution_y=$1+0 }
elsif ($line=~/^sides-duplex==true$/) { $duplexi=1 }
elsif ($line=~/^sides-dumplex==false$/) { $duplexi=2 }
elsif ($line=~/^sides-tumble==true$/) { $tumblei=1 }
elsif ($line=~/^sides-tumble==false$/) { $tumblei=2 }
elsif ($line=~/^add-showpage==\d+$/) { } # !!
elsif (length($line)==0 or $line=~/^(?:Copyright |This software )/) {}
elsif ($line=~/^Loading (\S+) font from.*[.][.][.]/) { debug "GS builtin font used: $1" }
else { debug "unknown line ($line)" }
}
undef $papersize_y if !defined $papersize_x;
die unless $allow_adsc_bb==1;
# Dat: This only applies when converting fron non-EPS PS:
# Setting $allow_adsc_bb=0|1 now would disallow/allow the %%BoundingBox
# etc. ADSC comment override the bbox computed by -sDEVICE=bbox.
# When converting PS -> EPS, the PS file usually contains
# `%%BoundingBox: 0 0 paperwidth paperheight', but the figure
# itself is smaller.
$bbtype='-';
## die "$papersize_x;;"; # PDF -sPAPERSIZE=a4
#if ($::opt_papersize ne 'force-unknown' and $::opt_papersize ne 'unchanged') {
# # override bbox
# ($llx,$lly)=(0,0);
# ($urx,$ury)=split/,/,$::opt_papersize;
#} elsif (!is_page1_stop() and defined $papersize_x and defined $papersize_y) {
#}
debug "PaperSize wd=${papersize_x}bp ht=${papersize_y}bp" if defined $papersize_x;
if ($::opt_papersize eq 'force-unknown' or ($::opt_papersize eq 'unchanged' and !defined $papersize_x)) {}
elsif ($::opt_papersize ne 'unchanged') {
die if is_page1_stop();
($papersize_x,$papersize_y)=split/,/,$::opt_papersize;
goto do_force_papersize
} else {
# Dat: no $do_bb_line here, because we've done it with $bbc++, and we'll also do it later
do_force_papersize:
die if is_page1_stop();
# vvv ($llx,$lly,$urx,$ury)=(0,0,$papersize_x,$papersize_y);
# $do_bb_line->("set 0 0 $papersize_x $papersize_y"," from /PageSize");
$after_correct.="1 dict dup /PageSize [".myceil($papersize_x)." ".myceil($papersize_y)."] put setpagedevice\n";
# ^^^ Dat: both PS and markedPS would benefit from /PaperSize
# ^^^ Dat: will be put after CorrectBoundingBox
# Dat: unneeded: $allow_adsc_bb=0 if $FileFormat eq 'PDF'; # force this into /CropBox (otherwise only /MediaBox)
}
if (defined $papersize_x and ($::opt_bboxfrom eq 'papersize' or ($::opt_bboxfrom eq 'guess' and is_set_pagesize_ok()))) {
$allow_adsc_bb=0;
$do_bb_line->("set 0 0 $papersize_x $papersize_y"," from /PageSize"); # does ($llx,$lly,$urx,$ury)=(0,0,$papersize_x,$papersize_y);
}
$allow_adsc_bb=0 if ($::opt_bboxfrom eq 'compute-gs') ? ($bbc!=0)
: ($::opt_bboxfrom eq 'guess') ? ($bbc!=0 and is_page1_stop()) # Imp: is is_page1_stop() OK here?
: 0;
if (!is_page1_stop()) {
$pop_count=$end_count=0; # assume PS is correct
$cut_offset=-1;
}
# if ($FileFormat ne 'EPS' and $FileFormat ne 'PS') { # device-specific (marked)
# ^^^ Dat: $::opt_resolution and $::opt_duplex are already 'force-unknown' if $FileFormat is appropriate
{
$::opt_resolution=$resolution_x.','.$resolution_y if
$::opt_resolution eq 'unchanged' and defined $resolution_x and defined $resolution_y;
# vvv Imp: move down like $::opt_resolution
if ($::opt_duplex eq 'force-unknown' or ($::opt_duplex eq 'unchanged' and $duplexi==0)) { $do_fix_tumble=($duplexi==1 && $tumblei==1) }
elsif ($::opt_duplex eq 'force-simplex') { do_simplex: $after_correct.="1 dict dup /Duplex false put setpagedevice\n" }
elsif ($::opt_duplex eq 'force-long' ) { do_long: $after_correct.="2 dict dup /Duplex true put dup /Tumble false put setpagedevice\n" }
elsif ($::opt_duplex eq 'force-short') { do_short: $do_fix_tumble=1; $after_correct.="2 dict dup /Duplex true put dup /Tumble true put setpagedevice\n" }
else {
$duplexi ||= $::opt_duplex eq 'default-simplex' ? 2 : 1;
$tumblei ||= $::opt_duplex eq 'default-short' ? 1 : 2;
goto do_simplex if $duplexi!=1;
goto do_long if $tumblei!=1;
goto do_short;
}
}
# vvv Dat: save...restore is _always_ necessary to undo the changes made
# by the file itself (??)
# vvv BUGFIX (only EPS) at Tue Feb 8 21:40:11 CET 2005
# vvv Dat: now with PS output it is possible that garbage is left on
# the stack (see the `LMRoman' example above)
$is_restored=1 if $FileFormat eq'EPS' or $FileFormat eq'markedEPS';
$after_comments.=$undefs; # after our precious setpagedevice calls
# debug "pop_count=$pop_count;";
# debug "end_count=$end_count;";
# debug "cut_offset=$cut_offset;";
$after_code.=("pop\n"x$pop_count).("end\n"x$end_count);
if ($cut_offset>=0 and ($bytes_left==-1 or $cut_offset<$bytes_left)) {
$bytes_left=$cut_offset-$already_read;
##print tell(IN)." ar=$already_read\n";
debug "Cutting after showpage at $cut_offset -> $bytes_left";
# ^^^ Dat: cutting after `showpage' makes PS -> EPS conversion easy
# sleep 1000;
}
# Dat: don't unlink $tifn yet, we'll continue scanning it
# Imp: verify EPS created
} else { $headEPSF=" $1" }
SKIP_BBOX_DISC:
if ($::opt_resolution eq 'force-unknown' or $::opt_resolution eq 'unchanged') {}
else { $after_correct.="1 dict dup /HWResolution [@{[split/[x,]/,$::opt_resolution]}] put setpagedevice\n" }
# ^^^ Dat: syntax already ok for $::opt_resolution
$after_correct.="2 dict dup /TextAlphaBits 4 put dup /GraphicsAlphaBits 4 put setpagedevice\n" if
$::opt_antialias eq 'yes' or $::opt_antialias eq 'scale3yes';
$headEPSF="" if $FileFormat ne 'EPS' and $FileFormat ne 'markedEPS';
$headPS=$1 if $header=~s/(PS-Adobe-[.\d]+)$//;
$to_OUT.="%!$headPS$headEPSF\n";
}
debug "Scanning header for BoundingBox";
my $do_atend=0;
my $doing_atend=0;
my $saved_pos;
my $saved_bytes_left;
my $creator_metapost_p=0; # HiResBoundingBox: after EndProlog
my $creator_adobeps_p=0;
my $had_pages=is_page1_stop(); # Dat: don't put `Pages:' to target EPS
my $fontsdefs="";
my %fontsnames;
my @creator;
read_again: while (length($_=readIN)) {
#print STDERR "(($_))\n";
### end of header
next unless /\S/;
y@\r@@d; chomp;
if (!$doing_atend) {
if (/^%%EndComments\b/i) {
# Dat: EPSI created by ImageMagick has BeginDefaults+EndDefaults+BeginPreview
# Dat: PS output by ADOBEPS4.DRV has BeginDefaults+PageBoundingBox+ViewingOrientation+PageFeatures+EndDefaults
1 while length($_=readIN) and !/\S/;
if (!/^%%BeginDefaults\b/i) { y@\r@@d; chomp; $after_comments.="$_\n"; last }
1 while length($_=readIN) and !/\S/;
if (!/^%%EndDefaults\b/i) { y@\r@@d; chomp; $after_comments.="%%BeginDefaults\n$_\n"; last }
next
} elsif (/^%%EndDefaults\b/i) { # EPSI created by ImageMagick
} elsif (/^%%Creator:\s*ADOBEPS/i) { # ADOBEPS4.DRV
# Emits ``%%BoundingBox 1 1 ...' instead of `0 0'
$creator_adobeps_p=1;
} elsif (/^%%Creator:\s*MetaPost\b/i) {
$creator_metapost_p=1;
} elsif ((substr($_,0,2)ne'%%' and substr($_,0,7)ne'%*Font:' and
substr($_,0,5)ne'%ADO_' and !/^%AI\d_/ # Dat: %ADO_DSC_..., %AI7_Thumbnail
and substr($_,0,5)ne'%EPS ') # epsincl.mp
or !$creator_metapost_p and substr($_,0,5)eq'%%End'
or /^%%Begin(?:Prolog|Setup)\b/i
) { $after_comments.="$_\n"; last }
}
if (/^%%BeginPreview\b/i) { # remove EPSI preview ballast ****pts****
while (1) {
error "Missing EPSI %%EndPreview" if !length($_=readIN);
last if /^%%EndPreview\b/;
y@\r@@d; chomp
}
} elsif (/^%%Creator:\s*(.*)/i) {
push @creator, $1;
$creator[-1]=~s@\s+\Z(?!\n)@@;
$creator[-1]=~s@, a2ping .*@@; # remove old
} elsif (/^%%(?:DocumentPaperSizes|PageOrder|DocumentMedia):/i) {
# silently ignore these -- will be recalculated
} elsif (/^%%Pages:\s+(\d+)\s*/i and !$had_pages) { # Not `%%Pages: (atend)'
# Dat: don't `$do_atend=1' only for %%Pages
$to_OUT.="$_\n"; $had_pages=1
} elsif (/^%%Pages:/i) {
# silently ignore these -- not significant for EPS
} elsif (/^$BBregex$BBValues/oi) { ### BoundingBox with values
s@($BBregex)\s*1\s+1\s+@$1 0 0 @ if $creator_adobeps_p;
# vvv $bbtype may be possibly already set by compute-gs
if ($allow_adsc_bb) {
$do_bb_line->($_," from ADSC");
if ($force_hiresbbox_value) {
$do_bb_line->("%%HiResBoundingBox: $force_hiresbbox_value"," from ADSC");
}
}
} elsif (/^$BBregex\s*\(atend\)/oi) {
### BoundingBox with (atend)
debug "At end $1BoundingBox";
# warning "Cannot look for BoundingBox in the trailer with option --filter" if $::opt_filter;
# ^^^ Dat: may be seekable anyway, omit warning
$do_atend=1
} elsif (/^%%Page:/i and !$creator_metapost_p) { # at Thu Sep 25 15:59:52 CEST 2003
$after_comments.="$_\n"; last
} elsif (/^%(?:ADO_DSC_|AI\d_)/) { # Dat: example: %ADO_DSC_Encoding: MacOS Roman
$to_OUT.="%$_\n";
} elsif (/^%\*Font:\s+(\S+)\s+/) { # mpost(1) output
## debug $_;
$fontsdefs.="$_\n"; # put in front (before `gsave ... translate')
$fontsnames{$1}=1;
} elsif (substr($_,0,5) eq '%EPS ') { # epsincl.mp
$after_correct.="$_\n" if !$doing_atend; # before `gsave'
} elsif ($doing_atend or /^%%End/) {
# we might be in mid-line
} else {
$to_OUT.="$_\n"
}
}
if ($doing_atend) { # already read (atend); restore file position
seek(IN, $saved_pos, 0) or error "Input unseekable, cannot go back to line `: (atend)'";
$bytes_left=$saved_bytes_left;
} elsif ($do_atend) { # seek to near EOF and try again
# error "Cannot leave line `: (atend)'" if ($saved_pos=tell IN)<0 or !seek(IN,0,1);
fix_pipe_in "j.ps", $to_OUT, 0;
die if ($saved_pos=tell IN)<0;
$saved_bytes_left=$bytes_left;
# vvv get the very last *BoundingBox entry from the last 4096 bytes
if ($bytes_left>4096) {
die unless seek(IN, $bytes_left-4096, 1);
$bytes_left=4096;
} elsif ($bytes_left<0) {
die unless seek(IN, -4096, 2) or seek(IN, 0,0); # Dat: 0,0 for short files
}
$doing_atend=1; goto read_again;
}
# if (!$had_pages) { debug "Lying %%Pages: 1"; $to_OUT.="%%Pages: 1\n" }
# ^^^ Dat: rather not lie !! go to (atend) if command line
# vvv Dat: $bbtype ne'-' would be a bad idea
warning "BoundingBox not found, try --bboxfrom=compute-gs" if !defined $llx; # !! compute-gs
push @creator, "$program $Htex::a2ping::VERSION"; # if "@creator"!~/\ba2ping\b/;
$to_OUT.="%%Creator: ".join(", ",@creator)."\n"; # before CorrectBoundingBox to be before `gsave' etc.
$to_OUT.=CorrectBoundingBox $llx, $lly, $urx, $ury, $after_correct, $fontsdefs, $is_restored;
$to_OUT.=$after_comments;
if (%fontsnames) { # !! save .. restore
$to_OUT.="{@{[sort keys%fontsnames]}}{\ndup where{pop pop}{cvlit dup def}ifelse}forall\n";
$to_OUT.="/fshow where{pop}{/fshow{exch findfont exch scalefont setfont show}bind def}ifelse\n";
}
}
### open output file or pipe (do this as late as possible)
my $do_scale3_pnm=0;
my $scale3_pnm_fn;
my @pnm2sampled_cmd;
if ($FileFormat eq 'PDF' or $FileFormat eq 'PDF1') {
my $ofn=$ll_zero ? $OutputFilename : fix_pipe_out('.pdf');
my $pipe = "$GS -q -dBATCH -sDEVICE=pdfwrite $GSOPTS -sOutputFile=".fnq($ofn)." -";
debug "Ghostscript ps2pdf pipe:", $pipe;
open(OUT, "| $pipe") or error "Cannot open Ghostscript pipe";
} elsif ($FileFormat eq 'PCL5') {
my $ofn=$do_fix_tumble ? fix_pipe_out('.pcl5') : $OutputFilename;
# vvv ljet4 cannot do duplex, ljet4d can
my $pipe = "$GS -q -dBATCH -sDEVICE=ljet4d $GSOPTS -sOutputFile=".fnq($ofn)." -";
debug "Ghostscript ps2ljet pipe:", $pipe;
open(OUT, "| $pipe") or error "Cannot open Ghostscript pipe";
} elsif ($FileFormat eq 'PBM' or $FileFormat eq 'PGM' or $FileFormat eq 'PPM'
or is_via_sam2p()) {
$do_scale3_pnm=($::opt_antialias eq'scale3no' or $::opt_antialias eq 'scale3yes');
my $device=$FileFormat eq 'PPM' || is_via_sam2p() ? 'ppmraw' :
$FileFormat eq 'PBM' && $::opt_antialias eq 'no' ? 'pbmraw' : 'pgmraw';
# Dat: -sDEVICE=pgm is ASCII, pgmraw is binary
my $pipe ="$GS -q -dBATCH -sDEVICE=$device ";
# $pipe.="-dTextAlphaBits=4 -dGraphicsAlphaBits=4 " if $::opt_antialias; # Dat: already done
my $ofn=$OutputFilename;
if (is_via_sam2p()) {
# Dat: fortunately the following file format names are commin in sam2p(1)
# and a2ping.pl: PNG XWD BMP TIFF JPEG GIF XPM
@pnm2sampled_cmd=('sam2p',"$FileFormat:",'--'); # Imp: use convert(1) if no sam2p(1)
$ofn=fix_force_out('SS.pnm');
push @pnm2sampled_cmd, $ofn, $OutputFilename;
}
if ($do_scale3_pnm) {
$scale3_pnm_fn=$ofn;
$ofn=fix_force_out('S3.pnm') if $do_scale3_pnm;
# ^^^ Dat: this must be the last call to fix_force_out()
}
$pipe.="$GSOPTS -sOutputFile=".fnq($ofn)." -";
debug "Ghostscript ps2raster pipe:", $pipe;
open(OUT, "| $pipe") or error "Cannot open Ghostscript pipe";
} else { open_OUT() }
my $unlink_OutputFilename;
END { unlink $unlink_OutputFilename if defined $unlink_OutputFilename }
$unlink_OutputFilename=$OutputFilename;
die unless binmode OUT;
#die $to_OUT;
# !! remove setpagedevice from EPS->EPS, but keep EPS->PGM
# vvv needed by EPS->PGM conversion !!
if (is_need_showpage() and is_page1_stop()) {
$to_OUT.="/showpage{showpage quit}bind def\n"; # don't call showpage twice
$after_code.="showpage\n";
}
error "write OUT" if !print OUT $to_OUT;
$to_OUT="";
### print rest of file
sub OVERLAP_LENGTH(){4096} # `%%TrailerLength: 1162' by ADOBEPS4.DRV
my $extra_trailer="%%Trailer\n";
##undef $unlink_OutputFilename; die;
{ my $overlap=""; # keeps OVERLAP_LENGTH chars
my $S;
# print OUT while length($_=readIN 4096);
while (length($S=readIN 4096)) { # Dat: 4096>=OVERLAP_LENGTH
#if (length($S)<OVERLAP_LENGTH) { $S="$overlap$S"; $overlap=""; }
#die if length($S)<OVERLAP_LENGTH; # happens sometimes
#print OUT $overlap, substr($S,0,length($S)-OVERLAP_LENGTH());
#$overlap=substr($S,-OVERLAP_LENGTH(),OVERLAP_LENGTH);
next if length($overlap.=$S)<OVERLAP_LENGTH;
print OUT substr($overlap,0,length($overlap)-OVERLAP_LENGTH());
$overlap=substr($overlap,-OVERLAP_LENGTH());
}
if ($overlap=~s@\r?\n%%Trailer\r?\n(.*?)\Z(?!\n)@\n%%Trailer\n@s) {
my $S=$1;
$S=~y@\r@@d;
$S=~s@\n%%TrailerLength:.*$@@m; # ADOBEPS4.DRV
$overlap.=$S;
$extra_trailer="";
}
$overlap=~s@(?:[\n\r\0\f]+%%EOF)?[\n\r\0\f]*\Z(?!\n)@@;
# vvv Dat: would move %%Trailer after dvips output `end userdict /end-hook known{end-hook}if'
# $overlap=~s@(?:[\n\r\0\f]+%%Trailer)?(?:[\n\r\0\f]+%%EOF)?[\n\r\0\f]+\Z(?!\n)@@;
print OUT $overlap;
}
### close files
error "closing IN: $?" unless close IN;
# ^^^ SUXX: gs always exit(0), if exists
# vvv Dat: $after_code is pop+end
print OUT "\n$extra_trailer$after_code",
("grestore\n"x$need_grestore),
("cleartomark restore\n"x$is_restored),
"%%EOF\n";
error "closing gs filter: $? $!" unless close OUT;
# --- PNM scaling routines for --antialias=scale3*
sub pnm_gettok($) {
my ($fh,$S,$C)=($_[0],"");
while (1) {
die "unexpected EOF" if !defined($C=getc($fh));
if ($C eq'#') { <$fh> } # ignore rest of line
elsif ($C=~y@ \n\r\t@@) { last if length($S)!=0 }
else { $S.=$C }
}
$S
}
my @div9=(0,0,0,0,0,map { $_, $_, $_, $_, $_, $_, $_, $_, $_ } 1..255, 255);
#** @param $_[0] length always divisible by 3
sub p5_avg_lines($$$$) {
use integer;
my $len=length($_[0]);
my $olen=$len/3;
while ($len>0) {
vec($_[3],--$olen,8)=$div9[
vec($_[0],$len-1,8)+vec($_[0],$len-2,8)+vec($_[0],$len-3,8)+
vec($_[1],$len-1,8)+vec($_[1],$len-2,8)+vec($_[1],$len-3,8)+
vec($_[2],$len-1,8)+vec($_[2],$len-2,8)+vec($_[2],$len-3,8)];
$len-=3;
}
}
#** @param $_[0] length always divisible by 9
sub p6_avg_lines($$$$) {
# Imp: why is it lighter than: convert -scale '33.3333%' a3.pbm a3r.pgm
use integer;
my $len=length($_[0]);
my $olen=$len/3;
while ($len>0) {
vec($_[3],--$olen,8)=$div9[
vec($_[0],$len-1,8)+vec($_[0],$len-4,8)+vec($_[0],$len-7,8)+
vec($_[1],$len-1,8)+vec($_[1],$len-4,8)+vec($_[1],$len-7,8)+
vec($_[2],$len-1,8)+vec($_[2],$len-4,8)+vec($_[2],$len-7,8)];
$len-=6 if 0==--$len%3;
}
}
# ---
if (!$ll_zero and ($FileFormat eq 'PDF' or $FileFormat eq 'PDF1')) { # correct /MediaBox if not (0,0)-based
### ****pts**** remove incorrect /MediaBox produced by gs
my $tfn=temp_prefix()."p.tgs";
error "temp open $tfn: $!" unless open F, "> $tfn";
$tmpfiles{$tfn}=1;
# vvv Dat: doesn't work with gs 8.53: Error: /undefined in readxrefentry
die unless print F "% this is temporary gs command file created by $program".'
GS_PDF_ProcSet begin
pdfdict begin
FN (r) file pdfopen begin
% vvv keep file offsets, because `pdffindpageref` overrides it with contents
/OFT Objects 0 get dup length array copy def
% vvv Dat: the generation number is assumed to be 0
% vvv Dat: modifies Objects[0]
1 pdffindpageref 0 get
Objects 0 OFT put
%===
%print_xref
{ readxrefentry } stopped { Objects exch lget } if
===
currentdict pdfclose end end end
';
die unless close F;
my $gs2="$GS -dNODISPLAY -dBATCH -sFN=".fnq(fix_pipe_out(undef))." -q ".fnq($tfn);
debug "Ghostscript dup pipe: $gs2";
my $offset=`$gs2`;
#die $offset;
chomp $offset;
temp_unlink $tfn;
if ($offset=~/\A\d+\Z(?!\n)/) {
# Dat: now $offsets is a file position containing our /Page object
die unless open F, "+< ".fix_pipe_out(undef);
die unless binmode F;
die unless seek F, $offset+=0, 0;
my $pageobj;
die unless 32<read F, $pageobj, 4096;
if ($::opt_keepoldmediabox) {
if ($pageobj=~m@\A(.*?/Type\s*/Page\b.*?/MediaBox\s*\[0 0 [^\]]*\].*?)((?:/CropBox\s*\[[^\]]+\]\s*)?/MediaBox\s*\[[^\]]+\])@s) {
substr($pageobj, length($1), length($2))=" "x length($2);
# ^^^ overwrite first buggy /MediaBox definition with spaces
die unless seek F, $offset, 0;
die unless print F $pageobj;
debug "new /MediaBox destroyed.";
} else {
debug "warning: double /MediaBox not found at $offset";
}
} else {
if ($pageobj=~m@\A(.*?/Type\s*/Page\b.*?)(/MediaBox\s*\[0 0 [^\]]*\]).*?/MediaBox\b@s) {
substr($pageobj, length($1), length($2))=" "x length($2);
# ^^^ overwrite first buggy /MediaBox definition with spaces
die unless seek F, $offset, 0;
die unless print F $pageobj;
debug "old /MediaBox destroyed.";
} else {
debug "warning: double /MediaBox not found at $offset";
}
}
die unless close F;
} else {
debug "warning: gs failed to locate double /MediaBox";
}
}
if ($FileFormat eq 'PCL5' and $do_fix_tumble) {
# stupid Ghostscript ignores /Tumble true with -sDEVICE=ljet4
# 2 dict dup /Duplex true /Tumble false put setpagedevice % long HP PCL5e "\033&l1S"
# 2 dict dup /Duplex true /Tumble true put setpagedevice % short HP PCL5e "\033&l2S"
# 2 dict dup /Duplex false /Tumble false put setpagedevice % simplex HP PCL5e "\033&l0S"
# HP PCL5e gs header "\033E\033&l2A\033&l1S\033&l0o0l0E\033&l-180u36Z"
die unless open F, "+< ".fix_pipe_out(undef);
die unless binmode F;
my $pageobj;
die unless 32<read F, $pageobj, 4096;
if ($pageobj=~s@\033&l1S.*@\033&l2S@s) {
die unless seek F, 0, 0;
die unless print F $pageobj;
debug "fixed /Tumble true (short).";
} elsif ($pageobj=~m@\033&l0S@) {
debug "no need to fix to /Tumble.";
} else {
debug "warning: /Duplex /Tumble settings not found"
}
die unless close F;
}
if ($do_scale3_pnm) {
# Imp: scale down the file in place, ovoid early overwrite
# Imp: possibly call an external C program that is faster
debug "Scaling down PNM by 3x3";
die unless open F, "> $scale3_pnm_fn";
die unless binmode F;
die unless open FIN, "< ".fix_pipe_out(undef);
my $hd;
die "PNMraw expected\n" if read(FIN,$hd,2)!=2 or $hd!~/\AP[456]/;
my $wd=pnm_gettok(*FIN); die "width expected\n" if $wd!~/\A(\d+)\Z(?!\n)/;
my $wd3=$hd eq 'P4' ? ($wd+7)>>3 : $hd eq 'P5' ? $wd : $wd*3; # bw/grayscale/RGB
my $ht=pnm_gettok(*FIN); die "height expected\n" if $ht!~/\A(\d+)\Z(?!\n)/;
if ($hd ne 'P4') {
my $mx=pnm_gettok(*FIN); die "max==255 expected, got: $mx\n" if $mx ne '255';
}
$wd+=0; $ht+=0;
{ use integer;
my $phd=($hd eq 'P5' and $FileFormat eq 'PBM') ? "P4 ".(($wd+2)/3)." ".(($ht+2)/3)."\n"
: ($hd eq 'P6' ? 'P6' : 'P5')."\n# reduced-3x3\n".
(($wd+2)/3)." ".(($ht+2)/3)." 255\n";
die if !print F $phd;
}
my($l1,$l2,$l3);
my $ret="";
if ($hd eq 'P4') {
while ($ht>0) {
die "full row expected1\n" if $wd3!=read FIN, $l1, $wd3;
if (--$ht==0) { $l2=$l1 }
else {
die "full row expected2\n" if $wd3!=read FIN, $l2, $wd3;
if (--$ht==0) { $l3=$l2 } # Imp: adjust 2/3 weight
else { $ht--;
die "full row expected3\n" if $wd3!=read FIN, $l3, $wd3;
}
}
$l1=unpack("B$wd",$l1); $l1=~y@10@\000\377@; $l1.=substr($l1,-3+length($l1)%3) if length($l1)%3!=0;
$l2=unpack("B$wd",$l2); $l2=~y@10@\000\377@; $l2.=substr($l2,-3+length($l2)%3) if length($l2)%3!=0;
$l3=unpack("B$wd",$l3); $l3=~y@10@\000\377@; $l3.=substr($l3,-3+length($l3)%3) if length($l3)%3!=0;
p5_avg_lines($l1, $l2, $l3, $ret);
die if !print F $ret;
}
} elsif ($hd eq 'P5') {
while ($ht>0) {
die "full row expected1\n" if $wd3!=read FIN, $l1, $wd3;
$l1.=substr($l1,-3+length($l1)%3) if length($l1)%3!=0;
if (--$ht==0) { $l2=$l1 }
else {
die "full row expected2\n" if $wd3!=read FIN, $l2, $wd3;
$l2.=substr($l2,-3+length($l2)%3) if length($l2)%3!=0;
if (--$ht==0) { $l3=$l2 } # Imp: adjust 2/3 weight
else { $ht--;
die "full row expected3\n" if $wd3!=read FIN, $l3, $wd3;
$l3.=substr($l3,-3+length($l3)%3) if length($l3)%3!=0;
}
}
p5_avg_lines($l1, $l2, $l3, $ret);
if ($FileFormat eq 'PBM') {
my $I=length($ret);
while ($I--) { vec($ret,$I,8)=vec($ret,$I,8)<$::opt_threshold } # [\0\1]
# ^^^ grayscale>=$::opt_threshold will be white
$ret=pack"B".length($ret),$ret;
}
die if !print F $ret;
}
} elsif ($hd eq 'P6') {
while ($ht>0) {
die "full row expected1\n" if $wd3!=read FIN, $l1, $wd3;
$l1.=substr($l1,-9+length($l1)%9) if length($l1)%9!=0;
if (--$ht==0) { $l2=$l1 }
else {
die "full row expected2\n" if $wd3!=read FIN, $l2, $wd3;
$l2.=substr($l2,-9+length($l2)%9) if length($l2)%9!=0;
if (--$ht==0) { $l3=$l2 } # Imp: adjust 2/3 weight
else { $ht--;
die "full row expected3\n" if $wd3!=read FIN, $l3, $wd3;
$l3.=substr($l3,-9+length($l3)%9) if length($l3)%9!=0;
}
}
p6_avg_lines($l1, $l2, $l3, $ret);
die if !print F $ret;
}
}
die unless close F;
temp_unlink $temp_out_fn;
undef $temp_out_fn;
}
if (@pnm2sampled_cmd) { # $scale3_pnm_fn -> $OutputFilename
do_system @pnm2sampled_cmd; # Dat: uses @extra -- really share that?
temp_unlink $scale3_pnm_fn;
} else { # BUGFIX for `a2ping.pl -v --antialias=no negyzet.eps negyzet.png' at Wed Jul 20 21:34:29 CEST 2005
fix_close_out();
}
undef $unlink_OutputFilename;
if ($OutputFilename eq '-') {
debug "Done OK, stdout is $FileFormat"
} elsif (-f $OutputFilename) {
debug "Done OK, created $FileFormat file $OutputFilename (".(-s _)." bytes)";
} else {
error "missing $OutputFilename"
}
just::end __END__
Dat: `=item * foo' is wrong, puts big space between `*' and `foo'
=begin man
.ds pts-dev \*[.T]
.do if '\*[.T]'ascii' .ds pts-dev tty
.do if '\*[.T]'ascii8' .ds pts-dev tty
.do if '\*[.T]'latin1' .ds pts-dev tty
.do if '\*[.T]'nippon' .ds pts-dev tty
.do if '\*[.T]'utf8' .ds pts-dev tty
.do if '\*[.T]'cp1047' .ds pts-dev tty
.do if '\*[pts-dev]'tty' \{\
.ll 79
.pl 33333v
.nr IN 2n
.\}
.ad n
=end
=head1 NAME
a2ping.pl -- convert between PS, EPS and PDF and other page description
formats
=head1 SYNOPSIS
Z<> B<a2ping.pl> [B<-->]B<help>
B<a2ping.pl> [B<-->]B<doc>
B<a2ping.pl> [I<options>] <I<inputfile>> [[I<outformat>:] I<outputfile>]
=head1 DESCRIPTION
B<a2ping> is a UNIX command line utility written in Perl that
converts many raster image and vector graphics formats to EPS or PDF and
other page description formats. Accepted input file formats are: PS
(PostScript), EPS, PDF, PNG, JPEG, TIFF, PNM, BMP, GIF, LBM, XPM, PCX,
TGA. Accepted output formats are: EPS, PCL5, PDF, PDF1, PBM, PGM, PPM,
PS, markedEPS, markedPS, PNG, XWD, BMP, TIFF, JPEG, GIF, XPM.
B<a2ping> delegates the low-level work to
Ghostscript (GS), B<pdftops> and B<sam2p>. B<a2ping> fixes many glitches
during the EPS to EPS conversion, so its output is often more compatible
and better embeddable than its input.
Without the C<--below> option, it is guarenteed to start at the 0,0
coordinate. C<--below>, C<--hires> and C<-v> are recommended options.
The page size is set exactly corresponding to the BoundingBox.
This means that when Ghostscript renders it, the result needs no
cropping, and the PDF MediaBox is correct.
If the bounding box is not right, of course, you have problems. If you
feed crap in, you get crap. But you can supply the
B<--bboxfrom=compute-gs> option to make GS recompute the bounding box.
The name of the input file doesn't matter -- B<a2ping> detects the file
format based on the first few bytes of the file. The name of the output
file matters if I<outformat> is missing from the command line: then the
extension of the output file determines the FileFormat (I<outformat>).
=head1 EXTERNAL PROGRAMS
The internal file format of B<a2ping.pl> is PS/EPS. Everything read is
first converted to PS or EPS, then processed by B<a2ping.pl>, then
converted to the output format.
To analyse the bounding box and other properties of non-EPS PS files
(and EPS files with option B<--bboxfrom> other than B<=guess>), GS is
used. Converting PS to EPS involves this analysis.
To write PDF files, GS is used.
To read PDF files, B<pdftops> from the B<xpdf> package is used.
Sampled input formats are PNG, JPEG, TIFF, PNM, BMP, GIF, LBM, XPM, PCX
and TGA. To read sampled input formats, B<sam2p> is used. B<sam2p> is
a raster image converter written in C++ by the author of B<a2ping.pl>.
Extra output formats are PNG, XWD, BMP, TIFF, JPEG, GIF and XPM. To
write extra output formats, B<sam2p> and GS are used.
PNM output formats are PGM, PGM and PPM. To write PNM output formats, GS
is used.
=head1 TIPS AND TRICKS
=over 2
=item *
Call with the B<-v> option to see progress and debug messages.
=item *
If your EPS contains a wrong bounding box, you can fix it by running
C<a2ping.pl -v --bboxfrom=compute-gs thefile.eps -->
=item *
You can specify B<-> as I<inputfile> to get stdin and as I<outputfile>
to get stdout. This works even for PDF files (which must be seekable),
because B<a2ping> copies them to a temporary file automatically.
=item *
If I<inputfile> and I<outputfile> are the same, B<a2ping> copies the
I<inputfile> to a temporary location first. However, this usage is
recommended only if there is a backup of the file to be restored in case
B<a2ping> doesn't produce the desired result.
=item *
If you specify B<--> as I<outputfile>, it will be the same as I<inputfile>.
=item *
B<a2ping> respects B<--Duplex> for FileFormat PCL5, even though GS doesn't.
=item *
If you have an incompatible PS that GS can read but your printer cannot print,
just run C<a2ping.pl foo.ps PDF: - | a2ping.pl - PS: foo.ps>
=item *
If you have a PS coming from Win32 (often with extension C<.prn>), run
it through B<a2ping>. It will remove the resolution changes and the
progress text printed to the terminal (which confuses gv(1) and makes
some filters in the print queue emit incorrect output).
=item *
B<a2ping> does antialiasing (B<--antialias=scale3no>) of glyphs and
curves when emitting a sampled image (FileFormats such as PGM and PPM).
This improves readability of the glyphs. B<=yes> instructs GS to do
internal antialiasing, but it usually doesn't improve much. B<=scale3no>
turns off GS internal antialiasing, but makes it render everything 3x3
as big, and then scales it back down. B<=scale3no> turns on both 3x3
scaling and GS internal antialiasing, which results in thicker lines and
worse quality in general.
=item *
When creating a PBM file, antialiasing usually doesn't improve the
quality, so it is switched off by default. But if you set
B<--antialias=scale3no> or B<--antialias=scale3yes>, GS will render a PGM file,
and the value of B<--threshold> determines the minimum intensity for white in
the final PBM.
=item *
If you need a bigger sampled output file, specify a larger
B<--Resolution>. The default is B<--Resolution=72>. If your sampled output file
is going to be really big, you should specify B<--AntiAlias=yes> instead of
the default B<--AntiAlias=scale3no> to speed up conversion.
=back
=head1 MISC
=over 2
=item *
Doesn't depend on the filename or extension of the input file.
=item *
Conversion from EPS to PDF: fixes glitches etc., calls gs
-sDEVICE=pdfwrite
=item *
Conversion from EPS to EPS: fixes various glitches, moves (llx,lly) to
(0,0), removes binary junk from the beginning of the EPS etc.
=item *
Conversion from PDF to PDF: keeps the file intact
=item *
Conversion from PDF to EPS: calls pdftops -eps (of the xpdf package)
=item *
Conversion from PS to EPS: keeps 1st page only, removes setpagedevice etc.
=back
=head1 AUTHORS
The author of B<a2ping> is Szabó Péter <F<pts@fazekas.hu>>.
B<a2ping> is inspired by and historically based on the B<epstopdf> Perl
script modified by Thomas Esser, Sept. 1998, but his modifications have
been removed from B<a2ping>, and also B<a2ping> and B<epstopdf> do not
share common code anymore. B<epstopdf> is written by Sebastian Rahtz,
for Elsevier Science. B<epstopdf> contained extra tricks from Hans Hagen's
texutil.
=head1 HISTORY
=head2 1999/05/06 v2.5 (Heiko Oberdiek)
* New options: --hires, --exact, --filter, --help.
* Many cosmetics: title, usage, ...
* New code for debug, warning, error
* Detecting of cygwin perl
* Scanning for %%{Hires,Exact,}BoundingBox.
* Scanning only the header in order not to get a wrong
BoundingBox of an included file.
* (atend) supported.
* uses strict; (earlier error detecting).
* changed first comment from '%!PS' to '%!';
* corrected (atend) pattern: '\s*\(atend\)'
* using of $bbxpat in all BoundingBox cases,
correct the first white space to '...Box:\s*$bb...'
* corrected first line (one line instead of two before 'if 0;';
=head2 2000/11/05 v2.6 (Heiko Oberdiek)
* %%HiresBoundingBox corrected to %%HiResBoundingBox
=head2 2001/03/05 v2.7 (Heiko Oberdiek)
* Newline before grestore for the case that there is no
whitespace at the end of the eps file.
=head2 2003/02/02 (Szabó Péter)
* option --below
* removes DOS EPSF binary junk correctly
* adds all 3 BoundingBox DSC comments
* reads all 3 BoundingBox DSC comments, and picks the best
* forces BoundingBox to be an integer
* adds %%EndComments and proper %!PS-Adobe-?-? EPSF-?.? header
* adds %%Pages:
* adds invocation syntax: a2ping <infile.eps> <outfile.eps|pdf>
* can convert PDF to EPS (by calling pdftops(1)) and PDF to PDF
* emulates work for PDF input
=head2 2003/04/16 (Szabó Péter)
* added PS and sam2p support, renamed to a2ping
* sam2p and pdftops if $InputFilename eq '-';
* remove PJL UEL header from the beginning
* works for PS non-EPS files for input
* input support for PNG JPEG TIFF PNM BMP GIF LBM XPM PCX TGA via sam2p
* removes ^L (form feed) from end of EPS file
* -x=-c:rle to add sam2p options
=head2 2003/04/26 (Szabó Péter)
* omit the unnecessary setpagedevice calls when creating normal eps
* --noverbose --nocompress supported differently
* no more option defaults :-(
* justlib2
* multi-page output with PS:, PDF:, PCL5:
* after `a2ping -pa4', file out.pcl says: `HP PCL printer data - A4 page
size', instead of `US letter'
* justlib2-ified doesn't depend on Getopt::Long anymore
* fully supports filtering (stdin and/or stdout), PDF and PCL5 output to
pipe (!$$ll_zero)
* adds DSC ``%%DocumentMedia: plain 612 792 0 () ()''
* BoundingBox precedence for EPS input: --PageSize, %%*BoundingBox,
setpagedevice. Precedence for other inputs: --PageSize, setpagedevice,
%%*BoundingBox
=head2 2003/09/25 (Szabó Péter)
* --bboxfrom=adsc: %%BoundingBox overrides -sDEVICE=bbox
* improved bbox discovery
* many bugfixes
* MetaPost EPS input fixes for prologues:=0;
* a2ping.pl -v --papersize=50,60 --bboxfrom=compute-gs t.ps t2.ps
* consistent bbox, --PageSize, /PageSize handling
* consistent --Resolution and --Duplex handling
=head2 2003/12/02 (Szabó Péter)
* --bboxfrom=compute-gs option to fix PS -> EPS bbox (gs -sDEVICE=bbox), tuzv.eps
=head2 2004/02/10 v2.77 (Szabó Péter)
* the compute-pipe routine is now run unless --bboxfrom=guess with EPS
* added --gsextra=
* added --antialias=
* added FileFormat PBM, PGM, PPM
* separated FileFormat features to FL_* constants
* added --doc
* there is no default FileFormat (PDF) anymore
|