|
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: 19456 (0x4c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Display_Environment, package body Visual_System_3, seg_04bc16
└─⟦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_3 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 Environmens is
record
The_Label : The_Environment_Labels;
The_State : The_Environment_States;
end record;
Environment : Environments;
procedure Protect_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 Protect_Column;
procedure Unprotect_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 Unprotect_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 (Null_Label,
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);
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, Min_Y) := 'Z';
Environment.The_Label (Min_X, Min_Y + 1) := 'P';
Environment.The_Label (Min_X, Min_Y + 2) := 'O';
Environment.The_Label (Min_X + 1, Min_Y) := 'T';
Environment.The_Label (Min_X + 1, Min_Y + 1) := 'A';
Environment.The_Label (Min_X + 1, Min_Y + 2) := 'L';
Environment.The_Label (Min_X + 2, Min_Y) := 'O';
Environment.The_Label (Min_X + 2, Min_Y + 1) := 'P';
Environment.The_Label (Min_X + 2, Min_Y + 2) := 'A'; Environment.The_Label (Min_X + 2, Min_Y + 3) := 'R';
Environment.The_Label (Min_X + 2, Min_Y + 4) := '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 + 5, Min_Y) := 'C';
Environment.The_Label (Min_X + 5, Min_Y + 1) := 'G';
Environment.The_Label (Min_X + 6, Min_Y) := 'T';
Environment.The_Label (Min_X + 6, Min_Y + 1) := 'N';
Environment.The_Label (Min_X + 7, Min_Y) := 'V';
Environment.The_Label (Min_X + 7, Min_Y + 1) := 'C';
Environment.The_Label (Min_X + 7, Min_Y + 2) := 'I';
Environment.The_Label (Min_X + 8, Min_Y) := 'S';
Environment.The_Label (Min_X + 9, Min_Y) := 'R';
Environment.The_Label (Min_X + 9, Min_Y + 1) := 'H';
Environment.The_Label (Min_X + 10, Min_Y + 1) := 'W';
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_3;
nblk1=12
nid=7
hdr6=18
[0x00] rec0=1d rec1=00 rec2=01 rec3=026
[0x01] rec0=00 rec1=00 rec2=03 rec3=002
[0x02] rec0=28 rec1=00 rec2=0f rec3=058
[0x03] rec0=1d rec1=00 rec2=0b rec3=02c
[0x04] rec0=01 rec1=00 rec2=12 rec3=06e
[0x05] rec0=1c rec1=00 rec2=02 rec3=018
[0x06] rec0=17 rec1=00 rec2=08 rec3=072
[0x07] rec0=1d rec1=00 rec2=09 rec3=088
[0x08] rec0=1a rec1=00 rec2=0e rec3=00a
[0x09] rec0=14 rec1=00 rec2=05 rec3=002
[0x0a] rec0=0f rec1=00 rec2=04 rec3=074
[0x0b] rec0=12 rec1=00 rec2=0a rec3=000
[0x0c] rec0=14 rec1=00 rec2=04 rec3=010
[0x0d] rec0=22 rec1=00 rec2=0e rec3=010
[0x0e] rec0=17 rec1=00 rec2=03 rec3=010
[0x0f] rec0=09 rec1=00 rec2=0a rec3=000
[0x10] rec0=06 rec1=00 rec2=03 rec3=000
[0x11] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x21750f16a86895b667875 0x42a00088462063c03
Free Block Chain:
0x7: 0000 00 10 02 a6 80 18 6b 65 72 5f 49 64 73 29 20 6f ┆ ker_Ids) o┆
0x10: 0000 00 0c 03 fc 80 15 20 20 39 20 20 20 20 31 30 20 ┆ 9 10 ┆
0xc: 0000 00 0d 03 fc 80 1f 20 20 20 66 6f 72 20 49 20 69 ┆ for I i┆
0xd: 0000 00 11 00 09 80 06 20 20 20 20 20 20 06 22 2c 20 ┆ ", ┆
0x11: 0000 00 06 00 43 80 06 6e 2e 58 20 3a 3d 06 00 37 20 ┆ C n.X := 7 ┆
0x6: 0000 00 00 00 8d 80 41 6f 76 65 5f 42 6c 6f 63 6b 20 ┆ Aove_Block ┆