pstoimg

Waveform Database Software Package 多种心电图文件格式的相互转换代码

fine as they are loaded. This option may not work on every installation
and/or bitmap type, depending of the capabilities of external programs.

=cut

my $INTERLACE = 0; # Do not make interlaced images by default
if($opt{interlaced}) {
  if($opt{type} eq 'gif') {
    print "$prompt: Warning: Interlaced GIFs not supported.\n";
    }
  $INTERLACE=1;
  }

=item B<-margins> I<X>,I<Y>

The offset of the rectangle in the postscript file that is going to be
rendered from top/left. Can be used together with B<-geometry> to further
reduce the size of the intermediate bitmap file generated by Ghostscript.

=cut

if($opt{margins}) {
  die <<"EOF" unless (($opt{margins} =~ /^(\d+),(\d+)$/));
$prompt: Error: Illegal margins specified: "$opt{margins}"
         Margins must be <hmargin>,<vmargin>
EOF
  $PAGE_HMARGIN = $1;
  $PAGE_VMARGIN = $2;
  }

=item B<-multipage>

Process a multi-page PostScript file, i.e. create an individual bitmap
for every page. The resulting files are numbered: The decimal number
(starting with 1) is appended to the basename of the PostScript input
file (or the basename of the filename specified with B<-out>), while
keeping the extension.

=item B<-out> I<file>

The file where to write the bitmap. If multiple PostScript files are
supplied on the command line, this option is ignored. The bitmap type
extension is appended automatically if I<file> does not contain a dot.
In connection with B<-multipage> I<file> is extended by the page number
as shown in this example:

-outfile foo.gif  --------E<gt> foo1.gif, foo2.gif, ...

=cut

if(!$opt{out} && $ENV{OUTFILE}) {
  $opt{out} = $ENV{OUTFILE};
  }

=item B<-quiet>

Do not print anything except error messages.

=item B<-rightjustify> I<num>

Add the appropriate amount of whitespace to the left of the image so that
it appears to be aligned to the right in a total width of I<num> pixels.

=cut

my $RIGHT_JUSTIFY = 0; # No right justifying by default
if($opt{rightjustify}) {
  $RIGHT_JUSTIFY = $opt{rightjustify};
  die <<"EOF" unless ($RIGHT_JUSTIFY =~ /^\d+$/ && $RIGHT_JUSTIFY > 0);
$prompt: Error: Illegal width for -rightjustify specified: "$RIGHT_JUSTIFY"
         Value must be a positive integer.
EOF
  }

=item B<-scale> I<factor>

Scale the image by I<factor>. Valid choices are any numbers greater than
zero. Useful choices are numbers between 0.1 - 5.
Large numbers may generate very large intermediate files and will take
longer to process. If this option is omitted, the environment SCALE is
considered.

=cut

unless($opt{scale}) {
  if($ENV{SCALE}) {
    $opt{scale} = $ENV{SCALE};
    }
  else {
    $opt{scale} = 1;
    }
  }
die <<"EOF" unless ($opt{scale} =~ /^[\d.e]+$/i && $opt{scale} > 0);
$prompt: Error: Illegal scale specified: "$opt{scale}"
         Scale must be nonnegative float value.
EOF

=item B<-shoreup> I<num>[B<d>]

Make height and width of the bitmap(s) an exact multiple of I<num>. If
I<num> is followed by a "d", then half the extra vertical space is placed
underneath. This option is useful, if you want to have "blown-up" images
of high quality for print, but downscale them in HTML using
C<E<lt>IMG WIDTH=x HEIGHT=yE<gt>>. If the actual image is is not an
integer multiple of x,y then browsers tend to display distorted images.

=cut

my $SHORE_UP = 0; # No pixel alignment by default
if($opt{shoreup}) {
  $SHORE_UP = $opt{shoreup};
  die <<"EOF" unless $SHORE_UP =~ /^\d+d?$/i;
$prompt: Error: Illegal shore-up specified: "$SHORE_UP"
         Value must be a positive integer, optionally followed by d
EOF
  }

=item B<-tmp> I<path>

Use I<path> to store temporary files. Defaults to /tmp on this
installation. This parameter can be set by the environment B<TMP> or 
B<TEMP>, too.

=cut

