|
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 Display_Environment, package body Visual_System_1, seg_04b781
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
package body Visual_System_1 is
Max_X : Integer := 12;
Min_X : Integer := 1;
Max_Y : Integer := 6;
Min_Y : Integer := 1;
The_Model_Marker, The_Selected_Block_Marker, The_Top_Block_Marker,
The_Top_Copied_Model_Marker, The_On_Table_Marker :
Marker := Marker'(Position => Positions'(X => Min_X, Y => Min_Y));
The_Markers : array (Marker_Ids) of Marker :=
(Model_Marker_Id => The_Model_Marker,
Selected_Block_Marker_Id => The_Selected_Block_Marker,
Top_Block_Marker_Id => The_Top_Block_Marker,
Top_Copied_Model_Marker_Id => The_Top_Copied_Model_Marker,
On_Table_Marker_Id => The_On_Table_Marker);
type States is (Protected, Free);
type The_Environment_Labels is
array (Min_X .. Max_X, Min_Y .. Max_Y) of Labels;
type The_Environment_States is
array (Min_X .. Max_X, Min_Y .. Max_Y) of States;
type Environments is
record
The_Label : The_Environment_Labels;
The_State : The_Environment_States;
end record;
Environment : Environments;
procedure Protecte_Column (Marker_Id_In_Column : in Marker_Ids) is
begin
for J in Min_Y .. Max_Y loop
Environment.The_State
((The_Markers (Marker_Id_In_Column).Position.X), J) := Protected;
end loop;
end Protecte_Column;
procedure Unprotecte_Column (Marker_Id_In_Column : in Marker_Ids) is
begin
for J in Min_Y .. Max_Y loop
Environment.The_State
((The_Markers (Marker_Id_In_Column).Position.X), J) := Free;
end loop;
end Unprotecte_Column;
function Get_Label_In_Position (I, J : Integer) return Labels is
begin
return (Environment.The_Label (I, J));
end Get_Label_In_Position;
--------------------------------------------------------------------------------
package Display_Environment is
procedure Initialize;
procedure Print_All;
procedure Print_One_Block (X, Y : Integer; What_Label : Labels);
end Display_Environment;
package body Display_Environment is separate;
--------------------------------------------------------------------------------
procedure Put_Label_In_Position
(What_Label : Labels; X : Integer; Y : Integer) is
begin
Environment.The_Label (X, Y) := What_Label;
Display_Environment.Print_One_Block (X, Y, What_Label);
end Put_Label_In_Position;
function Move (What_Id : in Marker_Ids; In_Direction : in Directions)
return Boolean is
begin
case In_Direction is
when Right =>
if The_Markers (What_Id).Position.X = Max_X then
return (False);
else
The_Markers (What_Id).Position.X :=
The_Markers (What_Id).Position.X + 1;
end if;
when Left =>
if The_Markers (What_Id).Position.X = Min_X then
return (False);
else
The_Markers (What_Id).Position.X :=
The_Markers (What_Id).Position.X - 1;
end if;
when Up =>
if The_Markers (What_Id).Position.Y = Max_Y then
return (False);
else
The_Markers (What_Id).Position.Y :=
The_Markers (What_Id).Position.Y + 1;
end if;
when Down =>
if The_Markers (What_Id).Position.Y = Min_Y then
return (False);
else
The_Markers (What_Id).Position.Y :=
The_Markers (What_Id).Position.Y - 1;
end if;
end case;
return (True);
end Move;
function Get_Label (The_Marker_Id : in Marker_Ids) return Labels is
begin
return (Get_Label_In_Position (The_Markers (The_Marker_Id).Position.X,
The_Markers (The_Marker_Id).Position.Y));
end Get_Label;
function Is_Same (One_Marker_Id : in Marker_Ids;
Other_Marker_Id : in Marker_Ids) return Boolean is
begin
return ((The_Markers (One_Marker_Id).Position.X =
The_Markers (Other_Marker_Id).Position.X) and
(The_Markers (One_Marker_Id).Position.Y =
The_Markers (Other_Marker_Id).Position.Y));
end Is_Same;
function Find (What_Label : in Labels; The_Marker_Id : in Marker_Ids)
return Boolean is
begin
for I in Min_X .. Max_X loop
for J in Min_Y .. Max_Y loop
if Environment.The_State (I, J) /= Protected then
if (Get_Label_In_Position (I, J) = What_Label) then
The_Markers (The_Marker_Id).Position.X := I;
The_Markers (The_Marker_Id).Position.Y := J;
return True;
end if;
end if;
end loop;
end loop;
return False;
end Find;
procedure Make_Coincided (What_Id : in Marker_Ids;
With_What_Id : in Marker_Ids) is
begin
The_Markers (What_Id).Position.X :=
The_Markers (With_What_Id).Position.X;
The_Markers (What_Id).Position.Y :=
The_Markers (With_What_Id).Position.Y;
end Make_Coincided;
procedure Put_Block (Block_Marked_With_Id : in Marker_Ids;
On_Marked_Place_With_Id : in Marker_Ids) is
The_Label : Labels;
begin
The_Label := Get_Label_In_Position
(The_Markers (Block_Marked_With_Id).Position.X,
The_Markers (Block_Marked_With_Id).Position.Y);
Put_Label_In_Position
(The_Label, The_Markers (On_Marked_Place_With_Id).Position.X,
The_Markers (On_Marked_Place_With_Id).Position.Y);
Put_Label_In_Position (Null_Label,
The_Markers (Block_Marked_With_Id).Position.X,
The_Markers (Block_Marked_With_Id).Position.Y);
The_Markers (Block_Marked_With_Id).Position.X :=
The_Markers (On_Marked_Place_With_Id).Position.X;
The_Markers (Block_Marked_With_Id).Position.Y :=
The_Markers (On_Marked_Place_With_Id).Position.Y;
end Put_Block;
procedure Load_Initial is
begin
for I in Min_X .. Max_X loop
for J in Min_Y .. Max_Y loop
Environment.The_Label (I, J) := Null_Label;
Environment.The_State (I, J) := Free;
end loop;
end loop;
--The Model to Copy
Environment.The_Label (Max_X, Min_Y) := 'U';
Environment.The_Label (Max_X, Min_Y + 1) := 'O';
Environment.The_Label (Max_X, Min_Y + 2) := 'C';
Environment.The_Label (Max_X, Min_Y + 3) := 'U';
Environment.The_Label (Max_X, Min_Y + 4) := 'O';
Environment.The_Label (Max_X, Min_Y + 5) := 'C';
-- les cubes disponibles
Environment.The_Label (Min_X + 1, Min_Y) := 'T';
Environment.The_Label (Min_X + 1, Min_Y + 1) := 'A';
Environment.The_Label (Min_X + 2, Min_Y) := 'O';
Environment.The_Label (Min_X + 2, Min_Y + 1) := 'E';
Environment.The_Label (Min_X + 3, Min_Y) := 'T';
Environment.The_Label (Min_X + 3, Min_Y + 1) := 'B';
Environment.The_Label (Min_X + 3, Min_Y + 2) := 'C';
Environment.The_Label (Min_X + 3, Min_Y + 3) := 'O';
Environment.The_Label (Min_X + 4, Min_Y) := 'E';
Environment.The_Label (Min_X + 4, Min_Y + 1) := 'U';
Environment.The_Label (Min_X + 4, Min_Y + 2) := 'G';
Environment.The_Label (Min_X + 4, Min_Y + 3) := 'C';
Environment.The_Label (Min_X + 4, Min_Y + 4) := 'N';
Environment.The_Label (Min_X + 4, Min_Y + 5) := 'M';
Environment.The_Label (Min_X + 10, Min_Y) := 'U';
end Load_Initial;
begin
Display_Environment.Initialize;
Load_Initial;
Display_Environment.Print_All;
end Visual_System_1;
nblk1=a
nid=0
hdr6=14
[0x00] rec0=1d rec1=00 rec2=01 rec3=026
[0x01] rec0=01 rec1=00 rec2=0a rec3=010
[0x02] rec0=27 rec1=00 rec2=09 rec3=074
[0x03] rec0=1d rec1=00 rec2=08 rec3=048
[0x04] rec0=18 rec1=00 rec2=07 rec3=004
[0x05] rec0=1b rec1=00 rec2=06 rec3=060
[0x06] rec0=1d rec1=00 rec2=05 rec3=048
[0x07] rec0=18 rec1=00 rec2=04 rec3=012
[0x08] rec0=14 rec1=00 rec2=03 rec3=078
[0x09] rec0=11 rec1=00 rec2=02 rec3=000
tail 0x217509f6e86835b2f0259 0x42a00088462063c03