#!/usr/bin/perl
# ========================================================================
# 				pgiac
# ========================================================================
# Jean-Michel Sarlat                              mercredi 17 octobre 2007
# ========================================================================
# mail : jm-sarlat@melusine.eu.org
# web  : http://melusine.eu.org/syracuse/giac/pgiac/
# ========================================================================
# Copyright (c) 2007 Jean-Michel Sarlat.  All rights reserved.
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
#  Modifié le 30 mai 2008 pour adapter à  dvips (Guillaume Connan)
#
#
#



use Fcntl;
use POSIX qw(:errno_h);
use File::Basename;

my $VERSION 	= "0.1";  	# Samedi 12 janvier 2008

my $OUT 	= ""; 		# Contenu en sortie.
my $NBFIG 	= 1;		# Compteur de figures.
my $COMPTEUR 	= 0;		# Compteur de commandes.
my $NBCMD 	= 0;		# Nombre de commandes successives traitées.

# --- Caractères utilisés dans le balisage de la sortie de giac avec
# l'option --texmacs.
my $chr2 = chr(2);
my $chr5 = chr(5);
my $prompt = "${chr2}prompt#> $chr5";

my $FIG_TITRE;


my $DEBUG  = 0;

# Commande pour déterminer la BoundingBox d'un fichier EPS via GS.
my $GSBBOX = "gs -q -sDEVICE=bbox -sPAPERSIZE=a4 -dNOPAUSE -dNOSAFER";

open(INSCI,$ARGV[0]) or die "Impossible d'ouvrir $ARGV[0]... : $!";
my $PRE = (fileparse($ARGV[0],qw{\..*}))[0];
open(LOG,">$PRE.out");

# ======================================================================
pipe(INF,OUTP);
pipe(INP,OUTF);



local $fh = select(OUTF); $| = 1; select $fh;
local $fh = select(OUTP); $| = 1; select $fh;


my $PIDP = $$;
my $PIDF = fork();

# === Procédure principale =============================================
unless ($PIDF) {
    sleep 0.5;
    close(INF); close(OUTF);
    # open(STDERR,">pgiac.err");
    open(STDOUT,">&OUTP");
    open(STDIN,"<&INP");
    open(STDERR,">&OUTP");
    select(STDOUT); $| = 1;
    system "giac --texmacs";
    exit;    
} else {
    close(INP); close(OUTP);
    $attributs = '';
    fcntl(INF,F_GETFL,$attributs);
    $attributs |= O_NONBLOCK;
    fcntl(INF,F_SETFL,$attributs) or die "Problème: $!\n";
    &Init;
    while (<INSCI>) {
	chomp($_);
	if ($_ =~ /^\.gp (.*)/) {
	    &LireParametres($1);
	} elsif ($_ =~ /^\.gmp (.*)/) {
	    &Executer($1,"mp");
	} elsif ($_ =~ /^\.g(.*)/) {
	    &Executer($1,"ltx");
	} elsif ($_ =~ /^\.G(.*)/) {
	    my @lignes = qx{cat $1};
	    &Executer(join("",@lignes));
	} elsif ($_ =~ /^\.f\:(.*)/) {
	    &ParametrerFigure($1);
	} elsif ($_ =~ /^\.f(.*)/) {
	    &InclureFigure($1);
	} else {
	    $OUT .= "$_\n";
	}
    }
    &Quitter;
    waitpid($PIDF,0);
}

open(OUTSCI,">$PRE.tex"); print OUTSCI $OUT; close(OUTSCI);