my $TMP = '';
if($opt{tmp}) {
  $opt{tmp} =~ s|\Q$dd\E+$||; # remove trailing directory separator(s)
  if(-d $opt{tmp} && -r _ && -w _) {
    $TMP = $opt{tmp};
  } else {
    print "$prompt: Warning: Cannot use $opt{tmp} as temporary directory.\n";
  }
}
if(!$TMP && ($ENV{TMP} || $ENV{TEMP})) {
  ($opt{tmp} = $ENV{TMP} || $ENV{TEMP}) =~ s|\Q$dd\E+$||;
  if(-d $opt{tmp} && -r _ && -w _) {
    $TMP = $opt{tmp};
  } else {
    print "$prompt: Warning: Cannot use $opt{tmp} as temporary directory.\n";
  }
}
if(!$TMP && -d $def_tmp && -r _ && -w _) {
  $TMP = $def_tmp;
}
print "$prompt: Temporary directory is $TMP\n" if($opt{debug});

=item B<-topjustify> [B<x>]I<num>

Add padding whitespace to the image so that it gets a defined height.
If an integer value is given, it defines the total height. The whitespace
is added at the bottom. If the number is preceded by "x", then this
multiple of the image height is added as whitespace at the bottom.

=cut

my $TOP_JUSTIFY = 0; # No top justifying by default
if($opt{topjustify}) {
  $TOP_JUSTIFY = $opt{topjustify};
  die <<"EOF" unless $TOP_JUSTIFY =~ /^x?\d+[.]?\d*$/i;
$prompt: Error: Illegal align specified: "$TOP_JUSTIFY"
         Value must be positive numeric, optionally preceded by x
EOF
  }

=item B<-transparent>

Generate transparent bitmaps, i.e. the background color (white) is
transparent if viewed with certain viewers (e.g. browsers). This option
may not be available due to missing capabilities of external
programs.

=cut

my $TRANSPARENT = 0; # Do not make make images transparent by default
if($opt{transparent}) {
  $TRANSPARENT = 1;
  }

=item B<-type> I<type>

Instruct pstoimg to render the bitmap in I<type> format. Depending on 
the local installation, pstoimg is capable of generating either GIF or
PNG bitmaps. This site features the following types: png

If omitted, the first type in this list is taken.

=cut

if($opt{type}) {
  $opt{type} = lc($opt{type});
  die <<"EOF" unless grep($_ eq $opt{type},@IMAGE_TYPES);
$prompt: Error: This version of pstoimg does not support
    "$opt{type}" image format.
EOF
  }
else {
  ($opt{type}) = @IMAGE_TYPES; # default image type
  }
# Support -gif and -png for a transition period
if($opt{gif}) {
  print qq{$prompt: Warning: The -gif switch is deprecated. Use "-type gif" instead.\n};
  if(grep($_ eq 'gif',@IMAGE_TYPES)) {
    $opt{type} = 'gif';
    }
  else {
    die <<"EOF";
$prompt: Error: This version of pstoimg does not support "gif" format.
EOF
    }
  }
if($opt{png}) {
  print qq{$prompt: Warning: The -png switch is deprecated. Use "-type png" instead.\n};
  if(grep($_ eq 'png',@IMAGE_TYPES)) {
    $opt{type} = 'png';
    }
  else {
    die <<"EOF";
$prompt: Error: This version of pstoimg does not support "png" format.
EOF
    }
  }

=item B<-white>

Remove TeX's page color information from the PostScript file before 
converting so that a white background is used.

=back

=cut

# do some consistency checks on the options

if($TRANSPARENT && $opt{type} eq 'gif') {
  print "$prompt: Warning: Transparent GIFs not supported.\n";
  }

die <<"EOF" if($RIGHT_JUSTIFY && $CENTER);
$prompt: Error: Conflicting options -center and -rightjustify.
EOF

# now setup some parameters

# calculate dpi resolution from density and scale
$DENSITY = int($opt{scale} * $DENSITY + .5) if($opt{scale} != 1);

my $reduce_color = '';
if($opt{depth} == 1) {
  $reduce_color = "$PPMQUANT 2";
  }
elsif ($opt{depth} == 8) {
  $reduce_color = "$PPMQUANT 256";
  }

my $gs_aalias = '';
if($opt{antialias}) {
  $GSDEVICE = $GSALIASDEVICE;
  if($opt{depth} == 1) { 
    $gs_aalias = '-dTextAlphaBits=4 ';
    $reduce_color = "$PPMQUANT -floyd 256";
    }
  else {
    $gs_aalias = '-dTextAlphaBits=4 -dGraphicsAlphaBits=4 ';
    }
  }
