|
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 - download
Length: 14336 (0x3800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Instruction_List, seg_0472db
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Text_Io, Animate_List, Complement_Array, The_Place;
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 =>
Text_Io.New_Line;
when Move =>
Animate_List.Init; -- movement_init utile ??
while not Animate_List.Done loop
Complement_Array.Move (Animate_List.Value);
Animate_List.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 =>
Text_Io.New_Line (30);
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=d
nid=3
hdr6=18
[0x00] rec0=1f rec1=00 rec2=01 rec3=046
[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=1f 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=058
[0x0a] rec0=14 rec1=00 rec2=05 rec3=012
[0x0b] rec0=10 rec1=00 rec2=07 rec3=000
[0x0c] rec0=24 rec1=00 rec2=12 rec3=4c7
tail 0x2174a6264865364385e54 0x42a00088462060003
Free Block Chain:
0x3: 0000 00 00 03 fc 80 1a 20 20 20 20 20 20 20 20 20 20 ┆ ┆