|
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: 11264 (0x2c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Document, seg_048bd3, seg_048c80, seg_048d95
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Text_Io, Nos_Chaines, String_Utilities, Display;
package body Document is
--------------------------------------------------------------------
--
-- Procedure Enter permet de lire une ligne de commande du joueur
-- par un simple " Get_Line " dans la fenetre.
--
--------------------------------------------------------------------
procedure Enter (An_Instruction : out String; Instr_Len : out Natural) is
begin
Display.Read_Player (An_Instruction, Instr_Len);
end Enter;
------------------------------------------------------------------------------
procedure Open is
begin
Text_Io.Set_Input (Text_Io.Standard_Input);
exception
when others =>
Text_Io.Put_Line ("Erreur open");
end Open;
------------------------------------------------------------------------------
procedure Close is
begin
Text_Io.Put_Line ("fin de programme");
Text_Io.Set_Input (Text_Io.Standard_Input);
exception
when others =>
Text_Io.Put_Line ("Erreur Close");
end Close;
------------------------------------------------------------------------------
--
-- Fonction permettant de mettre en minuscule : Get_To_Lower.
--
-- Fonction utilisee par Get.
--
------------------------------------------------------------------------------
procedure Get_To_Lower (S : in out String; Length : Natural) is
begin
for I in Length + 1 .. S'Last loop
S (I) := ' ';
end loop;
String_Utilities.Lower_Case (S);
end Get_To_Lower;
------------------------------------------------------------------------------
procedure Get (Table_Of_Word : in out Mots.T_Tab_Commande;
Number_Of_Words : out Mots.Number) is
Num_Of_Words : Mots.Number := 0;
Existe_Instruction : Boolean := False;
Error_Number : Boolean := False;
Tmp_Char : Character;
Tmp_Word, Tmp1_Word : Mots.Word;
Tmp_String : String (1 .. 80);
Line_Len : Natural := 0;
Word_Len : Natural := 0;
begin
Enter (Tmp_String, Line_Len);
Get_To_Lower (Tmp_String, Line_Len);
if Line_Len > 0 then
Tmp_Word := Nos_Chaines.Unbounded_Value (Tmp_String);
for Indice in 1 .. Line_Len loop
Tmp_Char := Nos_Chaines.Char_At_Pos (Tmp_Word, Indice);
case Tmp_Char is
when 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' =>
Nos_Chaines.Infinite_String.Append
(Tmp1_Word, Tmp_Char);
Word_Len := Word_Len + 1;
Existe_Instruction := True;
if Indice = Line_Len then
if Word_Len > 0 then
if Num_Of_Words >= Mots.Max_Number_Words then
Error_Number := True;
exit;
else
Num_Of_Words := Num_Of_Words + 1;
Nos_Chaines.Copy
(Table_Of_Word (Num_Of_Words),
Tmp1_Word);
Nos_Chaines.Free (Tmp1_Word);
Nos_Chaines.Free (Tmp_Word);
Word_Len := 0;
end if;
else
if not Existe_Instruction then
Table_Of_Word (1) :=
Nos_Chaines.Unbounded_Value ("nothing");
end if;
end if;
end if;
when others =>
if Word_Len > 0 then
if Num_Of_Words >= Mots.Max_Number_Words then
Error_Number := True;
exit;
else
Num_Of_Words := Num_Of_Words + 1;
Nos_Chaines.Copy
(Table_Of_Word (Num_Of_Words), Tmp1_Word);
Nos_Chaines.Free (Tmp1_Word);
Word_Len := 0;
end if;
end if;
end case;
end loop;
if Error_Number then
Number_Of_Words := Mots.Max_Number_Words + 1;
else
Number_Of_Words := Num_Of_Words;
end if;
else
Number_Of_Words := Num_Of_Words;
end if;
exception
when Constraint_Error =>
raise Mot_Trop_Long;
when others =>
Text_Io.Put_Line ("Erreur get!");
end Get;
--------------------------------------------------------------------
end Document;
nblk1=a
nid=2
hdr6=e
[0x00] rec0=21 rec1=00 rec2=01 rec3=038
[0x01] rec0=00 rec1=00 rec2=07 rec3=012
[0x02] rec0=1f rec1=00 rec2=04 rec3=020
[0x03] rec0=12 rec1=00 rec2=09 rec3=062
[0x04] rec0=13 rec1=00 rec2=0a rec3=062
[0x05] rec0=15 rec1=00 rec2=05 rec3=05e
[0x06] rec0=12 rec1=00 rec2=06 rec3=000
[0x07] rec0=15 rec1=00 rec2=05 rec3=05e
[0x08] rec0=12 rec1=00 rec2=06 rec3=000
[0x09] rec0=12 rec1=00 rec2=06 rec3=000
tail 0x215461626865a8253bb5b 0x42a00088462060003
Free Block Chain:
0x2: 0000 00 08 03 fc 80 39 20 20 20 20 20 20 46 69 6c 74 ┆ 9 Filt┆
0x8: 0000 00 03 00 8d 00 3f 20 20 20 20 20 20 20 20 66 75 ┆ ? fu┆
0x3: 0000 00 00 01 a8 80 15 64 5f 56 61 6c 75 65 20 28 54 ┆ d_Value (T┆