#!/usr/bin/perl
use v5.18;
use re 'eval';
use autodie; # muere si ocurre un error
use File::Basename; # separa el archivo de entrada
# Constantes
my $tempDir = "."; # temporary directory
my $imageDir = "images"; # where to save the images
my $ignore = "ignore"; # ignore verbatim environment
my $exacount = 1; # Counter for images
my $other = "other"; # otro entorno
#--------------------- Arreglo de la extensión -------------------------
my @SuffixList = ('.tex', '', '.ltx'); # posible extensión
my ($name, $path, $ext) = fileparse($ARGV[0], @SuffixList);
$ext = '.tex' if not $ext;
#---------------- Creamos el directorio para las imágenes --------------
-e $imageDir or mkdir($imageDir,0744) or die "No puedo crear $imageDir: $!\n";
# Constantes
my $BP = '\\\\begin{postscript}';
my $EP = '\\\\end{postscript}';
my $BPL = '\begin{postscript}';
my $EPL = '\end{postscript}';
my $sipgf = 'pgfpicture';
my $nopgf = 'pgfinterruptpicture';
my $graphics = "graphic=\{\[scale=1\]$imageDir/$name-fig";
############################# PARTE 1 ##################################
#--------------------------- Coment Verbatim ---------------------------
#---------------- Creamos un hash con los cambios ----------------------
my %cambios = (
# pspicture
'\pspicture' => '\TRICKS',
'\endpspicture' => '\ENDTRICKS',
# pspicture
'\begin{pspicture' => '\begin{TRICKS',
'\end{pspicture' => '\end{TRICKS',
# postscript
'\begin{postscript}' => '\begin{POSTRICKS}',
'\end{postscript}' => '\end{POSTRICKS}',
# $other
"\\begin\{$other" => '\begin{OTHER',
"\\end\{$other" => '\end{OTHER',
# document
'\begin{document}' => '\begin{DOCTRICKS}',
'\end{document}' => '\end{DOCTRICKS}',
# tikzpicture
'\begin{tikzpicture}' => '\begin{TIKZPICTURE}',
'\end{tikzpicture}' => '\end{TIKZPICTURE}',
# pgfinterruptpicture
'\begin{pgfinterruptpicture'=> '\begin{PGFINTERRUPTPICTURE',
'\end{pgfinterruptpicture' => '\end{PGFINTERRUPTPICTURE',
# pgfpicture
'\begin{pgfpicture}' => '\begin{PGFPICTURE}',
'\end{pgfpicture}' => '\end{PGFPICTURE}',
# ganttchart
'\begin{ganttchart}' => '\begin{GANTTCHART}',
'\end{ganttchart}' => '\end{GANTTCHART}',
# circuitikz
'\begin{circuitikz}' => '\begin{CIRCUITIKZ}',
'\end{circuitikz}' => '\end{CIRCUITIKZ}',
# forest
'\begin{forest}' => '\begin{FOREST}',
'\end{forest}' => '\end{FOREST}',
# tikzcd
'\begin{tikzcd}' => '\begin{TIKZCD}',
'\end{tikzcd}' => '\end{TIKZCD}',
# dependency
'\begin{dependency}' => '\begin{DEPENDENCY}',
'\end{dependency}' => '\end{DEPENDENCY}',
);
#--------------------- Coment Verbatim environment ---------------------
my @lineas;
{
open my $FILE,'<',"$name$ext";
@lineas = <$FILE>;
close $FILE;
}
#------------------------ Verbatim environments ------------------------
my $ENTORNO = qr/(?: (v|V)erbatim\*?| PSTexample | LTXexample| $ignore\*? | PSTcode | tcblisting\*? | spverbatim | minted | lstlisting | alltt | comment\*? | xcomment)/xi;
#
my $DEL;
my $tcbverb = qr/\\(?:tcboxverb|myverb)/;
my $arg_brac = qr/(?:\[.+?\])?/;
my $arg_curl = qr/\{(.+)\}/;
for (@lineas) {
if (/^\\begin\{($ENTORNO)(?{ $DEL = "\Q$^N" })\}/ .. /^\\end\{$DEL\}/) {
while (my($busco, $cambio) = each %cambios) {
s/\Q$busco\E/$cambio/g;
}
} # coment tcolorbox inline
elsif (m/$tcbverb$arg_brac$arg_curl/) {
while (my($busco, $cambio) = each %cambios) {
s/\Q$busco\E/$cambio/g;
}
} # close elsif
}
# Write
open my $SALIDA, '>', "$tempDir/$name-tmp$ext";
print $SALIDA @lineas;
close $SALIDA;
#------------------------ Coment inline Verbatim -----------------------
open my $ENTRADA, '<', "$tempDir/$name-tmp$ext";
my $archivo;
{
local $/;
$archivo = <$ENTRADA>;
}
close $ENTRADA;
## Variables y constantes
my $no_del = "\0";
my $del = $no_del;
## Reglas
my $llaves = qr/\{ .+? \} /x;
my $no_corchete = qr/(?:\[ .+? \])? /x;
my $delimitador = qr/\{ (?<del>.+?) \} /x;
my $verb = qr/(spv|v|V)erb [*]? /ix;
my $lst = qr/lstinline (?!\*) $no_corchete /ix;
my $mint = qr/mint (?!\*) $no_corchete $llaves /ix;
my $marca = qr/\\ (?:$verb | $lst | $mint ) (\S) .+? \g{-1} /x;
my $comentario = qr/^ \s* \%+ .+? $ /mx;
my $definedel = qr/\\ (?: DefineShortVerb | lstMakeShortInline ) $no_corchete $delimitador /ix;
my $indefinedel = qr/\\ (?: UndefineShortVerb | lstDeleteShortInline) $llaves /ix;
while ($archivo =~
/ $marca
| $comentario
| $definedel
| $indefinedel
| $del .+? $del # delimitado
/pgmx) {
my($pos_inicial, $pos_final) = ($-[0], $+[0]); # posiciones
my $encontrado = ${^MATCH}; # lo encontrado
if ($encontrado =~ /$definedel/){ # definimos delimitador
$del = $+{del};
$del = "\Q$+{del}" if substr($del,0,1) ne '\\'; # es necesario "escapar" el delimitador
}
elsif($encontrado =~ /$indefinedel/) { # indefinimos delimitador
$del = $no_del;
}
else { # aquí se hacen los cambios
while (my($busco, $cambio) = each %cambios) {
$encontrado =~ s/\Q$busco\E/$cambio/g; # es necesario escapar $busco
}
substr $archivo, $pos_inicial, $pos_final-$pos_inicial, $encontrado; # insertamos los nuevos cambios
pos($archivo)= $pos_inicial + length $encontrado; # re posicionamos la siguiente búsqueda
}
}
# Write
open my $SALIDA, '>', "$tempDir/$name-tmp$ext";
print $SALIDA "$archivo";
close $SALIDA;
############################# PARTE 2 ##################################
#-------------- Convert pspicture into begin{pspicture} ----------------
open my $ENTRADA, '<', "$tempDir/$name-tmp$ext";
my $archivo;
{
local $/;
$archivo = <$ENTRADA>;
}
close $ENTRADA;
## Partición del documento
my($cabeza,$cuerpo,$final) = $archivo =~ m/\A (.+?) (^\\begin{document} .+)(^\\end{document}.*)\z/msx;
#---------- Convert PStricks into Postscript environments --------------
# \pspicture to \begin{pspicture}
$cuerpo =~ s/\\pspicture(\*)?(.+?)\\endpspicture/\\begin{pspicture$1}$2\\end{pspicture$1}/gmsx;
# $other
$cuerpo =~ s/(\\begin\{$other.*?\}(.+?)\\end\{$other.*?\})/$BPL\n$1\n$EPL/gmsx;
# pspicture to Postscript
$cuerpo =~ s/
(
(?:\\psset\{[^\}]+\}.*?)?
(?:\\begin\{pspicture(\*)?\})
.*?
(?:\\end\{pspicture(\*)?\})
)
/$BPL\n$1\n$EPL/gmsx;
#---------- Convert PGF/TikZ into Postscript environments --------------
# pgfpicture
$cuerpo =~ s/
(
\\begin{$sipgf}
.*?
(
\\begin{$nopgf}
.+?
\\end{$nopgf}
.*?
)*?
\\end{$sipgf}
)
/$BPL\n$1\n$EPL/gmsx;
# tikz
$cuerpo =~ s/
(
(?:\\tikzset(\{(?:\{.*?\}|[^\{])*\}).*?)? # si está lo guardo
(?:\\begin\{tikzpicture\}) # aquí comienza la búsqueda
.*? # guardo el contenido en $1
(?:\\end\{tikzpicture\}) # termina la búsqueda
) # cierra $1
/$BPL\n$1\n$EPL/gmsx;
# forest
$cuerpo =~ s/
(
(?:\\begin\{forest\}) # aquí comienza la búsqueda
.*? # guardo el contenido en $1
(?:\\end\{forest\}) # termina la búsqueda
) # cierra $1
/$BPL\n$1\n$EPL/gmsx;
# tikzcd
$cuerpo =~ s/
(
(?:\\begin\{tikzcd\}) # aquí comienza la búsqueda
.*? # guardo el contenido en $1
(?:\\end\{tikzcd\}) # termina la búsqueda
) # cierra $1
/$BPL\n$1\n$EPL/gmsx;
# tikz-dependency
$cuerpo =~ s/
(
(?:\\begin\{dependency\}) # aquí comienza la búsqueda
.*? # guardo el contenido en $1
(?:\\end\{dependency\}) # termina la búsqueda
) # cierra $1
/$BPL\n$1\n$EPL/gmsx;
# circuitikz
$cuerpo =~ s/
(
(?:\\begin\{circuitikz\}) # aquí comienza la búsqueda
.*? # guardo el contenido en $1
(?:\\end\{circuitikz\}) # termina la búsqueda
) # cierra $1
/$BPL\n$1\n$EPL/gmsx;
# pgfgantt
$cuerpo =~ s/
(
(?:\\begin\{ganttchart\}) # aquí comienza la búsqueda
.*? # guardo el contenido en $1
(?:\\end\{ganttchart\}) # termina la búsqueda
) # cierra $1
/$BPL\n$1\n$EPL/gmsx;
# Eliminar duplicados
$cuerpo =~ s/
$BP # marca que buscamos
.*? # seguido de lo que sea
(?(?=$EP)(*SKIP)) # PERO si encontramos una marca de final, terminamos
\K # vale, si encontramos lo anterior, nos olvidamos de ello
$BP\n # quitar
(.*?) # mantener
$EP\n # quitar
/$1/gmsx;
# Write
open my $SALIDA, '>', "$tempDir/$name-tmp$ext";
print $SALIDA "$cabeza$cuerpo$final";
close $SALIDA;
$cabeza .= <<"EXTRA";
\\newenvironment{postscript}{}{}
\\pagestyle{empty}
EXTRA
# Poner el atributo añadido a PostScript
while ($cuerpo =~ /\\begin\{postscript\}/gsm) {
my $corchetes = $1;
my($pos_inicial, $pos_final) = ($-[1], $+[1]); # posición donde están los corchetes
if (not $corchetes) {
$pos_inicial = $pos_final = $+[0]; # si no hay corchetes, nos ponemos al final de \begin
}
if (not $corchetes or $corchetes =~ /\[\s*\]/) { # si no hay corchetes, o están vacíos,
$corchetes = "[$graphics-$exacount}]"; # ponemos los nuestros
}
substr($cuerpo, $pos_inicial, $pos_final - $pos_inicial) = $corchetes;
pos($cuerpo) = $pos_inicial + length $corchetes; # reposicionamos la búsqueda de la exp. reg.
}
continue {
$exacount++;
}
#------------------- Extract source for image files --------------------
while ($cuerpo =~ /$BP\[.+?(?<img_src_name>$imageDir\/.+?-\d+)\}\](?<code>.+?)(?=^$EP)/gsm) {
open my $SALIDA, '>', "$+{'img_src_name'}$ext";
print $SALIDA <<"EOC";
$cabeza\\begin{document}$+{'code'}\\end{document}
EOC
close $SALIDA;
}
__END__
