|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 7191 (0x1c17)
Types: TextFile
Names: »B«
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
└─⟦6f12a12be⟧ »DATA«
└─⟦this⟧
with Towers_Of_Hanoi_Graphic;
use Towers_Of_Hanoi_Graphic;
with Towers_Of_Hanoi_Kbs;
with Towers_Of_Hanoi_Frames;
use Towers_Of_Hanoi_Frames;
use Towers_Of_Hanoi_Kbs;
package body Towers_Of_Hanoi_Rules_For_Graphic is
use Kbs;
use Kbs.Expression;
use Kbs.System_Defined_Expression;
type Rule_Names is (Reformulating_Guru, Moving_Guru, No_More);
-------------------------------------------------------------------------------
package Reformulating_Guru_Rule is
function Premiss return Fact_Base.Queries;
procedure Action (The_Facts : Fact_Base.Collection);
end Reformulating_Guru_Rule;
package body Reformulating_Guru_Rule is
Decision_Table : constant array (1 .. 3, 1 .. 3) of Integer :=
(1 => (3, 3, 2), 2 => (3, 3, 1), 3 => (2, 1, 1));
function Other_Tower_Than (First, Second : Integer) return Integer is
begin
return Decision_Table (First, Second);
end Other_Tower_Than;
function More_Urgent (Than : Integer) return Integer is
begin
return Than + 1;
end More_Urgent;
function Premiss return Fact_Base.Queries is
The_Priority : constant Alias := Alias'(P);
begin
return (Movements.Exist ((Count => Is_Greater (1),
Priority => Define_As (The_Priority),
From_Tower | To_Tower => Is_Any)),
Movements.Absent
((Priority => Is_Greater (The_Priority),
From_Tower | To_Tower | Count => Is_Any)));
end Premiss;
procedure Action (The_Facts : Fact_Base.Collection) is
The_Movement : Fact_Base.Object renames The_Facts (1);
The_Source, The_Destination, The_Count, The_Priority : Integer;
Move_First, Move_Second, Move_Third : Integer;
The_Other_Tower : Integer;
begin
The_Source := Movements.Get (The_Movement, From_Tower);
The_Destination := Movements.Get (The_Movement, To_Tower);
The_Count := Movements.Get (The_Movement, Count);
The_Priority := Movements.Get (The_Movement, Priority);
Move_Third := More_Urgent (Than => The_Priority);
Move_Second := More_Urgent (Than => Move_Third);
Move_First := More_Urgent (Than => Move_Second);
The_Other_Tower := Other_Tower_Than (The_Source, The_Destination);
Movements.Add ((Priority => Move_First,
From_Tower => The_Source,
To_Tower => The_Other_Tower,
Count => The_Count - 1));
Movements.Add ((Priority => Move_Second,
From_Tower => The_Source,
To_Tower => The_Destination,
Count => 1));
Movements.Add ((Priority => Move_Third,
From_Tower => The_Other_Tower,
To_Tower => The_Destination,
Count => The_Count - 1));
Movements.Delete (The_Movement);
end Action;
end Reformulating_Guru_Rule;
-------------------------------------------------------------------------------
package Moving_Guru_Rule is
function Premiss return Fact_Base.Queries;
procedure Action (The_Facts : Fact_Base.Collection);
end Moving_Guru_Rule;
package body Moving_Guru_Rule is
function Premiss return Fact_Base.Queries is
The_Priority : constant Alias := Alias'(P);
The_Source : constant Alias := Alias'(S);
The_Destination : constant Alias := Alias'(D);
The_Level : constant Alias := Alias'(L);
begin
return (Movements.Exist ((Count => Is_Equal (1),
Priority => Define_As (The_Priority),
From_Tower => Define_As (The_Source),
To_Tower => Define_As (The_Destination))),
Towers.Exist ((Location => Is_Equal (The_Source),
Disk_Count => Is_Greater (0) and
Define_As (The_Level))),
Towers.Exist ((Location => Is_Equal (The_Destination),
Disk_Count => Is_Any)),
Disks.Exist ((Tower => Is_Equal (The_Source),
Level => Is_Equal (The_Level),
Size => Is_Any)),
Movements.Absent
((Priority => Is_Greater (The_Priority),
From_Tower | To_Tower | Count => Is_Any)));
end Premiss;
procedure Action (The_Facts : Fact_Base.Collection) is
The_Movement : Fact_Base.Object renames The_Facts (1);
The_Source : Fact_Base.Object renames The_Facts (2);
The_Destination : Fact_Base.Object renames The_Facts (3);
The_Disk : Fact_Base.Object renames The_Facts (4);
The_Disk_Count : Natural;
begin
The_Disk_Count := Towers.Get (The_Source, Disk_Count);
Towers.Change (The_Source, Disk_Count, The_Disk_Count - 1);
Delete_Disk (For_Needle => Towers.Get (The_Source, Location),
The_Disk => Disks.Get (The_Disk, Level),
Its_Size => Disks.Get (The_Disk, Size));
The_Disk_Count := Towers.Get (The_Destination, Disk_Count);
Towers.Change (The_Destination, Disk_Count, The_Disk_Count + 1);
Print_Disk (For_Needle => Towers.Get (The_Destination, Location),
The_Disk => The_Disk_Count + 1,
Its_Size => Disks.Get (The_Disk, Size));
Disks.Change (The_Disk, Tower,
Towers.Get (The_Destination, Location));
Disks.Change (The_Disk, Level, The_Disk_Count + 1);
Movements.Delete (The_Movement);
delay 0.8;
end Action;
end Moving_Guru_Rule;
-------------------------------------------------------------------------------
package Rule_Bundle is
new Kbs.Rule_Base.Generic_Rule_Bundle
(The_Bundle => Towers_Of_Hanoi_Rules,
Rule_Names => Rule_Names,
Nothing => Rule_Names'(No_More),
Rule_1 => Reformulating_Guru,
Premiss_1 => Reformulating_Guru_Rule.Premiss,
Action_1 => Reformulating_Guru_Rule.Action,
Rule_2 => Moving_Guru,
Premiss_2 => Moving_Guru_Rule.Premiss,
Action_2 => Moving_Guru_Rule.Action);
procedure Do_Action (For_Rule : Kbs.Rule_Base.Rule_Id;
On_Facts : Kbs.Fact_Base.Collection) is
begin
Rule_Bundle.Do_Action (For_Rule, On_Facts);
end Do_Action;
end Towers_Of_Hanoi_Rules_For_Graphic;