|
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: 15360 (0x3c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Instruction_List, seg_049b8b, seg_049c10, seg_049c22
└─⟦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, Complement_Array, The_Place, Screen;
package body Instruction_List is
Game_At_End : Boolean := False;
function Last_Element (List : in Object) return Object is
Last_Instruction : Object := List;
begin
while Last_Instruction.Next_Instruction /= Null_Object loop
Last_Instruction := Last_Instruction.Next_Instruction;
end loop;
return Last_Instruction;
end Last_Element;
procedure Insert_If (List : in out Object;
A_Condition : in Condition.Object;
Right : in Object;
Wrong : in Object) is
Last_Instruction : Object;
begin
if List = Null_Object then
List := new Instruction'(Next_Instruction => Null_Object,
Kind => Si,
The_Condition => A_Condition,
Right_Instruction_List => Right,
Wrong_Instruction_List => Wrong);
else
Last_Instruction := Last_Element (List);
Last_Instruction.Next_Instruction :=
new Instruction'(Next_Instruction => Null_Object,
Kind => Si,
The_Condition => A_Condition,
Right_Instruction_List => Right,
Wrong_Instruction_List => Wrong);
end if;
end Insert_If;
procedure Insert_Change (List : in out Object;
An_Affectation : in Affectation.Object) is
Last_Instruction : Object;
begin
if List = Null_Object then
List := new Instruction'(Next_Instruction => Null_Object,
Kind => Change,
The_Affectation => An_Affectation);
else
Last_Instruction := Last_Element (List);
Last_Instruction.Next_Instruction :=
new Instruction'(Next_Instruction => Null_Object,
Kind => Change,
The_Affectation => An_Affectation);
end if;
end Insert_Change;
procedure Insert_Display (List : in out Object;
A_Display_List : in View_List.Object) is
Last_Instruction : Object;
begin
if List = Null_Object then
List := new Instruction'(Next_Instruction => Null_Object,
Kind => Display,
Display_List => A_Display_List);
else
Last_Instruction := Last_Element (List);
Last_Instruction.Next_Instruction :=
new Instruction'(Next_Instruction => Null_Object,
Kind => Display,
Display_List => A_Display_List);
end if;
end Insert_Display;
procedure Insert_Next_Line (List : in out Object) is
Last_Instruction : Object;
begin
if List = Null_Object then
List := new Instruction'
(Next_Instruction => Null_Object, Kind => Next_Line);
else
Last_Instruction := Last_Element (List);
Last_Instruction.Next_Instruction :=
new Instruction'(Next_Instruction => Null_Object,
Kind => Next_Line);
end if;
end Insert_Next_Line;
procedure Insert_Move (List : in out Object) is
Last_Instruction : Object;
begin
if List = Null_Object then
List := new Instruction'
(Next_Instruction => Null_Object, Kind => Move);
else
Last_Instruction := Last_Element (List);
Last_Instruction.Next_Instruction :=
new Instruction'(Next_Instruction => Null_Object, Kind => Move);
end if;
end Insert_Move;
procedure Insert_Put (List : in out Object;
A_Subject : in Detail.Object;
A_Place : in Objet.Object) is
Last_Instruction : Object;
begin
if List = Null_Object then
List := new Instruction'(Next_Instruction => Null_Object,
Kind => Put,
Subject => A_Subject,
Place => A_Place);
else
Last_Instruction := Last_Element (List);
Last_Instruction.Next_Instruction :=
new Instruction'(Next_Instruction => Null_Object,
Kind => Put,
Subject => A_Subject,
Place => A_Place);
end if;
end Insert_Put;
procedure Insert_Stop (List : in out Object) is
Last_Instruction : Object;
begin
if List = Null_Object then
List := new Instruction'
(Next_Instruction => Null_Object, Kind => Stop);
else
Last_Instruction := Last_Element (List);
Last_Instruction.Next_Instruction :=
new Instruction'(Next_Instruction => Null_Object, Kind => Stop);
end if;
end Insert_Stop;
procedure Insert_Go (List : in out Object;
A_Direction : in Detail.Object) is
Last_Instruction : Object;
begin
if List = Null_Object then
List := new Instruction'(Next_Instruction => Null_Object,
Kind => Go,
Direction => A_Direction);
else
Last_Instruction := Last_Element (List);
Last_Instruction.Next_Instruction :=
new Instruction'(Next_Instruction => Null_Object,
Kind => Go,
Direction => A_Direction);
end if;
end Insert_Go;
procedure Insert_Erase (List : in out Object) is
Last_Instruction : Object;
begin
if List = Null_Object then
List := new Instruction'
(Next_Instruction => Null_Object, Kind => Erase);
else
Last_Instruction := Last_Element (List);
Last_Instruction.Next_Instruction :=
new Instruction'(Next_Instruction => Null_Object, Kind => Erase);
end if;
end Insert_Erase;
procedure Show (List : in Object) is
An_Instruction : Object := List;
begin
while An_Instruction /= Null_Object loop
Text_Io.Put_Line ("Instruction : Kind : " &
Instruction_Kind'Image (An_Instruction.Kind));
case An_Instruction.Kind is
when Si =>
Condition.Show (An_Instruction.The_Condition);
Text_Io.Put_Line ("instruction pour condition vrai");
Show (An_Instruction.Right_Instruction_List);
Text_Io.Put_Line ("instruction pour condition fausse");
Show (An_Instruction.Wrong_Instruction_List);
when Change =>
Affectation.Show (An_Instruction.The_Affectation);
when Display =>
View_List.Show (An_Instruction.Display_List);
when Put =>
Detail.Show (An_Instruction.Subject);
Objet.Show (An_Instruction.Place);
when Go =>
Detail.Show (An_Instruction.Direction);
when Next_Line | Move | Stop | Erase | Unknown =>
Text_Io.New_Line;
end case;
An_Instruction := An_Instruction.Next_Instruction;
end loop;
end Show;
procedure Run (List : in Object) is
An_Instruction : Object := List;
Ok : Boolean;
begin
while An_Instruction /= Null_Object loop
case An_Instruction.Kind is
when Si =>
if Condition.Is_Right (An_Instruction.The_Condition) then
Run (An_Instruction.Right_Instruction_List);
else
Run (An_Instruction.Wrong_Instruction_List);
end if;
when Change =>
Affectation.Run (An_Instruction.The_Affectation);
when Display =>
View_List.Display (An_Instruction.Display_List);
when Next_Line =>
Screen.New_Line_World_Window;
when Move =>
Complement_Array.List_Complement_Init;
while not Complement_Array.List_Complement_Done loop
if Complement_Array.Is_An_Animate
(Complement_Array.List_Complement_Name) and then
Complement_Array.Place
(Complement_Array.Index
(Complement_Array.List_Complement_Name)) /=
0 then
Complement_Array.Move
(Complement_Array.Index
(Complement_Array.List_Complement_Name));
end if;
Complement_Array.List_Complement_Next;
end loop;
when Put =>
Complement_Array.Put_Place
(Detail.Index (An_Instruction.Subject),
Objet.Complement (An_Instruction.Place), Ok);
when Stop =>
Game_At_End := True;
when Go =>
if Complement_Array.Exit_Exist
(The_Place.Index, Detail.Index
(An_Instruction.Direction)) then
The_Place.Put
(Complement_Array.Next_Place
(The_Place.Index,
Detail.Index (An_Instruction.Direction)));
end if;
when Erase =>
Screen.New_Line_World_Window (10);
when Unknown =>
null;
end case;
An_Instruction := An_Instruction.Next_Instruction;
end loop;
end Run;
function Is_At_End return Boolean is
begin
return Game_At_End;
end Is_At_End;
end Instruction_List;
nblk1=e
nid=7
hdr6=18
[0x00] rec0=1f rec1=00 rec2=01 rec3=052
[0x01] rec0=01 rec1=00 rec2=0c rec3=002
[0x02] rec0=17 rec1=00 rec2=04 rec3=040
[0x03] rec0=18 rec1=00 rec2=08 rec3=05e
[0x04] rec0=20 rec1=00 rec2=0d rec3=056
[0x05] rec0=1a rec1=00 rec2=09 rec3=01e
[0x06] rec0=1e rec1=00 rec2=06 rec3=032
[0x07] rec0=1e rec1=00 rec2=0a rec3=056
[0x08] rec0=12 rec1=00 rec2=0b rec3=04a
[0x09] rec0=1b rec1=00 rec2=02 rec3=040
[0x0a] rec0=12 rec1=00 rec2=05 rec3=012
[0x0b] rec0=1b rec1=00 rec2=03 rec3=000
[0x0c] rec0=19 rec1=00 rec2=03 rec3=024
[0x0d] rec0=05 rec1=00 rec2=0e rec3=000
tail 0x21547345286618f9bdae4 0x42a00088462060003
Free Block Chain:
0x7: 0000 00 0e 00 5a 80 02 73 65 02 00 36 20 20 20 20 20 ┆ Z se 6 ┆
0xe: 0000 00 00 00 18 80 12 20 49 6e 73 74 72 75 63 74 69 ┆ Instructi┆