# === GetTaille ========================================================
# Cette procédure scrute le descripteur INF en lecture jusqu'à ce qu'il 
# contienne des données, la taille de ces données est alors retournée.
sub GetTaille {
    my $taille = 0;
    while($taille == 0) {
	sleep 0.02;
	$taille = pack("L",0);
	# La valeur ci-dessous dépend du système, elle doit être calculée
	# pour chaque système (programme fionread extérieur).
	$FIONREAD = 0x00541b;
	ioctl(INF,$FIONREAD,$taille) 
	    or die "Problème (ioctl dans GetTaille) : $!\n";
	$taille = unpack("L",$taille);
    }
    return $taille;
}
# === GetTampon ========================================================
# Récupérer les données dans le descripteur de sortie de giac.
sub GetTampon {
    my $tampon = my $tmp = "";
    while (1) {
	my $t = GetTaille; 
	my $rv = sysread(INF,$tmp,$t);
	$tampon .= $tmp;
	# Fin de tampon pour une utilisation normale.
	$tmp =~ /$prompt$/ and last;
    }
    return $tampon;
}


# === Init =============================================================
# Cette procédure vide le descripteur INF des données transmises au tout
# début de la séquence.
sub Init {
    my $t = GetTampon;
}

# === GetOutGiac =======================================================
# Cette procédure analyse ce qui est récupéré dans le descripteur de 
# sortie de giac. Au début, les procédures d'appui.

sub outCommande {
    my $t = shift;
    return << "eop";
{\\MarqueCommandeGiac{$COMPTEUR} \\verb|$t|}
eop
}
sub outVerbatim {
    my $t = shift;    
    return << "eop";
\\begin{verbatim}
    \t\t$t
\\end{verbatim}
eop
}
sub outLaTeX {
    my $t = shift;
    return << "eop";
{\\MarqueLaTeXGiac{$t}}
eop
}
sub outGraphics {
    my $t = shift;
    return << "eop";
\\InscriptionFigureGiac{$t.eps}    
eop
}
sub GetOutGiac {
    # $c est le texte de la commande, $r est la réponse fournie par giac.
    my ($c,$r) = @_;
    # Incrémentation du compteur des commandes.
    $COMPTEUR++;
    print LOG "Commande $COMPTEUR\n";
    # Segmentation de la réponse (un peu simpliste pour l'instant, cela ne
    # tient pas compte des emboîtements...)
    my @champs = split /$chr2/, $r; shift @champs;
    my %reponse = ();
    foreach (@champs) {
	my($n,$v) = split /:/;
	if ($n eq "ps") {
	    $v = sprintf("$PRE-%02d",$NBFIG);
	    $NBFIG++;
	    rename "casgraph.eps",  "$v.eps";
	}
    	unless ($n =~ /^prompt/) {
	    # Nettoyage
	    $v =~ s/$chr5//g; $v =~ s/^\s*|\s*$//g;
	    # Affectation - La succession ds verbatim reste à règler,
	    # éventuellement...
	    $reponse{$n} = $v;
	    print LOG "$n:\n$v\n";
	}
    }
    # Construction de l'inscription.
    $OUT .= "%\@Commande-$COMPTEUR\n";
    $OUT .= &outCommande($c);
    $reponse{verbatim} and $reponse{verbatim} !~ /^\// 
	and $OUT .= &outVerbatim($reponse{verbatim});
    $reponse{latex}    and $OUT .= &outLaTeX($reponse{latex});
    $reponse{ps}       and $OUT .= &outGraphics($reponse{ps});
}
# === Fin de GetOutGiac ================================================

