|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 8192 (0x2000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Recherche_Jour, seg_03d510
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Type_Date, Text_Io, Integer_Text_Io;
use Type_Date, Text_Io, Integer_Text_Io;
procedure Recherche_Jour is
Date : D;
An_Biss, Nb_An, Last, Nb_An_Biss, Nb_J : Natural;
Jour : J;
Annee : A;
Ch : String (1 .. 35);
Z : Natural range 0 .. 12;
Mois : M;
--*************************************************
procedure Lecture (Date : in out D;
Last : in out Natural;
Mo : out M;
Annee : in out A) is
K : Integer range 0 .. 2;
Aux, I, U : Natural;
begin
loop
begin
K := 0;
U := 0;
Aux := 1;
Put ("Entrer la date: ");
Get_Line (Ch, Last);
for I in 1 .. Last loop
if (Ch (I) = ' ') and (I = 1) and (Ch (I + 1) = ' ') then
U := 0;
end if;
if (Ch (I) = ' ') and (I = 1) and (Ch (I + 1) /= ' ') then
Aux := I + 1;
end if;
if (I > 1) and then
((Ch (I - 1) = ' ') and (Ch (I) = ' ') and
(Ch (I + 1) = ' ')) then
U := 0;
end if;
if (I > 1) and then
((Ch (I - 1) /= ' ') and (Ch (I) = ' ') and
(Ch (I + 1) = ' ')) then
U := 1;
end if;
if (I > 1) and then
((Ch (I - 1) = ' ') and (Ch (I) = ' ') and
(Ch (I + 1) /= ' ')) then
U := 1;
end if;
if (I > 1) and then
((Ch (I - 1) /= ' ') and (Ch (I) = ' ') and
(Ch (I + 1) /= ' ')) then
U := 1;
end if;
if I = Last then
Annee := A'Value (Ch (Aux .. I));
exit;
end if;
if (Ch (I) = ' ') and (K < 3) and (U = 1) then
case K is
when 0 =>
Date := D'Value (Ch (Aux .. (I - 1)));
K := K + 1;
when 1 =>
Mo := Mo'Value (Ch (Aux .. (I - 1)));
K := K + 1;
when 2 =>
Annee := A'Value (Ch (Aux .. I));
exit;
K := K + 1;
when others =>
null;
end case;
end if;
if (I > 1) and then
((Ch (I - 1) /= ' ') and (Ch (I) = ' ') and
(Ch (I + 1) /= ' ')) then
Aux := I + 1;
end if;
end loop;
exit;
exception
when Constant_Error =>
New_Line;
Put_Line ("date incorrecte...");
New_Line;
end;
end loop;
end Lecture;
begin
loop
loop
Lecture (Date, Last, Mois, Annee);
Nb_An := Annee - 1901;
An_Biss := (Nb_An) mod (4);
case Mois is
when Avril | Juin | Septembre | Novembre =>
if Date > 30 then
Put ("date incorrecte");
New_Line;
else
exit;
end if;
when Fevrier =>
if An - Biss = 3 then
if Date > 29 then
Put ("date incorrecte");
New_Line;
else
exit;
end if;
else
if Date > 28 then
Put ("date incorrecte");
New_Line;
else
exit;
end if;
end if;
when others =>
exit;
end case;
end loop;
if (Annee < 1901) or (Annee > 2000) then
exit;
end if;
Nb_An_Biss := Nb_An / 4;
if (An_Biss = 3) and (Mois > Fevrier0) then
Nb_J := ((Nb_An - Nb_An_Biss) * 365) + (Nb_An_Biss * 366) + 1;
else
Nb_J := ((Nb_An - Nb_An_Biss) * 365) + (Nb_An_Biss * 366);
end if;
case Mois is
when Fevrier =>
Nb_J := Nb_J + 31;
when Mars =>
Nb_J := Nb_J + 59;
when Fevrier =>
Nb_J := Nb_J + 90;
when Fevrier =>
Nb_J := Nb_J + 120;
when Fevrier =>
Nb_J := Nb_J + 151;
when Fevrier =>
Nb_J := Nb_J + 181;
when Fevrier =>
Nb_J := Nb_J + 212;
when Fevrier =>
Nb_J := Nb_J + 243;
when Fevrier =>
Nb_J := Nb_J + 273;
when Fevrier =>
Nb_J := Nb_J + 304;
when Fevrier =>
Nb_J := Nb_J + 334;
when others =>
null;
end case;
Put ("le ");
Put (Ch (1 .. Last));
Put (" est un ");
Put (J'Image (Jour));
New_Line;
end loop;
end Recherche_Jour;
nblk1=7
nid=0
hdr6=e
[0x00] rec0=24 rec1=00 rec2=01 rec3=00a
[0x01] rec0=19 rec1=00 rec2=03 rec3=026
[0x02] rec0=18 rec1=00 rec2=02 rec3=04c
[0x03] rec0=1e rec1=00 rec2=04 rec3=036
[0x04] rec0=1b rec1=00 rec2=06 rec3=01e
[0x05] rec0=2c rec1=00 rec2=05 rec3=010
[0x06] rec0=02 rec1=00 rec2=07 rec3=001
tail 0x21535c8c285f84f07447d 0x42a00088462060003