|
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: 10240 (0x2800) Types: Ada Source Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Hanoi, seg_0581ce
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000 └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« └─⟦this⟧
-- UNIT: procedure HANOI -- FILES: hanoi.a termspec.a termbody.a -- AUTHOR (non-VERDIX): Colin Runciman -- COMPILE: a.make hanoi -o hanoi -v -f hanoi.a term*.a -- PURPOSE: demonstrate solution to "Towers of Hanoi" problem and a.make -- DESCRIPTION: shows consecutive positions of disks on three columns -- to move a tower from one column to another in such a way -- that no disk ever rests on a smaller one. -- Usage: hanoi -- .......................................................................... -- -- with Simple_Io; with Text_Io; use Text_Io; -- use Simple_Io; with Terminal; use Terminal; procedure Hanoi is ------------------------------------------- -- Data structures to represent the problem ------------------------------------------- subtype Pole_No is Integer range 1 .. 3; Pole_Height : constant Integer := 6; subtype Height is Integer range 0 .. Pole_Height; Max_Ring_No : constant Integer := Pole_Height - 1; subtype Ring_No is Integer range 0 .. Max_Ring_No; Term_Ch : Character := 'V'; Base_Depth : constant Integer := Screen_Depth - 1; type Ring_Array is array (Integer range <>) of Ring_No; type Pole_With_Rings is record Rings : Ring_Array (1 .. Pole_Height); Ring_Height : Ring_No; end record; Poles : array (Pole_No) of Pole_With_Rings := ((Rings => (5, 4, 3, 2, 1, 0), Ring_Height => 5), (Rings => (0, 0, 0, 0, 0, 0), Ring_Height => 0), (Rings => (0, 0, 0, 0, 0, 0), Ring_Height => 0)); procedure Draw_Ring (P : Pole_No; H : Height; R : Ring_No) is type Layer is (Top, Bottom); Ring_Picture : constant array (Ring_No, Layer) of String (1 .. 12) := ((" || ", " || "), (" -- ", " |01| "), (" ---- ", " | 02 | "), (" ------ ", " | 03 | "), (" -------- ", " | 04 | "), (" ---------- ", "| 05 |")); Down : constant Integer := Base_Depth - H * 2; Across : constant Integer := (P - 1) * 26 + 2; begin -- minimise cursor movement/character traffic -- drawing non-zero ring never over-writes a larger ring, so can -- send minimal amount if R = 0 then Fix_Cursor (Down, Across); Put (Ring_Picture (R, Top)); Fix_Cursor (Down + 1, Across); Put (Ring_Picture (R, Bottom)); else -- top of picture is two chars smaller than bottom Fix_Cursor (Down, Across + 6 - R); -- include leading blanks Put (Ring_Picture (R, Top) (7 - R .. 6 + R)); -- slice central part Fix_Cursor (Down + 1, Across + 5 - R); Put (Ring_Picture (R, Bottom) (6 - R .. 7 + R)); -- slice central part end if; end Draw_Ring; procedure Draw_Start is begin Clear_Screen; Fix_Cursor (2, 1); Put ("-- Towers of Hanoi --"); Fix_Cursor (Base_Depth, 1); for I in 1 .. 66 loop Put ('='); end loop; for P in Pole_No loop for R in Ring_No loop Draw_Ring (P, Pole_Height - R, Ring_No'(0)); end loop; end loop; for R in 1 .. Max_Ring_No loop Draw_Ring (1, Pole_Height - R, R); end loop; end Draw_Start; ---------------------------------------------------------------------- -- SOLVE expresses a suitable variant of the usual recursive solution. ---------------------------------------------------------------------- procedure Solve (R : Ring_No; Start_Pole, Finish_Pole : Pole_No) is procedure Move_Ring (From, To : Pole_No) is R : Ring_No := Poles (From).Rings (Poles (From).Ring_Height); begin Lift_Ring: declare Old_H : constant Height := Poles (From).Ring_Height; begin for H in Old_H .. Pole_Height loop Draw_Ring (From, H, Ring_No'(0)); exit when H = Pole_Height; Draw_Ring (From, H + 1, R); end loop; Poles (From).Rings (Old_H) := Ring_No'(0); Poles (From).Ring_Height := Old_H - 1; end Lift_Ring; Drop_Ring: declare New_H : constant Height := Poles (To).Ring_Height + 1; begin Draw_Ring (To, Pole_Height, R); for H in reverse New_H .. Pole_Height - 1 loop Draw_Ring (To, H + 1, Ring_No'(0)); Draw_Ring (To, H, R); end loop; Poles (To).Ring_Height := New_H; Poles (To).Rings (New_H) := R; end Drop_Ring; end Move_Ring; begin if R > 0 then declare Other_Pole : constant Pole_No := 6 - Start_Pole - Finish_Pole; begin Solve (R - 1, Start_Pole => Start_Pole, Finish_Pole => Other_Pole); Move_Ring (From => Start_Pole, To => Finish_Pole); Solve (R - 1, Start_Pole => Other_Pole, Finish_Pole => Finish_Pole); end; end if; end Solve; ---------------------------- -- Outermost body of program ---------------------------- begin Put ("Terminal type ( F(acit), V(T100), H(P2648), 1(FREEDOM100 ) > "); Text_Io.Get (Term_Ch); case Term_Ch is when 'F' | 'f' | 'V' | 'v' => Term := Vt100; when 'H' | 'h' => Term := Hp; when '1' => Term := Freedom100; when others => Term := Vt100; end case; Draw_Start; Solve (Max_Ring_No, Start_Pole => 1, Finish_Pole => 3); Solve (Max_Ring_No, Start_Pole => 3, Finish_Pole => 1); end Hanoi; pragma Main; -- .......................................................................... -- -- -- DISTRIBUTION AND COPYRIGHT: -- -- This software is released to the Public Domain (note: -- software released to the Public Domain is not subject -- to copyright protection). -- Restrictions on use or distribution: NONE -- -- DISCLAIMER: -- -- This software and its documentation are provided "AS IS" and -- without any expressed or implied warranties whatsoever. -- No warranties as to performance, merchantability, or fitness -- for a particular purpose exist. -- -- Because of the diversity of conditions and hardware under -- which this software may be used, no warranty of fitness for -- a particular purpose is offered. The user is advised to -- test the software thoroughly before relying on it. The user -- must assume the entire risk and liability of using this -- software. -- -- In no event shall any person or organization of people be -- held responsible for any direct, indirect, consequential -- or inconsequential damages or lost profits.
nblk1=9 nid=0 hdr6=12 [0x00] rec0=1d rec1=00 rec2=01 rec3=038 [0x01] rec0=00 rec1=00 rec2=09 rec3=02a [0x02] rec0=17 rec1=00 rec2=08 rec3=05e [0x03] rec0=16 rec1=00 rec2=07 rec3=036 [0x04] rec0=1e rec1=00 rec2=06 rec3=01a [0x05] rec0=16 rec1=00 rec2=05 rec3=01e [0x06] rec0=1d rec1=00 rec2=04 rec3=01c [0x07] rec0=1c rec1=00 rec2=03 rec3=024 [0x08] rec0=09 rec1=00 rec2=02 rec3=001 tail 0x2176579fc87e1657a3655 0x42a00088462060003