+++ /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