--- /dev/null
+eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q'
+ if 0;
+use strict;
+# ==============================================================================
+# psftopdf
+# Version 1.0 (Mercredi 19 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
+$::opt_t = 0; # Transformation initiale par pstoedit
+use Getopt::Long;
+GetOptions(
+ "dimmax=s",
+ "t"
+);
+
+our $debug = 1;
+
+our $GSBBOX = "$GS -sDEVICE=bbox -dBATCH -dNOPAUSE -dNOSAFER -P -c save pop -f";
+
+our $cm = 28.3464567;
+
+our $Fichier = $ARGV[0];
+-f $Fichier or die "Fichier <$Fichier> introuvable !\n";
+
+our ($Nom, $Dir, $Ext) = &FichierNRE($Fichier);
+
+# === Transformation éventuelle par pstoedit -----------------------------------
+if ($::opt_t) {
+ use File::Copy;
+ my $f = "$Nom-original$Ext";
+ copy($Fichier, $f);
+ my @a = ($PS, "-f ps", $f, $Fichier);
+ $debug and print STDERR "Processing by pstoedit...\n";
+ system(@a) == 0 or die "Running pstoedit failed\nCommand :".join(" ",@a)."\n";
+ $debug and print STDERR "Ok!\n";
+}
+# ==============================================================================
+
+our $ps = &FichierListe($Fichier);
+our $table = [];
+our @Bbox = ();
+
+our $cmyk = {};
+our $centrex = 0;
+our $centrey = 0;
+
+our $facteur = 1;
+our $DimMax = $::opt_dimmax;
+
+our $PageSizeX = 0;
+our $PageSizeY = 0;
+
+our @currentpoint = ();
+our @lastpoint = ();
+our $dmax = 0;
+
+# ==============================================================================
+# === Analyse
+# ==============================================================================
+$$table[0] = {
+ fichier => $Fichier,
+ source => &FichierScalaire($Fichier),
+ createur => "psftopst"
+};
+&LecturePostScript($table, $ps);
+$$table[0]->{bbox} = \@Bbox;
+# ==============================================================================
+# === Production
+# ==============================================================================
+our $pst = &EcritureFichierPST($table, $Nom);
+open PST, ">$Nom.pst" and print PST $pst and close PST;
+# ==============================================================================
+
+sub EcritureFichierPST {
+ my ($r, $n) = @_;
+ my $c = $$r[0]->{cmyk};
+ my $nc = 1;
+ my $out = "%\@PATRON:pstricks\n";
+ $out .= "\\makeatletter\n\\def\\psfs\@asolid{\\pst\@fill{\\pst\@usecolor\\psfillcolor eofill}}\n\\makeatother\n";
+ # Définition des couleurs dans le fichier pstricks
+ # Elles sont reprises dans la table représentant le fichier ps
+ $out .= "%\@COULEURS:\n";
+ foreach (@$c) {
+ my $roman = &Roman($nc);
+ $$cmyk{$_} = "Couleur$roman";
+ s/\s/\,/g;
+ $out .= "\\definecolor{Couleur$roman}{cmyk}{$_}\n";
+ $nc++;
+ }
+ # Acquisition du centre de l'image
+ my $b = $$r[0]->{bbox};
+ $out .= "%\@BOUNDINGBOX: " . join(" ", @$b) . "\n";
+ $centrex = ($$b[2] + $$b[0]) / 2;
+ $centrey = ($$b[3] + $$b[1]) / 2;
+ $out .= "%\@TRANSLATION: -($centrex,$centrey)\n";
+ my $l = ($$b[2] - $$b[0]);
+ my $h = ($$b[3] - $$b[1]);
+ my $max = $l; $max = $h if $h > $l;
+ $facteur = ($DimMax * $cm) / $max;
+ $out .= "%\@FACTEUR: $facteur\n";
+ my $abox = &xy_couple_modifie($b);
+ $out .= "%\@PSPICTURE:\n";
+ $out .= "% \\begin{pspicture}$abox\n";
+ if ($PageSizeX) {
+ my $clipframe = &xy_couple_modifie([0, 0, $PageSizeX, $PageSizeY]);
+ $out .= "%\@CLIPPING: $PageSizeX $PageSizeY\n";
+ $out .= "% \\begin{psclip}{\\psframe[linestyle=none]$clipframe}\n";
+ }
+ $out .= "%\@PICTURE:\n";
+ # Éléments de construction
+ for (my $i = 1; $i < scalar @$r; $i++) {
+ if ($$r[$i]->{path}) {
+ $out .= "%% Path : $i\n";
+ my $couleur = $$cmyk{$$r[$i]->{setcmykcolor}};
+ my $epaisseur = $$r[$i]->{setlinewidth}; $epaisseur = sprintf("linewidth=%0.5fpt", $epaisseur / $facteur);
+ my $t = $$r[$i]->{type};
+ $t eq "fill" and $out .= "\\pscustom[fillstyle=solid,fillcolor=$couleur,linestyle=none]{\n";
+ $t eq "eofill" and $out .= "\\pscustom[fillstyle=asolid,fillcolor=$couleur,linestyle=none]{\n";
+ $t eq "clip" and $out .= "\\psclip{\\psframe[fillstyle=none,linestyle=none]$abox}\%\n\\pscustom{\n";
+ $t eq "stroke" and $out .= "\\pscustom[$epaisseur,linecolor=$couleur]{\n";
+ my $p = $$r[$i]->{path};
+ my $n = $$r[$i]->{closepath};
+ foreach (@$p) {
+ my %e = %$_;
+ $e{t} eq "moveto" and $out .= "\\moveto".&xy_couple_modifie($e{p});
+ $e{t} eq "lineto" and $out .= "\\psline".&xy_couple_modifie($e{p});
+ $e{t} eq "curveto" and $out .= "\\psbezier".&xy_couple_modifie($e{p});
+ $e{t} eq "closepath" and $out .= "\\closepath";
+ $out .= "\n";
+ @lastpoint = @currentpoint;
+ }
+ $out .= "}\n";
+ $$r[$i]->{type} eq "clip" and $out .= "\\endpsclip\n";
+ }
+ }
+ $out .= "%\@---\n";
+ $out .= "% \\end{psclip}\n" if $PageSizeX;
+ $out .= "% \\end{pspicture}\n";
+}
+
+
+sub LecturePostScript {
+ my ($t, $p) = @_;
+ my $pathnumber = 0;
+ my $natpath = "";
+ my $path = [];
+ my $fpath = 0;
+ my $niveau = 0;
+ my $nclosepath = 0; # Nombre de closepath rencontrés
+ foreach (@$p) {
+ /^\%\s*(\d+)\s+pathnumber/ and $pathnumber = $1 and $$t[$pathnumber] = {};
+ /^\s*gsave/ and $niveau++;
+ /^\s*grestore/ and $niveau--;
+ s/setPageSize\s*$// and &setPageSize($_);
+ /^\%\%BoundingBox\: ([\d\.-]+) ([\d\.-]+) ([\d\.-]+) ([\d\.-]+)/ and &setBbox($1,$2,$3,$4);
+ if ($pathnumber) {
+ /^\%\s*filledpath/ and $natpath = "filledpath" and next;
+ /^\%\s*eofilledpath/ and $natpath = "eofilledpath" and next;
+ /^\%\s*strokedpath/ and $natpath = "strokedpath" and next;
+ /^\%\s*clippath/ and $natpath = "clippath" and next;
+ /setlinewidth$/ and $$t[$pathnumber]->{setlinewidth} = &setlinewidth($_) and next;
+ /setcmykcolor$/ and $$t[$pathnumber]->{setcmykcolor} = &setcmykcolor($_) and next;
+ /^newpath/ and $fpath = 1 and $path = [] and next;
+ if ($fpath) {
+ s/moveto\s*$// and push(@$path, {t => "moveto", p => &xy($_)});
+ s/lineto\s*$// and push(@$path, {t => "lineto", p => &xy($_)});
+ s/curveto\s*$// and push(@$path, {t => "curveto", p => &xy($_)});
+ /closepath/ and push(@$path, {t => "closepath", p => 1}) and $nclosepath++;
+ if (/(stroke)/ or /(eofill)/ or /(fill)/ or /(clip)/) {
+ $fpath = 0;
+ $$t[$pathnumber]->{path} = $path;
+ $$t[$pathnumber]->{type} = $1;
+ $$t[$pathnumber]->{niveau} = $niveau;
+ $$t[$pathnumber]->{closepath} = $nclosepath;
+ $pathnumber = 0;
+ $nclosepath = 0;
+ }
+ }
+ }
+ }
+ $$t[0]->{cmyk} = [];
+ foreach (keys %$cmyk) {
+ push @{$$t[0]->{cmyk}}, $_;
+ }
+}
+
+sub setPageSize {
+ my $s = shift;
+ $s =~ s/^\s*|\s*$//g;
+ ($PageSizeX, $PageSizeY) = split /\s+/, $s;
+}
+
+sub setlinewidth {
+ my $s = shift;
+ $s =~ s/^\s*|\s+setlinewidth$//g;
+ return $s;
+}
+
+sub setcmykcolor {
+ my $s = shift;
+ $s =~ s/^\s*|\s+setcmykcolor$//g;
+ $$cmyk{$s} = 1;
+ return $s;
+}
+
+sub xy {
+ my $s = shift;
+ $s =~ s/^\s*|\s*$//g;
+ my @xy = split /\s+/, $s;
+ return \@xy;
+}
+
+sub xy_couple_modifie {
+ my $xy = shift;
+ my @l = @$xy; @currentpoint = ($l[-2],$l[-1]);
+ my $s = "";
+ while (my ($x, $y) = splice(@l, 0, 2)) {
+ $s .= sprintf("(%0.8f,%0.8f)", ($x - $centrex) * $facteur, ($y - $centrey) * $facteur);
+ }
+ return $s;
+}
+
+# === 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);
+}
+# === Acquisition de la BoundingBox --------------------------------------------
+sub setBbox {
+ @Bbox = @_;
+}
+
+# === Écriture d'un nombre en chiffres romains ---------------------------------
+# Code emprunté au module Roman.pm ; http://search.cpan.org/dist/Roman
+# AUTEURS:
+# OZAWA Sakuro <ozawa at aisoft.co.jp> 1995-1997
+# Alexandr Ciornii, C<< <alexchorny at gmail.com> >> 2007
+# ------------------------------------------------------------------------------
+sub Roman {
+ my $arg = shift;
+ 0 < $arg and $arg < 4000 or return undef;
+ my %roman_digit = qw(1 IV 10 XL 100 CD 1000 MMMMMM);
+ my @figure = reverse sort keys %roman_digit;
+ $roman_digit{$_} = [split(//, $roman_digit{$_}, 2)] foreach @figure;
+ my($x, $roman);
+ foreach (@figure) {
+ my($digit, $i, $v) = (int($arg / $_), @{$roman_digit{$_}});
+ if (1 <= $digit and $digit <= 3) {
+ $roman .= $i x $digit;
+ } elsif ($digit == 4) {
+ $roman .= "$i$v";
+ } elsif ($digit == 5) {
+ $roman .= $v;
+ } elsif (6 <= $digit and $digit <= 8) {
+ $roman .= $v . $i x ($digit - 5);
+ } elsif ($digit == 9) {
+ $roman .= "$i$x";
+ }
+ $arg -= $digit * $_;
+ $x = $i;
+ }
+ return $roman;
+}
+# === Wanda --------------------------------------------------------------------
+sub WandaExecutePlugin {
+ my ($cnf, $elm, $args) = @_;
+}
+sub WandaAnalyseLignes {
+ my $cnf = shift;
+ my $l = shift;
+ my $c = {};
+ my $e = "CORPS";
+ my @p = ();
+ # Traitement
+ for(my $i=0; $i < scalar @$l; $i++) {
+ if ($$l[$i] =~ /^%@([\da-zA-Z_]+)\s*:\s*(.+?)\s*$/) {
+ # Affectation simple : la valeur suit le nom dans la ligne -----
+ $$c{$1} = $2;
+ } elsif ($$l[$i] =~ /^%@([\da-zA-Z_]+)\s*:\s*$/) {
+ # Affectation bloc : la valeur est constituée du bloc à suivre -
+ push @p, $e; $e = $1;
+ } elsif ($$l[$i] =~ /^%@\-\-\-/) {
+ # On ferme l'élément en cours... -------------------------------
+ $e = pop @p;
+ } elsif ($$l[$i] =~ /^%@\@lib:\s*(.+?)\s+$/) {
+ # On ajoute le contenu d'un fichier de la librairie ------------
+ if (-f "$$cnf{DIR}/lib/$1") {
+ $$c{$e} .= qx{cat "$$cnf{DIR}/lib/$1"} if $e;
+ }
+ } elsif ($$l[$i] =~ /^%@\@inc:\s*(.+?)\s+$/) {
+ # On ajoute le contenu d'un fichier local ----------------------
+ if (-f $1) {
+ $$c{$e} .= qx{cat $1} if $e;
+ }
+ } elsif ($$l[$i] =~ /^%@\@exec:\s*(.+?)\s+$/) {
+ # On éxécute un plugin -----------------------------------------
+ $$c{$e} .= &WandaExecutePlugin($cnf, $c, $1);
+ } else {
+ # La ligne est enregistrée dans l'éventuel élément en cours ----
+ $$c{$e} .= $$l[$i] if $e;
+ }
+ }
+ return $c;
+}
+sub WandaAnalyseContenu {
+ my ($cnf, $fichier) = @_;
+ open(SRC, $fichier); my @LIGNES = <SRC>; close(SRC);
+ return &WandaAnalyseLignes($cnf, \@LIGNES);
+}
+
+
+
Projets / pst-anamorphosis.git / blobdiff
Les fichiers de Syracuse sont mis à
disposition (sauf mention contraire) selon les termes de la