/*
================================================================================
  RPL/2 (R) version 4.1.12
  Copyright (C) 1989-2013 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 '->HMS'
================================================================================
  Entrées : structure processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_fleche_hms(struct_processus *s_etat_processus)
{
	struct_objet					*s_copie;
	struct_objet					*s_objet;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(conversion sexadécimale)\n\n");
		}
		else
		{
			printf("(conversion to hours minutes seconds)\n\n");
		}

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

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

		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) == d_erreur)
	{
		(*s_etat_processus).erreur_execution = d_ex_manque_argument;
		return;
	}

/*
--------------------------------------------------------------------------------
  Argument entier
--------------------------------------------------------------------------------
*/

	if ((*s_objet).type == INT)
	{
		/*
		 * On ne fait rien...
		 */
	}

/*
--------------------------------------------------------------------------------
  Argument réel
--------------------------------------------------------------------------------
*/

	else if ((*s_objet).type == REL)
	{
		if ((s_copie = copie_objet(s_etat_processus, s_objet, 'O')) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		liberation(s_etat_processus, s_objet);
		s_objet = s_copie;

		conversion_decimal_vers_hms((real8 *) (*s_objet).objet);
	}

/*
--------------------------------------------------------------------------------
  Argument invalide
--------------------------------------------------------------------------------
*/

	else
	{
		liberation(s_etat_processus, s_objet);

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

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

	return;
}


/*
================================================================================
  Fonction '->ARRAY'
================================================================================
  Entrées : structure processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_fleche_array(struct_processus *s_etat_processus)
{
	enum t_type						type;

	struct_liste_chainee			*l_element_courant;

	struct_objet					*s_objet;
	struct_objet					*s_objet_elementaire;

	unsigned long					i;
	unsigned long					j;
	unsigned long					nombre_colonnes;
	unsigned long					nombre_lignes;
	unsigned long					nombre_dimensions;
	unsigned long					nombre_termes;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  ->ARRAY [->ARRY] ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(création d'un vecteur ou d'une matrice)\n\n");
		}
		else
		{
			printf("(create vector or matrix)\n\n");
		}

		printf("    n: %s, %s, %s\n", d_INT, d_REL, d_CPL);
		printf("    ...\n");
		printf("    2: %s, %s, %s\n", d_INT, d_REL, d_CPL);
		printf("    1: %s\n", d_LST);
		printf("->  1: %s, %s, %s,\n"
				"       %s, %s, %s\n", d_VIN, d_VRL, d_VCX,
				d_MIN, 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, 0) == d_erreur)
		{
			return;
		}
	}

	if ((*s_etat_processus).hauteur_pile_operationnelle == 0)
	{
		(*s_etat_processus).erreur_execution = d_ex_manque_argument;
		return;
	}

	if ((*(*(*s_etat_processus).l_base_pile).donnee).type != LST)
	{
		(*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
		return;
	}

	l_element_courant = (*(*(*s_etat_processus).l_base_pile).donnee).objet;
	nombre_dimensions = 0;

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

	if (nombre_dimensions > 2)
	{
		(*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
		return;
	}

	l_element_courant = (*(*(*s_etat_processus).l_base_pile).donnee).objet;
	nombre_termes = 1;

	nombre_lignes = 0;
	nombre_colonnes = 0;

	while(l_element_courant != NULL)
	{
		if ((*(*l_element_courant).donnee).type != INT)
		{
			(*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
			return;
		}

		if ((*((integer8 *) (*(*l_element_courant).donnee).objet)) <= 0)
		{
			(*s_etat_processus).erreur_execution = d_ex_argument_invalide;
			return;
		}

		if (nombre_lignes == 0)
		{
			nombre_lignes = (*((integer8 *) (*(*l_element_courant)
					.donnee).objet));
		}
		else
		{
			nombre_colonnes = (*((integer8 *) (*(*l_element_courant)
					.donnee).objet));
		}

		nombre_termes *= (*((integer8 *) (*(*l_element_courant)
				.donnee).objet));
		l_element_courant = (*l_element_courant).suivant;
	}

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

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

	liberation(s_etat_processus, s_objet);

	if ((*s_etat_processus).hauteur_pile_operationnelle < nombre_termes)
	{
		(*s_etat_processus).erreur_execution = d_ex_manque_argument;
		return;
	}

	type = (nombre_dimensions == 1) ? VIN : MIN;
	
	l_element_courant = (*s_etat_processus).l_base_pile;

	for(i = 0; i < nombre_termes; i++)
	{
		if ((*(*l_element_courant).donnee).type == INT)
		{
			/*
			 * Rien à faire...
			 */
		}
		else if ((*(*l_element_courant).donnee).type == REL)
		{
			type = (nombre_dimensions == 1) ? VRL : MRL;
		}
		else if ((*(*l_element_courant).donnee).type == CPL)
		{
			type = (nombre_dimensions == 1) ? VCX : MCX;
		}
		else
		{
			(*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
			return;
		}

		l_element_courant = (*l_element_courant).suivant;
	}