elsif ($opt{aaliastext}) {
  $GSDEVICE = $GSALIASDEVICE;
    $gs_aalias = '-dTextAlphaBits=4 ';
    $reduce_color = "$PPMQUANT -floyd 256";
  }
my $PAPERSIZE = $ENV{PAPERSIZE} || '';
# This rx matches float values in Bounding Box expressions
my $Brx = '-?\d+(?:\.\d*|)';

##############################################################################
# Main program

=head1 DESCRIPTION

B<pstoimg> iterates over the given input files and runs them through
Ghostscipt. The resulting pnm (portable anymap files) are processed
with different Netpbm tools (cropping, color mapping, aligning, ...)
and finally converted into (currently) either GIF or PNG format. The
bitmaps can now be included e.g. in WWW pages.

The PostScript file is converted as is. If a valid bounding box is
found (EPS format), then only this area is converted. The image is
I<not> cropped by default.

=cut

die "$prompt: Error: No input file(s) specified\n"
  unless(@ARGV);

# suppress diagnostics messages if possible
my $NULLFILE = '/dev/null';
open(STDERR, ">$NULLFILE") unless($opt{debug});

my $exit = 0;

$opt{out} = '' if(@ARGV > 1); # disable -out if multiple ps files given

my $psfile;
foreach $psfile (@ARGV) {
  unless (-f $psfile) {
    print qq{$prompt: Error: Cannot find file "$psfile": $!\n};
    exit 1;
  }
  $exit += (&pstoimg($psfile) ? 0 : 1);
}

=head1 RETURN VALUE

=over 4

=item 0

if everything went all right

=item x

(x != 0) something went wrong. See the message output.

=back

=cut

exit $exit ? 1 : 0;

##############################################################################
# Subroutines

sub pstoimg {
  my ($psfile) = @_;

  print "$prompt: Processing $psfile\n" unless($opt{quiet});
  # remove a trailing suffix the same way a shell would do it
  my $base = $psfile;
  $base =~ s|[.][^.$dd$dd]*$||;

  my $outfile;
  if($opt{out}) {
    $outfile = $opt{out};
    # append the type unless -outfile has a "." in it
    $outfile .= ".$opt{type}" unless($outfile =~ /[.]/);
  }
  else {
    $outfile = "$base.$opt{type}";
  }

  # Invoke Ghostscript
  my $pnmdir = $TMP ? "$TMP$dd" : ".$dd";
  my $pnmbase = "p$$"; # keep it short for dos
  my $pnmfile = $pnmdir . 
    ($opt{multipage} ? "%d_${pnmbase}.pnm" : "$pnmbase.pnm");

  ps2pnm($psfile,$pnmfile) || return 0;

  my $ok = 1;
  if (-f $pnmfile) {
    if(crop_scale_etc($pnmfile, $outfile)) {
      L2hos->Unlink($pnmfile) unless($opt{debug});
      }
    else {
      return 0;
      }
    }
  elsif($opt{multipage}) {
    unless(opendir(DIR,$pnmdir)) {
      print qq{$prompt: Error: Could not open directory "$pnmdir": $!\n};
      return 0;
      }
    my @list = grep(/^\d+_\w*\./,readdir(DIR));
    closedir(DIR);
    if(@list) {
      my $i;
      foreach $i (@list) {
        my ($n) = $i =~ /^(\d+)_/;
        my $j = $outfile;
        $j =~ s|(\.[^/.]*)$|$n$1|;
	if(crop_scale_etc("$pnmdir$i", $j)) {
          L2hos->Unlink("$pnmdir$i") unless($opt{debug});
          }
        else {
          $ok = 0;
          }
        }
      }
    else {
      goto not_found;
      }
    }
  else {
    not_found:
    print "$prompt: Error: Couldn't find pnm output of $psfile\n";
    }
  L2hos->Unlink($psfile) if($opt{discard} && !$opt{debug});
  $ok;
  }

