home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #20 / NN_1992_20.iso / spool / comp / lang / perl / 5779 < prev    next >
Encoding:
Internet Message Format  |  1992-09-08  |  15.9 KB
  1. Xref: sparky comp.lang.perl:5779 comp.lang.postscript:4628 comp.compression:3225
  2. Path: sparky!uunet!zaphod.mps.ohio-state.edu!not-for-mail
  3. From: parker@shape.mps.ohio-state.edu (Steve Parker)
  4. Newsgroups: comp.lang.perl,comp.lang.postscript,comp.compression
  5. Subject: new postscript compression script in perl
  6. Date: 8 Sep 1992 16:55:08 -0400
  7. Organization: Department of Mathematics, The Ohio State University
  8. Lines: 409
  9. Distribution: world
  10. Message-ID: <18j3vcINN8vu@shape.mps.ohio-state.edu>
  11. NNTP-Posting-Host: shape.mps.ohio-state.edu
  12. Keywords: postscript,compress,perl
  13.  
  14. To Whom It May Concern,
  15.  
  16. NOTE: I posted this message recently with a old reversion of the compression
  17.       script that had errors and didn't work.  This version works!
  18.       My thanks to Mats Lidell, for finding the some of errors.
  19.  
  20. A few months ago I posted a request to the net regarding a postscript
  21. compression routine.  I have since found out that Postscript 2 is to have
  22. it's own standard way to compress images, nevertheless I have written a
  23. postscript image compressor.
  24.  
  25. The postscript compressor I have written is in perl but the form of compression
  26. is run-length encoding, and could be written in other languages, such as C, sed,
  27. awk, nawk, etc. (I am sure that Larry could probably even write the thing in
  28. roff--the man is mutant! ceveat: I am forever in his debt for writting perl.)
  29.  
  30. The most common responce that I received when telling my peers of my plans was
  31. "Why write the thing in postscript?" or "Why write the thing at all?"
  32.  
  33. Everyone knows that the way screen dump/image capture routines output their
  34. results on various architures is straight forward but disk wasteful.  Computer
  35. screen images are not like images from other sources in that they almost always
  36. have huge amounts of repetition, large areas all the same pattern.  And are
  37. therefore very susceptible to run-length-encoding-type compression schemes.
  38.  
  39. The reasons I think that a compression routine written in postscript is valuable
  40. are that the resulting compressed image is still a valid posctscript program,
  41. which can be sent via E-mail without fear of corruption to anyone with a
  42. postscript printer regardless of the machine to which it is connected, and
  43. futhermore can be subsequently compressed with your favorite routine:
  44. compress, pack, zip, zoo, arc, etc.
  45.  
  46. Finally I realize that this is not the most efficient method, but before I work
  47. on enhancing it, I thought that I'd post it.  I would like your input on how to
  48. improve it and I thought that many of you could use it 'as is' to help with
  49. disk space problems (a never-ending problem at our site at least).  I have found
  50. that users mind this form of compression less since it requires no additional
  51. actions to print the file later.
  52.  
  53. If you use this package, I would appreciate timing results/comments/suggestions.
  54. Please E-mail me any posts that you might make concerning this post so that
  55. I will post a summary at a later date:
  56.  
  57.  Steve Parker                    parker@mps.ohio-state.edu
  58.  Dept of Chemistry               201 McPherson Labs
  59.  Ohio State University           614-292-5042
  60.  
  61. I have thought of many ways to improve this script:
  62.  
  63. 1) Record which and how many of the decompression routines were used in a given
  64.    image, and insert only those that were used and in the order of fequency
  65.    that they were used.
  66. 2) Search the unique runs for patterns of 2 4 or 8 characters.
  67. 3) Make a new decompression routine called I for insert which would be used for
  68.    inserting unique string into a long run of repeating characters.
  69.  
  70. NOTE: The above ideas would most easily be accomplished by saving the compressed
  71.       image in memory or a temp file and/or making multiple passes at the image
  72.       data.
  73.  
  74. Any other suggestions?
  75.  
  76. Here are timing results for postscript images created on various machines,
  77. compressed on a Sparc ELC and printed on a AppleLaserWriter II:
  78.  
  79.  
  80. Test cases:
  81.  
  82.                                 (Apple LaserWriter II)
  83. Filename    size in    chars      bits in    time to     approximate time
  84.                                 image    compress     to print
  85. -------------------------------------------------------------------------
  86. snapshot.cmp.ps    63861         ---     67.0 s        100 s
  87. snapshot.ps      262906       1024000        --          245 s
  88. stripes.cmp.ps        2241         ---     31.0 s           30 s
  89. stripes.ps      133403       1036800        --        130 s
  90. iris.cmp.ps       73384            ---     68.5 s          100 s
  91. iris.ps          261385        524288        --        250 s
  92. stellar.cmp.ps      129140         ---     1027.3 s       425 s
  93. stellar.ps     1968436       1966728        --       1740 s
  94.  
  95. I am presently getting results for NeXT printers, and some others.
  96.  
  97. These files are available by E-mail at request to above address.
  98.  
  99. Here is my description of the two pieces necessary for
  100. compression/decompression (I originally had two files but now use the <DATA>
  101. file handle of perl):
  102.  
  103. decomp.header    is the postscript decompression header that will be used in
  104.         place of
  105.         "/picstr 1024 string def
  106.          { currentfile /picstr readhexstring pop }"
  107.         which is often used as the proc for the image function
  108.         ie "width hieght bitpersample proc image"
  109.  
  110. pscmp        is the perl script that compresses the hex digit pair
  111.         format often used to encode a bitmap in postscript, it also
  112.         inserts the decompression header file in a clever way.
  113.         Since the last thing on the stack before the image command
  114.         is called is the procedure that image will use to obtain the 
  115.         image, pscmp looks for the image command and inserts
  116.         pop { decompress }
  117.         before it.  The 'pop' command removes whatever procedure was
  118.         on the stack and then '{ decompress }' (my command) is pushed
  119.         on the stack in it's place.
  120.  
  121.         It does compression with the following four "codes":
  122.         u - one character  follows, whos ascii value  will determine
  123.             how many "unique" hex pairs follow. 1-256   pairs.
  124.         U - two characters follows, whos ascii values will determine
  125.             how many "unique" hex pairs follow. 257-65535 pairs.
  126.         r - one character  follows, whos ascii value  will determine
  127.             how many times to "repeat" the hex pair that follows.
  128.         R - one characters follows, whos ascii values will determine
  129.             how many times to "repeat" the hex pair that follows.
  130. NOTES:
  131.         * ranges for R and U could not be made to be 257-65792,
  132.           without splitting the runs into multiple strings,
  133.           since the largest string is 65335.
  134.         * I attempted two ways of storing the length of unique and
  135.           repeating runs.
  136.           The first and most straight forward to interpret in
  137.           postscipt, was to store them as one or two characters whose
  138.           ascii value was then interpretted as an integer by using the
  139.           'currentfile read pop' sequence.
  140.           The second used two or four digit hex number to represent
  141.           the length of the run, and used the postscript command
  142.           sequence:
  143.  
  144. /charx2  2 string def
  145. /charx4  4 string def
  146. /hexnum2 5 string def
  147. /hexnum4 7 string def
  148. /hexnum2 (16#00) def
  149. /hexnum4 (16#0000) def
  150. /getcount    { hexnum2 3 currentfile charx2 readstring pop
  151.           putinterval hexnum2 cvi } def
  152. /getbigcount    { hexnum4 3 currentfile charx4 readstring pop
  153.           putinterval hexnum4 cvi } def
  154.  
  155.           which works by putting the hex number ,ie. 'fd', in a string
  156.           like '16#00' thus giving the string '16#fd' which the command
  157.           'cvi' interprets as 0xfd, or 253.
  158.  
  159.           The later method was necessary because characters representing
  160.           serial port I/O controls, ie. '^D', '^S/^Q' were interpretted
  161.           by the printers I/O control and not pasted to the postscript
  162.           interpretter.
  163.           The former method did work however with Sun's Postscript
  164.           previewer "pageview version 3"
  165.         * pscmp removes the comments and unnecessary white space (used
  166.           for readability) from decomp.header as it inserts it into the
  167.           postscript.
  168.  
  169. *******************************************************************************
  170. Here is the script:
  171. #!/usr/local/bin/perl
  172. # A perl script to compress postscript images.
  173. #
  174. # codes: u - small count   run of unique hex pairs
  175. #     U - big   count   run of unique hex pairs
  176. #     r - small count+1    repeated   hex pair
  177. #     R - big   count+1    repeated   hex pair
  178. #     a repeat last r or R. NOT SUPPORTED IN THIS PERL SCRIPT.
  179. #
  180. # formats: u cc    'hphp...'
  181. #       U CC CC 'hphp...'
  182. #       r cc    'hp'
  183. #       R CC CC 'hp'
  184. #
  185. # where: 1) spaces are not output
  186. #     2) uUrR are output literally
  187. #     3) cc   is a 2 digit hex number (0-255) and represents range (1-256)
  188. #     4) CCCC is a 4 digit hex number (0-65535) for a range (257-65535)
  189. #        if not for max size on postscript string would be  (257-65792)
  190. #     5) 'hp' is a hex digit pair from 'image' data.
  191.  
  192. $name = $0;
  193. $name =~ s'.*/''; # remove path--like basename
  194. $usage = "usage:\n$name [postscript_file_with_IMAGE_data]";
  195.  
  196. select(STDOUT); $|=1;
  197.  
  198. $biggest=65534;
  199. $last="";
  200. while (<>) {
  201.   if ( /([^A-Fa-f\d\n])/ ) {
  202. #   print "'$1' ->$_";
  203.     if ($_ =~ /showpage/ || $_ =~ /grestore/ ) {
  204. #
  205. # FOUND a showpage or grestore so write out last repeating pair or unique run.
  206. #
  207.       if ($repeating) {
  208.     # we didn't record the first pair in $repeating
  209.     # so we needn't subtract 1.
  210. #$num=$repeating-1;
  211.     $num=$repeating;
  212.         if ( $num <= 255 ) {
  213.           #   case 2 small count repeat unit 2 hex digits.
  214.           printf("r%02X%2s\n",$num,$last);
  215.       $r++;
  216.         } else {
  217.           #   case 3  big  count repeat unit 2 hex digits.
  218.           printf("R%02X%02X%2s\n",int($num/256),($num%256),$last);
  219.       $R++;
  220.         }
  221.       } else {
  222.     $unique_str.=$last;
  223.     # we didn't yet record this last pair in $unique_run
  224.     # so we needn't subtract 1.
  225.     $num=$unique_run;
  226.         if ( $num <= 255 ) {
  227.           # case 0 small count unique string of hex digit pairs.
  228.           printf("u%02X%s",$num,$unique_str);
  229.       $u++;
  230.         } else {
  231.           # case 1  big  count unique string of hex digit pairs.
  232.           printf("\nU%02X%02X%s",int($num/256),($num%256),$unique_str);
  233.       $U++;
  234.         }
  235.       }
  236.       print;
  237.       & end;
  238.     }
  239. # add the postscript decompression header
  240. # inbetween the original proc called by the 'image' command
  241. # and the 'image' command itself
  242.     if ( $_ =~ /^(image\s?.*)$|^([^%]*)?(\simage\s?.*)$/ ) {
  243.       print "$1\n" if ($2);
  244.       if (! $headerin) {
  245. #       $file="/home/sysadmin/postscript/compress/decomp.header";
  246. #       open(HEADER,"$file") || die("$name: Cannot open $file: '$!'\n");
  247.         while (<DATA>) { s/(\s)\s+/\1/g; print if !(/^%/); }
  248.         $headerin++;
  249.         close(DATA);
  250.     print " pop { decompress }\n";
  251.       } else {
  252.     print " pop { decompress }\n";
  253.       }
  254.       if ($2) {
  255.         print "$2\n";
  256.       } else {
  257.         print "$1\n";
  258.       }
  259.       next;
  260.     }
  261.     print;
  262.     next;
  263.   } # else { print "\n" if ($unique_run || $repeating); }
  264. #
  265. #--------------------   HEX PAIR HANDLING LOOP   --------------------------
  266. #
  267.   while (s?([A-F0-9a-f][A-F0-9a-f])??) {
  268.     if ($repeating) {
  269.       if ($1 eq $last) {
  270. #-debug print STDERR "rs"; # repeating; same
  271.         $repeating++;   # found another one.
  272.     # check to see if we have filled biggest postscript string
  273.     # this will kept the decompress in postscript simple and fast.
  274.     if ($repeating eq $biggest) {
  275.       printf("Rfffe%2s",$last);
  276.       # set to start over fresh
  277.       $repeating=0;
  278.       # $unique_str should be set to null and $unique_run set to 0
  279.     }
  280.       } else {
  281. #-debug print STDERR "rd"; # repeating; different
  282. #
  283. # FOUND a unique hex pair so repeating unit has ended, write it out.
  284. #
  285. #$num=$repeating-1;
  286.     $num=$repeating;
  287.         if ( $repeating <= 255 ) {
  288.           #   case 2 small count repeat unit 2 hex digits.
  289. # -line-  $line+=6; if ( $line > 80) { $line=6; print "\n"; }
  290. #-debug   printf STDERR ">2,%2X,%2s ",$num,$last;
  291.           printf("r%02X%2s",$num,$last);
  292.       $r++;
  293.         } else {
  294.           #   case 3  big  count repeat unit 2 hex digits.
  295. # -line-  $line+=8; if ( $line > 80) { $line=8; print "\n"; }
  296. #-debug   printf(">3,%2X,%2X,%2s ",int($num/256),($num%256),$last);
  297.           printf("R%02X%02X%2s",int($num/256),($num%256),$last);
  298.       $R++;
  299.         }
  300.         $repeating=0;
  301.         $last=$1;
  302.       }
  303.  
  304.     } else { # must be unique'ing
  305.  
  306.       if ($1 eq $last) {
  307. #-debug print "us"; # uniquing; same
  308. #
  309. # FOUND a repeating hex pair so might have a unique run
  310. # which has ended, if so write it out.
  311. #
  312.         if ($unique_str) {
  313.       $num=$unique_run-1;
  314.           if ( $num <= 255 ) {
  315.             # case 0 small count unique string of hex digit pairs.
  316. # -line-    $line+=(4+$unique_run)); if ( $line > 80) { $line=4+$unique_run; print "\n"; }
  317. #-debug     printf("\n>0,%2X,'%s' ",$num,$unique_str);
  318.             printf("\nu%02X%s",$num,$unique_str);
  319.         $u++;
  320.           } else {
  321.             # case 1  big  count unique string of hex digit pairs.
  322. # -line-    $line+=(6+$unique_run); if ( $line > 80) { $line=6+$unique_run; print "\n"; }
  323. #-debug     printf("\n>1,%2X,%2X,'%s' ",int($num/256),($num%256),
  324.             printf("\nU%02X%02X%s",int($num/256),($num%256),$unique_str);
  325.         $U++;
  326.           }
  327.         }
  328.         # start counting repeating pairs, reset unique_run count
  329.         # and remember last.
  330.         $repeating++;
  331.         $unique_str='';$unique_run=0;
  332.         $last=$1;
  333.       } else { # countiue uniquing
  334. #-debug print "ud"; # uniquing; different
  335.         $unique_str.=$last;
  336. #       $unique_run+=2; # use this if using $line to limit to 80 chars/line.
  337.                         # but REMEMBER to divid by two when outputing!
  338.         $unique_run++;
  339.     # check to see if we have filled biggest postscript string
  340.     # this will kept the decompress in postscript simple and fast.
  341.     if ($unique_run eq $biggest) {
  342.       printf("Ufffe%s",$unique_str);
  343.       # set to start over fresh
  344.           $unique_str='';$unique_run=0;
  345.           $last=$1;
  346.       # $repeating should be set to 0
  347.     }
  348.         $last=$1;
  349.       }
  350.     }
  351.   }
  352. }
  353. &end;
  354. sub end {
  355.   printf STDERR "Statistics:\n" ;
  356.   printf STDERR "r's:%5d\n",$r ;
  357.   printf STDERR "R's:%5d\n",$R ;
  358.   printf STDERR "u's:%5d\n",$u ;
  359.   printf STDERR "U's:%5d\n",$U ;
  360.   ($user,$system,$cuser,$csystem)=times;
  361.   printf STDERR "Times:\tuser,\tsystem,\tcuser,\tcsystem\n";
  362.   printf STDERR "Times:\t%5f,\t%5f,\t%5f,\t%5f\n",
  363.          $user,$system,$cuser,$csystem;
  364.   exit;
  365.          }
  366. __END__
  367. %-------------------------------------------------------------------------------
  368. %
  369. % header to define 'decompress' which will replace the
  370. % { currentfile string readhexstring pop } proc commonly used with 'image'
  371. %
  372. % to be placed just before the 'image' command
  373. % the 'pop' on the line inserted above is to remove bogus 'proc' (as above)
  374. /repeater 1 string def
  375. /char     1 string def
  376. /charx2   2 string def
  377. /charx4   4 string def
  378. /hexnum2  5 string def
  379. /hexnum4  7 string def
  380. /debug   30 string def
  381. /big  65535 string def
  382. /hexnum2 (16#00)   def
  383. /hexnum4 (16#0000) def
  384. /gethexpair    { currentfile char readhexstring pop } def
  385. /getcount    { hexnum2 3
  386.           currentfile charx2 readstring pop
  387.           putinterval hexnum2 cvi } def
  388. /getbigcount    { hexnum4 3
  389.           currentfile charx4 readstring pop
  390.           putinterval hexnum4 cvi } def
  391. /codeu        { pop /cnt getcount def
  392.                   big 0 1 cnt { gethexpair putinterval big } for
  393.                   0 cnt 1 add getinterval
  394.          } def
  395. /codeU        { pop /cnt getbigcount def
  396.                   big 0 1 cnt { gethexpair putinterval big } for
  397.                   0 cnt 1 add getinterval
  398.          } def
  399. /coder        { pop /cnt getcount    def
  400.           /repeater gethexpair def % get repeater unit
  401.                   big 0 1 cnt {repeater putinterval big} for
  402.           0 cnt 1 add getinterval
  403.         } def
  404. /codeR        { pop /cnt getbigcount def
  405.           /repeater gethexpair def % get repeater unit
  406.                   big 0 1 cnt {repeater putinterval big} for
  407.           0 cnt 1 add getinterval
  408.                 } def
  409. /codeX        { pop big 0 cnt 1 add getinterval } def
  410. /done        { currentfile debug readstring pstack exit } def
  411. /skip        { pop decompress } def
  412. %
  413. % the following order of r,u,R,U was chosen by noting the frequency
  414. % of occurance from a small number of examples but can easily be changed.
  415. /others0    { dup (u)  eq { codeu } { others1 } ifelse } def
  416. /others1    { dup (R)  eq { codeR } { others2 } ifelse } def
  417. /others2    { dup (U)  eq { codeU } { others3 } ifelse } def
  418. /others3    { dup (a)  eq { codeX } { others4 } ifelse } def
  419. /others4    { dup (\n) eq { skip  } {  done   } ifelse } def
  420. /decompress    { currentfile char readstring pop
  421.           dup (r)  eq { coder } { others0 } ifelse } def
  422. %-----------------------------------------------------------------------------
  423.