/*
--------------------------------------------------------------------------------
  Traitement des vecteurs
--------------------------------------------------------------------------------
*/

	if (nombre_dimensions == 1)
	{
		if (type == VIN)
		{
			if ((s_objet = allocation(s_etat_processus, VIN)) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			if (((*((struct_vecteur *) (*s_objet).objet)).tableau =
					malloc(nombre_lignes * sizeof(integer8))) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}
		}
		else if (type == VRL)
		{
			if ((s_objet = allocation(s_etat_processus, VRL)) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			if (((*((struct_vecteur *) (*s_objet).objet)).tableau =
					malloc(nombre_lignes * sizeof(real8))) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}
		}
		else
		{
			if ((s_objet = allocation(s_etat_processus, VCX)) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			if (((*((struct_vecteur *) (*s_objet).objet)).tableau =
					malloc(nombre_lignes * sizeof(struct_complexe16)))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}
		}

		(*((struct_vecteur *) (*s_objet).objet)).taille = nombre_lignes;

		for(i = 0; i < nombre_lignes; i++)
		{
			if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
					&s_objet_elementaire) == d_erreur)
			{
				(*s_etat_processus).erreur_execution = d_ex_manque_argument;
				return;
			}

			if ((*((struct_vecteur *) (*s_objet).objet)).type == 'I')
			{
				((integer8 *) (*((struct_vecteur *) (*s_objet).objet))
						.tableau)[nombre_lignes - (i + 1)] = (*((integer8 *)
						(*s_objet_elementaire).objet));
			}
			else if ((*((struct_vecteur *) (*s_objet).objet)).type == 'R')
			{
				if ((*s_objet_elementaire).type == INT)
				{
					((real8 *) (*((struct_vecteur *) (*s_objet).objet))
							.tableau)[nombre_lignes - (i + 1)] =
							(real8) (*((integer8 *)
							(*s_objet_elementaire).objet));
				}
				else
				{
					((real8 *) (*((struct_vecteur *) (*s_objet).objet))
							.tableau)[nombre_lignes - (i + 1)] = (*((real8 *)
							(*s_objet_elementaire).objet));
				}
			}
			else
			{
				if ((*s_objet_elementaire).type == INT)
				{
					((struct_complexe16 *) (*((struct_vecteur *)
							(*s_objet).objet)).tableau)
							[nombre_lignes - (i + 1)].partie_reelle =
							(real8) (*((integer8 *)
							(*s_objet_elementaire).objet));
					((struct_complexe16 *) (*((struct_vecteur *)
							(*s_objet).objet)).tableau)
							[nombre_lignes - (i + 1)].partie_imaginaire = 0;
				}
				else if ((*s_objet_elementaire).type == REL)
				{
					((struct_complexe16 *) (*((struct_vecteur *)
							(*s_objet).objet)).tableau)
							[nombre_lignes - (i + 1)].partie_reelle =
							(*((real8 *) (*s_objet_elementaire).objet));
					((struct_complexe16 *) (*((struct_vecteur *)
							(*s_objet).objet)).tableau)
							[nombre_lignes - (i + 1)].partie_imaginaire = 0;
				}
				else
				{
					((struct_complexe16 *) (*((struct_vecteur *)
							(*s_objet).objet)).tableau)
							[nombre_lignes - (i + 1)].partie_reelle =
							(*((struct_complexe16 *)
							(*s_objet_elementaire).objet)).partie_reelle;
					((struct_complexe16 *) (*((struct_vecteur *)
							(*s_objet).objet)).tableau)
							[nombre_lignes - (i + 1)].partie_imaginaire =
							(*((struct_complexe16 *)
							(*s_objet_elementaire).objet)).partie_imaginaire;
				}
			}

			liberation(s_etat_processus, s_objet_elementaire);
		}
	}

/*
--------------------------------------------------------------------------------
  Traitement des matrices
--------------------------------------------------------------------------------
*/

	else
	{
		if (type == MIN)
		{
			if ((s_objet = allocation(s_etat_processus, MIN))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			if (((*((struct_matrice *) (*s_objet).objet)).tableau =
					malloc(nombre_lignes * sizeof(integer8 *))) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}
		}
		else if (type == MRL)
		{
			if ((s_objet = allocation(s_etat_processus, MRL))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			if (((*((struct_matrice *) (*s_objet).objet)).tableau =
					malloc(nombre_lignes * sizeof(real8 *))) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}
		}
		else
		{
			if ((s_objet = allocation(s_etat_processus, MCX))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			if (((*((struct_matrice *) (*s_objet).objet)).tableau =
					malloc(nombre_lignes * sizeof(struct_complexe16 *)))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}
		}

		(*((struct_matrice *) (*s_objet).objet)).nombre_lignes = nombre_lignes;
		(*((struct_matrice *) (*s_objet).objet)).nombre_colonnes =
				nombre_colonnes;

		for(i = 0; i < nombre_lignes; i++)
		{
			if ((*((struct_matrice *) (*s_objet).objet)).type == 'I')
			{
				if ((((integer8 **) (*((struct_matrice *)
						(*s_objet).objet)).tableau)[nombre_lignes - (i + 1)]
						= malloc(nombre_colonnes * sizeof(integer8))) == NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}
			}
			else if ((*((struct_matrice *) (*s_objet).objet)).type == 'R')
			{
				if ((((real8 **) (*((struct_matrice *)
						(*s_objet).objet)).tableau)[nombre_lignes - (i + 1)]
						= malloc(nombre_colonnes * sizeof(real8))) == NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}
			}
			else
			{
				if ((((struct_complexe16 **) (*((struct_matrice *)
						(*s_objet).objet)).tableau)[nombre_lignes - (i + 1)]
						= malloc(nombre_colonnes * sizeof(struct_complexe16)))
						== NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}
			}

			for(j = 0; j < nombre_colonnes; j++)
			{
				if (depilement(s_etat_processus, &((*s_etat_processus)
						.l_base_pile), &s_objet_elementaire) == d_erreur)
				{
					(*s_etat_processus).erreur_execution = d_ex_manque_argument;
					return;
				}

				if ((*((struct_matrice *) (*s_objet).objet)).type == 'I')
				{
					((integer8 **) (*((struct_matrice *) (*s_objet).objet))
							.tableau)[nombre_lignes - (i + 1)]
							[nombre_colonnes - (j + 1)] = (*((integer8 *)
							(*s_objet_elementaire).objet));
				}
				else if ((*((struct_matrice *) (*s_objet).objet)).type == 'R')
				{
					if ((*s_objet_elementaire).type == INT)
					{
						((real8 **) (*((struct_matrice *) (*s_objet).objet))
								.tableau)[nombre_lignes - (i + 1)]
								[nombre_colonnes - (j + 1)] =
								(real8) (*((integer8 *)
								(*s_objet_elementaire).objet));
					}
					else
					{
						((real8 **) (*((struct_matrice *) (*s_objet).objet))
								.tableau)[nombre_lignes - (i + 1)]
								[nombre_colonnes - (j + 1)] = (*((real8 *)
								(*s_objet_elementaire).objet));
					}
				}
				else
				{
					if ((*s_objet_elementaire).type == INT)
					{
						((struct_complexe16 **) (*((struct_matrice *)
								(*s_objet).objet)).tableau)
								[nombre_lignes - (i + 1)]
								[nombre_colonnes - (j + 1)].partie_reelle =
								(real8) (*((integer8 *)
								(*s_objet_elementaire).objet));
						((struct_complexe16 **) (*((struct_matrice *)
								(*s_objet).objet)).tableau)
								[nombre_lignes - (i + 1)]
								[nombre_colonnes - (j + 1)]
								.partie_imaginaire = 0;
					}
					else if ((*s_objet_elementaire).type == REL)
					{
						((struct_complexe16 **) (*((struct_matrice *)
								(*s_objet).objet)).tableau)
								[nombre_lignes - (i + 1)]
								[nombre_colonnes - (j + 1)].partie_reelle =
								(*((real8 *) (*s_objet_elementaire).objet));
						((struct_complexe16 **) (*((struct_matrice *)
								(*s_objet).objet)).tableau)
								[nombre_lignes - (i + 1)]
								[nombre_colonnes - (j + 1)]
								.partie_imaginaire = 0;
					}
					else
					{
						((struct_complexe16 **) (*((struct_matrice *)
								(*s_objet).objet)).tableau)
								[nombre_lignes - (i + 1)]
								[nombre_colonnes - (j + 1)].partie_reelle =
								(*((struct_complexe16 *)
								(*s_objet_elementaire).objet)).partie_reelle;
						((struct_complexe16 **) (*((struct_matrice *)
								(*s_objet).objet)).tableau)
								[nombre_lignes - (i + 1)]
								[nombre_colonnes - (j + 1)].partie_imaginaire =
								(*((struct_complexe16 *)
								(*s_objet_elementaire).objet))
								.partie_imaginaire;
					}
				}

				liberation(s_etat_processus, s_objet_elementaire);
			}
		}
	}

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

	return;
}


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

void
instruction_false(struct_processus *s_etat_processus)
{
	struct_objet					*s_objet;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(valeur fausse)\n\n");
		}
		else
		{
			printf("(false value)\n\n");
		}

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

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

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

	(*((integer8 *) (*s_objet).objet)) = 0;

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

	return;
}


/*
================================================================================
  Fonction '->STR'
================================================================================
  Entrées : structure processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_fleche_str(struct_processus *s_etat_processus)
{
	struct_objet					*s_objet_argument;
	struct_objet					*s_objet_resultat;

	unsigned char					*ligne;
	unsigned char					*ptr_e;
	unsigned char					*ptr_l;

	unsigned long					caracteres_echappement;

	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(conversion en chaîne)\n\n");
		}
		else
		{
			printf("(conversion into string of chars)\n\n");
		}

		printf("    1: %s, %s, %s, %s, %s, %s,\n"
				"       %s, %s, %s, %s, %s,\n"
				"       %s, %s, %s, %s, %s,\n"
				"       %s\n",
				d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
				d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
		printf("->  1: %s\n", d_INT);

		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_resultat = allocation(s_etat_processus, CHN)) == NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
		return;
	}

	ligne = formateur(s_etat_processus, 0, s_objet_argument);
	caracteres_echappement = 0;

	// Reconstitution des caractères d'échappement

	ptr_l = ligne;

	while((*ptr_l) != d_code_fin_chaine)
	{
		switch(*ptr_l)
		{
			case '\"':
			case '\b':
			case '\n':
			case '\t':
			case '\\':
			{
				caracteres_echappement++;
				break;
			}
		}

		ptr_l++;
	}

	if (((*s_objet_resultat).objet = malloc((strlen(ligne) + 1 +
			caracteres_echappement) * sizeof(unsigned char))) == NULL)
	{
		(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
		return;
	}

	ptr_l = ligne;
	ptr_e = (*s_objet_resultat).objet;

	while((*ptr_l) != d_code_fin_chaine)
	{
		switch(*ptr_l)
		{
			case '\\':
			{
				(*ptr_e) = '\\';
				(*(++ptr_e)) = '\\';
				break;
			}

			case '\"':
			{
				(*ptr_e) = '\\';
				(*(++ptr_e)) = '\"';
				break;
			}

			case '\b':
			{
				(*ptr_e) = '\\';
				(*(++ptr_e)) = 'b';
				break;
			}

			case '\n':
			{
				(*ptr_e) = '\\';
				(*(++ptr_e)) = 'n';
				break;
			}

			case '\t':
			{
				(*ptr_e) = '\\';
				(*(++ptr_e)) = 't';
				break;
			}

			default:
			{
				(*ptr_e) = (*ptr_l);
				break;
			}
		}

		ptr_l++;
		ptr_e++;
	}

	(*ptr_e) = d_code_fin_chaine;
	free(ligne);

	liberation(s_etat_processus, s_objet_argument);

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

	return;
}


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

void
instruction_fft(struct_processus *s_etat_processus)
{
	integer4					erreur;
	integer4					inverse;
	integer4					nombre_colonnes;
	integer4					nombre_lignes;

	logical1					presence_longueur_fft;

	long						longueur_fft_signee;

	struct_complexe16			*matrice_f77;

	struct_objet				*s_objet_argument;
	struct_objet				*s_objet_longueur_fft;
	struct_objet				*s_objet_resultat;

	unsigned long				i;
	unsigned long				j;
	unsigned long				k;
	unsigned long				longueur_fft;

	(*s_etat_processus).erreur_execution =d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(transformée de Fourier rapide)\n\n");
		}
		else
		{
			printf("(fast Fourier transform)\n\n");
		}

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

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

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

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

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

	/*
	 * Il est possible d'imposer une longueur de FFT au premier niveau
	 * de la pile.
	 */

	if ((*s_etat_processus).l_base_pile == NULL)
	{
		(*s_etat_processus).erreur_execution = d_ex_manque_argument;
		return;
	}

	if ((*(*(*s_etat_processus).l_base_pile).donnee).type == INT)
	{
		presence_longueur_fft = d_vrai;

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

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

		longueur_fft_signee = (*((integer8 *) (*s_objet_longueur_fft).objet));

		liberation(s_etat_processus, s_objet_longueur_fft);

		if (longueur_fft_signee <= 0)
		{
			(*s_etat_processus).erreur_execution = d_ex_longueur_fft;
			return;
		}

		longueur_fft = longueur_fft_signee;
	}
	else
	{
		presence_longueur_fft = d_faux;
		longueur_fft = 0;

		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;
	}

/*
--------------------------------------------------------------------------------
  Vecteur
--------------------------------------------------------------------------------
*/

	if (((*s_objet_argument).type == VIN) ||
			((*s_objet_argument).type == VRL) ||
			((*s_objet_argument).type == VCX))
	{
		if (presence_longueur_fft == d_faux)
		{
			longueur_fft = pow(2, (integer4) ceil(log((real8)
					(*((struct_vecteur *)
					(*s_objet_argument).objet)).taille) / log((real8) 2)));

			if ((longueur_fft / ((real8) (*((struct_vecteur *)
					(*s_objet_argument).objet)).taille)) == 2)
			{
				longueur_fft /= 2;
			}
		}

		if ((matrice_f77 = malloc(longueur_fft *
				sizeof(struct_complexe16))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		if ((*s_objet_argument).type == VIN)
		{
			for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
					.taille; i++)
			{
				matrice_f77[i].partie_reelle = (real8) ((integer8 *)
						(*((struct_vecteur *) (*s_objet_argument).objet))
						.tableau)[i];
				matrice_f77[i].partie_imaginaire = (real8) 0;
			}
		}
		else if ((*s_objet_argument).type == VRL)
		{
			for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
					.taille; i++)
			{
				matrice_f77[i].partie_reelle = ((real8 *)
						(*((struct_vecteur *) (*s_objet_argument).objet))
						.tableau)[i];
				matrice_f77[i].partie_imaginaire = (real8) 0;
			}
		}
		else
		{
			for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
					.taille; i++)
			{
				matrice_f77[i].partie_reelle = ((struct_complexe16 *)
						(*((struct_vecteur *) (*s_objet_argument).objet))
						.tableau)[i].partie_reelle;
				matrice_f77[i].partie_imaginaire = ((struct_complexe16 *)
						(*((struct_vecteur *) (*s_objet_argument).objet))
						.tableau)[i].partie_imaginaire;
			}
		}

		for(; i < longueur_fft; i++)
		{
				matrice_f77[i].partie_reelle = (real8) 0;
				matrice_f77[i].partie_imaginaire = (real8) 0;
		}

		nombre_lignes = 1;
		nombre_colonnes = longueur_fft;
		inverse = 0;

		dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);

		if (erreur != 0)
		{
			liberation(s_etat_processus, s_objet_argument);
			free(matrice_f77);

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

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

		(*((struct_vecteur *) (*s_objet_resultat).objet)).taille = longueur_fft;
		(*((struct_vecteur *) (*s_objet_resultat).objet)).tableau = matrice_f77;
	}

/*
--------------------------------------------------------------------------------
  Matrice
--------------------------------------------------------------------------------
*/

	else if (((*s_objet_argument).type == MIN) ||
			((*s_objet_argument).type == MRL) ||
			((*s_objet_argument).type == MCX))
	{
		if (presence_longueur_fft == d_faux)
		{
			longueur_fft = pow(2, (integer4) ceil(log((real8)
					(*((struct_matrice *)
					(*s_objet_argument).objet)).nombre_colonnes) /
					log((real8) 2)));

			if ((longueur_fft / ((real8) (*((struct_matrice *)
					(*s_objet_argument).objet)).nombre_colonnes)) == 2)
			{
				longueur_fft /= 2;
			}
		}

		if ((matrice_f77 = malloc(longueur_fft *
				(*((struct_matrice *) (*s_objet_argument).objet))
				.nombre_lignes * sizeof(struct_complexe16))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		if ((*s_objet_argument).type == MIN)
		{
			for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
					.objet)).nombre_colonnes; i++)
			{
				for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
						.objet)).nombre_lignes; j++)
				{
					matrice_f77[k].partie_reelle = (real8) ((integer8 **)
							(*((struct_matrice *) (*s_objet_argument).objet))
							.tableau)[j][i];
					matrice_f77[k++].partie_imaginaire = (real8) 0;
				}
			}

			for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
					.objet)).nombre_lignes; k++)
			{
				matrice_f77[k].partie_reelle = (real8) 0;
				matrice_f77[k].partie_imaginaire = (real8) 0;
			}
		}
		else if ((*s_objet_argument).type == MRL)
		{
			for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
					.objet)).nombre_colonnes; i++)
			{
				for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
						.objet)).nombre_lignes; j++)
				{
					matrice_f77[k].partie_reelle = ((real8 **)
							(*((struct_matrice *) (*s_objet_argument).objet))
							.tableau)[j][i];
					matrice_f77[k++].partie_imaginaire = (real8) 0;
				}
			}

			for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
					.objet)).nombre_lignes; k++)
			{
				matrice_f77[k].partie_reelle = (real8) 0;
				matrice_f77[k].partie_imaginaire = (real8) 0;
			}
		}
		else
		{
			for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
					.objet)).nombre_colonnes; i++)
			{
				for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
						.objet)).nombre_lignes; j++)
				{
					matrice_f77[k].partie_reelle = ((struct_complexe16 **)
							(*((struct_matrice *) (*s_objet_argument).objet))
							.tableau)[j][i].partie_reelle;
					matrice_f77[k++].partie_imaginaire =
							((struct_complexe16 **) (*((struct_matrice *)
							(*s_objet_argument).objet)).tableau)[j][i]
							.partie_imaginaire;
				}
			}

			for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
					.objet)).nombre_lignes; k++)
			{
				matrice_f77[k].partie_reelle = (real8) 0;
				matrice_f77[k].partie_imaginaire = (real8) 0;
			}
		}

		nombre_lignes = (*((struct_matrice *) (*s_objet_argument).objet))
				.nombre_lignes;
		nombre_colonnes = longueur_fft;
		inverse = 0;

		dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);

		if (erreur != 0)
		{
			liberation(s_etat_processus, s_objet_argument);
			free(matrice_f77);

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

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

		(*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
				(*((struct_matrice *) (*s_objet_argument).objet))
				.nombre_lignes;
		(*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
				longueur_fft;

		if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
				malloc((*((struct_matrice *) (*s_objet_resultat).objet))
				.nombre_lignes * sizeof(struct_complexe16 *))) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
				.nombre_lignes; i++)
		{
			if ((((struct_complexe16 **) (*((struct_matrice *)
					(*s_objet_resultat).objet)).tableau)[i] =
					malloc((*((struct_matrice *)
					(*s_objet_resultat).objet)).nombre_colonnes *
					sizeof(struct_complexe16))) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}
		}

		for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
				.nombre_colonnes; i++)
		{
			for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
					.nombre_lignes; j++)
			{
				((struct_complexe16 **) (*((struct_matrice *)
						(*s_objet_resultat).objet)).tableau)[j][i]
						.partie_reelle = matrice_f77[k].partie_reelle;
				((struct_complexe16 **) (*((struct_matrice *)
						(*s_objet_resultat).objet)).tableau)[j][i]
						.partie_imaginaire = matrice_f77[k++].partie_imaginaire;
			}
		}

		free(matrice_f77);
	}

/*
--------------------------------------------------------------------------------
  Calcul de FFT impossible
--------------------------------------------------------------------------------
*/

	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 (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
			s_objet_resultat) == d_erreur)
	{
		return;
	}

	return;
}


/*
================================================================================
  Fonction 'function' (passe en mode d'affichage y=f(x))
================================================================================
  Entrées : structure processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_function(struct_processus *s_etat_processus)
{
	(*s_etat_processus).erreur_execution = d_ex;

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

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(tracé y=f(x))\n\n");
			printf("  Aucun argument\n");
		}
		else
		{
			printf("(plot y=f(x))\n\n");
			printf("  No argument\n");
		}

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}
	
	strcpy((*s_etat_processus).type_trace_eq, "FONCTION");

	return;
}

// vim: ts=4