summaryrefslogtreecommitdiff
path: root/FS/FS/Misc/eps2png.pm
diff options
context:
space:
mode:
Diffstat (limited to 'FS/FS/Misc/eps2png.pm')
-rw-r--r--FS/FS/Misc/eps2png.pm278
1 files changed, 0 insertions, 278 deletions
diff --git a/FS/FS/Misc/eps2png.pm b/FS/FS/Misc/eps2png.pm
deleted file mode 100644
index aa8e572..0000000
--- a/FS/FS/Misc/eps2png.pm
+++ /dev/null
@@ -1,278 +0,0 @@
-package FS::Misc::eps2png;
-
-#based on eps2png by Johan Vromans
-#Copyright 1994,2008 by Johan Vromans.
-#This program is free software; you can redistribute it and/or
-#modify it under the terms of the Perl Artistic License or the
-#GNU General Public License as published by the Free Software
-#Foundation; either version 2 of the License, or (at your option) any
-#later version.
-
-use strict;
-use vars qw( @ISA @EXPORT_OK );
-use Exporter;
-use File::Temp;
-use File::Slurp qw( slurp );
-#use FS::UID;
-
-@ISA = qw( Exporter );
-@EXPORT_OK = qw( eps2png );
-
-################ Program parameters ################
-
-# Some GhostScript programs can produce GIF directly.
-# If not, we need the PBM package for the conversion.
-# NOTE: This will be changed upon install.
-my $use_pbm = 0;
-
-my $res = 82; # default resolution
-my $scale = 1; # default scaling
-my $mono = 0; # produce BW images if non-zero
-my $format; # output format
-my $gs_format; # GS output type
-my $output; # output, defaults to STDOUT
-my $antialias = 4; # antialiasing
-my $DEF_width; # desired widht
-my $DEF_height; # desired height
-#my $DEF_width = 90; # desired widht
-#my $DEF_height = 36; # desired height
-
-my ($verbose,$trace,$test,$debug) = (0,0,0,0);
-#handle_options ();
-set_out_type ('png'); # unless defined $format;
-warn "Producing $format ($gs_format) image.\n" if $verbose;
-
-$trace |= $test | $debug;
-$verbose |= $trace;
-
-################ Presets ################
-
-################ The Process ################
-
-my $err = 0;
-
-sub eps2png {
- my( $eps, %options ) = @_; #well, no options yet
-
- my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
- my $eps_file = new File::Temp( TEMPLATE => 'image.XXXXXXXX',
- DIR => $dir,
- SUFFIX => '.eps',
- #UNLINK => 0,
- ) or die "can't open temp file: $!\n";
- print $eps_file $eps;
- close $eps_file;
-
- my @eps = split(/\r?\n/, $eps);
-
- warn "converting eps (". length($eps). " bytes, ". scalar(@eps). " lines)\n"
- if $verbose;
-
- my $line = shift @eps; #<EPS>;
- unless ( $eps =~ /^%!PS-Adobe.*EPSF-/ ) {
- warn "not EPS file (no %!PS-Adobe header)\n";
- return; #empty png file?
- }
-
- my $ps = ""; # PostScript input data
- my $xscale;
- my $yscale;
- my $gotbb;
-
- # Prevent derived values from propagating.
- my $width = $DEF_width;
- my $height = $DEF_height;
-
- while ( @eps ) {
-
- $line = shift(@eps)."\n";
-
- # Search for BoundingBox.
- if ( $line =~ /^%%BoundingBox:\s*(\S+)\s+(\S+)\s+(\S+)\s+(\S+)/i ) {
- $gotbb++;
- warn "$eps_file: x0=$1, y0=$2, w=", $3-$1, ", h=", $4-$2
- if $verbose;
-
- if ( defined $width ) {
- $res = 72;
- $xscale = $width / ($3 - $1);
- if ( defined $height ) {
- $yscale = $height / ($4 - $2);
- }
- else {
- $yscale = $xscale;
- $height = ($4 - $2) * $yscale;
- }
- }
- elsif ( defined $height ) {
- $res = 72;
- $yscale = $height / ($4 - $2);
- if ( defined $width ) {
- $xscale = $width / ($3 - $1);
- }
- else {
- $xscale = $yscale;
- $width = ($3 - $1) * $xscale;
- }
- }
- unless ( defined $xscale ) {
- $xscale = $yscale = $scale;
- # Calculate actual width.
- $width = $3 - $1;
- $height = $4 - $2;
- # Normal PostScript resolution is 72.
- $width *= $res/72 * $xscale;
- $height *= $res/72 * $yscale;
- # Round up.
- $width = int ($width + 0.5) + 1;
- $height = int ($height + 0.5) + 1;
- }
- warn ", width=$width, height=$height\n" if $verbose;
-
- # Scale.
- $ps .= "$xscale $yscale scale\n"
- if $xscale != 1 || $yscale != 1;
-
- # Create PostScript code to translate coordinates.
- $ps .= (0-$1) . " " . (0-$2) . " translate\n"
- unless $1 == 0 && $2 == 0;
-
- # Include the image, show and quit.
- $ps .= "($eps_file) run\n".
- "showpage\n".
- "quit\n";
-
- last;
- }
- elsif ( $line =~ /^%%EndComments/i ) {
- last;
- }
- }
-
- unless ( $gotbb ) {
- warn "No bounding box in $eps_file\n";
- return;
- }
-
- #it would be better to ask gs to spit out files on stdout, but c'est la vie
-
- #my $out_file; # output file
- #my $pbm_file; # temporary file for PBM conversion
-
- my $out_file = new File::Temp( TEMPLATE => 'image.XXXXXXXX',
- DIR => $dir,
- SUFFIX => '.png',
- #UNLINK => 0,
- ) or die "can't open temp file: $!\n";
-
- my $pbm_file = new File::Temp( TEMPLATE => 'image.XXXXXXXX',
- DIR => $dir,
- SUFFIX => '.pbm',
- #UNLINK => 0,
- ) or die "can't open temp file: $!\n";
-
- # Note the temporary PBM file is created where the output file is
- # located, since that will guarantee accessibility (and a valid
- # filename).
- warn "Creating $out_file\n" if $verbose;
-
- my $gs0 = "gs -q -dNOPAUSE -r$res -g${width}x$height";
- my $gs1 = "-";
- $gs0 .= " -dTextAlphaBits=$antialias -dGraphicsAlphaBits=$antialias"
- if $antialias;
- if ( $format eq 'png' ) {
- mysystem ("$gs0 -sDEVICE=". ($mono ? "pngmono" : $gs_format).
- " -sOutputFile=$out_file $gs1", $ps);
- }
- elsif ( $format eq 'jpg' ) {
- mysystem ("$gs0 -sDEVICE=". ($mono ? "jpeggray" : $gs_format).
- " -sOutputFile=$out_file $gs1", $ps);
- }
- elsif ( $format eq 'gif' ) {
- if ( $use_pbm ) {
- # Convert to PPM and use some of the PBM converters.
- mysystem ("$gs0 -sDEVICE=". ($mono ? "pbm" : "ppm").
- " -sOutputFile=$pbm_file $gs1", $ps);
- # mysystem ("pnmcrop $pbm_file | ppmtogif > $out_file");
- mysystem ("ppmtogif $pbm_file > $out_file");
- unlink ($pbm_file);
- }
- else {
- # GhostScript has GIF drivers built-in.
- mysystem ("$gs0 -sDEVICE=". ($mono ? "gifmono" : "gif8").
- " -sOutputFile=$out_file $gs1", $ps);
- }
- }
- else {
- warn "ASSERT ERROR: Unhandled output type: $format\n";
- exit (1);
- }
-
-# unless ( -s $out_file ) {
-# warn "Problem creating $out_file for $eps_file\n";
-# $err++;
-# }
-
- slurp($out_file);
-
-}
-
-exit 1 if $err;
-
-################ Subroutines ################
-
-sub mysystem {
- my ($cmd, $data) = @_;
- warn "+ $cmd\n" if $trace;
- if ( $data ) {
- if ( $trace ) {
- my $dp = ">> " . $data;
- $dp =~ s/\n(.)/\n>> $1/g;
- warn "$dp";
- }
- open (CMD, "|$cmd") or die ("$cmd: $!\n");
- print CMD $data;
- close CMD or die ("$cmd close: $!\n");
- }
- else {
- system ($cmd);
- }
-}
-
-sub set_out_type {
- my ($opt) = lc (shift (@_));
- if ( $opt =~ /^png(mono|gray|16|256|16m|alpha)?$/ ) {
- $format = 'png';
- $gs_format = $format.(defined $1 ? $1 : '16m');
- }
- elsif ( $opt =~ /^gif(mono)?$/ ) {
- $format = 'gif';
- $gs_format = $format.(defined $1 ? $1 : '');
- }
- elsif ( $opt =~ /^(jpg|jpeg)(gray)?$/ ) {
- $format = 'jpg';
- $gs_format = 'jpeg'.(defined $2 ? $2 : '');
- }
- else {
- warn "ASSERT ERROR: Invalid value to set_out_type: $opt\n";
- exit (1);
- }
-}
-
-# 'antialias|aa=i' => \$antialias,
-# 'noantialias|noaa' => sub { $antialias = 0 },
-# 'scale=f' => \$scale,
-# 'width=i' => \$width,
-# 'height=i' => \$height,
-# 'resolution=i' => \$res,
-
-# die ("Antialias value must be 0, 1, 2, 4, or 8\n")
-
-# -width XXX desired with
-# -height XXX desired height
-# -resolution XXX resolution (default = $res)
-# -scale XXX scaling factor
-# -antialias XX antialias factor (must be 0, 1, 2, 4 or 8; default: 4)
-# -noantialias no antialiasing (same as -antialias 0)
-
-1;
generated by cgit v1.1 at 2024-07-01 17:47:52 +0000