{+doc
+NOMBRE: NucleoT
+CREACION:  10.9.92 - marzo.2004.rch. Reescribo para FPK-WIN32
+AUTORES:  rch@todo.com.uy
+REGISTRO:
+TIPO: Unidad Pascal.
+PROPOSITO:
 Proporcionar un mecanismo s˘lido para el despacho de envntos de
 simulaciones temporales en base a Ser.
 Los Seres deben ser programados como refinamientos de la clase
 TSer. Al crear una instancia de TSer se le indica el Escenario
 al que pertenece. El escenario tiene su instancia de TNucleoT que ser 
 el mecanismo de despacho de los eventos temporales sobre los Seres
 para que estos "juegen" en la simulaci˘n.

 Adem s de los Seres se pueden inscribir en el Nucleo de tiempos tareas
 a ser realizadas cuando sucedan determinados eventos.
 Por ejemplo, la captura de resultados de simulaci˘n o el fin de la simulaci˘n.

 La inscripci˘n de los Seres en el Nucleo de Tiempos es AUTOMATICA.

+PROYECTO: Simenerg

+REVISION:
+AUTOR:
+DESCRIPCION:
-doc}



unit NucleoT;
interface
uses
	horrores,
	Task2;


{ 	Los Tipos
	---------
}
type

	T_Anio = LongInt;
	T_DiaDelAnio = 1 .. 367;
	T_Mes = (Enero, Febrero, Marzo,
				Abril, Mayo, Junio,
		 Julio, Agosto, Setiembre,
		 Octubre, Noviembre, Diciembre);

	T_SemanaDelMes = 1..4;
	T_DiaDeLaSemana = (Domingo, Lunes, Martes, Miercoles,
		        Jueves, Viernes, Sabado);

	T_Estacion = ( Otonio, Invierno, Primavera, Verano );
	T_Hora = 0..23;
	T_Minuto = 0..59;
        T_Segundo = 0..59;
	T_DiaDelMes = 1..31;
	T_Horario = ( Nocturno, Diurno );

	T_Latido = (Lat_SinInicializar, Lat_Segundo, Lat_Minuto, Lat_Hora,
					Lat_Dia, Lat_Mes, Lat_Anio);




const
{	Consideramos las estaciones comenzando junto con algunos meses }
	MesComienzoDeEstacion: array[T_Estacion] of T_Mes =
		( Marzo, Junio, Setiembre,Diciembre);

{ Cambios de horarios }
	HoraEntradaHorarioDiurno = 6;
	HoraEntradaHorarioNocturno = 18;



{

Definimos la clase TNucleoT.
Esta clase tendr  el "tiempo" actual de una simulaci˘n.

}
type
  TNucleoT= class
{
 Estado del Nucleo de Tiempo
 ---------------------------
	El siguietne conjunto de variables definen el instante de tiempo
actual donde se encuentra el Nucleo de tiempos.
 }
	Anio: T_Anio;
	Estacion: T_Estacion;
	Mes: T_Mes;
	DiaDelAnio: T_DiaDelAnio;
	DiaDelMes: T_DiaDelMes;
	DiaDeLaSemana: T_DiaDeLaSemana;
	SemanaDelMes: T_SemanaDelMes;
	Hora: T_Hora;
	Minuto: T_Minuto;
	Segundo: T_Segundo;
	Horario: T_Horario;
	Latido: T_Latido;

{ DiasDelMesActual, se mantiene actualizada cada cambio de mes,
reflejando la cantidad de dĦas del mes en curso }
		  DiasDelMesActual: T_DiaDelMes;


{ Los Despachadores.
  ------------------
	Los siguientes despachadores son £tiles para inscribir tareas
en los mismos para que se ejecuten con los diferentes latidos del
Nucleo de Tiempos
}

	CadaSegundo: TDespachador_CadaSegundo;
	CadaMinuto: TDespachador_CadaMinuto;
	CadaHora: TDespachador_CadaHora;
	CadaDia: TDespachador_CadaDia;
	CadaSemana: TDespachador_CadaSemana;
	CadaMes: TDespachador_CadaMes;
	CambioEstacion: TDespachador_CambioEstacion;
	CadaAnio: TDespachador_CadaAnio;
	CambioHorario: TDespachador_CambioHorario;

private
	procedure Tic_Semana;
	procedure Tic_CambioEstacion;

public
{ Inicializa el Nucleo de Tiempo al instante indicado }
procedure FijarInstante(
	xAnio: T_Anio;
	xMes: T_Mes;
	xDiaDelMes: T_DiaDelMes;
	xHora: T_Hora;
	xMinuto: T_Minuto;
		  xSegundo:T_Segundo);


