|
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: 12288 (0x3000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Robotetbrique, procedure Mise_En_Casier, seg_00e36f
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Expertsystem;
with Robot_New, Brick_New;
procedure Mise_En_Casier is
package Robotetbrique is
procedure Miseenboite;
end Robotetbrique;
package body Robotetbrique is
Casier : Natural := 0;
A_Brick, A_Robot : Expertsystem.Reference;
function Peutmettreenboite return Boolean is
begin
Regle_Caser:
-- (classe => robot, tache => deposer, case => <c>)
-- (classe => brique, lieu => pince)
------------------------------------------------------
declare
function Robot_Match
(R : Expertsystem.Reference) return Boolean is
begin
return Robot_New.Is_The_Task
(Of_Robot => R,
The_Task => Robot_New.Deposer);
end Robot_Match;
function Brick_Match
(B : Expertsystem.Reference) return Boolean is
begin
return Brick_New.Is_The_Place
(Of_Brick => B, The_Place => Brick_New.Pince);
end Brick_Match;
function Robot_Ok is
new Expertsystem.Collection.Findone (Robot_Match);
function Brick_Ok is
new Expertsystem.Collection.Findone (Brick_Match);
begin
A_Robot := Robot_Ok (Robot_New.All_Robots);
A_Brick := Brick_Ok (Brick_New.All_Bricks);
if Expertsystem.Collection.Isnotnull (A_Robot) and
Expertsystem.Collection.Isnotnull (A_Brick) then
Brick_New.Modify (A_Brick,
The_Place => Brick_New.Boite);
Robot_New.Modify (A_Robot,
The_Task => Robot_New.Prendre);
Robot_New.Modify (A_Robot,
The_Box => Robot_New.Last_Box);
Brick_New.Modify
(A_Brick, The_Box => Robot_New.Box_Number (A_Robot));
Expertsystem.Put_Line
("RegleCaser : " & Robot_New.Name (A_Robot) &
" depose la brique dans la case" &
Integer'Image (Robot_New.Box_Number (A_Robot)));
Expertsystem.Put_Line (" ");
Robot_New.Modify (A_Robot, The_Occupation => False);
return True;
end if;
end Regle_Caser;
Regle_Saisir:
-- (classe => robot, tache => prendre)
-- (classe => brique, lieu => tas, taille=> <x> )
-- !(classe => brique, lieu => tas, taille=> (> <x>))
--------------------------------------------------------
declare
function Robot_Match
(R : Expertsystem.Reference) return Boolean is
begin
return Robot_New.Is_The_Task
(Of_Robot => R,
The_Task => Robot_New.Prendre) and then
not Robot_New.Is_Occupied (The_Robot => R);
end Robot_Match;
function Brick_Match
(B : Expertsystem.Reference) return Boolean is
begin
return Brick_New.Is_The_Place
(Of_Brick => B,
The_Place => Brick_New.Tas) and then
Brick_New.The_Greatest_On_Heap (Brick => B);
end Brick_Match;
function Robot_Ok is
new Expertsystem.Collection.Findone (Robot_Match);
function Brick_Ok is
new Expertsystem.Collection.Findone (Brick_Match);
begin
A_Brick := Brick_Ok (Brick_New.All_Bricks);
A_Robot := Robot_Ok (Robot_New.All_Robots);
if Expertsystem.Collection.Isnotnull (A_Robot) and
Expertsystem.Collection.Isnotnull (A_Brick) then
Robot_New.Modify (A_Robot, The_Occupation => True);
Brick_New.Modify (A_Brick,
The_Place => Brick_New.Pince);
Robot_New.Modify (A_Robot,
The_Task => Robot_New.Deposer);
Expertsystem.Put_Line
("RegleSaisir : " & Robot_New.Name (A_Robot) &
" prend brique (taille=" &
Integer'Image (Brick_New.Size (A_Brick)) &
" / couleur = " &
Brick_New.Tcolor'Image (Brick_New.Color (A_Brick)));
Expertsystem.Put_Line (" ");
return True;
end if;
end Regle_Saisir;
Regle_Arreter:
-- (classe => robot, tache => prendre)
-- !(classe => brique, lieu => tas)
-----------------------------------------
declare
function Robot_Match
(R : Expertsystem.Reference) return Boolean is
begin
return Robot_New.Is_The_Task
(Of_Robot => R,
The_Task => Robot_New.Prendre);
end Robot_Match;
function Brick_Match
(B : Expertsystem.Reference) return Boolean is
begin
return Brick_New.Is_The_Place
(Of_Brick => B, The_Place => Brick_New.Tas);
end Brick_Match;
function Robot_Ok is
new Expertsystem.Collection.Findone (Robot_Match);
function Brick_Ok is
new Expertsystem.Collection.Findone (Brick_Match);
begin
A_Brick := Brick_Ok (Brick_New.All_Bricks);
A_Robot := Robot_Ok (Robot_New.All_Robots);
if Expertsystem.Collection.Isnull (A_Brick) and
Expertsystem.Collection.Isnotnull (A_Robot) then
Expertsystem.Put_Line
("RegleArreter : " & Robot_New.Name (A_Robot) &
(" se suicide (plus de briques)"));
Expertsystem.Put_Line (" ");
Robot_New.Suicide (Of_Robot => A_Robot);
return True;
end if;
end Regle_Arreter;
return False;
end Peutmettreenboite;
------------------------------------------------------------------------------
procedure Mettreenboite is
begin
loop
exit when not Peutmettreenboite;
end loop;
end Mettreenboite;
------------------------------------------------------------------------------
procedure Miseenboite is
begin
Robot_New.Create;
Brick_New.Create;
loop
Mettreenboite;
-- autres contextes a traiter
exit;
end loop;
end Miseenboite;
end Robotetbrique;
begin
Robotetbrique.Miseenboite;
end Mise_En_Casier;
nblk1=b
nid=4
hdr6=12
[0x00] rec0=1e rec1=00 rec2=01 rec3=022
[0x01] rec0=13 rec1=00 rec2=08 rec3=036
[0x02] rec0=14 rec1=00 rec2=07 rec3=072
[0x03] rec0=13 rec1=00 rec2=06 rec3=04a
[0x04] rec0=14 rec1=00 rec2=0a rec3=05a
[0x05] rec0=16 rec1=00 rec2=02 rec3=036
[0x06] rec0=16 rec1=00 rec2=09 rec3=014
[0x07] rec0=1c rec1=00 rec2=05 rec3=012
[0x08] rec0=09 rec1=00 rec2=03 rec3=000
[0x09] rec0=16 rec1=00 rec2=04 rec3=000
[0x0a] rec0=28 rec1=00 rec2=00 rec3=010
tail 0x2170b01ae821d7e5bf8f5 0x42a00088462060003
Free Block Chain:
0x4: 0000 00 0b 00 17 80 0d 66 5f 52 6f 62 6f 74 20 3d 3e ┆ f_Robot =>┆
0xb: 0000 00 00 00 24 80 21 20 20 20 20 20 20 20 20 20 20 ┆ $ ! ┆