sub ps2pnm {
  my ($psfile,$pnmfile) = @_;
  my $gs_size = $PAPERSIZE ? "-sPAPERSIZE=$PAPERSIZE" : '';
  my $gs_density = ($DENSITY != 72) ? "-r$DENSITY" : '';

  my ($bbx, $bby, $bbw, $bbh) = (0,0,0,0);
  my $max_lines = 100;
  my ($epsf,$have_geometry) = (0,0);

  # Parse postscript file for information
  unless(open(PS, "<$psfile")) {
    print qq{$prompt: Error: Cannot read "$psfile": $!};
    return 0;
    }
  $_ = <PS>; # read one line
  if( /^%!.*EPSF/ ) {
    # we're in a EPSF file
    $epsf = 1;
    }
  if($GEOMETRY || $epsf) {
    while (defined ($_ = <PS>)) {
      # Look for bounding box comment
      # MRO: add support of precise bounding boxes
      if ($epsf && (
        /^%+(?:HiRes|Exact)BoundingBox:\s+($Brx)\s+($Brx)\s+($Brx)\s+($Brx)/o ||
        /^\%\%BoundingBox:\s+(-?\d+)\s+(-?\d+)\s+(-?\d+)\s+(-?\d+)/)) {
        $bbx = 0 - $1;    $bby = 0 - $2;
        $bbw = $3 + $bbx; $bbh = $4 + $bby;
        if(($bbw > 0) && ($bbh > 0)) { # we have a valid bounding box
          print "$prompt: EPSF dimensions are ${bbw}x$bbh\n" if($opt{debug});
          # this overrides the -geometry switch
          if($DENSITY) { # scale the output
            my $scale = $DENSITY / 72.0;
            $bbw *= $scale;
            $bbh *= $scale;
          }
          $bbw = int($bbw + 0.99);
          $bbh = int($bbh + 0.99);
          $GEOMETRY = "${bbw}x${bbh}";
          $have_geometry = 1;
          last;
          }
        }
      # Look for page size information
      elsif($GEOMETRY && /TeXDict\s+begin\s+(\d+)\s+(\d+)\s+/) {
        $PAGE_WIDTH  = int($1 / 65536 * 72 /72.27 +.5);
        $PAGE_HEIGHT = int($2 / 65536 * 72 /72.27 +.5);
        print "$prompt: Page dimensions are ${PAGE_WIDTH}x$PAGE_HEIGHT\n"
          if($opt{debug});
        # we don't have to look further for EPSF stuff at this point
        last;
        }
      elsif(!$GEOMETRY && (/^\%\%EndComments/ || --$max_lines == 0)) {
        # abort at a certain point to avoid scanning huge ps files
        last;
        }
      }
    }
  close PS;
  if($GEOMETRY && !$have_geometry) { # RRM: overrides $PAPERSIZE 
    # no geometry info found in the Postscript file
    $bbx = $PAGE_HMARGIN;
    $bby = $PAGE_HEIGHT - $PAGE_VMARGIN;
    unless($GEOMETRY =~ /\s*(\d+)x(\d+)/i) {
      print qq{$prompt: Illegal geometry "$GEOMETRY" specified.\n};
      return 0;
      }
    $bbw = $1 + 10;  # allow for the side-bars
    $bbh = $2;
    $bby = int(-$bby + $bbh + 8); # allow small margin for error
    $bbx = int(-$bbx + 5);        # allow small margin for error
    if($DENSITY) {
      my $scale = $DENSITY / 72.0;
      $bbw = int($scale * $bbw + .99);
      $bbh = int($scale * $bbh + .99);
      }
    $bbw += 10;  # add a 5pt margin for safety
    $bbh += 40;  # add a 20pt margin for safety
    $GEOMETRY = "${bbw}x$bbh";
    $have_geometry = 1;
    }
  if($have_geometry) {
    $gs_size = "-g$GEOMETRY ";
    }

  my $ps_changed = 0;
  if($have_geometry || $opt{white}) {
    # Remove any Postscript commands concerning Papersize if -g switch is used
    # thanks to  Axel Ramge for identifying the problem and for this code
    local($/) = undef;
    open(PS,"<$psfile");
    my $ps = <PS>;
    close(PS);
    my $had_papersize;
    if($have_geometry) {
      $had_papersize = ($ps =~ s/\n%%BeginPaperSize.*?%%EndPaperSize[^\n]*\n/\n/sg);
      }
    my $had_nonwhite;
    if($opt{white}) {
      $had_nonwhite = ($ps =~ s/(\n\d+ \d+ bop gsave) \d*\.\d+ (TeXcolorgray clippath fill grestore)/$1 1 $2/s);
      }
    $ps_changed = $had_papersize || $had_nonwhite;
    if($ps_changed) {
      my $tmppsfile = $pnmfile; # was "tmpps$$.ps"
      $tmppsfile =~ s/\.[^.]*$/.ps/;