X-Git-Url: https://melusine.eu.org/syracuse/G/git/?a=blobdiff_plain;f=opt%2Fpsftopst;fp=opt%2Fpsftopst;h=c577a1eb99d7cabeebd9c20147419db36dcd7734;hb=b2262dadfc33a16c396136b8b0aa6f3c8bc34e00;hp=0000000000000000000000000000000000000000;hpb=9b34804c91d3b160ad87009a71d3cc7cb153218f;p=pst-anamorphosis.git diff --git a/opt/psftopst b/opt/psftopst new file mode 100755 index 0000000..c577a1e --- /dev/null +++ b/opt/psftopst @@ -0,0 +1,347 @@ +eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q' + if 0; +use strict; +# ============================================================================== +# psftopst +# 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 = ""; + +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 = ; + 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 = ; + 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 1995-1997 +# Alexandr Ciornii, C<< >> 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 = ; close(SRC); + return &WandaAnalyseLignes($cnf, \@LIGNES); +} + + +