{ 	Los TICs del Nucleo de Tiempos.
	------------------------------
Tics del NDT. Llamando a cualquiera de estos procedimientos
se le da un Tic al NDT al nivel que sugiere el nombre del procedimiento
por ejemplo, si se llama a (Tic_Minuto) se avanzar  en unminuto el tiempo
actual del NDT, si en cambio se llama a (Tic_Dia) si avnazar  un dĦa el
tiempo }
  procedure Tic_Segundo;
  procedure Tic_Minuto;
  procedure Tic_Hora;
  procedure Tic_Dia;
  procedure Tic_Mes;
  procedure Tic_Anio;

  procedure Tic; // llama al correspondiente de acuerdo al valor de Latido

  constructor Create(
	xAnio: T_Anio;
	xMes: T_Mes;
	xDiaDelMes: T_DiaDelMes;
	xHora: T_Hora;
	xMinuto: T_Minuto;
        xSegundo:T_Segundo);

  procedure Free;
end;


{ Retorna TRUE si el a¤o pasado como par metro es bisiesto }
function Bisiesto( Anio: T_Anio ):boolean;

{ Retorna los dĦas del a¤o pasado como par metro. Los valores posibles
son 365 si el a¤o es bisiesto y 366 si no lo es }
function DarDiasDelAnio( Anio: T_Anio):integer;

{ Retorna el dĦa del a¤o correspondiente la fecha pasada como par metro
	Por ej: DarDiaDelAnio(1992, Enero, 1) devuelve 1 pues es el primer
dĦa del a¤o. }
function DarDiaDelAnio( Anio: T_Anio; Mes:T_Mes; DiaDelMes: T_DiaDelMes): T_DiaDelAnio;

{ Retorna el dĦa de la semana que corresponde a una fecha dada }
function DarDiaDeLaSemana(
	Anio: T_Anio;
	Mes:T_Mes;
	DiaDelMes: T_DiaDelMes): T_DiaDeLaSemana;


{ retorna TRUE si la fecha A es anterior ( o igual ) a la fecha B }
function EnOrdenCronologico(
	AnioA: T_Anio;
	MesA: T_Mes;
	DiaA: T_DiaDelMes;
	AnioB: T_Anio;
	MesB: T_Mes;
	DiaB: T_DiaDelMes ): boolean;


{ Retorna la distancia en dĦas (con signo) entre ambas fechas }
function DistanciaEnDias(
	AnioA: T_Anio;
	MesA: T_Mes;
	DiaA: T_DiaDelMes;
	AnioB: T_Anio;
	MesB: T_Mes;
	DiaB: T_DiaDelMes ): LongInt;

implementation



{  Definici˘n de la duraci˘n de cada uno de los meses.
	La duraci˘n del mes de febrero, se actuliza cada Cambio de A¤o
teniendo en cuenta los que son bisiestos y los que no}
const
	DiasDelMes:array[T_Mes] of T_DiaDelMes = (
							31, 28, 31,
							30, 31, 30,
							31, 31, 30,
							31, 30, 31 );



{ SwV, ( Swaps Variables) , conmuta (n) bytes de la posici˘n de memoria
de la varible (x) a la de la variable (y). }
procedure SwV( var x; var y; n: integer);
var
	k:integer;
	z:byte; { buffer para intercambio }
type
	w = record
		l,h:byte;
	end;
var
	px, py:^w;

begin
	px:= @w(x).l;
	py:= @w(y).l;

	for k:= 1 to n do
	begin
		z:= px^.l; px^.l:= py^.l; py^.l:= z;
		px:= @w(x).h; py:= @w(y).h;
	end
end;



function DarDiaDeLaSemana(
	Anio: T_Anio;
	Mes:T_Mes;
	DiaDelMes: T_DiaDelMes): T_DiaDeLaSemana;

var
	dd: LongInt;
	DDS: T_DiaDeLaSemana;

begin
	{ Tomaremos como fecha base el:
		 Lunes, 18 de Junio de 1962 }

	dd:= DistanciaEnDias( 1962, Junio, 18,
												Anio, Mes,   DiaDelMes );
	dd :=(Ord(Lunes)+ dd) mod 7;
	DDS:= Domingo;
	if dd>= 0 then
		Inc(DDS, dd)
	else
		Inc(DDS, 7+dd);
	DarDiaDeLaSemana:=DDS
end;





{ Retorna TRUE si el a¤o pasado como par metro es bisiesto }
function Bisiesto( Anio: T_Anio ):boolean;
begin
	Bisiesto:=(( Anio mod 4 ) = 0)and(( Anio mod 1000)<>0)
end;

