Practica en Lenguaje ADA: Implementa el préstamo Francés y Americano. También una cola FIFO, para las existencias en almacén.

with unchecked_deallocation,Text_Io,ada.integer_text_io,Ada.Float_Text_IO;
use Text_Io,ada.integer_text_io,Ada.Float_Text_IO;


procedure trabadministracion is
type nodo_lista;
type pnodo_lista is access nodo_lista;
type nodo_lista is record --lista doblemente encadenada
cantidad:integer;
precio:float;
siguiente:pnodo_lista;
anterior:pnodo_lista;
end record;
principio,final:pnodo_lista;--punteros al nodo ultimo y primero
---variables de los prestamos--
cantidad,cant,opcion:integer;
aux,precio:float;
---variables del lifo--
n,cont,s:integer;
g,anual,interes,i,c,f,a:float;

procedure Liberar_pnodo is new Unchecked_Deallocation(nodo_lista,Pnodo_lista);
--libera nodos del tipo pnodo_lista


procedure insertarfinal(cantidad: in integer;Precio: in float;principio,final: in out pnodo_lista) is
--inserta un nuevo nodo al final de la lista
recorrer:pnodo_lista;
begin
recorrer:=final;
if principio=null then --en caso de lista vacia
principio:=new nodo_lista;
principio.cantidad:=cantidad;
principio.precio:=precio;
final:=principio;
else --si la lista no esta vacia
final:=new nodo_lista;
final.cantidad:=cantidad;
final.precio:=precio;
recorrer.siguiente:=final;
final.anterior:=recorrer;
end if;
end insertarfinal;

procedure extraer(cant: in out integer;final: in out pnodo_lista)is
aux,aux2:pnodo_lista;
Cant_total:integer:=0 ;
begin
aux2:=final;
while aux2/=null loop
cant_total:=cant_total+aux2.cantidad;
aux2:=aux2.anterior;
end loop;
if cant>cant_total then
new_line;
put_line("La Cantidad Es Superior A La Actual");
else
if cant=final.cantidad then
aux:=final.anterior;
if principio/=final then
aux.siguiente:=null;
else
principio:=aux;
end if;
liberar_pnodo(final);
final:=aux;

else
if cant>final.cantidad then
cant:=cant-final.cantidad;
aux:=final.anterior;
liberar_pnodo(final);
aux.siguiente:=null;
final:=aux;
extraer(cant,final);
else
final.cantidad:=final.cantidad-cant;
end if;
end if;
end if;
end extraer;

procedure verpantalla(principio,final:pnodo_lista) is
--visualiza en pantalla la lista
recorrer:pnodo_lista;
begin
recorrer:=principio;
if not(recorrer=null) then --si la lista no esta vacia
--recorre toda la lista y pone el campo info en pantalla
while not(recorrer=null) loop
put("cantidad:");put(recorrer.cantidad);
put("precio:");put(recorrer.precio,fore=>5,aft=>2,exp=>0); --te pasa de la notacion cientifica a float
new_line;
recorrer:=recorrer.siguiente;
end loop;


else --si la lista esta vacia llama la excepcion
new_line;
put_line("No Hay Existencias");
end if;
end verpantalla;

function anualidad(c,i:float;n:integer)return float is
f,a,i2:float;
begin
i2:=i/100.0;
f:=1.0+i2;
f:=f**(-n);
f:=1.0-f;
f:=f/i2;
a:=c/f;
return (a);
end anualidad;

function cinteres(c,i,a:float;n,s:integer)return float is
f,i2,cinteres:float;
s2,n2:integer;
begin
s2:=s-1;
n2:=n-s2;
i2:=i/100.0;
f:=1.0+i2;
f:=f**(-n2);
f:=1.0-f;
f:=f/i2;
cinteres:=f*(anualidad(c,i,n))*i2;

return cinteres ;
end cinteres;

function camortizacion(c,i,a:float;n,s:integer)return float is
f,i2,i3,cinteres,a2,a3:float;
s2,n2:integer;
begin
i2:=i/100.0;
i3:=c*i2;
a2:=(anualidad(c,i,n))-i3;
s2:=s-1;
a3:=(1.0+i2)**s2;
a3:=a2*a3;

return a3 ;
end camortizacion;

function saldo(c,i,a:float;n,s:integer)return float is
f,i2,a2:float;
s2:integer;
begin
s2:=n-s;
i2:=i/100.0;
f:=1.0+i2;
f:=f**(-s2);
f:=1.0-f;
f:=f/i2;
a2:=(anualidad(c,i,n))*f;
return a2 ;
end saldo;
begin
loop
--begin
new_line;
put_line("*********************** Bienvenido A Este Programa *************************");
put_line("************** Administracion De Empresas II **************");
put_line("******* *******");
put_line("******* 1.= Terminar EL programa *******");
put_line("******* 2.= Realizado por *******");
put_line("******* 3.= Lifo *******");
put_line("******* 4.= Prestamos *******");
put_line("******* *******");
put_line("****************************************************************************");
new_line;
Put("Teclee su opcion");
get(opcion);
new_line;
case Opcion is
when 1=>
put_line("gracias por usar este programa");
exit;
when 2=>
new_line;
Put_line(" ***** Diseñadores Del Econominator ******");
new_line;
Put_line(" ** Jose Luis Cabrera Marrero ** ");
new_line;
Put_line(" ** Airam Caballero Perez **");
new_line;
Put_line(" ** Eduardo Hidalgo Luque **");
new_line;
Put_line(" ** Sergio Romero Sanchez **");
New_Line;
When 3=>
loop
new_line;
put_line("******************************* LIFO ********************************");
put_line("************** Administracion De Empresas II *************");
put_line("******* *******");
put_line("******* 1.= menu principal *******");
put_line("******* 2.= entradas *******");
put_line("******* 3.= salidas *******");
put_line("******* 4.= existencias actuales *******");
put_line("******* *******");
put_line("****************************************************************************");
new_line;
Put("Teclee su opcion");
get(opcion);
new_line;
case opcion is
when 1=>
EXIT;
when 2=>
put_line("-ENTRADAS-");
put("indique la cantidad de mercancia entrante:");
get(cantidad);
new_line;
put("precio al que entra la mercancia:");
get(precio);
insertarfinal(cantidad,precio,principio,final);
new_line;
put_line("¡¡ la entrada ha sido realizada ¡¡");
when 3=>
put_line("cantidad que va a salir del almacen");
get(cant);
extraer(cant,final);
new_line;

