opt/epsnorm

   1 eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q'
   2   if 0;
   3 use strict;
   4 # ==============================================================================
   5 # epsnorm
   6 # Version 1.0 (Dimanche 23 octobre 2011)                      Jean-Michel Sarlat
   7 # Ce script fait partie du projet pst-anamorphosis         (Gilg, Luque, Sarlat)
   8 # http://melusine.eu.org/syracuse/G/pst-anamorphosis                    Checkout
   9 # http://melusine.eu.org/syracuse/G/git/?p=pst-anamorphosis.git              git
  10 # ==============================================================================
  11
  12 our $windows_pstoedit = 'chemin vers pstoedit.exe';
  13
  14 our $on_windows = $^O =~ /^MSWin/;
  15 our $GS = $on_windows ? "gswin32c" : "gs";
  16 our $PS = $on_windows ? $windows_pstoedit : "pstoedit";
  17
  18
  19 # ===  Acquisition des options de la ligne de commande -------------------------
  20 $::opt_dimmax        =  4;                # Dimension maximale : 4 cm par défaut
  21 use Getopt::Long;
  22 GetOptions(
  23     "dimmax=s"
  24 );
  25
  26 our $debug  = 1;
  27
  28 our $cm = 28.3464567;
  29
  30 our $Fichier = $ARGV[0];
  31 -f $Fichier or die "Fichier <$Fichier> introuvable !\n";
  32
  33 our ($Nom, $Dir, $Ext) = &FichierNRE($Fichier);
  34
  35 our @Bbox = ();
  36
  37 use File::Copy;
  38 # === Première transformation par pstoedit -------------------------------------
  39 {
  40   my $f = "$Nom-original.$Ext";
  41   copy($Fichier, $f);
  42   my @a = ($PS, "-f", "ps", $f, $Fichier);
  43   $debug and print STDERR "Processing by pstoedit (1) ...\n";
  44   system(@a) == 0 or die "Running pstoedit failed\nCommand :".join(" ",@a)."\n";
  45   $debug and print STDERR "Ok!\n";
  46 }
  47 # === Adaptation du fichier ----------------------------------------------------
  48 {
  49   my $ps = &FichierListe($Fichier);
  50   my $n  = 0;
  51   my $p  = 0;
  52   foreach (@$ps) {
  53     $n++;
  54     not($p) and /^\%\%Page: 1 1/ and $p = $n;
  55     /^\%\%BoundingBox\: ([\d\.-]+) ([\d\.-]+) ([\d\.-]+) ([\d\.-]+)/ and
  56       &setBbox($1,$2,$3,$4);
  57   }
  58   my $t     = &getTranslate();
  59   my $s     = &getScale();
  60   $$ps[$p] .= "$::opt_dimmax $cm mul $s $t";
  61   open PS, "> $Fichier"; print PS join("\n", @$ps); close PS;
  62 }
  63 # === Seconde transformation par pstoedit --------------------------------------
  64 {
  65   my $f = "$Nom-temp.$Ext";
  66   copy($Fichier, $f);
  67   my @a = ($PS, "-f", "ps", "-noclip", $f, $Fichier);
  68   $debug and print STDERR "Processing by pstoedit (2)...\n";
  69   system(@a) == 0 or die "Running pstoedit failed\nCommand :".join(" ",@a)."\n";
  70   $debug and print STDERR "Ok!\n";
  71   unlink $f if -f $f;
  72 }
  73
  74
  75 # === Acquisition de la BoundingBox --------------------------------------------
  76 sub setBbox {
  77   @Bbox = @_;
  78 }
  79 # === Translation --------------------------------------------------------------
  80 sub getTranslate {
  81   my $tx = "$Bbox[2] $Bbox[0] add 2 div neg";
  82   my $ty = "$Bbox[3] $Bbox[1] add 2 div neg";
  83   return "$tx $ty translate";
  84 }
  85 # === Échelle ------------------------------------------------------------------
  86 sub getScale {
  87   my $lx = $Bbox[2] - $Bbox[0];
  88   my $ly = $Bbox[3] - $Bbox[1];
  89   my $m  = $lx; $m = $ly if $ly > $lx;
  90   return "$m div dup scale";
  91 }
  92
  93 # === Contenu d'un fichier et éléments du nom ----------------------------------
  94 # ------------------------------------------------------------------------------
  95 # Contenu sous forme d'une liste de lignes
  96 sub FichierListe {
  97   my $f = shift;
  98   open(FICH, $f) or die "Le fichier $f est introuvable !\n";
  99   my @l = <FICH>;
 100   close FICH;
 101   chomp @l;
 102   return \@l;
 103 }
 104 # Contenu en un seul élément
 105 sub FichierScalaire {
 106   my $f = shift;
 107   local $/;
 108   open(FICH, $f) or die "Le fichier $f est introuvable !\n";
 109   my $c = <FICH>;
 110   close FICH;
 111   return $c;
 112 }
 113 # Nom, Repertoire et Extension d'un fichier
 114 sub FichierNRE {
 115   my $f = shift;
 116   use File::Basename;
 117   my ($n, $r, $e) = fileparse($f,qw{\..*});
 118   $e =~ s/^\.//;
 119   return ($n, $r, $e);
 120 }
 121
 122
 123