|
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: 44032 (0xac00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Complement, seg_049b68, seg_049c0a, seg_049c1f
└─⟦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 Complement_Identifier_Array, Field_Identifier_Array, Screen;
package body Complement is
procedure Copy (Input_Item : in Object; Output_Item : in out Object) is
begin
Output_Item := Input_Item;
case Input_Item.Kind is
when Animate =>
Field_List.Free (Output_Item.Animate_Fields);
Field_List.Copy (Input_Item.Animate_Fields,
Output_Item.Animate_Fields);
when Place =>
Field_List.Free (Output_Item.Place_Fields);
Field_List.Copy (Input_Item.Place_Fields,
Output_Item.Place_Fields);
when Entity =>
Field_List.Free (Output_Item.Entity_Fields);
Field_List.Copy (Input_Item.Entity_Fields,
Output_Item.Entity_Fields);
when Word | Verb | Unknown =>
null;
end case;
end Copy;
procedure Put_Name (Item : in out Object;
Name : in Identifier.Object;
Ok : out Boolean) is
begin
case Item.Kind is
when Animate =>
Item.Animate_Name := Name;
Item.Animate_Group := Name;
Ok := True;
when Place =>
Item.Place_Name := Name;
Item.Place_Group := Name;
Ok := True;
when Entity =>
Item.Entity_Name := Name;
Item.Entity_Group := Name;
Ok := True;
when Word | Verb | Unknown =>
Ok := False;
end case;
end Put_Name;
procedure Put_Word (Item : in out Object; A_Word : in Identifier.Object) is
Ok : Boolean;
begin
Item := (Kind => Word, Word_Value => A_Word, Word_Group => A_Word);
end Put_Word;
procedure Put_Verb (Item : in out Object;
A_Synonym, A_Verb : in Identifier.Object) is
Ok : Boolean;
begin
Item := (Kind => Verb, Verb_Value => A_Synonym, Verb_Group => A_Verb);
end Put_Verb;
procedure Get_Fields (Item : in Object;
List : out Field_List.Object;
Ok : out Boolean) is
begin
Ok := True;
case Item.Kind is
when Animate =>
List := Item.Animate_Fields;
when Place =>
List := Item.Place_Fields;
when Entity =>
List := Item.Entity_Fields;
when Word | Verb | Unknown =>
Ok := False;
end case;
end Get_Fields;
procedure Get_Field (Item : in Object;
A_Field : out Field.Object;
Field_Index : in Positive;
Ok : out Boolean) is
List : Field_List.Object;
Local_Ok : Boolean;
begin
Get_Fields (Item, List, Local_Ok);
if Local_Ok then
Field_List.Get (List, A_Field,
Field_Identifier_Array.Image (Field_Index), Ok);
else
Ok := False;
end if;
end Get_Field;
procedure Put_Field (Item : in out Object; A_Field : in Field.Object) is
List : Field_List.Object;
Local_Ok : Boolean;
begin
case Item.Kind is
when Animate =>
Field_List.Put (Item.Animate_Fields, A_Field);
when Place =>
Field_List.Put (Item.Place_Fields, A_Field);
when Entity =>
Field_List.Put (Item.Entity_Fields, A_Field);
when Word | Verb | Unknown =>
null;
end case;
end Put_Field;
procedure Create_Number_Field (Item : in out Object;
Field_Index : in Positive;
Ok : out Boolean) is
A_Field : Field.Object;
begin
if Is_A_Subject (Item) and not Field_Belong (Item, Field_Index) then
Field.Create_Number (A_Field, Field_Index);
Put_Field (Item, A_Field);
Ok := True;
else
Ok := False;
end if;
end Create_Number_Field;
procedure Create_Sentence_Field (Item : in out Object;
Field_Index : in Positive;
Ok : out Boolean) is
A_Field : Field.Object;
begin
if Is_A_Subject (Item) and not Field_Belong (Item, Field_Index) then
Field.Create_Sentence (A_Field, Field_Index);
Put_Field (Item, A_Field);
Ok := True;
else
Ok := False;
end if;
end Create_Sentence_Field;
procedure Create_Enumerate_Field (Item : in out Object;
Field_Index : in Positive;
Ok : out Boolean) is
A_Field : Field.Object;
begin
if Is_A_Subject (Item) and not Field_Belong (Item, Field_Index) then
Field.Create_Enumerate (A_Field, Field_Index);
Put_Field (Item, A_Field);
Ok := True;
else
Ok := False;
end if;
end Create_Enumerate_Field;
procedure Field_Put_Number (Item : in out Object;
Field_Index : in Positive;
Number : in Integer;
Ok : out Boolean) is
A_Field : Field.Object;
Local_Ok : Boolean;
begin
Get_Field (Item, A_Field, Field_Index, Local_Ok);
if Local_Ok then
Field.Put_Number (A_Field, Number, Local_Ok);
if Local_Ok then
Put_Field (Item, A_Field);
end if;
end if;
Ok := Local_Ok;
end Field_Put_Number;
procedure Field_Put_Sentence (Item : in out Object;
Field_Index : in Positive;
Sentence : in Identifier.Object;
Ok : out Boolean) is
A_Field : Field.Object;
Local_Ok : Boolean;
begin
Get_Field (Item, A_Field, Field_Index, Local_Ok);
if Local_Ok then
Field.Put_Sentence (A_Field, Sentence, Local_Ok);
if Local_Ok then
Put_Field (Item, A_Field);
end if;
end if;
Ok := Local_Ok;
end Field_Put_Sentence;
procedure Field_Put_Enumerate (Item : in out Object;
Field_Index : in Positive;
Enumeration, Literal : in Positive;
Ok : out Boolean) is
A_Field : Field.Object;
Local_Ok : Boolean;
begin
Get_Field (Item, A_Field, Field_Index, Local_Ok);
if Local_Ok then
Field.Put_Enumerate (A_Field, Enumeration, Literal, Local_Ok);
if Local_Ok then
Put_Field (Item, A_Field);
end if;
end if;
Ok := Local_Ok;
end Field_Put_Enumerate;
procedure Put_Movement (Item : in out Object; Place : in Positive) is
Place_Index : Index.Object;
Iterator : Place_List.Iterator;
Temporary_List : Place_List.List;
begin
if Item.Animate_Place = 0 then
Item.Animate_Place := Place;
end if;
if Item.Kind = Animate then
Place_List.Init (Iterator, Item.Trip);
while not Place_List.Done (Iterator) loop
Place_Index := Place_List.Value (Iterator);
Temporary_List := Place_List.Make (Place_Index, Temporary_List);
Place_List.Next (Iterator);
end loop;
Index.Put (Place_Index, Place);
Temporary_List := Place_List.Make (Place_Index, Temporary_List);
Place_List.Free (Item.Trip);
Place_List.Init (Iterator, Temporary_List);
while not Place_List.Done (Iterator) loop
Place_Index := Place_List.Value (Iterator);
Item.Trip := Place_List.Make (Place_Index, Item.Trip);
Place_List.Next (Iterator);
end loop;
end if;
end Put_Movement;
procedure Move (Item : in out Object) is
begin
if Item.Kind = Animate then
if not Place_List.Is_Empty (Item.Trip) then
if Place_List.Done (Item.Trip_Iterator) then
Place_List.Init (Item.Trip_Iterator, Item.Trip); end if;
Item.Animate_Place :=
Index.Value (Place_List.Value (Item.Trip_Iterator));
Place_List.Next (Item.Trip_Iterator);
end if;
end if;
end Move;
function Exit_Exist
(Item : in Object; Direction : in Positive) return Boolean is
begin
if Item.Kind = Place then
return Link_List.Belong
(Item.Exits, Complement_Identifier_Array.Image
(Direction));
else
return False;
end if;
end Exit_Exist;
function Exits_Exist (Item : in Object) return Boolean is
begin
if Item.Kind = Place then
return not Link_List.Is_Empty (Item.Exits);
else
return False;
end if;
end Exits_Exist;
procedure Put_Exit (Item : in out Object;
Name, Start_Place, Start_Direction,
Next_Place, Next_Direction : in Positive;
Ok : out Boolean) is
A_Link : Link.Object;
Local_Ok : Boolean;
begin
if Item.Kind = Place then
if not Exit_Exist (Item, Start_Direction) then
Link.Put (A_Link, Name, Start_Place, Start_Direction,
Next_Place, Next_Direction);
Link_List.Put (Item.Exits, A_Link);
Ok := True;
else
Ok := False;
end if;
end if;
end Put_Exit;
function Exit_Name
(Item : in Object; Direction : in Positive) return Natural is
A_Link : Link.Object;
Local_Ok : Boolean;
begin
if Item.Kind = Place then
Link_List.Get
(Item.Exits, A_Link,
Complement_Identifier_Array.Image (Direction), Local_Ok);
if Local_Ok then
return Link.Name (A_Link);
else
return 0;
end if;
return 0;
end if;
end Exit_Name;
function Next_Place
(Item : in Object; Direction : in Positive) return Natural is
A_Link : Link.Object;
Local_Ok : Boolean;
begin
if Item.Kind = Place then
Link_List.Get
(Item.Exits, A_Link,
Complement_Identifier_Array.Image (Direction), Local_Ok);
if Local_Ok then
return Link.Next_Place (A_Link);
end if;
end if;
return 0;
end Next_Place;
function Next_Direction
(Item : in Object; Direction : in Positive) return Natural is
A_Link : Link.Object;
Local_Ok : Boolean;
begin
if Item.Kind = Place then
Link_List.Get
(Item.Exits, A_Link,
Complement_Identifier_Array.Image (Direction), Local_Ok);
if Local_Ok then
return Link.Next_Direction (A_Link);
else
return 0;
end if;
end if;
end Next_Direction;
procedure Put_Place
(Item : in out Object; Place : in Natural; Ok : out Boolean) is
begin
if Item.Kind = Animate then
Item.Animate_Place := Place;
Ok := True;
elsif Item.Kind = Entity then
Item.Entity_Place := Place;
Ok := True;
else
Ok := False;
end if;
end Put_Place;
procedure Show (Item : in Object) is
Trip_Iterator : Place_List.Iterator;
begin
Screen.Write_Help_Window ("Complement : Type : " &
Complement_Kind'Image (Item.Kind));
Screen.New_Line_Help_Window;
case Item.Kind is
when Animate =>
Screen.Write_Help_Window
(" Nom : " & Name (Item) & " Lieu : " &
Complement_Identifier_Array.Image (Place (Item)));
Screen.New_Line_Help_Window;
Field_List.Show (Item.Animate_Fields);
Place_List.Init (Trip_Iterator, Item.Trip);
while not Place_List.Done (Trip_Iterator) loop
Index.Show (Place_List.Value (Trip_Iterator));
Place_List.Next (Trip_Iterator);
end loop;
when Place =>
Screen.Write_Help_Window (" Nom : " & Name (Item));
Screen.New_Line_Help_Window;
Field_List.Show (Item.Place_Fields);
Link_List.Show (Item.Exits);
when Entity =>
Screen.Write_Help_Window
(" Nom : " & Name (Item) & " Lieu : " &
Complement_Identifier_Array.Image (Place (Item)));
Screen.New_Line_Help_Window;
Field_List.Show (Item.Entity_Fields);
when Word =>
Screen.Write_Help_Window (" Nom : " & Name (Item));
Screen.New_Line_Help_Window;
when Verb =>
Screen.Write_Help_Window (" Nom : " & Name (Item));
Screen.New_Line_Help_Window;
when Unknown =>
Screen.New_Line_Help_Window;
end case;
end Show;
procedure List_Exits_Init (Item : in out Object) is
begin
if Item.Kind = Place then
Link_List.Init (Item.Exits_Iterator, Item.Exits);
end if;
end List_Exits_Init;
procedure List_Exits_Next (Item : in out Object) is
begin
if Item.Kind = Place then
Link_List.Next (Item.Exits_Iterator);
end if;
end List_Exits_Next;
function List_Exits_Direction (Item : in Object) return Natural is
begin
if Item.Kind = Place then
return Link.Start_Direction (Link_List.Value (Item.Exits_Iterator));
else
return 0;
end if;
end List_Exits_Direction;
function List_Exits_Done (Item : in Object) return Boolean is
begin
if Item.Kind = Place then
return Link_List.Done (Item.Exits_Iterator);
else
return True;
end if;
end List_Exits_Done;
procedure Put_Group (Item : in out Object;
A_Group : in Identifier.Object;
Ok : out Boolean) is
begin
case Item.Kind is
when Animate =>
if Group (Item) = Name (Item) then
Item.Animate_Group := A_Group;
Ok := True;
else
Ok := False;
end if;
when Place =>
if Group (Item) = Name (Item) then
Item.Place_Group := A_Group;
Ok := True;
else
Ok := False;
end if;
when Entity =>
if Group (Item) = Name (Item) then
Item.Entity_Group := A_Group;
Ok := True;
else
Ok := False;
end if;
when Word =>
if Group (Item) = Name (Item) then
Item.Word_Group := A_Group;
Ok := True;
else
Ok := False;
end if;
when Verb | Unknown =>
Ok := False;
end case;
end Put_Group;
function Group (Item : in Object) return String is
begin
case Item.Kind is
when Animate =>
return Identifier.Image (Item.Animate_Group);
when Place =>
return Identifier.Image (Item.Place_Group);
when Entity =>
return Identifier.Image (Item.Entity_Group);
when Word =>
return Identifier.Image (Item.Word_Group);
when Verb =>
return Identifier.Image (Item.Verb_Group);
when Unknown =>
return "";
end case;
end Group;
function Field_Is_A_Number
(Item : in Object; Field_Index : in Positive) return Boolean is
A_Field : Field.Object;
Local_Ok : Boolean;
begin
Get_Field (Item, A_Field, Field_Index, Local_Ok);
if Local_Ok then
return Field.Is_A_Number (A_Field);
else
return False;
end if;
end Field_Is_A_Number;
function Field_Is_A_Sentence
(Item : in Object; Field_Index : in Positive) return Boolean is
A_Field : Field.Object;
Local_Ok : Boolean;
begin
Get_Field (Item, A_Field, Field_Index, Local_Ok);
if Local_Ok then
return Field.Is_A_Sentence (A_Field);
else
return False;
end if;
end Field_Is_A_Sentence;
function Field_Is_An_Enumerate
(Item : in Object; Field_Index : in Positive) return Boolean is
A_Field : Field.Object;
Local_Ok : Boolean;
begin
Get_Field (Item, A_Field, Field_Index, Local_Ok);
if Local_Ok then
return Field.Is_An_Enumerate (A_Field);
else
return False;
end if;
end Field_Is_An_Enumerate;
function Field_Belong
(Item : in Object; Field_Index : in Positive) return Boolean is
List : Field_List.Object;
Local_Ok : Boolean;
begin
Get_Fields (Item, List, Local_Ok);
if Local_Ok then
return Field_List.Belong
(List, Field_Identifier_Array.Image (Field_Index));
else
return False;
end if;
end Field_Belong;
function Is_A_Subject (Item : in Object) return Boolean is
begin
return Item.Kind = Animate or Item.Kind = Place or Item.Kind = Entity;
end Is_A_Subject;
function Is_An_Animate (Item : in Object) return Boolean is
begin
return Item.Kind = Animate;
end Is_An_Animate;
function Is_A_Place (Item : in Object) return Boolean is
begin
return Item.Kind = Place;
end Is_A_Place;
function Is_An_Entity (Item : in Object) return Boolean is
begin
return Item.Kind = Entity;
end Is_An_Entity;
function Is_A_Word (Item : in Object) return Boolean is
begin
return Item.Kind = Word;
end Is_A_Word;
function Is_A_Verb (Item : in Object) return Boolean is
begin
return Item.Kind = Verb;
end Is_A_Verb;
function Name (Item : in Object) return String is
begin
case Item.Kind is
when Animate =>
return Identifier.Image (Item.Animate_Name);
when Place =>
return Identifier.Image (Item.Place_Name);
when Entity =>
return Identifier.Image (Item.Entity_Name);
when Word =>
return Identifier.Image (Item.Word_Value);
when Verb =>
return Identifier.Image (Item.Verb_Value);
when Unknown =>
return "";
end case;
end Name;
function Place (Item : in Object) return Natural is
begin
case Item.Kind is
when Animate =>
return Item.Animate_Place;
when Entity =>
return Item.Entity_Place;
when Place | Word | Verb | Unknown =>
return 0;
end case;
end Place;
function Field_Number
(Item : in Object; Field_Index : in Positive) return Integer is
A_Field : Field.Object;
Local_Ok : Boolean;
begin
Get_Field (Item, A_Field, Field_Index, Local_Ok);
if Local_Ok then
return Field.Number (A_Field);
else
return 0;
end if;
end Field_Number;
function Field_Sentence
(Item : in Object; Field_Index : in Positive) return String is
A_Field : Field.Object;
Local_Ok : Boolean;
begin
Get_Field (Item, A_Field, Field_Index, Local_Ok);
if Local_Ok then
return Field.Sentence (A_Field);
else
return "";
end if;
end Field_Sentence;
function Field_Enumeration
(Item : in Object; Field_Index : in Positive) return Natural is
A_Field : Field.Object;
Local_Ok : Boolean;
begin
Get_Field (Item, A_Field, Field_Index, Local_Ok);
if Local_Ok then
return Field.Enumeration (A_Field);
else
return 0;
end if; end Field_Enumeration;
function Field_Literal
(Item : in Object; Field_Index : in Positive) return Natural is
A_Field : Field.Object;
Local_Ok : Boolean;
begin
Get_Field (Item, A_Field, Field_Index, Local_Ok);
if Local_Ok then
return Field.Literal (A_Field);
else
return 0;
end if;
end Field_Literal;
end Complement;
nblk1=2a
nid=9
hdr6=32
[0x00] rec0=1a rec1=00 rec2=01 rec3=014
[0x01] rec0=22 rec1=00 rec2=18 rec3=02e
[0x02] rec0=1c rec1=00 rec2=23 rec3=042
[0x03] rec0=21 rec1=00 rec2=05 rec3=00a
[0x04] rec0=1d rec1=00 rec2=1e rec3=008
[0x05] rec0=1e rec1=00 rec2=14 rec3=032
[0x06] rec0=1d rec1=00 rec2=26 rec3=03e
[0x07] rec0=1f rec1=00 rec2=1c rec3=02e
[0x08] rec0=17 rec1=00 rec2=29 rec3=002
[0x09] rec0=22 rec1=00 rec2=11 rec3=056
[0x0a] rec0=1f rec1=00 rec2=27 rec3=01e
[0x0b] rec0=01 rec1=00 rec2=1f rec3=03e
[0x0c] rec0=24 rec1=00 rec2=0e rec3=05a
[0x0d] rec0=22 rec1=00 rec2=20 rec3=026
[0x0e] rec0=13 rec1=00 rec2=03 rec3=026
[0x0f] rec0=21 rec1=00 rec2=0c rec3=010
[0x10] rec0=07 rec1=00 rec2=28 rec3=010
[0x11] rec0=21 rec1=00 rec2=21 rec3=022
[0x12] rec0=1d rec1=00 rec2=06 rec3=060
[0x13] rec0=23 rec1=00 rec2=1b rec3=012
[0x14] rec0=23 rec1=00 rec2=1d rec3=000
[0x15] rec0=29 rec1=00 rec2=0d rec3=006
[0x16] rec0=21 rec1=00 rec2=04 rec3=00a
[0x17] rec0=24 rec1=00 rec2=02 rec3=002
[0x18] rec0=12 rec1=00 rec2=08 rec3=000
[0x19] rec0=12 rec1=00 rec2=08 rec3=000
[0x1a] rec0=1f rec1=00 rec2=1b rec3=02e
[0x1b] rec0=20 rec1=00 rec2=0a rec3=008
[0x1c] rec0=1d rec1=00 rec2=1d rec3=062
[0x1d] rec0=21 rec1=00 rec2=24 rec3=03e
[0x1e] rec0=26 rec1=00 rec2=0d rec3=04c
[0x1f] rec0=21 rec1=00 rec2=04 rec3=030
[0x20] rec0=00 rec1=00 rec2=02 rec3=006
[0x21] rec0=1f rec1=00 rec2=15 rec3=06c
[0x22] rec0=21 rec1=00 rec2=08 rec3=014
[0x23] rec0=20 rec1=00 rec2=28 rec3=08c
[0x24] rec0=14 rec1=00 rec2=07 rec3=000
[0x25] rec0=1d rec1=00 rec2=1c rec3=094
[0x26] rec0=0e rec1=00 rec2=28 rec3=000
[0x27] rec0=00 rec1=40 rec2=10 rec3=634
[0x28] rec0=5c rec1=31 rec2=a1 rec3=530
[0x29] rec0=00 rec1=0c rec2=5a rec3=0c6
tail 0x21547329086618abdd73d 0x42a00088462060003
Free Block Chain:
0x9: 0000 00 07 03 fc 80 12 22 20 26 20 47 72 6f 75 70 20 ┆ " & Group ┆
0x7: 0000 00 15 00 04 80 01 6f 01 02 03 04 05 06 07 4f 6b ┆ o Ok┆
0x15: 0000 00 24 03 fc 80 16 72 64 20 7c 20 56 65 72 62 20 ┆ $ rd | Verb ┆
0x24: 0000 00 0a 00 07 80 04 65 6c 6f 6e 04 3b 06 00 18 20 ┆ elon ; ┆
0xa: 0000 00 0f 00 23 00 19 20 20 20 20 20 20 20 20 20 20 ┆ # ┆
0xf: 0000 00 17 00 1b 80 18 20 20 20 20 20 20 20 20 20 72 ┆ r┆
0x17: 0000 00 22 00 33 80 01 3b 01 00 1b 20 20 20 20 2d 2d ┆ " 3 ; --┆
0x22: 0000 00 12 00 32 80 0d 6f 6e 20 45 78 69 74 5f 45 78 ┆ 2 on Exit_Ex┆
0x12: 0000 00 13 00 4a 80 04 65 67 69 6e 04 00 38 2d 2d 20 ┆ J egin 8-- ┆
0x13: 0000 00 16 00 29 80 26 65 6c 64 5f 61 72 72 61 79 2e ┆ ) &eld_array.┆
0x16: 0000 00 1a 00 15 00 12 20 20 20 20 20 20 20 20 20 20 ┆ ┆
0x1a: 0000 00 19 00 07 80 04 66 69 65 72 04 61 6d 65 2c 20 ┆ fier ame, ┆
0x19: 0000 00 25 01 05 80 16 3e 20 4e 75 6c 6c 5f 47 72 6f ┆ % > Null_Gro┆
0x25: 0000 00 2a 03 fc 80 39 20 20 20 20 20 20 20 20 20 20 ┆ * 9 ┆
0x2a: 0000 00 0b 00 09 80 06 20 20 20 20 20 20 06 00 00 02 ┆ ┆
0xb: 0000 00 10 03 fc 80 16 20 20 4f 6b 20 3a 20 6f 75 74 ┆ Ok : out┆
0x10: 0000 00 00 03 fc 80 04 6e 69 6c 2c 04 00 2a 2d 2d 20 ┆ nil, *-- ┆