# === GetOutGiacMetaPost ===============================================
sub GetOutGiacMetaPost {
    my ($c,$r) = @_;
    # On avance d'un pas...
    $OUT .= "%\@Commande-$COMPTEUR\n";
    $OUT .= &outCommande($c);
    $COMPTEUR++;
    # Nettoyage de la réponse. Pour l'instant, suppression des deux
    # première lignes (verbatim) et de la dernière (prompt).
    my @l = split(/\n/,$r); pop @l; shift @l; shift @l;
    # Suppression d'une séquence chr2verbatim: observée en tête de
    # troisième ligne, curieux :)
    $l[0] =~ s/^${chr2}verbatim://;
    # Création du fichier MetaPost.
    open(MP,">giac-temp.mp"); print MP join("\n",@l); close MP;    
    # Compilation...
    qx{mpost giac-temp.mp};
    # Inscription de la réponse dans la sortie.
    if (-f "giac-temp.1") {
	# Transformation au format PDF
	qx{mptopdf giac-temp.1};
	# Renommage des fichiers...
	$v = sprintf("$PRE-%02d",$NBFIG);
	$NBFIG++;
	rename "giac-temp-1.pdf", "$v.pdf";
	rename "giac-temp.mp", "$v.mp";
	rename "giac-temp.1", "$v.1";
	$OUT .= &outGraphics($v);
    } else {
	$OUT .= &outVerbatim("Erreur, l'image n'est pas trouvée !");
    }
}
# === Fin de GetOutGiacMetaPost ========================================

sub Executer {
    my ($t,$a) = @_;
    (my $c = $t) =~ s/^\s+|\s+$//g;
    $DEBUG and print STDERR "envoi: |$c|\n";
    print OUTF "$c\n";
    if ($a eq "mp") {
	GetOutGiacMetaPost($t,GetTampon);
    } else {
	GetOutGiac($t,GetTampon); 
    }
}

### Conversion du fichier $f.eps au format PDF.
sub epstopdf {
    my $f = shift;
    my @b = split /\s+/, qx{$GSBBOX $f.eps quit.ps 2>&1 | grep "%%BoundingBox"};
    shift @b;
    my ($l,$h) = ($b[2] - $b[0], $b[3] - $b[1]); 
    open(PS,">pgiac-$f.ps");
    print PS "<</PageSize [$l $h] >> setpagedevice\n";
    print PS "/sysstroke {systemdict /stroke get exec} def\n";
    print PS "/stroke {.dashpath sysstroke} def\n";
    print PS "$b[0] neg $b[1] neg translate ($f.eps) run\n";
    close(PS);
    qx{ps2pdf14 pgiac-$f.ps $f.pdf };
    unlink "pgiac-$f.ps" if -f "pgiac-$f.ps";
}

sub InclureFigure {
    my $a = shift;
    $a =~ s/^\s+|\s+$//g;
    my @A = split /\s+/, $a;
    my $t = sprintf("$PRE-%03d",$NBFIG);
    $NBFIG++;
    if (-f "pari.ps") {
	rename("pari.ps","$t.ps");
	my $scale = "width=$PARW\\linewidth";
	foreach (@A) {
	    $scale = $_ if $_ =~ /^width\=/;
	}
	# qx{epstopdf $t.ps};
#	epstopdf($t);
	$OUT .= "\\begin{center}\n";
	$OUT .= " \\includegraphics[$scale]{$t.eps}";
	if ($FIG_TITRE ne "") {
	    $OUT .= "\\\\\n {\\small\\bfseries $FIG_TITRE}\n";
	    $FIG_TITRE = "";
	} else {
	    $OUT .= "\n";
	}
	$OUT .= "\\end{center}\n";
    } else {
	print "La figure $t.ps n'est pas créée...\n";
    }
}

sub ParametrerFigure {
    my $t = shift;
    if ($t =~ s/^titre\s+//) {
	$FIG_TITRE = $t;
    }
}

sub Quitter {
    print OUTF "quit\n";
}

# === Lire des paramètres ==============================================
# JMS - Jeudi 24 mai 2007
sub LireParametres {
    my $l = shift;
    $l =~ s/^\s+|\s+$//g;
    $l =~ /([A-Z]+)\s*=\s*\((.*)\)$/;
    if ($1 eq "PARW") {
	$PARW = $2;
    }
    if ($1 eq "BCOMM") {
	$BCOMM = $2;
    }
    if ($1 eq "ILM") {
	$ILM = $2;
    }
    if ($1 eq "LATEX") {
	my $t = $2; $t =~ s/§/\n/g;
	($BLATEX,$ELATEX) = split /\.\.\.\./, $t;
    }
}