1 eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q'
4 # ==============================================================================
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 # ==============================================================================
12 our $windows_pstoedit = '<chemin vers pstoedit.exe>';
14 our $on_windows = $^O =~ /^MSWin/;
15 our $GS = $on_windows ? "gswin32c" : "gs";
16 our $PS = $on_windows ? $windows_pstoedit : "pstoedit";
19 # === Acquisition des options de la ligne de commande -------------------------
20 $::opt_dimmax = 4; # Dimension maximale : 4 cm par défaut
30 our $Fichier = $ARGV[0];
31 -f $Fichier or die "Fichier <$Fichier> introuvable !\n";
33 our ($Nom, $Dir, $Ext) = &FichierNRE($Fichier);
38 # === Première transformation par pstoedit -------------------------------------
40 my $f = "$Nom-original.$Ext";
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";
47 # === Adaptation du fichier ----------------------------------------------------
49 my $ps = &FichierListe($Fichier);
54 not($p) and /^\%\%Page: 1 1/ and $p = $n;
55 /^\%\%BoundingBox\: ([\d\.-]+) ([\d\.-]+) ([\d\.-]+) ([\d\.-]+)/ and
56 &setBbox($1,$2,$3,$4);
58 my $t = &getTranslate();
60 $$ps[$p] .= "$::opt_dimmax $cm mul $s $t";
61 open PS, "> $Fichier"; print PS join("\n", @$ps); close PS;
63 # === Seconde transformation par pstoedit --------------------------------------
65 my $f = "$Nom-temp.$Ext";
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";
75 # === Acquisition de la BoundingBox --------------------------------------------
79 # === Translation --------------------------------------------------------------
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";
85 # === Échelle ------------------------------------------------------------------
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";
93 # === Contenu d'un fichier et éléments du nom ----------------------------------
94 # ------------------------------------------------------------------------------
95 # Contenu sous forme d'une liste de lignes
98 open(FICH, $f) or die "Le fichier $f est introuvable !\n";
104 # Contenu en un seul élément
105 sub FichierScalaire {
108 open(FICH, $f) or die "Le fichier $f est introuvable !\n";
113 # Nom, Repertoire et Extension d'un fichier
117 my ($n, $r, $e) = fileparse($f,qw{\..*});