DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦fb95448c7⟧ Ada Source

    Length: 6144 (0x1800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure New_Maze, seg_0582e4, separate Maze

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

E3 Source Code



separate (Maze)
----------------------------------------------------------------------
--
--                New_maze : create a new maze
--
--                      written by
--
--                   Edmond Schonberg
--
--                      Ada Project
--                   Courant Institute
--                  New York University
--                   251 Mercer Street
--                New York, New York  10012
--
-----------------------------------------------------------------------

-- with Random_Numbers;
-- use Random_Numbers;
-- with System;
-- separate (Maze)

procedure New_Maze (Start, Goal : Position; Num_Lines : Integer) is
    -- create a new maze with a given number of paths, including two long ones
    -- that lead to source and destination.
    Pos : Position;
    D : Direction;
    L : Integer;

    task type Liner is
        -- one is created for each path.
        entry Draw (Pos : Position; Dir : Direction; Len : Integer);
    end Liner;

    type New_Liner is access Liner;
    Next_Line : New_Liner;

    function Max_Len (P : Position; D : Direction) return Integer is
        -- establish distance from any point to boundary,
        -- along a given direction.
    begin
        case D is
            when Up =>
                return P.Row;
            when Right =>
                return (80 - P.Col);
            when Down =>
                return (23 - P.Row);
            when Left =>
                return P.Col;
        end case;

    end Max_Len;
    task body Liner is
        P : Position;
        D : Direction;
        L : Integer;
    begin
        accept Draw (Pos : Position; Dir : Direction; Len : Integer) do
            P := Pos;
            D := Dir;
            L := Len;
        end Draw;
        for I in 1 .. L loop
            Putc (' ', P.Row, P.Col);
            Dist (P.Row, P.Col) := Max_Dist;
            P := Next_Pos (P, D);
        end loop;
    end Liner;

begin
    Clear;
    -- case System.System_Name is
    --   when System.Pc_Dos =>
    --     Fill_Screen (Ascii.Si);
    --  when others =>
    Fill_Screen ('#');
    -- end case;
    Pos := Start;              -- first path starts at source.
    D := Up;                    -- which is always on bottom row.
    L := 20;
    for I in 1 .. Num_Lines loop
        -- create the right number of tasks, and start each at a random posi-
        -- tion, going in a random direction towards the boundary.
        Next_Line := new Liner;
        Next_Line.Draw (Pos, D, L);
        Pos := (2 * (1 + Random_Int (11)), 2 * (1 + Random_Int (38)));
        D := Direction'Val (Random_Int (40) mod 4);
        L := Max_Len (Pos, D);
        L := L / 2 + Random_Int (L / 4);
    end loop;
    -- One more for path leading to destination. (always on top row).
    Next_Line := new Liner;
    Next_Line.Draw (Goal, Down, 22);
exception
    when Storage_Error | Program_Error =>
        Puts ("unable to create new tasks. Try simpler maze.", 23, 1);

end New_Maze;

E3 Meta Data

    nblk1=5
    nid=5
    hdr6=8
        [0x00] rec0=21 rec1=00 rec2=01 rec3=080
        [0x01] rec0=23 rec1=00 rec2=04 rec3=042
        [0x02] rec0=1d rec1=00 rec2=03 rec3=00a
        [0x03] rec0=04 rec1=00 rec2=02 rec3=000
        [0x04] rec0=c0 rec1=00 rec2=00 rec3=100
    tail 0x217658d1c87e28421ea25 0x42a00088462060003
Free Block Chain:
  0x5: 0000  00 00 00 04 80 01 67 01 00 00 00 00 00 3d 53 74  ┆      g      =St┆