/*
================================================================================
  RPL/2 (R) version 4.0.18
  Copyright (C) 1989-2010 Dr. BERTRAND Joël

  This file is part of RPL/2.

  RPL/2 is free software; you can redistribute it and/or modify it
  under the terms of the CeCILL V2 License as published by the french
  CEA, CNRS and INRIA.
 
  RPL/2 is distributed in the hope that it will be useful, but WITHOUT
  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  FITNESS FOR A PARTICULAR PURPOSE.  See the CeCILL V2 License
  for more details.
 
  You should have received a copy of the CeCILL License
  along with RPL/2. If not, write to info@cecill.info.
================================================================================
*/


#include "rpl.conv.h"


/*
================================================================================
  Fonction 'sdev'
================================================================================
  Entrées :
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_sdev(struct_processus *s_etat_processus)
{
	logical1							presence_variable;

	long								i;

	struct_objet						*s_objet_statistique;
	struct_objet						*s_objet_resultat;
	struct_objet						*s_objet_temporaire;

	unsigned long						nombre_colonnes;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  SDEV ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(écart-type)\n\n");
		}
		else
		{
			printf("(standard deviation)\n\n");
		}

		printf("->  1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}

	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
		{
			return;
		}
	}

	/*
	 * Recherche d'une variable globale référencée par SIGMA
	 */

	if (recherche_variable(s_etat_processus, ds_sdat) == d_faux)
	{
		/*
		 * Aucune variable SIGMA
		 */

		(*s_etat_processus).erreur_systeme = d_es;
		(*s_etat_processus).erreur_execution = d_ex_absence_observations;
		return;
	}
	else
	{
		/*
		 * Il existe une variable locale SIGMA. Reste à vérifier l'existence
		 * d'une variable SIGMA globale...
		 */

		i = (*s_etat_processus).position_variable_courante;
		presence_variable = d_faux;

		while(i >= 0)
		{
			if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,
					ds_sdat) == 0) && ((*s_etat_processus)
					.s_liste_variables[i].niveau == 1))
			{
				presence_variable = d_vrai;
				break;
			}

			i--;
		}

		if (presence_variable == d_faux)
		{
			(*s_etat_processus).erreur_execution = d_ex_absence_observations;
			return;
		}
		else
		{
			(*s_etat_processus).position_variable_courante = i;

			if ((*s_etat_processus).s_liste_variables[i].objet == NULL)
			{
				(*s_etat_processus).erreur_execution = d_ex_variable_partagee;
				return;
			}

			if (((*((*s_etat_processus).s_liste_variables
					[(*s_etat_processus).position_variable_courante].objet))
					.type != MIN) && ((*((*s_etat_processus)
					.s_liste_variables[(*s_etat_processus)
					.position_variable_courante].objet)).type != MRL))
			{
				(*s_etat_processus).erreur_execution =
						d_ex_matrice_statistique_invalide;
				return;
			}

			nombre_colonnes = (*((struct_matrice *) (*((*s_etat_processus)
					.s_liste_variables[(*s_etat_processus)
					.position_variable_courante].objet)).objet))
					.nombre_colonnes;
		}
	}

	s_objet_statistique = ((*s_etat_processus).s_liste_variables
			[(*s_etat_processus).position_variable_courante]).objet;

	if (((*s_objet_statistique).type == MIN) ||
			((*s_objet_statistique).type == MRL))
	{
		if ((*((struct_matrice *) (*s_objet_statistique).objet)).nombre_lignes
				<= 1)
		{
			(*s_etat_processus).erreur_execution =
					d_ex_statistiques_echantillon;
			return;
		}

		if ((s_objet_resultat = allocation(s_etat_processus, NON)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		if (((*s_objet_resultat).objet = ecart_type_statistique(
				(struct_matrice *) (*s_objet_statistique).objet, 'E')) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		if (nombre_colonnes == 1)
		{
			if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
			{
				(*s_objet_resultat).type = VIN;
				s_objet_temporaire = s_objet_resultat;

				if ((s_objet_resultat = allocation(s_etat_processus, INT))
						== NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				(*((integer8 *) (*s_objet_resultat).objet)) =
						((integer8 *) (*((struct_vecteur *)
						(*s_objet_temporaire).objet)).tableau)[0];

				liberation(s_etat_processus, s_objet_temporaire);
			}
			else
			{
				(*s_objet_resultat).type = VRL;
				s_objet_temporaire = s_objet_resultat;

				if ((s_objet_resultat = allocation(s_etat_processus, REL))
						== NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				(*((real8 *) (*s_objet_resultat).objet)) =
						((real8 *) (*((struct_vecteur *)
						(*s_objet_temporaire).objet)).tableau)[0];

				liberation(s_etat_processus, s_objet_temporaire);
			}
		}
		else
		{
			if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
			{
				(*s_objet_resultat).type = VIN;
			}
			else
			{
				(*s_objet_resultat).type = VRL;
			}
		}

		if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
				s_objet_resultat) == d_erreur)
		{
			return;
		}
	}
	else
	{
		(*s_etat_processus).erreur_execution =
				d_ex_matrice_statistique_invalide;
		return;
	}

	return;
}


/*
================================================================================
  Fonction 'schur'
================================================================================
  Entrées :
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_schur(struct_processus *s_etat_processus)
{
	struct_matrice				*s_matrice;

	struct_objet				*s_copie_argument;
	struct_objet				*s_objet_argument;
	struct_objet				*s_objet_resultat;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  SCHUR ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(décomposition de Schur)\n\n");
		}
		else
		{
			printf("(Schur decomposition)\n\n");
		}

		printf("    1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
		printf("->  2: %s, %s\n", d_MRL, d_MCX);
		printf("    1: %s, %s\n", d_MRL, d_MCX);

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}

	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
		{
			return;
		}
	}

	if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
			&s_objet_argument) == d_erreur)
	{
		(*s_etat_processus).erreur_execution = d_ex_manque_argument;
		return;
	}

/*
--------------------------------------------------------------------------------
  Décomposition de Schur réelle
--------------------------------------------------------------------------------
*/

	if (((*s_objet_argument).type == MIN) ||
			((*s_objet_argument).type == MRL))
	{
		if ((s_copie_argument = copie_objet(s_etat_processus,
				s_objet_argument, 'Q')) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		liberation(s_etat_processus, s_objet_argument);
		s_objet_argument = s_copie_argument;

		if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
				(*((struct_matrice *) (*s_objet_argument).objet))
				.nombre_colonnes)
		{
			liberation(s_etat_processus, s_objet_argument);

			(*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
			return;
		}

		if ((s_matrice = malloc(sizeof(struct_matrice)))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		factorisation_schur(s_etat_processus, (*s_objet_argument).objet,
				&s_matrice);

		if ((*s_etat_processus).erreur_systeme != d_es)
		{
			return;
		}

		if (((*s_etat_processus).exception != d_ep) ||
				((*s_etat_processus).erreur_execution != d_ex))
		{
			free(s_matrice);
			liberation(s_etat_processus, s_objet_argument);
			return;
		}

		if ((s_objet_resultat = allocation(s_etat_processus, NON)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*s_objet_resultat).objet = s_matrice;
		(*s_objet_resultat).type = MRL;
		(*s_objet_argument).type = MRL;
	}

/*
--------------------------------------------------------------------------------
  Décomposition de Schur complexe
--------------------------------------------------------------------------------
*/

	else if ((*s_objet_argument).type == MCX)
	{
		if ((s_copie_argument = copie_objet(s_etat_processus,
				s_objet_argument, 'Q')) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		liberation(s_etat_processus, s_objet_argument);
		s_objet_argument = s_copie_argument;

		if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
				(*((struct_matrice *) (*s_objet_argument).objet))
				.nombre_colonnes)
		{
			liberation(s_etat_processus, s_objet_argument);

			(*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
			return;
		}

		if ((s_matrice = malloc(sizeof(struct_matrice)))
				== NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		factorisation_schur(s_etat_processus, (*s_objet_argument).objet,
				&s_matrice);

		if ((*s_etat_processus).erreur_systeme != d_es)
		{
			return;
		}

		if (((*s_etat_processus).exception != d_ep) ||
				((*s_etat_processus).erreur_execution != d_ex))
		{
			free(s_matrice);
			liberation(s_etat_processus, s_objet_argument);
			return;
		}

		if ((s_objet_resultat = allocation(s_etat_processus, NON)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*s_objet_resultat).objet = s_matrice;
		(*s_objet_resultat).type = MCX;
	}

/*
--------------------------------------------------------------------------------
  Type d'argument invalide
--------------------------------------------------------------------------------
*/

	else
	{
		liberation(s_etat_processus, s_objet_argument);

		(*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
		return;
	}

	if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
			s_objet_argument) == d_erreur)
	{
		return;
	}

	if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
			s_objet_resultat) == d_erreur)
	{
		return;
	}

	return;
}


/*
================================================================================
  Fonction 'sync'
================================================================================
  Entrées :
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_sync(struct_processus *s_etat_processus)
{
	struct_descripteur_fichier	*descripteur;

	struct_objet				*s_objet_argument;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  SYNC ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(synchronisation d'un fichier)\n\n");
		}
		else
		{
			printf("(synchronising a file)\n\n");
		}

		printf("    1: %s\n", d_FCH);

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}

	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
		{
			return;
		}
	}

	if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
			&s_objet_argument) == d_erreur)
	{
		(*s_etat_processus).erreur_execution = d_ex_manque_argument;
		return;
	}

	if ((*s_objet_argument).type == FCH)
	{
		if ((descripteur = descripteur_fichier(s_etat_processus,
				(struct_fichier *) (*s_objet_argument).objet)) == NULL)
		{
			return;
		}

		if ((*descripteur).type != 'C')
		{
			liberation(s_etat_processus, s_objet_argument);

			(*s_etat_processus).erreur_execution = d_ex_erreur_type_fichier;
			return;
		}

		if (fflush((*descripteur).descripteur_c) != 0)
		{
			liberation(s_etat_processus, s_objet_argument);

			(*s_etat_processus).erreur_execution =
					d_ex_erreur_acces_fichier;
			return;
		}
	}
	else
	{
		liberation(s_etat_processus, s_objet_argument);

		(*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
		return;
	}

	liberation(s_etat_processus, s_objet_argument);

	return;
}


/*
================================================================================
  Fonction 'scale'
================================================================================
  Entrées :
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_scale(struct_processus *s_etat_processus)
{
	/*
	 * Prend comme argument une liste
	 */

	long							nombre_arguments_principaux;
	long							nombre_arguments_auxiliaires;

	struct_liste_chainee			*l_element_courant;
	struct_liste_chainee			*l_element_courant_auxiliaire;

	struct_objet					*s_objet_argument;
	struct_objet					*s_objet_auxiliaire;

	unsigned char					*tampon;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  SCALE ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(définition de l'échelle)\n\n");
		}
		else
		{
			printf("(scale definition)\n\n");
		}

		printf("    1: %s\n\n", d_LST);

		if ((*s_etat_processus).langue == 'F')
		{
			printf("  Utilisation :\n\n");
		}
		else
		{
			printf("  Usage:\n\n");
		}

		printf("    { { Xmin Xmax } { Ymin Ymax } { Zmin Zmax } } SCALE\n");
		printf("    { \"AUTOMATIC\" { Ymin Ymax } } SCALE\n");

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}

	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
		{
			return;
		}
	}

	if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
			&s_objet_argument) == d_erreur)
	{
		(*s_etat_processus).erreur_execution = d_ex_manque_argument;
		return;
	}

	if ((*s_objet_argument).type == LST)
	{
		l_element_courant = (struct_liste_chainee *) (*s_objet_argument).objet;
		nombre_arguments_principaux = 0;

		while(l_element_courant != NULL)
		{
			nombre_arguments_principaux++;
			l_element_courant = (*l_element_courant).suivant;
		}

		if ((nombre_arguments_principaux != 2) &&
				(nombre_arguments_principaux != 3))
		{
			liberation(s_etat_processus, s_objet_argument);

			(*s_etat_processus).erreur_execution = d_ex_argument_invalide;
			return;
		}

		l_element_courant = (struct_liste_chainee *) (*s_objet_argument).objet;
		nombre_arguments_principaux = 0;

		while(l_element_courant != NULL)
		{
			nombre_arguments_principaux++;

			if ((*(*l_element_courant).donnee).type == LST)
			{
				l_element_courant_auxiliaire = (struct_liste_chainee *)
						(*(*l_element_courant).donnee).objet;
				nombre_arguments_auxiliaires = 0;

				while(l_element_courant_auxiliaire != NULL)
				{
					l_element_courant_auxiliaire =
							(*l_element_courant_auxiliaire).suivant;
					nombre_arguments_auxiliaires++;
				}

				if (nombre_arguments_auxiliaires != 2)
				{
					liberation(s_etat_processus, s_objet_argument);

					(*s_etat_processus).erreur_execution =
							d_ex_argument_invalide;
					return;
				}

				l_element_courant_auxiliaire = (struct_liste_chainee *)
						(*(*l_element_courant).donnee).objet;
				nombre_arguments_auxiliaires = 0;

				while(l_element_courant_auxiliaire != NULL)
				{
					nombre_arguments_auxiliaires++;

					if (((*(*l_element_courant_auxiliaire).donnee).type ==
							RPN) || (
							(*(*l_element_courant_auxiliaire).donnee)
							.type == ALG) ||
							((*(*l_element_courant_auxiliaire).donnee)
							.type == NOM))
					{
						if (evaluation(s_etat_processus,
								(*l_element_courant_auxiliaire).donnee, 'N')
								== d_erreur)
						{
							liberation(s_etat_processus, s_objet_argument);

							return;
						}

						if (depilement(s_etat_processus,
								&((*s_etat_processus).l_base_pile),
								&s_objet_auxiliaire) == d_erreur)
						{
							liberation(s_etat_processus, s_objet_argument);

							(*s_etat_processus).erreur_execution =
									d_ex_manque_argument;
							return;
						}

						liberation(s_etat_processus,
								(*l_element_courant_auxiliaire).donnee);
						(*l_element_courant_auxiliaire).donnee =
								s_objet_auxiliaire;
					}

					if ((*(*l_element_courant_auxiliaire).donnee).type == INT)
					{
						switch(nombre_arguments_principaux)
						{
							case 1 :
							{
								if (nombre_arguments_auxiliaires == 1)
								{
									if ((*s_etat_processus).systeme_axes == 0)
									{
										(*s_etat_processus).x_min = (real8)
												(*((integer8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));
									}
									else
									{
										(*s_etat_processus).x2_min = (real8)
												(*((integer8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));
									}
								}
								else if (nombre_arguments_auxiliaires == 2)
								{
									if ((*s_etat_processus).systeme_axes == 0)
									{
										(*s_etat_processus).x_max = (real8)
												(*((integer8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));
										(*s_etat_processus)
												.echelle_automatique_x = d_faux;
									}
									else
									{
										(*s_etat_processus).x2_max = (real8)
												(*((integer8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));
										(*s_etat_processus)
												.echelle_automatique_x2
												= d_faux;
									}
								}
								else
								{
									liberation(s_etat_processus,
											s_objet_argument);

									(*s_etat_processus).erreur_execution =
											d_ex_argument_invalide;
									return;
								}

								break;
							}

							case 2 :
							{
								if (nombre_arguments_auxiliaires == 1)
								{
									if ((*s_etat_processus).systeme_axes == 0)
									{
										(*s_etat_processus).y_min = (real8)
												(*((integer8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));
									}
									else
									{
										(*s_etat_processus).y2_min = (real8)
												(*((integer8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));
									}
								}
								else if (nombre_arguments_auxiliaires == 2)
								{
									if ((*s_etat_processus).systeme_axes == 0)
									{
										(*s_etat_processus).y_max = (real8)
												(*((integer8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));

										(*s_etat_processus)
												.echelle_automatique_y = d_faux;
									}
									else
									{
										(*s_etat_processus).y2_max = (real8)
												(*((integer8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));

										(*s_etat_processus)
												.echelle_automatique_y2
												= d_faux;
									}
								}
								else
								{
									liberation(s_etat_processus,
											s_objet_argument);

									(*s_etat_processus).erreur_execution =
											d_ex_argument_invalide;
									return;
								}

								break;
							}

							case 3 :
							{
								if (nombre_arguments_auxiliaires == 1)
								{
									if ((*s_etat_processus).systeme_axes == 0)
									{
										(*s_etat_processus).z_min = (real8)
												(*((integer8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));
									}
									else
									{
										(*s_etat_processus).z2_min = (real8)
												(*((integer8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));
									}
								}
								else if (nombre_arguments_auxiliaires == 2)
								{
									if ((*s_etat_processus).systeme_axes == 0)
									{
										(*s_etat_processus).z_max = (real8)
												(*((integer8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));

										(*s_etat_processus)
												.echelle_automatique_z = d_faux;
									}
									else
									{
										(*s_etat_processus).z2_max = (real8)
												(*((integer8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));

										(*s_etat_processus)
												.echelle_automatique_z
												= d_faux;
									}
								}
								else
								{
									liberation(s_etat_processus,
											s_objet_argument);

									(*s_etat_processus).erreur_execution =
											d_ex_argument_invalide;
									return;
								}

								break;
							}

							default :
							{
								liberation(s_etat_processus, s_objet_argument);

								(*s_etat_processus).erreur_execution =
										d_ex_argument_invalide;
								return;
							}
						}
					}
					else if ((*(*l_element_courant_auxiliaire)
							.donnee).type == REL)
					{
						switch(nombre_arguments_principaux)
						{
							case 1 :
							{
								if (nombre_arguments_auxiliaires == 1)
								{
									if ((*s_etat_processus).systeme_axes == 0)
									{
										(*s_etat_processus).x_min =
												(*((real8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));
									}
									else
									{
										(*s_etat_processus).x2_min =
												(*((real8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));
									}
								}
								else if (nombre_arguments_auxiliaires == 2)
								{
									if ((*s_etat_processus).systeme_axes == 0)
									{
										(*s_etat_processus).x_max =
												(*((real8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));
									
										(*s_etat_processus)
												.echelle_automatique_x = d_faux;
									}
									else
									{
										(*s_etat_processus).x2_max =
												(*((real8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));

										(*s_etat_processus)
												.echelle_automatique_x2
												= d_faux;
									}
								}
								else
								{
									liberation(s_etat_processus,
											s_objet_argument);

									(*s_etat_processus).erreur_execution =
											d_ex_argument_invalide;
									return;
								}

								break;
							}

							case 2 :
							{
								if (nombre_arguments_auxiliaires == 1)
								{
									if ((*s_etat_processus).systeme_axes == 0)
									{
										(*s_etat_processus).y_min =
												(*((real8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));
									}
									else
									{
										(*s_etat_processus).y2_min =
												(*((real8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));
									}
								}
								else if (nombre_arguments_auxiliaires == 2)
								{
									if ((*s_etat_processus).systeme_axes == 0)
									{
										(*s_etat_processus).y_max =
												(*((real8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));

										(*s_etat_processus)
												.echelle_automatique_y = d_faux;
									}
									else
									{
										(*s_etat_processus).y2_max =
												(*((real8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));

										(*s_etat_processus)
												.echelle_automatique_y2
												= d_faux;
									}
								}
								else
								{
									liberation(s_etat_processus,
											s_objet_argument);

									(*s_etat_processus).erreur_execution =
											d_ex_argument_invalide;
									return;
								}

								break;
							}

							case 3 :
							{
								if (nombre_arguments_auxiliaires == 1)
								{
									if ((*s_etat_processus).systeme_axes == 0)
									{
										(*s_etat_processus).z_min =
												(*((real8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));
									}
									else
									{
										(*s_etat_processus).z2_min =
												(*((real8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));
									}
								}
								else if (nombre_arguments_auxiliaires == 2)
								{
									if ((*s_etat_processus).systeme_axes == 0)
									{
										(*s_etat_processus).z_max =
												(*((real8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));

										(*s_etat_processus)
												.echelle_automatique_z = d_faux;
									}
									else
									{
										(*s_etat_processus).z2_max =
												(*((real8 *) (*
												(*l_element_courant_auxiliaire)
												.donnee).objet));

										(*s_etat_processus)
												.echelle_automatique_z2
												= d_faux;
									}
								}
								else
								{
									liberation(s_etat_processus,
											s_objet_argument);

									(*s_etat_processus).erreur_execution =
											d_ex_argument_invalide;
									return;
								}

								break;
							}

							default :
							{
								liberation(s_etat_processus, s_objet_argument);

								(*s_etat_processus).erreur_execution =
										d_ex_argument_invalide;
								return;
							}
						}
					}

					l_element_courant_auxiliaire =
							(*l_element_courant_auxiliaire).suivant;
				}
			}
			else if ((*(*l_element_courant).donnee).type == CHN)
			{
				tampon = conversion_majuscule((unsigned char *)
						(*(*l_element_courant).donnee).objet);

				if (tampon == NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				if (strcmp(tampon, "AUTOMATIC") == 0)
				{
					switch(nombre_arguments_principaux)
					{
						case 1 :
						{
							if ((*s_etat_processus).systeme_axes == 0)
							{
								(*s_etat_processus).echelle_automatique_x
										= d_vrai;
							}
							else
							{
								(*s_etat_processus).echelle_automatique_x2
										= d_vrai;
							}

							break;
						}

						case 2 :
						{
							if ((*s_etat_processus).systeme_axes == 0)
							{
								(*s_etat_processus).echelle_automatique_y
										= d_vrai;
							}
							else
							{
								(*s_etat_processus).echelle_automatique_y2
										= d_vrai;
							}

							break;
						}

						case 3 :
						{
							if ((*s_etat_processus).systeme_axes == 0)
							{
								(*s_etat_processus).echelle_automatique_z
										= d_vrai;
							}
							else
							{
								(*s_etat_processus).echelle_automatique_z2
										= d_vrai;
							}

							break;
						}

						default :
						{
							liberation(s_etat_processus, s_objet_argument);
							free(tampon);

							(*s_etat_processus).erreur_execution =
									d_ex_argument_invalide;
							return;
						}
					}
				}
				else
				{
					liberation(s_etat_processus, s_objet_argument);
					free(tampon);

					(*s_etat_processus).erreur_execution =
							d_ex_argument_invalide;
					return;
				}

				free(tampon);
			}
			else
			{
				liberation(s_etat_processus, s_objet_argument);

				(*s_etat_processus).erreur_execution =
						d_ex_erreur_type_argument;
				return;
			}

			l_element_courant = (*l_element_courant).suivant;
		}
	}
	else
	{
		liberation(s_etat_processus, s_objet_argument);

		(*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
		return;
	}

	liberation(s_etat_processus, s_objet_argument);

	if (test_cfsf(s_etat_processus, 52) == d_faux)
	{
		if ((*s_etat_processus).fichiers_graphiques != NULL)
		{
			appel_gnuplot(s_etat_processus, 'N');
		}
	}

	return;
}


/*
================================================================================
  Fonction 'scls'
================================================================================
  Entrées :
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_scls(struct_processus *s_etat_processus)
{
	logical1					presence_variable;
	logical1					matrice_entiere;

	long						i;

	real8						valeur_courante;

	struct_objet				*s_objet_statistique;

	unsigned long				j;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  SCLS ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(échelle automatique d'un nuage de points)\n\n");
			printf("  Aucun argument\n");
		}
		else
		{
			printf("(auto scale scatter plot)\n\n");
			printf("  No argument\n");
		}

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}

	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
		{
			return;
		}
	}

	/*
	 * Vérification de la présence de la matrice statistique
	 */

	if (recherche_variable(s_etat_processus, ds_sdat) == d_faux)
	{
		/*
		 * Aucune variable ds_sdat n'existe.
		 */

		(*s_etat_processus).erreur_execution = d_ex_absence_observations;
		(*s_etat_processus).erreur_systeme = d_es;

		return;
	}

	i = (*s_etat_processus).position_variable_courante;
	presence_variable = d_faux;

	while(i >= 0)
	{
		if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,
				ds_sdat) == 0) && ((*s_etat_processus)
				.s_liste_variables[i].niveau == 1))
		{
			presence_variable = d_vrai;
			break;
		}

		i--;
	}

	if (presence_variable == d_faux)
	{
		(*s_etat_processus).erreur_execution = d_ex_absence_observations;
		return;
	}

	if ((*s_etat_processus).s_liste_variables[i].objet == NULL)
	{
		(*s_etat_processus).erreur_execution = d_ex_variable_partagee;
		return;
	}

	s_objet_statistique = (*s_etat_processus).s_liste_variables[i].objet;

	if ((*s_objet_statistique).type == MIN)
	{
		matrice_entiere = d_vrai;
	}
	else if ((*s_objet_statistique).type == MRL)
	{
		matrice_entiere = d_faux;
	}
	else
	{
		(*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
		return;
	}

	switch((*((struct_matrice *) (*s_objet_statistique).objet)).nombre_colonnes)
	{
		/*
		 * Une colonne
		 */

		case 1 :
		{
			(*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
			break;
		}

		/*
		 * Deux colonnes ou plus
		 */

		default :
		{
			if (((*s_etat_processus).colonne_statistique_1 < 1) ||
					((*s_etat_processus).colonne_statistique_2 < 1) ||
					((*s_etat_processus).colonne_statistique_1 > (integer8)
					(*((struct_matrice *) (*s_objet_statistique).objet))
					.nombre_colonnes) ||
					((*s_etat_processus).colonne_statistique_2 > (integer8)
					(*((struct_matrice *) (*s_objet_statistique).objet))
					.nombre_colonnes))
			{
				(*s_etat_processus).erreur_execution =
						d_ex_observations_inexistantes;
				return;
			}

			if (matrice_entiere == d_vrai)
			{
				if ((*s_etat_processus).systeme_axes == 0)
				{
					(*s_etat_processus).x_min = (real8) ((integer8 **)
							(*((struct_matrice *) (*s_objet_statistique).objet))
							.tableau)[0][(*s_etat_processus)
							.colonne_statistique_1 - 1];
					(*s_etat_processus).x_max = (*s_etat_processus).x_min;
				}
				else
				{
					(*s_etat_processus).x2_min = (real8) ((integer8 **)
							(*((struct_matrice *) (*s_objet_statistique).objet))
							.tableau)[0][(*s_etat_processus)
							.colonne_statistique_1 - 1];
					(*s_etat_processus).x2_max = (*s_etat_processus).x2_min;
				}

				if ((*s_etat_processus).systeme_axes == 0)
				{
					(*s_etat_processus).y_min = (real8) ((integer8 **)
							(*((struct_matrice *) (*s_objet_statistique).objet))
							.tableau)[0][(*s_etat_processus)
							.colonne_statistique_2 - 1];
					(*s_etat_processus).y_max = (*s_etat_processus).y_min;
				}
				else
				{
					(*s_etat_processus).y2_min = (real8) ((integer8 **)
							(*((struct_matrice *) (*s_objet_statistique).objet))
							.tableau)[0][(*s_etat_processus)
							.colonne_statistique_2 - 1];
					(*s_etat_processus).y2_max = (*s_etat_processus).y2_min;
				}
			}
			else
			{
				if ((*s_etat_processus).systeme_axes == 0)
				{
					(*s_etat_processus).x_min = ((real8 **)
							(*((struct_matrice *) (*s_objet_statistique).objet))
							.tableau)[0][(*s_etat_processus)
							.colonne_statistique_1 - 1];
					(*s_etat_processus).x_max = (*s_etat_processus).x_min;
				}
				else
				{
					(*s_etat_processus).x2_min = ((real8 **)
							(*((struct_matrice *) (*s_objet_statistique).objet))
							.tableau)[0][(*s_etat_processus)
							.colonne_statistique_1 - 1];
					(*s_etat_processus).x2_max = (*s_etat_processus).x2_min;
				}

				if ((*s_etat_processus).systeme_axes == 0)
				{
					(*s_etat_processus).y_min = ((real8 **)
							(*((struct_matrice *) (*s_objet_statistique).objet))
							.tableau)[0][(*s_etat_processus)
							.colonne_statistique_2 - 1];
					(*s_etat_processus).y_max = (*s_etat_processus).y_min;
				}
				else
				{
					(*s_etat_processus).y2_min = ((real8 **)
							(*((struct_matrice *) (*s_objet_statistique).objet))
							.tableau)[0][(*s_etat_processus)
							.colonne_statistique_2 - 1];
					(*s_etat_processus).y2_max = (*s_etat_processus).y2_min;
				}
			}

			for(j = 1; j < (*((struct_matrice *) (*s_objet_statistique).objet))
					.nombre_lignes; j++)
			{
				if (matrice_entiere == d_vrai)
				{
					valeur_courante = (real8) ((integer8 **)
							(*((struct_matrice *) (*s_objet_statistique).objet))
							.tableau)[j][(*s_etat_processus)
							.colonne_statistique_1 - 1];

					if ((*s_etat_processus).systeme_axes == 0)
					{
						if (valeur_courante < (*s_etat_processus).x_min)
						{
							(*s_etat_processus).x_min = valeur_courante;
						}

						if (valeur_courante > (*s_etat_processus).x_max)
						{
							(*s_etat_processus).x_max = valeur_courante;
						}
					}
					else
					{
						if (valeur_courante < (*s_etat_processus).x2_min)
						{
							(*s_etat_processus).x2_min = valeur_courante;
						}

						if (valeur_courante > (*s_etat_processus).x2_max)
						{
							(*s_etat_processus).x2_max = valeur_courante;
						}
					}

					valeur_courante = (real8) ((integer8 **)
							(*((struct_matrice *) (*s_objet_statistique).objet))
							.tableau)[j][(*s_etat_processus)
							.colonne_statistique_2 - 1];

					if ((*s_etat_processus).systeme_axes == 0)
					{
						if (valeur_courante < (*s_etat_processus).y_min)
						{
							(*s_etat_processus).y_min = valeur_courante;
						}

						if (valeur_courante > (*s_etat_processus).y_max)
						{
							(*s_etat_processus).y_max = valeur_courante;
						}
					}
					else
					{
						if (valeur_courante < (*s_etat_processus).y2_min)
						{
							(*s_etat_processus).y2_min = valeur_courante;
						}

						if (valeur_courante > (*s_etat_processus).y2_max)
						{
							(*s_etat_processus).y2_max = valeur_courante;
						}
					}
				}
				else
				{
					valeur_courante = ((real8 **)
							(*((struct_matrice *) (*s_objet_statistique).objet))
							.tableau)[j][(*s_etat_processus)
							.colonne_statistique_1 - 1];

					if ((*s_etat_processus).systeme_axes == 0)
					{
						if (valeur_courante < (*s_etat_processus).x_min)
						{
							(*s_etat_processus).x_min = valeur_courante;
						}

						if (valeur_courante > (*s_etat_processus).x_max)
						{
							(*s_etat_processus).x_max = valeur_courante;
						}
					}
					else
					{
						if (valeur_courante < (*s_etat_processus).x2_min)
						{
							(*s_etat_processus).x2_min = valeur_courante;
						}

						if (valeur_courante > (*s_etat_processus).x2_max)
						{
							(*s_etat_processus).x2_max = valeur_courante;
						}
					}

					valeur_courante = ((real8 **)
							(*((struct_matrice *) (*s_objet_statistique).objet))
							.tableau)[j][(*s_etat_processus)
							.colonne_statistique_2 - 1];

					if ((*s_etat_processus).systeme_axes == 0)
					{
						if (valeur_courante < (*s_etat_processus).y_min)
						{
							(*s_etat_processus).y_min = valeur_courante;
						}

						if (valeur_courante > (*s_etat_processus).y_max)
						{
							(*s_etat_processus).y_max = valeur_courante;
						}
					}
					else
					{
						if (valeur_courante < (*s_etat_processus).y2_min)
						{
							(*s_etat_processus).y2_min = valeur_courante;
						}

						if (valeur_courante > (*s_etat_processus).y2_max)
						{
							(*s_etat_processus).y2_max = valeur_courante;
						}
					}
				}
			}

			break;
		}
	}

	return;
}


/*
================================================================================
  Fonction 'spar'
================================================================================
  Entrées :
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_spar(struct_processus *s_etat_processus)
{
	logical1						presence_matrice_statistique;
	logical1						presence_variable;

	long							i;

	struct_liste_chainee			*l_ancienne_base;
	struct_liste_chainee			*l_nouvelle_base;

	struct_objet					*s_objet_resultat;

	/*
	 * { { Dimensions de SIGMA } X Y }
	 */
		
	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  SPAR ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(paramètres statistiques)\n\n");
		}
		else
		{
			printf("(statistical parameters)\n\n");
		}

		printf("->  1: %s\n", d_LST);

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}

	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
		{
			return;
		}
	}

	if ((s_objet_resultat = allocation(s_etat_processus, LST)) == NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
		return;
	}

	(*s_objet_resultat).objet = NULL;
	l_ancienne_base = (*s_objet_resultat).objet;

	// Colonne 2

	if ((l_nouvelle_base = malloc(sizeof(struct_liste_chainee))) == NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
		return;
	}

	if (((*l_nouvelle_base).donnee = allocation(s_etat_processus, INT))
			== NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
		return;
	}

	(*l_nouvelle_base).suivant = l_ancienne_base;
	(*((integer8 *) (*(*l_nouvelle_base).donnee).objet)) =
			(*s_etat_processus).colonne_statistique_2;
	(*s_objet_resultat).objet = l_nouvelle_base;
	l_ancienne_base = (*s_objet_resultat).objet;

	// Colonne 1

	if ((l_nouvelle_base = allocation_maillon(s_etat_processus)) == NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
		return;
	}

	if (((*l_nouvelle_base).donnee = allocation(s_etat_processus, INT))
			== NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
		return;
	}

	(*l_nouvelle_base).suivant = l_ancienne_base;
	(*((integer8 *) (*(*l_nouvelle_base).donnee).objet)) =
			(*s_etat_processus).colonne_statistique_1;
	(*s_objet_resultat).objet = l_nouvelle_base;
	l_ancienne_base = (*s_objet_resultat).objet;

	// Dimensions de la matrice statistique

	if ((l_nouvelle_base = allocation_maillon(s_etat_processus)) == NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
		return;
	}

	if (((*l_nouvelle_base).donnee = allocation(s_etat_processus, NON))
			== NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
		return;
	}

	if (recherche_variable(s_etat_processus, ds_sdat) == d_faux)
	{
		/*
		 * Aucune variable SIGMA
		 */

		(*s_etat_processus).erreur_systeme = d_es;
		(*s_etat_processus).erreur_execution = d_ex;
		presence_matrice_statistique = d_faux;
	}
	else
	{
		/*
		 * Il existe une variable locale SIGMA. Reste à vérifier l'existence
		 * d'une variable SIGMA globale...
		 */

		i = (*s_etat_processus).position_variable_courante;
		presence_variable = d_faux;

		while(i >= 0)
		{
			if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,
					ds_sdat) == 0) && ((*s_etat_processus)
					.s_liste_variables[i].niveau == 1))
			{
				presence_variable = d_vrai;
				break;
			}

			i--;
		}

		if (presence_variable == d_faux)
		{
			presence_matrice_statistique = d_faux;
		}
		else
		{
			if ((*s_etat_processus).s_liste_variables[i].objet == NULL)
			{
				(*s_etat_processus).erreur_execution = d_ex_variable_partagee;
				return;
			}

			presence_matrice_statistique = d_vrai;
			(*s_etat_processus).position_variable_courante = i;
		}
	}

	if (presence_matrice_statistique == d_faux)
	{
		if (((*(*l_nouvelle_base).donnee).objet = malloc(12 *
				sizeof(unsigned char))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		(*(*l_nouvelle_base).donnee).type = CHN;
		strcpy((unsigned char *) (*(*l_nouvelle_base).donnee).objet,
				"UNAVAILABLE");
	}
	else
	{
		if (((*((*s_etat_processus).s_liste_variables
				[(*s_etat_processus).position_variable_courante].objet))
				.type != MIN) && ((*((*s_etat_processus)
				.s_liste_variables[(*s_etat_processus)
				.position_variable_courante].objet)).type != MRL))
		{
			if (((*(*l_nouvelle_base).donnee).objet = malloc(9 *
					sizeof(unsigned char))) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			(*(*l_nouvelle_base).donnee).type = CHN;
			strcpy((unsigned char *) (*(*l_nouvelle_base).donnee).objet,
					"DISABLED");
		}
		else
		{
			(*(*l_nouvelle_base).donnee).type = LST;

			if (((*(*l_nouvelle_base).donnee).objet =
					allocation_maillon(s_etat_processus)) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			if (((*((struct_liste_chainee *) (*(*l_nouvelle_base).donnee)
					.objet)).donnee = allocation(s_etat_processus, INT))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			(*((integer8 *) (*((*((struct_liste_chainee *) (*(*l_nouvelle_base)
					.donnee).objet)).donnee)).objet)) = (*((struct_matrice *)
					(*((*s_etat_processus).s_liste_variables
					[(*s_etat_processus).position_variable_courante].objet))
					.objet)).nombre_lignes;

			if (((*((struct_liste_chainee *) (*(*l_nouvelle_base).donnee)
					.objet)).suivant = allocation_maillon(s_etat_processus))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			(*(*((struct_liste_chainee *) (*(*l_nouvelle_base).donnee).objet))
					.suivant).suivant = NULL;

			if (((*(*((struct_liste_chainee *) (*(*l_nouvelle_base).donnee)
					.objet)).suivant).donnee = allocation(s_etat_processus,
					INT)) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			(*((integer8 *) (*((*(*((struct_liste_chainee *)
					(*(*l_nouvelle_base).donnee).objet)).suivant).donnee))
					.objet)) = (*((struct_matrice *) (*((*s_etat_processus)
					.s_liste_variables[(*s_etat_processus)
					.position_variable_courante].objet)).objet))
					.nombre_colonnes;
		}
	}

	(*l_nouvelle_base).suivant = l_ancienne_base;
	(*s_objet_resultat).objet = l_nouvelle_base;

	if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
			s_objet_resultat) == d_erreur)
	{
		return;
	}

	return;
}

// vim: ts=4