When 4=>
put_line("las existencia actuales son:");
verpantalla(principio,final);
When Others=>
Put_line("La Opcion Elegida Es Incorrecta");
New_Line;
New_Line;

End case;
end loop; ----fin del menu lifo
new_line;
when 4=>
loop
new_line;
put_line("******************************* PRESTAMOS ***************************");
put_line("************** Administracion De Empresas II *************");
put_line("******* *******");
put_line("******* 1.= menu principal *******");
put_line("******* 2.= Sistema Americano *******");
put_line("******* 3.= Sistema Frances *******");
put_line("******* *******");
put_line("****************************************************************************");
new_line;
Put("Teclee su opcion");
get(opcion);
new_line;
case opcion is
when 1=>
EXIT;
when 2=>
loop
new_line;
put_line("***************************** PRESTAMOS **************************");
put_line("**** --SISTEMA AMERICANO-- ****");
put_line("**** ****");
put_line("**** 1.= menu principal ****");
put_line("**** 2.= cuantia constante de interes a pagar en cada ano del prestamo ****");
put_line("**** 3.= cuantia constante que hay que imponer en el fondo ****");
put_line("**** ****");
put_line("*******************************************************************************");
new_line;
Put("Teclee su opcion");
get(opcion);
new_line;
case opcion is
when 1=>
exit;
when 2=>

put_line("introduzca el capital del prestamo");
get(c);
put_line("introduzca el interes del prestamo anual en %");
get(i);


begin
aux:=i/100.0;
interes:=c*aux;
new_line;
put_line("la cuantia de interes es :"); put(interes,fore=>5,aft=>3,exp=>0);

end;
when 3=>
put_line("introduzca el capital del prestamo");
get(c);
put_line("introduzca las imposiciones anules en %");
get(i);
put_line("introduzca la duracion del prestamo en años");
get(n);
begin
f:=i/100.0;
f:=(((1.0+f)**n)-1.0)/f;
cont:=0;
anual:=c/f;
new_line;
put_line("la cuantia es:"); put(anual,fore=>5,aft=>3,exp=>0);


end;
when others=>
put_line("La Opcion Es Incorrecta");
trabadministracion;
end case;
end loop; ---fin del menu sistema americano
when 3=>
put_line("introduzca el capital del prestamo");
get(c);
put_line("introduzca el interes del prestamo anual en %");
get(i);
put_line("introduzca la duracion del prestamo en años");
get(n);
loop

new_line;
put_line("**************************** PRESTAMOS ********************************");
put_line("************** ---SISTEMA FRANCES--- *************");
put_line("******* *******");
put_line("******* 1.= salir *******");
put_line("******* 2.= calcular la anualidad que amortiza el prestamo *******");
put_line("******* 3.= cuota de amortizacion de un periodo en concreto *******");
put_line("******* 4.= cuota de interes de un periodo concreto *******");
put_line("******* 5.= saldo del prestamo en un año concreto *******");
put_line("******* *******");
put_line("****************************************************************************");
new_line;
Put("Teclee su opcion");
get(opcion);
new_line;
case opcion is
when 1=>
exit;
when 2=>
put(anualidad(c,i,n),fore=>5,aft=>2,exp=>0);
when 3=>
put_line("introduzca el periodo que desea obtener:");
get(s);
if s>n then
put_line("el periodo seleccionado es mayor que los periodos de amortizacion del prestamo");
exit;
end if;
put_line("la cuota de amortizacion es:");
put(camortizacion(c,i,a,n,s),fore=>5,aft=>2,exp=>0);

when 4=>
put_line("introduzca el periodo que desea obtener:");
get(s);
if s>n then
put_line("el periodo seleccionado es mayor que los periodos de amortizacion del prestamo");
exit;
end if;
put_line("la cuota de interes es:");
put(cinteres(c,i,a,n,s),fore=>5,aft=>2,exp=>0);

when 5=>
put_line("introduzca el periodo que desea obtener:");
get(s);
if s>n then
put_line("el periodo seleccionado es mayor que los periodos de amortizacion del prestamo");
exit;
end if;
put_line("el saldo del prestamo es:");
put(saldo(c,i,a,n,s),fore=>5,aft=>2,exp=>0);
when others=>
put_line("La Opcion Es Incorrecta");
trabadministracion;


end case;
end loop; ----------fin del menu del prestamo fraces
when others=>
put_line("La Opcion Es Incorrecta");
trabadministracion;

end case;
end loop; ---fin del menu prestamos


when others=>
put_line("La Opcion Es Incorrecta");
trabadministracion;
end case;
--Creamos Las Excepciones Necesarias.").
Exception
When Data_error =>
new_line;
put_line("Los Parametros Introducidos Son Incorrectos");
skip_line;
new_line;
When others=>
Put_Line("Error Desconocido");
New_Line;
end;
end loop; ---fin menu principal
End trabadministracion;