{ retorna TRUE si la fecha B es posterior ( o igual ) a la fecha A }
function EnOrdenCronologico(
	AnioA: T_Anio;
	MesA: T_Mes;
	DiaA: T_DiaDelMes;
	AnioB: T_Anio;
	MesB: T_Mes;
	DiaB: T_DiaDelMes ):boolean;
begin
	if AnioA>AnioB then EnOrdenCronologico:=false
	else if MesA>MesB then EnOrdenCronologico:=false
	else if DiaA>DiaB then EnOrdenCronologico:=false
	else EnOrdenCronologico:=true
end;





function DistanciaEnDias(
	AnioA: T_Anio;
	MesA: T_Mes;
	DiaA: T_DiaDelMes;
	AnioB: T_Anio;
	MesB: T_Mes;
	DiaB: T_DiaDelMes ):LongInt;
var
	DA: LongInt;
	signo: integer;
	kAnio:T_Anio;

begin

	{ Obligo a los datos a estar en orden cronologico }
	if Not EnOrdenCronologico (
		AnioA, MesA, DiaA,
		AnioB, MesB, DiaB) then
		begin
			SWV(AnioA,AnioB,SizeOf(T_Anio));
			SWV(MesA,MesB,SizeOf(T_Mes));
			SWV(DiaA,DiaB,SizeOf(T_DiaDelMes));
			Signo:= -1;
		end
	else
		Signo:=1;

	DA:= 0;

	kAnio:= AnioA;
	while  kAnio < AnioB do
	begin
		DA:= DA+ DarDiasDelAnio(kAnio);
		inc(kAnio);
	end;
	DA:= DA + DarDiaDelAnio(AnioB, MesB, DiaB);
	DA:= DA - DarDiaDelAnio(AnioA, MesA, DiaA);

	DistanciaEnDias:= DA * signo
end;


{ --------- Definici˘n de los TICs ----------------}

procedure TNucleoT.Tic_Semana;
begin
	if SemanaDelMes = 4 then
		SemanaDelMes:= 1
	else inc(SemanaDelMes);

	CadaSemana.run;
end;


procedure TNucleoT.Tic_CambioEstacion;
begin
	Estacion := T_Estacion((integer(Estacion)+1) mod 4);
	CambioEstacion.run;
end;


procedure TNucleoT.Tic_Segundo;
begin
	if Segundo = 59 then
	begin
		Segundo:=0;
		Tic_Minuto;
	end
	else inc(Segundo);

	CadaSegundo.run;
end;



procedure TNucleoT.Tic_Minuto;
begin
	if Minuto = 59 then
	begin
		Minuto:=0;
		Tic_Hora;
	end
	else inc(Minuto);

	CadaMinuto.run;
end;

procedure TNucleoT.Tic_Hora;
begin
	if Hora = HoraEntradaHorarioDiurno then
	begin
		Horario:= Diurno;
		CambioHorario.run;
	end
	else
		if Hora = HoraEntradaHorarioNocturno then
		begin
			Horario:= Nocturno;
			CambioHorario.run;
		end;

	if Hora = 23 then
	begin
		Hora:= 0;
		Tic_Dia;
	end
	else inc(Hora);

	CadaHora.run;
end;

procedure TNucleoT.Tic_Dia;
begin

	inc( DiaDelAnio );

	if DiaDeLaSemana = Sabado then
	begin
		DiaDeLaSemana:= Domingo;
		Tic_Semana;
	end
	else inc(DiaDeLaSemana);

	if DiaDelMes =  DiasDelMesActual then
	begin
		DiaDelMes:= 1;
		Tic_Mes;
	end
	else Inc(DiaDelMes);

	CadaDia.run;
end;


procedure TNucleoT.Tic_Mes;
begin
	if Mes = Diciembre then
	begin
		Mes:=Enero;
		Tic_Anio;
	end
	else
		Inc(Mes);

	DiasDelMesActual:=DiasDelMes[Mes];

	if MesComienzoDeEstacion[ T_Estacion((integer(Estacion)+1) mod 4)] = mes then
		
		Tic_CambioEstacion;

	CadaMes.run;
end;


procedure TNucleoT.Tic_Anio;
begin
	inc(Anio);
	DiaDelAnio:=1;

	if bisiesto( Anio) then
		DiasDelMes[Febrero]:=29
	else DiasDelMes[Febrero]:=28;

	CadaAnio.run;
end;



procedure TNucleoT.Tic;
begin
	case Latido of
		Lat_Segundo: Tic_Segundo;
		Lat_Minuto: Tic_Minuto;
		Lat_Hora: Tic_Hora;
		Lat_Dia: Tic_Dia;
		Lat_Mes: Tic_Mes;
		Lat_Anio: Tic_Anio;
	else
		error('La variable TNucleoT.Latido no fue inicializada');
	end;
end;



