Ajout du script epsnorm.pl et mise à jour de la doc des scripts

[pst-anamorphosis.git] / opt / epsnorm

diff --git a/opt/epsnorm b/opt/epsnorm
new file mode 100755 (executable)
index 0000000..f9f34b0
--- /dev/null
+++ b/opt/epsnorm
@@ -0,0 +1,123 @@
+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 = <FICH>;
+  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 = <FICH>;
+  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);
+}
+
+
+