Re: [MacPerl] JPEG question

[Chuck Griffith <griffch@startribune.com>]

At 10:28 PM -0600 12/2/97, <beany@nando.net> wrote:
>Is there a way to tap into QuickTime or something to read a JPEG file and
>determine its dimensions in pixels? Or is a different perl solution in
>order here?  I found the Image::size package in CPAN but I don't
>understand it well enough to make it work with MacPerl... I tried
>extracting the jpegsize subroutine, but I couldn't modify it enough to
>work by itself.
>

This routine was extracted but untested from a tested routine that runs on
Sun Solaris. It was derived from code found at
http://www.tardis.ed.ac.uk/~ark/wwwis/

There are probably docs online somewhere that describe the contents of a
jpeg file but I don't seem to have a reference to them in my bookmarks.

sub readJPEG {
  my($filename) = @_;
  my($done)=0;
  my($c1, $c2, $ch, $junk, $s, $a, $b, $c, $d, $length, $addr);

  open (JPEG, $filename);
  $addr += read(JPEG, $c1, 1); $addr += read(JPEG, $c2, 1);
  if( !((ord($c1) == 0xFF) && (ord($c2) == 0xD8))){
		return ();
  }
  while (ord($ch) != 0xDA && !$done) {
    # Find next marker (JPEG markers begin with 0xFF)
    # This can hang the program!!
    while (ord($ch) != 0xFF) {  $addr += read(JPEG, $ch, 1); }
    # JPEG markers can be padded with unlimited 0xFF's
    while (ord($ch) == 0xFF) { $addr += read(JPEG, $ch, 1); }
    # Now, $ch contains the value of the marker.
    if ((ord($ch) >= 0xC0) && (ord($ch) <= 0xC3)) {
      $addr += read (JPEG, $junk, 3);
      $addr += read(JPEG, $s, 4);
      ($a,$b,$c,$d)=unpack("C"x4,$s);
      $height = $a<<8|$b;
      $width  = $c<<8|$d;
      $done=1;
    } else {
      # We **MUST** skip variables, since FF's within variable names are
      # NOT valid JPEG markers
      $addr += read (JPEG, $s, 2);
      ($c1, $c2) = unpack("C"x2,$s);
      $length = $c1<<8|$c2;
      if( ($length < 2) ){
				return ();
      } else {
        $addr += read(JPEG, $junk, $length-2);
      }
    }
  }
  close (JPEG);
  return $height, $width;
}

------------------------------------------------------------------------
Chuck Griffith
612-673-4105



***** Want to unsubscribe from this list?
***** Send mail with body "unsubscribe" to mac-perl-request@iis.ee.ethz.ch