{ --------------Fin de los TICs -------------------}


function DarDiasDelAnio( Anio: T_Anio):integer;
begin
	if Bisiesto(Anio) then DarDiasDelAnio:=366
	else DarDiasDelAnio:=365;
end;

function DarDiaDelAnio( Anio: T_Anio; Mes:T_Mes; DiaDelMes: T_DiaDelMes): T_DiaDelAnio;
var
	kMes: T_Mes;
	DiasDeFebrero: T_DiaDelMes;
	A: T_DiaDelAnio;

begin

	DiasDeFebrero:= DiasDelMes[Febrero];

	if Bisiesto( Anio ) then DiasDelMes[Febrero]:=29
	else DiasDelMes[Febrero]:=28;


	A:= DiaDelMes;
	kMes:= Enero;
	while kMes< Mes do
	begin
		A:=A+DiasDelMes[kMes];
		inc(kMes)
	end;

	DiasDelMes[Febrero]:=DiasDeFebrero;
	DarDiaDelAnio:= A;
end;

procedure TNucleoT.FijarInstante(
	xAnio: T_Anio;
	xMes: T_Mes;
	xDiaDelMes: T_DiaDelMes;
	xHora: T_Hora;
	xMinuto: T_Minuto;
		  xSegundo: T_Segundo);

var
	kMes: T_Mes;
begin

	if (xHora < HoraEntradaHorarioNocturno)
			and(xHora> HoraEntradaHorarioDiurno) then
		Horario:= Diurno
	else Horario:= NOcturno;

	{ Fijamos el a¤o }
	Anio:= xAnio;

	{ Acomodamos los dĦas del mes de febrero }
	if bisiesto( Anio )then
		DiasDelMes[Febrero]:=29
	else DiasDelMes[Febrero]:=28;

	{ Fijamos el mes }
	Mes:= xMes;

	{ Fijamos la Estaci˘n }
	if Mes < MesComienzoDeEstacion[Otonio] then Estacion:=Verano
	else if Mes < MesComienzoDeEstacion[Invierno] then Estacion:=Otonio
	else if Mes < MesComienzoDeEstacion[Primavera] then Estacion:=Invierno
	else Estacion:=Primavera;

	{ Fijamos l dĦa del Mes }
	DiaDelMes:= xDiaDelMes;
	if DiaDelMes>DiasDelMes[Mes] then RunError(201);

	{ Inicializamos DiasDelMesActual }
	DiasDelMesActual:=DiasDelMes[Mes];

	{ Fijamos dĦa del A¤o }
	DiaDelAnio:= DiaDelMes;
	kMes:= Enero;
	while kMes< Mes do
	begin
		DiaDelAnio:=DiaDelAnio+DiasDelMes[kMes];
		inc(kMes);  // ???.rch.marzo.2004 BUG faltaba incrementar
	end;


	{ Fijamos el dĦa de la semana }
	DiaDeLaSemana:= DarDiaDeLaSemana(Anio,Mes,DiaDelMes);


	{ Fijamos la semana del mes }
	SemanaDelMes:= trunc((DiaDelMes-1)/DiasDelMesActual *4)+1;

	{ Fijamos la hora }
	Hora:= xHora;

	{ Fijamos el Minuto }
	Minuto:= xMinuto;

        { Fijamos el Segundo }
        Segundo:= xSegundo;
end;


constructor TNucleoT.Create(
	xAnio: T_Anio;
	xMes: T_Mes;
	xDiaDelMes: T_DiaDelMes;
	xHora: T_Hora;
	xMinuto: T_Minuto;
		  xSegundo:T_Segundo);



begin
	inherited Create;
	Latido:= Lat_SinInicializar;
	FijarInstante(xAnio,xMes,xDiaDelMes,
								xHora,xMinuto,xSegundo);

	CadaSegundo:= TDespachador_CadaSegundo.Create;
	CadaMinuto:= TDespachador_CadaMinuto.Create;
	CadaHora:= TDespachador_CadaHora.Create;
	CadaDia:= TDespachador_CadaDia.Create;
	CadaSemana:= TDespachador_CadaSemana.Create;
	CadaMes:= TDespachador_CadaMes.Create;
	CambioEstacion:= TDespachador_CambioEstacion.Create;
	CadaAnio:= TDespachador_CadaAnio.Create;
	CambioHorario:= TDespachador_CambioHorario.Create;
end;

procedure TNucleoT.Free;
begin
  CadaSegundo.Free;
  CadaMinuto.Free;
  CadaHora.Free;
  CadaDia.Free;
  CadaSemana.Free;
  CadaMes.Free;
  CambioEstacion.Free;
  CadaAnio.Free;
  CambioHorario.Free;
  inherited Free;
end;


end.
