home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / XBM.pm < prev    next >
Encoding:
Perl POD Document  |  2004-01-07  |  2.3 KB  |  111 lines
  1. package Image::Info::XBM;
  2. $VERSION = '1.04';
  3. use strict;
  4. use Image::Xbm 1.07;
  5.  
  6. sub process_file{
  7.     my($info, $source, $opts) = @_;
  8.  
  9.     $SIG{__WARN__} = sub {
  10.     $info->push_info(0, "Warn", shift);
  11.     };
  12.  
  13.     my $i = Image::Xbm->new(-file, $source);
  14.  
  15.     $info->push_info(0, "color_type" => "Grey");
  16.     $info->push_info(0, "file_ext" => "xbm");
  17.     $info->push_info(0, "file_media_type" => "image/x-xbitmap");
  18.     $info->push_info(0, "height", $i->get(-height));
  19.     $info->push_info(0, "resolution", "1/1");
  20.     $info->push_info(0, "width", $i->get(-width));
  21.     $info->push_info(0, "BitsPerSample" => 1);
  22.     $info->push_info(0, "SamplesPerPixel", 1);
  23.  
  24.     $info->push_info(0, "ColorTableSize" => 2 );
  25.     if(  $opts->{L1D_Histogram} ){
  26.     #Do Histogram
  27.     my $imgdata = $i->as_binstring();
  28.     $info->push_info(0, "L1D_Histogram", [$imgdata =~ tr/0//d,
  29.                           $imgdata =~ tr/1//d ]);
  30.     }
  31.     $info->push_info(0, "HotSpotX" => $i->get(-hotx) );
  32.     $info->push_info(0, "HotSpotY" => $i->get(-hoty) );
  33. }
  34. 1;
  35. __END__
  36. =pod
  37.  
  38. =head1 NAME
  39.  
  40. Image::Info::XBM - XBM support for Image::Info
  41.  
  42. =head1 SYNOPSIS
  43.  
  44.  use Image::Info qw(image_info dim);
  45.  
  46.  my $info = image_info("image.xbm");
  47.  if (my $error = $info->{error}) {
  48.      die "Can't parse image info: $error\n";
  49.  }
  50.  my $color = $info->{color_type};
  51.  
  52.  my($w, $h) = dim($info);
  53.  
  54. =head1 DESCRIPTION
  55.  
  56. This modules supplies the standard key names
  57. except for Compression, Gamma, Interlace, LastModificationTime, as well as:
  58.  
  59. =over
  60.  
  61. =item HotSpotX
  62.  
  63. The x-coord of the image's hotspot.
  64. Set to -1 if there is no hotspot.
  65.  
  66. =item HotSpotY
  67.  
  68. The y-coord of the image's hotspot.
  69. Set to -1 if there is no hotspot.
  70.  
  71. =item L1D_Histogram
  72.  
  73. Reference to an array representing a one dimensioanl luminance
  74. histogram. This key is only present if C<image_info> is invoked
  75. as C<image_info($file, L1D_Histogram=E<gt>1)>. The range is from 0 to 1.
  76.  
  77. =back
  78.  
  79. =item FILES
  80.  
  81. This module requires L<Image::Xbm>
  82.  
  83. =head1 SEE ALSO
  84.  
  85. L<Image::Info>, L<Image::Xbm>
  86.  
  87. =head1 NOTES
  88.  
  89. For more information about XBM see:
  90.  
  91.  http://www.dcs.ed.ac.uk/home/mxr/gfx/2d/XBM.txt
  92.  
  93. =head1 AUTHOR
  94.  
  95. Jerrad Pierce <belg4mit@mit.edu>/<webmaster@pthbb.org>
  96.  
  97. This library is free software; you can redistribute it and/or
  98. modify it under the same terms as Perl itself.
  99.  
  100. =cut
  101.  
  102. =begin register
  103.  
  104. MAGIC: /^#define\s+/
  105.  
  106. See L<Image::Info::XBM> for details.
  107.  
  108. =end register
  109.  
  110. =cut
  111.