eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q' if 0; use strict; # ============================================================================== # epsnorm # Version 1.0 (Dimanche 23 octobre 2011) Jean-Michel Sarlat # Ce script fait partie du projet pst-anamorphosis (Gilg, Luque, Sarlat) # http://melusine.eu.org/syracuse/G/pst-anamorphosis Checkout # http://melusine.eu.org/syracuse/G/git/?p=pst-anamorphosis.git git # ============================================================================== our $windows_pstoedit = 'chemin vers pstoedit.exe'; our $on_windows = $^O =~ /^MSWin/; our $GS = $on_windows ? "gswin32c" : "gs"; our $PS = $on_windows ? $windows_pstoedit : "pstoedit"; # === Acquisition des options de la ligne de commande ------------------------- $::opt_dimmax = 4; # Dimension maximale : 4 cm par défaut use Getopt::Long; GetOptions( "dimmax=s" ); our $debug = 1; our $cm = 28.3464567; our $Fichier = $ARGV[0]; -f $Fichier or die "Fichier <$Fichier> introuvable !\n"; our ($Nom, $Dir, $Ext) = &FichierNRE($Fichier); our @Bbox = (); use File::Copy; # === Première transformation par pstoedit ------------------------------------- { my $f = "$Nom-original.$Ext"; copy($Fichier, $f); my @a = ($PS, "-f", "ps", $f, $Fichier); $debug and print STDERR "Processing by pstoedit (1) ...\n"; system(@a) == 0 or die "Running pstoedit failed\nCommand :".join(" ",@a)."\n"; $debug and print STDERR "Ok!\n"; } # === Adaptation du fichier ---------------------------------------------------- { my $ps = &FichierListe($Fichier); my $n = 0; my $p = 0; foreach (@$ps) { $n++; not($p) and /^\%\%Page: 1 1/ and $p = $n; /^\%\%BoundingBox\: ([\d\.-]+) ([\d\.-]+) ([\d\.-]+) ([\d\.-]+)/ and &setBbox($1,$2,$3,$4); } my $t = &getTranslate(); my $s = &getScale(); $$ps[$p] .= "$::opt_dimmax $cm mul $s $t"; open PS, "> $Fichier"; print PS join("\n", @$ps); close PS; } # === Seconde transformation par pstoedit -------------------------------------- { my $f = "$Nom-temp.$Ext"; copy($Fichier, $f); my @a = ($PS, "-f", "ps", "-noclip", $f, $Fichier); $debug and print STDERR "Processing by pstoedit (2)...\n"; system(@a) == 0 or die "Running pstoedit failed\nCommand :".join(" ",@a)."\n"; $debug and print STDERR "Ok!\n"; unlink $f if -f $f; } # === Acquisition de la BoundingBox -------------------------------------------- sub setBbox { @Bbox = @_; } # === Translation -------------------------------------------------------------- sub getTranslate { my $tx = "$Bbox[2] $Bbox[0] add 2 div neg"; my $ty = "$Bbox[3] $Bbox[1] add 2 div neg"; return "$tx $ty translate"; } # === Échelle ------------------------------------------------------------------ sub getScale { my $lx = $Bbox[2] - $Bbox[0]; my $ly = $Bbox[3] - $Bbox[1]; my $m = $lx; $m = $ly if $ly > $lx; return "$m div dup scale"; } # === Contenu d'un fichier et éléments du nom ---------------------------------- # ------------------------------------------------------------------------------ # Contenu sous forme d'une liste de lignes sub FichierListe { my $f = shift; open(FICH, $f) or die "Le fichier $f est introuvable !\n"; my @l = ; close FICH; chomp @l; return \@l; } # Contenu en un seul élément sub FichierScalaire { my $f = shift; local $/; open(FICH, $f) or die "Le fichier $f est introuvable !\n"; my $c = ; close FICH; return $c; } # Nom, Repertoire et Extension d'un fichier sub FichierNRE { my $f = shift; use File::Basename; my ($n, $r, $e) = fileparse($f,qw{\..*}); $e =~ s/^\.//; return ($n, $r, $e); }