Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/manage/pplanner.src

Text File | 1988-05-03 | 384.8 KB | 13,293 lines

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--simutil.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_IO;

---------------------------------------------------------
-- Author : T. C. Bryan
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date   : June 1985
-- Summary:  procedure stops a running screen
--           to allow user reading error msgs.
---------------------------------------------------------
procedure PRESS_RETURN_TO_CONTINUE is

        A_RETURN  : string (1..8);
        LAST_CHAR : natural;

begin
    TEXT_IO.NEW_LINE (2);
        TEXT_IO.PUT_LINE ("Please PRESS return to continue ....");
        TEXT_IO.GET_LINE (A_RETURN, LAST_CHAR);
end PRESS_RETURN_TO_CONTINUE;


with TEXT_IO, PRESS_RETURN_TO_CONTINUE;

procedure FATAL (UNIT : STRING) is
-- Author : M. K. McNair
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date   : 8 March 1985
-- Summary: This procedure provides a centralized error reporting
--          facility. The main use for it is to provide a call
--          traceback facility.

begin
    TEXT_IO.NEW_LINE;
    TEXT_IO.PUT_LINE
       ("********************************************************************************");
    TEXT_IO.PUT_LINE ("An internal error occured in the ");
    TEXT_IO.PUT_LINE (UNIT & " unit.");
    TEXT_IO.PUT_LINE ("Please notify your System Manager.");
    TEXT_IO.PUT_LINE
       ("********************************************************************************");
    PRESS_RETURN_TO_CONTINUE;
end FATAL;




--  The following is a series of complete and machine-independent,
--  but not necessarily efficient, packages which, if compiled in order,
--  will provide the elementary functions required by some benchmarks

--  This specific file was prepared for the VAX/VMS Telesoft 1.3d Oct84 release
--  This is an unvalidated system


package FLOATING_CHARACTERISTICS is
--  This package is a floating mantissa definition of a binary FLOAT
--  It was first used on the DEC-10 and the VAX but should work for any
--  since the parameters are obtained by initializing on the actual hardware
--  Otherwise the parameters could be set in the spec if known
--  This is a preliminary package that defines the properties
--  of the particular floating point type for which we are going to
--  generate the math routines
--  The constants are those required by the routines described in
--  "Software Manual for the Elementary Functions" W. Cody & W. Waite
--  Prentice-Hall 1980
--  Actually most are needed only for the test programs
--  rather than the functions themselves, but might as well be here
--  Most of these could be in the form of attributes if
--  all the floating types to be considered were those built into the
--  compiler, but we also want to be able to support user defined types
--  such as software floating types of greater precision than
--  the hardware affords, or types defined on one machine to
--  simulate another
--  So we use the Cody-Waite names and derive them from an adaptation of the
--  MACHAR routine as given by Cody-Waite in Appendix B

    IBETA : INTEGER;
    --  The radix of the floating-point representation

    IT : INTEGER;
    --  The number of base IBETA digits in the DIS_FLOAT significand

    IRND : INTEGER;
    --  TRUE (1) if floating addition rounds, FALSE (0) if truncates

    NGRD : INTEGER;
    --  Number of guard digits for multiplication

    MACHEP : INTEGER;
    --  The largest negative integer such that
    --    1.0 + FLOAT(IBETA) ** MACHEP /= 1.0
    --  except that MACHEP is bounded below by -(IT + 3)

    NEGEP : INTEGER;
    --  The largest negative integer such that
    --    1.0 -0 FLOAT(IBETA) ** NEGEP /= 1.0
    --  except that NEGEP is bounded below by -(IT + 3)

    IEXP : INTEGER;
    --  The number of bits (decimal places if IBETA = 10)
    --  reserved for the representation of the exponent (including
    --  the bias or sign) of a floating-point number

    MINEXP : INTEGER;
    --  The largest in magnitude negative integer such that
    --  FLOAT(IBETA) ** MINEXP is a positive floating-point number


    MAXEXP : INTEGER;
    --  The largest positive exponent for a finite floating-point number

    EPS : FLOAT;
    --  The smallest positive floating-point number such that
    --                              1.0 + EPS /= 1.0
    --  In particular, if IBETA = 2 or IRND = 0,
    --  EPS = FLOAT(IBETA) ** MACHEP
    --  Otherwise, EPS = (FLOAT(IBETA) ** MACHEP) / 2


    EPSNEG : FLOAT;
    --  A small positive floating-point number such that 1.0-EPSNEG /= 1.0

    XMIN : FLOAT;
    --  The smallest non-vanishing floating-point power of the radix
    --  In particular, XMIN = FLOAT(IBETA) ** MINEXP

    XMAX : FLOAT;
    --  The largest finite floating-point number

--  Here the structure of the floating type is defined
--  I have assumed that the exponent is always some integer form
--  The mantissa can vary
--  Most often it will be a fixed type or the same floating type
--  depending on the most efficient machine implementation
--  Most efficient implementation may require details of the machine hardware
--  In this version the simplest representation is used
--  The mantissa is extracted into a FLOAT and uses the predefined operations
    type EXPONENT_TYPE is new INTEGER;  --  should be derived  ##########
    subtype MANTISSA_TYPE is FLOAT;   --   range -1.0..1.0;
--  A consequence of the rigorous constraints on MANTISSA_TYPE is that
--  operations must be very carefully examined to make sure that no number
--  greater than one results
--  Actually this limitation is important in constructing algorithms
--  which will also run when MANTISSA_TYPE is a fixed point type

--  If we are not using the STANDARD type, we have to define all the
--  operations at this point
--  We also need PUT for the type if it is not otherwise available

--  Now we do something strange
--  Since we do not know in the following routines whether the mantissa
--  will be carried as a fixed or floating type, we have to make some
--  provision for dividing by two
--  We cannot use the literals, since FIXED/2.0 and FLOAT/2 will fail
--  We define a type-dependent factor that will work
    MANTISSA_DIVISOR_2 : constant FLOAT := 2.0;
    MANTISSA_DIVISOR_3 : constant FLOAT := 3.0;
--  This will work for the MANTISSA_TYPE defined above
--  The alternative of defining an operation "/" to take care of it
--  is too sweeping and would allow unAda-like errors

    MANTISSA_HALF : constant MANTISSA_TYPE := 0.5;


    procedure DEFLOAT (X : FLOAT;
               N : in out EXPONENT_TYPE;
               F : in out MANTISSA_TYPE);
    procedure REFLOAT (N : EXPONENT_TYPE;
               F : MANTISSA_TYPE;
               X : in out FLOAT);
--  Since the user may wish to define a floating type by some other name
--  CONVERT_TO_FLOAT is used rather than just FLOAT for explicit coersion
    function CONVERT_TO_FLOAT (K : INTEGER) return FLOAT;
    function CONVERT_TO_FLOAT (N : EXPONENT_TYPE) return FLOAT;
    function CONVERT_TO_FLOAT (F : MANTISSA_TYPE) return FLOAT;

end FLOATING_CHARACTERISTICS;



with TEXT_IO;
use TEXT_IO;

package body FLOATING_CHARACTERISTICS is
--  This package is a floating mantissa definition of a binary FLOAT

    A, B, Y, Z           : FLOAT;
    I, K, MX, IZ         : INTEGER;
    BETA, BETAM1, BETAIN : FLOAT;
    ONE                  : FLOAT := 1.0;
    ZERO                 : FLOAT := 0.0;

    procedure DEFLOAT (X : FLOAT;
               N : in out EXPONENT_TYPE;
               F : in out MANTISSA_TYPE) is
--  This is admittedly a slow method - but portable - for breaking down
--  a floating point number into its exponent and mantissa
--  Obviously with knowledge of the machine representation
--  it could be replaced with a couple of simple extractions
    EXPONENT_LENGTH : INTEGER := IEXP;
    M               : EXPONENT_TYPE;
    W, Y, Z         : FLOAT;
    begin
    N := 0;
    F := 0.0;
    Y := abs (X);

    if Y = 0.0 then
        return;

    elsif Y < 0.5 then
        for J in reverse 0 .. (EXPONENT_LENGTH - 2) loop
        --  Dont want to go all the way to 2.0**(EXPONENT_LENGTH - 1)
        --  Since that (or its reciprocal) will overflow if exponent
        -- biased
        --  Ought to use talbular values rather than compute each time
        M := EXPONENT_TYPE (2 ** J);
        Z := 1.0 / (2.0 ** INTEGER (M));
        W := Y / Z;

        if W < 1.0 then
            Y := W;
            N := N - M;
        end if;
        end loop;
    else
        for J in reverse 0 .. (EXPONENT_LENGTH - 2) loop
        M := EXPONENT_TYPE (2 ** J);
        Z := 2.0 ** INTEGER (M);
        W := Y / Z;

        if W >= 0.5 then
            Y := W;
            N := N + M;
        end if;
        end loop;
        --  And just to clear up any loose ends from biased exponents
    end if;

    while Y < 0.5 loop
        Y := Y * 2.0;
        N := N - 1;
    end loop;

    while Y >= 1.0 loop
        Y := Y / 2.0;
        N := N + 1;
    end loop;

    F := MANTISSA_TYPE (Y);

    if X < 0.0 then
        F := -F;
    end if;

    return;
    exception
    when others =>
        N := 0;
        F := 0.0;
        return;
    end DEFLOAT;


    procedure REFLOAT (N : EXPONENT_TYPE;
               F : MANTISSA_TYPE;
               X : in out FLOAT) is
--  Again a brute force method - but portable
--  Watch out near MAXEXP
    M : INTEGER;
    Y : FLOAT;
    begin
    if F = 0.0 then
        X := ZERO;
        return;
    end if;

    M := INTEGER (N);
    Y := abs (FLOAT (F));

    while Y < 0.5 loop
        M := M - 1;

        if M < MINEXP then
        X := ZERO;
        end if;

        Y := Y + Y;
        exit when M <= MINEXP;
    end loop;

    if M = MAXEXP then
        M := M - 1;
        X := Y * 2.0 ** M;
        X := X * 2.0;

    elsif M <= MINEXP + 2 then
        M := M + 3;
        X := Y * 2.0 ** M;
        X := ((X / 2.0) / 2.0) / 2.0;
    else
        X := Y * 2.0 ** M;
    end if;

    if F < 0.0 then
        X := -X;
    end if;

    return;
    end REFLOAT;

    function CONVERT_TO_FLOAT (K : INTEGER) return FLOAT is
    begin
    return FLOAT (K);
    end CONVERT_TO_FLOAT;

    function CONVERT_TO_FLOAT (N : EXPONENT_TYPE) return FLOAT is
    begin
    return FLOAT (N);
    end CONVERT_TO_FLOAT;

    function CONVERT_TO_FLOAT (F : MANTISSA_TYPE) return FLOAT is
    begin
    return FLOAT (F);
    end CONVERT_TO_FLOAT;


begin
    --  Initialization for the VAX with values derived by MACHAR
--  In place of running MACHAR as the actual initialization

--  IBETA :=    2;
--  IT :=    24;
--  IRND :=    1;
--  NEGEP :=    -24;
--  EPSNEG :=    5.9604644E-008;
--  MACHEP :=    -24;
--  EPS :=    5.9604644E-008;
--  NGRD :=    0;
--  XMIN := 5.9E-39;
--  MINEXP :=    -126;
--  IEXP :=    8;
--  MAXEXP :=    127;
--  XMAX :=    8.5E37 * 2.0;


----  This initialization is the MACHAR routine of Cody and Waite Appendix B.
    PUT ("INITIALIZATING WITH MACHAR     -     ");
    A := ONE;

    while (((A + ONE) - A) - ONE) = ZERO loop
    A := A + A;
    end loop;

    B := ONE;

    while ((A + B) - A) = ZERO loop
    B := B + B;
    end loop;

    IBETA := INTEGER ((A + B) - A);
    BETA := CONVERT_TO_FLOAT (IBETA);


    IT := 0;
    B := ONE;

    while (((B + ONE) - B) - ONE) = ZERO loop
    IT := IT + 1;
    B := B * BETA;
    end loop;


    IRND := 0;
    BETAM1 := BETA - ONE;

    if ((A + BETAM1) - A) /= ZERO then
    IRND := 1;
    end if;


    NEGEP := IT + 3;
    BETAIN := ONE / BETA;
    A := ONE;

    for I in 1 .. NEGEP loop
--  for I in 1..50  loop
--  exit when I > NEGEP;
    A := A * BETAIN;
    end loop;

    B := A;

    while ((ONE - A) - ONE) = ZERO loop
    A := A * BETA;
    NEGEP := NEGEP - 1;
    end loop;

    NEGEP := -NEGEP;


    EPSNEG := A;

    if (IBETA /= 2) and (IRND /= 0) then
    A := (A * (ONE + A)) / (ONE + ONE);

    if ((ONE - A) - ONE) /= ZERO then
        EPSNEG := A;
    end if;
    end if;


    MACHEP := -IT - 3;
    A := B;

    while ((ONE + A) - ONE) = ZERO loop
    A := A * BETA;
    MACHEP := MACHEP + 1;
    end loop;


    EPS := A;

    if (IBETA /= 2) and (IRND /= 0) then
    A := (A * (ONE + A)) / (ONE + ONE);

    if ((ONE + A) - ONE) /= ZERO then
        EPS := A;
    end if;
    end if;


    NGRD := 0;

    if ((IRND = 0) and ((ONE + EPS) * ONE - ONE) /= ZERO) then
    NGRD := 1;
    end if;


    I := 0;
    K := 1;
    Z := BETAIN;

    loop
    Y := Z;
    Z := Y * Y;
    A := Z * ONE;
    exit when ((A + A) = ZERO) or (abs (Z) >= Y);
    I := I + 1;
    K := K + K;
    end loop;

    if (IBETA /= 10) then
    IEXP := I + 1;
    MX := K + K;
    else
    IEXP := 2;
    IZ := IBETA;

    while (K >= IZ) loop
        IZ := IZ * IBETA;
        IEXP := IEXP + 1;
    end loop;

    MX := IZ + IZ - 1;
    end if;

    loop
    XMIN := Y;
    Y := Y * BETAIN;
    A := Y * ONE;
    exit when ((A + A) = ZERO) or (abs (Y) >= XMIN);
    K := K + 1;
    end loop;


    MINEXP := -K;


    if ((MX <= (K + K - 3)) and (IBETA /= 10)) then
    MX := MX + MX;
    IEXP := IEXP + 1;
    end if;


    MAXEXP := MX + MINEXP;
    I := MAXEXP + MINEXP;

    if ((IBETA = 2) and (I = 0)) then
    MAXEXP := MAXEXP - 1;
    end if;

    if (I > 20) then
    MAXEXP := MAXEXP - 1;
    end if;

    if (A /= Y) then
    MAXEXP := MAXEXP - 2;
    end if;


    XMAX := ONE - EPSNEG;

    if ((XMAX * ONE) /= XMAX) then
    XMAX := ONE - BETA * EPSNEG;
    end if;

    XMAX := XMAX / (BETA * BETA * BETA * XMIN);
    I := MAXEXP + MINEXP + 3;

    if I > 0 then
    for J in 1 .. 50 loop
        exit when J > I;

        if IBETA = 2 then
        XMAX := XMAX + XMAX;
        else
        XMAX := XMAX * BETA;
        end if;
    end loop;
    end if;

    PUT ("INITIALIZED");  NEW_LINE;

end FLOATING_CHARACTERISTICS;

with TEXT_IO;
use TEXT_IO;

package NUMERIC_IO is

    procedure GET (FILE : FILE_TYPE; ITEM : out INTEGER);
    procedure GET (ITEM : out INTEGER);
    procedure GET (FILE : FILE_TYPE; ITEM : out FLOAT);
    procedure GET (ITEM : out FLOAT);
    procedure PUT (FILE : FILE_TYPE; ITEM : INTEGER);
    procedure PUT (ITEM : INTEGER; WIDTH : FIELD);
    procedure PUT (ITEM : INTEGER);
    procedure PUT (FILE : FILE_TYPE; ITEM : FLOAT);
    procedure PUT (ITEM : FLOAT);

end NUMERIC_IO;


with TEXT_IO;
use TEXT_IO;

package body NUMERIC_IO is
-- This ought to be done by instantiating the FLoaT_IO and INTEGER_IO
--  But if you dont yet have the generic TEXT_IO implemented yet
--  then something like this does the job on the DEC-10 IAPC
--  But it is a kludge
--  No effort has been put into making it pretty or portable
    package INT_IO is new TEXT_IO.INTEGER_IO (INTEGER);
    package FLT_IO is new TEXT_IO.FLOAT_IO (FLOAT);
    use INT_IO;
    use FLT_IO;

    procedure GET (FILE : FILE_TYPE; ITEM : out INTEGER) is
    begin
    INT_IO.GET (FILE, ITEM);
    end GET;

    procedure GET (ITEM : out INTEGER) is
    begin
    INT_IO.GET (ITEM);
    end GET;

    procedure GET (FILE : FILE_TYPE; ITEM : out FLOAT) is
    begin
    FLT_IO.GET (FILE, ITEM);
    end GET;

    procedure GET (ITEM : out FLOAT) is
    begin
    FLT_IO.GET (ITEM);
    end GET;

    procedure PUT (FILE : FILE_TYPE; ITEM : INTEGER) is
    begin
    INT_IO.PUT (FILE, ITEM);
    end PUT;

    procedure PUT (ITEM : INTEGER; WIDTH : FIELD) is
    J, K, M : INTEGER := 0;
    begin
    if WIDTH = 1 then
        case ITEM is

        when 0      =>  PUT ('0');

        when 1      =>  PUT ('1');

        when 2      =>  PUT ('2');

        when 3      =>  PUT ('3');

        when 4      =>  PUT ('4');

        when 5      =>  PUT ('5');

        when 6      =>  PUT ('6');

        when 7      =>  PUT ('7');

        when 8      =>  PUT ('8');

        when 9      =>  PUT ('9');

        when others =>  PUT ('*');
        end case;
    else
        if ITEM < 0 then
        PUT ('-');
        J := -ITEM;
        else
        PUT (' ');
        J := ITEM;
        end if;

        for I in 1 .. WIDTH - 1 loop
        M := 10 ** (WIDTH - 1 - I);
        K := J / M;
        J := J - K * M;
        NUMERIC_IO.PUT (K, 1);
        end loop;
    end if;
    end PUT;

    procedure PUT (ITEM : INTEGER) is
    begin
    INT_IO.PUT (ITEM);
    end PUT;

    procedure PUT (FILE : FILE_TYPE; ITEM : FLOAT) is
    begin
    FLT_IO.PUT (FILE, ITEM);
    end PUT;

    procedure PUT (ITEM : FLOAT) is
    begin
    FLT_IO.PUT (ITEM);
    end PUT;

end NUMERIC_IO;



with FLOATING_CHARACTERISTICS;
use FLOATING_CHARACTERISTICS;

package NUMERIC_PRIMITIVES is

--  This may seem a little much but is put in this form to allow the
--  same form to be used for a generic package
--  If that is not needed, simple litterals could be substituted
    ZERO  : FLOAT := CONVERT_TO_FLOAT (INTEGER (0));
    ONE   : FLOAT := CONVERT_TO_FLOAT (INTEGER (1));
    TWO   : FLOAT := ONE + ONE;
    THREE : FLOAT := ONE + ONE + ONE;
    HALF  : FLOAT := ONE / TWO;

--  The following "constants" are effectively deferred to
--  the initialization part of the package body
--  This is in order to make it possible to generalize the floating type
--  If that capability is not desired, constants may be included here
    PI            : FLOAT;
    ONE_OVER_PI   : FLOAT;
    TWO_OVER_PI   : FLOAT;
    PI_OVER_TWO   : FLOAT;
    PI_OVER_THREE : FLOAT;
    PI_OVER_FOUR  : FLOAT;
    PI_OVER_SIX   : FLOAT;


    function SIGN (X, Y : FLOAT) return FLOAT;
    --  Returns the value of X with the sign of Y
    function MAX (X, Y : FLOAT) return FLOAT;
    --  Returns the algebraicly larger of X and Y
    function TRUNCATE (X : FLOAT) return FLOAT;
    --  Returns the floating value of the integer no larger than X
    --  AINT(X)
    function ROUND (X : FLOAT) return FLOAT;
    --  Returns the floating value nearest X
    --  AINTRND(X)
    function RAN return FLOAT;
    --  This uses a portable algorithm and is included at this point
    --  Algorithms that presume unique machine hardware information
    --  should be initiated in FLOATING_CHARACTERISTICS

end NUMERIC_PRIMITIVES;



with FLOATING_CHARACTERISTICS;
use FLOATING_CHARACTERISTICS;

package body NUMERIC_PRIMITIVES is


    function SIGN (X, Y : FLOAT) return FLOAT is
--  Returns the value of X with the sign of Y
    begin
    if Y >= 0.0 then
        return X;
    else
        return -X;
    end if;
    end SIGN;

    function MAX (X, Y : FLOAT) return FLOAT is
    begin
    if X >= Y then
        return X;
    else
        return Y;
    end if;
    end MAX;

    function TRUNCATE (X : FLOAT) return FLOAT is
--  Optimum code depends on how the system rounds at exact halves
    begin
    if FLOAT (INTEGER (X)) = X then
        return X;
    end if;

    if X > ZERO then
        return FLOAT (INTEGER (X - HALF));

    elsif X = ZERO then
        return ZERO;
    else
        return FLOAT (INTEGER (X + HALF));
    end if;
    end TRUNCATE;

    function ROUND (X : FLOAT) return FLOAT is
    begin
    return FLOAT (INTEGER (X));
    end ROUND;


    package KEY is
    X : INTEGER := 10_001;
    Y : INTEGER := 20_001;
    Z : INTEGER := 30_001;
    end KEY;

    function RAN return FLOAT is
--  This rectangular random number routine is adapted from a report
--  "A Pseudo-Random Number Generator" by B. A. Wichmann and I. D. Hill
--  NPL Report DNACS XX (to be published)
--  In this stripped version, it is suitable for machines supporting
--  INTEGER at only 16 bits and is portable in Ada
    W : FLOAT;
    begin

    KEY.X := 171 * (KEY.X mod 177 - 177) - 2 * (KEY.X / 177);

    if KEY.X < 0 then
        KEY.X := KEY.X + 30269;
    end if;

    KEY.Y := 172 * (KEY.Y mod 176 - 176) - 35 * (KEY.Y / 176);

    if KEY.Y < 0 then
        KEY.Y := KEY.Y + 30307;
    end if;

    KEY.Z := 170 * (KEY.Z mod 178 - 178) - 63 * (KEY.Z / 178);

    if KEY.Z < 0 then
        KEY.Z := KEY.Z + 30323;
    end if;

    --  CONVERT_TO_FLOAT is used instead of FLOAT since the floating
    --  type may be software defined

    W := CONVERT_TO_FLOAT (KEY.X) / 30269.0 +
         CONVERT_TO_FLOAT (KEY.Y) / 30307.0 +
         CONVERT_TO_FLOAT (KEY.Z) / 30323.0;

    return W - CONVERT_TO_FLOAT (INTEGER (W - 0.5));

    end RAN;

begin
    PI := CONVERT_TO_FLOAT (INTEGER (3)) +
      CONVERT_TO_FLOAT (MANTISSA_TYPE (0.14159_26535_89793_23846));
    ONE_OVER_PI := CONVERT_TO_FLOAT (MANTISSA_TYPE (0.31830_98861_83790_67154));
    TWO_OVER_PI := CONVERT_TO_FLOAT (MANTISSA_TYPE (0.63661_97723_67581_34308));
    PI_OVER_TWO := CONVERT_TO_FLOAT (INTEGER (1)) +
           CONVERT_TO_FLOAT (MANTISSA_TYPE (0.57079_63267_94896_61923));
    PI_OVER_THREE := CONVERT_TO_FLOAT (INTEGER (1)) +
             CONVERT_TO_FLOAT
            (MANTISSA_TYPE (0.04719_75511_96597_74615));
    PI_OVER_FOUR := CONVERT_TO_FLOAT
               (MANTISSA_TYPE (0.78539_81633_97448_30962));
    PI_OVER_SIX := CONVERT_TO_FLOAT (MANTISSA_TYPE (0.52359_87755_98298_87308));

end NUMERIC_PRIMITIVES;




with FLOATING_CHARACTERISTICS;
use FLOATING_CHARACTERISTICS;

package CORE_FUNCTIONS is

    EXP_LARGE : FLOAT;
    EXP_SMALL : FLOAT;

    function SQRT  (X : FLOAT) return FLOAT;
    function CBRT  (X : FLOAT) return FLOAT;
    function LOG   (X : FLOAT) return FLOAT;
    function LOG10 (X : FLOAT) return FLOAT;
    function EXP   (X : FLOAT) return FLOAT;
    function "**"  (X, Y : FLOAT) return FLOAT;

end CORE_FUNCTIONS;




with TEXT_IO;
use TEXT_IO;
with FLOATING_CHARACTERISTICS;
use FLOATING_CHARACTERISTICS;
with NUMERIC_IO;
use NUMERIC_IO;
with NUMERIC_PRIMITIVES;
use NUMERIC_PRIMITIVES;

package body CORE_FUNCTIONS is

--  The following routines are coded directly from the algorithms and
--  coeficients given in "Software Manual for the Elementry Functions"
--  by William J. Cody, Jr. and William Waite, Prentice_Hall, 1980
--  CBRT by analogy
--  A more general formulation uses MANTISSA_TYPE, etc.
--  The coeficients are appropriate for 25 to 32 bits floating significance
--  They will work for less but slightly shorter versions are possible
--  The routines are coded to stand alone so they need not be compiled together

--  These routines have been coded to accept a general MANTISSA_TYPE
--  That is, they are designed to work with a manitssa either fixed of float
--  There are some explicit conversions which are required but these will
--  not cause any extra code to be generated

--      16 JULY 1982       W A WHITAKER  AFATL EGLIN AFB FL 32542
--                         T C EICHOLTZ  USAFA


    function SQRT (X : FLOAT) return FLOAT is
    M, N   : EXPONENT_TYPE;
    F, Y   : MANTISSA_TYPE;
    RESULT : FLOAT;

    subtype INDEX is INTEGER range 0 .. 100; --  #########################
    SQRT_L1 : INDEX := 3;
    --  Could get away with SQRT_L1 := 2 for 28 bits
    --  Using the better Cody-Waite coeficients overflows MANTISSA_TYPE
    SQRT_C1 : MANTISSA_TYPE := 8#0.3317777777#;
    SQRT_C2 : MANTISSA_TYPE := 8#0.4460000000#;
    SQRT_C3 : MANTISSA_TYPE := 8#0.55202_36314_77747_36311_0#;

    begin
    if X = ZERO then
        RESULT := ZERO;
        return RESULT;

    elsif X = ONE then
        --  To get exact SQRT(1.0)
        RESULT := ONE;
        return RESULT;

    elsif X < ZERO then
        NEW_LINE;
        PUT ("CALLED SQRT FOR NEGATIVE ARGUMENT   ");
        PUT (X);
        PUT ("   USED ABSOLUTE VALUE");
        NEW_LINE;
        RESULT := SQRT (abs (X));
        return RESULT;
    else
        DEFLOAT (X, N, F);
        Y := SQRT_C1 + MANTISSA_TYPE (SQRT_C2 * F);

        for J in 1 .. SQRT_L1 loop
        Y := Y / MANTISSA_DIVISOR_2 +
             MANTISSA_TYPE ((F / MANTISSA_DIVISOR_2) / Y);
        end loop;

        if (N mod 2) /= 0 then
        Y := MANTISSA_TYPE (SQRT_C3 * Y);
        N := N + 1;
        end if;

        M := N / 2;
        REFLOAT (M, Y, RESULT);
        return RESULT;
    end if;
    exception
    when others =>
        NEW_LINE;  PUT (" EXCEPTION IN SQRT, X = ");  PUT (X);
        PUT ("  RETURNED 1.0");  NEW_LINE;
        return ONE;
    end SQRT;


    function CBRT (X : FLOAT) return FLOAT is
    M, N   : EXPONENT_TYPE;
    F, Y   : MANTISSA_TYPE;
    RESULT : FLOAT;

    subtype INDEX is INTEGER range 0 .. 100; --  #########################
    CBRT_L1 : INDEX := 3;
    CBRT_C1 : MANTISSA_TYPE := 0.5874009;
    CBRT_C2 : MANTISSA_TYPE := 0.4125990;
    CBRT_C3 : MANTISSA_TYPE := 0.62996_05249;
    CBRT_C4 : MANTISSA_TYPE := 0.79370_05260;

    begin
    if X = ZERO then
        RESULT := ZERO;
        return RESULT;
    else
        DEFLOAT (X, N, F);
        F := abs (F);
        Y := CBRT_C1 + MANTISSA_TYPE (CBRT_C2 * F);

        for J in 1 .. CBRT_L1 loop
        Y := Y -
             (Y / MANTISSA_DIVISOR_3 -
              MANTISSA_TYPE
             ((F / MANTISSA_DIVISOR_3) / MANTISSA_TYPE (Y * Y)));
        end loop;

        case (N mod 3) is
        when 0 =>
            null;

        when 1 =>
            Y := MANTISSA_TYPE (CBRT_C3 * Y);
            N := N + 2;

        when 2 =>
            Y := MANTISSA_TYPE (CBRT_C4 * Y);
            N := N + 1;

        when others =>
            null;
        end case;

        M := N / 3;

        if X < ZERO then
        Y := -Y;
        end if;

        REFLOAT (M, Y, RESULT);
        return RESULT;
    end if;
    exception
    when others =>
        RESULT := ONE;

        if X < ZERO then
        RESULT := -ONE;
        end if;

        NEW_LINE;  PUT ("EXCEPTION IN CBRT, X = ");  PUT (X);
        PUT ("  RETURNED  ");  PUT (RESULT);  NEW_LINE;
        return RESULT;
    end CBRT;

    function LOG (X : FLOAT) return FLOAT is
--  Uses fixed formulation for generality

    RESULT        : FLOAT;
    N             : EXPONENT_TYPE;
    XN            : FLOAT;
    Y             : FLOAT;
    F             : MANTISSA_TYPE;
    Z, ZDEN, ZNUM : MANTISSA_TYPE;

    C0            : constant MANTISSA_TYPE := 0.20710_67811_86547_52440;
    --  SQRT(0.5) - 0.5
    C1 : constant FLOAT := 8#0.543#;
    C2 : constant FLOAT := -2.12194_44005_46905_82767_9E-4;

    function R (Z : MANTISSA_TYPE) return MANTISSA_TYPE is
--  Use fixed formulation here because the float coeficents are > 1.0
--  and would exceed the limits on a MANTISSA_TYPE
        A0 : constant MANTISSA_TYPE := 0.04862_85276_587;
        B0 : constant MANTISSA_TYPE := 0.69735_92187_803;
        B1 : constant MANTISSA_TYPE := -0.125;
        C  : constant MANTISSA_TYPE := 0.01360_09546_862;
    begin
        return Z +
           MANTISSA_TYPE
              (Z *
               MANTISSA_TYPE
              (MANTISSA_TYPE (Z * Z) *
               (C +
                MANTISSA_TYPE
                   (A0 /
                (B0 +
                 MANTISSA_TYPE
                    (B1 * MANTISSA_TYPE (Z * Z)))))));
    end R;

    begin

    if X < ZERO then
        NEW_LINE;
        PUT ("CALLED LOG FOR NEGATIVE ");
        PUT (X);
        PUT ("   USE ABS => ");
        RESULT := LOG (abs (X));
        PUT (RESULT);
        NEW_LINE;

    elsif X = ZERO then
        NEW_LINE;
        PUT ("CALLED LOG FOR ZERO ARGUMENT, RETURNED ");
        RESULT := -XMAX; --  SUPPOSED TO BE -LARGE
        PUT (RESULT);
        NEW_LINE;
    else
        DEFLOAT (X, N, F);
        ZNUM := F - MANTISSA_HALF;
        Y := CONVERT_TO_FLOAT (ZNUM);
        ZDEN := ZNUM / MANTISSA_DIVISOR_2 + MANTISSA_HALF;

        if ZNUM > C0 then
        Y := Y - MANTISSA_HALF;
        ZNUM := ZNUM - MANTISSA_HALF;
        ZDEN := ZDEN + MANTISSA_HALF / MANTISSA_DIVISOR_2;
        else
        N := N - 1;
        end if;

        Z := MANTISSA_TYPE (ZNUM / ZDEN);
        RESULT := CONVERT_TO_FLOAT (R (Z));

        if N /= 0 then
        XN := CONVERT_TO_FLOAT (N);
        RESULT := (XN * C2 + RESULT) + XN * C1;
        end if;
    end if;

    return RESULT;

    exception
    when others =>
        NEW_LINE;  PUT (" EXCEPTION IN LOG, X = ");  PUT (X);
        PUT ("  RETURNED 0.0");  NEW_LINE;
        return ZERO;
    end LOG;


    function LOG10 (X : FLOAT) return FLOAT is
    LOG_10_OF_2 : constant FLOAT :=
              CONVERT_TO_FLOAT
             (MANTISSA_TYPE (8#0.33626_75425_11562_41615#));
    begin
    return LOG (X) * LOG_10_OF_2;
    end LOG10;

    function EXP (X : FLOAT) return FLOAT is

    RESULT         : FLOAT;
    N              : EXPONENT_TYPE;
    XG, XN, X1, X2 : FLOAT;
    F, G           : MANTISSA_TYPE;

    BIGX           : FLOAT := EXP_LARGE;
    SMALLX         : FLOAT := EXP_SMALL;

    ONE_OVER_LOG_2 : constant FLOAT := 1.4426_95040_88896_34074;
    C1             : constant FLOAT := 0.69335_9375;
    C2             : constant FLOAT := -2.1219_44400_54690_58277E-4;

    function R (G : MANTISSA_TYPE) return MANTISSA_TYPE is
        Z, GP, Q : MANTISSA_TYPE;

        P0       : constant MANTISSA_TYPE := 0.24999_99999_9992;
        P1       : constant MANTISSA_TYPE := 0.00595_04254_9776;
        Q0       : constant MANTISSA_TYPE := 0.5;
        Q1       : constant MANTISSA_TYPE := 0.05356_75176_4522;
        Q2       : constant MANTISSA_TYPE := 0.00029_72936_3682;
    begin
        Z := MANTISSA_TYPE (G * G);
        GP := MANTISSA_TYPE ((MANTISSA_TYPE (P1 * Z) + P0) * G);
        Q := MANTISSA_TYPE ((MANTISSA_TYPE (Q2 * Z) + Q1) * Z) + Q0;
        return MANTISSA_HALF + MANTISSA_TYPE (GP / (Q - GP));
    end R;


    begin

    if X > BIGX then
        NEW_LINE;
        PUT ("  EXP CALLED WITH TOO BIG A POSITIVE ARGUMENT, ");
        PUT (X);  PUT ("   RETURNED XMAX");
        NEW_LINE;
        RESULT := XMAX;

    elsif X < SMALLX then
        NEW_LINE;
        PUT ("  EXP CALLED WITH TOO BIG A NEGATIVE ARGUMENT,  ");
        PUT (X);  PUT ("    RETURNED ZERO");
        NEW_LINE;
        RESULT := ZERO;

    elsif abs (X) < EPS then
        RESULT := ONE;
    else
        N := EXPONENT_TYPE (X * ONE_OVER_LOG_2);
        XN := CONVERT_TO_FLOAT (N);
        X1 := ROUND (X);
        X2 := X - X1;
        XG := ((X1 - XN * C1) + X2) - XN * C2;
        G := MANTISSA_TYPE (XG);
        N := N + 1;
        F := R (G);
        REFLOAT (N, F, RESULT);
    end if;

    return RESULT;

    exception
    when others =>
        NEW_LINE;  PUT (" EXCEPTION IN EXP, X = ");  PUT (X);
        PUT ("  RETURNED 1.0");  NEW_LINE;
        return ONE;
    end EXP;

    function "**" (X, Y : FLOAT) return FLOAT is
--  This is the last function to be coded since it appeared that it really
--  was un-Ada-like and ought not be in the regular package
--  Nevertheless it was included in this version
--  It is specific for FLOAT and does not have the MANTISSA_TYPE generality
    M, N                                           : EXPONENT_TYPE;
    G                                              : MANTISSA_TYPE;
    P, TEMP, IW1, I                                : INTEGER;
    RESULT, Z, V, R, U1, U2, W, W1, W2, W3, Y1, Y2 : FLOAT;

    K                                              : constant FLOAT :=
                             0.44269_50408_88963_40736;
    IBIGX                                          : constant INTEGER :=
                             INTEGER (TRUNCATE (16.0 *
                                        LOG (XMAX) -
                                        1.0));
    ISMALLX                                        : constant INTEGER :=
                             INTEGER (TRUNCATE (16.0 *
                                        LOG (XMIN) +
                                        1.0));

    P1                                             : constant FLOAT :=
                             0.83333_32862_45E-1;
    P2                                             : constant FLOAT :=
                             0.12506_48500_52E-1;

    Q1                                             : constant FLOAT :=
                             0.69314_71805_56341;
    Q2                                             : constant FLOAT :=
                             0.24022_65061_44710;
    Q3                                             : constant FLOAT :=
                             0.55504_04881_30765E-1;
    Q4                                             : constant FLOAT :=
                             0.96162_06595_83789E-2;
    Q5                                             : constant FLOAT :=
                             0.13052_55159_42810E-2;

    A1                                             : array (1 .. 17)
                                    of FLOAT :=
                             (8#1.00000_0000#,
                              8#0.75222_5750#,
                              8#0.72540_3067#,
                              8#0.70146_3367#,
                              8#0.65642_3746#,
                              8#0.63422_2140#,
                              8#0.61263_4520#,
                              8#0.57204_2434#,
                              8#0.55202_3631#,
                              8#0.53254_0767#,
                              8#0.51377_3265#,
                              8#0.47572_4623#,
                              8#0.46033_7602#,
                              8#0.44341_7233#,
                              8#0.42712_7017#,
                              8#0.41325_3033#,
                              8#0.40000_0000#);

    A2                                             : array (1 .. 8)
                                    of FLOAT :=
                             (8#0.00000_00005_22220_66302_61734_72062#,
                              8#0.00000_00003_02522_47021_04062_61124#,
                              8#0.00000_00005_21760_44016_17421_53016#,
                              8#0.00000_00007_65401_41553_72504_02177#,
                              8#0.00000_00002_44124_12254_31114_01243#,
                              8#0.00000_00000_11064_10432_66404_42174#,
                              8#0.00000_00004_72542_16063_30176_55544#,
                              8#0.00000_00001_74611_03661_23056_22556#);


    function REDUCE (V : FLOAT) return FLOAT is
    begin
        return FLOAT (INTEGER (16.0 * V)) * 0.0625;
    end REDUCE;

    begin
    if X <= ZERO then
        if X < ZERO then
        RESULT := (abs (X)) ** Y;
        NEW_LINE;
        PUT ("X**Y CALLED WITH X = ");  PUT (X);  NEW_LINE;
        PUT ("USED ABS, RETURNED ");  PUT (RESULT);  NEW_LINE;
        else
        if Y <= ZERO then
            if Y = ZERO then
            RESULT := ZERO;
            else
            RESULT := XMAX;
            end if;

            NEW_LINE;
            PUT ("X**Y CALLED WITH X = 0, Y = ");  PUT (Y);  NEW_LINE;
            PUT ("RETURNED ");  PUT (RESULT);  NEW_LINE;
        else
            RESULT := ZERO;
        end if;
        end if;
    else
        DEFLOAT (X, M, G);
        P := 1;

        if G <= A1 (9) then
        P := 9;
        end if;

        if G <= A1 (P + 4) then
        P := P + 4;
        end if;

        if G <= A1 (P + 2) then
        P := P + 2;
        end if;

        Z := ((G - A1 (P + 1)) - A2 ((P + 1) / 2)) / (G + A1 (P + 1));
        Z := Z + Z;
        V := Z * Z;
        R := (P2 * V + P1) * V * Z;
        R := R + K * R;
        U2 := (R + Z * K) + Z;
        U1 := FLOAT (INTEGER (M) * 16 - P) * 0.0625;
        Y1 := REDUCE (Y);
        Y2 := Y - Y1;
        W := U2 * Y + U1 * Y2;
        W1 := REDUCE (W);
        W2 := W - W1;
        W := W1 + U1 * Y1;
        W1 := REDUCE (W);
        W2 := W2 + (W - W1);
        W3 := REDUCE (W2);
        IW1 := INTEGER (TRUNCATE (16.0 * (W1 + W3)));
        W2 := W2 - W3;

        if W > FLOAT (IBIGX) then
        RESULT := XMAX;
        PUT ("X**Y CALLED  X =");  PUT (X);  PUT ("   Y =");  PUT (Y);
        PUT ("   TOO LARGE  RETURNED ");  PUT (RESULT);  NEW_LINE;

        elsif W < FLOAT (ISMALLX) then
        RESULT := ZERO;
        PUT ("X**Y CALLED  X =");  PUT (X);  PUT ("   Y =");  PUT (Y);
        PUT ("   TOO SMALL  RETURNED ");  PUT (RESULT);  NEW_LINE;
        else
        if W2 > ZERO then
            W2 := W2 - 0.0625;
            IW1 := IW1 + 1;
        end if;

        if IW1 < INTEGER (ZERO) then
            I := 0;
        else
            I := 1;
        end if;

        M := EXPONENT_TYPE (I + IW1 / 16);
        P := 16 * INTEGER (M) - IW1;
        Z := ((((Q5 * W2 + Q4) * W2 + Q3) * W2 + Q2) * W2 + Q1) * W2;
        Z := A1 (P + 1) + (A1 (P + 1) * Z);

        REFLOAT (M, Z, RESULT);
        end if;
    end if;

    return RESULT;
    end "**";

begin
    EXP_LARGE := LOG (XMAX) * (ONE - EPS);
    EXP_SMALL := LOG (XMIN) * (ONE - EPS);
end CORE_FUNCTIONS;




package TRIG_FUNCTIONS is
    function SIN   (X : FLOAT) return FLOAT;
    function COS   (X : FLOAT) return FLOAT;
    function TAN   (X : FLOAT) return FLOAT;
    function COT   (X : FLOAT) return FLOAT;
    function ASIN  (X : FLOAT) return FLOAT;
    function ACOS  (X : FLOAT) return FLOAT;
    function ATAN  (X : FLOAT) return FLOAT;
    function ATAN2 (V, U : FLOAT) return FLOAT;
    function SINH  (X : FLOAT) return FLOAT;
    function COSH  (X : FLOAT) return FLOAT;
    function TANH  (X : FLOAT) return FLOAT;
end TRIG_FUNCTIONS;





with TEXT_IO;
use TEXT_IO;
with FLOATING_CHARACTERISTICS;
use FLOATING_CHARACTERISTICS;
with NUMERIC_IO;
use NUMERIC_IO;
with NUMERIC_PRIMITIVES;
use NUMERIC_PRIMITIVES;
with CORE_FUNCTIONS;
use CORE_FUNCTIONS;

package body TRIG_FUNCTIONS is

--  PRELIMINARY VERSION *********************************

--  The following routines are coded directly from the algorithms and
--  coeficients given in "Software Manual for the Elementry Functions"
--  by William J. Cody, Jr. and William Waite, Prentice_Hall, 1980
--  This particular version is stripped to work with FLOAT and INTEGER
--  and uses a mantissa represented as a FLOAT
--  A more general formulation uses MANTISSA_TYPE, etc.
--  The coeficients are appropriate for 25 to 32 bits floating significance
--  They will work for less but slightly shorter versions are possible
--  The routines are coded to stand alone so they need not be compiled together

--      16 JULY 1982       W A WHITAKER  AFATL EGLIN AFB FL 32542
--                         T C EICHOLTZ  USAFA


    function SIN (X : FLOAT) return FLOAT is
    SGN, Y       : FLOAT;
    N            : INTEGER;
    XN           : FLOAT;
    F, G, X1, X2 : FLOAT;
    RESULT       : FLOAT;

    YMAX         : FLOAT := FLOAT (INTEGER (PI * TWO ** (IT / 2)));
    BETA         : FLOAT := CONVERT_TO_FLOAT (IBETA);
    EPSILON      : FLOAT := BETA ** (-IT / 2);

    C1           : constant FLOAT := 3.140625;
    C2           : constant FLOAT := 9.6765_35897_93E-4;

    function R (G : FLOAT) return FLOAT is
        R1 : constant FLOAT := -0.16666_66660_883;
        R2 : constant FLOAT := 0.83333_30720_556E-2;
        R3 : constant FLOAT := -0.19840_83282_313E-3;
        R4 : constant FLOAT := 0.27523_97106_775E-5;
        R5 : constant FLOAT := -0.23868_34640_601E-7;
    begin
        return ((((R5 * G + R4) * G + R3) * G + R2) * G + R1) * G;
    end R;

    begin
    if X < ZERO then
        SGN := -ONE;
        Y := -X;
    else
        SGN := ONE;
        Y := X;
    end if;

    if Y > YMAX then
        NEW_LINE;
        PUT (" SIN CALLED WITH ARGUMENT TOO LARGE FOR ACCURACY ");
        PUT (X);  NEW_LINE;
    end if;

    N := INTEGER (Y * ONE_OVER_PI);
    XN := CONVERT_TO_FLOAT (N);

    if N mod 2 /= 0 then
        SGN := -SGN;
    end if;

    X1 := TRUNCATE (abs (X));
    X2 := abs (X) - X1;
    F := ((X1 - XN * C1) + X2) - XN * C2;

    if abs (F) < EPSILON then
        RESULT := F;
    else
        G := F * F;
        RESULT := F + F * R (G);
    end if;

    return (SGN * RESULT);
    end SIN;


    function COS (X : FLOAT) return FLOAT is
    SGN, Y       : FLOAT;
    N            : INTEGER;
    XN           : FLOAT;
    F, G, X1, X2 : FLOAT;
    RESULT       : FLOAT;

    YMAX         : FLOAT := FLOAT (INTEGER (PI * TWO ** (IT / 2)));
    BETA         : FLOAT := CONVERT_TO_FLOAT (IBETA);
    EPSILON      : FLOAT := BETA ** (-IT / 2);

    C1           : constant FLOAT := 3.140625;
    C2           : constant FLOAT := 9.6765_35897_93E-4;

    function R (G : FLOAT) return FLOAT is
        R1 : constant FLOAT := -0.16666_66660_883;
        R2 : constant FLOAT := 0.83333_30720_556E-2;
        R3 : constant FLOAT := -0.19840_83282_313E-3;
        R4 : constant FLOAT := 0.27523_97106_775E-5;
        R5 : constant FLOAT := -0.23868_34640_601E-7;
    begin
        return ((((R5 * G + R4) * G + R3) * G + R2) * G + R1) * G;
    end R;

    begin
    SGN := 1.0;
    Y := abs (X) + PI_OVER_TWO;

    if Y > YMAX then
        NEW_LINE;
        PUT (" COS CALLED WITH ARGUMENT TOO LARGE FOR ACCURACY ");
        PUT (X);  NEW_LINE;
    end if;

    N := INTEGER (Y * ONE_OVER_PI);
    XN := CONVERT_TO_FLOAT (N);

    if N mod 2 /= 0 then
        SGN := -SGN;
    end if;

    XN := XN - 0.5;      -- TO FORM COS INSTEAD OF SIN
    X1 := TRUNCATE (abs (X));
    X2 := abs (X) - X1;
    F := ((X1 - XN * C1) + X2) - XN * C2;

    if abs (F) < EPSILON then
        RESULT := F;
    else
        G := F * F;
        RESULT := F + F * R (G);
    end if;

    return (SGN * RESULT);
    end COS;


    function TAN (X : FLOAT) return FLOAT is
    SGN, Y       : FLOAT;
    N            : INTEGER;
    XN           : FLOAT;
    F, G, X1, X2 : FLOAT;
    RESULT       : FLOAT;

    YMAX         : FLOAT := FLOAT (INTEGER (PI * TWO ** (IT / 2))) / 2.0;
    BETA         : FLOAT := CONVERT_TO_FLOAT (IBETA);
    EPSILON      : FLOAT := BETA ** (-IT / 2);

    C1           : constant FLOAT := 8#1.444#;
    C2           : constant FLOAT := 4.8382_67948_97E-4;

    function R (G : FLOAT) return FLOAT is
        P0 : constant FLOAT := 1.0;
        P1 : constant FLOAT := -0.11136_14403_566;
        P2 : constant FLOAT := 0.10751_54738_488E-2;
        Q0 : constant FLOAT := 1.0;
        Q1 : constant FLOAT := -0.44469_47720_281;
        Q2 : constant FLOAT := 0.15973_39213_300E-1;
    begin
        return ((P2 * G + P1) * G * F + F) /
           (((Q2 * G + Q1) * G + 0.5) + 0.5);
    end R;

    begin
    Y := abs (X);

    if Y > YMAX then
        NEW_LINE;
        PUT (" TAN CALLED WITH ARGUMENT TOO LARGE FOR ACCURACY ");
        PUT (X);  NEW_LINE;
    end if;

    N := INTEGER (X * TWO_OVER_PI);
    XN := CONVERT_TO_FLOAT (N);
    X1 := TRUNCATE (X);
    X2 := X - X1;
    F := ((X1 - XN * C1) + X2) - XN * C2;

    if abs (F) < EPSILON then
        RESULT := F;
    else
        G := F * F;
        RESULT := R (G);
    end if;

    if N mod 2 = 0 then
        return RESULT;
    else
        return -1.0 / RESULT;
    end if;
    end TAN;

    function COT (X : FLOAT) return FLOAT is
    SGN, Y       : FLOAT;
    N            : INTEGER;
    XN           : FLOAT;
    F, G, X1, X2 : FLOAT;
    RESULT       : FLOAT;


    YMAX     : FLOAT := FLOAT (INTEGER (PI * TWO ** (IT / 2))) / 2.0;
    BETA     : FLOAT := CONVERT_TO_FLOAT (IBETA);
    EPSILON  : FLOAT := BETA ** (-IT / 2);
    EPSILON1 : FLOAT := 1.0 / XMAX;

    C1       : constant FLOAT := 8#1.444#;
    C2       : constant FLOAT := 4.8382_67948_97E-4;

    function R (G : FLOAT) return FLOAT is
        P0 : constant FLOAT := 1.0;
        P1 : constant FLOAT := -0.11136_14403_566;
        P2 : constant FLOAT := 0.10751_54738_488E-2;
        Q0 : constant FLOAT := 1.0;
        Q1 : constant FLOAT := -0.44469_47720_281;
        Q2 : constant FLOAT := 0.15973_39213_300E-1;
    begin
        return ((P2 * G + P1) * G * F + F) /
           (((Q2 * G + Q1) * G + 0.5) + 0.5);
    end R;

    begin
    Y := abs (X);

    if Y < EPSILON1 then
        NEW_LINE;
        PUT (" COT CALLED WITH ARGUMENT TOO NEAR ZERO ");
        PUT (X);  NEW_LINE;

        if X < 0.0 then
        return -XMAX;
        else
        return XMAX;
        end if;
    end if;

    if Y > YMAX then
        NEW_LINE;
        PUT (" COT CALLED WITH ARGUMENT TOO LARGE FOR ACCURACY ");
        PUT (X);  NEW_LINE;
    end if;

    N := INTEGER (X * TWO_OVER_PI);
    XN := CONVERT_TO_FLOAT (N);
    X1 := TRUNCATE (X);
    X2 := X - X1;
    F := ((X1 - XN * C1) + X2) - XN * C2;

    if abs (F) < EPSILON then
        RESULT := F;
    else
        G := F * F;
        RESULT := R (G);
    end if;

    if N mod 2 /= 0 then
        return -RESULT;
    else
        return 1.0 / RESULT;
    end if;
    end COT;


    function ASIN (X : FLOAT) return FLOAT is
    G, Y    : FLOAT;
    RESULT  : FLOAT;
    BETA    : FLOAT := CONVERT_TO_FLOAT (IBETA);
    EPSILON : FLOAT := BETA ** (-IT / 2);

    function R (G : FLOAT) return FLOAT is
        P1 : constant FLOAT := -0.27516_55529_0596E1;
        P2 : constant FLOAT := 0.29058_76237_4859E1;
        P3 : constant FLOAT := -0.59450_14419_3246;
        Q0 : constant FLOAT := -0.16509_93320_2424E2;
        Q1 : constant FLOAT := 0.24864_72896_9164E2;
        Q2 : constant FLOAT := -0.10333_86707_2113E2;
        Q3 : constant FLOAT := 1.0;
    begin
        return (((P3 * G + P2) * G + P1) * G) /
           (((G + Q2) * G + Q1) * G + Q0);
    end R;

    begin
    Y := abs (X);

    if Y > HALF then
        if Y > 1.0 then
        NEW_LINE;  PUT (" ASIN CALLED FOR ");  PUT (X);
        PUT (" (> 1)  TRUNCATED TO 1, CONTINUED");  NEW_LINE;
        Y := 1.0;
        end if;

        G := ((0.5 - Y) + 0.5) / 2.0;
        Y := -2.0 * SQRT (G);
        RESULT := Y + Y * R (G);
        RESULT := (PI_OVER_FOUR + RESULT) + PI_OVER_FOUR;
    else
        if Y < EPSILON then
        RESULT := Y;
        else
        G := Y * Y;
        RESULT := Y + Y * R (G);
        end if;
    end if;

    if X < 0.0 then
        RESULT := -RESULT;
    end if;

    return RESULT;
    end ASIN;

    function ACOS (X : FLOAT) return FLOAT is
    G, Y    : FLOAT;
    RESULT  : FLOAT;
    BETA    : FLOAT := CONVERT_TO_FLOAT (IBETA);
    EPSILON : FLOAT := BETA ** (-IT / 2);

    function R (G : FLOAT) return FLOAT is
        P1 : constant FLOAT := -0.27516_55529_0596E1;
        P2 : constant FLOAT := 0.29058_76237_4859E1;
        P3 : constant FLOAT := -0.59450_14419_3246;
        Q0 : constant FLOAT := -0.16509_93320_2424E2;
        Q1 : constant FLOAT := 0.24864_72896_9164E2;
        Q2 : constant FLOAT := -0.10333_86707_2113E2;
        Q3 : constant FLOAT := 1.0;
    begin
        return (((P3 * G + P2) * G + P1) * G) /
           (((G + Q2) * G + Q1) * G + Q0);
    end R;

    begin
    Y := abs (X);

    if Y > HALF then
        if Y > 1.0 then
        NEW_LINE;  PUT (" ACOS CALLED FOR ");  PUT (X);
        PUT (" (> 1)  TRUNCATED TO 1, CONTINUED");  NEW_LINE;
        Y := 1.0;
        end if;

        G := ((0.5 - Y) + 0.5) / 2.0;
        Y := -2.0 * SQRT (G);
        RESULT := Y + Y * R (G);

        if X < 0.0 then
        RESULT := (PI_OVER_TWO + RESULT) + PI_OVER_TWO;
        else
        RESULT := -RESULT;
        end if;

    else
        if Y < EPSILON then
        RESULT := Y;
        else
        G := Y * Y;
        RESULT := Y + Y * R (G);
        end if;

        if X < 0.0 then
        RESULT := (PI_OVER_FOUR + RESULT) + PI_OVER_FOUR;
        else
        RESULT := (PI_OVER_FOUR - RESULT) + PI_OVER_FOUR;
        end if;
    end if;

    return RESULT;
    end ACOS;


    function ATAN (X : FLOAT) return FLOAT is
    F, G : FLOAT;

    subtype REGION is INTEGER range 0 .. 3; --  ##########
    N                : REGION;
    RESULT           : FLOAT;

    BETA             : FLOAT := CONVERT_TO_FLOAT (IBETA);

    EPSILON          : FLOAT := BETA ** (-IT / 2);

    SQRT_3           : constant FLOAT := 1.73205_08075_68877_29353;
    SQRT_3_MINUS_1   : constant FLOAT := 0.73205_08075_68877_29353;
    TWO_MINUS_SQRT_3 : constant FLOAT := 0.26794_91924_31122_70647;

    function R (G : FLOAT) return FLOAT is
        P0 : constant FLOAT := -0.14400_83448_74E1;
        P1 : constant FLOAT := -0.72002_68488_98;
        Q0 : constant FLOAT := 0.43202_50389_19E1;
        Q1 : constant FLOAT := 0.47522_25845_99E1;
        Q2 : constant FLOAT := 1.0;
    begin
        return ((P1 * G + P0) * G) / ((G + Q1) * G + Q0);
    end R;

    begin
    F := abs (X);

    if F > 1.0 then
        F := 1.0 / F;
        N := 2;
    else
        N := 0;
    end if;

    if F > TWO_MINUS_SQRT_3 then
        F := (((SQRT_3_MINUS_1 * F - 0.5) - 0.5) + F) / (SQRT_3 + F);
        N := N + 1;
    end if;

    if abs (F) < EPSILON then
        RESULT := F;
    else
        G := F * F;
        RESULT := F + F * R (G);
    end if;

    if N > 1 then
        RESULT := -RESULT;
    end if;

    case N is
        when 0 =>
        RESULT := RESULT;

        when 1 =>
        RESULT := PI_OVER_SIX + RESULT;

        when 2 =>
        RESULT := PI_OVER_TWO + RESULT;

        when 3 =>
        RESULT := PI_OVER_THREE + RESULT;
    end case;

    if X < 0.0 then
        RESULT := -RESULT;
    end if;

    return RESULT;

    end ATAN;



    function ATAN2 (V, U : FLOAT) return FLOAT is
    X, RESULT : FLOAT;

    begin

    if U = 0.0 then
        if V = 0.0 then
        RESULT := 0.0;
        NEW_LINE;
        PUT (" ATAN2 CALLED WITH 0/0   RETURNED ");  PUT (RESULT);
        NEW_LINE;

        elsif V > 0.0 then
        RESULT := PI_OVER_TWO;
        else
        RESULT := -PI_OVER_TWO;
        end if;

    else
        X := abs (V / U);
        --  If underflow or overflow is detected, go to the exception
        RESULT := ATAN (X);

        if U < 0.0 then
        RESULT := PI - RESULT;
        end if;

        if V < 0.0 then
        RESULT := -RESULT;
        end if;
    end if;

    return RESULT;
    exception
    when NUMERIC_ERROR =>
        if abs (V) > abs (U) then
        RESULT := PI_OVER_TWO;

        if V < 0.0 then
            RESULT := -RESULT;
        end if;
        else
        RESULT := 0.0;

        if U < 0.0 then
            RESULT := PI - RESULT;
        end if;
        end if;

        return RESULT;
    end ATAN2;


    function SINH (X : FLOAT) return FLOAT is
    G, W, Y, Z       : FLOAT;
    RESULT           : FLOAT;
    BETA             : FLOAT := CONVERT_TO_FLOAT (IBETA);
    EPSILON          : FLOAT := BETA ** (-IT / 2);

    YBAR             : FLOAT := EXP_LARGE;
    LN_V             : FLOAT := 8#0.542714#;
    V_OVER_2_MINUS_1 : FLOAT := 0.13830_27787_96019_02638E-4;
    WMAX             : FLOAT := YBAR - LN_V + 0.69;

    function R (G : FLOAT) return FLOAT is
        P0 : constant FLOAT := 0.10622_28883_7151E4;
        P1 : constant FLOAT := 0.31359_75645_6058E2;
        P2 : constant FLOAT := 0.34364_14035_8506;
        Q0 : constant FLOAT := 0.63733_73302_1822E4;
        Q1 : constant FLOAT := -0.13051_01250_9199E3;
        Q2 : constant FLOAT := 1.0;
    begin
        return (((P2 * G + P1) * G + P0) * G) / ((G + Q1) * G + Q0);
    end R;

    begin
    Y := abs (X);

    if Y <= 1.0 then
        if Y < EPSILON then
        RESULT := X;
        else
        G := X * X;
        RESULT := X + X * R (G);
        end if;

    else
        if Y <= YBAR then
        Z := EXP (Y);
        RESULT := (Z - 1.0 / Z) / 2.0;
        else
        W := Y - LN_V;

        if W > WMAX then
            NEW_LINE;
            PUT (" SINH CALLED WITH TOO LARGE ARGUMENT  ");  PUT (X);
            PUT (" RETURN BIG");  NEW_LINE;
            W := WMAX;
        end if;

        Z := EXP (W);
        RESULT := Z + V_OVER_2_MINUS_1 * Z;
        end if;

        if X < 0.0 then
        RESULT := -RESULT;
        end if;

    end if;

    return RESULT;
    end SINH;


    function COSH (X : FLOAT) return FLOAT is
    G, W, Y, Z       : FLOAT;
    RESULT           : FLOAT;
    BETA             : FLOAT := CONVERT_TO_FLOAT (IBETA);
    EPSILON          : FLOAT := BETA ** (-IT / 2);

    YBAR             : FLOAT := EXP_LARGE;
    LN_V             : FLOAT := 8#0.542714#;
    V_OVER_2_MINUS_1 : FLOAT := 0.13830_27787_96019_02638E-4;
    WMAX             : FLOAT := YBAR - LN_V + 0.69;

    function R (G : FLOAT) return FLOAT is
        P0 : constant FLOAT := 0.10622_28883_7151E4;
        P1 : constant FLOAT := 0.31359_75645_6058E2;
        P2 : constant FLOAT := 0.34364_14035_8506;
        Q0 : constant FLOAT := 0.63733_73302_1822E4;
        Q1 : constant FLOAT := -0.13051_01250_9199E3;
        Q2 : constant FLOAT := 1.0;
    begin
        return (((P2 * G + P1) * G + P0) * G) / ((G + Q1) * G + Q0);
    end R;

    begin
    Y := abs (X);

    if Y <= YBAR then
        Z := EXP (Y);
        RESULT := (Z + 1.0 / Z) / 2.0;
    else
        W := Y - LN_V;

        if W > WMAX then
        NEW_LINE;
        PUT (" COSH CALLED WITH TOO LARGE ARGUMENT  ");  PUT (X);
        PUT (" RETURN BIG");  NEW_LINE;
        W := WMAX;
        end if;

        Z := EXP (W);
        RESULT := Z + V_OVER_2_MINUS_1 * Z;
    end if;

    return RESULT;
    end COSH;


    function TANH (X : FLOAT) return FLOAT is
    G, W, Y, Z  : FLOAT;
    RESULT      : FLOAT;
    BETA        : FLOAT := CONVERT_TO_FLOAT (IBETA);
    EPSILON     : FLOAT := BETA ** (-IT / 2);

    XBIG        : FLOAT :=
              (LOG (2.0) + CONVERT_TO_FLOAT (IT + 1) * LOG (BETA)) /
              2.0;
    LN_3_OVER_2 : FLOAT := 0.54930_61443_34054_84570;

    function R (G : FLOAT) return FLOAT is
        P0 : constant FLOAT := -0.21063_95800_0245E2;
        P1 : constant FLOAT := -0.93363_47565_2401;
        Q0 : constant FLOAT := 0.63191_87401_5582E2;
        Q1 : constant FLOAT := 0.28077_65347_0471E2;
        Q2 : constant FLOAT := 1.0;
    begin
        return ((P1 * G + P0) * G) / ((G + Q1) * G + Q0);
    end R;

    begin
    Y := abs (X);

    if Y > XBIG then
        RESULT := 1.0;
    else
        if Y > LN_3_OVER_2 then
        RESULT := 0.5 - 1.0 / (EXP (Y + Y) + 1.0);
        RESULT := RESULT + RESULT;
        else
        if Y < EPSILON then
            RESULT := Y;
        else
            G := Y * Y;
            RESULT := Y + Y * R (G);
        end if;
        end if;
    end if;

    if X < 0.0 then
        RESULT := -RESULT;
    end if;

    return RESULT;
    end TANH;


begin
    null;
end TRIG_FUNCTIONS;




with TEXT_IO;

package SCREEN_IO is
-- Author   : M. K. McNair
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date     : 8 March 1985
-- Summary  :
--   This package provides a localized way of inputting values from
--   a terminal. If errors occur on input, the function will handle
--   the error itself - control does not return until a valid value
--   has been entered.

    function RETURNED_INTEGER (PROMPT      : STRING := "";
                   DEFAULT     : INTEGER := 0;
                   USE_DEFAULT : BOOLEAN := FALSE;
                   ERROR_TEXT  : STRING := "";
                   FROM_VALUE  : INTEGER := INTEGER'FIRST;
                   TO_VALUE    : INTEGER := INTEGER'LAST;
                   CONFIRM     : BOOLEAN := FALSE) return INTEGER;
    function RETURNED_FLOAT
            (PROMPT                      : STRING := "";
         DEFAULT                     : FLOAT := 0.0;
         USE_DEFAULT                 : BOOLEAN := FALSE;
         DISPLAY_EXPONENT_IN_DEFAULT : BOOLEAN := FALSE;
         AFT_WIDTH_IN_DEFAULT        : NATURAL := 2;
         ERROR_TEXT                  : STRING := "";
         FROM_VALUE                  : FLOAT := FLOAT'FIRST;
         TO_VALUE                    : FLOAT := FLOAT'LAST;
         CONFIRM                     : BOOLEAN := FALSE) return FLOAT;

    function RETURNED_STRING (PROMPT      : STRING := "";
                  DEFAULT     : STRING := "";
                  USE_DEFAULT : BOOLEAN := FALSE;
                  CONFIRM     : BOOLEAN := FALSE) return STRING;

    generic
    type ENUM_TYPE is (<>);
    function RETURNED_ENUMERATION (PROMPT      : STRING := "";
                   DEFAULT     : ENUM_TYPE := ENUM_TYPE'FIRST;
                   USE_DEFAULT : BOOLEAN := FALSE;
                   ERROR_TEXT  : STRING := "";
                   FROM_VALUE  : ENUM_TYPE := ENUM_TYPE'FIRST;
                   TO_VALUE    : ENUM_TYPE := ENUM_TYPE'LAST;
                   CONFIRM     : BOOLEAN := FALSE)
                    return ENUM_TYPE;

end SCREEN_IO;




package body SCREEN_IO is
-- Author   : M. K. McNair
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date     : 8 March 1985
-- Summary  :
--   This is the package body to the SCREEN_IO package.

    BUFFER_LENGTH : constant POSITIVE := 256;



    procedure ERROR (MSG : STRING) is
    begin
    if MSG'LENGTH > 0 then
        TEXT_IO.PUT_LINE (MSG);
    end if;
    end ERROR;



    -- Author   : T. C. Bryan
    -- Source:     Division Software Technology and Support
    --             Western Development Laboratories
    --             Ford Aerospace & Communications Corporation
    --             ATTN:  Ada Tools Group
    -- Date     : June 1985
    -- Summary  :
    --   This function evaluates each character coming from standard
    --   input for a simulated back space character, the current value
    --   of this character is"#" sign.  When encountered such character,
    --   it redraws the current input line to the screen minus the last
    --   two characters.
    --   In effect, it allows user to correct miswritten character
    --   while inputting data.

    function GET_THE_STRING return STRING is

    A_BUFF         : STRING (1 .. BUFFER_LENGTH);
    INDEX          : INTEGER := 0;
    CURRENT_LETTER : CHARACTER;

    ---------------------------------------------------------
    -- the "\" sign can be replaced by any special character
    -- that is not normally part of the input line.
    ---------------------------------------------------------

    BACK_SPACE : constant CHARACTER := '\';

    begin

    while not TEXT_IO.END_OF_LINE loop
        TEXT_IO.GET (CURRENT_LETTER);

        if (CURRENT_LETTER /= BACK_SPACE) then
        INDEX := INDEX + 1;
        A_BUFF (INDEX) := CURRENT_LETTER;
        else
        INDEX := INDEX - 1;

        if INDEX < 0 then
            INDEX := 0;
        end if;

        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT (A_BUFF (1 .. INDEX));
        end if;
    end loop;

    TEXT_IO.SKIP_LINE;

    return (A_BUFF (1 .. INDEX));

    end GET_THE_STRING;



    function GO_AGAIN return BOOLEAN is

    type YESNO_TYPE is (Y, YE, YES, N, NO);

    package YESNO_IO is new TEXT_IO.ENUMERATION_IO (YESNO_TYPE);

    ANSWER : YESNO_TYPE;
    BUFFER : STRING (1 .. BUFFER_LENGTH);
    LAST   : NATURAL;
    begin
    TEXT_IO.NEW_LINE;
    TEXT_IO.PUT ("Would you like to re-enter this value? ");

    TEXT_IO.GET_LINE (BUFFER, LAST);
    YESNO_IO.GET (BUFFER (1 .. LAST), ANSWER, LAST);
    return ANSWER in Y .. YES;

    exception
    when TEXT_IO.DATA_ERROR =>
        TEXT_IO.PUT_LINE ("Please enter either Yes or No.");
        return GO_AGAIN;

    when TEXT_IO.END_ERROR =>
        return FALSE;
    end GO_AGAIN;



    function RETURNED_INTEGER (PROMPT      : STRING := "";
                   DEFAULT     : INTEGER := 0;
                   USE_DEFAULT : BOOLEAN := FALSE;
                   ERROR_TEXT  : STRING := "";
                   FROM_VALUE  : INTEGER := INTEGER'FIRST;
                   TO_VALUE    : INTEGER := INTEGER'LAST;
                   CONFIRM     : BOOLEAN := FALSE) return INTEGER is


    ENCOUNTERED_CONSTRAINT_ERROR : exception;
    ENCOUNTERED_END_ERROR        : exception;
    ENCOUNTERED_DATA_ERROR       : exception;

    LAST : INTEGER;

    subtype ANSWER_TYPE is INTEGER range FROM_VALUE .. TO_VALUE;

    ANSWER : ANSWER_TYPE;

    package INT_IO is new TEXT_IO.INTEGER_IO (INTEGER);

    function RETURNED_ANSWER (VALUE : STRING) return INTEGER is

    begin

        INT_IO.GET (VALUE, ANSWER, LAST);
        return (ANSWER);

    exception
        when CONSTRAINT_ERROR | NUMERIC_ERROR =>
        raise ENCOUNTERED_CONSTRAINT_ERROR;

        when TEXT_IO.END_ERROR =>
        raise ENCOUNTERED_END_ERROR;

        when TEXT_IO.DATA_ERROR =>
        raise ENCOUNTERED_DATA_ERROR;

        when others =>
        raise ENCOUNTERED_DATA_ERROR;

    end RETURNED_ANSWER;
    begin

    TEXT_IO.PUT (PROMPT);

    if USE_DEFAULT then
        TEXT_IO.NEW_LINE;
        TEXT_IO.SET_COL (4);
        TEXT_IO.PUT ("(default => ");
        INT_IO.PUT (DEFAULT);  TEXT_IO.PUT (" ) ");
    end if;

    declare
        BUFFER : constant STRING := GET_THE_STRING;

    begin

        if CONFIRM then
        if GO_AGAIN then
            return RETURNED_INTEGER
                  (PROMPT, DEFAULT, USE_DEFAULT, ERROR_TEXT,
                   FROM_VALUE, TO_VALUE, CONFIRM);
        end if;
        end if;

        return (RETURNED_ANSWER (BUFFER));
    exception
        when ENCOUNTERED_CONSTRAINT_ERROR =>
        if ERROR_TEXT /= "" then
            ERROR (MSG => ERROR_TEXT);
        else
            TEXT_IO.PUT ("Please enter an integer between ");
            INT_IO.PUT (FROM_VALUE);
            TEXT_IO.PUT (" and ");
            INT_IO.PUT (TO_VALUE);  TEXT_IO.NEW_LINE;
        end if;

        return RETURNED_INTEGER
              (PROMPT, DEFAULT, USE_DEFAULT, ERROR_TEXT,
               FROM_VALUE, TO_VALUE, CONFIRM);

        when ENCOUNTERED_END_ERROR =>
        if USE_DEFAULT then
            TEXT_IO.PUT ("Using default value of => ");
            INT_IO.PUT (DEFAULT);  TEXT_IO.NEW_LINE;
            return DEFAULT;
        else
            if ERROR_TEXT = "" then
            TEXT_IO.PUT ("Please enter an integer between ");
            INT_IO.PUT (FROM_VALUE);
            TEXT_IO.PUT (" and ");
            INT_IO.PUT (TO_VALUE);  TEXT_IO.NEW_LINE;
            else
            ERROR (MSG => ERROR_TEXT);
            end if;

            return RETURNED_INTEGER
                  (PROMPT, DEFAULT, USE_DEFAULT, ERROR_TEXT,
                   FROM_VALUE, TO_VALUE, CONFIRM);
        end if;

        when ENCOUNTERED_DATA_ERROR =>
        if ERROR_TEXT /= "" then
            ERROR (MSG => ERROR_TEXT);
        else
            ERROR (MSG => "You must enter an integer.");
        end if;

        return RETURNED_INTEGER
              (PROMPT, DEFAULT, USE_DEFAULT, ERROR_TEXT,
               FROM_VALUE, TO_VALUE, CONFIRM);

    end;

    end RETURNED_INTEGER;



    function RETURNED_FLOAT
            (PROMPT                      : STRING := "";
         DEFAULT                     : FLOAT := 0.0;
         USE_DEFAULT                 : BOOLEAN := FALSE;
         DISPLAY_EXPONENT_IN_DEFAULT : BOOLEAN := FALSE;
         AFT_WIDTH_IN_DEFAULT        : NATURAL := 2;
         ERROR_TEXT                  : STRING := "";
         FROM_VALUE                  : FLOAT := FLOAT'FIRST;
         TO_VALUE                    : FLOAT := FLOAT'LAST;
         CONFIRM                     : BOOLEAN := FALSE) return FLOAT is

    LAST : INTEGER;

    ENCOUNTER_END_ERROR  : exception;
    END_CONVERT_TO_FLOAT : exception;

    subtype ANSWER_TYPE is FLOAT range FROM_VALUE .. TO_VALUE;

    ANSWER : ANSWER_TYPE;

    package FLT_IO is new TEXT_IO.FLOAT_IO (FLOAT);


    -- Author   : T. C. Bryan
    -- Source:     Division Software Technology and Support
    --             Western Development Laboratories
    --             Ford Aerospace & Communications Corporation
    --             ATTN:  Ada Tools Group
    -- Date     : June 1985
    -- Summary  :
    --   This function evaluates a numerical value coming in from standard
    --   input and converts it, if necessary, to a float number.
    --   In effect, it allows user to input a float number without being
    --   restricted to a specific format.

    function CONVERT_TO_FLOAT (TEMP_NAME : STRING) return FLOAT is



        FOUND_DOT          : BOOLEAN := FALSE;
        FOUND_NU_AFTER_DOT : BOOLEAN := FALSE;

        A_FLOAT_NUMBER     : ANSWER_TYPE;
        LAST_NU            : POSITIVE;

    begin
        if TEMP_NAME = "" then
        raise ENCOUNTER_END_ERROR;
        end if;

        for I in 1 .. TEMP_NAME'LENGTH loop
        if TEMP_NAME (I) = '.' and not FOUND_DOT then
            FOUND_DOT := TRUE;

        elsif FOUND_DOT and TEMP_NAME (I) /= ' ' then
            FOUND_NU_AFTER_DOT := TRUE;
        end if;

        end loop;

        if FOUND_DOT then
                -- case .x
        if TEMP_NAME (1) = '.' and TEMP_NAME'LENGTH > 1 then
            FLT_IO.GET
               (FROM => "0" & TEMP_NAME,
            ITEM => A_FLOAT_NUMBER,
            LAST => LAST_NU);
            -- case x.x
        elsif FOUND_NU_AFTER_DOT then
            FLT_IO.GET
               (FROM => TEMP_NAME,
            ITEM => A_FLOAT_NUMBER,
            LAST => LAST_NU);
            -- case x.
        else
            FLT_IO.GET
               (FROM => TEMP_NAME & "0",
            ITEM => A_FLOAT_NUMBER,
            LAST => LAST_NU);
        end if;
        -- case x
        else
        FLT_IO.GET (FROM => TEMP_NAME & ".0",
                ITEM => A_FLOAT_NUMBER,
                LAST => LAST_NU);
        end if;

        return (A_FLOAT_NUMBER);

    exception
        when CONSTRAINT_ERROR | NUMERIC_ERROR | TEXT_IO.DATA_ERROR =>
        raise END_CONVERT_TO_FLOAT;

        when TEXT_IO.END_ERROR =>
        raise ENCOUNTER_END_ERROR;

    end CONVERT_TO_FLOAT;



    begin

    TEXT_IO.PUT (PROMPT);

    if USE_DEFAULT then
        TEXT_IO.NEW_LINE;
        TEXT_IO.SET_COL (4);
        TEXT_IO.PUT ("(default => ");

        if not DISPLAY_EXPONENT_IN_DEFAULT then
        FLT_IO.PUT (DEFAULT, EXP => 0, AFT => AFT_WIDTH_IN_DEFAULT);
        else
        FLT_IO.PUT (DEFAULT, AFT => AFT_WIDTH_IN_DEFAULT);
        end if;

        TEXT_IO.PUT (" ) ");
    end if;

    declare
        BUFFER : constant STRING := GET_THE_STRING;

    begin

        if CONFIRM then
        if GO_AGAIN then
            return RETURNED_FLOAT
                  (PROMPT, DEFAULT, USE_DEFAULT,
                   DISPLAY_EXPONENT_IN_DEFAULT,
                   AFT_WIDTH_IN_DEFAULT, ERROR_TEXT, FROM_VALUE,
                   TO_VALUE, CONFIRM);
        end if;
        end if;

        return (CONVERT_TO_FLOAT (TEMP_NAME => BUFFER));
    exception
        when END_CONVERT_TO_FLOAT =>
        if ERROR_TEXT /= "" then
            ERROR (MSG => ERROR_TEXT);
        else
            TEXT_IO.PUT ("Please enter a float between ");
            FLT_IO.PUT (FROM_VALUE, EXP => 0);
            TEXT_IO.PUT (" and ");
            FLT_IO.PUT (TO_VALUE, EXP => 0);
            TEXT_IO.NEW_LINE;
        end if;

        return RETURNED_FLOAT
              (PROMPT, DEFAULT, USE_DEFAULT,
               DISPLAY_EXPONENT_IN_DEFAULT, AFT_WIDTH_IN_DEFAULT,
               ERROR_TEXT, FROM_VALUE, TO_VALUE, CONFIRM);

        when ENCOUNTER_END_ERROR =>
        if USE_DEFAULT then
            TEXT_IO.PUT ("Using default value of => ");
            FLT_IO.PUT (DEFAULT, EXP => 0);  TEXT_IO.NEW_LINE;
            return DEFAULT;
        else
            if ERROR_TEXT = "" then
            TEXT_IO.PUT ("Please enter a float between ");
            FLT_IO.PUT (FROM_VALUE, EXP => 0);
            TEXT_IO.PUT (" and ");
            FLT_IO.PUT (TO_VALUE, EXP => 0);
            TEXT_IO.NEW_LINE;
            else
            ERROR (MSG => ERROR_TEXT);
            end if;

            return RETURNED_FLOAT
                  (PROMPT, DEFAULT, USE_DEFAULT,
                   DISPLAY_EXPONENT_IN_DEFAULT,
                   AFT_WIDTH_IN_DEFAULT, ERROR_TEXT, FROM_VALUE,
                   TO_VALUE, CONFIRM);
        end if;

    end;

    end RETURNED_FLOAT;




    function RETURNED_STRING (PROMPT      : STRING := "";
                  DEFAULT     : STRING := "";
                  USE_DEFAULT : BOOLEAN := FALSE;
                  CONFIRM     : BOOLEAN := FALSE) return STRING is

    begin

    TEXT_IO.PUT (PROMPT);

    if USE_DEFAULT then
        TEXT_IO.NEW_LINE;
        TEXT_IO.SET_COL (4);

        if DEFAULT = "" then
        TEXT_IO.PUT ("(default => RETURN) ");
        else
        TEXT_IO.PUT ("  (default => " & DEFAULT & " ) ");
        end if;
    end if;

    declare
        BUFFER : constant STRING := GET_THE_STRING;

    begin

        if CONFIRM then
        if GO_AGAIN then
            return RETURNED_STRING
                  (PROMPT, DEFAULT, USE_DEFAULT, CONFIRM);
        end if;
        end if;

        return (BUFFER);
    exception
        when TEXT_IO.END_ERROR =>
        if USE_DEFAULT then
            if DEFAULT = "" then
            return RETURNED_STRING
                  (PROMPT, DEFAULT, USE_DEFAULT, CONFIRM);
            else
            TEXT_IO.PUT ("Using default value of => ");
            TEXT_IO.PUT (DEFAULT);  TEXT_IO.NEW_LINE;
            return DEFAULT;
            end if;
        else
            return RETURNED_STRING
                  (PROMPT, DEFAULT, USE_DEFAULT, CONFIRM);
        end if;
    end;

    end RETURNED_STRING;




    function RETURNED_ENUMERATION
            (PROMPT      : STRING := "";
         DEFAULT     : ENUM_TYPE := ENUM_TYPE'FIRST;
         USE_DEFAULT : BOOLEAN := FALSE;
         ERROR_TEXT  : STRING := "";
         FROM_VALUE  : ENUM_TYPE := ENUM_TYPE'FIRST;
         TO_VALUE    : ENUM_TYPE := ENUM_TYPE'LAST;
         CONFIRM     : BOOLEAN := FALSE) return ENUM_TYPE is

    LAST : INTEGER;

    ENCOUNTERED_CONSTRAINT_ERROR : exception;
    ENCOUNTERED_END_ERROR        : exception;
    ENCOUNTERED_DATA_ERROR       : exception;

    subtype ANSWER_TYPE is ENUM_TYPE range FROM_VALUE .. TO_VALUE;

    ANSWER : ANSWER_TYPE;

    package ENUM_IO is new TEXT_IO.ENUMERATION_IO (ENUM_TYPE);

    function RETURNED_ANSWER (VALUE : STRING) return ENUM_TYPE is

    begin

        ENUM_IO.GET (VALUE, ANSWER, LAST);
        return (ANSWER);

    exception
        when CONSTRAINT_ERROR =>
        raise ENCOUNTERED_CONSTRAINT_ERROR;

        when TEXT_IO.END_ERROR =>
        raise ENCOUNTERED_END_ERROR;

        when TEXT_IO.DATA_ERROR =>
        raise ENCOUNTERED_DATA_ERROR;

        when others =>
        raise ENCOUNTERED_DATA_ERROR;

    end RETURNED_ANSWER;


    begin

    TEXT_IO.PUT (PROMPT);

    if USE_DEFAULT then
        TEXT_IO.NEW_LINE;
        TEXT_IO.SET_COL (4);
        TEXT_IO.PUT ("(default => ");
        ENUM_IO.PUT (DEFAULT);  TEXT_IO.PUT (" ) ");
    end if;

    declare
        BUFFER : constant STRING := GET_THE_STRING;

    begin


        if CONFIRM then
        if GO_AGAIN then
            return RETURNED_ENUMERATION
                  (PROMPT, DEFAULT, USE_DEFAULT, ERROR_TEXT,
                   FROM_VALUE, TO_VALUE, CONFIRM);
        end if;
        end if;

        return (RETURNED_ANSWER (VALUE => BUFFER));
    exception
        when ENCOUNTERED_CONSTRAINT_ERROR =>
        if ERROR_TEXT /= "" then
            ERROR (MSG => ERROR_TEXT);
        else
            TEXT_IO.PUT ("Please enter a value between ");
            ENUM_IO.PUT (FROM_VALUE);
            TEXT_IO.PUT (" and ");
            ENUM_IO.PUT (TO_VALUE);  TEXT_IO.NEW_LINE;
        end if;

        return RETURNED_ENUMERATION
              (PROMPT, DEFAULT, USE_DEFAULT, ERROR_TEXT,
               FROM_VALUE, TO_VALUE, CONFIRM);

        when ENCOUNTERED_END_ERROR =>
        if USE_DEFAULT then
            TEXT_IO.PUT ("Using default value of => ");
            ENUM_IO.PUT (DEFAULT);  TEXT_IO.NEW_LINE;
            return DEFAULT;
        else
            if ERROR_TEXT = "" then
            TEXT_IO.PUT ("Please enter a value between ");
            ENUM_IO.PUT (FROM_VALUE);
            TEXT_IO.PUT (" and ");
            ENUM_IO.PUT (TO_VALUE);  TEXT_IO.NEW_LINE;
            else
            ERROR (MSG => ERROR_TEXT);
            end if;

            return RETURNED_ENUMERATION
                  (PROMPT, DEFAULT, USE_DEFAULT, ERROR_TEXT,
                   FROM_VALUE, TO_VALUE, CONFIRM);
        end if;

        when ENCOUNTERED_DATA_ERROR =>
        if ERROR_TEXT /= "" then
            ERROR (MSG => ERROR_TEXT);
        else
            ERROR (MSG => "You entered an invalid value.");
        end if;

        return RETURNED_ENUMERATION
              (PROMPT, DEFAULT, USE_DEFAULT, ERROR_TEXT,
               FROM_VALUE, TO_VALUE, CONFIRM);

    end;

    end RETURNED_ENUMERATION;

end SCREEN_IO;




with CALENDAR;

package DATE_AND_TIME is
-- Author    : M. K. McNair
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date      : 8 March 1985
-- Summary   :
--   This package is built on top of CALENDAR to give the ability to
--   put a date/time to a string.

    subtype HOUR_NUMBER   is INTEGER range 0 .. 23;
    subtype MINUTE_NUMBER is INTEGER range 0 .. 59;
    subtype SECOND_NUMBER is INTEGER range 0 .. 59;

    function CURRENT_DATE return STRING;
    function CURRENT_TIME return STRING;

    function DATE (DAY   : CALENDAR.DAY_NUMBER;
           MONTH : CALENDAR.MONTH_NUMBER;
           YEAR  : CALENDAR.YEAR_NUMBER) return STRING;
    function TIME (HOUR   : HOUR_NUMBER;
           MINUTE : MINUTE_NUMBER;
           SECOND : SECOND_NUMBER) return STRING;


-- julian functions (relative to 7 Dec 1941)

    subtype JULIAN_TYPE is INTEGER;
    subtype DAY_TYPE    is INTEGER range 1 .. 31;
    subtype MONTH_TYPE  is INTEGER range 1 .. 12;
    subtype YEAR_TYPE   is INTEGER range 0 .. 2000;

    type CALENDAR_TYPE is
    record
        DAY   : DAY_TYPE;
        MONTH : MONTH_TYPE;
        YEAR  : YEAR_TYPE;
    end record;

    function DAY_OF_WEEK              (JULIAN_DAY : JULIAN_TYPE) return INTEGER;
    function NEAREST_PRECEDING_MONDAY (JULIAN_DAY : JULIAN_TYPE)
                        return JULIAN_TYPE;
    function JULIAN_DATE              (CALENDAR_DATE : CALENDAR_TYPE)
                        return JULIAN_TYPE;
    function CALENDAR_DATE            (JULIAN_DATE : JULIAN_TYPE)
                        return CALENDAR_TYPE;
-- misc stuff
    type MONTH_NAME_TYPE is
     (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG, SEP, OCT, NOV, DEC);

    for MONTH_NAME_TYPE use (JAN => 1,
                 FEB => 2,
                 MAR => 3,
                 APR => 4,
                 MAY => 5,
                 JUN => 6,
                 JUL => 7,
                 AUG => 8,
                 SEP => 9,
                 OCT => 10,
                 NOV => 11,
                 DEC => 12);

    type WEEK_NAME_TYPE is
     (SUNDAY,    MONDAY,    TUESDAY,   WEDNESDAY, THURSDAY,  FRIDAY,
      SATURDAY);

    for WEEK_NAME_TYPE use (SUNDAY    => 1,
                MONDAY    => 2,
                TUESDAY   => 3,
                WEDNESDAY => 4,
                THURSDAY  => 5,
                FRIDAY    => 6,
                SATURDAY  => 7);
    MONTH_NAME         : constant array (1 .. 12) of MONTH_NAME_TYPE :=
             (1  => JAN,
              2  => FEB,
              3  => MAR,
              4  => APR,
              5  => MAY,
              6  => JUN,
              7  => JUL,
              8  => AUG,
              9  => SEP,
              10 => OCT,
              11 => NOV,
              12 => DEC);
    DAY_NAME           : constant array (1 .. 7) of WEEK_NAME_TYPE :=
             (1 => SUNDAY,
              2 => MONDAY,
              3 => TUESDAY,
              4 => WEDNESDAY,
              5 => THURSDAY,
              6 => FRIDAY,
              7 => SATURDAY);
    DAYS_IN            : constant array (MONTH_NAME_TYPE) of POSITIVE :=
             (JAN => 31,
              FEB => 28,
              MAR => 31,
              APR => 30,
              MAY => 31,
              JUN => 30,
              JUL => 31,
              AUG => 31,
              SEP => 30,
              OCT => 31,
              NOV => 30,
              DEC => 31);
    HOURS_PER_DAY      : constant INTEGER := 24;
    DAYS_PER_WEEK      : constant INTEGER := 7;
    WEEKS_PER_YEAR     : constant INTEGER := 52;
    DAYS_PER_YEAR      : constant FLOAT := 365.25;
    MINUTES_PER_HOUR   : constant INTEGER := 60;
    SECONDS_PER_MINUTE : constant INTEGER := 60;

end DATE_AND_TIME;




package body DATE_AND_TIME is
-- Author   : M. K. McNair
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date     : 8 March 1985
-- Summary  :
--   This is the package body to the DATE_AND_TIME package.


-- CHANGE_HISTORY:
------------------

-- May 17, 1985   Ken Lamarche
--   Change made to the function "calender_date" so that the function uses temp
--   variables rather than the constrained calender_type variables for
--   arithmetic work.

-- May 21, 1985   Ken Lamrche
--   Change to function "julian_date" so that temp variables are used in the
--   arithmetic operations, rather than constrained calender_type variables.

    function CURRENT_DATE return STRING is
    TIME_NOW : CALENDAR.TIME := CALENDAR.CLOCK;
    begin
    return DATE (CALENDAR.DAY (TIME_NOW), CALENDAR.MONTH (TIME_NOW),
             CALENDAR.YEAR (TIME_NOW));
    end CURRENT_DATE;

    function CURRENT_TIME return STRING is
    TIME_NOW : INTEGER range 0 .. 86400 :=
           INTEGER (CALENDAR.SECONDS (CALENDAR.CLOCK));
    HOURS    : HOUR_NUMBER := TIME_NOW / (60 * 60);
    MINUTES  : MINUTE_NUMBER := (TIME_NOW - (60 * 60 * HOURS)) / 60;
    SECONDS  : SECOND_NUMBER :=
           TIME_NOW - (60 * 60 * HOURS) - (60 * MINUTES);
    begin
    return TIME (HOURS, MINUTES, SECONDS);
    end CURRENT_TIME;

    function DATE (DAY   : CALENDAR.DAY_NUMBER;
           MONTH : CALENDAR.MONTH_NUMBER;
           YEAR  : CALENDAR.YEAR_NUMBER) return STRING is
    begin
    return INTEGER'IMAGE (DAY) & ' ' &
           MONTH_NAME_TYPE'IMAGE (MONTH_NAME_TYPE'VAL (MONTH - 1)) &
           INTEGER'IMAGE (YEAR);
    end DATE;

    function TIME (HOUR   : HOUR_NUMBER;
           MINUTE : MINUTE_NUMBER;
           SECOND : SECOND_NUMBER) return STRING is
    begin
    return INTEGER'IMAGE (HOUR) & ':' & INTEGER'IMAGE (MINUTE) & ':' &
           INTEGER'IMAGE (SECOND);
    end TIME;

    function DAY_OF_WEEK (JULIAN_DAY : JULIAN_TYPE) return INTEGER is
    begin
    return JULIAN_DAY mod 7;
    end DAY_OF_WEEK;

    function NEAREST_PRECEDING_MONDAY (JULIAN_DAY : JULIAN_TYPE)
                        return JULIAN_TYPE is
    begin
    return JULIAN_DAY - (DAY_OF_WEEK (JULIAN_DAY) - 1);
    end NEAREST_PRECEDING_MONDAY;



    function JULIAN_DATE (CALENDAR_DATE : CALENDAR_TYPE) return JULIAN_TYPE is
    TEMP1, TEMP2, TEMP3 : INTEGER;
    begin
    TEMP3 := CALENDAR_DATE.YEAR;
    TEMP2 := CALENDAR_DATE.MONTH;
    TEMP1 := CALENDAR_DATE.DAY;

    if TEMP2 <= 2 then
        TEMP2 := TEMP2 + 9;
        TEMP3 := TEMP3 - 1;
    else
        TEMP2 := TEMP2 - 3;
    end if;

    TEMP3 := TEMP3 * 1461 / 4;
    return TEMP3 - 15256 + (153 * TEMP2 + 2) / 5 + TEMP1 - 1;
    end JULIAN_DATE;



    function CALENDAR_DATE (JULIAN_DATE : JULIAN_TYPE) return CALENDAR_TYPE is
    RETURN_DATE  : CALENDAR_TYPE;
    TEMP_JULIAN  : JULIAN_TYPE;
    TEMP1, TEMP2 : INTEGER; -- used for arithmetic
    begin
    TEMP_JULIAN := JULIAN_DATE + 15256;
    TEMP_JULIAN := 4 * TEMP_JULIAN + 3;
    RETURN_DATE.YEAR := TEMP_JULIAN / 1461;
    TEMP1 := TEMP_JULIAN mod 1461;
    TEMP1 := TEMP1 / 4 + 1;
    TEMP2 := (5 * TEMP1 - 3) / 153;
    TEMP1 := (5 * TEMP1 - 3) mod 153;
    RETURN_DATE.DAY := TEMP1 / 5 + 1;

    if TEMP2 >= 10 then
        RETURN_DATE.MONTH := TEMP2 - 9;
        RETURN_DATE.YEAR := RETURN_DATE.YEAR + 1;
    else
        RETURN_DATE.MONTH := TEMP2 + 3;
    end if;

    return RETURN_DATE;
    end CALENDAR_DATE;

end DATE_AND_TIME;




package STRING_UTILITIES is
-- Author   : M. K. McNair
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date     : 8 March 1985
-- Summary  :
--   This package provides some simple string manipulation subprograms.

    function FIRST_NON_BLANK_CHARACTER_POSITION (IN_STRING : STRING)
                          return NATURAL;
    function LAST_NON_BLANK_CHARACTER_POSITION  (IN_STRING : STRING)
                          return NATURAL;
    function REMOVE_LEADING_AND_TRAILING_BLANKS (FROM_STRING : STRING)
                          return STRING;

    -- LOWER_TO_UPPER will return the upper case value of a string. All lower
    -- case characters in the string are swapped with upper case characters.
    -- Added by: Ken Lamarche
    -- Date:     7 May 1985
    function LOWER_TO_UPPER (OF_STRING : STRING) return STRING;


end STRING_UTILITIES;




package body STRING_UTILITIES is
-- Author  : M. K. McNair
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date    : 8 March 1985
-- Summary :
--   This is the package body to the STRING_UTILITIES package.


    function FIRST_NON_BLANK_CHARACTER_POSITION (IN_STRING : STRING)
                          return NATURAL is
    COUNT : NATURAL;
    begin
    for INDEX in IN_STRING'RANGE loop
        COUNT := INDEX;
        exit when IN_STRING (COUNT) /= ' ';
    end loop;

    return COUNT;
    end FIRST_NON_BLANK_CHARACTER_POSITION;



    function LAST_NON_BLANK_CHARACTER_POSITION (IN_STRING : STRING)
                         return NATURAL is
    COUNT : NATURAL;
    begin
    for INDEX in reverse IN_STRING'RANGE loop
        COUNT := INDEX;
        exit when IN_STRING (COUNT) /= ' ';
    end loop;

    return COUNT;
    end LAST_NON_BLANK_CHARACTER_POSITION;



    function REMOVE_LEADING_AND_TRAILING_BLANKS (FROM_STRING : STRING)
                          return STRING is
    begin
    return FROM_STRING
          (FIRST_NON_BLANK_CHARACTER_POSITION (FROM_STRING) ..
           LAST_NON_BLANK_CHARACTER_POSITION (FROM_STRING));
    end REMOVE_LEADING_AND_TRAILING_BLANKS;


    -- The LOWER_TO_UPPER function returns a string that is the upper case image
    -- of the string passes it. All lower case characters of the passed string
    -- are swapped with upper case characters.
    -- Added by: Ken Lamarche
    -- Date:     7 May 1985
    function LOWER_TO_UPPER (OF_STRING : STRING) return STRING is

    STRING_TO_RETURN : STRING (OF_STRING'RANGE);

    function LOWER_TO_UPPER_CHAR (CHAR : CHARACTER) return CHARACTER is

        type LOWER_LETTERS is new CHARACTER range 'a' .. 'z';

        LITTLE : LOWER_LETTERS;
    begin
        -- Convert input character to a LOWER_LETTERS type. If it is not a
        -- lower case charcater, an exception will be raised and the same
        -- character will be returned.
        LITTLE := LOWER_LETTERS (CHAR);
        return CHARACTER'VAL
             ((CHARACTER'POS (CHAR) - CHARACTER'POS ('a')) +
              CHARACTER'POS ('A'));
    exception
        when CONSTRAINT_ERROR =>
        return CHAR;
    end LOWER_TO_UPPER_CHAR;

    begin
    for I in OF_STRING'RANGE loop
        STRING_TO_RETURN (I) := LOWER_TO_UPPER_CHAR (OF_STRING (I));
    end loop;

    return STRING_TO_RETURN;

    end LOWER_TO_UPPER;



end STRING_UTILITIES;




with TEXT_IO;

package FILE_OPS is
-- Author   : M. K. McNair
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date     : 8 March 1985
-- Summary  :
--   This package provides procedures for handling the opening of
--   files in an interactive and localized manner.

    function FILE_EXISTS (WITH_NAME : STRING) return BOOLEAN;

    procedure OPEN (THE_FILE         : in out TEXT_IO.FILE_TYPE;
            WITH_NAME        : STRING := "";
            TO_MODE          : TEXT_IO.FILE_MODE := TEXT_IO.IN_FILE;
            WITH_OPTIONS     : STRING := "";
            CREATION_ENABLED : BOOLEAN := FALSE);
    -- similar to a Fortran OPEN with the CREATION_ENABLED flag
    -- available

    procedure CLOSE (THE_FILE : in out TEXT_IO.FILE_TYPE);

    procedure DELETE (THE_FILE : in out TEXT_IO.FILE_TYPE);

    procedure USER_OPEN (THE_FILE    : in out TEXT_IO.FILE_TYPE;
             WITH_PROMPT : STRING;
             TO_MODE     : TEXT_IO.FILE_MODE := TEXT_IO.IN_FILE);
    -- get a file name from the user and open the file to the indicated
    -- mode. If the actual pathname is desired just call
    -- TEXT_IO.NAME (THE_FILE)

    FILE_ALREADY_OPEN, ILLEGAL_FILE_NAME, SYSTEM_CANNOT_CREATE_FILE,
    SYSTEM_CANNOT_OPEN_FILE, FILE_NOT_OPEN, SYSTEM_CANNOT_DELETE_FILE,
    FILE_ALREADY_EXISTS : exception;

end FILE_OPS;




with STRING_UTILITIES,
     SCREEN_IO;

package body FILE_OPS is
-- Author   : M. K. McNair
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date     : 8 March 1985
-- Summary  :
--   This is the body to the FILE_OPS package.

    function FILE_EXISTS (WITH_NAME : STRING) return BOOLEAN is
    THE_FILE : TEXT_IO.FILE_TYPE;
    begin
    OPEN (THE_FILE,
          STRING_UTILITIES.REMOVE_LEADING_AND_TRAILING_BLANKS (WITH_NAME));
    CLOSE (THE_FILE);
    return TRUE;
    exception
    when others =>
        return FALSE;
    end FILE_EXISTS;

    procedure OPEN (THE_FILE         : in out TEXT_IO.FILE_TYPE;
            WITH_NAME        : STRING := "";
            TO_MODE          : TEXT_IO.FILE_MODE := TEXT_IO.IN_FILE;
            WITH_OPTIONS     : STRING := "";
            CREATION_ENABLED : BOOLEAN := FALSE) is
    use STRING_UTILITIES;
    begin
    if CREATION_ENABLED then
        if FILE_EXISTS (WITH_NAME) then
        OPEN (THE_FILE, WITH_NAME, TO_MODE, WITH_OPTIONS);
        else
        TEXT_IO.CREATE
           (THE_FILE, TO_MODE,
            REMOVE_LEADING_AND_TRAILING_BLANKS (WITH_NAME));
        end if;
    else
        TEXT_IO.OPEN (THE_FILE, TO_MODE,
              REMOVE_LEADING_AND_TRAILING_BLANKS (WITH_NAME));
    end if;
    exception
    when TEXT_IO.STATUS_ERROR =>
        raise FILE_ALREADY_OPEN;

    when TEXT_IO.NAME_ERROR =>
        raise ILLEGAL_FILE_NAME;

    when TEXT_IO.USE_ERROR =>
        if CREATION_ENABLED then
        raise SYSTEM_CANNOT_CREATE_FILE;
        else
        raise SYSTEM_CANNOT_OPEN_FILE;
        end if;
    end OPEN;

    procedure CLOSE (THE_FILE : in out TEXT_IO.FILE_TYPE) is
    begin
    TEXT_IO.CLOSE (THE_FILE);
    exception
    when TEXT_IO.STATUS_ERROR =>
        raise FILE_NOT_OPEN;
    end CLOSE;

    procedure DELETE (THE_FILE : in out TEXT_IO.FILE_TYPE) is
    begin
    TEXT_IO.DELETE (THE_FILE);
    exception
    when TEXT_IO.STATUS_ERROR =>
        raise FILE_NOT_OPEN;

    when TEXT_IO.USE_ERROR =>
        raise SYSTEM_CANNOT_DELETE_FILE;
    end DELETE;

    procedure USER_OPEN (THE_FILE    : in out TEXT_IO.FILE_TYPE;
             WITH_PROMPT : STRING;
             TO_MODE     : TEXT_IO.FILE_MODE := TEXT_IO.IN_FILE) is
    use STRING_UTILITIES;

    BUFFER : STRING (1 .. 64);
    LAST   : NATURAL;
    begin
    -- get the pathname
    OPEN (THE_FILE,
          REMOVE_LEADING_AND_TRAILING_BLANKS
         (SCREEN_IO.RETURNED_STRING
             (PROMPT => WITH_PROMPT, CONFIRM => FALSE)), TO_MODE,
          CREATION_ENABLED => TRUE);
    exception
    when FILE_ALREADY_EXISTS =>
        begin
        OPEN (THE_FILE,
              REMOVE_LEADING_AND_TRAILING_BLANKS (BUFFER (1 .. LAST)),
              TO_MODE);
        exception
        when FILE_ALREADY_OPEN =>
            TEXT_IO.NEW_LINE;
            TEXT_IO.PUT_LINE
               ("That file is currently in use. Try again.");
            USER_OPEN (THE_FILE, WITH_PROMPT, TO_MODE);
        end;

    when ILLEGAL_FILE_NAME =>
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("Illegal file name. Try again.");
        USER_OPEN (THE_FILE, WITH_PROMPT, TO_MODE);

    when SYSTEM_CANNOT_CREATE_FILE | SYSTEM_CANNOT_OPEN_FILE =>
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("The system cannot handle file operations.");
        raise;
    end USER_OPEN;

end FILE_OPS;




package MATH_FUNCTIONS is
-- Author   : M. K. McNair
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date     : 8 March 1985
-- Summary  :
--   This package makes use of the two CODY-WAITE implementation
--   packages to give the functionality listed.

    type D2_FLOAT_ARRAY is array (POSITIVE range <>, POSITIVE range <>)
                  of FLOAT;


    function  "**"                            (X, Y : FLOAT) return FLOAT;
    function  EXP                             (POWER : FLOAT) return FLOAT;
    procedure GAUSSIAN_ELIMINATION            (MATRIX : in out D2_FLOAT_ARRAY;
                           N      : INTEGER);
    function  INVERSE_NORMAL_FUNCTION         (REQUIRED_PROBABILITY : FLOAT;
                           TIME_EXPECTED_VALUE  : FLOAT;
                           TIME_VARIANCE        : FLOAT)
                            return FLOAT;
    function  LOG                             (X : FLOAT) return FLOAT;
    function  LOG10                           (X : FLOAT) return FLOAT;
    function  NORMAL_FUNCTION
         (TIME_DIFFERENCE    : FLOAT;        -- required_time -
                             -- expected_time
          STANDARD_DEVIATION : FLOAT) return FLOAT;
    function  POLYNOMIAL                      (A, B, C, T : FLOAT) return FLOAT;
    function  TRUNCATE                        (VALUE : FLOAT) return INTEGER;
    function  TRUNCATE                        (VALUE : FLOAT) return FLOAT;
    function  TRUNCATED_RAYLEIGH_DISTRIBUTION (Y, T : FLOAT) return FLOAT;

    NEGATIVE_ARGUMENT_GIVEN, NEGATIVE_VALUE_GIVEN, ARGUMENT_TO_LARGE,
    ARGUMENT_TO_SMALL, A_ZERO_BASE_WAS_GIVEN, CALCULATED_VALUE_TO_BIG,
    CALCULATED_VALUE_TO_SMALL : exception;

end MATH_FUNCTIONS;




with FLOATING_CHARACTERISTICS,
     NUMERIC_PRIMITIVES;
use FLOATING_CHARACTERISTICS, NUMERIC_PRIMITIVES;

package body MATH_FUNCTIONS is
-- Author   : M. K. McNair
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date     : 8 March 1985
-- Summary  :
--   This is the package body to the MATH_FUNCTIONS package. These
--   algorithms were originally implemented by Whitaker, et al.

    EXP_LARGE : FLOAT;
    EXP_SMALL : FLOAT;

    function "**" (X, Y : FLOAT) return FLOAT is
    M, N                                           : EXPONENT_TYPE;
    G                                              : MANTISSA_TYPE;
    P, TEMP, IW1, I                                : INTEGER;
    RESULT, Z, V, R, U1, U2, W, W1, W2, W3, Y1, Y2 : FLOAT;
    K                                              : constant FLOAT :=
                             0.44269_50408_88963_40736;
    IBIGX                                          : constant INTEGER :=
                             TRUNCATE (16.0 *
                                   LOG (XMAX) -
                                   1.0);
    ISMALLX                                        : constant INTEGER :=
                             TRUNCATE (16.0 *
                                   LOG (XMIN) +
                                   1.0);
    P1                                             : constant FLOAT :=
                             0.83333_32862_45e-1;
    P2                                             : constant FLOAT :=
                             0.12506_48500_52e-1;
    Q1                                             : constant FLOAT :=
                             0.69314_71805_56341;
    Q2                                             : constant FLOAT :=
                             0.24022_65061_44710;
    Q3                                             : constant FLOAT :=
                             0.55504_04881_30765e-1;
    Q4                                             : constant FLOAT :=
                             0.96162_06595_83789e-2;
    Q5                                             : constant FLOAT :=
                             0.13052_55159_42810e-2;
    A1                                             : array (1 .. 17)
                                    of FLOAT :=
                             (8#1.00000_0000#,
                              8#0.75222_5750#,
                              8#0.72540_3067#,
                              8#0.70146_3367#,
                              8#0.65642_3746#,
                              8#0.63422_2140#,
                              8#0.61263_4520#,
                              8#0.57204_2434#,
                              8#0.55202_3631#,
                              8#0.53254_0767#,
                              8#0.51377_3265#,
                              8#0.47572_4623#,
                              8#0.46033_7602#,
                              8#0.44341_7233#,
                              8#0.42712_7017#,
                              8#0.41325_3033#,
                              8#0.40000_0000#);

    A2                                             : array (1 .. 8)
                                    of FLOAT :=
                             (8#0.00000_00005_22220_66302_61734_72062#,
                              8#0.00000_00003_02522_47021_04062_61124#,
                              8#0.00000_00005_21760_44016_17421_53016#,
                              8#0.00000_00007_65401_41553_72504_02177#,
                              8#0.00000_00002_44124_12254_31114_01243#,
                              8#0.00000_00000_11064_10432_66404_42174#,
                              8#0.00000_00004_72542_16063_30176_55544#,
                              8#0.00000_00001_74611_03661_23056_22556#);

    function REDUCE (V : FLOAT) return FLOAT is
    begin
        return FLOAT (INTEGER (16.0 * V)) * 0.0625;
    end REDUCE;

    begin
    if X <= ZERO then
        if X < ZERO then
        RESULT := (abs (X)) ** Y;
        raise NEGATIVE_ARGUMENT_GIVEN;
        else
        if Y <= ZERO then
            if Y = ZERO then
            RESULT := ZERO;
            else
            RESULT := XMAX;
            end if;

            raise A_ZERO_BASE_WAS_GIVEN;
        else
            RESULT := ZERO;
        end if;
        end if;
    else
        DEFLOAT (X, M, G);
        P := 1;

        if G <= A1 (9) then
        P := 9;
        end if;

        if G <= A1 (P + 4) then
        P := P + 4;
        end if;

        if G <= A1 (P + 2) then
        P := P + 2;
        end if;

        Z := ((G - A1 (P + 1)) - A2 ((P + 1) / 2)) / (G + A1 (P + 1));
        Z := Z + Z;
        V := Z * Z;
        R := (P2 * V + P1) * V * Z;
        R := R + K * R;
        U2 := (R + Z * K) + Z;
        U1 := FLOAT (INTEGER (M) * 16 - P) * 0.0625;
        Y1 := REDUCE (Y);
        Y2 := Y - Y1;
        W := U2 * Y + U1 * Y2;
        W1 := REDUCE (W);
        W2 := W - W1;
        W := W1 + U1 * Y1;
        W1 := REDUCE (W);
        W2 := W2 + (W - W1);
        W3 := REDUCE (W2);
        IW1 := TRUNCATE (16.0 * (W1 + W3));
        W2 := W2 - W3;

        if W > FLOAT (IBIGX) then
        RESULT := XMAX;
        raise CALCULATED_VALUE_TO_BIG;

        elsif W < FLOAT (ISMALLX) then
        raise CALCULATED_VALUE_TO_SMALL;
        else
        if W2 > ZERO then
            W2 := W2 - 0.0625;
            IW1 := IW1 + 1;
        end if;

        if IW1 < INTEGER (ZERO) then
            I := 0;
        else
            I := 1;
        end if;

        M := EXPONENT_TYPE (I + IW1 / 16);
        P := 16 * INTEGER (M) - IW1;
        Z := ((((Q5 * W2 + Q4) * W2 + Q3) * W2 + Q2) * W2 + Q1) * W2;
        Z := A1 (P + 1) + (A1 (P + 1) * Z);
        REFLOAT (M, Z, RESULT);
        end if;
    end if;

    return RESULT;
    end "**";

    function EXP (POWER : FLOAT) return FLOAT is
    X              : FLOAT renames POWER;
    RESULT         : FLOAT;
    N              : EXPONENT_TYPE;
    XG, XN, X1, X2 : FLOAT;
    F, G           : MANTISSA_TYPE;
    BIGX           : FLOAT := EXP_LARGE;
    SMALLX         : FLOAT := EXP_SMALL;
    ONE_OVER_LOG_2 : constant FLOAT := 1.4426_95040_88896_34074;
    C1             : constant FLOAT := 0.69335_9375;
    C2             : constant FLOAT := -2.1219_44400_54690_58277e-4;


    function R (G : MANTISSA_TYPE) return MANTISSA_TYPE is
        Z, GP, Q : MANTISSA_TYPE;
        P0       : constant MANTISSA_TYPE := 0.24999_99999_9992;
        P1       : constant MANTISSA_TYPE := 0.00595_04254_9776;
        Q0       : constant MANTISSA_TYPE := 0.5;
        Q1       : constant MANTISSA_TYPE := 0.05356_75176_4522;
        Q2       : constant MANTISSA_TYPE := 0.00029_72936_3682;
    begin
        Z := MANTISSA_TYPE (G * G);
        GP := MANTISSA_TYPE ((MANTISSA_TYPE (P1 * Z) + P0) * G);
        Q := MANTISSA_TYPE ((MANTISSA_TYPE (Q2 * Z) + Q1) * Z) + Q0;
        return MANTISSA_HALF + MANTISSA_TYPE (GP / (Q - GP));
    end R;
    begin
    if X > BIGX then
        raise ARGUMENT_TO_LARGE;

    elsif X < SMALLX then
        raise ARGUMENT_TO_SMALL;

    elsif abs (X) < EPS then
        RESULT := ONE;
    else
        N := EXPONENT_TYPE (X * ONE_OVER_LOG_2);
        XN := CONVERT_TO_FLOAT (N);
        X1 := ROUND (X);
        X2 := X - X1;
        XG := ((X1 - XN * C1) + X2) - XN * C2;
        G := MANTISSA_TYPE (XG);
        N := N + 1;
        F := R (G);
        REFLOAT (N, F, RESULT);
    end if;

    return RESULT;
    exception
    when others =>
        return ONE;
    end EXP;

    function LOG (X : FLOAT) return FLOAT is
    RESULT        : FLOAT;
    N             : EXPONENT_TYPE;
    XN            : FLOAT;
    Y             : FLOAT;
    F             : MANTISSA_TYPE;
    Z, ZDEN, ZNUM : MANTISSA_TYPE;
    C0            : constant MANTISSA_TYPE := 0.20710_67811_86547_52440; --sqrt(0.5)
    C1            : constant FLOAT := 8#0.543#;
    C2            : constant FLOAT := -2.12194_44005_46905_82767_9e-4;


    function R (Z : MANTISSA_TYPE) return MANTISSA_TYPE is
        A0 : constant MANTISSA_TYPE := 0.04862_85276_587;
        B0 : constant MANTISSA_TYPE := 0.69735_92187_803;
        B1 : constant MANTISSA_TYPE := -0.125;
        C  : constant MANTISSA_TYPE := 0.01360_09546_862;
    begin
        return Z +
           MANTISSA_TYPE
              (Z *
               MANTISSA_TYPE
              (MANTISSA_TYPE (Z * Z) *
               (C +
                MANTISSA_TYPE
                   (A0 /
                (B0 +
                 MANTISSA_TYPE
                    (B1 * MANTISSA_TYPE (Z * Z)))))));
    end R;
    begin
    if X < ZERO then
        raise NEGATIVE_VALUE_GIVEN;

    elsif X = ZERO then
        RESULT := -XMAX;
    else
        DEFLOAT (X, N, F);
        ZNUM := F - MANTISSA_HALF;
        Y := CONVERT_TO_FLOAT (ZNUM);
        ZDEN := ZNUM / MANTISSA_DIVISOR_2 + MANTISSA_HALF;

        if ZNUM > C0 then
        Y := Y - MANTISSA_HALF;
        ZNUM := ZNUM - MANTISSA_HALF;
        ZDEN := ZDEN + MANTISSA_HALF / MANTISSA_DIVISOR_2;
        else
        N := N - 1;
        end if;

        Z := MANTISSA_TYPE (ZNUM / ZDEN);
        RESULT := CONVERT_TO_FLOAT (R (Z));

        if N /= 0 then
        XN := CONVERT_TO_FLOAT (N);
        RESULT := (XN * C2 + RESULT) + XN * C1;
        end if;
    end if;

    return RESULT;
    end LOG;

    function LOG10 (X : FLOAT) return FLOAT is
    begin
    return 1.0;
    end LOG10;

    function TRUNCATED_RAYLEIGH_DISTRIBUTION (Y, T : FLOAT) return FLOAT is
    VALUE1 : FLOAT := (0.15 * Y) + (0.7 * T);
    VALUE2 : FLOAT := Y * Y;
    begin
    return (VALUE1 / (0.25 * VALUE2)) *
           EXP (-((VALUE1) ** 2) / (0.5 * VALUE2));
    end TRUNCATED_RAYLEIGH_DISTRIBUTION;

    function POLYNOMIAL (A, B, C, T : FLOAT) return FLOAT is
    begin
    return A * (T * T) + B * T + C;
    end POLYNOMIAL;

    procedure GAUSSIAN_ELIMINATION (MATRIX : in out D2_FLOAT_ARRAY;
                    N      : INTEGER) is
    TEMP : FLOAT;
    A    : D2_FLOAT_ARRAY
         (1 .. MATRIX'LENGTH (1), 1 .. MATRIX'LENGTH (2)) := MATRIX;
    begin
    for KRR in 1 .. N loop
        for I in 1 .. N loop
        if A (I, KRR) /= 0.0 then
            TEMP := A (I, KRR);

            for J in 1 .. N + 1 loop
            A (I, J) := A (I, J) / TEMP;
            end loop;
        end if;
        end loop;

        for L in 1 .. N loop
        if (L /= KRR) and (A (L, KRR) /= 0.0) then
            for K in 1 .. N + 1 loop
            A (L, K) := A (L, K) - A (KRR, K);
            end loop;
        end if;
        end loop;
    end loop;

    for I in 1 .. N loop
        A (I, N + 1) := A (I, N + 1) / A (I, I);
        A (I, I) := 1.0;
    end loop;

    MATRIX := A;
    end GAUSSIAN_ELIMINATION;

    function TRUNCATE (VALUE : FLOAT) return INTEGER is
    begin
    return INTEGER (NUMERIC_PRIMITIVES.TRUNCATE (VALUE));
    end TRUNCATE;

    function TRUNCATE (VALUE : FLOAT) return FLOAT is
    begin
    return NUMERIC_PRIMITIVES.TRUNCATE (VALUE);
    end TRUNCATE;

    function INVERSE_NORMAL_FUNCTION (REQUIRED_PROBABILITY : FLOAT;
                      TIME_EXPECTED_VALUE  : FLOAT;
                      TIME_VARIANCE        : FLOAT)
                       return FLOAT is
    X                                                   : constant array (1 .. 6)
                                          of FLOAT :=
                                  (1 => 0.5,
                                   2 => 0.6,
                                   3 => 0.7,
                                   4 => 0.8,
                                   5 => 0.9,
                                   6 => 0.95);
    Y                                                   : constant array (1 .. 6)
                                          of FLOAT :=
                                  (1 => 0.0,
                                   2 => 0.253,
                                   3 => 0.525,
                                   4 => 0.842,
                                   5 => 1.282,
                                   6 => 1.645);
    ANSWER, COEFFICIENT, TEMP_PROBABILITY, SLOPE, PRINV : FLOAT;
    I                                                   : INTEGER;
    begin
    ANSWER := TIME_EXPECTED_VALUE;

    if TIME_VARIANCE >= 0.0001 then
        COEFFICIENT := 1.0;
        TEMP_PROBABILITY := REQUIRED_PROBABILITY;

        if REQUIRED_PROBABILITY < 0.5 then
        COEFFICIENT := -1.0;
        TEMP_PROBABILITY := 1.0 - REQUIRED_PROBABILITY;
        end if;

        if TEMP_PROBABILITY <= 0.95 then
        I := INTEGER (10.0 * (TEMP_PROBABILITY - 0.39999));
        SLOPE := (Y (I + 1) - Y (I)) / (X (I + 1) - X (I));
        PRINV := SLOPE * (TEMP_PROBABILITY - X (I)) + Y (I);
        else
        PRINV := (-1.68 * LOG (3.996 * (1.0 - TEMP_PROBABILITY))) **
             0.5;
        end if;

        return (TIME_VARIANCE ** 0.5) * COEFFICIENT * PRINV +
           TIME_EXPECTED_VALUE;
    end if;

    return ANSWER;
    end INVERSE_NORMAL_FUNCTION;

    function NORMAL_FUNCTION (TIME_DIFFERENCE    : FLOAT;
-- required_time - expected_time


                  STANDARD_DEVIATION : FLOAT) return FLOAT is
    RATIO, ANSWER : FLOAT;
    begin
    RATIO := TIME_DIFFERENCE / STANDARD_DEVIATION;

    if (RATIO >= -4.0) and (RATIO <= 4.0) then
        declare
        P : FLOAT := 0.0;
        M : INTEGER := 0;
        W : FLOAT;
        begin
        loop
            P := P + RATIO;
            M := M + 1;
            W := RATIO;
            RATIO := -((TIME_DIFFERENCE / STANDARD_DEVIATION) ** 2 *
                   FLOAT (2 * M - 1) /
                   (4.0 * FLOAT (M) ** 2 + FLOAT (2 * M))) * RATIO;
            exit when abs (W - RATIO) < 0.00001;
        end loop;

        ANSWER := 0.39894228 * P + 0.5;
        end;
    end if;

    if RATIO > 4.0 then
        ANSWER := 1.0;

    elsif RATIO < -4.0 then
        ANSWER := 0.0;
    end if;

    return ANSWER;
    end NORMAL_FUNCTION;

begin
    EXP_LARGE := LOG (XMAX) * (ONE - EPS);
    EXP_SMALL := LOG (XMIN) * (ONE - EPS);
end MATH_FUNCTIONS;




generic
    DISPLAY_WIDTH  : INTEGER := 80;
    DISPLAY_HEIGHT : INTEGER := 24;
package MENU is
-- Author : M.K. McNair
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date   : 8 March 1985
-- Summary: This package provides a means for formatting and then
--          using menus. The menu constructed must fit into the
--          display restrictions given by DISPLAY_HEIGHT and
--          DISPLAY_WIDTH.


    type STRING_ACCESS_TYPE is access STRING;

    subtype MENU_LINE_TYPE is STRING_ACCESS_TYPE;

    type MENU_TYPE is array (POSITIVE range <>) of MENU_LINE_TYPE;

    NULL_LINE : constant MENU_LINE_TYPE := null;
-- this is a predefined constant which signifies a blank line upon
-- menu display


    procedure GET_MENU_VALUE (MENU_USED     : MENU_TYPE;
                  TITLE         : STRING_ACCESS_TYPE;
                  CHOICE_CHOSEN : out POSITIVE);
-- this is where the menu gets put out to TEXT_IO.STANDARD_OUTPUT
    MENU_TO_HIGH, MENU_TO_WIDE : exception;


    generic
    type MENU_ITEMS_TYPE is (<>);
    function ENUMERATION_MENU return MENU_TYPE;
-- This will create a menu from a list of items in an enumeration
-- type. Note that any underscores in the enumeration literals
-- will be displayed.


    type ITEM_ARRAY_TYPE is array (POSITIVE range <>) of STRING_ACCESS_TYPE;

    function STRING_MENU (ITEMS : ITEM_ARRAY_TYPE) return MENU_TYPE;
-- this will create a menu from an array of string access types

end MENU;




with TEXT_IO;

package body MENU is
-- Author : M. K. McNair
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date   : 8 March 1985
-- Summary: This is the body to the MENU package. There are no global
--          variables so it is o.k. to use this package in a multi-
--          tasking environment. There are three procedures here.


    procedure GET_MENU_VALUE (MENU_USED     : MENU_TYPE;
                  TITLE         : STRING_ACCESS_TYPE;
                  CHOICE_CHOSEN : out POSITIVE) is
-- Summary: This procedure will display a menu with the given title,
--          all of which is centered on the screen. A prompt will be
--          given to the user to enter a choice. If an illegal choice
--          is entered, the menu will be redrawn and the prompt will
--          be repeated. Control will return only when a legal value
--          is entered.


    NUMBER_OF_CHOICES : constant INTEGER :=
                MENU_USED'LAST - MENU_USED'FIRST + 1;
    TEMP_CHOICE       : INTEGER;
    VERTICAL_SPACING  : INTEGER;
    begin
    if NUMBER_OF_CHOICES > DISPLAY_HEIGHT - 2 then
        raise MENU_TO_HIGH;
    end if;

    -- for centering purposes, find the longest menu line
    declare
        LONGEST_MENU_LINE : INTEGER := MENU_USED (1).all'LENGTH;
    begin
        for INDEX in MENU_USED'FIRST .. MENU_USED'LAST loop
        if LONGEST_MENU_LINE < MENU_USED (INDEX).all'LENGTH then
            LONGEST_MENU_LINE := MENU_USED (INDEX).all'LENGTH;
        end if;
        end loop;

        if LONGEST_MENU_LINE > DISPLAY_WIDTH then
        raise MENU_TO_WIDE;
        end if;
    end;

    -- determine vertical spacing between title and menu and then menu
    -- and prompt
    VERTICAL_SPACING := (DISPLAY_HEIGHT - NUMBER_OF_CHOICES - 2) / 2;
    TEXT_IO.NEW_PAGE;

    -- if a title was given then put it out
    declare
        TITLE_SPACING : INTEGER := (DISPLAY_WIDTH - TITLE.all'LENGTH) / 2;
    begin
        TEXT_IO.SET_COL (TEXT_IO.COUNT (TITLE_SPACING));
        TEXT_IO.PUT_LINE (TITLE.all);
        TEXT_IO.NEW_LINE (TEXT_IO.COUNT (VERTICAL_SPACING));
    exception
        when CONSTRAINT_ERROR =>
        null;
    end;

    -- display the menu
    declare
        INDEX    : NATURAL := MENU_USED'FIRST - 1;
        END_LOOP : BOOLEAN := FALSE;
    begin
        loop
        INDEX := INDEX + 1;

        begin
            TEXT_IO.PUT_LINE (MENU_USED (INDEX).all);
        exception
            when CONSTRAINT_ERROR =>
            END_LOOP := TRUE;
        end;

        exit when END_LOOP;
        end loop;
    end;

    -- output prompt
    declare
        BUFFER         : STRING (1 .. 40) := (1 .. 40 => ' ');
        LENGTH         : NATURAL;
        INTEGER_CHOICE : INTEGER;
    begin
        begin
        TEXT_IO.NEW_LINE (TEXT_IO.COUNT (VERTICAL_SPACING));
        exception
        when CONSTRAINT_ERROR =>
            null;
        end;

        TEXT_IO.PUT ("What is your choice? ");
        TEXT_IO.GET_LINE (BUFFER, LENGTH);

        -- try to interpret prompt
        declare
        package INT_IO is new TEXT_IO.INTEGER_IO (INTEGER);
        begin
        -- looking for an integer
        INT_IO.GET (BUFFER, INTEGER_CHOICE, LENGTH);
        exception
        when others =>
-- integer within range not entered
            declare
            package FLT_IO is new TEXT_IO.FLOAT_IO (FLOAT);

            FLOAT_CHOICE : FLOAT;
            begin
            -- was a float entered?
            FLT_IO.GET (BUFFER, FLOAT_CHOICE, LENGTH);
            -- convert float to integer
            INTEGER_CHOICE := INTEGER (FLOAT_CHOICE);
            exception
            when others =>
-- nothing meaningful entered
                INTEGER_CHOICE := 0;
            end;
        end;

        TEMP_CHOICE := INTEGER_CHOICE;

        if not (TEMP_CHOICE <= NUMBER_OF_CHOICES and TEMP_CHOICE > 0) then
        -- this test is used instead of raising CONSTRAINT_ERROR, since
        -- this makes it easier to use recursion
        GET_MENU_VALUE (MENU_USED, TITLE, TEMP_CHOICE);
        end if;
    end;

    CHOICE_CHOSEN := TEMP_CHOICE;
    end GET_MENU_VALUE;

    function ENUMERATION_MENU return MENU_TYPE is
-- Summary: Create an "Enumeration - Type Menu"

    MENU_SIZE : constant POSITIVE :=
            (MENU_ITEMS_TYPE'POS (MENU_ITEMS_TYPE'LAST) -
             MENU_ITEMS_TYPE'POS (MENU_ITEMS_TYPE'FIRST) + 1);
    -- front_spacing + max_item_number_width + between_spacing +
    --   max_item_length + between_spacing = display_width
    function SPACING_LENGTH return INTEGER is
-- Summary: It is assumed that all the spacing parameters are
--          equal. This provides that spacing value
        MAX_ITEM_LENGTH : NATURAL := 0;
        LENGTH          : POSITIVE;
        ITEM_LENGTH     : INTEGER;
    begin
        for ITEM in MENU_ITEMS_TYPE loop
        ITEM_LENGTH :=
          MENU_ITEMS_TYPE'IMAGE (ITEM)'LAST -
          MENU_ITEMS_TYPE'IMAGE (ITEM)'FIRST + 1;

        if MAX_ITEM_LENGTH < ITEM_LENGTH then
            MAX_ITEM_LENGTH := ITEM_LENGTH;
        end if;
        end loop;

        LENGTH := (DISPLAY_WIDTH -
               INTEGER'IMAGE
             (MENU_ITEMS_TYPE'POS (MENU_ITEMS_TYPE'LAST) + 1)
            'LENGTH + 1 - MAX_ITEM_LENGTH) / 3;
        return LENGTH;
    end SPACING_LENGTH;


    function ITEM_NUMBER (I : INTEGER) return STRING is
-- Summary: This converts an integer to a string
        MAX_ITEM_NUMBER : constant INTEGER := MENU_SIZE;
        I_STRING        : constant STRING := INTEGER'IMAGE (I);
    begin
        declare
        MAX_ITEM_NUMBER_STRING : constant STRING :=
                     INTEGER'IMAGE (MAX_ITEM_NUMBER);
        begin
        declare
            TEMP_STRING : STRING
                    (1 .. MAX_ITEM_NUMBER_STRING'LENGTH - 1) :=
                  (1 .. MAX_ITEM_NUMBER_STRING'LENGTH - 1 =>
                     ' ');
        begin
            TEMP_STRING (1 .. I_STRING'LENGTH - 1) :=
              I_STRING (I_STRING'FIRST + 1 .. I_STRING'LAST);
            return TEMP_STRING;
        exception
            when CONSTRAINT_ERROR =>
            return TEMP_STRING;
        end;
        end;
    end ITEM_NUMBER;
    begin
    declare
        MENU          : MENU_TYPE (1 .. MENU_SIZE);
        NUMBER_SPACES : INTEGER := SPACING_LENGTH;
    begin
        declare
        SCREEN_SPACING : STRING (1 .. NUMBER_SPACES) :=
                 (1 .. NUMBER_SPACES => ' ');
        begin
-- construct the mennu line-by-line
        for INDEX in 1 .. MENU_SIZE loop
            MENU (INDEX) :=
              new STRING'
                (SCREEN_SPACING & ITEM_NUMBER (INDEX) &
                 SCREEN_SPACING &
                 MENU_ITEMS_TYPE'IMAGE
                   (MENU_ITEMS_TYPE'VAL (INDEX - 1)));
        end loop;

        return MENU;
        end;
    end;
    end ENUMERATION_MENU;

    function STRING_MENU (ITEMS : ITEM_ARRAY_TYPE) return MENU_TYPE is
-- Summary: This procedure creates a menu from an array of strings

    MENU_SIZE : constant POSITIVE := ITEMS'LENGTH;
    -- front_spacing + max_item_number_width + bewteen_spacing +
    --   max_item_length + between_spacing = display_width
    function SPACING_LENGTH return INTEGER is
-- Summary: Since the spacings above are assumed to be equal, this
--          function calculates the amount of that spacing.

        MAX_ITEM_LENGTH : NATURAL := 0;
        LENGTH          : POSITIVE;
        ITEM_LENGTH     : INTEGER;
    begin
        for ITEM in 1 .. MENU_SIZE loop
        ITEM_LENGTH := ITEMS (ITEM)'LENGTH;

        if MAX_ITEM_LENGTH < ITEM_LENGTH then
            MAX_ITEM_LENGTH := ITEM_LENGTH;
        end if;
        end loop;

        LENGTH := (DISPLAY_WIDTH - INTEGER'IMAGE (ITEMS'LAST + 1)'LENGTH +
               1 - MAX_ITEM_LENGTH) / 3;
        return LENGTH;
    end SPACING_LENGTH;


    function ITEM_NUMBER (I : INTEGER) return STRING is
-- Summary: This function will convert an integer to a string

        MAX_ITEM_NUMBER : constant INTEGER := MENU_SIZE;
        I_STRING        : constant STRING := INTEGER'IMAGE (I);
    begin
        declare
        MAX_ITEM_NUMBER_STRING : constant STRING :=
                     INTEGER'IMAGE (MAX_ITEM_NUMBER);
        begin
        declare
            TEMP_STRING : STRING
                    (1 .. MAX_ITEM_NUMBER_STRING'LENGTH - 1) :=
                  (1 .. MAX_ITEM_NUMBER_STRING'LENGTH - 1 =>
                     ' ');
        begin
            TEMP_STRING (1 .. I_STRING'LENGTH - 1) :=
              I_STRING (I_STRING'FIRST + 1 .. I_STRING'LAST);
            return TEMP_STRING;
        exception
            when CONSTRAINT_ERROR =>
            return TEMP_STRING;
        end;
        end;
    end ITEM_NUMBER;
    begin
    declare
        MENU          : MENU_TYPE (1 .. MENU_SIZE);
        NUMBER_SPACES : INTEGER := SPACING_LENGTH;
    begin
        declare
        SCREEN_SPACING : STRING (1 .. NUMBER_SPACES) :=
                 (1 .. NUMBER_SPACES => ' ');
        begin
-- The menu construction begins...
        for INDEX in 1 .. MENU_SIZE loop
            MENU (INDEX) :=
              new STRING'
                (SCREEN_SPACING & ITEM_NUMBER (INDEX) &
                 SCREEN_SPACING & ITEMS (INDEX).all);
        end loop;

        return MENU;
        end;
    end;
    end STRING_MENU;
end MENU;




package MULTIPLE_CHOICE is
-- Author   : M. K. McNair
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date     : 8 March 1985
-- Summary  :
--   This package implements a MULTIPLE_CHOICE scheme for getting input.
--   A multiple choice question is generalized to consist of:
--
--   Preceding text
--     ...
--   Choices
--     ...
--   Following text
--     ...
--   Prompt.


    type STRING_ACCESS_TYPE is access STRING;

    type TEXT_TYPE is array (POSITIVE range <>) of STRING_ACCESS_TYPE;

    generic
    type ANSWER_TYPE is (<>);
    procedure GET (ANSWER         : out ANSWER_TYPE;
           PRECEDING_TEXT : TEXT_TYPE;
           FOLLOWING_TEXT : TEXT_TYPE);

end MULTIPLE_CHOICE;




with TEXT_IO,
     FATAL;

package body MULTIPLE_CHOICE is
-- Author   : M. K. McNair
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date     : 8 March 1985
-- Summary  :
--   This is the body to the MULTIPLE_CHOICE package.

    procedure GET (ANSWER         : out ANSWER_TYPE;
           PRECEDING_TEXT : TEXT_TYPE;
           FOLLOWING_TEXT : TEXT_TYPE) is

    package ANSWER_IO is new TEXT_IO.ENUMERATION_IO (ANSWER_TYPE);

    RESPONSE        : ANSWER_TYPE;
    BUFFER          : STRING (1 .. 128);
    TEMP_LAST, LAST : NATURAL;

    CHOICE_COLUMN   : constant TEXT_IO.COUNT := 5;
    begin
    for INDEX in PRECEDING_TEXT'RANGE loop
        TEXT_IO.PUT_LINE (PRECEDING_TEXT (INDEX).all);
    end loop;

    TEXT_IO.NEW_LINE;

    for INDEX in ANSWER_TYPE loop
        TEXT_IO.SET_COL (CHOICE_COLUMN);
        TEXT_IO.PUT ('(' & INTEGER'IMAGE (ANSWER_TYPE'POS (INDEX) + 1) &
             ")    ");
        TEXT_IO.PUT_LINE (ANSWER_TYPE'IMAGE (INDEX));
    end loop;

    TEXT_IO.NEW_LINE;

    for INDEX in FOLLOWING_TEXT'RANGE loop
        TEXT_IO.PUT_LINE (FOLLOWING_TEXT (INDEX).all);
    end loop;

    TEXT_IO.NEW_LINE;  TEXT_IO.PUT ("? ");
    TEXT_IO.GET_LINE (BUFFER, LAST);
    ANSWER_IO.GET (BUFFER (1 .. LAST), RESPONSE, TEMP_LAST);
    ANSWER := RESPONSE;
    exception
    when TEXT_IO.DATA_ERROR | CONSTRAINT_ERROR =>
        declare
        NUMBER : INTEGER;

        package INT_IO is new TEXT_IO.INTEGER_IO (INTEGER);
        begin
        -- did the user type in the number instead??
        INT_IO.GET (BUFFER (1 .. LAST), NUMBER, TEMP_LAST);
        ANSWER := ANSWER_TYPE'VAL (NUMBER - 1);
        exception
        when TEXT_IO.DATA_ERROR | CONSTRAINT_ERROR =>
            TEXT_IO.NEW_LINE;
            TEXT_IO.PUT_LINE ("Invalid response.");
            TEXT_IO.NEW_LINE;
            GET (ANSWER, PRECEDING_TEXT, FOLLOWING_TEXT);
        end;

    when TEXT_IO.END_ERROR =>
        TEXT_IO.NEW_LINE;
        GET (ANSWER, PRECEDING_TEXT, FOLLOWING_TEXT);

    when others =>
        FATAL (UNIT => "multiple_choice.get");
    end GET;

end MULTIPLE_CHOICE;




with TEXT_IO;
generic
    DISPLAY_WIDTH  : POSITIVE := 80;
    DISPLAY_HEIGHT : POSITIVE := 24;
package CHARTS is
-- Author : M. K. McNair
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date   : 8 March 1985
-- Summary: This package provides a data structure and a "hands-off"
--          means of outputing charts. A chart is composed of a two-
--          dimensional matrix where each element of the matrix can
--          be either a string, integer or float. There are three
--          restrictions to the construction of a chart: it must fit
--          the above DISPLAY_WIDTH and DISPLAY_HEIGHT parameters,
--          there must be enough storage to store the chart in
--          memory, and the output file must be open for output.
--          As a possible solution to storage problems, consider
--          declaring an access type to CHART_TYPE and then allocating
--          the chart when needed. When it is no longer required,
--          then use UNCHECKED_DEALLOCATION to deallocate the chart.


    type STRING_ACCESS_TYPE is access STRING;
    type TITLE_ARRAY        is array (POSITIVE range <>) of STRING_ACCESS_TYPE;
    type ELEMENT_TYPE is (STRNG, INT, REAL);
    type CHART_ELEMENT_TYPE (KIND_OF_ELEMENT : ELEMENT_TYPE := STRNG) is
    record
        WIDTH : NATURAL := 0;
        -- width being 0 implies the smallest width required to fit the
        -- value
        case KIND_OF_ELEMENT is
        when STRNG =>
            STRING_VALUE : STRING_ACCESS_TYPE;
            -- value of null implies a blank line
        when INT =>
            INTEGER_VALUE : INTEGER;

        when REAL =>
            FLOAT_VALUE : FLOAT;
            AFT         : INTEGER := 2;
        end case;
    end record;
    type CHART_TYPE is array (POSITIVE range <>, POSITIVE range <>)
                  of CHART_ELEMENT_TYPE;
-- the first index is the row number, the second index is the column number

    procedure OUTPUT (THE_CHART  : CHART_TYPE;
              WITH_TITLE : TITLE_ARRAY;
              TO_FILE    : TEXT_IO.FILE_TYPE := TEXT_IO.CURRENT_OUTPUT);

    procedure CLEANUP (THE_TITLE : in out TITLE_ARRAY);
    procedure CLEANUP (THE_CHART : in out CHART_TYPE);

    OUTPUT_ALREADY_OPEN, OUTPUT_NOT_OPEN, CHART_TO_WIDE, CHART_TO_TALL : exception;
-- note: STORAGE_ERROR is not listed here since, if it is to be raised,
--       it will be raised at the point where the chart is declared.
end CHARTS;

with FATAL,
     UNCHECKED_DEALLOCATION;
-- This is an error reporting subprogram





package body CHARTS is
-- Author : M. K. McNair
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date   : 8 March 1985
-- Summary: This is the body to the CHARTS package. There are no global
--          variables, so it is o.k. to use this package in a multi-
--          tasking environment.


    procedure FREE is new UNCHECKED_DEALLOCATION (STRING, STRING_ACCESS_TYPE);

    package FLT_IO is new TEXT_IO.FLOAT_IO (FLOAT);

    procedure OUTPUT (THE_CHART  : CHART_TYPE;
              WITH_TITLE : TITLE_ARRAY;
              TO_FILE    : TEXT_IO.FILE_TYPE :=
                   TEXT_IO.CURRENT_OUTPUT) is
    FILE_LINE_LENGTH : TEXT_IO.COUNT := TEXT_IO.LINE_LENGTH (TO_FILE);
    TITLE            : TITLE_ARRAY renames WITH_TITLE;
    ROW_OFFSET       : NATURAL;

    procedure OUTPUT_STRING (WITH_VALUE : STRING;
                 AND_WIDTH  : NATURAL;
                 TO_FILE    : TEXT_IO.FILE_TYPE) is

-- Summary: This procedure will output a string with the specified
--          width to the specified file. The file must already be
--          open for output.

        VALUE : STRING renames WITH_VALUE;
        WIDTH : NATURAL renames AND_WIDTH;
        FILE  : TEXT_IO.FILE_TYPE renames TO_FILE;
    begin
        if (WIDTH = 0) or (WIDTH = VALUE'LENGTH) then
        -- if actual width indicated ....
        TEXT_IO.PUT (FILE, VALUE);

        elsif WIDTH > VALUE'LENGTH then
        -- leading blanks need to be attached
        TEXT_IO.SET_COL
           (FILE,
            TEXT_IO.COUNT
               (INTEGER (TEXT_IO.COL (FILE)) + WIDTH - VALUE'LENGTH));
        TEXT_IO.PUT (FILE, VALUE);
        else
        -- the string needs to be truncated
        TEXT_IO.PUT (FILE,
                 VALUE (VALUE'FIRST .. VALUE'FIRST + WIDTH - 1));
        end if;
    exception
        when others =>
        raise;
    end OUTPUT_STRING;

    begin
    -- set the output file's line length to display_width
    TEXT_IO.SET_LINE_LENGTH (TO_FILE, TEXT_IO.COUNT (DISPLAY_WIDTH));

    -- Find longest line and then provide a line offset - that way,
    -- all the lines will be centered within the DISPLAY_WIDTH.
    declare
        LENGTH, MAX_LENGTH : NATURAL := 0;
    begin
        for ROW in THE_CHART'RANGE (1) loop
        LENGTH := 0;

        for COLUMN in THE_CHART'RANGE (2) loop
            declare
            ELEMENT : constant CHART_ELEMENT_TYPE :=
                  THE_CHART (ROW, COLUMN);
            begin
            if ELEMENT.WIDTH > 0 then
                LENGTH := LENGTH + ELEMENT.WIDTH;
            else
                case ELEMENT.KIND_OF_ELEMENT is
                when STRNG =>
                    begin
                    LENGTH :=
                      LENGTH +
                      ELEMENT.STRING_VALUE.all'LENGTH;
                    exception
                    when CONSTRAINT_ERROR =>
                        null;
                    end;

                when INT =>
                    LENGTH :=
                      LENGTH +
                      INTEGER'IMAGE (ELEMENT.INTEGER_VALUE)
                       'LENGTH;

                when REAL =>
                    declare
                    TEMP_STRING : STRING (1 .. 60);
                    FIRST       : NATURAL;
                    begin
                    FLT_IO.PUT
                       (TEMP_STRING, ELEMENT.FLOAT_VALUE,
                        EXP => 0, AFT => ELEMENT.AFT);

                    for INDEX in 1 .. 60 loop
                        FIRST := INDEX;
                        exit when TEMP_STRING (INDEX) /=
                              ' ';
                    end loop;

                    LENGTH := LENGTH + 60 - FIRST + 1;
                    end;
                end case;
            end if;
            end;
        end loop;

        if LENGTH > MAX_LENGTH then
            MAX_LENGTH := LENGTH;
        end if;
        end loop;

        ROW_OFFSET := (DISPLAY_WIDTH - MAX_LENGTH) / 2;
    exception
        when CONSTRAINT_ERROR =>
        raise CHART_TO_WIDE;
    end;

    -- put out centered title ...
    declare
        SPACING : NATURAL;
    begin
        TEXT_IO.NEW_PAGE (TO_FILE);
        SPACING := (DISPLAY_HEIGHT - TITLE'LENGTH -
            THE_CHART'LENGTH (1)) / 2;

        for INDEX in TITLE'RANGE loop
        declare
            CENTER : NATURAL;
        begin
            CENTER := (DISPLAY_WIDTH - TITLE (INDEX).all'LENGTH) / 2;
            TEXT_IO.SET_COL (TO_FILE, TEXT_IO.COUNT (CENTER));
            TEXT_IO.PUT_LINE (TO_FILE, TITLE (INDEX).all);
        exception
            when CONSTRAINT_ERROR =>
            if TITLE (INDEX) /= null then
                -- i.e. title line to long
                raise;
            else
                TEXT_IO.NEW_LINE (TO_FILE);
            end if;
        end;
        end loop;

        if SPACING > 0 then
        TEXT_IO.NEW_LINE (TO_FILE, TEXT_IO.COUNT (SPACING));
        end if;
    exception
        when CONSTRAINT_ERROR =>
        raise CHART_TO_TALL;
    end;

    -- put out chart
    for ROW in THE_CHART'FIRST (1) .. THE_CHART'LAST (1) loop
        TEXT_IO.PUT (TO_FILE, (1 .. ROW_OFFSET => ' '));

        for COLUMN in THE_CHART'FIRST (2) .. THE_CHART'LAST (2) loop
        declare
            ELEMENT : constant CHART_ELEMENT_TYPE :=
                  THE_CHART (ROW, COLUMN);
            FILE    : TEXT_IO.FILE_TYPE renames TO_FILE;
        begin
            case ELEMENT.KIND_OF_ELEMENT is
            when STRNG =>
                begin
                OUTPUT_STRING
                   (WITH_VALUE => ELEMENT.STRING_VALUE.all,
                    AND_WIDTH  => ELEMENT.WIDTH,
                    TO_FILE    => FILE);
                exception
                when CONSTRAINT_ERROR =>  -- blank field desired
                    begin
                    TEXT_IO.SET_COL
                       (FILE,
                        TEXT_IO.COUNT
                           (INTEGER (TEXT_IO.COL (FILE)) +
                        ELEMENT.WIDTH));
                    exception
                    when TEXT_IO.LAYOUT_ERROR =>
                        null;
                    end;
                end;

            when INT =>
                OUTPUT_STRING
                   (WITH_VALUE => INTEGER'IMAGE
                        (ELEMENT.INTEGER_VALUE),
                AND_WIDTH  => ELEMENT.WIDTH,
                TO_FILE    => FILE);

            when REAL =>
                declare
                TEMP_STRING : STRING (1 .. 60);
                FIRST       : NATURAL;
                begin
                FLT_IO.PUT
                   (TEMP_STRING, ELEMENT.FLOAT_VALUE,
                    EXP => 0, AFT => ELEMENT.AFT);

                for INDEX in 1 .. 60 loop
                    FIRST := INDEX;
                    exit when TEMP_STRING (INDEX) /= ' ';
                end loop;

                OUTPUT_STRING
                   (WITH_VALUE => TEMP_STRING (FIRST .. 60),
                    AND_WIDTH  => ELEMENT.WIDTH,
                    TO_FILE    => FILE);
                end;
            end case;
        exception
            when others =>
            raise;
        end;
        end loop;

        TEXT_IO.NEW_LINE (TO_FILE);
    end loop;

    -- restore line length
    TEXT_IO.SET_LINE_LENGTH (TO_FILE, FILE_LINE_LENGTH);
    exception
    when TEXT_IO.STATUS_ERROR =>
        TEXT_IO.SET_LINE_LENGTH (TO_FILE, FILE_LINE_LENGTH);
        raise OUTPUT_NOT_OPEN;

    when TEXT_IO.MODE_ERROR =>
        TEXT_IO.SET_LINE_LENGTH (TO_FILE, FILE_LINE_LENGTH);
        raise OUTPUT_ALREADY_OPEN;

    when TEXT_IO.LAYOUT_ERROR =>
        TEXT_IO.SET_LINE_LENGTH (TO_FILE, FILE_LINE_LENGTH);
        raise CHART_TO_WIDE;

    when CHART_TO_WIDE =>
        TEXT_IO.SET_LINE_LENGTH (TO_FILE, FILE_LINE_LENGTH);
        raise;

    when CHART_TO_TALL =>
        TEXT_IO.SET_LINE_LENGTH (TO_FILE, FILE_LINE_LENGTH);
        raise;

    when others =>
        FATAL (UNIT => "charts.output");
        raise;
    end OUTPUT;

    procedure CLEANUP (THE_TITLE : in out TITLE_ARRAY) is
    begin
    for INDEX in THE_TITLE'RANGE loop
        FREE (THE_TITLE (INDEX));
    end loop;
    end CLEANUP;

    procedure CLEANUP (THE_CHART : in out CHART_TYPE) is
    begin
    for FIRST_INDEX in THE_CHART'RANGE (1) loop
        for SECOND_INDEX in THE_CHART'RANGE (2) loop
        if THE_CHART (FIRST_INDEX, SECOND_INDEX).KIND_OF_ELEMENT =
           STRNG then
            FREE (THE_CHART (FIRST_INDEX, SECOND_INDEX).STRING_VALUE);
        end if;
        end loop;
    end loop;
    end CLEANUP;

end CHARTS;





generic
    type ARC_DATA_TYPE  is private;
    type NODE_DATA_TYPE is private;
package GRAPHS is
    type NODE_TYPE  is private;
    type ARC_TYPE   is private;
    type GRAPH_TYPE is limited private;

    procedure CREATE_ARC                      (WITH_VALUE   : ARC_DATA_TYPE;
                           BETWEEN_NODE : NODE_TYPE;
                           AND_NODE     : NODE_TYPE);
    function  NEW_NODE
         (WITH_VALUE                      : NODE_DATA_TYPE;
          MAXIMUM_NUMBER_OF_INCOMING_ARCS : NATURAL;
          MAXIMUM_NUMBER_OF_OUTGOING_ARCS : NATURAL;
          IN_GRAPH                        : GRAPH_TYPE)
                            return NODE_TYPE;
    procedure CREATE
         (A_GRAPH                 : in out GRAPH_TYPE;
          WITH_START_NODE         : NODE_TYPE;
          WITH_END_NODE           : NODE_TYPE;
          MAXIMUM_NUMBER_OF_NODES : NATURAL);
    procedure SET_END_NODE                    (TO_VALUE : NODE_TYPE;
                           IN_GRAPH : GRAPH_TYPE);
    procedure SET_START_NODE                  (TO_VALUE : NODE_TYPE;
                           IN_GRAPH : GRAPH_TYPE);
    procedure DELETE                          (THE_NODE : in out NODE_TYPE);
    procedure DELETE                          (THE_ARC : in out ARC_TYPE);
    function  CURRENT_NUMBER_OF_INCOMING_ARCS (ON_NODE : NODE_TYPE)
                            return NATURAL;
    function  CURRENT_NUMBER_OF_OUTGOING_ARCS (ON_NODE : NODE_TYPE)
                            return NATURAL;
    function  MAXIMUM_NUMBER_OF_INCOMING_ARCS (ON_NODE : NODE_TYPE)
                            return NATURAL;
    function  MAXIMUM_NUMBER_OF_OUTGOING_ARCS (ON_NODE : NODE_TYPE)
                            return NATURAL;
    function  HEAD_NODE                       (OF_ARC : ARC_TYPE)
                            return NODE_TYPE;
    function  TAIL_NODE                       (OF_ARC : ARC_TYPE)
                            return NODE_TYPE;
    function  START_NODE                      (OF_GRAPH : GRAPH_TYPE)
                            return NODE_TYPE;
    function  END_NODE                        (OF_GRAPH : GRAPH_TYPE)
                            return NODE_TYPE;
    function  VALUE                           (OF_ARC : ARC_TYPE)
                            return ARC_DATA_TYPE;
    function  VALUE                           (OF_NODE : NODE_TYPE)
                            return NODE_DATA_TYPE;
    procedure ASSIGN_VALUE                    (OF_NODE  : NODE_TYPE;
                           TO_NODE  : in out NODE_TYPE;
                           IN_GRAPH : GRAPH_TYPE);

    type ARC_LIST_TYPE is array (INTEGER range <>) of ARC_TYPE;
    function ARC (WITH_TAIL : NODE_TYPE;
          WITH_HEAD : NODE_TYPE) return ARC_LIST_TYPE;

    procedure ASSIGN (VALUE : NODE_DATA_TYPE; TO_NODE : NODE_TYPE);

    procedure ASSIGN (VALUE : ARC_DATA_TYPE; TO_ARC : ARC_TYPE);

    type NODE_LIST_TYPE is array (INTEGER range <>) of NODE_TYPE;

    function  INCOMING_ARCS (ON_NODE : NODE_TYPE) return ARC_LIST_TYPE;
    function  OUTGOING_ARCS (ON_NODE : NODE_TYPE) return ARC_LIST_TYPE;
    function  NODES         (ON_GRAPH : GRAPH_TYPE) return NODE_LIST_TYPE;
    procedure TOPSORT       (NODE_LIST : in out NODE_LIST_TYPE);


-- misc functions
    function LIST_OF_SINKS   (IN_GRAPH : GRAPH_TYPE) return NODE_LIST_TYPE;
    function LIST_OF_SOURCES (IN_GRAPH : GRAPH_TYPE) return NODE_LIST_TYPE;
    function ANY_CYCLES      (IN_GRAPH : GRAPH_TYPE) return BOOLEAN;


-- exceptions
    HEAD_NODE_DOES_NOT_EXIST,
-- raised in: create_arc





    TAIL_NODE_DOES_NOT_EXIST,
-- raised in: create_arc





    MAXIMUM_NUMBER_OF_NODES_SPECIFIED_IN_GRAPH,
-- raised in: new_node



    NOT_ENOUGH_STORAGE_REMAINING,
-- raised in: create_arc,
--            new_node,
--            create




    END_NODE_ALREADY_EXISTS,
-- raised in: set_end_node




    START_NODE_ALREADY_EXISTS,
-- raised in: set_start_node




    ARC_DOES_NOT_EXIST,
-- raised in: head_node,
--            tail_node,
--            value (of_arc)





    ITERATION_IN_PROGRESS,
-- raised in: start_incoming_arc_iteration,
--            start_outgoing_arc_iteration,
--            start_node_iteration,
--            start_arc_iteration




    NODE_DOES_NOT_EXIST,
-- raised in: current_number_of_incoming_arcs,
--            current_number_of_outgoing_arcs,
--            value (of_node),
--            start_incoming_arc_iteration,
--            more_incoming_arcs
--            current_incoming_arc,
--            start_outgoing_arc_iteration,
--            more_outgoing_arcs,
--            current_outgoing_arc





    GRAPH_DOES_NOT_EXIST,
-- raised in: start_node,
--            end_node,
--            set_start_node,
--            set_end_node






    ASSIGN_FROM_NODE_DOES_NOT_EXIST,
-- raised in: assign_value





    NOT_ENOUGH_INCOMING_ARC_SLOTS_SPECIFIED,
-- raised in: assign_value





    NOT_ENOUGH_OUTGOING_ARC_SLOTS_SPECIFIED,
-- raised in: assign_value





    ARC_DOES_NOT_CONNECT_THESE_NODES,
-- raised in: arc





    MAXIMUM_NUMBER_OF_ARCS_SPECIFIED_BETWEEN_THESE_NODES,
-- raised in: create_arc





    PATH_NOT_FOUND,
-- raised in: search_tree





    NODE_FOUND_TWICE,
-- raised in: search_tree





    CYCLE_EXISTS,
--raised in:  TOPSORT





    NODE_NOT_FOUND : exception;
-- raised in: search_tree

private
    type ARC_VALUE_TYPE is
    record
        VALUE     : ARC_DATA_TYPE;
        HEAD_NODE : NODE_TYPE;
        TAIL_NODE : NODE_TYPE;
    end record;
    pragma PACK (ARC_VALUE_TYPE);

    type ARC_TYPE is access ARC_VALUE_TYPE;

    subtype ARRAY_OF_ARCS is ARC_LIST_TYPE;

    type NODE_VALUE_TYPE (MAXIMUM_INCOMING_ARCS : NATURAL;
              MAXIMUM_OUTGOING_ARCS : NATURAL) is
    record
        VALUE         : NODE_DATA_TYPE;
        INCOMING_ARCS : ARRAY_OF_ARCS (1 .. MAXIMUM_INCOMING_ARCS);
        OUTGOING_ARCS : ARRAY_OF_ARCS (1 .. MAXIMUM_OUTGOING_ARCS);
        TOPSORT_COUNT : NATURAL;
    end record;
    pragma PACK (NODE_VALUE_TYPE);
    type NODE_TYPE is access NODE_VALUE_TYPE;
    type GRAPH_VALUE_TYPE (MAX_NUMBER_OF_NODES : POSITIVE) is
    record
        START_NODE : NODE_TYPE;
        END_NODE   : NODE_TYPE;
        NODE_LIST  : NODE_LIST_TYPE (1 .. MAX_NUMBER_OF_NODES);
    end record;
    pragma PACK (GRAPH_VALUE_TYPE);

    type GRAPH_TYPE is access GRAPH_VALUE_TYPE;
end GRAPHS;





with UNCHECKED_DEALLOCATION;

package body GRAPHS is

    procedure CREATE_ARC (WITH_VALUE   : ARC_DATA_TYPE;
              BETWEEN_NODE : NODE_TYPE;
              AND_NODE     : NODE_TYPE) is
    pragma OPTIMIZE (TIME);

    HEAD_NODE : NODE_TYPE renames AND_NODE;
    TAIL_NODE : NODE_TYPE renames BETWEEN_NODE;
    ARC_VALUE : ARC_DATA_TYPE renames WITH_VALUE;
    TEMP_ARC  : ARC_TYPE := new ARC_VALUE_TYPE;


    function NEXT_FREE_SLOT (IN_ARRAY : ARRAY_OF_ARCS) return NATURAL is
        pragma OPTIMIZE (TIME);

        COUNT : NATURAL := 0;
    begin
        loop
        COUNT := COUNT + 1;
        exit when IN_ARRAY (COUNT) = null;
        end loop;

        return COUNT;
    exception
        when CONSTRAINT_ERROR =>
        raise MAXIMUM_NUMBER_OF_ARCS_SPECIFIED_BETWEEN_THESE_NODES;
    end NEXT_FREE_SLOT;
    begin
    TEMP_ARC.all := (ARC_VALUE, HEAD_NODE, TAIL_NODE);
    HEAD_NODE.INCOMING_ARCS (NEXT_FREE_SLOT (HEAD_NODE.INCOMING_ARCS)) :=
      TEMP_ARC;
    TAIL_NODE.OUTGOING_ARCS (NEXT_FREE_SLOT (TAIL_NODE.OUTGOING_ARCS)) :=
      TEMP_ARC;
    exception
    when STORAGE_ERROR =>
        raise NOT_ENOUGH_STORAGE_REMAINING;

    when CONSTRAINT_ERROR =>
        if (HEAD_NODE = null) then
        raise HEAD_NODE_DOES_NOT_EXIST;

        elsif (TAIL_NODE = null) then
        raise TAIL_NODE_DOES_NOT_EXIST;
        end if;
    end CREATE_ARC;


    function NEW_NODE (WITH_VALUE                      : NODE_DATA_TYPE;
               MAXIMUM_NUMBER_OF_INCOMING_ARCS : NATURAL;
               MAXIMUM_NUMBER_OF_OUTGOING_ARCS : NATURAL;
               IN_GRAPH                        : GRAPH_TYPE)
                return NODE_TYPE is
    pragma OPTIMIZE (SPACE);

    NODE_VALUE : NODE_DATA_TYPE renames WITH_VALUE;
    GRAPH      : GRAPH_TYPE renames IN_GRAPH;
    TEMP_NODE  : NODE_TYPE;


    function NEXT_FREE_SLOT (IN_ARRAY : NODE_LIST_TYPE) return NATURAL is
        COUNT : NATURAL := 0;
    begin
        loop
        COUNT := COUNT + 1;
        exit when IN_ARRAY (COUNT) = null;
        end loop;

        return COUNT;
    exception
        when CONSTRAINT_ERROR =>
        raise MAXIMUM_NUMBER_OF_NODES_SPECIFIED_IN_GRAPH;
    end NEXT_FREE_SLOT;
    begin
    TEMP_NODE := new NODE_VALUE_TYPE
               (MAXIMUM_NUMBER_OF_INCOMING_ARCS,
                MAXIMUM_NUMBER_OF_OUTGOING_ARCS);
    TEMP_NODE.VALUE := NODE_VALUE;
    GRAPH.NODE_LIST (NEXT_FREE_SLOT (GRAPH.NODE_LIST)) := TEMP_NODE;
    return TEMP_NODE;
    exception
    when STORAGE_ERROR =>
        raise NOT_ENOUGH_STORAGE_REMAINING;
    end NEW_NODE;


    procedure CREATE (A_GRAPH                 : in out GRAPH_TYPE;
              WITH_START_NODE         : NODE_TYPE;
              WITH_END_NODE           : NODE_TYPE;
              MAXIMUM_NUMBER_OF_NODES : NATURAL) is
    pragma OPTIMIZE (SPACE);

    START_NODE : NODE_TYPE renames WITH_START_NODE;
    END_NODE   : NODE_TYPE renames WITH_END_NODE;
    TEMP_GRAPH : GRAPH_TYPE;
    begin
    TEMP_GRAPH := new GRAPH_VALUE_TYPE (MAXIMUM_NUMBER_OF_NODES);
    TEMP_GRAPH.START_NODE := START_NODE;
    TEMP_GRAPH.END_NODE := END_NODE;
    A_GRAPH := TEMP_GRAPH;
    exception
    when STORAGE_ERROR =>
        raise NOT_ENOUGH_STORAGE_REMAINING;
    end CREATE;

    procedure SET_END_NODE (TO_VALUE : NODE_TYPE; IN_GRAPH : GRAPH_TYPE) is
    begin
    IN_GRAPH.END_NODE := TO_VALUE;
    exception
    when CONSTRAINT_ERROR =>
        raise GRAPH_DOES_NOT_EXIST;
    end SET_END_NODE;

    procedure SET_START_NODE (TO_VALUE : NODE_TYPE; IN_GRAPH : GRAPH_TYPE) is
    begin
    IN_GRAPH.START_NODE := TO_VALUE;
    exception
    when CONSTRAINT_ERROR =>
        raise GRAPH_DOES_NOT_EXIST;
    end SET_START_NODE;

    procedure DELETE (THE_NODE : in out NODE_TYPE) is
    pragma OPTIMIZE (SPACE);

    procedure DEALLOCATE is new UNCHECKED_DEALLOCATION
           (NODE_VALUE_TYPE, NODE_TYPE);
    begin
    DEALLOCATE (THE_NODE);
    end DELETE;


    procedure DELETE (THE_ARC : in out ARC_TYPE) is
    pragma OPTIMIZE (SPACE);

    procedure DEALLOCATE is new UNCHECKED_DEALLOCATION
           (ARC_VALUE_TYPE, ARC_TYPE);
    begin
    DEALLOCATE (THE_ARC);
    end DELETE;


    function NUMBER_NON_NULL_ELEMENTS (IN_ARRAY : ARRAY_OF_ARCS)
                        return NATURAL is
    pragma OPTIMIZE (TIME);

    THE_ARRAY : ARRAY_OF_ARCS renames IN_ARRAY;
    COUNT     : NATURAL := 0;
    begin
    for INDEX in THE_ARRAY'RANGE loop
        if THE_ARRAY (INDEX) /= null then
        COUNT := COUNT + 1;
        end if;
    end loop;

    return COUNT;
    end NUMBER_NON_NULL_ELEMENTS;


    function CURRENT_NUMBER_OF_INCOMING_ARCS (ON_NODE : NODE_TYPE)
                           return NATURAL is
    pragma OPTIMIZE (TIME);

    NODE : NODE_TYPE renames ON_NODE;
    begin
    return NUMBER_NON_NULL_ELEMENTS (IN_ARRAY => NODE.INCOMING_ARCS);
    exception
    when CONSTRAINT_ERROR =>
        raise NODE_DOES_NOT_EXIST;
    end CURRENT_NUMBER_OF_INCOMING_ARCS;


    function CURRENT_NUMBER_OF_OUTGOING_ARCS (ON_NODE : NODE_TYPE)
                           return NATURAL is
    pragma OPTIMIZE (TIME);

    NODE : NODE_TYPE renames ON_NODE;
    begin
    return NUMBER_NON_NULL_ELEMENTS (IN_ARRAY => NODE.OUTGOING_ARCS);
    exception
    when CONSTRAINT_ERROR =>
        raise NODE_DOES_NOT_EXIST;
    end CURRENT_NUMBER_OF_OUTGOING_ARCS;


    function MAXIMUM_NUMBER_OF_INCOMING_ARCS (ON_NODE : NODE_TYPE)
                           return NATURAL is
    pragma OPTIMIZE (TIME);

    NODE : NODE_TYPE renames ON_NODE;
    begin
    return NODE.MAXIMUM_INCOMING_ARCS;
    exception
    when CONSTRAINT_ERROR =>
        raise NODE_DOES_NOT_EXIST;
    end MAXIMUM_NUMBER_OF_INCOMING_ARCS;

    function MAXIMUM_NUMBER_OF_OUTGOING_ARCS (ON_NODE : NODE_TYPE)
                           return NATURAL is
    pragma OPTIMIZE (TIME);

    NODE : NODE_TYPE renames ON_NODE;
    begin
    return NODE.MAXIMUM_OUTGOING_ARCS;
    exception
    when CONSTRAINT_ERROR =>
        raise NODE_DOES_NOT_EXIST;
    end MAXIMUM_NUMBER_OF_OUTGOING_ARCS;


    function HEAD_NODE (OF_ARC : ARC_TYPE) return NODE_TYPE is
    pragma OPTIMIZE (TIME);

    ARC : ARC_TYPE renames OF_ARC;
    begin
    return ARC.HEAD_NODE;
    exception
    when CONSTRAINT_ERROR =>
        raise ARC_DOES_NOT_EXIST;
    end HEAD_NODE;


    function TAIL_NODE (OF_ARC : ARC_TYPE) return NODE_TYPE is
    pragma OPTIMIZE (TIME);

    ARC : ARC_TYPE renames OF_ARC;
    begin
    return ARC.TAIL_NODE;
    exception
    when CONSTRAINT_ERROR =>
        raise ARC_DOES_NOT_EXIST;
    end TAIL_NODE;


    function START_NODE (OF_GRAPH : GRAPH_TYPE) return NODE_TYPE is
    pragma OPTIMIZE (TIME);

    GRAPH : GRAPH_TYPE renames OF_GRAPH;
    begin
    return GRAPH.START_NODE;
    exception
    when CONSTRAINT_ERROR =>
        raise GRAPH_DOES_NOT_EXIST;
    end START_NODE;


    function END_NODE (OF_GRAPH : GRAPH_TYPE) return NODE_TYPE is
    pragma OPTIMIZE (TIME);

    GRAPH : GRAPH_TYPE renames OF_GRAPH;
    begin
    return GRAPH.END_NODE;
    exception
    when CONSTRAINT_ERROR =>
        raise GRAPH_DOES_NOT_EXIST;
    end END_NODE;


    function VALUE (OF_ARC : ARC_TYPE) return ARC_DATA_TYPE is
    pragma OPTIMIZE (TIME);

    ARC : ARC_TYPE renames OF_ARC;
    begin
    return ARC.VALUE;
    exception
    when CONSTRAINT_ERROR =>
        raise ARC_DOES_NOT_EXIST;
    end VALUE;


    function VALUE (OF_NODE : NODE_TYPE) return NODE_DATA_TYPE is
    pragma OPTIMIZE (TIME);

    NODE : NODE_TYPE renames OF_NODE;
    begin
    return NODE.VALUE;
    exception
    when CONSTRAINT_ERROR =>
        raise NODE_DOES_NOT_EXIST;
    end VALUE;


    procedure ASSIGN_VALUE (OF_NODE  : NODE_TYPE;
                TO_NODE  : in out NODE_TYPE;
                IN_GRAPH : GRAPH_TYPE) is
    pragma OPTIMIZE (TIME);

    ASSIGN_FROM_NODE : NODE_TYPE renames OF_NODE;
    ASSIGN_TO_NODE   : NODE_TYPE renames TO_NODE;
    GRAPH            : GRAPH_TYPE renames IN_GRAPH;
    begin
    if ASSIGN_TO_NODE = null then
        ASSIGN_TO_NODE := NEW_NODE (ASSIGN_FROM_NODE.VALUE,
                    ASSIGN_FROM_NODE.MAXIMUM_INCOMING_ARCS,
                    ASSIGN_FROM_NODE.MAXIMUM_OUTGOING_ARCS,
                    GRAPH);
    else
        ASSIGN_TO_NODE.VALUE := ASSIGN_FROM_NODE.VALUE;

        for INDEX in 1 .. ASSIGN_TO_NODE.MAXIMUM_INCOMING_ARCS loop
        DELETE (ASSIGN_TO_NODE.INCOMING_ARCS (INDEX));
        end loop;

        for INDEX in 1 .. ASSIGN_TO_NODE.MAXIMUM_OUTGOING_ARCS loop
        DELETE (ASSIGN_TO_NODE.OUTGOING_ARCS (INDEX));
        end loop;
    end if;

    declare
        TO_INDEX : NATURAL := 0;
    begin
        for FROM_INDEX in ASSIGN_FROM_NODE.INCOMING_ARCS'RANGE loop
        if ASSIGN_FROM_NODE.INCOMING_ARCS (FROM_INDEX) /= null then
            TO_INDEX := TO_INDEX + 1;
            ASSIGN_TO_NODE.INCOMING_ARCS (TO_INDEX) :=
              ASSIGN_FROM_NODE.INCOMING_ARCS (FROM_INDEX);
            ASSIGN_TO_NODE.INCOMING_ARCS (TO_INDEX).all :=
              ASSIGN_FROM_NODE.INCOMING_ARCS (FROM_INDEX).all;
        end if;
        end loop;

        for FROM_INDEX in ASSIGN_FROM_NODE.OUTGOING_ARCS'RANGE loop
        if ASSIGN_FROM_NODE.OUTGOING_ARCS (FROM_INDEX) /= null then
            TO_INDEX := TO_INDEX + 1;
            ASSIGN_TO_NODE.OUTGOING_ARCS (TO_INDEX) :=
              ASSIGN_FROM_NODE.OUTGOING_ARCS (FROM_INDEX);
            ASSIGN_TO_NODE.OUTGOING_ARCS (TO_INDEX).all :=
              ASSIGN_FROM_NODE.OUTGOING_ARCS (FROM_INDEX).all;
        end if;
        end loop;
    end;
    exception
    when CONSTRAINT_ERROR =>
        if ASSIGN_FROM_NODE = null then
        raise ASSIGN_FROM_NODE_DOES_NOT_EXIST;

        elsif ASSIGN_TO_NODE.MAXIMUM_INCOMING_ARCS <
          ASSIGN_FROM_NODE.MAXIMUM_INCOMING_ARCS then
        raise NOT_ENOUGH_INCOMING_ARC_SLOTS_SPECIFIED;

        elsif ASSIGN_TO_NODE.MAXIMUM_OUTGOING_ARCS <
          ASSIGN_FROM_NODE.MAXIMUM_OUTGOING_ARCS then
        raise NOT_ENOUGH_OUTGOING_ARC_SLOTS_SPECIFIED;
        end if;
    end ASSIGN_VALUE;


    function ARC (WITH_TAIL : NODE_TYPE;
          WITH_HEAD : NODE_TYPE) return ARC_LIST_TYPE is
    TIP_NODE   : NODE_TYPE renames WITH_HEAD;
    TAIL_NODE  : NODE_TYPE renames WITH_TAIL;
    ARC_LIST   : constant ARC_LIST_TYPE :=
             OUTGOING_ARCS (ON_NODE => TAIL_NODE);
    TEMP_LIST  : ARC_LIST_TYPE (ARC_LIST'RANGE);
    TEMP_INDEX : INTEGER range ARC_LIST'FIRST .. ARC_LIST'LAST :=
             ARC_LIST'FIRST;
    begin

    for INDEX in ARC_LIST'RANGE loop

        if TIP_NODE = HEAD_NODE (OF_ARC => ARC_LIST (INDEX)) then
        TEMP_LIST (TEMP_INDEX) := ARC_LIST (INDEX);
        end if;
    end loop;

    if TEMP_LIST (TEMP_LIST'FIRST) /= null then
        return TEMP_LIST (TEMP_LIST'FIRST .. TEMP_LIST'LAST);
    else
        raise ARC_DOES_NOT_CONNECT_THESE_NODES;
    end if;
    end ARC;

    procedure ASSIGN (VALUE : NODE_DATA_TYPE; TO_NODE : NODE_TYPE) is
    begin
    TO_NODE.VALUE := VALUE;
    exception
    when CONSTRAINT_ERROR =>
        raise NODE_DOES_NOT_EXIST;
    end ASSIGN;

    procedure ASSIGN (VALUE : ARC_DATA_TYPE; TO_ARC : ARC_TYPE) is
    begin
    TO_ARC.VALUE := VALUE;
    exception
    when CONSTRAINT_ERROR =>
        raise ARC_DOES_NOT_EXIST;
    end ASSIGN;

    function INCOMING_ARCS (ON_NODE : NODE_TYPE) return ARC_LIST_TYPE is
    NODE  : NODE_TYPE renames ON_NODE;
    TEMP  : ARC_LIST_TYPE (1 .. NODE.MAXIMUM_INCOMING_ARCS);
    INDEX : NATURAL := 0;
    begin
    for I in NODE.INCOMING_ARCS'RANGE loop
        if NODE.INCOMING_ARCS (I) /= null then
        INDEX := INDEX + 1;
        TEMP (INDEX) := NODE.INCOMING_ARCS (I);
        end if;
    end loop;

    return TEMP (1 .. INDEX);
    exception
    when CONSTRAINT_ERROR =>
        raise NODE_DOES_NOT_EXIST;
    end INCOMING_ARCS;

    function OUTGOING_ARCS (ON_NODE : NODE_TYPE) return ARC_LIST_TYPE is
    NODE  : NODE_TYPE renames ON_NODE;
    TEMP  : ARC_LIST_TYPE (1 .. NODE.MAXIMUM_OUTGOING_ARCS);
    INDEX : NATURAL := 0;
    begin
    for I in NODE.OUTGOING_ARCS'RANGE loop
        if NODE.OUTGOING_ARCS (I) /= null then
        INDEX := INDEX + 1;
        TEMP (INDEX) := NODE.OUTGOING_ARCS (I);
        end if;
    end loop;

    return TEMP (1 .. INDEX);
    exception
    when CONSTRAINT_ERROR =>
        raise GRAPH_DOES_NOT_EXIST;
    end OUTGOING_ARCS;

    function NODES (ON_GRAPH : GRAPH_TYPE) return NODE_LIST_TYPE is
    GRAPH : GRAPH_TYPE renames ON_GRAPH;
    TEMP  : NODE_LIST_TYPE (1 .. GRAPH.MAX_NUMBER_OF_NODES);
    INDEX : NATURAL := 0;
    begin
    for I in GRAPH.NODE_LIST'RANGE loop
        if GRAPH.NODE_LIST (I) /= null then
        INDEX := INDEX + 1;
        TEMP (INDEX) := GRAPH.NODE_LIST (I);
        end if;
    end loop;

    return TEMP (1 .. INDEX);
    end NODES;


    function LIST_OF_SINKS (IN_GRAPH : GRAPH_TYPE) return NODE_LIST_TYPE is
    GRAPH     : GRAPH_TYPE renames IN_GRAPH;
    TEMP_LIST : NODE_LIST_TYPE (1 .. GRAPH.MAX_NUMBER_OF_NODES);
    INDEX     : NATURAL := 0;
    NODE_LIST : constant NODE_LIST_TYPE := NODES (ON_GRAPH => GRAPH);
    begin

    for NODE_INDEX in NODE_LIST'RANGE loop

        declare
        NODE : NODE_TYPE renames NODE_LIST (NODE_INDEX);
        begin
        if ((MAXIMUM_NUMBER_OF_OUTGOING_ARCS (NODE) = 0) or else
            (CURRENT_NUMBER_OF_OUTGOING_ARCS (NODE) = 0)) then
            INDEX := INDEX + 1;
            TEMP_LIST (INDEX) := NODE;
        end if;
        end;
    end loop;

    return TEMP_LIST (1 .. INDEX);
    end LIST_OF_SINKS;

    function LIST_OF_SOURCES (IN_GRAPH : GRAPH_TYPE) return NODE_LIST_TYPE is
    GRAPH     : GRAPH_TYPE renames IN_GRAPH;
    TEMP_LIST : NODE_LIST_TYPE (1 .. GRAPH.MAX_NUMBER_OF_NODES);
    INDEX     : NATURAL := 0;
    NODE_LIST : constant NODE_LIST_TYPE := NODES (ON_GRAPH => GRAPH);
    begin

    for NODE_INDEX in NODE_LIST'RANGE loop
        declare
        NODE : NODE_TYPE renames NODE_LIST (NODE_INDEX);
        begin
        if ((MAXIMUM_NUMBER_OF_INCOMING_ARCS (NODE) = 0) or else
            (CURRENT_NUMBER_OF_INCOMING_ARCS (NODE) = 0)) then
            INDEX := INDEX + 1;
            TEMP_LIST (INDEX) := NODE;
        end if;
        end;
    end loop;

    return TEMP_LIST (1 .. INDEX);
    end LIST_OF_SOURCES;

    function ANY_CYCLES (IN_GRAPH : GRAPH_TYPE) return BOOLEAN is
    GRAPH     : GRAPH_TYPE renames IN_GRAPH;
    VISITED   : NODE_LIST_TYPE (1 .. GRAPH.MAX_NUMBER_OF_NODES);
    INDEX     : NATURAL := 0;
    NODE_LIST : constant NODE_LIST_TYPE := NODES (ON_GRAPH => GRAPH);
    begin

    for NODE_INDEX in NODE_LIST'RANGE loop

        declare
        NODE : NODE_TYPE renames NODE_LIST (NODE_INDEX);
        begin
-- search for node in visited list
        for I in 1 .. INDEX loop
            if NODE = VISITED (I) then
            return TRUE;
            end if;
        end loop;
        -- node not visited yet...
        INDEX := INDEX + 1;
        VISITED (INDEX) := NODE;
        end;
    end loop;

    return FALSE;
    end ANY_CYCLES;

    procedure TOPSORT (NODE_LIST : in out NODE_LIST_TYPE) is
--Arrange nodelist into topological sort order.
    ZERO_COUNT : NODE_LIST_TYPE (NODE_LIST'RANGE);
    --set of nodes all of whose predecessors are in zero_count or
    -- sorted_nodes.

    SORTED_NODES          : NODE_LIST_TYPE (NODE_LIST'RANGE); --builds up
                                  -- the
                                  -- topological
                                  -- sort

    Z_INSERT, Z_DELETE, S : INTEGER := 0; --indices to zero_count and
                          -- sorted_nodes.
    NUMBER_NON_NULL_NODES : INTEGER := 0;

    begin
    for I in NODE_LIST'RANGE loop
        if NODE_LIST (I) /= null then
        NUMBER_NON_NULL_NODES := NUMBER_NON_NULL_NODES + 1;
        NODE_LIST (I).TOPSORT_COUNT :=
          CURRENT_NUMBER_OF_INCOMING_ARCS (NODE_LIST (I));

        if NODE_LIST (I).TOPSORT_COUNT = 0 then
            Z_INSERT := Z_INSERT + 1;
            ZERO_COUNT (Z_INSERT) := NODE_LIST (I);
        end if;
        end if;
    end loop;

    while Z_DELETE < Z_INSERT loop
        --main loop;  select a node from zero_count, move it to
        -- sorted_nodes, and
        --decrement the topsort_count fields of all nodes it points to.
        S := S + 1;
        Z_DELETE := Z_DELETE + 1;
        SORTED_NODES (S) := ZERO_COUNT (Z_DELETE);

        for J in SORTED_NODES (S).OUTGOING_ARCS'RANGE loop
        if SORTED_NODES (S).OUTGOING_ARCS (J) /= null then
            SORTED_NODES (S).OUTGOING_ARCS (J).HEAD_NODE
             .TOPSORT_COUNT :=
              SORTED_NODES (S).OUTGOING_ARCS (J).HEAD_NODE
               .TOPSORT_COUNT - 1;

            if SORTED_NODES (S).OUTGOING_ARCS (J).HEAD_NODE
            .TOPSORT_COUNT = 0 then
            Z_INSERT := Z_INSERT + 1;
            ZERO_COUNT (Z_INSERT) :=
              SORTED_NODES (S).OUTGOING_ARCS (J).HEAD_NODE;
            end if;
        end if;
        end loop;
    end loop;
    --main while loop

    if S < NUMBER_NON_NULL_NODES then
        raise CYCLE_EXISTS;
    else
        NODE_LIST := SORTED_NODES;
    end if;

    end TOPSORT;

end GRAPHS;





with TEXT_IO;

package PERT_IO is

-- This package is used to read and write the text Activity File. The package
-- spec contains types for the records describing the activities, the records
-- describing the file header, and functions for reading and writting to the
-- Activity File.

    subtype NAME_TYPE is STRING (10 .. 41);
    subtype CODE_TYPE is STRING (1 .. 8);

    type INPUT_LINE_RECORD_TYPE is
    record
        WBS_CODE      : CODE_TYPE;
        ACTIVITY_NAME : NAME_TYPE;
        TAIL_NODE     : INTEGER;
        HEAD_NODE     : INTEGER;
        OPTIMISTICS   : FLOAT;
        MOST_LIKELY   : FLOAT;
        PESSIMISTICS  : FLOAT;
        STAFFING      : FLOAT;
        RATE          : FLOAT;
    end record;


    subtype LENGTH_RANGE is INTEGER range 1 .. 132;

    type HEADER_LINE_TYPE (LENGTH : LENGTH_RANGE := 1) is
    record
        VALUE : STRING (1 .. LENGTH);
    end record;

    NUMBER_OF_HEADER_RECORDS : constant := 5;

    type HEADER_BUFFER_ARRAY is array (1 .. NUMBER_OF_HEADER_RECORDS)
                       of HEADER_LINE_TYPE;


    procedure READ_HEADER (FROM_FILE  : TEXT_IO.FILE_TYPE;
               HEADER_SET : out HEADER_BUFFER_ARRAY);


    procedure WRITE_HEADER
         (TO_FILE    : TEXT_IO.FILE_TYPE := TEXT_IO.CURRENT_OUTPUT;
          HEADER_SET : HEADER_BUFFER_ARRAY);


    procedure READ_ONE_ACTIVITY_LINE (FROM_FILE : TEXT_IO.FILE_TYPE;
                      A_RECORD  : out INPUT_LINE_RECORD_TYPE);


    procedure WRITE_ONE_LINE
         (TO_FILE  : TEXT_IO.FILE_TYPE := TEXT_IO.CURRENT_OUTPUT;
          A_RECORD : INPUT_LINE_RECORD_TYPE);



    ACTIVITY_FILE_IS_NOT_OPEN    : exception;
    END_OF_ACTIVITY_FILE_REACHED : exception;
    ACTIVITY_FILE_IS_READ_ONLY   : exception;
    BAD_DATA                     : exception;
    VALUE_OUTSIDE_LEGAL_RANGE    : exception;



end PERT_IO;





-- This is the package body for the PERT_IO package. It contains the
-- the procedures bodies of the procedures given in the spec. No internal
-- procedures are needed.

package body PERT_IO is


    procedure READ_HEADER (FROM_FILE  : TEXT_IO.FILE_TYPE;
               HEADER_SET : out HEADER_BUFFER_ARRAY) is

    ACTIVITY_FILE  : TEXT_IO.FILE_TYPE renames FROM_FILE;
    INPUT_LINE     : STRING (LENGTH_RANGE);
    INPUT_LINE_END : POSITIVE;

    begin
    for I in 1 .. NUMBER_OF_HEADER_RECORDS loop
        TEXT_IO.GET_LINE (ACTIVITY_FILE, INPUT_LINE, INPUT_LINE_END);
        HEADER_SET (I) := (INPUT_LINE_END,
                   INPUT_LINE (1 .. INPUT_LINE_END));
    end loop;

    exception
    when TEXT_IO.STATUS_ERROR =>
        raise ACTIVITY_FILE_IS_NOT_OPEN;

    when TEXT_IO.END_ERROR =>
        raise END_OF_ACTIVITY_FILE_REACHED;

    end READ_HEADER;



    procedure WRITE_HEADER
         (TO_FILE    : TEXT_IO.FILE_TYPE := TEXT_IO.CURRENT_OUTPUT;
          HEADER_SET : HEADER_BUFFER_ARRAY) is

    ACTIVITY_FILE : TEXT_IO.FILE_TYPE renames TO_FILE;

    begin
    for I in 1 .. NUMBER_OF_HEADER_RECORDS loop
        TEXT_IO.PUT_LINE (ACTIVITY_FILE, HEADER_SET (I).VALUE);
    end loop;

    exception
    when TEXT_IO.STATUS_ERROR =>
        raise ACTIVITY_FILE_IS_NOT_OPEN;

    when TEXT_IO.MODE_ERROR =>
        raise ACTIVITY_FILE_IS_READ_ONLY;

    end WRITE_HEADER;



    procedure READ_ONE_ACTIVITY_LINE (FROM_FILE : TEXT_IO.FILE_TYPE;
                      A_RECORD  : out INPUT_LINE_RECORD_TYPE) is

    ACTIVITY_FILE : TEXT_IO.FILE_TYPE renames FROM_FILE;

    package INT_IO is new TEXT_IO.INTEGER_IO (INTEGER);
    package FLT_IO is new TEXT_IO.FLOAT_IO (FLOAT);

    begin
    TEXT_IO.GET (ACTIVITY_FILE, A_RECORD.WBS_CODE);
    TEXT_IO.SET_COL (ACTIVITY_FILE, 10);
    TEXT_IO.GET (ACTIVITY_FILE, A_RECORD.ACTIVITY_NAME);
    INT_IO.GET (ACTIVITY_FILE, A_RECORD.TAIL_NODE);
    INT_IO.GET (ACTIVITY_FILE, A_RECORD.HEAD_NODE);
    FLT_IO.GET (ACTIVITY_FILE, A_RECORD.OPTIMISTICS);
    FLT_IO.GET (ACTIVITY_FILE, A_RECORD.MOST_LIKELY);
    FLT_IO.GET (ACTIVITY_FILE, A_RECORD.PESSIMISTICS);
    FLT_IO.GET (ACTIVITY_FILE, A_RECORD.STAFFING);
    FLT_IO.GET (ACTIVITY_FILE, A_RECORD.RATE);

    exception
    when TEXT_IO.STATUS_ERROR =>
        raise ACTIVITY_FILE_IS_NOT_OPEN;

    when TEXT_IO.END_ERROR =>
        raise END_OF_ACTIVITY_FILE_REACHED;

    when TEXT_IO.DATA_ERROR =>
        raise BAD_DATA;

    when CONSTRAINT_ERROR =>
        raise VALUE_OUTSIDE_LEGAL_RANGE;

    end READ_ONE_ACTIVITY_LINE;



    procedure WRITE_ONE_LINE
         (TO_FILE  : TEXT_IO.FILE_TYPE := TEXT_IO.CURRENT_OUTPUT;
          A_RECORD : INPUT_LINE_RECORD_TYPE) is

    ACTIVITY_FILE : TEXT_IO.FILE_TYPE renames TO_FILE;

    package INT_IO is new TEXT_IO.INTEGER_IO (INTEGER);
    package FLT_IO is new TEXT_IO.FLOAT_IO (FLOAT);

    begin
    TEXT_IO.PUT (ACTIVITY_FILE, A_RECORD.WBS_CODE);
    TEXT_IO.PUT (ACTIVITY_FILE, " ");
    TEXT_IO.PUT (ACTIVITY_FILE, A_RECORD.ACTIVITY_NAME);
    TEXT_IO.PUT (ACTIVITY_FILE, " ");
    INT_IO.PUT (ACTIVITY_FILE, A_RECORD.TAIL_NODE, WIDTH => 4);
    TEXT_IO.PUT (ACTIVITY_FILE, " ");
    INT_IO.PUT (ACTIVITY_FILE, A_RECORD.HEAD_NODE, WIDTH => 4);
    TEXT_IO.PUT (ACTIVITY_FILE, " ");
    FLT_IO.PUT
       (ACTIVITY_FILE, A_RECORD.OPTIMISTICS, EXP => 0, FORE => 3, AFT => 1);
    TEXT_IO.PUT (ACTIVITY_FILE, " ");
    FLT_IO.PUT
       (ACTIVITY_FILE, A_RECORD.MOST_LIKELY, EXP => 0, FORE => 3, AFT => 1);
    TEXT_IO.PUT (ACTIVITY_FILE, " ");
    FLT_IO.PUT
       (ACTIVITY_FILE, A_RECORD.PESSIMISTICS, EXP => 0, FORE => 3,
        AFT => 1);
    TEXT_IO.PUT (ACTIVITY_FILE, " ");
    FLT_IO.PUT
       (ACTIVITY_FILE, A_RECORD.STAFFING, EXP => 0, FORE => 2, AFT => 1);
    TEXT_IO.PUT (ACTIVITY_FILE, " ");
    FLT_IO.PUT
       (ACTIVITY_FILE, A_RECORD.RATE, EXP => 0, FORE => 7, AFT => 1);

    TEXT_IO.NEW_LINE;

    exception
    when TEXT_IO.STATUS_ERROR =>
        raise ACTIVITY_FILE_IS_NOT_OPEN;

    when TEXT_IO.MODE_ERROR =>
        raise ACTIVITY_FILE_IS_READ_ONLY;

    end WRITE_ONE_LINE;



end PERT_IO;




package FILE_HANDLER is


-----------------------------------------------------------
-- Author:     T. C. Bryan/Ken Lamarche
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :     May 25 1985
-- Summary:    This function prompts users for a string
--   of a specified length required by the SIMPERT run.
--   Example -  a file name, a title for a report, etc.
-----------------------------------------------------------

    type OUTFILES is (TOUT, ACT, NODE, MAN, BARIN);

    subtype LENGTH_RANGE is INTEGER range 1 .. 132;

    type OUTFILE_NAME_TYPE (LENGTH : LENGTH_RANGE := 1) is
    record
        VALUE : STRING (1 .. LENGTH);
    end record;
    type OUTFILE_ARRAY_TYPE is array (OUTFILES) of OUTFILE_NAME_TYPE;

    OUTFILE_ARRAY : constant OUTFILE_ARRAY_TYPE :=
            (TOUT  => (8, "tout.tem"),
             ACT   => (7, "act.tem"),
             NODE  => (8, "node.tem"),
             MAN   => (12, "manpower.tem"),
             BARIN => (9, "barin.tem"));


    procedure VERIFY_OUTPUT;


    function VERIFY_LABEL
            (WITH_PROMPT     : STRING := "ENTER a string of characters";
         LENGTH_OF_LABEL : INTEGER := 80;
         STRING_TYPE     : STRING := "string") return STRING;



    function VERIFY_INPUT (FILE_PROMPT          : STRING;
               MAX_FILE_NAME_LENGTH : INTEGER) return STRING;



    STOP_ON_USER_REQUEST     : exception;
    END_FILE_HANDLER_REQUEST : exception;


end FILE_HANDLER;




with TEXT_IO,
     SCREEN_IO,
     FILE_OPS;


package body FILE_HANDLER is

-----------------------------------------------------------
-- Author:     T. C. Bryan/Ken Lamarche
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :     May 25 1985
-- Summary:    This package contains subprograms handling
--             verification of input and output files used
--             by SIMPERT.
-----------------------------------------------------------


    type YESNO_TYPE is (Y, YE, YES, N, NO, NONE);

    function RETURN_YESNO is new SCREEN_IO.RETURNED_ENUMERATION (YESNO_TYPE);

    ERROR_INDENTATION : TEXT_IO.COUNT := 15;




-----------------------------------------------------------
-- Author:     T. C. Bryan/Ken Lamarche
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :     May 25 1985
-- Summary:    This procedure verifies the output files
--             created in the SIMPERT run. It allows user
--             to save output files from previous SIMPERT run,
--             and assure that the output files can be created.
-----------------------------------------------------------
    procedure VERIFY_OUTPUT is

    GO_AHEAD : BOOLEAN := TRUE;

    STOP_FILES_EXIST : exception;


    -- Attempts to create the output files (with no content).
    procedure CREATE_OUTPUT_FILES is
    begin
        for I in OUTFILES loop
        declare
            THE_OUTPUT_FILE : TEXT_IO.FILE_TYPE;
        begin
            FILE_OPS.OPEN
               (THE_FILE         => THE_OUTPUT_FILE,
            WITH_NAME        => OUTFILE_ARRAY (I).VALUE,
            TO_MODE          => TEXT_IO.IN_FILE,
            CREATION_ENABLED => TRUE);

            TEXT_IO.DELETE (THE_OUTPUT_FILE);


        exception

            when FILE_OPS.SYSTEM_CANNOT_CREATE_FILE =>
            TEXT_IO.NEW_LINE;
            TEXT_IO.PUT_LINE ("INPUT ERROR:");

            TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
            TEXT_IO.PUT_LINE
               ("Program cannot create [" &
                OUTFILE_ARRAY (I).VALUE & "]");
            TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
            TEXT_IO.PUT_LINE ("due to an access problem.");
            TEXT_IO.NEW_LINE;
            raise END_FILE_HANDLER_REQUEST;

            when FILE_OPS.FILE_ALREADY_OPEN =>
            TEXT_IO.NEW_LINE;
            TEXT_IO.PUT_LINE ("INPUT ERROR:");

            TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
            TEXT_IO.PUT_LINE
               ("[" & OUTFILE_ARRAY (I).VALUE &
                "] is currently in use.");

            TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
            TEXT_IO.PUT_LINE ("Program cannot access it");
            TEXT_IO.NEW_LINE;
            raise END_FILE_HANDLER_REQUEST;

        end;
        end loop;
    end CREATE_OUTPUT_FILES;

    begin

    for I in OUTFILES loop
        if FILE_OPS.FILE_EXISTS (WITH_NAME => OUTFILE_ARRAY (I).VALUE) then
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT ("WARNING !!!  [" & OUTFILE_ARRAY (I).VALUE & "]");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE (" will be overwritten.  ");
        GO_AHEAD := FALSE;
        end if;
    end loop;

    if GO_AHEAD then
        CREATE_OUTPUT_FILES;
    else
        if (RETURN_YESNO
           (PROMPT     => ASCII.LF & ASCII.CR &
                  "Do you wish to CONTINUE?  (y/n) -->  ",
            DEFAULT    => NONE,
            FROM_VALUE => Y,
            TO_VALUE   => NO,
            ERROR_TEXT => ASCII.LF & ASCII.CR & "INPUT ERROR:  " &
                  "Answer must be either Y or N." & ASCII.LF &
                  ASCII.CR) in Y .. YES) then
        CREATE_OUTPUT_FILES;
        else
        raise STOP_FILES_EXIST;

        end if;
    end if;

    exception
    when STOP_FILES_EXIST =>
        raise STOP_ON_USER_REQUEST;

    end VERIFY_OUTPUT;



-----------------------------------------------------------
-- Author:     T. C. Bryan/Ken Lamarche
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :     May 25 1985
-- Summary:    This function prompts users for a string
--   of a specified length required by the SIMPERT run.
--   Example -  a file name, a title for a report, etc.
-----------------------------------------------------------
    function VERIFY_LABEL
            (WITH_PROMPT     : STRING := "ENTER a string of characters";
         LENGTH_OF_LABEL : INTEGER := 80;
         STRING_TYPE     : STRING := "string") return STRING is

    LABEL : constant STRING :=
        (SCREEN_IO.RETURNED_STRING
            (PROMPT  => ASCII.LF & ASCII.CR & WITH_PROMPT & ASCII.LF &
                ASCII.CR & ASCII.LF & ASCII.CR & "-->   ",
             CONFIRM => FALSE));
    begin
    if LABEL'LENGTH = 0 or LABEL'LENGTH > LENGTH_OF_LABEL then
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("INPUT ERROR:");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("The " & STRING_TYPE &
                  " required must be of length");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("1 to " & INTEGER'IMAGE (LENGTH_OF_LABEL) &
                  " characters. Please try again.");
        TEXT_IO.NEW_LINE;
        return (VERIFY_LABEL (WITH_PROMPT, LENGTH_OF_LABEL, STRING_TYPE));
    else
        return (LABEL);
    end if;
    end VERIFY_LABEL;



----------------------------------------------------------------------------
--  Summary
--     This function returns a file name that is free of text_io error
--     That is it assures the file with specified name exists and is accessible.
--     Although the function requires opening the file during checking its
--     status, it closes the file upon leaving, the user, therefore,
--     must re_open it prior to using.
--  Author:  T. C. Bryan
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
--  Date  :  May 25, 1985
----------------------------------------------------------------------------

    function VERIFY_INPUT (FILE_PROMPT          : STRING;
               MAX_FILE_NAME_LENGTH : INTEGER) return STRING is

    WORKING_FILE : TEXT_IO.FILE_TYPE;

    FILE_DOESNOT_EXIST : exception;



    -----------------------------------------------------------
    --
    -----------------------------------------------------------
    function GETNAME_AND_VERIFY_EXISTENCE return STRING is

        THE_FILE : constant STRING :=
               (VERIFY_LABEL
               (WITH_PROMPT     => FILE_PROMPT,
                LENGTH_OF_LABEL => MAX_FILE_NAME_LENGTH,
                STRING_TYPE     => "file name"));

    begin

        if FILE_OPS.FILE_EXISTS (WITH_NAME => THE_FILE) then
        return (THE_FILE);
        else
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("WARNING !!!");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("File [" & THE_FILE & "] not found.");
        TEXT_IO.NEW_LINE (2);

        if (RETURN_YESNO
               (PROMPT     => ASCII.LF & ASCII.CR &
                      "Do you wish to try again " &
                      "on another file name (y/n) -->  ",
            DEFAULT    => NONE,
            FROM_VALUE => Y,
            TO_VALUE   => NO,
            ERROR_TEXT => ASCII.LF & ASCII.CR & "INPUT ERROR:  " &
                      "Answer must be either Y or N." &
                      ASCII.LF & ASCII.CR)) in Y .. YES then
            return (GETNAME_AND_VERIFY_EXISTENCE);
        else
            return (" ");
        end if;
        end if;


    end GETNAME_AND_VERIFY_EXISTENCE;


    begin

    declare
        THE_FILE_NAME : constant STRING := GETNAME_AND_VERIFY_EXISTENCE;

    begin
        if THE_FILE_NAME = " " then
        raise FILE_DOESNOT_EXIST;
        end if;

        FILE_OPS.OPEN
           (THE_FILE         => WORKING_FILE,
        WITH_NAME        => THE_FILE_NAME,
        TO_MODE          => TEXT_IO.IN_FILE,
        CREATION_ENABLED => TRUE);

        TEXT_IO.CLOSE (WORKING_FILE);
        return (THE_FILE_NAME);

    exception
        when FILE_DOESNOT_EXIST =>
--TEXT_IO.NEW_LINE (2);
--TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
--TEXT_IO.PUT_LINE ("Program terminates on user request");
--TEXT_IO.NEW_LINE (2);
        return (" ");
        -- raise STOP_ON_USER_REQUEST;

        when FILE_OPS.SYSTEM_CANNOT_OPEN_FILE =>
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("INPUT ERROR:");

        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE
           ("[" & THE_FILE_NAME & "] cannot be accessed.");
        TEXT_IO.NEW_LINE (2);
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE
           ("A fatal error ocurred. Program cannot continue.");
        TEXT_IO.NEW_LINE (2);
        return (" ");
        -- raise END_FILE_HANDLER_REQUEST;

        when FILE_OPS.FILE_ALREADY_OPEN =>
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("INPUT ERROR:");

        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE
           ("[" & THE_FILE_NAME & "] is currently in use.");

        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("Program cannot access it");
        TEXT_IO.NEW_LINE (2);
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE
           ("A fatal error ocurred. Program cannot continue.");
        TEXT_IO.NEW_LINE (2);
        return (" ");
        -- raise END_FILE_HANDLER_REQUEST;

        when FILE_OPS.ILLEGAL_FILE_NAME =>
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("INPUT ERROR:");

        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("[" & THE_FILE_NAME & "] is an illegal name");
        TEXT_IO.NEW_LINE (2);

        if (RETURN_YESNO
               (PROMPT     => "Do you wish to try again" &
                      " on another file name (y/n) -->  " &
                      ASCII.LF & ASCII.CR,
            DEFAULT    => NONE,
            FROM_VALUE => Y,
            TO_VALUE   => NO,
            ERROR_TEXT => ASCII.LF & ASCII.CR & "INPUT ERROR:  " &
                      "Answer must be either Y or N.")) in
           Y .. YES then
            return (VERIFY_INPUT (FILE_PROMPT, MAX_FILE_NAME_LENGTH));

        else
            --TEXT_IO.NEW_LINE (2);
            --TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
            --TEXT_IO.PUT_LINE ("Program terminates on user request");
            --TEXT_IO.NEW_LINE (2);
            return (" ");
            -- raise STOP_ON_USER_REQUEST;
        end if;
    end;
    end VERIFY_INPUT;



end FILE_HANDLER;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--schedule.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_IO,
     MENU,
     PRESS_RETURN_TO_CONTINUE,
     FATAL;

procedure SCHEDULE is
-------------------------------------------------------------------------------
-- Author : M. McNair, L. Yelowitz
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date   : 28 May 1985
-- Summary:
--   This procedure is the main program to the NOSC Pert Model tools. It
--   calls the programs to create and modify files for Simpert, as well
--   as Simpert and Gantt. The constants
--   DISPLAY_HEIGHT and DISPLAY_WIDTH are used throughout both of
--   these programs. The modification of them here, will effect the
--   entire tool.
--
-------------------------------------------------------------------------------
    DISPLAY_HEIGHT : constant NATURAL := 24;
    DISPLAY_WIDTH  : constant NATURAL := 80;

    package MENU_OPS is new MENU (DISPLAY_WIDTH, DISPLAY_HEIGHT);

    TOP_LEVEL_MENU : constant MENU_OPS.ITEM_ARRAY_TYPE :=
             (1 => new STRING'("Create New Input File for Simpert"),
              2 => new STRING'("Modify Existing File for Simpert"),
              3 => new STRING'("Run Simpert"),
              4 => new STRING'("Run Gantt"),
              5 => new STRING'("Exit from Project Planning Tools."));
    -- top level menu

    TOP_LEVEL_TITLE : constant MENU_OPS.STRING_ACCESS_TYPE :=
              new STRING'("Project Planning Tools - Top Level Menu");
    -- top level menu title

    CHOICE : POSITIVE;
    -- menu choice of user

    procedure NEWFILE is separate;

    procedure MODIFY is separate;

    procedure PERT is separate;

    procedure OUT_GANTT is separate;  --change to OUT_GANTT for real



begin
    INITIAL_GREETING:
    begin
    -- This initial greeting has been localized here. To change what
    -- is seen, just modify the code in this block.
    TEXT_IO.NEW_PAGE;
    TEXT_IO.NEW_LINE (TEXT_IO.COUNT (DISPLAY_HEIGHT / 2 - 1));
    TEXT_IO.SET_COL (TEXT_IO.COUNT ((DISPLAY_WIDTH - 14) / 2));
    TEXT_IO.PUT_LINE ("Welcome to the");
    TEXT_IO.SET_COL (TEXT_IO.COUNT ((DISPLAY_WIDTH - 17) / 2));
    TEXT_IO.PUT_LINE ("Project Planning Tools.");
    delay 2.0;
    end INITIAL_GREETING;

    loop
    -- main program loop

    MENU_OPS.GET_MENU_VALUE
       (MENU_USED     => MENU_OPS.STRING_MENU (TOP_LEVEL_MENU),
        TITLE         => TOP_LEVEL_TITLE,
        CHOICE_CHOSEN => CHOICE);

    case CHOICE is
-- choice has been made - now branch accordingly
        when 1 =>
        NEWFILE;

        when 2 =>
        MODIFY;

        when 3 =>
        PERT;

        when 4 =>
        OUT_GANTT;

        when 5 =>
        exit;

        when others =>
        null;
    end case;

    delay 1.0;

    end loop;

    FINAL_GREETING:
    begin
    -- This block is similar to that which houses the intro. message.
    -- Make respective changes here.
    TEXT_IO.NEW_PAGE;
    TEXT_IO.NEW_LINE (TEXT_IO.COUNT (DISPLAY_HEIGHT / 2));
    TEXT_IO.SET_COL (TEXT_IO.COUNT ((DISPLAY_WIDTH - 42) / 2));
    TEXT_IO.PUT_LINE ("Thank you for using the Project Planning Tools.");
    end FINAL_GREETING;

exception
    when others =>
-- Throughout the tool, a FATAL procedure is available. This is
-- for debugging once the tool is in use. If an unexpected branch
-- in execution arises, this procedure will notify the user of
-- it.
    FATAL (UNIT => "SCHEDULE -- the main");
end SCHEDULE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--newfile.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_IO;
with SCREEN_IO,
     FILE_OPS;

separate (SCHEDULE)




----------------------------------------------------------------
-- Author:     T. C. Bryan
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :     April 1985
-- Summary:    This procedure creates a new input file for
--             SIMPERT run.
-----------------------------------------------------------------
procedure NEWFILE is

    subtype INT_NUM is INTEGER range 0 .. 1000000;

    package I_NUMBER is new TEXT_IO.INTEGER_IO (INT_NUM);

    subtype FLOAT_NUM is FLOAT range 0.0 .. 100_000.0;

    package F_NUMBER is new TEXT_IO.FLOAT_IO (FLOAT_NUM);

    MAXIMUM_NUMBER_OF_ACTIVITIES                : constant INTEGER := 4000;
    MAXIMUM_NUMBER_OF_NODES                     : constant INTEGER := 3400;
    MAXIMUM_NUMBER_OF_IN_OUT_NODES              : constant INTEGER := 25;
    MAXIMUM_NUMBER_OF_ACTIVITY_IN_CRITICAL_PATH : constant INTEGER := 2000;
    MAXIMUM_NUMBER_OF_NAME_NODES                : constant INTEGER := 9999;

    MAX_ERROR   : exception;
    END_NEWFILE : exception;


    UNITS            : STRING (1 .. 1) := " ";
    CONTINUE_OR_STOP : STRING (1 .. 1) := " ";

    type GO_OR_STOP is (S, STOP, CONTINUE, C);
    -------------------------------------------------------
    -- newly created INFILE = THE_NEWFILE_NAME(1..LAST_CHAR_OF_FILENAME)
    -------------------------------------------------------
    MAX_ACT_CODE          : constant INTEGER := 8;
    MAX_ACT_NAME          : constant INTEGER := 32;
    MAX_LINE              : constant INTEGER := 80;
    THE_NEWFILE_NAME      : STRING (1 .. MAX_LINE);
    MAX_FILE_NAME         : constant INTEGER := 32;
    LAST_CHAR_OF_FILENAME : NATURAL;
    THE_NEW_FILE          : TEXT_IO.FILE_TYPE;

    MAX_YEAR              : constant INTEGER := 99;
    KDAY, KMON, KYR       : INTEGER := 1;

    ACTIVITY_CODE         : STRING (1 .. MAX_LINE);
    CODE_LAST             : NATURAL;
    ACTIVITY_NAME         : STRING (1 .. MAX_LINE);
    NAME_LAST             : NATURAL;
    ERROR_INDENTATION     : TEXT_IO.COUNT := 15;




    -------------------------------------------------------
    -- function receives an integer within the range
    -- start_integer .. end_integer
    -------------------------------------------------------
    function RETURN_INTEGER (INPUT_PROMPT  : STRING;
                 START_INTEGER : INTEGER := 0;
                 END_INTEGER   : INTEGER := 0) return INTEGER is


    begin
    return SCREEN_IO.RETURNED_INTEGER
          (PROMPT     => ASCII.LF & ASCII.CR & INPUT_PROMPT &
                 ASCII.LF & ASCII.CR,
           FROM_VALUE => START_INTEGER,
           TO_VALUE   => END_INTEGER,
           CONFIRM    => FALSE,
           ERROR_TEXT =>
             ASCII.LF & ASCII.CR &
             "INPUT ERROR:   Program expects an integer number " &
             "within " & INTEGER'IMAGE (START_INTEGER) & " through " &
             INTEGER'IMAGE (END_INTEGER) & "." & ASCII.LF & ASCII.CR &
             "               Please try again." & ASCII.LF & ASCII.CR);
    end RETURN_INTEGER;



    -----------------------------------
    -- put out a welcome message
    -----------------------------------
    procedure WELCOME_MESSAGE is
    INDENTATION    : TEXT_IO.COUNT := 7;
    INDENT_FOR_MAX : TEXT_IO.COUNT := 50;

    begin
    TEXT_IO.NEW_PAGE;
    TEXT_IO.NEW_LINE (5);
    TEXT_IO.SET_COL (TO => INDENTATION);
    TEXT_IO.PUT ("      Welcome to NEWFILE Version 1.0");

    TEXT_IO.NEW_LINE (3);
    TEXT_IO.SET_COL (TO => INDENTATION);
    TEXT_IO.PUT ("Network constraints for this version are:");

    TEXT_IO.NEW_LINE (2);
    TEXT_IO.SET_COL (TO => INDENTATION);
    TEXT_IO.PUT ("    Max number of activities (arcs)       =");
    TEXT_IO.SET_COL (TO => INDENT_FOR_MAX);
    I_NUMBER.PUT (MAXIMUM_NUMBER_OF_ACTIVITIES);

    TEXT_IO.NEW_LINE;
    TEXT_IO.SET_COL (TO => INDENTATION);
    TEXT_IO.PUT ("    Max number of nodes                   =");
    TEXT_IO.SET_COL (TO => INDENT_FOR_MAX);
    I_NUMBER.PUT (MAXIMUM_NUMBER_OF_NODES);

    TEXT_IO.NEW_LINE;
    TEXT_IO.SET_COL (TO => INDENTATION);
    TEXT_IO.PUT ("    Max number of in/out arcs at any node =");
    TEXT_IO.SET_COL (TO => INDENT_FOR_MAX);
    I_NUMBER.PUT (MAXIMUM_NUMBER_OF_IN_OUT_NODES);

    TEXT_IO.NEW_LINE;
    TEXT_IO.SET_COL (TO => INDENTATION);
    TEXT_IO.PUT ("    Max number of arcs in critical path   =");
    TEXT_IO.SET_COL (TO => INDENT_FOR_MAX);
    I_NUMBER.PUT (MAXIMUM_NUMBER_OF_ACTIVITY_IN_CRITICAL_PATH);

    TEXT_IO.NEW_LINE (5);
    TEXT_IO.SET_COL (TO => INDENTATION);
        PRESS_RETURN_TO_CONTINUE;
    TEXT_IO.NEW_PAGE;
    end WELCOME_MESSAGE;

    ----------------------------------------
    -- prompt the user for the time units
    -- Units is either in days or in weeks
    ----------------------------------------
    procedure SELECTION_DAYS_OR_WEEKS is

    type D_OR_W is (D, DAY, DAYS, W, WEEK, WEEKS, NONE);

    function RETURNED_DW is new SCREEN_IO.RETURNED_ENUMERATION (D_OR_W);

    THE_ANSWER : D_OR_W := NONE;


    begin

    while THE_ANSWER not in D .. WEEKS loop
        THE_ANSWER := RETURNED_DW
                 (PROMPT     =>
                ASCII.LF & ASCII.CR &
                "           <-- ENTER time units " &
                "(days = D, weeks = W)" & ASCII.CR,
                  DEFAULT    => NONE,
                  FROM_VALUE => D,
                  TO_VALUE   => WEEKS,
                  CONFIRM    => FALSE,
                  ERROR_TEXT =>
                ASCII.LF & ASCII.CR &
                "INPUT ERROR:  Answer must be either " &
                "D for days or W for weeks");
    end loop;

    TEXT_IO.NEW_LINE;

    declare
        TEMP_UNITS : constant STRING := D_OR_W'IMAGE (THE_ANSWER);
    begin
        UNITS (1) := TEMP_UNITS (TEMP_UNITS'FIRST);
    end;
    end SELECTION_DAYS_OR_WEEKS;


    -------------------------------------------
    -- continue or not continue !!!
    -------------------------------------------
    procedure SELECTION_CONTINUE_OR_STOP is

    function RETURNED_GS is new SCREEN_IO.RETURNED_ENUMERATION (GO_OR_STOP);

    THE_ANSWER : GO_OR_STOP;


    begin
    THE_ANSWER := RETURNED_GS
             (PROMPT     => ASCII.LF & ASCII.CR &
                    "ENTER 'C' to continue program " &
                    "or 'S' to stop it -->   ",
              ERROR_TEXT =>
                ASCII.LF & ASCII.CR &
                "INPUT ERROR:  Answer must be either C for " &
                "continue or S for stop  ");

    declare
        TEMP_UNITS : constant STRING := GO_OR_STOP'IMAGE (THE_ANSWER);

    begin
        CONTINUE_OR_STOP (1) := TEMP_UNITS (TEMP_UNITS'FIRST);
    end;

    end SELECTION_CONTINUE_OR_STOP;



    --------------------------------
    -- obtain a string from user
    --------------------------------
    procedure OBTAIN_NAME (WITH_PROMPT     : STRING := " ";
               THE_NAME        : out STRING;
               END_OF_THE_NAME : in out NATURAL;
               MAX_OF_THE_NAME : INTEGER := 8) is

    begin
    loop
        declare
        TEMP_NAME: constant STRING :=
              SCREEN_IO.RETURNED_STRING
                  (PROMPT  => ASCII.LF & ASCII.CR &
                            WITH_PROMPT &
                   ASCII.LF & ASCII.CR,
                   CONFIRM => FALSE);
        begin
        END_OF_THE_NAME := TEMP_NAME'LENGTH;
        THE_NAME(1..END_OF_THE_NAME) := TEMP_NAME;
        exit when END_OF_THE_NAME in 1 .. MAX_OF_THE_NAME;
            TEXT_IO.NEW_LINE;
            TEXT_IO.PUT_LINE ("INPUT ERROR:");

            TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
            TEXT_IO.PUT_LINE ("Name must be within 1 through " &
                  INTEGER'IMAGE (MAX_OF_THE_NAME) & " characters.");

            TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
            TEXT_IO.PUT_LINE ("Please try again.");
            TEXT_IO.NEW_LINE;
        end;
    end loop;

    end OBTAIN_NAME;


    -------------------------------------------
    -- create a user requested new simpert file
    -------------------------------------------
    procedure CREATEF is
    CONTINUE_CASE : GO_OR_STOP := C;

    begin
    -----------------------------------------------
    -- gets file name from the user and creates it...
    -----------------------------------------------

    TEXT_IO.NEW_LINE;
    OBTAIN_NAME
       (WITH_PROMPT     => "              <-- ENTER name of newfile" &
                   ASCII.CR,
        THE_NAME        => THE_NEWFILE_NAME,
        END_OF_THE_NAME => LAST_CHAR_OF_FILENAME,
        MAX_OF_THE_NAME => MAX_FILE_NAME);
    TEXT_IO.NEW_LINE;

    if FILE_OPS.FILE_EXISTS
          (WITH_NAME => THE_NEWFILE_NAME (1 .. LAST_CHAR_OF_FILENAME)) then

        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("WARNING!!!");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("File " &
                  THE_NEWFILE_NAME (1 .. LAST_CHAR_OF_FILENAME) &
                  " already exists");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE
           ("and will be overwritten.  Is it ok to continue?");
        SELECTION_CONTINUE_OR_STOP;

        if GO_OR_STOP'VALUE (CONTINUE_OR_STOP) = CONTINUE_CASE then
        TEXT_IO.CREATE
           (THE_NEW_FILE, TEXT_IO.OUT_FILE,
            THE_NEWFILE_NAME (1 .. LAST_CHAR_OF_FILENAME));
        TEXT_IO.CLOSE (THE_NEW_FILE);
        else
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("Program terminates per user request");
        TEXT_IO.NEW_LINE;
        raise END_NEWFILE;
        end if;
    end if;

    FILE_OPS.OPEN
       (THE_FILE         => THE_NEW_FILE,
        WITH_NAME        => THE_NEWFILE_NAME (1 .. LAST_CHAR_OF_FILENAME),
        TO_MODE          => TEXT_IO.OUT_FILE,
        CREATION_ENABLED => TRUE);
    ----------------------------------
    -- file exception handlers...
    ----------------------------------
    exception
    when FILE_OPS.SYSTEM_CANNOT_CREATE_FILE | FILE_OPS.ILLEGAL_FILE_NAME =>
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("INPUT ERROR:");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("Program cannot create " &
                  THE_NEWFILE_NAME (1 .. LAST_CHAR_OF_FILENAME));
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE
           ("due to an access problem or an illegal file name");
        raise END_NEWFILE;

    when FILE_OPS.FILE_ALREADY_OPEN =>
        TEXT_IO.PUT_LINE ("INPUT ERROR:");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE (THE_NEWFILE_NAME (1 .. LAST_CHAR_OF_FILENAME) &
                  " exists and is currently in use.");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("Program cannot create it");
        raise END_NEWFILE;




    end CREATEF;

    -----------------------------------------------
    -- promt user for a project start date .....
    -----------------------------------------------
    procedure STARTDATE is


    begin
       ----------------------------------------------------
       -- a loop used to assure that user only enters 8
       -- characters for start date which is in the form
       -- of dd/mm/yy where dd =< 31 days, mm =<12 months,
       -- and yy between rang 80..max_year; where max_year
       -- has been globally defined.  An example is 28/11/80
       ----------------------------------------------------

    loop
        declare
           START_DATE : constant STRING :=
              SCREEN_IO.RETURNED_STRING
                  (PROMPT  => ASCII.LF & ASCII.CR &
                           "dd/mm/yy    <-- ENTER Estimated Project " &
                   "start date" & ASCII.LF & ASCII.CR,
                   CONFIRM => FALSE);
        begin
        ----------------------------------------------------
        -- the inputted start date is parsed into
        -- dd, mm, yy string and inserted into three global
        -- variables named kday, kmon, and kyr respectively.
        ----------------------------------------------------

        KDAY := INTEGER'VALUE (START_DATE(1..2));
        KMON := INTEGER'VALUE (START_DATE(4..5));
        KYR  := INTEGER'VALUE (START_DATE(7..8));

            TEXT_IO.NEW_LINE;
            exit when START_DATE'LENGTH  = 8 and
              KDAY in 1 .. 31 and
              KMON in 1 .. 12 and KYR in 80 .. MAX_YEAR;

            TEXT_IO.PUT_LINE ("INPUT ERROR:");

            if START_DATE /= " " then
            TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
            TEXT_IO.PUT_LINE
               (START_DATE & "  is an incorrect response.");
            end if;

            TEXT_IO.NEW_LINE;
            TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
            TEXT_IO.PUT_LINE
               ("Start date needed must be in the form of dd/mm/yy.");

            TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
            TEXT_IO.PUT_LINE
               ("where [dd] is between 01..31 days, [mm] 01..12 months,");

            TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
            TEXT_IO.PUT ("and [yy] 80..");
            I_NUMBER.PUT (MAX_YEAR, WIDTH => 2);
            TEXT_IO.PUT_LINE (".  Please try again." & ASCII.LF & ASCII.CR);

        exception
            when others => null;
        end;
    end loop;
    end STARTDATE;



    ----------------------------------------------------------
    -- write input obtained to the newly created simpert file
    ----------------------------------------------------------
    procedure WRITEF is


    OPTIMISTICS                   : FLOAT;
    MOST_LIKELY                   : FLOAT;
    PESSIMISTICS                  : FLOAT;
    AVERAGE_NU                    : FLOAT;
    AVERAGE_COST                  : FLOAT;

    HEAD_NODE, TAIL_NODE          : INTEGER := 0;
    NUMBER_OF_ACTIVITIES_INPUTTED : INTEGER := 1;

    INPUT_COMPLETE                : BOOLEAN := FALSE;

    type DUMMIES is (DUMMY);



    -------------------------------------------------------
    -- writes global variables to the newly created file
    -------------------------------------------------------
    procedure WRITE_GLOBAL is
        PROG : constant STRING := "S";

    begin

        TEXT_IO.PUT_LINE (THE_NEW_FILE, PROG);
        TEXT_IO.PUT_LINE (THE_NEW_FILE, UNITS);
        I_NUMBER.PUT (THE_NEW_FILE, KDAY, WIDTH => 2);
        TEXT_IO.PUT (THE_NEW_FILE, " ");
        I_NUMBER.PUT (THE_NEW_FILE, KMON, WIDTH => 2);
        TEXT_IO.PUT (THE_NEW_FILE, " ");
        I_NUMBER.PUT (THE_NEW_FILE, KYR, WIDTH => 2);
        TEXT_IO.NEW_LINE (THE_NEW_FILE);
        TEXT_IO.PUT (THE_NEW_FILE,
             "  CODE        " &
             "ACTIVITY TITLE              TAIL HEAD ");
        TEXT_IO.PUT_LINE (THE_NEW_FILE,
                  "  OPTM  M.L.  PESS STAF $RATE/ODC");
        TEXT_IO.PUT (THE_NEW_FILE,
             "XXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX XXXX XXXX");
        TEXT_IO.PUT_LINE (THE_NEW_FILE,
                  "  XXX.X XXX.X XXX.X XX.X XXXXXXX.X");

    end WRITE_GLOBAL;

    -------------------------------------------------------
    -- function verifies string called "dummy" ...
    -------------------------------------------------------
    function IN_DUMMIES return BOOLEAN is
        D_TEMP : DUMMIES;


    begin
        D_TEMP := DUMMIES'VALUE (ACTIVITY_NAME (1 .. 5));
        return TRUE;
    exception
        when CONSTRAINT_ERROR =>  return FALSE;
    end IN_DUMMIES;




    -------------------------------------------------------
    -- prompt user for all estimates for one activity
    -- input data must be in float number ...
    -------------------------------------------------------
    procedure NEW_SIMPERT_LINE is


        function RETURN_ESTIMATE (INPUT_PROMPT : STRING;
                      BEGIN_AT     : FLOAT := 0.0;
                      LIMIT_FLOAT  : FLOAT := 999.90000)
                       return FLOAT is


        begin
        return SCREEN_IO.RETURNED_FLOAT
              (PROMPT     => ASCII.LF & ASCII.CR & INPUT_PROMPT &
                     ASCII.LF & ASCII.CR,
               FROM_VALUE => BEGIN_AT,
               CONFIRM    => FALSE,
               TO_VALUE   => LIMIT_FLOAT);

        end RETURN_ESTIMATE;


    begin

        OPTIMISTICS := RETURN_ESTIMATE
                  (INPUT_PROMPT =>
                 "XXX.X  <--ENTER optimistic (1%) " &
                 "time estimate");

        MOST_LIKELY := RETURN_ESTIMATE
                  (INPUT_PROMPT =>
                 "XXX.X  <--ENTER most likely (1%) " &
                 "time estimate");
        PESSIMISTICS := RETURN_ESTIMATE
                   (INPUT_PROMPT =>
                  "XXX.X  <--ENTER pessimistic (1%) " &
                  "time estimate");

        if OPTIMISTICS = 0.0 and
           MOST_LIKELY = 0.0 and PESSIMISTICS = 0.0 then
        AVERAGE_NU := 0.0;
        AVERAGE_COST := 0.0;
        else
        AVERAGE_NU := RETURN_ESTIMATE
                 (INPUT_PROMPT =>
                    "XX.X  <--ENTER average number of " &
                    "equivalent of full-time personnel",
                  LIMIT_FLOAT  => 99.90000);
        AVERAGE_COST :=
          RETURN_ESTIMATE
             (INPUT_PROMPT =>
            "XXXXXXX.X  <--ENTER average cost per " &
            "man-time unit",
              BEGIN_AT     => 1.0,
              LIMIT_FLOAT  => 999999.90000);
        end if;

    end NEW_SIMPERT_LINE;



    -------------------------------------------------------
    -- prompt user for activity name & node information
    -------------------------------------------------------
    procedure NAME_NODE_ENTRY is



-----------------------------------
-- accept input for one activity
-----------------------------------
        procedure TAKE_INPUT is

        begin

        ------------------------------------------
        -- NAME is a 32 character string
        -- ACTIVITY CODE is an 8 character string
        ------------------------------------------
        TEXT_IO.NEW_PAGE;
        TEXT_IO.NEW_LINE (2);

        TEXT_IO.SET_COL (TO => 15);
        TEXT_IO.PUT ("Activity [arc] number ");
        I_NUMBER.PUT (NUMBER_OF_ACTIVITIES_INPUTTED);
        TEXT_IO.NEW_LINE (2);

        OBTAIN_NAME
           (WITH_PROMPT     => "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  " &
                       "<-- ENTER name of activity",
            THE_NAME        => ACTIVITY_NAME,
            END_OF_THE_NAME => NAME_LAST,
            MAX_OF_THE_NAME => MAX_ACT_NAME);
        TEXT_IO.NEW_LINE;

        if IN_DUMMIES then
            CODE_LAST := 8;
            ACTIVITY_CODE (1 .. CODE_LAST) := (1 .. CODE_LAST => ' ');
        else
            TEXT_IO.NEW_LINE;
            OBTAIN_NAME
               (WITH_PROMPT     => "XXXXXXXX  <-- ENTER arc code [WBS]",
            THE_NAME        => ACTIVITY_CODE,
            END_OF_THE_NAME => CODE_LAST,
            MAX_OF_THE_NAME => MAX_ACT_CODE);
            TEXT_IO.NEW_LINE;
        end if;
        -------------------------------------------------------
        -- TAIL and HEAD nodes must be greater than zero .......
        -------------------------------------------------------
        TAIL_NODE := RETURN_INTEGER
                (INPUT_PROMPT  => "XXXX  <--ENTER tail node",
                 START_INTEGER => 1,
                 END_INTEGER   => MAXIMUM_NUMBER_OF_NAME_NODES);
        TEXT_IO.NEW_LINE;

        HEAD_NODE := RETURN_INTEGER
                (INPUT_PROMPT  => "XXXX  <--ENTER head node",
                 START_INTEGER => 1,
                 END_INTEGER   => MAXIMUM_NUMBER_OF_NAME_NODES);

        TEXT_IO.NEW_PAGE;
        --
        --   CHECK FOR STRING "DUMMY" IN FIRST 5 CHARACTERS of ACT .....
        --
        if IN_DUMMIES then
            OPTIMISTICS := 0.0;
            MOST_LIKELY := 0.0;
            PESSIMISTICS := 0.0;
            AVERAGE_NU := 0.0;
            AVERAGE_COST := 0.0;
            TEXT_IO.NEW_LINE (5);
        else
            TEXT_IO.NEW_LINE (3);
            TEXT_IO.SET_COL (TO => 10);
            TEXT_IO.PUT_LINE
               ("ENTER following parameters for activity:");

            TEXT_IO.SET_COL (TO => 14);
            TEXT_IO.PUT_LINE (ACTIVITY_NAME (1 .. NAME_LAST));
            TEXT_IO.NEW_LINE (3);
            --
            --          NEW FILE SIMPERT .....
            --
            -------------------------------------------------------
            -- MOST_LIKELY must be within the range of OPTI..PESSI
            -------------------------------------------------------
            NEW_SIMPERT_LINE;

            loop
            if OPTIMISTICS > MOST_LIKELY or
               MOST_LIKELY > PESSIMISTICS then
                TEXT_IO.NEW_LINE;
                TEXT_IO.PUT_LINE ("INPUT ERROR:");

                TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
                TEXT_IO.PUT_LINE
                   ("Relative size of input is inconsistent.");
                TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
                TEXT_IO.PUT_LINE
                    ("Optimistics must be <= most likely " &
                    " <= pessimistic");

                TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
                TEXT_IO.PUT_LINE ("Please try again.");
                TEXT_IO.NEW_LINE (2);
                NEW_SIMPERT_LINE;
            else
                exit;
            end if;
            end loop;
        end if;

        end TAKE_INPUT;


    begin
        TAKE_INPUT;

        loop
        declare
            LOOP_ANSWER : constant STRING :=
                  SCREEN_IO.RETURNED_STRING
                     (PROMPT =>
                    ASCII.LF & ASCII.CR &
                    "ENTER [r] to RE_ENTER parameters " &
                    "for this activity," & ASCII.LF &
                    ASCII.CR &
                    "or [s] for STOP inputting, or press " &
                    "RETURN to continue ....." &
                    ASCII.LF & ASCII.CR);

        begin

            if LOOP_ANSWER = "r" or LOOP_ANSWER = "R" then
            TAKE_INPUT;

            elsif LOOP_ANSWER = "s" or LOOP_ANSWER = "S" then
            INPUT_COMPLETE := TRUE;
            exit;

            elsif LOOP_ANSWER = "" then
            exit;
            else
            TEXT_IO.NEW_LINE;
            TEXT_IO.PUT_LINE ("INPUT ERROR:  Please try again.");
            TEXT_IO.NEW_LINE;
            end if;
        end;
        end loop;

        TEXT_IO.NEW_LINE (1);
    end NAME_NODE_ENTRY;




    begin
    --   MAIN
    WRITE_GLOBAL;

    for I in 1 .. MAXIMUM_NUMBER_OF_ACTIVITIES loop
        --
        --          READ ACTIVITY NAME & NODE NUMBERS FROM SCREEN .....
        --

        NAME_NODE_ENTRY;

        -----------------### text_io limitation ### ----------------

        -- when text_io.float_io.put encounters the float value 0.0
        -- it puts out the sequence 0.^A .  In order to make up
        -- for this limitation, the program is coded so that the string
        -- "0.0" will be printed in lieu when such condition is met.

        --------------- ### end text_io limitation ### --------------


        TEXT_IO.PUT (THE_NEW_FILE, ACTIVITY_CODE (1 .. CODE_LAST));

        TEXT_IO.SET_COL (THE_NEW_FILE, TO => 10);
        TEXT_IO.PUT (THE_NEW_FILE, ACTIVITY_NAME (1 .. NAME_LAST));

        TEXT_IO.SET_COL (THE_NEW_FILE, TO => 43);
        I_NUMBER.PUT (THE_NEW_FILE, TAIL_NODE, WIDTH => 4);

        TEXT_IO.SET_COL (THE_NEW_FILE, TO => 48);
        I_NUMBER.PUT (THE_NEW_FILE, HEAD_NODE, WIDTH => 4);

        TEXT_IO.SET_COL (THE_NEW_FILE, TO => 54);

        if OPTIMISTICS = 0.0 then
        TEXT_IO.PUT (THE_NEW_FILE, "  0.0");
        else
        F_NUMBER.PUT
           (THE_NEW_FILE, OPTIMISTICS, EXP => 0, FORE => 3, AFT => 1);
        end if;

        TEXT_IO.SET_COL (THE_NEW_FILE, TO => 60);

        if MOST_LIKELY = 0.0 then
        TEXT_IO.PUT (THE_NEW_FILE, "  0.0");
        else
        F_NUMBER.PUT
           (THE_NEW_FILE, MOST_LIKELY, EXP => 0, FORE => 3, AFT => 1);
        end if;

        TEXT_IO.SET_COL (THE_NEW_FILE, TO => 66);

        if PESSIMISTICS = 0.0 then
        TEXT_IO.PUT (THE_NEW_FILE, "  0.0");
        else
        F_NUMBER.PUT
           (THE_NEW_FILE, PESSIMISTICS, EXP => 0, FORE => 3, AFT => 1);
        end if;

        TEXT_IO.SET_COL (THE_NEW_FILE, TO => 72);

        if AVERAGE_NU = 0.0 then
        TEXT_IO.PUT (THE_NEW_FILE, " 0.0");
        else
        F_NUMBER.PUT
           (THE_NEW_FILE, AVERAGE_NU, EXP => 0, FORE => 2, AFT => 1);
        end if;

        TEXT_IO.SET_COL (THE_NEW_FILE, TO => 77);

        if AVERAGE_COST = 0.0 then
        TEXT_IO.PUT (THE_NEW_FILE, "      0.0");
        else
        F_NUMBER.PUT
           (THE_NEW_FILE, AVERAGE_COST, EXP => 0, FORE => 7, AFT => 1);
        end if;

        TEXT_IO.NEW_LINE (THE_NEW_FILE);

        exit when INPUT_COMPLETE;
        NUMBER_OF_ACTIVITIES_INPUTTED := NUMBER_OF_ACTIVITIES_INPUTTED + 1;

    end loop;

    if NUMBER_OF_ACTIVITIES_INPUTTED > MAXIMUM_NUMBER_OF_ACTIVITIES then
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("NETWORK CONSTRAINT ERROR:");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT ("Number of activities exceeds the maximum limit of ");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        I_NUMBER.PUT (MAXIMUM_NUMBER_OF_ACTIVITIES);
        TEXT_IO.PUT (".   Program aborts.");
        TEXT_IO.NEW_LINE;
        TEXT_IO.CLOSE (THE_NEW_FILE);
        raise MAX_ERROR;
    end if;

    -------------------------
    -- error handlers
    -------------------------
    exception
    when MAX_ERROR =>
        raise END_NEWFILE;
    end WRITEF;


    -------------------------
    -- THE MAIN BODY OF NEWFILE
    -------------------------
begin
    --
    -- To screen: welcome statement and network constraints ...
    --
    WELCOME_MESSAGE;

    --
    -- Enter time units (D = days or W = weeks) ....
    --
    TEXT_IO.NEW_LINE (4);

    SELECTION_DAYS_OR_WEEKS;

    --
    -- Open new file to be generated .....
    --
    CREATEF;

    --
    -- Read estimated project start date from screen .....
    --
    STARTDATE;
    --
    -- New file simpert .....
    --
    WRITEF;
    --
    -- Close new file .....
    --
    TEXT_IO.CLOSE (THE_NEW_FILE);

exception
    when END_NEWFILE =>
        PRESS_RETURN_TO_CONTINUE;

    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " &
               "[NEWFILE]");

end NEWFILE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--modify.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_IO;
with SCREEN_IO,
     FILE_OPS;



separate (SCHEDULE)

------------------------------------------------------------------------
-- Author:     T.C. Bryan
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :     April 1985
-- Summary:    This procedure edits input files for
--             SIMPERT run.  Two major functions are add input data
--             to and/or delete from an existing input file.
--             This file is originally created by routine "newfile".
------------------------------------------------------------------------
procedure MODIFY is

    subtype INT_NUM is INTEGER range 0 .. 1000000;

    package I_NUMBER is new TEXT_IO.INTEGER_IO (INT_NUM);

    subtype FLOAT_NUM is FLOAT range 0.0 .. 100_000.0;

    package F_NUMBER is new TEXT_IO.FLOAT_IO (FLOAT_NUM);

    type YESNO_TYPE is (Y, YE, YES, N, NO, NONE);

    function RETURN_YESNO is new SCREEN_IO.RETURNED_ENUMERATION (YESNO_TYPE);

    YES_NO_ANSWER                               : YESNO_TYPE;

    MAXIMUM_NUMBER_OF_ACTIVITIES                : constant INTEGER := 4000;
    MAXIMUM_NUMBER_OF_NODES                     : constant INTEGER := 3400;
    MAXIMUM_NUMBER_OF_IN_OUT_NODES              : constant INTEGER := 25;
    MAXIMUM_NUMBER_OF_ACTIVITY_IN_CRITICAL_PATH : constant INTEGER := 2000;
    MAXIMUM_NUMBER_OF_NAME_NODES                : constant INTEGER := 9999;

    MAX_ACT_ERROR      : exception;
    BAD_DATA           : exception;
    END_PER_USER_ERROR : exception;
    END_MODIFY         : exception;


    type A_OR_D is (A, ADD, D, DELETE, NONE);

    REQUEST_FOR_DELETION : A_OR_D := D;
    REQUEST_FOR_ADDITION : A_OR_D := A;
    ADD_DELETE_ANSWER    : STRING (1 .. 1) := " ";

    MAX_LINE             : constant INTEGER := 80;
    MAX_ACT_CODE         : constant INTEGER := 8;
    MAX_ACT_NAME         : constant INTEGER := 32;

    type GO_OR_STOP is (S, STOP, CONTINUE, C);

    CONTINUE_OR_STOP  : STRING (1 .. 1) := " ";
    CONTINUE_CASE     : GO_OR_STOP := C;

    INPUT_FILE        : STRING (1 .. MAX_LINE);
    MAX_FILE_NAME     : constant INTEGER := 32;
    END_FILE_NAME     : NATURAL;
    USER_INPUT_FILE   : TEXT_IO.FILE_TYPE;

    ERROR_INDENTATION : TEXT_IO.COUNT := 15;

    VALID_DATA        : INTEGER;

    subtype LENGTH_RANGE is INTEGER range 1 .. 132;

    type HEADER_LINE_TYPE (LENGTH : LENGTH_RANGE := 1) is
    record
        VALUE : STRING (1 .. LENGTH);
    end record;
    type HEADER_BUFFER_ARRAY is array (1 .. 5) of HEADER_LINE_TYPE;

    FILE_HEADER : HEADER_BUFFER_ARRAY;

    type INPUT_LINE_RECORD_TYPE is

    record
        WBS_CODE      : STRING (1 .. 8);
        ACTIVITY_NAME : STRING (1 .. 32);
        TAIL_NODE     : INTEGER;
        HEAD_NODE     : INTEGER;
        OPTIMISTICS   : FLOAT;
        MOST_LIKELY   : FLOAT;
        PESSIMISTICS  : FLOAT;
        STAFFING      : FLOAT;
        RATE          : FLOAT;
    end record;

    CURRENT_INPUT_LINE : INPUT_LINE_RECORD_TYPE;
    type BODY_BUFFER_ARRAY_TYPE        is array (INTEGER range <>)
                         of INPUT_LINE_RECORD_TYPE;
    type BODY_BUFFER_ARRAY_ACCESS_TYPE is access BODY_BUFFER_ARRAY_TYPE;

    BODY_BUFFER_ARRAY         : BODY_BUFFER_ARRAY_ACCESS_TYPE :=
                new BODY_BUFFER_ARRAY_TYPE
                      (1 .. MAXIMUM_NUMBER_OF_ACTIVITIES);
    BODY_BUFFER_ARRAY_COUNTER : INTEGER;






    -----------------------------------------------------------
    -- read in 9 fields from a given input line and insert
    -- each field into appropriate place in the working buffer
    -----------------------------------------------------------
    procedure READ_ONE_ACTIVITY_LINE (FROM_FILE : TEXT_IO.FILE_TYPE;
                      A_RECORD  : out INPUT_LINE_RECORD_TYPE) is


    begin

    TEXT_IO.GET (FROM_FILE, A_RECORD.WBS_CODE);
    TEXT_IO.SET_COL (FROM_FILE, TO => 10);
    TEXT_IO.GET (FROM_FILE, A_RECORD.ACTIVITY_NAME);
    I_NUMBER.GET (FROM_FILE, A_RECORD.TAIL_NODE);
    I_NUMBER.GET (FROM_FILE, A_RECORD.HEAD_NODE);
    F_NUMBER.GET (FROM_FILE, A_RECORD.OPTIMISTICS);
    F_NUMBER.GET (FROM_FILE, A_RECORD.MOST_LIKELY);
    F_NUMBER.GET (FROM_FILE, A_RECORD.PESSIMISTICS);
    F_NUMBER.GET (FROM_FILE, A_RECORD.STAFFING);
    F_NUMBER.GET (FROM_FILE, A_RECORD.RATE);


    exception
    when TEXT_IO.DATA_ERROR =>
        raise BAD_DATA;

    end READ_ONE_ACTIVITY_LINE;



    --------------------------------------------------------
    -- write the value of elements in each record
    --------------------------------------------------------
    procedure WRITE_ONE_LINE
         (TO_FILE  : TEXT_IO.FILE_TYPE := TEXT_IO.CURRENT_OUTPUT;
          A_RECORD : INPUT_LINE_RECORD_TYPE) is

    begin
    -----------------### text_io limitation ### ----------------

    -- when text_io.float_io.put encounters the float value 0.0
    -- it puts out the sequence 0.^A .  In order to make up
    -- for this limitation, the program is coded so that the string
    -- "0.0" will be printed in lieu when such condition is met.

    --------------- ### end text_io limitation ### --------------


    TEXT_IO.PUT (TO_FILE, A_RECORD.WBS_CODE);

    TEXT_IO.SET_COL (TO_FILE, TO => 10);

    TEXT_IO.PUT (TO_FILE, A_RECORD.ACTIVITY_NAME);

    TEXT_IO.SET_COL (TO_FILE, TO => 43);
    I_NUMBER.PUT (TO_FILE, A_RECORD.TAIL_NODE, WIDTH => 4);

    TEXT_IO.SET_COL (TO_FILE, TO => 48);
    I_NUMBER.PUT (TO_FILE, A_RECORD.HEAD_NODE, WIDTH => 4);

    TEXT_IO.SET_COL (TO_FILE, TO => 54);

    if A_RECORD.OPTIMISTICS = 0.0 then
        TEXT_IO.PUT (TO_FILE, "  0.0");
    else
        F_NUMBER.PUT
           (TO_FILE, A_RECORD.OPTIMISTICS, EXP => 0, FORE => 3, AFT => 1);
    end if;

    TEXT_IO.SET_COL (TO_FILE, TO => 60);

    if A_RECORD.MOST_LIKELY = 0.0 then
        TEXT_IO.PUT (TO_FILE, "  0.0");
    else
        F_NUMBER.PUT
           (TO_FILE, A_RECORD.MOST_LIKELY, EXP => 0, FORE => 3, AFT => 1);
    end if;

    TEXT_IO.SET_COL (TO_FILE, TO => 66);

    if A_RECORD.PESSIMISTICS = 0.0 then
        TEXT_IO.PUT (TO_FILE, "  0.0");
    else
        F_NUMBER.PUT
           (TO_FILE, A_RECORD.PESSIMISTICS, EXP => 0, FORE => 3, AFT => 1);
    end if;

    TEXT_IO.SET_COL (TO_FILE, TO => 72);

    if A_RECORD.STAFFING = 0.0 then
        TEXT_IO.PUT (TO_FILE, " 0.0");
    else
        F_NUMBER.PUT
           (TO_FILE, A_RECORD.STAFFING, EXP => 0, FORE => 2, AFT => 1);
    end if;

    TEXT_IO.SET_COL (TO_FILE, TO => 77);

    if A_RECORD.RATE = 0.0 then
        TEXT_IO.PUT (TO_FILE, "      0.0");
    else
        F_NUMBER.PUT
           (TO_FILE, A_RECORD.RATE, EXP => 0, FORE => 7, AFT => 1);
    end if;

    TEXT_IO.NEW_LINE (TO_FILE);

    end WRITE_ONE_LINE;



    ----------------------------------------
    -- putout a welcome message
    ----------------------------------------
    procedure WELCOME_MESSAGE is

    INDENTATION    : TEXT_IO.COUNT := 7;
    INDENT_FOR_MAX : TEXT_IO.COUNT := 53;

    begin
    TEXT_IO.NEW_PAGE;
    TEXT_IO.NEW_LINE (5);
    TEXT_IO.SET_COL (TO => INDENTATION);
    TEXT_IO.PUT ("      Welcome to MODIFY Version 1.0");

    TEXT_IO.NEW_LINE (3);
    TEXT_IO.SET_COL (TO => INDENTATION);
    TEXT_IO.PUT ("Network constraints for this version are:");

    TEXT_IO.NEW_LINE (2);
    TEXT_IO.SET_COL (TO => INDENTATION);
    TEXT_IO.PUT ("    Max number of activities (arcs)        =");
    TEXT_IO.SET_COL (TO => INDENT_FOR_MAX);
    I_NUMBER.PUT (MAXIMUM_NUMBER_OF_ACTIVITIES);

    TEXT_IO.NEW_LINE;
    TEXT_IO.SET_COL (TO => INDENTATION);
    TEXT_IO.PUT ("    Max number of nodes                    =");
    TEXT_IO.SET_COL (TO => INDENT_FOR_MAX);
    I_NUMBER.PUT (MAXIMUM_NUMBER_OF_NODES);

    TEXT_IO.NEW_LINE;
    TEXT_IO.SET_COL (TO => INDENTATION);
    TEXT_IO.PUT ("    Max number of inbound arcs at any node =");
    TEXT_IO.SET_COL (TO => INDENT_FOR_MAX);
    I_NUMBER.PUT (MAXIMUM_NUMBER_OF_IN_OUT_NODES);

    TEXT_IO.NEW_LINE;
    TEXT_IO.SET_COL (TO => INDENTATION);
    TEXT_IO.PUT ("    Max number of arcs in critical path    =");
    TEXT_IO.SET_COL (TO => INDENT_FOR_MAX);
    I_NUMBER.PUT (MAXIMUM_NUMBER_OF_ACTIVITY_IN_CRITICAL_PATH);

    TEXT_IO.NEW_LINE (5);
    TEXT_IO.SET_COL (TO => INDENTATION);
        PRESS_RETURN_TO_CONTINUE;

    TEXT_IO.NEW_PAGE;
    end WELCOME_MESSAGE;



    -------------------------------------------------------------------
    -- receive an integer within the range start_integer .. end_integer
    -------------------------------------------------------------------
    function RETURN_INTEGER (INPUT_PROMPT  : STRING;
                 START_INTEGER : INTEGER := 0;
                 END_INTEGER   : INTEGER := 0) return INTEGER is
    begin
    return SCREEN_IO.RETURNED_INTEGER
          (PROMPT     => ASCII.LF & ASCII.CR & INPUT_PROMPT &
                 ASCII.LF & ASCII.CR,
           FROM_VALUE => START_INTEGER,
           TO_VALUE   => END_INTEGER,
           CONFIRM    => FALSE,
           ERROR_TEXT =>
             ASCII.LF & ASCII.CR &
             "INPUT ERROR:   Program expects an integer number " &
             "within " & INTEGER'IMAGE (START_INTEGER) & " through " &
             INTEGER'IMAGE (END_INTEGER) & "." & ASCII.LF & ASCII.CR &
             "               Please try again." & ASCII.LF & ASCII.CR);
    end RETURN_INTEGER;



    --------------------------------------------------
    -- prompt the user for a choice of either to ADD
    -- or DELETE records from a given input file
    --------------------------------------------------
    procedure OBTAIN_ADD_OR_DELETE is

    function RETURNED_A_D is new SCREEN_IO.RETURNED_ENUMERATION (A_OR_D);

    THE_ANSWER : A_OR_D := NONE;

    begin
    while THE_ANSWER not in A .. DELETE loop
        THE_ANSWER := RETURNED_A_D
                 (PROMPT     =>
                "Do you want to add or delete?  " &
                "ENTER:  a or d -->    ",
                  DEFAULT    => NONE,
                  FROM_VALUE => A,
                      CONFIRM    => FALSE,
                  TO_VALUE   => DELETE,
                  ERROR_TEXT =>
                ASCII.LF & ASCII.CR &
                "INPUT ERROR:  Answer must be either " &
                "[a] for add or [d]  for delete" & ASCII.LF &
                ASCII.CR);
    end loop;

    declare
        TEMP_UNITS : constant STRING := A_OR_D'IMAGE (THE_ANSWER);
    begin
        ADD_DELETE_ANSWER (1) := TEMP_UNITS (TEMP_UNITS'FIRST);
    end;

    end OBTAIN_ADD_OR_DELETE;



    ---------------------------------------------------------------
    -- prompt the user for continue or stop program decision
    ---------------------------------------------------------------
    procedure SELECTION_CONTINUE_OR_STOP is

    function RETURNED_GS is new SCREEN_IO.RETURNED_ENUMERATION (GO_OR_STOP);

    THE_ANSWER : GO_OR_STOP;

    begin
    THE_ANSWER := RETURNED_GS
             (PROMPT     =>
                ASCII.LF & ASCII.CR &
                "       <-- ENTER C to continue program " &
                "or S to stop it" & ASCII.LF & ASCII.CR,
              ERROR_TEXT =>
                ASCII.LF & ASCII.CR & "INPUT ERROR:  " &
                "Answer must be either C for continue " &
                "or S for stop  ");

    declare
        TEMP_UNITS : constant STRING := GO_OR_STOP'IMAGE (THE_ANSWER);
    begin
        CONTINUE_OR_STOP (1) := TEMP_UNITS (TEMP_UNITS'FIRST);
    end;

    end SELECTION_CONTINUE_OR_STOP;



    --------------------------------
    -- obtain a string from user
    --------------------------------
    procedure OBTAIN_NAME (WITH_PROMPT     : STRING := " ";
               THE_NAME        : out STRING;
               END_OF_THE_NAME : in out NATURAL;
               MAX_OF_THE_NAME : INTEGER := 8) is

    begin
    loop
        declare
        TEMP_NAME: constant STRING :=
              SCREEN_IO.RETURNED_STRING
                  (PROMPT  => ASCII.LF & ASCII.CR &
                            WITH_PROMPT &
                   ASCII.LF & ASCII.CR,
                   CONFIRM => FALSE);
        begin
            END_OF_THE_NAME := TEMP_NAME'LENGTH;
            THE_NAME(1..END_OF_THE_NAME) := TEMP_NAME;
            exit when END_OF_THE_NAME in 1 .. MAX_OF_THE_NAME;
            TEXT_IO.NEW_LINE;
            TEXT_IO.PUT_LINE ("INPUT ERROR:");

            TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
            TEXT_IO.PUT_LINE ("File name must be within 1 through " &
                  INTEGER'IMAGE (MAX_OF_THE_NAME) & " characters.");

            TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
            TEXT_IO.PUT_LINE ("Please try again.");
            TEXT_IO.NEW_LINE;
        end;
    end loop;

    end OBTAIN_NAME;



    -----------------------------------
    -- obtain input file from user
    -----------------------------------
    procedure OBTAIN_INPUT_FILE_NAME is

    END_GET_FILE_NAME : exception;

    --------------------------------------------
    -- query user for a valid input file name
    --------------------------------------------
    procedure GET_FILE_NAME is

    begin
        TEXT_IO.NEW_LINE;
        OBTAIN_NAME
           (WITH_PROMPT     => "              <-- ENTER name of input file",
        THE_NAME        => INPUT_FILE,
        END_OF_THE_NAME => END_FILE_NAME,
        MAX_OF_THE_NAME => MAX_FILE_NAME);
        TEXT_IO.NEW_LINE;

        if FILE_OPS.FILE_EXISTS
          (WITH_NAME => INPUT_FILE (1 .. END_FILE_NAME)) then
        TEXT_IO.NEW_LINE (2);

        if (RETURN_YESNO
               (PROMPT     =>
              "WARNING !!!  [" & INPUT_FILE (1 .. END_FILE_NAME) &
              "]    will be modified.  " & ASCII.LF & ASCII.CR &
              "Do you wish to RE-ENTER the name?  (y/n) -->  ",
            DEFAULT    => NONE,
            FROM_VALUE => Y,
            TO_VALUE   => NO,
            ERROR_TEXT => ASCII.LF & ASCII.CR & "INPUT ERROR:  " &
                      "Answer must be either Y or N." &
                      ASCII.LF & ASCII.CR) in Y .. YES) then
            GET_FILE_NAME;
        end if;
        else
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("INPUT ERROR:");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE
           ("File " & INPUT_FILE (1 .. END_FILE_NAME) & " not found.");
        TEXT_IO.NEW_LINE (2);
        YES_NO_ANSWER :=
          RETURN_YESNO
             (PROMPT     => ASCII.LF & ASCII.CR &
                    "Do you wish to try again " &
                    "on another file name (y/n) -->  ",
              DEFAULT    => NONE,
              FROM_VALUE => Y,
              TO_VALUE   => NO,
              ERROR_TEXT => ASCII.LF & ASCII.CR & "INPUT ERROR:  " &
                    "Answer must be either Y or N." &
                    ASCII.LF & ASCII.CR);

        if YES_NO_ANSWER in Y .. YES then
            GET_FILE_NAME;
        else
            TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
            TEXT_IO.PUT_LINE ("Program terminate per user request");
            TEXT_IO.NEW_LINE;
            raise END_GET_FILE_NAME;
        end if;
        end if;

    end GET_FILE_NAME;


    begin

    GET_FILE_NAME;

    FILE_OPS.OPEN
       (THE_FILE         => USER_INPUT_FILE,
        WITH_NAME        => INPUT_FILE (1 .. END_FILE_NAME),
        TO_MODE          => TEXT_IO.IN_FILE,
        CREATION_ENABLED => TRUE);


    ----------------------------------
    -- file error handlers...
    ----------------------------------
    exception
    when END_GET_FILE_NAME =>
        raise END_PER_USER_ERROR;

    when FILE_OPS.SYSTEM_CANNOT_OPEN_FILE =>
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("INPUT ERROR:");

        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE (INPUT_FILE (1 .. END_FILE_NAME) &
                  " cannot be accessed.");
        TEXT_IO.NEW_LINE;
        raise END_PER_USER_ERROR;

    when FILE_OPS.FILE_ALREADY_OPEN =>
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("INPUT ERROR:");

        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE (INPUT_FILE (1 .. END_FILE_NAME) &
                  " is currently in use.");

        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("Program cannot access it");
        TEXT_IO.NEW_LINE;
        raise END_PER_USER_ERROR;

    when FILE_OPS.ILLEGAL_FILE_NAME =>
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("INPUT ERROR:");

        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("[" & INPUT_FILE (1 .. END_FILE_NAME) &
                  "] is an illegal name");
        TEXT_IO.NEW_LINE (2);
        YES_NO_ANSWER := RETURN_YESNO
                (PROMPT     =>
                   "Do you wish to try again" &
                   " on another file name (y/n) -->  " &
                   ASCII.LF & ASCII.CR,
                 DEFAULT    => NONE,
                 FROM_VALUE => Y,
                 TO_VALUE   => NO,
                 ERROR_TEXT =>
                   ASCII.LF & ASCII.CR & "INPUT ERROR:  " &
                   "Answer must be either Y or N.");

        if YES_NO_ANSWER in Y .. YES then
        OBTAIN_INPUT_FILE_NAME;
        else
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("Program terminate per user request");
        TEXT_IO.NEW_LINE;
        raise END_PER_USER_ERROR;
        end if;

    end OBTAIN_INPUT_FILE_NAME;




    ----------------------------------------------------------
    -- create buffers to store data read from user input file,
    -- the data are used during modification process
    ----------------------------------------------------------
    procedure CREATE_INPUT_BUFFER_ARRAY is

    HEADER_LINES    : STRING (LENGTH_RANGE'FIRST .. LENGTH_RANGE'LAST);
    HEADER_LINE_END : NATURAL;



    begin
    ------------------------------------------------------------
    -- user input file contains two type of lines -
    -- The first 5 lines of input file have header information
    -- which are read and stored in buffer named "header_buffer_array".
    -- The subsequent lines of input file have activities information
    -- which are read and stored in buffer named "body_buffer_array".
    ------------------------------------------------------------

    -------------------------------------
    -- read in header lines
    -------------------------------------
    for I in 1 .. 5 loop
        TEXT_IO.GET_LINE (USER_INPUT_FILE, HEADER_LINES, HEADER_LINE_END);
        FILE_HEADER (I) :=
          (HEADER_LINE_END, HEADER_LINES (1 .. HEADER_LINE_END));
    end loop;


    -------------------------------------
    -- read in the rest of the lines
    -------------------------------------
    BODY_BUFFER_ARRAY_COUNTER := 0;

    loop
        BODY_BUFFER_ARRAY_COUNTER := BODY_BUFFER_ARRAY_COUNTER + 1;

        if BODY_BUFFER_ARRAY_COUNTER > MAXIMUM_NUMBER_OF_ACTIVITIES then
        raise MAX_ACT_ERROR;
        end if;

        READ_ONE_ACTIVITY_LINE
           (FROM_FILE => USER_INPUT_FILE, A_RECORD => CURRENT_INPUT_LINE);

        BODY_BUFFER_ARRAY.all (BODY_BUFFER_ARRAY_COUNTER) :=
          CURRENT_INPUT_LINE;
    end loop;


    ------------------------
    -- errors handlers
    ------------------------
    exception
    when MAX_ACT_ERROR =>
        TEXT_IO.PUT_LINE ("NETWORK CONSTRAINT ERROR:");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT ("The number of activities contained in " &
             INPUT_FILE (1 .. END_FILE_NAME));
        TEXT_IO.PUT_LINE (" exceeds the maximum limit of ");
        I_NUMBER.PUT (MAXIMUM_NUMBER_OF_ACTIVITIES);
        TEXT_IO.PUT_LINE (".");
        raise END_MODIFY;

    when BAD_DATA =>
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("INPUT ERROR:");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("Inconsistent data encountered at the line ");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT ("containing activity named:");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("   [" & CURRENT_INPUT_LINE.ACTIVITY_NAME & "].");
        raise END_MODIFY;

    when TEXT_IO.END_ERROR =>
        BODY_BUFFER_ARRAY_COUNTER := BODY_BUFFER_ARRAY_COUNTER - 1;
        TEXT_IO.CLOSE (USER_INPUT_FILE);

    end CREATE_INPUT_BUFFER_ARRAY;




    -------------------------------------------
    -- remove unwanted records from the record
    -- array as per user request.
    -------------------------------------------
    procedure PROCESS_DELETION is

    CURRENT_BEGIN_RANGE      : INTEGER := 1;
    CURRENT_END_RANGE        : INTEGER := 0;

    SEGMENT_OF_DELETED_LINES : constant INTEGER := 12;

    DELETED_LINE             : INTEGER;


    DELETE_RECORD : INPUT_LINE_RECORD_TYPE :=
            (WBS_CODE      => "delete--",
             ACTIVITY_NAME => "this record will be deleted     ",
             TAIL_NODE     => -1,
             HEAD_NODE     => -1,
             OPTIMISTICS   => -1.0,
             MOST_LIKELY   => -1.0,
             PESSIMISTICS  => -1.0,
             STAFFING      => 0.0,
             RATE          => 0.0);



    ------------------------------------------------
    -- prompt user for delete or not delete decision
    -- if delete, how many?
    ------------------------------------------------
    function HOW_MANY_TO_BE_DELETED return INTEGER is

    begin
        if (RETURN_YESNO
           (PROMPT     => ASCII.LF & ASCII.CR &
                  "Do you wish to delete any " &
                  "of above activities (y/n) -->  ",
            DEFAULT    => NONE,
            FROM_VALUE => Y,
            TO_VALUE   => NO,
            ERROR_TEXT => ASCII.LF & ASCII.CR & "INPUT ERROR:  " &
                  "Answer must be either Y or N.") in
        Y .. YES) then

        return (RETURN_INTEGER
               (INPUT_PROMPT =>
                  ASCII.LF & ASCII.CR &
                  "      <-- How many activities will be deleted?",
                END_INTEGER  => SEGMENT_OF_DELETED_LINES));
        else
        return (0);
        end if;

    end HOW_MANY_TO_BE_DELETED;


    ----------------------------------------------
    -- main of PROCESS_DELETION
    ----------------------------------------------
    begin

    loop
        -----------------------------------
        -- obtain 12 lines of text segment
        -----------------------------------
        if (CURRENT_BEGIN_RANGE + SEGMENT_OF_DELETED_LINES - 1) >=
           BODY_BUFFER_ARRAY_COUNTER then
        CURRENT_END_RANGE := BODY_BUFFER_ARRAY_COUNTER;
        else
        CURRENT_END_RANGE :=
          CURRENT_BEGIN_RANGE + SEGMENT_OF_DELETED_LINES - 1;
        end if;
        --------------------------------------------------
        -- output the segment to screen, each line begins
        -- with a numerical value of 1 .. 12 for all
        -- regular 12 line segment.
        --------------------------------------------------
        declare
        CHOICE_NUMBER           : INTEGER := 1;
        NUMBER_OF_DELETED_LINES : INTEGER := 0;
        begin

        -----------------------------------
        -- output section of text to screen
        -----------------------------------
        TEXT_IO.NEW_PAGE;
        TEXT_IO.NEW_LINE (6);
        TEXT_IO.PUT ("  Option# ");
        TEXT_IO.SET_COL (TO => 40);
        TEXT_IO.PUT_LINE ("Activity Name");
        TEXT_IO.NEW_LINE;

        for LINE_INDEX in CURRENT_BEGIN_RANGE .. CURRENT_END_RANGE loop
            CURRENT_INPUT_LINE := BODY_BUFFER_ARRAY.all (LINE_INDEX);
            TEXT_IO.SET_COL (TO => 3);
            I_NUMBER.PUT (CHOICE_NUMBER, WIDTH => 4);
            TEXT_IO.SET_COL (TO => 20);
            TEXT_IO.PUT_LINE (CURRENT_INPUT_LINE.ACTIVITY_NAME);
            CHOICE_NUMBER := CHOICE_NUMBER + 1;
        end loop;

        NUMBER_OF_DELETED_LINES := HOW_MANY_TO_BE_DELETED;

        ---------------------------------------------------------
        -- return to calling program when there is no deleted input
        ---------------------------------------------------------
        if NUMBER_OF_DELETED_LINES > 0 then

                ---------------------------------------------------
                -- process deleted request by replacing
                -- unwanted record with aggregate of delete_record.
                ---------------------------------------------------
            declare
            DELETE_LINE : INTEGER;

            begin
            for DELETE_INDEX in 1 .. NUMBER_OF_DELETED_LINES loop
                DELETE_LINE :=
                  RETURN_INTEGER
                 (INPUT_PROMPT  =>
                    "     <-- Enter option# for " &
                    "one of the " &
                    INTEGER'IMAGE (NUMBER_OF_DELETED_LINES) &
                    "'s  unwanted activities",
                  START_INTEGER => 1,
                  END_INTEGER   => SEGMENT_OF_DELETED_LINES);
                BODY_BUFFER_ARRAY.all
                   (CURRENT_BEGIN_RANGE + DELETE_LINE - 1) :=
                  DELETE_RECORD;
            end loop;
            end;
        end if;
        end;

        CURRENT_BEGIN_RANGE := CURRENT_END_RANGE + 1;
        exit when CURRENT_END_RANGE >= BODY_BUFFER_ARRAY_COUNTER;
    end loop;

    ----------------------------------------------
    -- remove delete record from body_buffer_array
    ----------------------------------------------
    declare
        NEXT_POINTER : INTEGER := 0;
    begin
        for CURRENT_POINTER in 1 .. BODY_BUFFER_ARRAY_COUNTER loop
        if BODY_BUFFER_ARRAY.all (CURRENT_POINTER) /= DELETE_RECORD then
            NEXT_POINTER := NEXT_POINTER + 1;

            if NEXT_POINTER /= CURRENT_POINTER then
            BODY_BUFFER_ARRAY (NEXT_POINTER) :=
              BODY_BUFFER_ARRAY (CURRENT_POINTER);
            end if;
        end if;
        end loop;

        BODY_BUFFER_ARRAY_COUNTER := NEXT_POINTER;
    end;

    TEXT_IO.NEW_LINE;


    end PROCESS_DELETION;



    -------------------------------------------------------------
    -- add records to the record buffer as per user request.
    -------------------------------------------------------------
    procedure PROCESS_ADDITION is

    NUMBER_ADDED                  : INTEGER := 0;
    NUMBER_OF_ACTIVITIES_INPUTTED : INTEGER := BODY_BUFFER_ARRAY_COUNTER;

    WBS_CODE                      : STRING (1 .. MAX_LINE);
    CODE_LAST                     : NATURAL;
    ACTIVITY_NAME                 : STRING (1 .. MAX_LINE);
    NAME_LAST                     : NATURAL;

    HEAD_NODE, TAIL_NODE          : INTEGER := 0;

    OPTIMISTICS                   : FLOAT;
    MOST_LIKELY                   : FLOAT;
    PESSIMISTICS                  : FLOAT;
    STAFFING                      : FLOAT;
    RATE                          : FLOAT;


    ------------------------------------------------
    -- prompt user for how many to be added
    ------------------------------------------------
    function HOW_MANY_TO_BE_ADDED return INTEGER is

    begin

        TEXT_IO.NEW_PAGE;
        TEXT_IO.NEW_LINE (3);
        return (RETURN_INTEGER
               (INPUT_PROMPT =>
              ASCII.LF & ASCII.CR &
              "      <-- How many activities will be added?" &
              ASCII.LF & ASCII.CR,
            END_INTEGER  => 999));
        TEXT_IO.NEW_LINE;
    end HOW_MANY_TO_BE_ADDED;


    --------------------------------------------------
    -- prompt user for pertinent information to create
    -- new record adding to existing input buffer
    --------------------------------------------------
    procedure ADD_TO_BUFFER_ARRAY is

        type DUMMIES is (DUMMY);



        -------------------------------------------------------
        -- function verifies string called "dummy" ...
        -------------------------------------------------------
        function IN_DUMMIES return BOOLEAN is
        D_TEMP : DUMMIES;

        begin
        D_TEMP := DUMMIES'VALUE (ACTIVITY_NAME (1 .. 5));
        return TRUE;
        exception
        when CONSTRAINT_ERROR =>  return FALSE;
        end IN_DUMMIES;



        ---------------------------------------------
        -- prompt user for all estimates
        -- input data must be in float number ...
        ---------------------------------------------
        procedure NEW_SIMPERT_LINE is


            ---------------------------------------------
            -- process to receive a float number
            --------------------------------------------
        function RETURN_ESTIMATE (INPUT_PROMPT : STRING;
                      BEGIN_AT     : FLOAT := 0.0;
                      LIMIT_FLOAT  : FLOAT := 999.90000)
                       return FLOAT is

        begin
            return SCREEN_IO.RETURNED_FLOAT
                  (PROMPT     => ASCII.LF & ASCII.CR &
                         INPUT_PROMPT & ASCII.LF & ASCII.CR,
                   FROM_VALUE => BEGIN_AT,
                       CONFIRM    => FALSE,
                   TO_VALUE   => LIMIT_FLOAT);
        end RETURN_ESTIMATE;


        begin

        OPTIMISTICS :=
          RETURN_ESTIMATE
             (INPUT_PROMPT => "XXX.X  <--ENTER optimistic (1%) " &
                      "time estimate");

        MOST_LIKELY :=
          RETURN_ESTIMATE
             (INPUT_PROMPT => "XXX.X  <--ENTER most likely (1%) " &
                      "time estimate");

        PESSIMISTICS :=
          RETURN_ESTIMATE
             (INPUT_PROMPT => "XXX.X  <--ENTER pessimistic (1%) " &
                      "time estimate");

        ---------------------------------------------
        -- when time estimates are zero skip the rest
        ---------------------------------------------
        if OPTIMISTICS = 0.0 and
           MOST_LIKELY = 0.0 and PESSIMISTICS = 0.0 then
            STAFFING := 0.0;
            RATE := 0.0;
        else
            STAFFING :=
              RETURN_ESTIMATE
             (INPUT_PROMPT =>
                "XX.X  <--ENTER average number of " &
                "equivalent of full-time personnel",
              LIMIT_FLOAT  => 99.90000);

            RATE := RETURN_ESTIMATE
                   (INPUT_PROMPT =>
                  "XXXXXXX.X  <--ENTER average cost per " &
                  "man-time unit",
                BEGIN_AT     => 1.0,
                LIMIT_FLOAT  => 999999.90000);
        end if;

        end NEW_SIMPERT_LINE;

        -------------------------------------------------------
        -- Reads activity name & node numbers from screen ...
        -- uses NEW_SIMPERT_LINE to collect estimates
        -------------------------------------------------------
        procedure DATA_ENTRY is

        procedure TAKE_INPUT is

        begin
            ----------------------------------------------
            -- NAME is a MAX_ACT_NAME = 32 character
            -- string ACTIVITY CODE is an MAX_ACT_CODE = 8
            -- character string
            ----------------------------------------------
            TEXT_IO.NEW_PAGE;
            TEXT_IO.NEW_LINE (2);

            TEXT_IO.SET_COL (TO => 15);
            TEXT_IO.PUT ("Activity [arc] number ");
            I_NUMBER.PUT (NUMBER_OF_ACTIVITIES_INPUTTED);
            TEXT_IO.NEW_LINE (2);

            OBTAIN_NAME
               (WITH_PROMPT     =>
              "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  " &
              "<-- ENTER name of activity",
            THE_NAME        => ACTIVITY_NAME,
            END_OF_THE_NAME => NAME_LAST,
            MAX_OF_THE_NAME => MAX_ACT_NAME);

            if NAME_LAST < MAX_ACT_NAME then
            ACTIVITY_NAME (NAME_LAST + 1 .. MAX_ACT_NAME) :=
              (NAME_LAST + 1 .. MAX_ACT_NAME => ' ');
            end if;

            if IN_DUMMIES then
            CODE_LAST := MAX_ACT_CODE;
            WBS_CODE (1 .. CODE_LAST) := (1 .. CODE_LAST => ' ');
            else
            OBTAIN_NAME
               (WITH_PROMPT     =>
                  "XXXXXXXX  <-- ENTER arc code [WBS]",
                THE_NAME        => WBS_CODE,
                END_OF_THE_NAME => CODE_LAST,
                MAX_OF_THE_NAME => MAX_ACT_CODE);

            if CODE_LAST < MAX_ACT_CODE then
                WBS_CODE (CODE_LAST + 1 .. MAX_ACT_CODE) :=
                  (CODE_LAST + 1 .. MAX_ACT_CODE => ' ');
            end if;
            end if;

            -------------------------------------------------------
            -- TAIL and HEAD nodes must be greater than zero .......
            -------------------------------------------------------

            TAIL_NODE :=
              RETURN_INTEGER
             (INPUT_PROMPT  => "XXXX  <--ENTER tail node",
              START_INTEGER => 1,
              END_INTEGER   => MAXIMUM_NUMBER_OF_NAME_NODES);
            TEXT_IO.NEW_LINE;

            HEAD_NODE :=
              RETURN_INTEGER
             (INPUT_PROMPT  => "XXXX  <--ENTER head node",
              START_INTEGER => 1,
              END_INTEGER   => MAXIMUM_NUMBER_OF_NAME_NODES);

            TEXT_IO.NEW_PAGE;
            --
            --   CHECK FOR STRING "DUMMY" IN FIRST 5 CHARACTERS of ACT
            --
            if IN_DUMMIES then
            OPTIMISTICS := 0.0;
            MOST_LIKELY := 0.0;
            PESSIMISTICS := 0.0;
            STAFFING := 0.0;
            RATE := 0.0;
            TEXT_IO.NEW_LINE (5);
            else
            TEXT_IO.NEW_LINE (3);
            TEXT_IO.SET_COL (TO => 10);
            TEXT_IO.PUT_LINE
               ("ENTER following parameters for activity:");

            TEXT_IO.SET_COL (TO => 14);
            TEXT_IO.PUT_LINE (ACTIVITY_NAME (1 .. NAME_LAST));
            TEXT_IO.NEW_LINE (3);
            --
            --          NEW line SIMPERT .....
            --
            -------------------------------------------------------
            -- MOST_LIKELY must be within the range of OPTI..PESSI
            -------------------------------------------------------
            NEW_SIMPERT_LINE;

            loop
                if OPTIMISTICS > MOST_LIKELY or
                   MOST_LIKELY > PESSIMISTICS then
                TEXT_IO.NEW_LINE;
                TEXT_IO.PUT_LINE ("INPUT ERROR:");

                TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
                TEXT_IO.PUT_LINE
                   ("Relative size of input is inconsistent.");
                TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
                TEXT_IO.PUT_LINE
                    ("  Optimistics must be <= most likely " &
                    " <= pessimistic");

                TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
                TEXT_IO.PUT_LINE ("Please try again.");
                TEXT_IO.NEW_LINE (2);
                NEW_SIMPERT_LINE;
                else
                exit;
                end if;
            end loop;
            end if;

        end TAKE_INPUT;


        begin
        TAKE_INPUT;

        loop
            declare
            LOOP_ANSWER : constant STRING :=
                      SCREEN_IO.RETURNED_STRING
                     (PROMPT =>
                        ASCII.LF & ASCII.CR &
                        "ENTER [r] to RE_ENTER parameters" &
                        " for this activity" & ASCII.LF &
                        ASCII.CR &
                        "or press RETURN to continue ...." &
                        ASCII.LF & ASCII.CR);
            begin
            if LOOP_ANSWER = "r" or LOOP_ANSWER = "R" then
                TAKE_INPUT;

            elsif LOOP_ANSWER = "" then
                exit;
            else
                TEXT_IO.NEW_LINE;
                TEXT_IO.PUT_LINE
                   ("INPUT ERROR:  Please try again.");
                TEXT_IO.NEW_LINE;
            end if;
            end;
        end loop;

        TEXT_IO.NEW_LINE (1);
        end DATA_ENTRY;


    begin

        NUMBER_OF_ACTIVITIES_INPUTTED := NUMBER_OF_ACTIVITIES_INPUTTED + 1;
        DATA_ENTRY;

        BODY_BUFFER_ARRAY (BODY_BUFFER_ARRAY_COUNTER).WBS_CODE :=
          WBS_CODE (1 .. MAX_ACT_CODE);
        BODY_BUFFER_ARRAY (BODY_BUFFER_ARRAY_COUNTER).ACTIVITY_NAME :=
          ACTIVITY_NAME (1 .. MAX_ACT_NAME);
        BODY_BUFFER_ARRAY (BODY_BUFFER_ARRAY_COUNTER).TAIL_NODE :=
          TAIL_NODE;
        BODY_BUFFER_ARRAY (BODY_BUFFER_ARRAY_COUNTER).HEAD_NODE :=
          HEAD_NODE;
        BODY_BUFFER_ARRAY (BODY_BUFFER_ARRAY_COUNTER).OPTIMISTICS :=
          OPTIMISTICS;
        BODY_BUFFER_ARRAY (BODY_BUFFER_ARRAY_COUNTER).MOST_LIKELY :=
          MOST_LIKELY;
        BODY_BUFFER_ARRAY (BODY_BUFFER_ARRAY_COUNTER).PESSIMISTICS :=
          PESSIMISTICS;
        BODY_BUFFER_ARRAY (BODY_BUFFER_ARRAY_COUNTER).STAFFING := STAFFING;
        BODY_BUFFER_ARRAY (BODY_BUFFER_ARRAY_COUNTER).RATE := RATE;

    end ADD_TO_BUFFER_ARRAY;

    begin

    NUMBER_ADDED := HOW_MANY_TO_BE_ADDED;

    ---------------------------------------------------------
    -- return to calling program when there is no added input
    ---------------------------------------------------------
    if NUMBER_ADDED = 0 then
        return;
    end if;

    --------------------------------------------------------------
    -- terminate when the summation of new and existing activities
    -- exceeds the  maximum number of activities allowed.
    --------------------------------------------------------------

    if (BODY_BUFFER_ARRAY_COUNTER + NUMBER_ADDED) >
       MAXIMUM_NUMBER_OF_ACTIVITIES then

        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("NETWORK CONSTRAINT ERROR:");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT ("Number of activities exceeds " &
             "the maximum limit of ");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        I_NUMBER.PUT (MAXIMUM_NUMBER_OF_ACTIVITIES);
        TEXT_IO.PUT (".");
        raise MAX_ACT_ERROR;
    end if;


    --------------------------------------------------
    -- process new activities when all else is in order
    --------------------------------------------------
    for INDEX in 1 .. NUMBER_ADDED loop
        BODY_BUFFER_ARRAY_COUNTER := BODY_BUFFER_ARRAY_COUNTER + 1;
        ADD_TO_BUFFER_ARRAY;
    end loop;


    exception
    when MAX_ACT_ERROR =>
        TEXT_IO.PUT_LINE ("NETWORK CONSTRAINT ERROR:");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT ("The number of activities contained in " &
             INPUT_FILE (1 .. END_FILE_NAME));
        TEXT_IO.PUT_LINE (" exceeds the maximum limit of ");
        I_NUMBER.PUT (MAXIMUM_NUMBER_OF_ACTIVITIES);
        TEXT_IO.PUT_LINE (".");
        raise END_MODIFY;

    end PROCESS_ADDITION;



    -------------------------------------
    -- modify the input file to reflect
    -- new changes per user request.
    -------------------------------------
    procedure MODIFY_USER_INPUT_FILE is

    REVISED_INPUT_FILE : TEXT_IO.FILE_TYPE;

    begin
    TEXT_IO.CREATE (REVISED_INPUT_FILE, TEXT_IO.OUT_FILE,
            INPUT_FILE (1 .. END_FILE_NAME));

    for I in 1 .. 5 loop
        TEXT_IO.PUT_LINE (REVISED_INPUT_FILE, FILE_HEADER (I).VALUE);
    end loop;

    for I in 1 .. BODY_BUFFER_ARRAY_COUNTER loop
        CURRENT_INPUT_LINE := BODY_BUFFER_ARRAY.all (I);
        WRITE_ONE_LINE (TO_FILE  => REVISED_INPUT_FILE,
                A_RECORD => CURRENT_INPUT_LINE);
    end loop;

    TEXT_IO.CLOSE (REVISED_INPUT_FILE);

    end MODIFY_USER_INPUT_FILE;

begin

    WELCOME_MESSAGE;

    TEXT_IO.NEW_LINE (4);
    OBTAIN_ADD_OR_DELETE;

    TEXT_IO.NEW_LINE (4);
    OBTAIN_INPUT_FILE_NAME;

    CREATE_INPUT_BUFFER_ARRAY;

    if A_OR_D'VALUE (ADD_DELETE_ANSWER) = REQUEST_FOR_DELETION then
    PROCESS_DELETION;

    elsif A_OR_D'VALUE (ADD_DELETE_ANSWER) = REQUEST_FOR_ADDITION then
    PROCESS_ADDITION;
    end if;

    MODIFY_USER_INPUT_FILE;

    if (RETURN_YESNO
       (PROMPT     => "Are you done modifying?" & "  (y/n) --> " &
              ASCII.LF & ASCII.CR,
        DEFAULT    => NONE,
        FROM_VALUE => Y,
        TO_VALUE   => NO,
        ERROR_TEXT => ASCII.LF & ASCII.CR &
              "INPUT ERROR:  Answer must be either Y or N." &
              ASCII.LF & ASCII.CR) in N .. NO) then
    MODIFY;
    end if;

exception
    when END_PER_USER_ERROR =>
        PRESS_RETURN_TO_CONTINUE;

    when END_MODIFY =>
        PRESS_RETURN_TO_CONTINUE;
    TEXT_IO.CLOSE (USER_INPUT_FILE);

    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " &
               "[MODIFY]");

end MODIFY;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--pert.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with GRAPHS,
     TEXT_IO,
     DATE_AND_TIME,
     SCREEN_IO,
     FILE_HANDLER;


separate (SCHEDULE)
procedure PERT is
--------------------------------------------------------------------------
-- Author:     Ken Lamarche
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :     May 1985
-- Summary:
-- This is the main program on the SIMPERT process. It contains the data
-- structures used for the Event Nodes, and the Activity Arc (stucture includes
-- the information stored for a given node or arc). This procedure calls
-- separate subprograms to perform the functions of PERT.
---------------------------------------------------------------------------

    MAX_NUMBER_OF_EVENTS                 : constant POSITIVE := 3400;
    MAX_NUMBER_OF_ACTIVITIES             : constant POSITIVE := 4000;
    MAX_NUMBER_OF_ACTIVITIES_INTO_NODE   : constant POSITIVE := 25;
    MAX_NUMBER_OF_ACTIVITIES_OUT_OF_NODE : constant POSITIVE := 25;
    MAX_YEAR                             : constant INTEGER := 99;

    -------------------------------------------------------------------------
    -- Used for Outputing Messages.
    -------------------------------------------------------------------------
    ERROR_INDENTATION : TEXT_IO.COUNT := 15;

    subtype EVENT_ID_TYPE    is INTEGER range 1 .. MAX_NUMBER_OF_EVENTS;
    subtype ACTIVITY_ID_TYPE is INTEGER range 1 .. MAX_NUMBER_OF_ACTIVITIES;


    type ACTIVITY_TYPE is
    record
        NAME               : STRING (1 .. 42);
        ACTIVITY_ID        : ACTIVITY_ID_TYPE;
        OPTIMISTIC_TIME    : FLOAT := 0.0;
        MOST_PROBABLE_TIME : FLOAT := 0.0;
        PESSIMISTIC_TIME   : FLOAT := 0.0;
        DURATION_TIME      : FLOAT := 0.0;
        ON_CP_COUNT        : FLOAT := 0.0;
        ESTIMATE_START     : FLOAT := 0.0;
        ESTIMATE_STOP      : FLOAT := 0.0;
        STAFFING           : FLOAT := 0.0;
        RATE               : FLOAT := 0.0;
    end record;

    type EVENT_TYPE is
    record
        EVENT_ID               : INTEGER := 0;
        DET_TIME_OF_EVENT      : FLOAT := 0.0;
        DET_LATE_TIME_OF_EVENT : FLOAT := -1.0;
        SIM_TIME_OF_EVENT      : FLOAT := 0.0;
        SUM_OF_TIMES           : FLOAT := 0.0;
        SUM_OF_SQUARES         : FLOAT := 0.0;
        VARIANCE               : FLOAT := 0.0;
        ESTIMATE_TIME_OF_EVENT : FLOAT := 0.0;
        CRIT_PATH_INDEX        : FLOAT := 0.0;
        MOST_CRIT_INBOUND_ARC  : NATURAL := 0;
        LONGEST_PATH_TO_EVENT  : INTEGER := 0;
    end record;

    -------------------------------------------------------------------------
    -- Time unit is a Day or Week.
    -------------------------------------------------------------------------
    type TIME_UNIT_TYPE is (D, W);


    -------------------------------------------------------------------------
    -- Some variables used in PERT, or in more than one separate subprogram.
    -------------------------------------------------------------------------
    GRAPH_IS_OK         : BOOLEAN;

    TIME_UNIT_CODE      : TIME_UNIT_TYPE := D;
    JULIAN_START_DATE   : DATE_AND_TIME.JULIAN_TYPE;
    WORKDAYS_PER_WEEK   : constant POSITIVE :=
                 SCREEN_IO.RETURNED_INTEGER
                (PROMPT      =>
                   ASCII.LF & ASCII.CR & ASCII.LF &
                   ASCII.CR & ASCII.LF & ASCII.CR & ASCII.LF &
                   ASCII.CR & ASCII.LF & ASCII.CR &
                   "ENTER the number of workdays " &
                   "per week -->  ",
                 from_value  => 5,
                 to_value    => 7,
                 DEFAULT     => 5,
                 USE_DEFAULT => TRUE,
                 CONFIRM     => FALSE);
    CONFIDENCE_INTERVAL : FLOAT := 0.0;


    -------------------------------------------------------------------------
    -- The PERT process can be run in SIMULATION (Summing the results for
    -- later averaging), or DETERMINISTIC (uses three point averages, and
    -- the PERT process is only run once to determine a result).
    -------------------------------------------------------------------------
    type RUN_TYPE is (SIMULATION, DETERMINISTIC);



    NUMBER_OF_ITERATIONS   : constant INTEGER :=
                 SCREEN_IO.RETURNED_INTEGER
                (PROMPT      =>
                   ASCII.LF & ASCII.CR & ASCII.LF &
                   ASCII.CR & ASCII.LF & ASCII.CR & ASCII.LF &
                   ASCII.CR & ASCII.LF & ASCII.CR &
                   "ENTER the number of iterations " &
                   "in the PERT simulation",
                 from_value  => 2,
                 to_value    => 5000,
                 DEFAULT     => 1000,
                 USE_DEFAULT => TRUE,
                 CONFIRM     => FALSE);

    PROBABILITY_FOR_OUTPUT : constant FLOAT :=
                 SCREEN_IO.RETURNED_FLOAT
                (PROMPT      =>
                   ASCII.LF & ASCII.CR & ASCII.LF & ASCII.CR &
                   ASCII.LF & ASCII.CR &
                   "ENTER the desired probability for output",
                 DEFAULT     => 0.90,
                 FROM_VALUE  => 0.05,
                 TO_VALUE    => 0.95,
                 USE_DEFAULT => TRUE,
                 CONFIRM     => FALSE);

    -------------------------------------------------------------------------
    -- Get values for program constants:
    --   The input files,
    --   The number of iterations,
    --   The probability for the output display.
    -------------------------------------------------------------------------
    PERT_FILE        : constant STRING :=
               FILE_HANDLER.VERIFY_INPUT
              (FILE_PROMPT          =>
                 ASCII.LF & ASCII.CR & ASCII.LF & ASCII.CR &
                 ASCII.LF & ASCII.CR & ASCII.LF & ASCII.CR &
                 "Enter the name of the file containing " &
                 "Activity Information" & ASCII.LF & ASCII.CR &
                 "[32 characters or less].",
               MAX_FILE_NAME_LENGTH => 32);

    FILE_OF_HOLIDAYS : constant STRING :=
               FILE_HANDLER.VERIFY_INPUT
              (FILE_PROMPT          =>
                 ASCII.LF & ASCII.CR & ASCII.LF & ASCII.CR &
                 ASCII.LF & ASCII.CR &
                 "Enter the name of the file containing " &
                 "Holiday date" & ASCII.LF & ASCII.CR &
                 "[32 character or less].",
               MAX_FILE_NAME_LENGTH => 32);

    -------------------------------------------------------------------------
    -- File type object for Random Number File. This file is only used in
    -- testing the pert program...
    -------------------------------------------------------------------------
    RANDOM_FILE : TEXT_IO.FILE_TYPE;


    STOP_SIMPERT      : exception;
    END_VERIFY_OUTPUT : exception;





    package PERT_OPS is new GRAPHS (ACTIVITY_TYPE, EVENT_TYPE);

    NETWORK : PERT_OPS.GRAPH_TYPE;

    -------------------------------------------------------------------------
    -- Function returns a GRAPH_TYPE data structure that is the graph
    -- described in the PERT_FILE input file. Exceptions are raised if
    -- the data in the file is not legal.
    -------------------------------------------------------------------------
    function PERT_NETWORK return PERT_OPS.GRAPH_TYPE is separate;



    -------------------------------------------------------------------------
    -- Procedure check the graph data structure for correctnes, ie,
    -- 1 source and sink, no cycles. OK is false on a bad graph.
    -------------------------------------------------------------------------
    procedure IS_GOOD (PERT_NETWORK : in out PERT_OPS.GRAPH_TYPE;
               OK           : out BOOLEAN) is separate;



    -------------------------------------------------------------------------
    -- Procedure does the PERT run. It does a traversal of the graph
    -- structure and sets times for the events, and starting/stopping
    -- times for the activities.
    -------------------------------------------------------------------------
    procedure PROCESS (IN_NETWORK : PERT_OPS.GRAPH_TYPE;
               FOR_RUN    : RUN_TYPE) is separate;



    -------------------------------------------------------------------------
    -- Procedure is used to perform calculations following the simulation
    -- of PERT. Calculations include averages, stnd dev, start and stop times
    -- (The "times" are floating values that are events in time. These values
    -- are translated to the approriate work unit (day or week) and calendar
    -- date when the values are printed.
    -------------------------------------------------------------------------
    procedure OVERALL_CALCS (PERT_NETWORK : PERT_OPS.GRAPH_TYPE) is separate;


    -------------------------------------------------------------------------
    -- Procedure prints the output reports. This procedure contains
    -- further separate subprograms to output each report.
    -------------------------------------------------------------------------
    procedure OUTPUT_VALUES is separate;


begin

    if (PERT_FILE = " ") or (FILE_OF_HOLIDAYS = " ") then
    TEXT_IO.NEW_LINE (2);
    TEXT_IO.PUT_LINE ("MISSING REQUIRED INPUT-FILE(s) !!!");
    TEXT_IO.NEW_LINE;
    TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
    TEXT_IO.PUT_LINE ("PERT terminates on user request");
        PRESS_RETURN_TO_CONTINUE;
    else

    ------------------------------------------------------------------------
    -- Validate Output files. Make sure user wants to write over them.
    ------------------------------------------------------------------------
    FILE_HANDLER.VERIFY_OUTPUT;

    ------------------------------------------------------------------------
    -- Read file and check if graph is correct.
    ------------------------------------------------------------------------
    TEXT_IO.NEW_PAGE;
    TEXT_IO.SET_LINE (9);
    TEXT_IO.SET_COL (3);
    TEXT_IO.PUT_LINE ("Reading the Activity Info file, and checking" &
              " for correct graph structure.");
    NETWORK := PERT_NETWORK;
    IS_GOOD (PERT_NETWORK => NETWORK, OK => GRAPH_IS_OK);

    if GRAPH_IS_OK then
        PROCESS (IN_NETWORK => NETWORK, FOR_RUN => DETERMINISTIC);

        -----**********************************************************----
        --   Open a file of random numbers. This file is only used for
        --   testing the PERT program. Take these out on delivery.
        ------------------------------------------------------------------
        --   TEXT_IO.OPEN (RANDOM_FILE, TEXT_IO.IN_FILE, "random.num");
        -----**********************************************************----


        DO_SIMULATION:
        declare
        procedure SET_UP_DISPLAY is
        begin
            TEXT_IO.NEW_PAGE;
            TEXT_IO.SET_LINE (9);
            TEXT_IO.SET_COL (5);
            TEXT_IO.PUT_LINE
               ("Pert Simulation is now running, " &
            "(star represents another iteration).");
            TEXT_IO.NEW_LINE;
            TEXT_IO.SET_COL (10);
        end SET_UP_DISPLAY;

        begin

        SET_UP_DISPLAY;

        for ITERATIONS in 1 .. NUMBER_OF_ITERATIONS loop
            if ITERATIONS mod 600 = 0 then
            SET_UP_DISPLAY;

            elsif ITERATIONS mod 60 = 0 then
            TEXT_IO.NEW_LINE;
            TEXT_IO.SET_COL (10);
            end if;

            TEXT_IO.PUT ('*');
            PROCESS (IN_NETWORK => NETWORK, FOR_RUN => SIMULATION);
        end loop;

        end DO_SIMULATION;

        -----**********************************************************----
        --   Close the file of random numbers. Only used in testing pert.
        -------------------------------------------------------------------
        --   TEXT_IO.CLOSE (RANDOM_FILE);
        -----**********************************************************----

        --------------------------------------------------------------------
        -- Notify user of doing overall calculations.
        --------------------------------------------------------------------
        TEXT_IO.NEW_PAGE;
        TEXT_IO.SET_LINE (9);
        TEXT_IO.SET_COL (17);
        TEXT_IO.PUT_LINE ("Performing calculations for Simpert results.");
        OVERALL_CALCS (PERT_NETWORK => NETWORK);

        --------------------------------------------------------------------
        -- Generate output reports.
        --------------------------------------------------------------------
        OUTPUT_VALUES;

        OUTPUT_SUMMARY_ON_SCREEN:
        declare
        type ANSWER is (Y, YES, N, NO);

        function RETURNED_ANSWER is new SCREEN_IO.RETURNED_ENUMERATION
               (ANSWER);

        THE_SUMMARY_REPORT : TEXT_IO.FILE_TYPE;
        ONE_LINE           : STRING (1 .. 132);
        LAST_OF_LINE       : NATURAL;
        begin
        if RETURNED_ANSWER
              (PROMPT      =>
             ASCII.LF & ASCII.CR & ASCII.LF & ASCII.CR &
             ASCII.LF & ASCII.CR &
             "Do you wish to see the [Network Summary] on your " &
             "screen?  " & ASCII.LF & ASCII.CR & "ENTER [y/n] --> ",
               DEFAULT     => N,
               USE_DEFAULT => TRUE,
               ERROR_TEXT  =>
             ASCII.LF & ASCII.CR &
             "INPUT ERROR:  Please ENTER  either [y] or [n] ...") =
           Y then

            TEXT_IO.OPEN
               (THE_SUMMARY_REPORT, TEXT_IO.IN_FILE,
            FILE_HANDLER.OUTFILE_ARRAY (FILE_HANDLER.TOUT).VALUE);

            while not TEXT_IO.END_OF_FILE (THE_SUMMARY_REPORT) loop
            TEXT_IO.GET_LINE
               (THE_SUMMARY_REPORT, ONE_LINE, LAST_OF_LINE);
            TEXT_IO.PUT_LINE (ONE_LINE (1 .. LAST_OF_LINE));
            end loop;

            TEXT_IO.CLOSE (THE_SUMMARY_REPORT);
                    PRESS_RETURN_TO_CONTINUE;
        end if;
        end OUTPUT_SUMMARY_ON_SCREEN;
    else

        --------------------------------------------------------------------
        -- On bad graph...
        --------------------------------------------------------------------
        raise STOP_SIMPERT;
    end if;
    end if;

exception
    when FILE_HANDLER.STOP_ON_USER_REQUEST =>
    TEXT_IO.NEW_LINE;
    TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
    TEXT_IO.PUT_LINE ("PERT terminated on user request.");
        PRESS_RETURN_TO_CONTINUE;

    when STOP_SIMPERT | FILE_HANDLER.END_FILE_HANDLER_REQUEST =>
    TEXT_IO.NEW_LINE;
    TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
    TEXT_IO.PUT_LINE ("A fatal error ocurred. PERT cannot continue.");
        PRESS_RETURN_TO_CONTINUE;

    when END_VERIFY_OUTPUT =>
    null;

    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " & "[PERT]");

end PERT;




with PERT_IO,
     TEXT_IO,
     SCREEN_IO,
     STRING_UTILITIES;

separate (SCHEDULE.PERT)
function PERT_NETWORK return PERT_OPS.GRAPH_TYPE is
----------------------------------------------------------------------------
-- Author:  Ken Lamarche
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date:    May 1985
-- Summary:
-- This function reads the file of activities, and creates a graph from it.
-- This function does not check the graph for validity, it just constructs it.
----------------------------------------------------------------------------

    ACTIVITY_FILE  : TEXT_IO.FILE_TYPE;
    ACTIVITY       : ACTIVITY_TYPE;
    EVENT          : EVENT_TYPE;
    HEADER_SET     : PERT_IO.HEADER_BUFFER_ARRAY;
    ACTIVITY_SET   : PERT_IO.INPUT_LINE_RECORD_TYPE;
    NETWORK        : PERT_OPS.GRAPH_TYPE;

    ACTIVITY_READ  : BOOLEAN := FALSE;  -- Set true when first activity is read
                       -- from the file.
    ERROR_ACTIVITY : PERT_IO.NAME_TYPE; -- Equals name of last entered activity.

------------------------------------------
-- Exceptions raised by this procedure:
------------------------------------------
    BAD_DATE_INFO      : exception;
    BAD_TIME_CODE_UNIT : exception;



----------------------------------------------------------------------------
-- This function will create a node in the graph structure given the event
-- record. (If the node doesn't exist it will create it and return the
-- NODE_TYPE. If it does exist, it will just return the existing NODE_TYPE.)
----------------------------------------------------------------------------
    function NODE (WITH_ID : INTEGER) return PERT_OPS.NODE_TYPE is
    ID        : INTEGER renames WITH_ID;
    EVENT     : EVENT_TYPE;
    NODE_LIST : constant PERT_OPS.NODE_LIST_TYPE :=
            PERT_OPS.NODES (ON_GRAPH => NETWORK);
    begin

    for INDEX in NODE_LIST'RANGE loop
        if PERT_OPS.VALUE (NODE_LIST (INDEX)).EVENT_ID = ID then
        return NODE_LIST (INDEX);
        end if;
    end loop;

    EVENT.EVENT_ID := ID;
    return PERT_OPS.NEW_NODE
          (WITH_VALUE                      => EVENT,
           MAXIMUM_NUMBER_OF_INCOMING_ARCS =>
             MAX_NUMBER_OF_ACTIVITIES_INTO_NODE,
           MAXIMUM_NUMBER_OF_OUTGOING_ARCS =>
             MAX_NUMBER_OF_ACTIVITIES_OUT_OF_NODE,
           IN_GRAPH                        => NETWORK);
    end NODE;



--------------------------------------------------------------------
-- This procedure is used to zero the values of a "dummy" activity.
-- If the activity name is "dummy", all numeric components of the
-- activity are set to zero.
--------------------------------------------------------------------
    procedure ZERO_DUMMY
         (ACTIVITY_SET : in out PERT_IO.INPUT_LINE_RECORD_TYPE) is

    begin
    if STRING_UTILITIES.LOWER_TO_UPPER
          (STRING_UTILITIES.REMOVE_LEADING_AND_TRAILING_BLANKS
          (ACTIVITY_SET.ACTIVITY_NAME)) = "DUMMY" then
        ACTIVITY_SET.OPTIMISTICS := 0.0;
        ACTIVITY_SET.MOST_LIKELY := 0.0;
        ACTIVITY_SET.PESSIMISTICS := 0.0;
        ACTIVITY_SET.STAFFING := 0.0;
        ACTIVITY_SET.RATE := 0.0;
    end if;

    return;
    end ZERO_DUMMY;



begin
    PERT_OPS.CREATE
       (A_GRAPH                 => NETWORK,
    WITH_START_NODE         => null,
    WITH_END_NODE           => null,
    MAXIMUM_NUMBER_OF_NODES => MAX_NUMBER_OF_EVENTS);

    TEXT_IO.OPEN (FILE => ACTIVITY_FILE,
          MODE => TEXT_IO.IN_FILE,
          NAME => STRING_UTILITIES.REMOVE_LEADING_AND_TRAILING_BLANKS
                 (PERT_FILE));

    PERT_IO.READ_HEADER (ACTIVITY_FILE, HEADER_SET);

    LOAD_HEADER_INFORMATION:
    declare
    LAST_INDEX, START_CHAR : POSITIVE := 1;
    DATE_INFO              : array (1 .. 3) of INTEGER;
    DATE_SPEC              : DATE_AND_TIME.CALENDAR_TYPE;

    package INT_IO is new TEXT_IO.INTEGER_IO (INTEGER);
    begin
    TIME_UNIT_CODE := TIME_UNIT_TYPE'VALUE
                (STRING_UTILITIES
                  .REMOVE_LEADING_AND_TRAILING_BLANKS
                (HEADER_SET (2).VALUE));

    for I in 1 .. 3 loop
        INT_IO.GET (FROM => HEADER_SET (3).VALUE
                   (START_CHAR .. HEADER_SET (3).LENGTH),
            ITEM => DATE_INFO (I),
            LAST => LAST_INDEX);
        START_CHAR := LAST_INDEX + 1;
    end loop;

    DATE_SPEC := (DAY   => DATE_INFO (1),
              MONTH => DATE_INFO (2),
              YEAR  => DATE_INFO (3));
    JULIAN_START_DATE := DATE_AND_TIME.JULIAN_DATE (DATE_SPEC);

    exception
    when CONSTRAINT_ERROR =>
        raise BAD_TIME_CODE_UNIT;

    when TEXT_IO.DATA_ERROR =>
        raise BAD_DATE_INFO;
    end LOAD_HEADER_INFORMATION;


    loop

    PERT_IO.READ_ONE_ACTIVITY_LINE (ACTIVITY_FILE, ACTIVITY_SET);
    ZERO_DUMMY (ACTIVITY_SET);

    ACTIVITY.NAME := (ACTIVITY_SET.WBS_CODE & "  " &
              ACTIVITY_SET.ACTIVITY_NAME);
    ACTIVITY.OPTIMISTIC_TIME := ACTIVITY_SET.OPTIMISTICS;
    ACTIVITY.MOST_PROBABLE_TIME := ACTIVITY_SET.MOST_LIKELY;
    ACTIVITY.PESSIMISTIC_TIME := ACTIVITY_SET.PESSIMISTICS;
    ACTIVITY.STAFFING := ACTIVITY_SET.STAFFING;
    ACTIVITY.RATE := ACTIVITY_SET.RATE;

    ACTIVITY_READ := TRUE;
    ERROR_ACTIVITY := ACTIVITY_SET.ACTIVITY_NAME;

    ---------------------------------------
    -- insert new activity into network
    ---------------------------------------
    PERT_OPS.CREATE_ARC (WITH_VALUE   => ACTIVITY,
                 BETWEEN_NODE => NODE (ACTIVITY_SET.TAIL_NODE),
                 AND_NODE     => NODE (ACTIVITY_SET.HEAD_NODE));
    end loop;


exception
    when PERT_IO.END_OF_ACTIVITY_FILE_REACHED =>
    if ACTIVITY_READ then
        TEXT_IO.CLOSE (ACTIVITY_FILE);
        return NETWORK;
    else
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("INPUT ERROR:");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("File " & TEXT_IO.NAME (ACTIVITY_FILE) &
                  " contains no activity information.");
        TEXT_IO.NEW_LINE;
        TEXT_IO.CLOSE (ACTIVITY_FILE);
            PRESS_RETURN_TO_CONTINUE;
        raise STOP_SIMPERT;
    end if;

    when PERT_IO.BAD_DATA | PERT_IO.VALUE_OUTSIDE_LEGAL_RANGE |
     BAD_TIME_CODE_UNIT | BAD_DATE_INFO =>

    TEXT_IO.NEW_LINE;
    TEXT_IO.PUT_LINE ("INPUT ERROR:");
    TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
    TEXT_IO.PUT_LINE ("File " & TEXT_IO.NAME (ACTIVITY_FILE) &
              " contains unexpected data ");
    TEXT_IO.SET_COL (TO => ERROR_INDENTATION);

    if ACTIVITY_READ then
        TEXT_IO.PUT_LINE ("at line following activity " &
                  STRING_UTILITIES
                   .REMOVE_LEADING_AND_TRAILING_BLANKS
                 (ERROR_ACTIVITY) & ".");
    else
        TEXT_IO.PUT_LINE ("in or following the header information.");
    end if;

    TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
    TEXT_IO.PUT_LINE ("Please CORRECT the Activity file and " &
              "RE-RUN the program.");
    TEXT_IO.CLOSE (ACTIVITY_FILE);
        PRESS_RETURN_TO_CONTINUE;
    raise STOP_SIMPERT;

    when PERT_OPS.MAXIMUM_NUMBER_OF_NODES_SPECIFIED_IN_GRAPH =>

    TEXT_IO.NEW_LINE;
    TEXT_IO.PUT_LINE ("INPUT ERROR:");
    TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
    TEXT_IO.PUT_LINE ("File " & TEXT_IO.NAME (ACTIVITY_FILE) &
              " specifies too many Event Nodes.");
        PRESS_RETURN_TO_CONTINUE;
    raise STOP_SIMPERT;

    when PERT_OPS.NOT_ENOUGH_STORAGE_REMAINING =>

    TEXT_IO.NEW_LINE;
    TEXT_IO.PUT_LINE ("INPUT ERROR:");
    TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
    TEXT_IO.PUT_LINE ("File " & TEXT_IO.NAME (ACTIVITY_FILE) &
              " specifies a graph too big for available memory.");
    TEXT_IO.CLOSE (ACTIVITY_FILE);
        PRESS_RETURN_TO_CONTINUE;
    raise STOP_SIMPERT;


    when PERT_OPS.MAXIMUM_NUMBER_OF_ARCS_SPECIFIED_BETWEEN_THESE_NODES =>

    TEXT_IO.NEW_LINE;
    TEXT_IO.PUT_LINE ("INPUT ERROR:");
    TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
    TEXT_IO.PUT_LINE ("File " & TEXT_IO.NAME (ACTIVITY_FILE) &
              " specifies an event with too many activity " &
              "in and/or out.");
    TEXT_IO.CLOSE (ACTIVITY_FILE);
        PRESS_RETURN_TO_CONTINUE;
    raise STOP_SIMPERT;

    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " & "[PERT.PERT_NETWORK]");

end PERT_NETWORK;





with NUMERIC_PRIMITIVES;

separate (SCHEDULE.PERT)
procedure PROCESS (IN_NETWORK : PERT_OPS.GRAPH_TYPE; FOR_RUN : RUN_TYPE) is
-----------------------------------------------------------------
-- Author:  Ken Lamarche
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :  May 1985
-- Summary:
-----------------------------------------------------------------

    NETWORK   : PERT_OPS.GRAPH_TYPE renames IN_NETWORK;
    NODE_LIST : constant PERT_OPS.NODE_LIST_TYPE :=
        PERT_OPS.NODES (ON_GRAPH => NETWORK);
    RUN       : RUN_TYPE renames FOR_RUN;

    function "=" (LEFT, RIGHT : PERT_OPS.NODE_TYPE) return BOOLEAN
           renames PERT_OPS."=";

    -- Set up a Floating Point IO package for reading random numbers
    -- from a file. This is temporary code for testing purposes only.
    -- The code line below should be taken out on delivery.
    package FLT_IO is new TEXT_IO.FLOAT_IO (FLOAT);

    --------------------------------------------------------------------
    -- calculate the distribution of optimistics, pessimisstics, and
    -- most likely estimates
    --------------------------------------------------------------------
    function TRIANGULAR_DISTRIBUTION
            (LOW_VALUE, MIDDLE_VALUE, HIGH_VALUE : FLOAT) return FLOAT is
    TEMP, F, HEIGHT : FLOAT;

    -----**********************************************************----
    --   Function used for testing purposes to return a random
    --   number from a file.
        --------------------------------------------------------------------
    --   function GIVE_RANDOM return FLOAT is
    --       R1 : FLOAT;
    --   begin
    --       FLT_IO.GET (RANDOM_FILE, R1);
    --       return R1;
    --   end GIVE_RANDOM;
    -----**********************************************************----

    begin
    HEIGHT := 2.0 / (HIGH_VALUE - LOW_VALUE);

    loop
        -----**********************************************************----
        --   For testing purposes, a random number is read in from a file.
        -------------------------------------------------------------------
        --   TEMP := LOW_VALUE + GIVE_RANDOM * (HIGH_VALUE - LOW_VALUE);
        -----**********************************************************----

        TEMP := LOW_VALUE +
                 NUMERIC_PRIMITIVES.RAN * (HIGH_VALUE - LOW_VALUE);

        if TEMP < MIDDLE_VALUE then
        F := HEIGHT * (TEMP - LOW_VALUE) / (MIDDLE_VALUE - LOW_VALUE);
        else
        F := HEIGHT * (TEMP - HIGH_VALUE) / (MIDDLE_VALUE - HIGH_VALUE);
        end if;

        -----**********************************************************----
        --   For testing purposes, read the random number from a file.
        -------------------------------------------------------------------
        --   exit when GIVE_RANDOM <= (F / HEIGHT);
        -----**********************************************************----

        exit when NUMERIC_PRIMITIVES.RAN <= (F / HEIGHT);
    end loop;

    return TEMP;
    end TRIANGULAR_DISTRIBUTION;


    --------------------------------------------------------------------------
    -- This procedure will handle the determined "Time Of The Event" depending
    -- on the type of run... Deterministic, or Simulation.
    --------------------------------------------------------------------------
    procedure HANDLE_TIME_OF_EVENT (EVENT_TIME : FLOAT;
                    EVENT      : in out EVENT_TYPE) is
    begin
    case RUN is
        when SIMULATION =>
        EVENT.SIM_TIME_OF_EVENT := EVENT_TIME;
        EVENT.SUM_OF_TIMES := EVENT.SUM_OF_TIMES + EVENT_TIME;
        EVENT.SUM_OF_SQUARES := EVENT.SUM_OF_SQUARES + EVENT_TIME ** 2;

        when DETERMINISTIC =>
        EVENT.DET_TIME_OF_EVENT := EVENT_TIME;
        EVENT.SIM_TIME_OF_EVENT := EVENT_TIME;
    end case;
    end HANDLE_TIME_OF_EVENT;


    --------------------------------------------------------------------
    -- This function produces a duration time for an arc, depending on
    -- whether this is a deterministic run or not. On a deterministic
    -- pert run, the duration is a three point average. On a non deter-
    -- ministic run, the duration is triangular distributed random #.
    --------------------------------------------------------------------
    function PRODUCE_DURATION (OPTIM, MOST_PROB, PESSIM : FLOAT) return FLOAT is
    begin
    if OPTIM = PESSIM then
        return OPTIM;
    else
        case RUN is
        when DETERMINISTIC =>
            return (OPTIM + MOST_PROB + PESSIM) / 3.0;

        when SIMULATION =>
            return TRIANGULAR_DISTRIBUTION (OPTIM, MOST_PROB, PESSIM);
        end case;
    end if;
    end PRODUCE_DURATION;




begin
    for NODE_INDEX in NODE_LIST'RANGE loop
    declare
        EVENT_IMAGE : PERT_OPS.NODE_TYPE renames NODE_LIST (NODE_INDEX);
        EVENT       : EVENT_TYPE := PERT_OPS.VALUE (EVENT_IMAGE);
    begin
        if EVENT_IMAGE /= PERT_OPS.START_NODE (NETWORK) then
        declare
            ARC_LIST                  : constant PERT_OPS
                              .ARC_LIST_TYPE :=
                        PERT_OPS.INCOMING_ARCS
                           (ON_NODE => EVENT_IMAGE);
            TEMP_EVENT_TIME           : FLOAT := 0.0;
            CRITICAL_ACTIVITY         : ACTIVITY_TYPE;
            MOST_CRITICAL_INBOUND_ARC : PERT_OPS.ARC_TYPE;
        begin
            for ARC_INDEX in ARC_LIST'RANGE loop

            EXAMINE_EACH_INCOMING_ARC:
            declare
                ACTIVITY       : ACTIVITY_TYPE :=
                         PERT_OPS.VALUE
                        (ARC_LIST (ARC_INDEX));
                EARLIEST_START : FLOAT :=
                         PERT_OPS.VALUE
                        (PERT_OPS.TAIL_NODE
                            (ARC_LIST (ARC_INDEX)))
                          .SIM_TIME_OF_EVENT;
                DURATION_TIME  : FLOAT :=
                         PRODUCE_DURATION
                        (ACTIVITY.OPTIMISTIC_TIME,
                         ACTIVITY.MOST_PROBABLE_TIME,
                         ACTIVITY.PESSIMISTIC_TIME);

            begin

                if (DURATION_TIME + EARLIEST_START) >
                   TEMP_EVENT_TIME then
                TEMP_EVENT_TIME :=
                  DURATION_TIME + EARLIEST_START;
                MOST_CRITICAL_INBOUND_ARC :=
                  ARC_LIST (ARC_INDEX);
                end if;
            end EXAMINE_EACH_INCOMING_ARC;

            end loop;

            CRITICAL_ACTIVITY :=
              PERT_OPS.VALUE (MOST_CRITICAL_INBOUND_ARC);

            if RUN = SIMULATION then
            CRITICAL_ACTIVITY.ON_CP_COUNT :=
              CRITICAL_ACTIVITY.ON_CP_COUNT + 1.0;
            end if;

            PERT_OPS.ASSIGN
               (CRITICAL_ACTIVITY, MOST_CRITICAL_INBOUND_ARC);

            HANDLE_TIME_OF_EVENT (TEMP_EVENT_TIME, EVENT);
            PERT_OPS.ASSIGN (EVENT, EVENT_IMAGE);
        end;
        -- processing for a given node
        end if;
        -- node processed was not the start node
    end;
    -- block for node processing declarations
    end loop;

exception
    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " & "[PERT.PROCESS]");

end PROCESS;





with TEXT_IO;

separate (SCHEDULE.PERT)
procedure IS_GOOD (PERT_NETWORK : in out PERT_OPS.GRAPH_TYPE;
           OK           : out BOOLEAN) is
-----------------------------------------------------------
-- Author:     Larry Yelowitz
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :     May 25 1985
-- Summary:    This procedure verifies the validity of a network
-----------------------------------------------------------

    SINK_LIST   : constant PERT_OPS.NODE_LIST_TYPE :=
          PERT_OPS.LIST_OF_SINKS (IN_GRAPH => PERT_NETWORK);
    SOURCE_LIST : constant PERT_OPS.NODE_LIST_TYPE :=
          PERT_OPS.LIST_OF_SOURCES (IN_GRAPH => PERT_NETWORK);

    package INT_IO is new TEXT_IO.INTEGER_IO (INTEGER);


begin

    OK := TRUE;

    begin
    PERT_OPS.TOPSORT (PERT_NETWORK.NODE_LIST);
    exception
    when PERT_OPS.CYCLE_EXISTS =>

        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("PERT NETWORK ERROR:");

        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("Cycles were found in your network.");
            PRESS_RETURN_TO_CONTINUE;
        OK := FALSE;
    end;


    case SINK_LIST'LENGTH is
    when 0 =>
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("PERT NETWORK ERROR:");

        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE
           ("You have not specified an ending event in the network.");
            PRESS_RETURN_TO_CONTINUE;
        OK := FALSE;

    when 1 =>  PERT_OPS.SET_END_NODE (SINK_LIST (1), PERT_NETWORK);

    when others =>
        OK := FALSE;
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("PERT NETWORK ERROR:");

        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("You have specified more than one ending event.");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("These are event numbers:");

        for INDEX in SINK_LIST'RANGE loop
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        INT_IO.PUT (PERT_OPS.VALUE (SINK_LIST (INDEX)).EVENT_ID);
        TEXT_IO.NEW_LINE;
        end loop;
            PRESS_RETURN_TO_CONTINUE;
    end case;

    case SOURCE_LIST'LENGTH is
    when 0 =>
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("PERT NETWORK ERROR:");

        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE
           ("You have not specified a starting event in the network.");
            PRESS_RETURN_TO_CONTINUE;
        OK := FALSE;

    when 1 =>  PERT_OPS.SET_START_NODE (SOURCE_LIST (1), PERT_NETWORK);

    when others =>
        OK := FALSE;
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("PERT NETWORK ERROR:");

        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("You have specified more than one " &
                  "starting event in the network.");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("These are event numbers:");

        for INDEX in SOURCE_LIST'RANGE loop
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        INT_IO.PUT (PERT_OPS.VALUE (SOURCE_LIST (INDEX)).EVENT_ID);
        TEXT_IO.NEW_LINE;
        end loop;
            PRESS_RETURN_TO_CONTINUE;
    end case;

exception
    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " & "[PERT.IS_GOOD]");

end IS_GOOD;





with MATH_FUNCTIONS;

separate (SCHEDULE.PERT)
procedure OVERALL_CALCS (PERT_NETWORK : PERT_OPS.GRAPH_TYPE) is
---------------------------------------------------------------------------
-- Author:  Ken Lamarche
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :  May 1985
-- Summary:
-- This procedure is called to perform overall calculations for the SIMPERT
-- process following the iterations of the pert program. The calculations
-- include setting averages and variances of event times, criticallity
-- values for nodes and arcs, start and stop times for the activities.
---------------------------------------------------------------------------

    NETWORK : PERT_OPS.GRAPH_TYPE renames PERT_NETWORK;


    function PROB_TIME (TIME, VARIANCE_OF_TIME : FLOAT) return FLOAT is

    begin
    if PROBABILITY_FOR_OUTPUT = 0.5 then
        return TIME;
    else
        return MATH_FUNCTIONS.INVERSE_NORMAL_FUNCTION
              (PROBABILITY_FOR_OUTPUT, TIME, VARIANCE_OF_TIME);
    end if;
    end PROB_TIME;




begin

    declare
    NODE_LIST : constant PERT_OPS.NODE_LIST_TYPE :=
            PERT_OPS.NODES (ON_GRAPH => NETWORK);

    function "=" (LEFT, RIGHT : PERT_OPS.NODE_TYPE) return BOOLEAN
               renames PERT_OPS."=";
    begin
    for NODE_INDEX in NODE_LIST'RANGE loop

        PROCESS_THE_NODE:
        declare
        EVENT_IMAGE                       : PERT_OPS.NODE_TYPE
                             renames NODE_LIST
                                (NODE_INDEX);
        EVENT                             : EVENT_TYPE :=
                            PERT_OPS.VALUE
                               (EVENT_IMAGE);
        INDEX_OF_ARC_WITH_HIGH_CRIT_COUNT : NATURAL := 0;
        begin
        EVENT.SIM_TIME_OF_EVENT :=
          EVENT.SUM_OF_TIMES / FLOAT (NUMBER_OF_ITERATIONS);
        EVENT.VARIANCE :=
          (EVENT.SUM_OF_SQUARES -
           FLOAT (NUMBER_OF_ITERATIONS) *
           (EVENT.SIM_TIME_OF_EVENT ** 2)) /
          FLOAT (NUMBER_OF_ITERATIONS - 1);

        -- variance might go negative due to round-off
        -- for this case variance is reset to 0.0

        if EVENT.VARIANCE < 0.0 then
            EVENT.VARIANCE := 0.0;
        end if;

        if EVENT_IMAGE /= PERT_OPS.START_NODE (NETWORK) then

            EVENT.ESTIMATE_TIME_OF_EVENT :=
              PROB_TIME (EVENT.SIM_TIME_OF_EVENT, EVENT.VARIANCE);

            HANDLE_INCOMING_ARCS:
            declare
            ARC_LIST           : constant PERT_OPS.ARC_LIST_TYPE :=
                         PERT_OPS.INCOMING_ARCS
                        (ON_NODE => EVENT_IMAGE);
            HIGHEST_CRIT_COUNT : FLOAT := 0.0;
            ACTIVITY           : ACTIVITY_TYPE;
            TAIL_OF_ACT        : EVENT_TYPE;
            begin
            for ARC_INDEX in ARC_LIST'RANGE loop
                ACTIVITY := PERT_OPS.VALUE (ARC_LIST (ARC_INDEX));
                ACTIVITY.ON_CP_COUNT :=
                  ACTIVITY.ON_CP_COUNT /
                  FLOAT (NUMBER_OF_ITERATIONS);

                if ACTIVITY.ON_CP_COUNT > HIGHEST_CRIT_COUNT then
                INDEX_OF_ARC_WITH_HIGH_CRIT_COUNT := ARC_INDEX;
                HIGHEST_CRIT_COUNT := ACTIVITY.ON_CP_COUNT;
                end if;

                PERT_OPS.ASSIGN (ACTIVITY, ARC_LIST (ARC_INDEX));
                TAIL_OF_ACT :=
                  PERT_OPS.VALUE
                 (PERT_OPS.TAIL_NODE (ARC_LIST (ARC_INDEX)));

                if TAIL_OF_ACT.LONGEST_PATH_TO_EVENT + 1 >
                   EVENT.LONGEST_PATH_TO_EVENT then
                EVENT.LONGEST_PATH_TO_EVENT :=
                  TAIL_OF_ACT.LONGEST_PATH_TO_EVENT + 1;
                end if;
            end loop;

            ACTIVITY :=
              PERT_OPS.VALUE
                 (ARC_LIST (INDEX_OF_ARC_WITH_HIGH_CRIT_COUNT));
            ACTIVITY.ESTIMATE_STOP := EVENT.ESTIMATE_TIME_OF_EVENT;
            PERT_OPS.ASSIGN
               (ACTIVITY,
                ARC_LIST (INDEX_OF_ARC_WITH_HIGH_CRIT_COUNT));
            end HANDLE_INCOMING_ARCS;

        else

            EVENT.ESTIMATE_TIME_OF_EVENT := 0.0;

        end if;

        EVENT.MOST_CRIT_INBOUND_ARC :=
          INDEX_OF_ARC_WITH_HIGH_CRIT_COUNT;

        if EVENT_IMAGE /= PERT_OPS.END_NODE (OF_GRAPH => NETWORK) then

            HANDLE_OUTGOING_ARCS:
            declare
            ARC_LIST         : constant PERT_OPS.ARC_LIST_TYPE :=
                       PERT_OPS.OUTGOING_ARCS
                          (ON_NODE => EVENT_IMAGE);
            ACTIVITY         : ACTIVITY_TYPE;
            TIME             : FLOAT;
            VARIANCE_OF_TIME : FLOAT;
            begin
            for ARC_INDEX in ARC_LIST'RANGE loop
                ACTIVITY := PERT_OPS.VALUE (ARC_LIST (ARC_INDEX));
                ACTIVITY.DURATION_TIME :=
                  (ACTIVITY.OPTIMISTIC_TIME +
                   ACTIVITY.MOST_PROBABLE_TIME +
                   ACTIVITY.PESSIMISTIC_TIME) / 3.0;

                ACTIVITY.ESTIMATE_START :=
                  EVENT.ESTIMATE_TIME_OF_EVENT;

                TIME := EVENT.SIM_TIME_OF_EVENT +
                    ACTIVITY.DURATION_TIME;
                VARIANCE_OF_TIME :=
                  EVENT.VARIANCE +
                  (((ACTIVITY.PESSIMISTIC_TIME -
                 ACTIVITY.OPTIMISTIC_TIME) ** 2 +
                (ACTIVITY.MOST_PROBABLE_TIME -
                 ACTIVITY.OPTIMISTIC_TIME) *
                (ACTIVITY.MOST_PROBABLE_TIME -
                 ACTIVITY.PESSIMISTIC_TIME)) / 18.0);
                ACTIVITY.ESTIMATE_STOP :=
                  PROB_TIME (TIME, VARIANCE_OF_TIME);

                PERT_OPS.ASSIGN (ACTIVITY, ARC_LIST (ARC_INDEX));
            end loop;
            end HANDLE_OUTGOING_ARCS;

        end if;

        PERT_OPS.ASSIGN (EVENT, EVENT_IMAGE);
        end PROCESS_THE_NODE;

    end loop;

    -----------------------------------------------------------
    -- Figure the Node and Activity Critical Path Index.
    -- Go through the nodes in reverse order.
    -----------------------------------------------------------
    for NODE_INDEX in reverse NODE_LIST'RANGE loop

        FIGURE_CRITS_FOR_EACH_NODE:
        declare
        EVENT_IMAGE : PERT_OPS.NODE_TYPE renames NODE_LIST (NODE_INDEX);
        EVENT       : EVENT_TYPE := PERT_OPS.VALUE (EVENT_IMAGE);
        begin
        if EVENT_IMAGE = PERT_OPS.END_NODE (NETWORK) then
            EVENT.CRIT_PATH_INDEX := 1.0;
        end if;

        if EVENT_IMAGE /= PERT_OPS.START_NODE (NETWORK) then
            SET_CRIT_INDEX_FOR_EACH_INCOMING_ARC:
            declare
            ARC_LIST : constant PERT_OPS.ARC_LIST_TYPE :=
                   PERT_OPS.INCOMING_ARCS
                      (ON_NODE => EVENT_IMAGE);
            ACTIVITY : ACTIVITY_TYPE;
            begin
            for ARC_INDEX in ARC_LIST'RANGE loop
                ACTIVITY := PERT_OPS.VALUE (ARC_LIST (ARC_INDEX));
                ACTIVITY.ON_CP_COUNT :=
                  ACTIVITY.ON_CP_COUNT * EVENT.CRIT_PATH_INDEX;

                GET_TAIL_EVENT_NODE:
                declare
                TAIL_IMAGE : PERT_OPS.NODE_TYPE :=
                         PERT_OPS.TAIL_NODE
                        (ARC_LIST (ARC_INDEX));
                TAIL       : EVENT_TYPE :=
                         PERT_OPS.VALUE (TAIL_IMAGE);
                begin
                TAIL.CRIT_PATH_INDEX :=
                  TAIL.CRIT_PATH_INDEX + ACTIVITY.ON_CP_COUNT;
                PERT_OPS.ASSIGN (TAIL, TAIL_IMAGE);
                end GET_TAIL_EVENT_NODE;

                PERT_OPS.ASSIGN (ACTIVITY, ARC_LIST (ARC_INDEX));
            end loop;
            end SET_CRIT_INDEX_FOR_EACH_INCOMING_ARC;

            ----------------------------------------------------------
            -- for critical arc into the given node, bump up the
            -- est. stop of the arc to be est. time of event of the node
            ----------------------------------------------------------
            declare
            ACTIVITY : ACTIVITY_TYPE;
            begin
            if EVENT.MOST_CRIT_INBOUND_ARC /= 0 then
                ACTIVITY :=
                  PERT_OPS.VALUE
                 (EVENT_IMAGE.INCOMING_ARCS
                     (EVENT.MOST_CRIT_INBOUND_ARC));

                ACTIVITY.ESTIMATE_STOP :=
                  EVENT.ESTIMATE_TIME_OF_EVENT;
                PERT_OPS.ASSIGN
                   (ACTIVITY,
                EVENT_IMAGE.INCOMING_ARCS
                   (EVENT.MOST_CRIT_INBOUND_ARC));
            end if;
            end;

        end if;

        PERT_OPS.ASSIGN (EVENT, EVENT_IMAGE);
        end FIGURE_CRITS_FOR_EACH_NODE;

    end loop;

    ---------------------------------------------------------------------
    -- Loop through the nodes of the graph in reverse order to figure the
    -- deterministic late time of each event. This is the latest time the
    -- event can happen and still not affect the completion date of the
    -- whole project.
    ---------------------------------------------------------------------
    for NODE_INDEX in reverse NODE_LIST'RANGE loop
        FIGURE_DET_LATE_TIMES_FOR_EVENTS:
        declare
        EVENT_IMAGE : PERT_OPS.NODE_TYPE renames NODE_LIST (NODE_INDEX);
        EVENT       : EVENT_TYPE := PERT_OPS.VALUE (EVENT_IMAGE);
        begin
        if EVENT_IMAGE = PERT_OPS.END_NODE (NETWORK) then
            EVENT.DET_LATE_TIME_OF_EVENT := EVENT.DET_TIME_OF_EVENT;
        else
            FIND_LATEST_SAFE_TIME_FOR_EVENT:
            declare
            ARC_LIST : constant PERT_OPS.ARC_LIST_TYPE :=
                   PERT_OPS.OUTGOING_ARCS
                      (ON_NODE => EVENT_IMAGE);
            ACTIVITY : ACTIVITY_TYPE;
            begin
            for ARC_INDEX in ARC_LIST'RANGE loop
                ACTIVITY := PERT_OPS.VALUE (ARC_LIST (ARC_INDEX));

                GET_HEAD_EVENT:
                declare
                HEAD_IMAGE : PERT_OPS.NODE_TYPE :=
                         PERT_OPS.HEAD_NODE
                        (ARC_LIST (ARC_INDEX));
                HEAD       : EVENT_TYPE :=
                         PERT_OPS.VALUE (HEAD_IMAGE);
                begin
                if (EVENT.DET_LATE_TIME_OF_EVENT = -1.0) or
                   (HEAD.DET_LATE_TIME_OF_EVENT -
                    ACTIVITY.DURATION_TIME <
                    EVENT.DET_LATE_TIME_OF_EVENT) then
                    EVENT.DET_LATE_TIME_OF_EVENT :=
                      HEAD.DET_LATE_TIME_OF_EVENT -
                      ACTIVITY.DURATION_TIME;
                end if;
                end GET_HEAD_EVENT;
            end loop;
            end FIND_LATEST_SAFE_TIME_FOR_EVENT;
        end if;

        PERT_OPS.ASSIGN (EVENT, EVENT_IMAGE);

        end FIGURE_DET_LATE_TIMES_FOR_EVENTS;
    end loop;


    FIGURE_CONFIDENCE_INTERVAL:
    declare
        EVENT_IMAGE : PERT_OPS.NODE_TYPE renames NODE_LIST (NODE_LIST'LAST);
        EVENT       : EVENT_TYPE := PERT_OPS.VALUE (EVENT_IMAGE);

        function "**" (X, Y : FLOAT) return FLOAT
                renames MATH_FUNCTIONS."**";
    begin
        CONFIDENCE_INTERVAL :=
          1.645 * (EVENT.VARIANCE ** 0.5) /
          ((FLOAT (NUMBER_OF_ITERATIONS)) ** 0.5);
    end FIGURE_CONFIDENCE_INTERVAL;

    end;

exception
    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " & "[PERT.OVERALL_CALCS]");


end OVERALL_CALCS;





with MATH_FUNCTIONS,
     CALENDAR,
     TEXT_IO,
     SCREEN_IO,
     DATE_AND_TIME,
     STRING_UTILITIES;

separate (SCHEDULE.PERT)
procedure OUTPUT_VALUES is
------------------------------------------------------------------
-- Author: K. Lamarche and T. C. Bryan
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  : May 1985
-- Summary:
-- This procedure is used to output the reports of the SIMPERT run.
-- A separate procedure is used to print every report.
------------------------------------------------------------------

    subtype INT_NUM is INTEGER range 0 .. 1000000;

    package I_NUMBER is new TEXT_IO.INTEGER_IO (INT_NUM);

    subtype FLOAT_NUM is FLOAT range 0.0 .. 100_000.0;

    package F_NUMBER is new TEXT_IO.FLOAT_IO (FLOAT_NUM);

    --------------------------------------------------------------
    -- names of various reports that are outputted by SIMPERT run
    --------------------------------------------------------------
    THE_SUMMARY_REPORT_NAME  : constant STRING :=
                   FILE_HANDLER.OUTFILE_ARRAY (FILE_HANDLER.TOUT)
                .VALUE;

    THE_ACTIVITY_REPORT_NAME : constant STRING :=
                   FILE_HANDLER.OUTFILE_ARRAY (FILE_HANDLER.ACT)
                .VALUE;

    THE_NODE_REPORT_NAME     : constant STRING :=
                   FILE_HANDLER.OUTFILE_ARRAY (FILE_HANDLER.NODE)
                .VALUE;

    THE_MANPOWER_REPORT_NAME : constant STRING :=
                   FILE_HANDLER.OUTFILE_ARRAY (FILE_HANDLER.MAN)
                .VALUE;

    THE_GANTT_REPORT_NAME    : constant STRING :=
                   FILE_HANDLER.OUTFILE_ARRAY (FILE_HANDLER.BARIN)
                .VALUE;

    TIME_NOW                 : CALENDAR.TIME := CALENDAR.CLOCK;
    DATE_SPEC_NOW            : DATE_AND_TIME.CALENDAR_TYPE :=
                   (DAY   => CALENDAR.DAY (TIME_NOW),
                MONTH => CALENDAR.MONTH (TIME_NOW),
                YEAR  => CALENDAR.YEAR (TIME_NOW) - 1900);
    JULIAN_DATE_NOW          : DATE_AND_TIME.JULIAN_TYPE :=
                   DATE_AND_TIME.JULIAN_DATE (DATE_SPEC_NOW);

    BIG_ACTIVITY_LIST        : PERT_OPS.ARC_LIST_TYPE (ACTIVITY_ID_TYPE);
    BIG_LIST_INDEX           : NATURAL := 0;
    TOTAL_FREE_SLACK         : FLOAT := 0.0;
    CRIT_PATH_HEAD_NODE      : INTEGER :=
                   SCREEN_IO.RETURNED_INTEGER
                  (PROMPT      =>
                     ASCII.FF & ASCII.LF & ASCII.CR &
                     "ENTER the last event for the " &
                     "critical path to be returned  ",
                   DEFAULT     =>
                     PERT_OPS.VALUE
                    (PERT_OPS.END_NODE
                        (OF_GRAPH => NETWORK)).EVENT_ID,
                   USE_DEFAULT => TRUE);

    MAX_NUM_HOLIDAYS         : constant := 200;

    type HOLIDAY_ARRAY is array (1 .. MAX_NUM_HOLIDAYS)
                 of DATE_AND_TIME.JULIAN_TYPE;

    HOLIDAYS            : HOLIDAY_ARRAY;
    ACTUAL_NUM_HOLIDAYS : INTEGER := 0;

    OUTPUT_REPORT_TITLE : constant STRING :=
              FILE_HANDLER.VERIFY_LABEL
                 (WITH_PROMPT     =>
                "ENTER a Title for the output reports." &
                "  [60 characters or less]",
                  STRING_TYPE     => "Title",
                  LENGTH_OF_LABEL => 60);



    function "**" (X, Y : FLOAT) return FLOAT renames MATH_FUNCTIONS."**";



    -------------------------------------------------------
    -- convert a julian date into a 9 character field
    -- representing a date.  The resulted date is given in the
    -- format dd/name_month/yy where:
    -- dd is the day, name_month is the first 3 characters
    -- of a month name, and yy is the last two digits of the
    -- 4 digit year.
    -- e.g. 14 Mar 85, if dd is a one non-blank character then
    -- dd contains one blank and following by a digit.
    --
    -- Author: T. C. Bryan
    -- Source:     Division Software Technology and Support
    --             Western Development Laboratories
    --             Ford Aerospace & Communications Corporation
    --             ATTN:  Ada Tools Group
    -- Library use : date_and_time.
    -- Date:  17 May 85
    -------------------------------------------------------
    function CONVERT_TO_NORMAL_DATE
            (THE_JULIAN_IS : DATE_AND_TIME.JULIAN_TYPE) return STRING is

    DATE_SPEC : DATE_AND_TIME.CALENDAR_TYPE :=
            DATE_AND_TIME.CALENDAR_DATE (THE_JULIAN_IS);
    WANT_DATE : constant STRING :=
            (DATE_AND_TIME.DATE
            (DATE_SPEC.DAY, DATE_SPEC.MONTH,
             DATE_SPEC.YEAR + 1900));
    begin
    if WANT_DATE'LENGTH = 11 then
        return (WANT_DATE (1 .. 2) & " " & WANT_DATE (4 .. 6) & " " &
            WANT_DATE (10 .. 11));
    else
        return (WANT_DATE (2 .. 3) & " " & WANT_DATE (5 .. 7) & " " &
            WANT_DATE (11 .. 12));
    end if;
    end CONVERT_TO_NORMAL_DATE;




    ------------------------------------------------------------
    -- write a common header report for all reports derived
    -- from SIMPERT run.  Handle different page width with default
    -- set for 132 column-page.  Report title, if any, will be
    -- centered according to page width inputted.
    ------------------------------------------------------------
    procedure WRITE_HEADER_REPORT
         (TO_FILE       : TEXT_IO.FILE_TYPE :=
                  TEXT_IO.CURRENT_OUTPUT;
          FORM_NAME     : STRING := " ";
          PAGE_WIDTH    : INTEGER := 132;
          TITLE         : STRING :=
                  STRING_UTILITIES
                   .REMOVE_LEADING_AND_TRAILING_BLANKS
                     (OUTPUT_REPORT_TITLE);
          ESTIMATE      : STRING :=
                  STRING_UTILITIES
                   .REMOVE_LEADING_AND_TRAILING_BLANKS
                     (PERT_FILE);
          PROBABILITY   : STRING :=
                  INTEGER'IMAGE
                    (INTEGER (100.0 *
                          PROBABILITY_FOR_OUTPUT)) & "%";
          ITERATIONS    : INTEGER := NUMBER_OF_ITERATIONS;
          INTERVAL_IS   : FLOAT := CONFIDENCE_INTERVAL;
          TODAY_IS      : DATE_AND_TIME.JULIAN_TYPE :=
                  JULIAN_DATE_NOW;
          TIME_IS       : STRING := DATE_AND_TIME.CURRENT_TIME;
          START_DATE_IS : DATE_AND_TIME.JULIAN_TYPE :=
                  JULIAN_START_DATE) is

    CENTER_HEADING              : INTEGER := FORM_NAME'LENGTH;
    RIGHT_MARGIN                : constant INTEGER :=
                      (PAGE_WIDTH - CENTER_HEADING) / 2;
    LEFT_MARGIN                 : constant INTEGER := PAGE_WIDTH - 31;
    COLON_INDENT                : TEXT_IO.COUNT := 18;

    RIGHT_MARGIN_FOR_FORM_TITLE : TEXT_IO.COUNT :=
                      TEXT_IO.COUNT (RIGHT_MARGIN);
    LEFT_TEXT_MARGIN            : TEXT_IO.COUNT :=
                      TEXT_IO.COUNT (LEFT_MARGIN);

    begin

    TEXT_IO.NEW_PAGE (TO_FILE);
    TEXT_IO.NEW_LINE (TO_FILE, 5);
    TEXT_IO.SET_COL (TO_FILE, TO => RIGHT_MARGIN_FOR_FORM_TITLE);
    TEXT_IO.PUT_LINE (TO_FILE, FORM_NAME);
    TEXT_IO.NEW_LINE (TO_FILE, 2);

    TEXT_IO.PUT (TO_FILE, "SIMPERT Version 1.0");
    TEXT_IO.SET_COL (TO_FILE, TO => LEFT_TEXT_MARGIN);
    TEXT_IO.PUT_LINE (TO_FILE,
              "        Date Today:  " &
              CONVERT_TO_NORMAL_DATE (TODAY_IS));

    TEXT_IO.SET_COL (TO_FILE, TO => LEFT_TEXT_MARGIN);
    TEXT_IO.PUT_LINE (TO_FILE, "              Time: " & TIME_IS);

    TEXT_IO.PUT (TO_FILE, "Title");
    TEXT_IO.SET_COL (TO_FILE, TO => COLON_INDENT);
    TEXT_IO.PUT_LINE (TO_FILE, ":  " & TITLE);

    TEXT_IO.NEW_LINE (TO_FILE);
    TEXT_IO.PUT (TO_FILE, "Estimate file");
    TEXT_IO.SET_COL (TO_FILE, TO => COLON_INDENT);
    TEXT_IO.PUT (TO_FILE, ":  " & ESTIMATE);
    TEXT_IO.SET_COL (TO_FILE, TO => LEFT_TEXT_MARGIN);
    TEXT_IO.PUT_LINE (TO_FILE,
              "Date Project Start:  " &
              CONVERT_TO_NORMAL_DATE (START_DATE_IS));

    TEXT_IO.PUT (TO_FILE, "Probability");
    TEXT_IO.SET_COL (TO_FILE, TO => COLON_INDENT);
    TEXT_IO.PUT_LINE (TO_FILE, ":  " & PROBABILITY);

    TEXT_IO.PUT (TO_FILE, "Iterations");
    TEXT_IO.SET_COL (TO_FILE, TO => COLON_INDENT);
    TEXT_IO.PUT (TO_FILE, ":  ");
    I_NUMBER.PUT (TO_FILE, ITERATIONS, WIDTH => 4);
    TEXT_IO.NEW_LINE (TO_FILE);

    TEXT_IO.PUT (TO_FILE, "Conf Interval");
    TEXT_IO.SET_COL (TO_FILE, TO => COLON_INDENT);
    TEXT_IO.PUT (TO_FILE, ":  ");

    if (INTERVAL_IS <= 0.09) then
        TEXT_IO.PUT (TO_FILE, " 0.0");
    else
        F_NUMBER.PUT (TO_FILE, INTERVAL_IS, EXP => 0, FORE => 2, AFT => 1);
    end if;

    TEXT_IO.NEW_LINE (TO_FILE, 3);
    end WRITE_HEADER_REPORT;



    -----------------------------------------------------------------
    -- create a list of all activities excluding "dummy" activities
    -----------------------------------------------------------------
    procedure ADD_NON_DUMMY_ACTIVITY (ARC : PERT_OPS.ARC_TYPE) is
    begin
    if STRING_UTILITIES.LOWER_TO_UPPER
          (STRING_UTILITIES.REMOVE_LEADING_AND_TRAILING_BLANKS
          (PERT_OPS.VALUE (ARC).NAME (11 .. 42))) /= "DUMMY" then
        BIG_LIST_INDEX := BIG_LIST_INDEX + 1;
        BIG_ACTIVITY_LIST (BIG_LIST_INDEX) := ARC;
    end if;
    end ADD_NON_DUMMY_ACTIVITY;



    -----------------------------------------------------------------
    -- return a label for a unit of number of days or weeks
    -----------------------------------------------------------------
    function REQUESTED_UNIT_CODE return STRING is
    begin
    if TIME_UNIT_CODE = W then
        return ("Weeks");
    else
        return ("Days");
    end if;
    end REQUESTED_UNIT_CODE;



    ---------------------------------------------------
    -- compute the actual unit required in whole number
    ---------------------------------------------------
    function TO_DAYS (TIME_UNIT : INTEGER) return INTEGER is
    begin
    if TIME_UNIT_CODE = W then
        return WORKDAYS_PER_WEEK * TIME_UNIT;
    else
        return TIME_UNIT;
    end if;
    end TO_DAYS;


-------------------------------------------------------------------------
--  Procedure used to read the holidays file into an array. The array will
--  be used by subsequent functions to determine real dates from project
--  time offsets.
-------------------------------------------------------------------------
    procedure READ_HOLIDAY_FILE is

    HOLI         : DATE_AND_TIME.CALENDAR_TYPE;
    HOLIDAY_FILE : TEXT_IO.FILE_TYPE;

    begin

    TEXT_IO.OPEN (FILE => HOLIDAY_FILE,
              MODE => TEXT_IO.IN_FILE,
              NAME =>
            STRING_UTILITIES.REMOVE_LEADING_AND_TRAILING_BLANKS
               (FILE_OF_HOLIDAYS));

    while not TEXT_IO.END_OF_FILE (HOLIDAY_FILE) loop
        I_NUMBER.GET (HOLIDAY_FILE, HOLI.DAY, WIDTH => 2);
        TEXT_IO.SET_COL (HOLIDAY_FILE, 4);
        I_NUMBER.GET (HOLIDAY_FILE, HOLI.MONTH, WIDTH => 2);
        TEXT_IO.SET_COL (HOLIDAY_FILE, 7);
        I_NUMBER.GET (HOLIDAY_FILE, HOLI.YEAR, WIDTH => 2);
        ACTUAL_NUM_HOLIDAYS := ACTUAL_NUM_HOLIDAYS + 1;

        if ACTUAL_NUM_HOLIDAYS > MAX_NUM_HOLIDAYS then
        ACTUAL_NUM_HOLIDAYS := MAX_NUM_HOLIDAYS;
        exit;
        end if;

        HOLIDAYS (ACTUAL_NUM_HOLIDAYS) := DATE_AND_TIME.JULIAN_DATE (HOLI);
        TEXT_IO.SKIP_LINE (HOLIDAY_FILE);
    end loop;


    exception
    when TEXT_IO.DATA_ERROR =>

        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("INPUT ERROR:");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE
           ("Holiday information file contains unexpected data");
        TEXT_IO.CLOSE (HOLIDAY_FILE);
            PRESS_RETURN_TO_CONTINUE;

    when TEXT_IO.END_ERROR =>
        TEXT_IO.CLOSE (HOLIDAY_FILE);

    end READ_HOLIDAY_FILE;




-------------------------------------------------------------------------
--  Compute number of working days between start and end inclusive.
--  This function assumes that a global variable HOLIDAYS is an array
--    which stores the julians of the holidays in increasing order,
--    and that the global variable ACTUAL_NUM_HOLIDAYS is an exact count
--    of the number of julian holidays stored.  Ie, HOLIDAYS is searched
--    from 1..ACTUAL_NUM_HOLIDAYS.
--  This function also assumes that a global variable WORKDAYS_PER_WEEK
--    is available, with a value of 5, 6, or 7.
-------------------------------------------------------------------------
    function WORKDAYS_BETWEEN (START  : DATE_AND_TIME.JULIAN_TYPE;
                   FINISH : DATE_AND_TIME.JULIAN_TYPE)
                    return DATE_AND_TIME.JULIAN_TYPE is

    ANSWER : DATE_AND_TIME.JULIAN_TYPE;
    WPW    : INTEGER renames WORKDAYS_PER_WEEK;


    function NPM (JULIAN_DAY : DATE_AND_TIME.JULIAN_TYPE)
               return DATE_AND_TIME.JULIAN_TYPE
               renames DATE_AND_TIME.NEAREST_PRECEDING_MONDAY;



    ------------------------------------------------------------
    -- return number of holidays between LOW and HIGH inclusive.
    ------------------------------------------------------------
    function NUMBER_HOLIDAYS (LOW, HIGH : DATE_AND_TIME.JULIAN_TYPE)
                   return INTEGER is
        COUNT : INTEGER := 0;
    begin
        for I in 1 .. ACTUAL_NUM_HOLIDAYS loop
        if HOLIDAYS (I) in LOW .. HIGH then
            COUNT := COUNT + 1;
        end if;
        end loop;

        return COUNT;
    end NUMBER_HOLIDAYS;


    begin
    if FINISH < START then
        return 0;
    end if;

    ANSWER := FINISH - START + 1; --begin with no. of calendar days
    ANSWER := ANSWER - ((NPM (FINISH) - NPM (START)) / 7) * (7 - WPW);
    --approx number of weekends have now been subtracted.
    if ((FINISH rem 7) = 6 and WPW < 6) then
        ANSWER := ANSWER - 1;
    end if;
    -- if FINISH is a Saturday, it has to be subtracted
    -- separately, which was just done.
    if ((START rem 7) = 0 and WPW < 7) then
        ANSWER := ANSWER - 1;
    end if;
    -- if START is a Sunday, then it has to be subtracted
    -- separately, since npm(sunday) returns following mon.
    ANSWER := ANSWER - NUMBER_HOLIDAYS (START, FINISH);
    return ANSWER;
    end WORKDAYS_BETWEEN;



    -----------------------------------------------
    -- return the Nth working day at or past J.
    -----------------------------------------------
    function FIND_PROPER_DATE (J : DATE_AND_TIME.JULIAN_TYPE;
                   N : POSITIVE) return DATE_AND_TIME.JULIAN_TYPE is

    GUESS : DATE_AND_TIME.JULIAN_TYPE; --Will contain returned value.



    -------------------------------------------------------
    -- figure out if the day is one of the recorded holiday
    -------------------------------------------------------
    function IS_HOLIDAY (DAY : DATE_AND_TIME.JULIAN_TYPE) return BOOLEAN is
    begin
        for I in 1 .. ACTUAL_NUM_HOLIDAYS loop
        if HOLIDAYS (I) = DAY then
            return TRUE;

        elsif HOLIDAYS (I) > DAY then
            return FALSE;
        end if;
        end loop;

        return FALSE; --DAY is beyond all recorded holidays
    end IS_HOLIDAY;



    -------------------------------------------------------
    --
    -------------------------------------------------------
    function PROPER_DATE (J : DATE_AND_TIME.JULIAN_TYPE;
                  N : POSITIVE) return DATE_AND_TIME.JULIAN_TYPE is

        N1 : NATURAL :=
         N - 1 + (N / WORKDAYS_PER_WEEK) * (7 - WORKDAYS_PER_WEEK);
        -- N1 is a guess as to be the returned value
        -- of this function, based on number of weekends.
        N2 : NATURAL := WORKDAYS_BETWEEN (J, J + N1);
    begin
        if N2 >= N then
        return J + N1;
        else
        return PROPER_DATE (J + N1 + 1, N - N2);
        end if;
    end PROPER_DATE;



    begin
    GUESS := PROPER_DATE (J, N);
    -- GUESS may have returned a holiday or weekend.
    -- Return first preceding workday.
    loop
        if (GUESS rem 7 = 6) and WORKDAYS_PER_WEEK < 6 then
        GUESS := GUESS - 1;      -- Sat., so try preceding day.
        elsif (GUESS rem 7 = 0) and WORKDAYS_PER_WEEK < 7 then
        GUESS := GUESS - 2;      -- Sun, so try preceding friday.
        elsif IS_HOLIDAY (GUESS) then
        GUESS := GUESS - 1;      -- holiday, so try preceding day.
        else
        exit;
        end if;
    end loop;

    return GUESS;
    end FIND_PROPER_DATE;


    function GET_NEW_DATE (WITH_YESNO_PROMPT : STRING;
               PASSED_DATE       : DATE_AND_TIME.JULIAN_TYPE;
               AND_TEXT_PROMPT   : STRING)
                return DATE_AND_TIME.JULIAN_TYPE is


    type ANSWER is (Y, N);

    function RETURNED_ANSWER is new SCREEN_IO.RETURNED_ENUMERATION (ANSWER);

    DATE_SPEC : DATE_AND_TIME.CALENDAR_TYPE;



    function USE_DATE_STRING (DATE_STRING : STRING) return BOOLEAN is
        LAST_INDEX : POSITIVE;
        DATE_INFO  : array (1 .. 3) of INTEGER;
        EXCEED_MAX_YEAR : exception;
    begin
        if ( INTEGER'VALUE( DATE_STRING (7..8) ) ) not in 80..MAX_YEAR then
        raise EXCEED_MAX_YEAR;
        end if;
        for I in 1 .. 3 loop
        I_NUMBER.GET (FROM => DATE_STRING ((3 * I - 2) .. (3 * I - 1)),
                  ITEM => DATE_INFO (I),
                  LAST => LAST_INDEX);
        end loop;

        DATE_SPEC := (DAY   => DATE_INFO (1),
                  MONTH => DATE_INFO (2),
                  YEAR  => DATE_INFO (3));
        return TRUE;
    exception
        when EXCEED_MAX_YEAR | CONSTRAINT_ERROR | TEXT_IO.DATA_ERROR =>
        return FALSE;
    end USE_DATE_STRING;

    begin
    if RETURNED_ANSWER
          (PROMPT      => ASCII.LF & ASCII.CR & WITH_YESNO_PROMPT,
           DEFAULT     => N,
           USE_DEFAULT => TRUE,
           ERROR_TEXT  =>
         ASCII.LF & ASCII.CR &
         "INPUT ERROR:  Please ENTER  either [y] or [n] ...") = Y then

        while not USE_DATE_STRING
             (SCREEN_IO.RETURNED_STRING
             (PROMPT  => ASCII.LF & ASCII.CR & AND_TEXT_PROMPT &
                     " [in form dd/mm/yy] -->  ",
              CONFIRM => FALSE)) loop

        TEXT_IO.PUT_LINE ("INPUT ERROR:");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("Date needed must be in form [dd/mm/yy].");

        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE
           ("where [dd] is between 01..31 days, [mm] 01..12 months,");

        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT ("and [yy] 80..  " &
            INTEGER'IMAGE (MAX_YEAR) & ".  ");
        TEXT_IO.PUT_LINE ("Please try again." & ASCII.LF & ASCII.CR);

        end loop;

        return (DATE_AND_TIME.JULIAN_DATE (DATE_SPEC));
    else
        return (PASSED_DATE);
    end if;
    end GET_NEW_DATE;

    -------------------------------------------------------
    -- Procedure is used to get a revised start date, then
    -- make the start date the 1st real working day at of
    -- following the calendar date specified.
    -------------------------------------------------------
    procedure REVISE_DATE is

    DATE_SPEC : DATE_AND_TIME.CALENDAR_TYPE :=
            DATE_AND_TIME.CALENDAR_DATE (JULIAN_START_DATE);

    begin

    JULIAN_START_DATE := GET_NEW_DATE
                (WITH_YESNO_PROMPT =>
                   "Do you wish to change the " &
                   "project start date (currently " &
                   DATE_AND_TIME.DATE
                      (DATE_SPEC.DAY, DATE_SPEC.MONTH,
                       DATE_SPEC.YEAR + 1900) & ")." &
                   ASCII.LF & ASCII.CR & "ENTER [y/n] -->   ",
                 PASSED_DATE       => JULIAN_START_DATE,
                 AND_TEXT_PROMPT   =>
                   "ENTER new project start date ");

    JULIAN_START_DATE := FIND_PROPER_DATE (JULIAN_START_DATE, 1);

    end REVISE_DATE;


    -------------------------------------------------------
    -- Functions are used to map an integer project working
    -- day from a floating event time value.
    --------------------------------------------------------
    function TIME_UNIT_STARTED (ABSOLUTE_TIME : FLOAT) return INTEGER is
    begin
    if ABSOLUTE_TIME = 0.0 then
        return 1;
    else
        return MATH_FUNCTIONS.TRUNCATE (ABSOLUTE_TIME) + 2;
    end if;
    end TIME_UNIT_STARTED;

    function TIME_UNIT_DONE (ABSOLUTE_TIME : FLOAT) return INTEGER is
    begin
    return MATH_FUNCTIONS.TRUNCATE (ABSOLUTE_TIME) + 1;
    end TIME_UNIT_DONE;


    -------------------------------------------------------
    --
    -------------------------------------------------------

    procedure ACTIVITY_REPORT (FINAL_ACTIVITY_LIST : PERT_OPS.ARC_LIST_TYPE) is separate;

    procedure NODE_REPORT (FINAL_NODE_LIST : PERT_OPS.NODE_LIST_TYPE) is separate;

    procedure GANTT_REPORT (FINAL_ACTIVITY_LIST : PERT_OPS.ARC_LIST_TYPE) is separate;

    procedure SUM_MAN (FINAL_ACTIVITY_LIST : PERT_OPS.ARC_LIST_TYPE) is separate;




begin



    -----------------------------------------------------
    -- Set up holiday file
    -----------------------------------------------------
    READ_HOLIDAY_FILE;


    -----------------------------------------------------
    -- Set the julian start date to the 1st legal workday
    -- following the julian start date.
    -----------------------------------------------------
    REVISE_DATE;

    -----------------------------------------------------
    -- Create a large list of activities.
    -- Visit each node, and add the activities
    -- comming into that node (except dummys) to a big list.
    -----------------------------------------------------
    declare
    NODE_LIST : constant PERT_OPS.NODE_LIST_TYPE :=
            PERT_OPS.NODES (ON_GRAPH => NETWORK);

    function "=" (LEFT, RIGHT : PERT_OPS.NODE_TYPE) return BOOLEAN
               renames PERT_OPS."=";

    FINAL_NODE_LIST : PERT_OPS.NODE_LIST_TYPE (NODE_LIST'RANGE) :=
              NODE_LIST (NODE_LIST'RANGE);


    procedure SORT_NODES (LIST : in out PERT_OPS.NODE_LIST_TYPE) is
--sort LIST into ascending order based on ESTIMATE_TIME_OF_EVENT
--use shell sort logic

        CURRENT_VALUE   : FLOAT;
        CURRENT_NODE    : PERT_OPS.NODE_TYPE;
        DISTANCE        : INTEGER range 0 .. LIST'LAST + 1 :=
                  (LIST'LAST + 1) / 3;
        PRECEDING_INDEX : INTEGER range -(LIST'LAST + 1) / 3 .. LIST'LAST;

    begin
        while DISTANCE > 0 loop
        for INDEX in DISTANCE + 1 .. LIST'LAST loop
            CURRENT_VALUE :=
              PERT_OPS.VALUE (LIST (INDEX)).ESTIMATE_TIME_OF_EVENT;
            PRECEDING_INDEX := INDEX - DISTANCE;

            if CURRENT_VALUE <
               PERT_OPS.VALUE (LIST (PRECEDING_INDEX))
            .ESTIMATE_TIME_OF_EVENT then
            CURRENT_NODE := LIST (INDEX);

            loop
                LIST (PRECEDING_INDEX + DISTANCE) :=
                  LIST (PRECEDING_INDEX);
                PRECEDING_INDEX := PRECEDING_INDEX - DISTANCE;
                exit when PRECEDING_INDEX < LIST'FIRST or else
                      CURRENT_VALUE >=
                      PERT_OPS.VALUE (LIST (PRECEDING_INDEX))
                       .ESTIMATE_TIME_OF_EVENT;
            end loop;

            LIST (PRECEDING_INDEX + DISTANCE) := CURRENT_NODE;
            end if;
        end loop;

        DISTANCE := (DISTANCE + 1) / 3;
        end loop;

    end SORT_NODES;

    begin
    -- Sort FINAL_NODE_LIST on expected event time...
    SORT_NODES (FINAL_NODE_LIST);

    -----------------------------------------------------
    -- Output Node Report.
    -----------------------------------------------------
    NODE_REPORT (FINAL_NODE_LIST);

    for NODE_INDEX in NODE_LIST'RANGE loop
        if NODE_LIST (NODE_INDEX) /= PERT_OPS.START_NODE (NETWORK) then
        APPEND_THE_INCOMING_ARCS_TO_THE_BIG_LIST:
        declare
            ARC_LIST     : constant PERT_OPS.ARC_LIST_TYPE :=
                   PERT_OPS.INCOMING_ARCS
                      (ON_NODE => NODE_LIST (NODE_INDEX));
            END_ARC_LIST : NATURAL := ARC_LIST'LAST;
        begin
            for ARC_INDEX in ARC_LIST'RANGE loop
            ADD_NON_DUMMY_ACTIVITY (ARC_LIST (ARC_INDEX));
            end loop;
        end APPEND_THE_INCOMING_ARCS_TO_THE_BIG_LIST;
        end if;
    end loop;
    end;

    PROCESSING_FOR_ACTIVITY_LISTINGS:
    declare
    FINAL_ACTIVITY_LIST : PERT_OPS.ARC_LIST_TYPE (1 .. BIG_LIST_INDEX) :=
                  BIG_ACTIVITY_LIST (1 .. BIG_LIST_INDEX);

    procedure SORT_ACT_LIST (LIST : in out PERT_OPS.ARC_LIST_TYPE) is
--sort LIST into ascending order based on ESTIMATE_STOP
--use shell sort logic

        CURRENT_VALUE   : FLOAT;
        CURRENT_ARC     : PERT_OPS.ARC_TYPE;
        DISTANCE        : INTEGER range 0 .. LIST'LAST + 1 :=
                  (LIST'LAST + 1) / 3;
        PRECEDING_INDEX : INTEGER range -(LIST'LAST + 1) / 3 .. LIST'LAST;

    begin
        while DISTANCE > 0 loop
        for INDEX in DISTANCE + 1 .. LIST'LAST loop
            CURRENT_VALUE :=
              PERT_OPS.VALUE (LIST (INDEX)).ESTIMATE_STOP;
            PRECEDING_INDEX := INDEX - DISTANCE;

            if CURRENT_VALUE <
               PERT_OPS.VALUE (LIST (PRECEDING_INDEX))
            .ESTIMATE_STOP then
            CURRENT_ARC := LIST (INDEX);

            loop
                LIST (PRECEDING_INDEX + DISTANCE) :=
                  LIST (PRECEDING_INDEX);
                PRECEDING_INDEX := PRECEDING_INDEX - DISTANCE;
                exit when PRECEDING_INDEX < LIST'FIRST or else
                      CURRENT_VALUE >=
                      PERT_OPS.VALUE (LIST (PRECEDING_INDEX))
                       .ESTIMATE_STOP;
            end loop;

            LIST (PRECEDING_INDEX + DISTANCE) := CURRENT_ARC;
            end if;
        end loop;

        DISTANCE := (DISTANCE + 1) / 3;
        end loop;

    end SORT_ACT_LIST;

    begin
    -- Sort the list of activities on ending date.
    SORT_ACT_LIST (FINAL_ACTIVITY_LIST);

    -----------------------------------------------------
    -- Output Activity Report.
    -----------------------------------------------------
    ACTIVITY_REPORT (FINAL_ACTIVITY_LIST);

    -----------------------------------------------------
    -- Output Gantt Report.
    -----------------------------------------------------
    GANTT_REPORT (FINAL_ACTIVITY_LIST);

    -----------------------------------------------------
    -- Output Summary Report and Manpower Report.
    -----------------------------------------------------
    SUM_MAN (FINAL_ACTIVITY_LIST);

    end PROCESSING_FOR_ACTIVITY_LISTINGS;

exception
    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " & "[PERT.OUTPUT_VALUES]");

end OUTPUT_VALUES;





separate (SCHEDULE.PERT.OUTPUT_VALUES)
procedure ACTIVITY_REPORT (FINAL_ACTIVITY_LIST : PERT_OPS.ARC_LIST_TYPE) is
-----------------------------------------------------------
-- Author:     K. Lamarche and T. C. Bryan
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :     May 1985
-- Summary:    This procedure outputs the Activity Report
--             for the SIMPERT run.
---------------------------------------------------------

    THE_ACT_REPORT : TEXT_IO.FILE_TYPE;

    type ACT_BODY_LINE_RECORD_TYPE is
    record
        WBS_CODE  : STRING (1 .. 8);
        ACT_NAME  : STRING (12 .. 43);
        TAIL      : INTEGER;
        HEAD      : INTEGER;
        STAFF     : FLOAT;
        LAB_HRS   : INTEGER;
        COST      : INTEGER;
        DAYS_STRT : INTEGER;
        DAYS_SPAN : INTEGER;
        STD_DEV   : INTEGER;
        TT_SLACK  : INTEGER;
        F_SLACK   : INTEGER;
        CRIT_INDX : FLOAT;
        STRT_DATE : DATE_AND_TIME.JULIAN_TYPE;
        THE_REM   : INTEGER;
        FIN_DATE  : DATE_AND_TIME.JULIAN_TYPE;
    end record;



    -------------------------------------------
    -- write one title line for column heading
    -------------------------------------------
    procedure WRITE_ACT_HEADER_LINE
         (TO_FILE   : TEXT_IO.FILE_TYPE := TEXT_IO.CURRENT_OUTPUT;
          WBS_CODE  : STRING;
          ACT_NAME  : STRING;
          TAIL      : STRING;
          HEAD      : STRING;
          STAFF     : STRING;
          LAB_HRS   : STRING;
          COST      : STRING;
          DAYS_STRT : STRING;
          DAYS_SPAN : STRING;
          STD_DEV   : STRING;
          TT_SLACK  : STRING;
          F_SLACK   : STRING;
          CRIT_INDX : STRING;
          STRT_DATE : STRING;
          THE_REM   : STRING;
          FIN_DATE  : STRING) is

    begin

    TEXT_IO.PUT (TO_FILE, WBS_CODE);
    TEXT_IO.SET_COL (TO_FILE, 12);
    TEXT_IO.PUT (TO_FILE, ACT_NAME);
    TEXT_IO.SET_COL (TO_FILE, 45);
    TEXT_IO.PUT (TO_FILE, TAIL);
    TEXT_IO.SET_COL (TO_FILE, 50);
    TEXT_IO.PUT (TO_FILE, HEAD);
    TEXT_IO.SET_COL (TO_FILE, 55);
    TEXT_IO.PUT (TO_FILE, STAFF);
    TEXT_IO.SET_COL (TO_FILE, 60);
    TEXT_IO.PUT (TO_FILE, LAB_HRS);
    TEXT_IO.SET_COL (TO_FILE, 66);
    TEXT_IO.PUT (TO_FILE, COST);
    TEXT_IO.SET_COL (TO_FILE, 73);
    TEXT_IO.PUT (TO_FILE, DAYS_STRT);
    TEXT_IO.SET_COL (TO_FILE, 78);
    TEXT_IO.PUT (TO_FILE, DAYS_SPAN);
    TEXT_IO.SET_COL (TO_FILE, 84);
    TEXT_IO.PUT (TO_FILE, STD_DEV);
    TEXT_IO.SET_COL (TO_FILE, 87);
    TEXT_IO.PUT (TO_FILE, TT_SLACK);
    TEXT_IO.SET_COL (TO_FILE, 92);
    TEXT_IO.PUT (TO_FILE, F_SLACK);
    TEXT_IO.SET_COL (TO_FILE, 97);
    TEXT_IO.PUT (TO_FILE, CRIT_INDX);
    TEXT_IO.SET_COL (TO_FILE, 105);
    TEXT_IO.PUT (TO_FILE, STRT_DATE);
    TEXT_IO.SET_COL (TO_FILE, 116);
    TEXT_IO.PUT (TO_FILE, THE_REM);
    TEXT_IO.SET_COL (TO_FILE, 122);
    TEXT_IO.PUT (TO_FILE, FIN_DATE);
    TEXT_IO.NEW_LINE (TO_FILE);

    end WRITE_ACT_HEADER_LINE;



    ---------------------------------------------------------------
    -- write one line of the report text.  The text is defined by
    -- "act_body_line_record_type
    ---------------------------------------------------------------
    procedure WRITE_ACT_BODY_LINE
         (TO_FILE : TEXT_IO.FILE_TYPE := TEXT_IO.CURRENT_OUTPUT;
          A_LINE  : ACT_BODY_LINE_RECORD_TYPE) is

    begin
    TEXT_IO.PUT (TO_FILE, A_LINE.WBS_CODE);
    TEXT_IO.SET_COL (TO_FILE, 12);
    TEXT_IO.PUT (TO_FILE, A_LINE.ACT_NAME);
    TEXT_IO.SET_COL (TO_FILE, 45);
    I_NUMBER.PUT (TO_FILE, A_LINE.TAIL, WIDTH => 4);
    TEXT_IO.SET_COL (TO_FILE, 50);
    I_NUMBER.PUT (TO_FILE, A_LINE.HEAD, WIDTH => 4);
    TEXT_IO.SET_COL (TO_FILE, 55);

    if A_LINE.STAFF <= 0.09 then
        TEXT_IO.PUT (TO_FILE, " 0.0");
    else
        F_NUMBER.PUT (TO_FILE, A_LINE.STAFF, EXP => 0, FORE => 2, AFT => 1);
    end if;

    TEXT_IO.SET_COL (TO_FILE, 60);
    I_NUMBER.PUT (TO_FILE, A_LINE.LAB_HRS, WIDTH => 5);
    TEXT_IO.SET_COL (TO_FILE, 66);
    I_NUMBER.PUT (TO_FILE, A_LINE.COST, WIDTH => 6);
    TEXT_IO.SET_COL (TO_FILE, 73);
    I_NUMBER.PUT (TO_FILE, A_LINE.DAYS_STRT, WIDTH => 4);
    TEXT_IO.SET_COL (TO_FILE, 78);
    I_NUMBER.PUT (TO_FILE, A_LINE.DAYS_SPAN, WIDTH => 4);
    TEXT_IO.SET_COL (TO_FILE, 84);
    I_NUMBER.PUT (TO_FILE, A_LINE.STD_DEV, WIDTH => 2);
    TEXT_IO.SET_COL (TO_FILE, 87);
    I_NUMBER.PUT (TO_FILE, A_LINE.TT_SLACK, WIDTH => 4);
    TEXT_IO.SET_COL (TO_FILE, 92);
    I_NUMBER.PUT (TO_FILE, A_LINE.F_SLACK, WIDTH => 4);
    TEXT_IO.SET_COL (TO_FILE, 97);

    if A_LINE.CRIT_INDX <= 0.009 then
        TEXT_IO.PUT (TO_FILE, "0.00");
    else
        F_NUMBER.PUT
           (TO_FILE, A_LINE.CRIT_INDX, EXP => 0, FORE => 1, AFT => 2);
    end if;

    TEXT_IO.SET_COL (TO_FILE, 105);
    TEXT_IO.PUT (TO_FILE, CONVERT_TO_NORMAL_DATE (A_LINE.STRT_DATE));
    TEXT_IO.SET_COL (TO_FILE, 116);
    I_NUMBER.PUT (TO_FILE, A_LINE.THE_REM, WIDTH => 3);
    TEXT_IO.SET_COL (TO_FILE, 122);
    TEXT_IO.PUT (TO_FILE, CONVERT_TO_NORMAL_DATE (A_LINE.FIN_DATE));
    TEXT_IO.NEW_LINE (TO_FILE);

    end WRITE_ACT_BODY_LINE;


begin

    -------------------------------
    -- create the  activity report
    -------------------------------
    TEXT_IO.CREATE (THE_ACT_REPORT, TEXT_IO.OUT_FILE, THE_ACTIVITY_REPORT_NAME);
    -------------------------
    -- the heading portion
    -------------------------
    WRITE_HEADER_REPORT (TO_FILE    => THE_ACT_REPORT,
             FORM_NAME  => "ACTIVITY REPORT",
             PAGE_WIDTH => 130);


    WRITE_ACT_HEADER_LINE
       (TO_FILE   => THE_ACT_REPORT,
    WBS_CODE  => "",
    ACT_NAME  => "",
    TAIL      => "",
    HEAD      => "",
    STAFF     => "",
    LAB_HRS   => "Labor",
    COST      => " Cost ",
    DAYS_STRT => REQUESTED_UNIT_CODE,
    DAYS_SPAN => REQUESTED_UNIT_CODE,
    STD_DEV   => "Sd",
    TT_SLACK  => "Totl",
    F_SLACK   => "Free",
    CRIT_INDX => "Crit",
    STRT_DATE => "  Start  ",
    THE_REM   => "",
    FIN_DATE  => " Finish  ");


    WRITE_ACT_HEADER_LINE
       (TO_FILE   => THE_ACT_REPORT,
    WBS_CODE  => "WBS Code",
    ACT_NAME  => "        Activity Title",
    TAIL      => "Tail",
    HEAD      => "Head",
    STAFF     => "Staf",
    LAB_HRS   => "Hours",
    COST      => "($100)",
    DAYS_STRT => "Strt",
    DAYS_SPAN => "Span",
    STD_DEV   => "Dv",
    TT_SLACK  => "Slck",
    F_SLACK   => "Slck",
    CRIT_INDX => "Indx",
    STRT_DATE => "  Date   ",
    THE_REM   => "Rem",
    FIN_DATE  => "  Date   ");


    WRITE_ACT_HEADER_LINE
       (TO_FILE   => THE_ACT_REPORT,
    WBS_CODE  => "________",
    ACT_NAME  => "________________________________",
    TAIL      => "____",
    HEAD      => "____",
    STAFF     => "____",
    LAB_HRS   => "_____",
    COST      => "______",
    DAYS_STRT => "____",
    DAYS_SPAN => "____",
    STD_DEV   => "__",
    TT_SLACK  => "____",
    F_SLACK   => "____",
    CRIT_INDX => "____",
    STRT_DATE => "_________",
    THE_REM   => "___",
    FIN_DATE  => "_________");

    TEXT_IO.NEW_LINE (THE_ACT_REPORT);
    TEXT_IO.PUT_LINE (THE_ACT_REPORT,
              "Data sorted on ---> Expected Finish Date");
    TEXT_IO.NEW_LINE (THE_ACT_REPORT);

    -------------------------
    -- the text portion
    -------------------------
    declare
    ACTIVITY      : ACTIVITY_TYPE;
    ACT_BODY_LINE : ACT_BODY_LINE_RECORD_TYPE;
    STOP_TICK     : INTEGER;

    begin

    for ACTIVITY_INDEX in FINAL_ACTIVITY_LIST'RANGE loop

        ACTIVITY := PERT_OPS.VALUE (FINAL_ACTIVITY_LIST (ACTIVITY_INDEX));
        ACT_BODY_LINE.WBS_CODE := ACTIVITY.NAME (1 .. 8);
        ACT_BODY_LINE.ACT_NAME := ACTIVITY.NAME (11 .. 42);
        ACT_BODY_LINE.TAIL :=
          PERT_OPS.VALUE (PERT_OPS.TAIL_NODE
                 (FINAL_ACTIVITY_LIST (ACTIVITY_INDEX)))
           .EVENT_ID;
        ACT_BODY_LINE.HEAD :=
          PERT_OPS.VALUE (PERT_OPS.HEAD_NODE
                 (FINAL_ACTIVITY_LIST (ACTIVITY_INDEX)))
           .EVENT_ID;
        ACT_BODY_LINE.STAFF := ACTIVITY.STAFFING;

        ACT_BODY_LINE.DAYS_STRT :=
          TIME_UNIT_STARTED (ACTIVITY.ESTIMATE_START);
        STOP_TICK := TIME_UNIT_DONE (ACTIVITY.ESTIMATE_STOP);

        if STOP_TICK < ACT_BODY_LINE.DAYS_STRT then
        STOP_TICK := ACT_BODY_LINE.DAYS_STRT;
        end if;

        if ACTIVITY.ESTIMATE_START = ACTIVITY.ESTIMATE_STOP then
        ACT_BODY_LINE.DAYS_SPAN := 0;
        else
        ACT_BODY_LINE.DAYS_SPAN :=
          STOP_TICK - ACT_BODY_LINE.DAYS_STRT + 1;
        end if;

        ACT_BODY_LINE.LAB_HRS :=
          ACT_BODY_LINE.DAYS_SPAN * INTEGER (ACTIVITY.STAFFING) *
          (TO_DAYS (1) * 8);

        if ACTIVITY.STAFFING = 0.0 then
        ACT_BODY_LINE.COST := INTEGER (ACTIVITY.RATE / 100.0);
        else
        ACT_BODY_LINE.COST :=
          INTEGER (FLOAT (ACT_BODY_LINE.DAYS_SPAN) * ACTIVITY.RATE *
               ACTIVITY.STAFFING / 100.0);
        end if;

        ACT_BODY_LINE.STD_DEV :=
          INTEGER (((((ACTIVITY.PESSIMISTIC_TIME -
               ACTIVITY.OPTIMISTIC_TIME) ** 2.0 +
              (ACTIVITY.MOST_PROBABLE_TIME -
               ACTIVITY.OPTIMISTIC_TIME) *
              (ACTIVITY.MOST_PROBABLE_TIME -
               ACTIVITY.PESSIMISTIC_TIME)) / 18.0) ** 0.5) + 0.5);

        ACT_BODY_LINE.TT_SLACK :=
          INTEGER (PERT_OPS.VALUE
              (PERT_OPS.HEAD_NODE
                  (FINAL_ACTIVITY_LIST (ACTIVITY_INDEX)))
            .DET_LATE_TIME_OF_EVENT -
               PERT_OPS.VALUE
              (PERT_OPS.TAIL_NODE
                  (FINAL_ACTIVITY_LIST (ACTIVITY_INDEX)))
            .DET_TIME_OF_EVENT - ACTIVITY.DURATION_TIME);

        CALCULATE_FREE_SLACK:
        declare
        FREE_SLACK : FLOAT :=
                 PERT_OPS.VALUE
                (PERT_OPS.HEAD_NODE
                    (FINAL_ACTIVITY_LIST (ACTIVITY_INDEX)))
                  .DET_TIME_OF_EVENT -
                 PERT_OPS.VALUE
                (PERT_OPS.TAIL_NODE
                    (FINAL_ACTIVITY_LIST (ACTIVITY_INDEX)))
                  .DET_TIME_OF_EVENT - ACTIVITY.DURATION_TIME;
        begin
        if FREE_SLACK < 0.0 then
            FREE_SLACK := 0.0;
        end if;

        ACT_BODY_LINE.F_SLACK := INTEGER (FREE_SLACK);
        TOTAL_FREE_SLACK := TOTAL_FREE_SLACK + FREE_SLACK;
        end CALCULATE_FREE_SLACK;

        ACT_BODY_LINE.CRIT_INDX := ACTIVITY.ON_CP_COUNT;

        ACT_BODY_LINE.STRT_DATE :=
          FIND_PROPER_DATE
         (JULIAN_START_DATE, TO_DAYS (ACT_BODY_LINE.DAYS_STRT));
        ACT_BODY_LINE.FIN_DATE :=
          FIND_PROPER_DATE (JULIAN_START_DATE, TO_DAYS (STOP_TICK));

        ACT_BODY_LINE.THE_REM :=
          WORKDAYS_BETWEEN (JULIAN_DATE_NOW, ACT_BODY_LINE.FIN_DATE);

        if ACT_BODY_LINE.THE_REM < 0 then
        ACT_BODY_LINE.THE_REM := 0;
        end if;

        WRITE_ACT_BODY_LINE
           (TO_FILE => THE_ACT_REPORT, A_LINE => ACT_BODY_LINE);

    end loop;

    TEXT_IO.CLOSE (THE_ACT_REPORT);
    end;

exception
    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " &
               "[PERT.OUTPUT_VALUES.ACTIVITY_REPORT]");

end ACTIVITY_REPORT;





separate (SCHEDULE.PERT.OUTPUT_VALUES)
procedure GANTT_REPORT (FINAL_ACTIVITY_LIST : PERT_OPS.ARC_LIST_TYPE) is
--------------------------------------------------------------------------
-- Author:  Ken Lamarche and T.C. Bryan
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :  May 1985
-- Summary:
-- This procedure is used to produce the Gantt Report. This output will be
-- used as a text report, and also to produce the Gantt Chart.
--------------------------------------------------------------------------


    THE_GANTT_REPORT : TEXT_IO.FILE_TYPE;

    type GANTT_BODY_LINE_RECORD_TYPE is
    record
        WBS_CODE   : STRING (1 .. 8);
        GANTT_NAME : STRING (12 .. 43);
        CRITICAL   : CHARACTER;
        TAIL       : INTEGER;
        HEAD       : INTEGER;
        STAFF      : INTEGER;
        START      : INTEGER;
        STOP       : INTEGER;
    end record;


    procedure WRITE_SECOND_HEADER_REPORT
         (TO_FILE       : TEXT_IO.FILE_TYPE := THE_GANTT_REPORT;
          TITLE         : STRING :=
                  STRING_UTILITIES
                   .REMOVE_LEADING_AND_TRAILING_BLANKS
                     (OUTPUT_REPORT_TITLE);
          SIMPERT_FILE  : STRING :=
                  STRING_UTILITIES
                   .REMOVE_LEADING_AND_TRAILING_BLANKS
                     (PERT_FILE);
          NUMBER_OF_ACT : INTEGER := FINAL_ACTIVITY_LIST'LENGTH;
          TT_PROJ_SCHED : FLOAT :=
                  PERT_OPS.VALUE (PERT_OPS.END_NODE (NETWORK))
                   .ESTIMATE_TIME_OF_EVENT;
          TIME_UNIT     : STRING :=
                  TIME_UNIT_TYPE'IMAGE (TIME_UNIT_CODE) &
                  INTEGER'IMAGE (WORKDAYS_PER_WEEK);
          PROBABILITY   : FLOAT := PROBABILITY_FOR_OUTPUT;
          START_DATE_IS : DATE_AND_TIME.JULIAN_TYPE :=
                  JULIAN_START_DATE) is


-------------------------------------------------------
-- convert a julian date into the format "dd mm yy"
--
-- Author: T. C. Bryan
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Library use : date_and_time.
-- Date:  17 May 85
-------------------------------------------------------
    function CONVERT_TO_DD_MM_YY_DATE
            (THE_JULIAN_IS : DATE_AND_TIME.JULIAN_TYPE) return STRING is

        DATE_SPEC : DATE_AND_TIME.CALENDAR_TYPE :=
            DATE_AND_TIME.CALENDAR_DATE (THE_JULIAN_IS);


    begin

        return (INTEGER'IMAGE (DATE_SPEC.DAY) &
            INTEGER'IMAGE (DATE_SPEC.MONTH) &
            INTEGER'IMAGE (DATE_SPEC.YEAR));

    end CONVERT_TO_DD_MM_YY_DATE;



    begin


    TEXT_IO.PUT (TO_FILE, TITLE);
    TEXT_IO.SET_COL (TO_FILE, TO => 81);
    TEXT_IO.PUT_LINE (TO_FILE, "Title");

    TEXT_IO.PUT (TO_FILE, SIMPERT_FILE);
    TEXT_IO.SET_COL (TO_FILE, TO => 68);
    TEXT_IO.PUT_LINE (TO_FILE, "SIMPERT input file");

    I_NUMBER.PUT (TO_FILE, NUMBER_OF_ACT, WIDTH => 4);
    TEXT_IO.SET_COL (TO_FILE, TO => 66);
    TEXT_IO.PUT_LINE (TO_FILE, "Number of activities");

    if TT_PROJ_SCHED <= 0.009 then
        TEXT_IO.PUT (TO_FILE, " 0.0");
    else
        F_NUMBER.PUT
           (TO_FILE, TT_PROJ_SCHED, EXP => 0, FORE => 4, AFT => 2);
    end if;

    TEXT_IO.SET_COL (TO_FILE, TO => 64);
    TEXT_IO.PUT_LINE (TO_FILE, "Total project schedule");

    TEXT_IO.PUT (TO_FILE, TIME_UNIT);
    TEXT_IO.SET_COL (TO_FILE, TO => 51);
    TEXT_IO.PUT_LINE (TO_FILE, "D = days, W = weeks, # = days/weeks");

    TEXT_IO.SET_COL (TO_FILE, TO => 4);

    if PROBABILITY <= 0.009 then
        TEXT_IO.PUT (TO_FILE, " 0.0");
    else
        F_NUMBER.PUT (TO_FILE, PROBABILITY, EXP => 0, FORE => 1, AFT => 2);
    end if;

    TEXT_IO.SET_COL (TO_FILE, TO => 66);
    TEXT_IO.PUT_LINE (TO_FILE, "Probability for time");

    TEXT_IO.PUT (TO_FILE, CONVERT_TO_DD_MM_YY_DATE (START_DATE_IS));
    TEXT_IO.SET_COL (TO_FILE, TO => 57);
    TEXT_IO.PUT_LINE (TO_FILE, "Project Start date {dd/mm/yy}");

    end WRITE_SECOND_HEADER_REPORT;



    procedure WRITE_GANTT_HEADER_LINE
         (TO_FILE    : TEXT_IO.FILE_TYPE := TEXT_IO.CURRENT_OUTPUT;
          WBS_CODE   : STRING;
          GANTT_NAME : STRING;
          CRITICAL   : STRING;
          TAIL       : STRING;
          HEAD       : STRING;
          STAFF      : STRING;
          START      : STRING;
          STOP       : STRING) is

    begin

    TEXT_IO.PUT (TO_FILE, WBS_CODE);
    TEXT_IO.SET_COL (TO_FILE, 12);
    TEXT_IO.PUT (TO_FILE, GANTT_NAME);
    TEXT_IO.SET_COL (TO_FILE, 45);
    TEXT_IO.PUT (TO_FILE, CRITICAL);
    TEXT_IO.SET_COL (TO_FILE, 51);
    TEXT_IO.PUT (TO_FILE, TAIL);
    TEXT_IO.SET_COL (TO_FILE, 58);
    TEXT_IO.PUT (TO_FILE, HEAD);
    TEXT_IO.SET_COL (TO_FILE, 65);
    TEXT_IO.PUT (TO_FILE, STAFF);
    TEXT_IO.SET_COL (TO_FILE, 72);
    TEXT_IO.PUT (TO_FILE, START);
    TEXT_IO.SET_COL (TO_FILE, 81);
    TEXT_IO.PUT (TO_FILE, STOP);
    TEXT_IO.NEW_LINE (TO_FILE);

    end WRITE_GANTT_HEADER_LINE;



    procedure WRITE_GANTT_BODY_LINE
         (TO_FILE : TEXT_IO.FILE_TYPE := TEXT_IO.CURRENT_OUTPUT;
          A_LINE  : GANTT_BODY_LINE_RECORD_TYPE) is

    begin
    TEXT_IO.PUT (TO_FILE, A_LINE.WBS_CODE);
    TEXT_IO.SET_COL (TO_FILE, 12);
    TEXT_IO.PUT (TO_FILE, A_LINE.GANTT_NAME);
    TEXT_IO.SET_COL (TO_FILE, 48);
    TEXT_IO.PUT (TO_FILE, A_LINE.CRITICAL);
    TEXT_IO.SET_COL (TO_FILE, 51);
    I_NUMBER.PUT (TO_FILE, A_LINE.TAIL, WIDTH => 4);
    TEXT_IO.SET_COL (TO_FILE, 58);
    I_NUMBER.PUT (TO_FILE, A_LINE.HEAD, WIDTH => 4);
    TEXT_IO.SET_COL (TO_FILE, 67);
    I_NUMBER.PUT (TO_FILE, A_LINE.STAFF, WIDTH => 3);
    TEXT_IO.SET_COL (TO_FILE, 74);
    I_NUMBER.PUT (TO_FILE, A_LINE.START, WIDTH => 3);
    TEXT_IO.SET_COL (TO_FILE, 82);
    I_NUMBER.PUT (TO_FILE, A_LINE.STOP, WIDTH => 3);

    TEXT_IO.NEW_LINE (TO_FILE);
    end WRITE_GANTT_BODY_LINE;



begin
    ------------------------
    -- Print Gantt report.
    ------------------------
    TEXT_IO.CREATE (THE_GANTT_REPORT, TEXT_IO.OUT_FILE, THE_GANTT_REPORT_NAME);
    WRITE_HEADER_REPORT (TO_FILE    => THE_GANTT_REPORT,
             FORM_NAME  => "GANTT INPUT FILE",
             PAGE_WIDTH => 86);

    TEXT_IO.NEW_LINE (THE_GANTT_REPORT, 2);
    WRITE_SECOND_HEADER_REPORT;
    TEXT_IO.NEW_LINE (THE_GANTT_REPORT, 2);


    WRITE_GANTT_HEADER_LINE
       (TO_FILE    => THE_GANTT_REPORT,
    WBS_CODE   => "WBS Code",
    GANTT_NAME => "        Activity Title",
    CRITICAL   => "Crit",
    TAIL       => "Tail",
    HEAD       => "Head",
    STAFF      => "Staff",
    START      => "Start",
    STOP       => "Stop");


    WRITE_GANTT_HEADER_LINE
       (TO_FILE    => THE_GANTT_REPORT,
    WBS_CODE   => "________",
    GANTT_NAME => "________________________________",
    CRITICAL   => "____",
    TAIL       => "____",
    HEAD       => "____",
    STAFF      => "_____",
    START      => "_____",
    STOP       => "____");


    TEXT_IO.NEW_LINE (THE_GANTT_REPORT, 2);
    TEXT_IO.PUT_LINE (THE_GANTT_REPORT, "Data sorted on ---> Finish Time");
    TEXT_IO.NEW_LINE (THE_GANTT_REPORT);

    declare
    ACTIVITY        : ACTIVITY_TYPE;
    GANTT_BODY_LINE : GANTT_BODY_LINE_RECORD_TYPE;
    begin
    for ACTIVITY_INDEX in FINAL_ACTIVITY_LIST'RANGE loop
        ACTIVITY := PERT_OPS.VALUE (FINAL_ACTIVITY_LIST (ACTIVITY_INDEX));

        GANTT_BODY_LINE.WBS_CODE := ACTIVITY.NAME (1 .. 8);
        GANTT_BODY_LINE.GANTT_NAME := ACTIVITY.NAME (11 .. 42);

        IS_ARC_ON_CRITICAL_PATH:
        declare
        EVENT_IMAGE : PERT_OPS.NODE_TYPE :=
                  PERT_OPS.HEAD_NODE
                 (FINAL_ACTIVITY_LIST (ACTIVITY_INDEX));
        ARC_LIST    : constant PERT_OPS.ARC_LIST_TYPE :=
                  PERT_OPS.INCOMING_ARCS (EVENT_IMAGE);
        begin
        if PERT_OPS."="
              (ARC_LIST (PERT_OPS.VALUE (EVENT_IMAGE)
                  .MOST_CRIT_INBOUND_ARC),
               FINAL_ACTIVITY_LIST (ACTIVITY_INDEX)) then
            GANTT_BODY_LINE.CRITICAL := 'C';
        else
            GANTT_BODY_LINE.CRITICAL := ' ';
        end if;
        end IS_ARC_ON_CRITICAL_PATH;

        GANTT_BODY_LINE.TAIL :=
          PERT_OPS.VALUE (PERT_OPS.TAIL_NODE
                 (FINAL_ACTIVITY_LIST (ACTIVITY_INDEX)))
           .EVENT_ID;

        GANTT_BODY_LINE.HEAD :=
          PERT_OPS.VALUE (PERT_OPS.HEAD_NODE
                 (FINAL_ACTIVITY_LIST (ACTIVITY_INDEX)))
           .EVENT_ID;

        GANTT_BODY_LINE.STAFF := INTEGER (ACTIVITY.STAFFING);

        GANTT_BODY_LINE.START :=
          TO_DAYS (TIME_UNIT_STARTED (ACTIVITY.ESTIMATE_START));

        GANTT_BODY_LINE.STOP :=
          TO_DAYS (TIME_UNIT_DONE (ACTIVITY.ESTIMATE_STOP));

        WRITE_GANTT_BODY_LINE
           (TO_FILE => THE_GANTT_REPORT, A_LINE => GANTT_BODY_LINE);
    end loop;

    end;

    TEXT_IO.CLOSE (THE_GANTT_REPORT);

exception
    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " &
               "[PERT.OUTPUT_VALUES.GANTT_REPORT]");

end GANTT_REPORT;





separate (SCHEDULE.PERT.OUTPUT_VALUES)
procedure NODE_REPORT (FINAL_NODE_LIST : PERT_OPS.NODE_LIST_TYPE) is
------------------------------------------------------------------------------
-- Authors: K. Lamarche and T. C. Bryan
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date:    May 1985
-- Summary:
-- This procedure is used to output the Node Information report. It Is
-- called with a sorted list of NODE_TYPES; pointers that point to the
-- information record of each node.
-------------------------------------------------------------------------------


    THE_NODE_REPORT : TEXT_IO.FILE_TYPE;

    type NODE_BODY_LINE_RECORD_TYPE is
    record
        NODE        : INTEGER;
        EXPECTED    : FLOAT;
        TIME_DATE   : DATE_AND_TIME.JULIAN_TYPE;
        STND_DEV    : FLOAT;
        PROBABILITY : FLOAT;
        PTIME_DATE  : DATE_AND_TIME.JULIAN_TYPE;
        CRIT_INDEX  : FLOAT;
    end record;


    procedure WRITE_NODE_HEADER_LINE
         (TO_FILE     : TEXT_IO.FILE_TYPE := TEXT_IO.CURRENT_OUTPUT;
          NODE        : STRING;
          EXPECTED    : STRING;
          TIME_DATE   : STRING;
          STND_DEV    : STRING;
          PROBABILITY : STRING;
          PTIME_DATE  : STRING;
          CRIT_INDEX  : STRING) is

    begin

    TEXT_IO.PUT (TO_FILE, NODE);
    TEXT_IO.SET_COL (TO_FILE, 10);
    TEXT_IO.PUT (TO_FILE, EXPECTED);
    TEXT_IO.SET_COL (TO_FILE, 20);
    TEXT_IO.PUT (TO_FILE, TIME_DATE);
    TEXT_IO.SET_COL (TO_FILE, 34);
    TEXT_IO.PUT (TO_FILE, STND_DEV);
    TEXT_IO.SET_COL (TO_FILE, 51);
    TEXT_IO.PUT (TO_FILE, PROBABILITY);
    TEXT_IO.SET_COL (TO_FILE, 60);
    TEXT_IO.PUT (TO_FILE, PTIME_DATE);
    TEXT_IO.SET_COL (TO_FILE, 73);
    TEXT_IO.PUT (TO_FILE, CRIT_INDEX);

    TEXT_IO.NEW_LINE (TO_FILE);

    end WRITE_NODE_HEADER_LINE;



    procedure WRITE_NODE_BODY_LINE
         (TO_FILE : TEXT_IO.FILE_TYPE := TEXT_IO.CURRENT_OUTPUT;
          A_LINE  : NODE_BODY_LINE_RECORD_TYPE) is

    begin
    I_NUMBER.PUT (TO_FILE, A_LINE.NODE, WIDTH => 4);
    TEXT_IO.SET_COL (TO_FILE, 10);

    if A_LINE.EXPECTED <= 0.009 then
        TEXT_IO.PUT (TO_FILE, "   0.00");
    else
        F_NUMBER.PUT
           (TO_FILE, A_LINE.EXPECTED, EXP => 0, FORE => 4, AFT => 2);
    end if;

    TEXT_IO.SET_COL (TO_FILE, 20);
    TEXT_IO.PUT (TO_FILE, CONVERT_TO_NORMAL_DATE (A_LINE.TIME_DATE));
    TEXT_IO.SET_COL (TO_FILE, 36);

    if A_LINE.STND_DEV <= 0.009 then
        TEXT_IO.PUT (TO_FILE, "   0.00");
    else
        F_NUMBER.PUT
           (TO_FILE, A_LINE.STND_DEV, EXP => 0, FORE => 4, AFT => 2);
    end if;

    TEXT_IO.SET_COL (TO_FILE, 50);

    if A_LINE.PROBABILITY <= 0.009 then
        TEXT_IO.PUT (TO_FILE, "   0.00");
    else
        F_NUMBER.PUT
           (TO_FILE, A_LINE.PROBABILITY, EXP => 0, FORE => 4, AFT => 2);
    end if;

    TEXT_IO.SET_COL (TO_FILE, 60);
    TEXT_IO.PUT (TO_FILE, CONVERT_TO_NORMAL_DATE (A_LINE.PTIME_DATE));
    TEXT_IO.SET_COL (TO_FILE, 79);

    if A_LINE.CRIT_INDEX <= 0.009 then
        TEXT_IO.PUT (TO_FILE, " 0.00");
    else
        F_NUMBER.PUT
           (TO_FILE, A_LINE.CRIT_INDEX, EXP => 0, FORE => 2, AFT => 2);
    end if;

    TEXT_IO.NEW_LINE (TO_FILE);

    end WRITE_NODE_BODY_LINE;



begin

    --------------------------------------------------
    -- create the Node report
    --------------------------------------------------
    TEXT_IO.CREATE (THE_NODE_REPORT, TEXT_IO.OUT_FILE, THE_NODE_REPORT_NAME);

    --------------------------------------------------
    -- Put the header to the file
    --------------------------------------------------
    WRITE_HEADER_REPORT (TO_FILE    => THE_NODE_REPORT,
             FORM_NAME  => "NODE_REPORT",
             PAGE_WIDTH => 89);
    TEXT_IO.NEW_LINE (THE_NODE_REPORT, 2);

    TEXT_IO.PUT (THE_NODE_REPORT, "Number of Nodes: ");
    I_NUMBER.PUT (THE_NODE_REPORT, FINAL_NODE_LIST'LENGTH, WIDTH => 4);
    TEXT_IO.NEW_LINE (THE_NODE_REPORT, 2);


    WRITE_NODE_HEADER_LINE
       (TO_FILE     => THE_NODE_REPORT,
    NODE        => "Node",
    EXPECTED    => "Expected",
    TIME_DATE   => "Time/Date",
    STND_DEV    => "Standard Dev.",
    PROBABILITY => INTEGER'IMAGE
             (INTEGER (PROBABILITY_FOR_OUTPUT * 100.0)) & "%",
    PTIME_DATE  => "Time/Date",
    CRIT_INDEX  => "Criticality Index");

    WRITE_NODE_HEADER_LINE
       (TO_FILE     => THE_NODE_REPORT,
    NODE        => "----",
    EXPECTED    => "--------",
    TIME_DATE   => "---------",
    STND_DEV    => "-------------",
    PROBABILITY => "------",
    PTIME_DATE  => "---------",
    CRIT_INDEX  => "-----------------");

    TEXT_IO.NEW_LINE (THE_NODE_REPORT, 2);
    TEXT_IO.PUT_LINE (THE_NODE_REPORT, "Data sorted on ---> network topology");
    TEXT_IO.NEW_LINE (THE_NODE_REPORT);


    declare
    EVENT          : EVENT_TYPE;
    NODE_BODY_LINE : NODE_BODY_LINE_RECORD_TYPE;

    begin
    for NODE_INDEX in FINAL_NODE_LIST'RANGE loop

        EVENT := PERT_OPS.VALUE (FINAL_NODE_LIST (NODE_INDEX));

        NODE_BODY_LINE.NODE := EVENT.EVENT_ID;

        NODE_BODY_LINE.EXPECTED := EVENT.SIM_TIME_OF_EVENT;

        NODE_BODY_LINE.TIME_DATE :=
          FIND_PROPER_DATE
         (JULIAN_START_DATE,
          TO_DAYS (TIME_UNIT_DONE (EVENT.SIM_TIME_OF_EVENT)));

        NODE_BODY_LINE.STND_DEV := EVENT.VARIANCE ** 0.5;

        if NODE_BODY_LINE.STND_DEV < 0.01 then
        NODE_BODY_LINE.STND_DEV := 0.0;
        end if;

        NODE_BODY_LINE.PROBABILITY := EVENT.ESTIMATE_TIME_OF_EVENT;

        NODE_BODY_LINE.PTIME_DATE :=
          FIND_PROPER_DATE
         (JULIAN_START_DATE,
          TO_DAYS (TIME_UNIT_DONE (EVENT.ESTIMATE_TIME_OF_EVENT)));

        NODE_BODY_LINE.CRIT_INDEX := EVENT.CRIT_PATH_INDEX;


        WRITE_NODE_BODY_LINE
           (TO_FILE => THE_NODE_REPORT, A_LINE => NODE_BODY_LINE);

    end loop;

    end;

    TEXT_IO.CLOSE (THE_NODE_REPORT);

exception
    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " &
               "[PERT.OUTPUT_VALUES.NODE_REPORT]");

end NODE_REPORT;





separate (SCHEDULE.PERT.OUTPUT_VALUES)
procedure SUM_MAN (FINAL_ACTIVITY_LIST : PERT_OPS.ARC_LIST_TYPE) is
--------------------------------------------------------------
-- Authors:  K. Lamarche and T.C. Bryan
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date   :  May 1985
-- Summary:
-- This procedure is used to create 2 reports.
-- 1) a summary report which covers the following sub sections:
--     stochastic critical path,
--     total schedule and associated risk
--     effort/manpower estimates
--     cost estimates
--     network summary metrics
-- and 2) a manpower report
--------------------------------------------------------------


    THE_SUMMARY_REPORT  : TEXT_IO.FILE_TYPE;
    THE_MANPOWER_REPORT : TEXT_IO.FILE_TYPE;


    type MANPOWER_REPORT_BODY_LINE_RECORD_TYPE is
    record
        WORKING_DAYS : INTEGER;
        MANPOWER     : FLOAT;
    end record;


    type STOCHA_BODY_LINE_RECORD_TYPE is
    record
        WBS_CODE : STRING (1 .. 8);
        ACT_NAME : STRING (12 .. 43);
        TAIL     : INTEGER;
        HEAD     : INTEGER;
        FIN_TIME : FLOAT;
        FIN_DATE : DATE_AND_TIME.JULIAN_TYPE;
    end record;


    type SCHED_A_RISK_BODY_LINE_RECORD_TYPE is
    record
        PROBABILITY            : FLOAT;
        PROBABILITY_DATE       : DATE_AND_TIME.JULIAN_TYPE;
        OPTIMISTICS            : FLOAT;
        OPTIMISTICS_DATE       : DATE_AND_TIME.JULIAN_TYPE;
        EXPECTATIONS           : FLOAT;
        EXPECTATIONS_DATE      : DATE_AND_TIME.JULIAN_TYPE;
        PESSIMISTICS           : FLOAT;
        PESSIMISTICS_DATE      : DATE_AND_TIME.JULIAN_TYPE;
        STANDARD_DEVIATION     : FLOAT;
        PROB_REQUIRED_COMPLETE : FLOAT;
        REQUIRED_DATE          : DATE_AND_TIME.JULIAN_TYPE;
        TOTAL_EFFORT           : FLOAT;
        AVERAGE_MANLOAD        : FLOAT;
        PEAK_MANLOAD_TIME      : FLOAT;
        PEAK_MANLOAD_DATE      : DATE_AND_TIME.JULIAN_TYPE;
        PEAK_MANLOAD           : FLOAT;
        LABOR_COST             : FLOAT;
        DIRECT_COST            : FLOAT;
        TOTAL_COST             : FLOAT;
        AVERAGE_COST           : FLOAT;
    end record;


    type NETWORK_SUMMARY_BODY_LINE_RECORD_TYPE is
    record
        NUMBER_OF_ARCS     : INTEGER;
        NUMBER_OF_NODES    : INTEGER;
        MAX_NUMBER_OF_ARCS : INTEGER;
        MAX_NUMBER_OF_PARA : INTEGER;
        MAX_OCCUR_DATE     : DATE_AND_TIME.JULIAN_TYPE;
        NET_COMPLEX        : FLOAT;
        STOCHA_COMPLEX     : FLOAT;
        STOCHA_FREE_SLCK   : FLOAT;
        SUM_OF_ACT_DURATS  : FLOAT;
        MAX_ARC            : STRING (1 .. 32);
        MAX_DURATIONS      : FLOAT;
        AVERAGE_DURATIONS  : FLOAT;
        STOCHASTIC_DENSITY : FLOAT;
        AVG_TIME_WIDTH     : FLOAT;
    end record;



    -----------------------------------------------------------------
    -- output one line of text for the "manpower report".  The text
    -- is defined by the "manpower_report_body_line_record_type"
    -----------------------------------------------------------------
    procedure WRITE_MANPOWER_REPORT_BODY_LINE
         (TO_FILE : TEXT_IO.FILE_TYPE := TEXT_IO.CURRENT_OUTPUT;
          A_LINE  : MANPOWER_REPORT_BODY_LINE_RECORD_TYPE) is

    WORKING_DAYS_COLUMN : TEXT_IO.COUNT := 14;
    MANPOWER_COLUMN     : TEXT_IO.COUNT := 44;

    begin

    TEXT_IO.SET_COL (TO_FILE, TO => WORKING_DAYS_COLUMN);
    I_NUMBER.PUT (TO_FILE, A_LINE.WORKING_DAYS, WIDTH => 4);
    TEXT_IO.SET_COL (TO_FILE, TO => MANPOWER_COLUMN);

    if A_LINE.MANPOWER <= 0.009 then
        TEXT_IO.PUT (TO_FILE, "  0.00");
    else
        F_NUMBER.PUT
           (TO_FILE, A_LINE.MANPOWER, EXP => 0, FORE => 3, AFT => 2);
    end if;

    TEXT_IO.NEW_LINE (TO_FILE);

    end WRITE_MANPOWER_REPORT_BODY_LINE;



    -----------------------------------------------------------
    -- output the header line for the subsection "Stochastic
    -- Critical Path" of the "summary report".
    -----------------------------------------------------------
    procedure WRITE_STOCHA_HEADER_LINE
         (TO_FILE  : TEXT_IO.FILE_TYPE := TEXT_IO.CURRENT_OUTPUT;
          WBS_CODE : STRING := "WBS Code";
          ACT_NAME : STRING := "Activity Title";
          TAIL     : STRING := "Tail";
          HEAD     : STRING := "Head";
          FIN_TIME : STRING := "Finish Time";
          FIN_DATE : STRING := "Finish Date") is

    begin

    TEXT_IO.PUT (TO_FILE, WBS_CODE);
    TEXT_IO.SET_COL (TO_FILE, 19);
    TEXT_IO.PUT (TO_FILE, ACT_NAME);
    TEXT_IO.SET_COL (TO_FILE, 45);
    TEXT_IO.PUT (TO_FILE, TAIL);
    TEXT_IO.SET_COL (TO_FILE, 51);
    TEXT_IO.PUT (TO_FILE, HEAD);
    TEXT_IO.SET_COL (TO_FILE, 57);
    TEXT_IO.PUT (TO_FILE, FIN_TIME);
    TEXT_IO.SET_COL (TO_FILE, 70);
    TEXT_IO.PUT (TO_FILE, FIN_DATE);

    TEXT_IO.NEW_LINE (TO_FILE);

    end WRITE_STOCHA_HEADER_LINE;


    -----------------------------------------------------------
    -- output a line of text for the subsection "Stochastic
    -- Critical Path" of the "summary report".  The text is
    -- defined by "stocha_body_line_record_type"
    -----------------------------------------------------------
    procedure WRITE_STOCHA_BODY_LINE
         (TO_FILE : TEXT_IO.FILE_TYPE := TEXT_IO.CURRENT_OUTPUT;
          A_LINE  : STOCHA_BODY_LINE_RECORD_TYPE) is

    begin
    TEXT_IO.PUT (TO_FILE, A_LINE.WBS_CODE);
    TEXT_IO.SET_COL (TO_FILE, 12);
    TEXT_IO.PUT (TO_FILE, A_LINE.ACT_NAME);
    TEXT_IO.SET_COL (TO_FILE, 45);
    I_NUMBER.PUT (TO_FILE, A_LINE.TAIL, WIDTH => 4);
    TEXT_IO.SET_COL (TO_FILE, 51);
    I_NUMBER.PUT (TO_FILE, A_LINE.HEAD, WIDTH => 4);
    TEXT_IO.SET_COL (TO_FILE, 60);

    if A_LINE.FIN_TIME <= 0.009 then
        TEXT_IO.PUT (TO_FILE, " 0.0");
    else
        F_NUMBER.PUT
           (TO_FILE, A_LINE.FIN_TIME, EXP => 0, FORE => 4, AFT => 2);
    end if;

    TEXT_IO.SET_COL (TO_FILE, 70);
    TEXT_IO.PUT (TO_FILE, CONVERT_TO_NORMAL_DATE (A_LINE.FIN_DATE));
    TEXT_IO.NEW_LINE (TO_FILE);

    end WRITE_STOCHA_BODY_LINE;



    -----------------------------------------------------
    -- output a line of text for the subsections
    --      Total Schedule and Associated Risk
    --      Effort/Manpower Estimates
    --      Cost Estimates
    -- of the "summary report".  The text is
    -- defined by "sched_a_risk_body_line_record_type"
    ------------------------------------------------------
    procedure WRITE_SCHED_A_RISK_BODY_LINE
         (TO_FILE : TEXT_IO.FILE_TYPE := TEXT_IO.CURRENT_OUTPUT;
          A_LINE  : SCHED_A_RISK_BODY_LINE_RECORD_TYPE) is


    procedure WRITE_RESULT_AND_DATE
             (WITH_TEXT   : STRING := " ";
              WITH_RESULT : FLOAT := 0.0;
              WITH_DATE   : DATE_AND_TIME.JULIAN_TYPE) is

        LEFT_MARGIN       : TEXT_IO.COUNT := 5;
        EQUAL_SIGN_COLUMN : TEXT_IO.COUNT := 45;
        RESULT_COLUMN     : TEXT_IO.COUNT := 53;
        DATE_COLUMN       : TEXT_IO.COUNT := 68;

    begin
        TEXT_IO.SET_COL (TO_FILE, TO => LEFT_MARGIN);
        TEXT_IO.PUT (TO_FILE, WITH_TEXT);
        TEXT_IO.SET_COL (TO_FILE, TO => EQUAL_SIGN_COLUMN);
        TEXT_IO.PUT (TO_FILE, "=");
        TEXT_IO.SET_COL (TO_FILE, TO => RESULT_COLUMN);

        if WITH_RESULT <= 0.009 then
        TEXT_IO.PUT (TO_FILE, "  0.00");
        else
        F_NUMBER.PUT
           (TO_FILE, WITH_RESULT, EXP => 0, FORE => 3, AFT => 2);
        end if;

        if WITH_DATE > 0 then
        TEXT_IO.SET_COL (TO_FILE, TO => DATE_COLUMN);
        TEXT_IO.PUT (TO_FILE, CONVERT_TO_NORMAL_DATE (WITH_DATE));
        end if;

        TEXT_IO.NEW_LINE (TO_FILE, 2);
    end WRITE_RESULT_AND_DATE;


    begin

    TEXT_IO.NEW_LINE (TO_FILE, 2);
    TEXT_IO.PUT_LINE (TO_FILE, "TOTAL SCHEDULE AND ASSOCIATED RISK");
    TEXT_IO.PUT_LINE (TO_FILE, "----------------------------------");
    TEXT_IO.NEW_LINE (TO_FILE);

    WRITE_RESULT_AND_DATE (WITH_TEXT   =>
                 INTEGER'IMAGE
                   (INTEGER (PROBABILITY_FOR_OUTPUT *
                         100.0)) &
                 "% Probability Completion Time/Date",
                   WITH_RESULT => A_LINE.PROBABILITY,
                   WITH_DATE   => A_LINE.PROBABILITY_DATE);

    WRITE_RESULT_AND_DATE (WITH_TEXT   => "Optimistic Completion Time/Date",
                   WITH_RESULT => A_LINE.OPTIMISTICS,
                   WITH_DATE   => A_LINE.OPTIMISTICS_DATE);

    WRITE_RESULT_AND_DATE (WITH_TEXT   => "Expected Completion Time/Date",
                   WITH_RESULT => A_LINE.EXPECTATIONS,
                   WITH_DATE   => A_LINE.EXPECTATIONS_DATE);

    WRITE_RESULT_AND_DATE (WITH_TEXT   =>
                 "Pessimistic Completion Time/Date",
                   WITH_RESULT => A_LINE.PESSIMISTICS,
                   WITH_DATE   => A_LINE.PESSIMISTICS_DATE);

    WRITE_RESULT_AND_DATE (WITH_TEXT   => "Standard Deviation",
                   WITH_RESULT => A_LINE.STANDARD_DEVIATION,
                   WITH_DATE   => 0);

    WRITE_RESULT_AND_DATE (WITH_TEXT   =>
                 "Required Schedule with" & ASCII.LF &
                 ASCII.CR & "    probability of completion" &
                 ASCII.LF & ASCII.CR & "    by scheduled date",
                   WITH_RESULT => A_LINE.PROB_REQUIRED_COMPLETE,
                   WITH_DATE   => A_LINE.REQUIRED_DATE);


    TEXT_IO.NEW_LINE (TO_FILE, 2);
    TEXT_IO.PUT_LINE (TO_FILE, "EFFORT/MANPOWER ESTIMATES");
    TEXT_IO.PUT_LINE (TO_FILE, "-------------------------");
    TEXT_IO.NEW_LINE (TO_FILE);
    WRITE_RESULT_AND_DATE (WITH_TEXT   => "Total Effort (in man_days)",
                   WITH_RESULT => A_LINE.TOTAL_EFFORT,
                   WITH_DATE   => 0);

    WRITE_RESULT_AND_DATE (WITH_TEXT   => "Average Manload",
                   WITH_RESULT => A_LINE.AVERAGE_MANLOAD,
                   WITH_DATE   => 0);

    WRITE_RESULT_AND_DATE (WITH_TEXT   => "Peak Manload Time/Date",
                   WITH_RESULT => A_LINE.PEAK_MANLOAD_TIME,
                   WITH_DATE   => A_LINE.PEAK_MANLOAD_DATE);

    WRITE_RESULT_AND_DATE (WITH_TEXT   => "Peak Manload",
                   WITH_RESULT => A_LINE.PEAK_MANLOAD,
                   WITH_DATE   => 0);

    TEXT_IO.NEW_PAGE (TO_FILE);
    TEXT_IO.PUT_LINE (TO_FILE, "COST ESTIMATES");
    TEXT_IO.PUT_LINE (TO_FILE, "--------------");
    TEXT_IO.NEW_LINE (TO_FILE);
    WRITE_RESULT_AND_DATE (WITH_TEXT   => "Direct Labor Cost (in K $)",
                   WITH_RESULT => A_LINE.LABOR_COST,
                   WITH_DATE   => 0);

    WRITE_RESULT_AND_DATE (WITH_TEXT   => "Other Direct Cost (in K $)",
                   WITH_RESULT => A_LINE.DIRECT_COST,
                   WITH_DATE   => 0);

    WRITE_RESULT_AND_DATE (WITH_TEXT   => "Total Cost (in K $)",
                   WITH_RESULT => A_LINE.TOTAL_COST,
                   WITH_DATE   => 0);

    WRITE_RESULT_AND_DATE (WITH_TEXT   => "Average Cost per Man-Hour(in $)",
                   WITH_RESULT => A_LINE.AVERAGE_COST,
                   WITH_DATE   => 0);

    end WRITE_SCHED_A_RISK_BODY_LINE;



    -----------------------------------------------------
    -- output a line of text for the subsections
    --      Network summary metrics
    -- of the "summary report".  The text is
    -- defined by "network_summary_body_line_record_type"
    ------------------------------------------------------
    procedure WRITE_NETWORK_SUMMARY_BODY_LINE
         (TO_FILE : TEXT_IO.FILE_TYPE := TEXT_IO.CURRENT_OUTPUT;
          A_LINE  : NETWORK_SUMMARY_BODY_LINE_RECORD_TYPE) is

    LEFT_MARGIN       : TEXT_IO.COUNT := 5;
    EQUAL_SIGN_COLUMN : TEXT_IO.COUNT := 55;
    RESULT_COLUMN     : TEXT_IO.COUNT := 63;

    procedure WRITE_FLOAT_RESULT (WITH_TEXT   : STRING := " ";
                      WITH_RESULT : FLOAT := 0.0) is


    begin
        TEXT_IO.SET_COL (TO_FILE, TO => LEFT_MARGIN);
        TEXT_IO.PUT (TO_FILE, WITH_TEXT);
        TEXT_IO.SET_COL (TO_FILE, TO => EQUAL_SIGN_COLUMN);
        TEXT_IO.PUT (TO_FILE, "=");
        TEXT_IO.SET_COL (TO_FILE, TO => RESULT_COLUMN);

        if WITH_RESULT <= 0.009 then
        TEXT_IO.PUT (TO_FILE, "  0.00");
        else
        F_NUMBER.PUT
           (TO_FILE, WITH_RESULT, EXP => 0, FORE => 3, AFT => 2);
        end if;

        TEXT_IO.NEW_LINE (TO_FILE, 2);
    end WRITE_FLOAT_RESULT;


    procedure WRITE_INT_RESULT (WITH_TEXT   : STRING := " ";
                    WITH_RESULT : INTEGER := 0) is


    begin
        TEXT_IO.SET_COL (TO_FILE, TO => LEFT_MARGIN);
        TEXT_IO.PUT (TO_FILE, WITH_TEXT);
        TEXT_IO.SET_COL (TO_FILE, TO => EQUAL_SIGN_COLUMN);
        TEXT_IO.PUT (TO_FILE, "=");
        TEXT_IO.SET_COL (TO_FILE, TO => RESULT_COLUMN);
        I_NUMBER.PUT (TO_FILE, WITH_RESULT, WIDTH => 4);
        TEXT_IO.NEW_LINE (TO_FILE, 2);
    end WRITE_INT_RESULT;
    begin

    TEXT_IO.NEW_LINE (TO_FILE);
    TEXT_IO.PUT_LINE (TO_FILE, "NETWORK SUMMARY METRICS");
    TEXT_IO.PUT_LINE (TO_FILE, "-----------------------");
    TEXT_IO.NEW_LINE (TO_FILE);

    WRITE_INT_RESULT (WITH_TEXT   => "Number of ARCS  [excludes dummies]",
              WITH_RESULT => A_LINE.NUMBER_OF_ARCS);

    WRITE_INT_RESULT (WITH_TEXT   => "Number of NODES",
              WITH_RESULT => A_LINE.NUMBER_OF_NODES);

    WRITE_INT_RESULT (WITH_TEXT   =>
                "MAX Number of ARCS in any path [includes dummies]",
              WITH_RESULT => A_LINE.MAX_NUMBER_OF_ARCS);

    TEXT_IO.SET_COL (TO_FILE, TO => LEFT_MARGIN);
    TEXT_IO.PUT (TO_FILE, "MAX Number of Parallel Paths");
    TEXT_IO.SET_COL (TO_FILE, TO => EQUAL_SIGN_COLUMN);
    TEXT_IO.PUT (TO_FILE, "=");
    TEXT_IO.SET_COL (TO_FILE, TO => RESULT_COLUMN);
    I_NUMBER.PUT (TO_FILE, A_LINE.MAX_NUMBER_OF_PARA, WIDTH => 4);
    TEXT_IO.NEW_LINE (TO_FILE);
    TEXT_IO.SET_COL (TO_FILE, 10);
    TEXT_IO.PUT_LINE (TO_FILE,
              "MAX occurs first on  " &
              CONVERT_TO_NORMAL_DATE (A_LINE.MAX_OCCUR_DATE));
    TEXT_IO.NEW_LINE (TO_FILE);

    WRITE_FLOAT_RESULT (WITH_TEXT   => "Network Complexity",
                WITH_RESULT => A_LINE.NET_COMPLEX);

    WRITE_FLOAT_RESULT (WITH_TEXT   => "Stochastic Complexity",
                WITH_RESULT => A_LINE.STOCHA_COMPLEX);

    WRITE_FLOAT_RESULT (WITH_TEXT   => "Total Stochastic Free Slack",
                WITH_RESULT => A_LINE.STOCHA_FREE_SLCK);

    WRITE_FLOAT_RESULT (WITH_TEXT   => "Sum of all activity durations",
                WITH_RESULT => A_LINE.SUM_OF_ACT_DURATS);

    TEXT_IO.SET_COL (TO_FILE, 5);
    TEXT_IO.PUT_LINE (TO_FILE, "MAX arc :  " & A_LINE.MAX_ARC);
    TEXT_IO.SET_COL (TO_FILE, 10);
    TEXT_IO.PUT (TO_FILE, "MAX duration  =      ");

    if A_LINE.MAX_DURATIONS <= 0.009 then
        TEXT_IO.PUT (TO_FILE, "  0.00");
    else
        F_NUMBER.PUT
           (TO_FILE, A_LINE.MAX_DURATIONS, EXP => 0, FORE => 3, AFT => 2);
    end if;

    TEXT_IO.NEW_LINE (TO_FILE, 2);

    WRITE_FLOAT_RESULT (WITH_TEXT   => "Average Duration [no dummies]",
                WITH_RESULT => A_LINE.AVERAGE_DURATIONS);

    WRITE_FLOAT_RESULT (WITH_TEXT   => "Stochastic Density",
                WITH_RESULT => A_LINE.STOCHASTIC_DENSITY);

    WRITE_FLOAT_RESULT (WITH_TEXT   => "Average Time Width",
                WITH_RESULT => A_LINE.AVG_TIME_WIDTH);
    TEXT_IO.NEW_LINE (TO_FILE, 4);

    TEXT_IO.PUT_LINE (THE_SUMMARY_REPORT, "Note:");
    TEXT_IO.PUT_LINE (THE_SUMMARY_REPORT,
              "   (1) SIMPERT global report found in file " &
              "----------------->   " & THE_SUMMARY_REPORT_NAME);

    TEXT_IO.PUT_LINE (THE_SUMMARY_REPORT,
              "   (2) Activity report " &
              "------------------------------------->   " &
              THE_ACTIVITY_REPORT_NAME);

    TEXT_IO.PUT_LINE (THE_SUMMARY_REPORT,
              "   (3) Node report " &
              "----------------------------------------->   " &
              THE_NODE_REPORT_NAME);

    TEXT_IO.PUT_LINE (THE_SUMMARY_REPORT,
              "   (4) Data points for manpower curve " &
              "temporarily in file -->   " &
              THE_MANPOWER_REPORT_NAME);

    TEXT_IO.PUT_LINE (THE_SUMMARY_REPORT,
              "   (5) Input data for Gantt Chart are " &
              "found in file -------->   " & THE_GANTT_REPORT_NAME);

    TEXT_IO.PUT_LINE (THE_SUMMARY_REPORT,
              "   (6) RENAME any of the files.tem  " &
              "if you want to save them");


    end WRITE_NETWORK_SUMMARY_BODY_LINE;





begin

    TEXT_IO.CREATE (THE_SUMMARY_REPORT, TEXT_IO.OUT_FILE,
            THE_SUMMARY_REPORT_NAME);

    ------------------------------------------------------------
    -- Output the summary report.  A header is output first,
    -- then a line for each activity.
    ------------------------------------------------------------
    declare
    NODE_LIST    : constant PERT_OPS.NODE_LIST_TYPE :=
               PERT_OPS.NODES (ON_GRAPH => NETWORK);
    CURRENT_NODE : PERT_OPS.NODE_TYPE;

    begin
    WRITE_HEADER_REPORT (TO_FILE => THE_SUMMARY_REPORT, PAGE_WIDTH => 80);

    TEXT_IO.NEW_LINE (THE_SUMMARY_REPORT, 2);
    TEXT_IO.PUT_LINE (THE_SUMMARY_REPORT, "STOCHASTIC CRITICAL PATH:");
    TEXT_IO.NEW_LINE (THE_SUMMARY_REPORT, 2);

    WRITE_STOCHA_HEADER_LINE
       (TO_FILE  => THE_SUMMARY_REPORT,
        WBS_CODE => "WBS Code",
        ACT_NAME => "Activity Title",
        TAIL     => "Tail",
        HEAD     => "Head",
        FIN_TIME => "Finish Time",
        FIN_DATE => "Finish Date");

    declare
        THE_UNDER_LINE : STRING (1 .. 80) := (1 .. 80 => '_');

    begin
        TEXT_IO.PUT_LINE (THE_SUMMARY_REPORT, THE_UNDER_LINE);
    end;

    TEXT_IO.NEW_LINE (THE_SUMMARY_REPORT);

    ----------------------------------------------------
    -- Find the Head node for the desired critical path.
    ----------------------------------------------------
    for NODE_INDEX in NODE_LIST'RANGE loop
        CURRENT_NODE := NODE_LIST (NODE_INDEX);

        if PERT_OPS.VALUE (CURRENT_NODE).EVENT_ID = CRIT_PATH_HEAD_NODE then
        exit;
        end if;
    end loop;

    while not PERT_OPS."="
             (CURRENT_NODE, PERT_OPS.START_NODE (NETWORK)) loop

        declare
        CURRENT_EVENT_VALUE : EVENT_TYPE :=
                      PERT_OPS.VALUE (CURRENT_NODE);
        ARC_LIST            : constant PERT_OPS.ARC_LIST_TYPE :=
                      PERT_OPS.INCOMING_ARCS
                     (ON_NODE => CURRENT_NODE);
        ACTIVITY_ARC        : PERT_OPS.ARC_TYPE :=
                      ARC_LIST (CURRENT_EVENT_VALUE
                         .MOST_CRIT_INBOUND_ARC);
        ACTIVITY            : ACTIVITY_TYPE :=
                      PERT_OPS.VALUE (ACTIVITY_ARC);
        STOP_TICK           : INTEGER :=
                      TIME_UNIT_DONE (ACTIVITY.ESTIMATE_STOP);
        STOCHA_BODY_LINE    : STOCHA_BODY_LINE_RECORD_TYPE;

        begin
        STOCHA_BODY_LINE.WBS_CODE := ACTIVITY.NAME (1 .. 8);
        STOCHA_BODY_LINE.ACT_NAME := ACTIVITY.NAME (11 .. 42);
        STOCHA_BODY_LINE.TAIL :=
          PERT_OPS.VALUE (PERT_OPS.TAIL_NODE (ACTIVITY_ARC)).EVENT_ID;
        STOCHA_BODY_LINE.HEAD := CURRENT_EVENT_VALUE.EVENT_ID;
        STOCHA_BODY_LINE.FIN_TIME := ACTIVITY.ESTIMATE_STOP;
        STOCHA_BODY_LINE.FIN_DATE :=
          FIND_PROPER_DATE (JULIAN_START_DATE, STOP_TICK);
        WRITE_STOCHA_BODY_LINE
           (TO_FILE => THE_SUMMARY_REPORT, A_LINE => STOCHA_BODY_LINE);

        CURRENT_NODE := PERT_OPS.TAIL_NODE (ACTIVITY_ARC);
        end;
    end loop;

    end;

    --------------------------------------------
    -- Output the Risk Information, the Summary.
    --------------------------------------------
    OUTPUT_RISK_INFORMATION:
    declare
    JULIAN_REQ_COMPLETE                            : DATE_AND_TIME
                              .JULIAN_TYPE;
    COMPLETE_PROJECT                               : PERT_OPS.NODE_TYPE :=
                             PERT_OPS.END_NODE
                                (OF_GRAPH =>
                                   NETWORK);
    COMPLETE_PROJECT_INFO                          : EVENT_TYPE :=
                             PERT_OPS.VALUE
                                (COMPLETE_PROJECT);
    TIME_FOR_PROJECT                               : FLOAT;
    END_PROJECT_TIME_UNIT                          : constant INTEGER :=
                             TIME_UNIT_DONE
                                (COMPLETE_PROJECT_INFO
                                  .ESTIMATE_TIME_OF_EVENT);
    LOAD_PER_TIME_UNIT                             : array (1 .. END_PROJECT_TIME_UNIT)
                                    of FLOAT :=
                             (1 .. END_PROJECT_TIME_UNIT =>
                                0.0);
    TOTAL_LAB_COST, TOTAL_DIRECT_COST, TOTAL_LABOR : FLOAT := 0.0;
    PEAK_LOADING                                   : FLOAT := 0.0;
    PEAK_TIME_UNIT                                 : INTEGER;
    SUM_OF_ALL_ACTIVITY_TIMES                      : FLOAT := 0.0;
    NAME_OF_LONGEST_ACTIVITY                       : STRING (1 .. 32);
    MAX_ACTIVITY_TIME                              : FLOAT := 0.0;
    MAX_PARALLEL_PATHS                             : INTEGER := 0;
    MAX_PARALLEL_OCCURANCE                         : DATE_AND_TIME
                              .JULIAN_TYPE := 1;
    SCHED_A_RISK_BODY_LINE                         : SCHED_A_RISK_BODY_LINE_RECORD_TYPE;

    begin
    SCHED_A_RISK_BODY_LINE.PROBABILITY :=
      COMPLETE_PROJECT_INFO.ESTIMATE_TIME_OF_EVENT;
    SCHED_A_RISK_BODY_LINE.PROBABILITY_DATE :=
      FIND_PROPER_DATE (JULIAN_START_DATE,
                TO_DAYS (TIME_UNIT_DONE
                    (SCHED_A_RISK_BODY_LINE.PROBABILITY)));

    SCHED_A_RISK_BODY_LINE.OPTIMISTICS :=
      COMPLETE_PROJECT_INFO.SIM_TIME_OF_EVENT -
      (3.0 * (COMPLETE_PROJECT_INFO.VARIANCE) ** 0.5);
    SCHED_A_RISK_BODY_LINE.OPTIMISTICS_DATE :=
      FIND_PROPER_DATE (JULIAN_START_DATE,
                TO_DAYS (TIME_UNIT_DONE
                    (SCHED_A_RISK_BODY_LINE.OPTIMISTICS)));

    SCHED_A_RISK_BODY_LINE.EXPECTATIONS :=
      COMPLETE_PROJECT_INFO.SIM_TIME_OF_EVENT;
    SCHED_A_RISK_BODY_LINE.EXPECTATIONS_DATE :=
      FIND_PROPER_DATE (JULIAN_START_DATE,
                TO_DAYS (TIME_UNIT_DONE
                    (SCHED_A_RISK_BODY_LINE.EXPECTATIONS)));

    SCHED_A_RISK_BODY_LINE.PESSIMISTICS :=
      COMPLETE_PROJECT_INFO.SIM_TIME_OF_EVENT +
      (3.0 * (COMPLETE_PROJECT_INFO.VARIANCE) ** 0.5);
    SCHED_A_RISK_BODY_LINE.PESSIMISTICS_DATE :=
      FIND_PROPER_DATE (JULIAN_START_DATE,
                TO_DAYS (TIME_UNIT_DONE
                    (SCHED_A_RISK_BODY_LINE.PESSIMISTICS)));

    SCHED_A_RISK_BODY_LINE.STANDARD_DEVIATION :=
      COMPLETE_PROJECT_INFO.VARIANCE ** 0.5;

    -------------------------------------------------
    -- prompt user for a desired complete date,
    -- stop date will be used as default otherwise
    -------------------------------------------------
    JULIAN_REQ_COMPLETE :=
      GET_NEW_DATE (WITH_YESNO_PROMPT =>
              "Do you have " &
              "a required completion date?  ENTER [y/n]  -->   ",
            PASSED_DATE       =>
              SCHED_A_RISK_BODY_LINE.PROBABILITY_DATE,
            AND_TEXT_PROMPT   => "ENTER required project " &
                         "completion date");

    SCHED_A_RISK_BODY_LINE.REQUIRED_DATE :=
      FIND_PROPER_DATE (JULIAN_REQ_COMPLETE, 1);

    TIME_FOR_PROJECT := FLOAT (WORKDAYS_BETWEEN
                      (JULIAN_START_DATE, JULIAN_REQ_COMPLETE));

    if COMPLETE_PROJECT_INFO.VARIANCE = 0.0 then
        if TIME_FOR_PROJECT > COMPLETE_PROJECT_INFO.SIM_TIME_OF_EVENT then
        SCHED_A_RISK_BODY_LINE.PROB_REQUIRED_COMPLETE := 1.0;
        else
        SCHED_A_RISK_BODY_LINE.PROB_REQUIRED_COMPLETE := 0.0;
        end if;
    else
        SCHED_A_RISK_BODY_LINE.PROB_REQUIRED_COMPLETE :=
          MATH_FUNCTIONS.NORMAL_FUNCTION
         (TIME_DIFFERENCE    =>
            TIME_FOR_PROJECT - COMPLETE_PROJECT_INFO.SIM_TIME_OF_EVENT,
          STANDARD_DEVIATION => COMPLETE_PROJECT_INFO.VARIANCE ** 0.5);

        if SCHED_A_RISK_BODY_LINE.PROB_REQUIRED_COMPLETE < 0.01 then
        SCHED_A_RISK_BODY_LINE.PROB_REQUIRED_COMPLETE := 0.0;
        end if;
    end if;

    --------------------------------------------------------------
    -- Figure Total Cost, Total Labor, and Network Summery Metrics.
    --------------------------------------------------------------
    FIGURE_TOTALS_AND_MAXES_FROM_ACTIVITY_LIST:
    declare
        ACTIVITY             : ACTIVITY_TYPE;
        DURATION             : FLOAT;
        NET_ACTIVITY_GAIN    : array (1 .. END_PROJECT_TIME_UNIT)
                      of INTEGER :=
                   (1 .. END_PROJECT_TIME_UNIT => 0);
        PARALLEL_ACCUMULATOR : INTEGER := 0;
        ACTIVITY_STOP        : INTEGER := 0;
        ACTIVITY_START       : INTEGER := 0;
    begin
        for ACTIVITY_INDEX in FINAL_ACTIVITY_LIST'RANGE loop
        ACTIVITY := PERT_OPS.VALUE
                   (FINAL_ACTIVITY_LIST (ACTIVITY_INDEX));

        ACTIVITY_START := TIME_UNIT_STARTED (ACTIVITY.ESTIMATE_START);
        ACTIVITY_STOP := TIME_UNIT_DONE (ACTIVITY.ESTIMATE_STOP);
        DURATION := FLOAT (ACTIVITY_STOP - ACTIVITY_START + 1);

        TOTAL_LAB_COST :=
          TOTAL_LAB_COST + ACTIVITY.RATE * ACTIVITY.STAFFING * DURATION;

        TOTAL_LABOR := TOTAL_LABOR + ACTIVITY.STAFFING * DURATION;

        if ACTIVITY.STAFFING = 0.0 then
            TOTAL_DIRECT_COST := TOTAL_DIRECT_COST + ACTIVITY.RATE;
        end if;

        SUM_OF_ALL_ACTIVITY_TIMES :=
          SUM_OF_ALL_ACTIVITY_TIMES + DURATION;

        if DURATION > MAX_ACTIVITY_TIME then
            MAX_ACTIVITY_TIME := DURATION;
            NAME_OF_LONGEST_ACTIVITY := ACTIVITY.NAME (11 .. 42);
        end if;

        ACCOUNTING_FOR_STARTING_AND_STOPING_OF_ACTIVITY:
        begin
            for TIME_UNIT_INDEX in ACTIVITY_START .. ACTIVITY_STOP loop
            declare
                STAFF : FLOAT
                     renames LOAD_PER_TIME_UNIT
                        (TIME_UNIT_INDEX);
            begin
                STAFF := STAFF + ACTIVITY.STAFFING;

                if STAFF > PEAK_LOADING then
                PEAK_LOADING := STAFF;
                PEAK_TIME_UNIT := TIME_UNIT_INDEX;
                end if;
            end;
            end loop;

            NET_ACTIVITY_GAIN (ACTIVITY_START) :=
              NET_ACTIVITY_GAIN (ACTIVITY_START) + 1;
            NET_ACTIVITY_GAIN (ACTIVITY_STOP) :=
              NET_ACTIVITY_GAIN (ACTIVITY_STOP) - 1;
        end ACCOUNTING_FOR_STARTING_AND_STOPING_OF_ACTIVITY;

        end loop;

        for TIME_UNIT_INDEX in 1 .. END_PROJECT_TIME_UNIT loop
        PARALLEL_ACCUMULATOR :=
          PARALLEL_ACCUMULATOR + NET_ACTIVITY_GAIN (TIME_UNIT_INDEX);

        if PARALLEL_ACCUMULATOR > MAX_PARALLEL_PATHS then
            MAX_PARALLEL_PATHS := PARALLEL_ACCUMULATOR;
            MAX_PARALLEL_OCCURANCE := TIME_UNIT_INDEX;
        end if;
        end loop;
    end FIGURE_TOTALS_AND_MAXES_FROM_ACTIVITY_LIST;

    SCHED_A_RISK_BODY_LINE.TOTAL_EFFORT := TOTAL_LABOR;

    SCHED_A_RISK_BODY_LINE.AVERAGE_MANLOAD :=
      TOTAL_LABOR / COMPLETE_PROJECT_INFO.SIM_TIME_OF_EVENT;

    SCHED_A_RISK_BODY_LINE.PEAK_MANLOAD_TIME := FLOAT (PEAK_TIME_UNIT);

    SCHED_A_RISK_BODY_LINE.PEAK_MANLOAD_DATE :=
      FIND_PROPER_DATE (JULIAN_START_DATE, PEAK_TIME_UNIT);

    SCHED_A_RISK_BODY_LINE.PEAK_MANLOAD := PEAK_LOADING;

    SCHED_A_RISK_BODY_LINE.LABOR_COST := TOTAL_LAB_COST / 1000.0;

    SCHED_A_RISK_BODY_LINE.DIRECT_COST := TOTAL_DIRECT_COST / 1000.0;

    SCHED_A_RISK_BODY_LINE.TOTAL_COST :=
      (TOTAL_LAB_COST + TOTAL_DIRECT_COST) / 1000.0;

    if TOTAL_LABOR /= 0.0 then
        SCHED_A_RISK_BODY_LINE.AVERAGE_COST :=
          TOTAL_LAB_COST / (TOTAL_LABOR * FLOAT (TO_DAYS (1)) * 8.0);
    else
        SCHED_A_RISK_BODY_LINE.AVERAGE_COST := 0.0;
    end if;


    ------------------------------------------------------------------------
    -- Output the lines for the report: a header, and the report information
    ------------------------------------------------------------------------
    WRITE_HEADER_REPORT (TO_FILE => THE_SUMMARY_REPORT, PAGE_WIDTH => 80);
    TEXT_IO.NEW_LINE (THE_SUMMARY_REPORT, 2);

    WRITE_SCHED_A_RISK_BODY_LINE
       (TO_FILE => THE_SUMMARY_REPORT, A_LINE => SCHED_A_RISK_BODY_LINE);


    ------------------------------------------------------------------------
    -- Build the output report for the summary listings, output the headers
    -- and this report.
    ------------------------------------------------------------------------
    WRITE_NETWORK_SUMMARY:
    declare
        NODE_LIST                 : constant PERT_OPS.NODE_LIST_TYPE :=
                    PERT_OPS.NODES (ON_GRAPH => NETWORK);
        NETWORK_SUMMARY_BODY_LINE : NETWORK_SUMMARY_BODY_LINE_RECORD_TYPE;
    begin
        NETWORK_SUMMARY_BODY_LINE.NUMBER_OF_ARCS :=
          FINAL_ACTIVITY_LIST'LENGTH;
        NETWORK_SUMMARY_BODY_LINE.NUMBER_OF_NODES := NODE_LIST'LENGTH;

        NETWORK_SUMMARY_BODY_LINE.MAX_NUMBER_OF_ARCS :=
          COMPLETE_PROJECT_INFO.LONGEST_PATH_TO_EVENT;
        NETWORK_SUMMARY_BODY_LINE.MAX_NUMBER_OF_PARA := MAX_PARALLEL_PATHS;
        NETWORK_SUMMARY_BODY_LINE.MAX_OCCUR_DATE :=
          FIND_PROPER_DATE (JULIAN_START_DATE, MAX_PARALLEL_OCCURANCE);

        NETWORK_SUMMARY_BODY_LINE.NET_COMPLEX :=
          1.0 -
          FLOAT (NETWORK_SUMMARY_BODY_LINE.NUMBER_OF_NODES) /
          FLOAT (NETWORK_SUMMARY_BODY_LINE.NUMBER_OF_ARCS + 1);

        if COMPLETE_PROJECT_INFO.VARIANCE = 0.0 then
        NETWORK_SUMMARY_BODY_LINE.STOCHA_COMPLEX := 1.0;
        else
        NETWORK_SUMMARY_BODY_LINE.STOCHA_COMPLEX :=
          1.0 -
          2.0 *
          MATH_FUNCTIONS.NORMAL_FUNCTION
             ((COMPLETE_PROJECT_INFO.DET_TIME_OF_EVENT -
               COMPLETE_PROJECT_INFO.SIM_TIME_OF_EVENT),
              COMPLETE_PROJECT_INFO.VARIANCE ** 0.5);

        if NETWORK_SUMMARY_BODY_LINE.STOCHA_COMPLEX < 0.0 then
            NETWORK_SUMMARY_BODY_LINE.STOCHA_COMPLEX := 0.0;
        end if;
        end if;

        NETWORK_SUMMARY_BODY_LINE.STOCHA_FREE_SLCK := TOTAL_FREE_SLACK;

        NETWORK_SUMMARY_BODY_LINE.SUM_OF_ACT_DURATS :=
          SUM_OF_ALL_ACTIVITY_TIMES;

        NETWORK_SUMMARY_BODY_LINE.MAX_ARC := NAME_OF_LONGEST_ACTIVITY;

        NETWORK_SUMMARY_BODY_LINE.MAX_DURATIONS := MAX_ACTIVITY_TIME;

        NETWORK_SUMMARY_BODY_LINE.AVERAGE_DURATIONS :=
          SUM_OF_ALL_ACTIVITY_TIMES / FLOAT (FINAL_ACTIVITY_LIST'LENGTH);

        NETWORK_SUMMARY_BODY_LINE.STOCHASTIC_DENSITY :=
          SUM_OF_ALL_ACTIVITY_TIMES /
          (SUM_OF_ALL_ACTIVITY_TIMES + TOTAL_FREE_SLACK);
        NETWORK_SUMMARY_BODY_LINE.AVG_TIME_WIDTH :=
          SUM_OF_ALL_ACTIVITY_TIMES /
          COMPLETE_PROJECT_INFO.SIM_TIME_OF_EVENT;


        ------------------------------------------------------
        -- Write the summary information to the report file.
        ------------------------------------------------------
        WRITE_HEADER_REPORT
           (TO_FILE => THE_SUMMARY_REPORT, PAGE_WIDTH => 80);
        TEXT_IO.NEW_LINE (THE_SUMMARY_REPORT, 2);

        WRITE_NETWORK_SUMMARY_BODY_LINE
           (TO_FILE => THE_SUMMARY_REPORT,
        A_LINE  => NETWORK_SUMMARY_BODY_LINE);

    end WRITE_NETWORK_SUMMARY;

    TEXT_IO.CLOSE (THE_SUMMARY_REPORT);


    -----------------------------------------------------------
    -- Do necessary output processing for the manpower report.
    -----------------------------------------------------------
    TEXT_IO.CREATE (THE_MANPOWER_REPORT, TEXT_IO.OUT_FILE,
            THE_MANPOWER_REPORT_NAME);

    GENERATE_MANPOWER_REPORT:
    declare
        MANPOWER_REPORT_BODY_LINE : MANPOWER_REPORT_BODY_LINE_RECORD_TYPE;
    begin
        WRITE_HEADER_REPORT
           (TO_FILE => THE_MANPOWER_REPORT, PAGE_WIDTH => 80);

        declare
        WORKING_COLUMN  : TEXT_IO.COUNT := 10;
        MANPOWER_COLUMN : TEXT_IO.COUNT := 43;
        begin
        TEXT_IO.NEW_LINE (THE_MANPOWER_REPORT, 2);
        TEXT_IO.SET_COL (THE_MANPOWER_REPORT, TO => WORKING_COLUMN);
        TEXT_IO.PUT (THE_MANPOWER_REPORT,
                 "Working " & REQUESTED_UNIT_CODE);
        TEXT_IO.SET_COL (THE_MANPOWER_REPORT, TO => MANPOWER_COLUMN);
        TEXT_IO.PUT_LINE (THE_MANPOWER_REPORT, "Manpower");
        TEXT_IO.SET_COL (THE_MANPOWER_REPORT, TO => WORKING_COLUMN);
        TEXT_IO.PUT (THE_MANPOWER_REPORT, "------------");
        TEXT_IO.SET_COL (THE_MANPOWER_REPORT, TO => MANPOWER_COLUMN);
        TEXT_IO.PUT_LINE (THE_MANPOWER_REPORT, "--------");
        TEXT_IO.NEW_LINE (THE_MANPOWER_REPORT);
        end;

        for INDEX in LOAD_PER_TIME_UNIT'RANGE loop
        MANPOWER_REPORT_BODY_LINE.WORKING_DAYS := INDEX;
        MANPOWER_REPORT_BODY_LINE.MANPOWER :=
          LOAD_PER_TIME_UNIT (INDEX);
        WRITE_MANPOWER_REPORT_BODY_LINE
           (TO_FILE => THE_MANPOWER_REPORT,
            A_LINE  => MANPOWER_REPORT_BODY_LINE);
        end loop;

        TEXT_IO.CLOSE (THE_MANPOWER_REPORT);
    end GENERATE_MANPOWER_REPORT;


    end OUTPUT_RISK_INFORMATION;

exception
    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " &
               "[PERT.OUTPUT_VALUES.SUM_MAN]");

end SUM_MAN;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--outgantt.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_IO;
with SCREEN_IO;
with FILE_OPS;
with DATE_AND_TIME;
with FILE_HANDLER;

separate (SCHEDULE)
procedure OUT_GANTT is
-----------------------------------------------------------
-- Author:     Larry Yelowitz, T. C. Bryan
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :     May 25 1985
-- Summary:    This procedure outputs a Gantt chart based on
--            data generated during Simpert.
-----------------------------------------------------------

    MAX_NUM_ACTIVITIES  : constant INTEGER := 500;
    MAX_NUM_HOLIDAYS    : constant INTEGER := 100;   -- over lifetime of project


    CAL_DAYS_PER_PERIOD : constant INTEGER := 91;    --13 weeks per time period
    WORKDAYS_PER_WEEK   : INTEGER range 5 .. 7;      --read from input file
    ACTIVITY_COUNTER    : INTEGER range 0 .. 20 := 0; --num activ. per page
    ACTUAL_NUM_HOLIDAYS : INTEGER range 0 .. MAX_NUM_HOLIDAYS :=
              MAX_NUM_HOLIDAYS;
    ------------------------------------------------------------------
    --later, read in ACTUAL_NUM_HOLIDAYS from input file
    ------------------------------------------------------------------

    NUM_CURRENT_HOLIDAYS : INTEGER range 0 .. 50 := 0; --in current period
    WEEKENDS_PER_PERIOD  : INTEGER range 0 .. 26;
    START_DAY_INDEX      : INTEGER range 0 .. 6; --day of actual start.
                         --0 = SUNDAY.
                         --init from file; then constant
    NUM_ACTIVITIES       : INTEGER range 1 .. MAX_NUM_ACTIVITIES;
    NUM_CURRENT_WORKDAYS : INTEGER range 1 .. CAL_DAYS_PER_PERIOD;
    CAL_DAYS_ELAPSED     : INTEGER := 0;                --update by
                                  -- CAL_DAYS_PER_PERIOD.

    PAGE                 : INTEGER := 0; --Number the pages that get printed.

    subtype PROJECT_DAYS_FOOTER is INTEGER range -5 .. 1090; --footer on each
                                 -- page
    subtype PROJECT_DAYS is PROJECT_DAYS_FOOTER range 0 .. 999;
    ------------------------------------------------------------------
    --working days into project.
    ------------------------------------------------------------------

    type ACTIVITY_INFO is
    record
        NAME     : STRING (1 .. 32);
        START    : PROJECT_DAYS; --start day, based on working days into
                     -- proj
        STOP     : PROJECT_DAYS;
        CRITICAL : BOOLEAN; -- on critical path?
    end record;

    type ACTIVITIES_INFO is array (NATURAL range <>) of ACTIVITY_INFO;

    ------------------------------------------------------------------
    --  type OUTPUT_SYMBOLS is ('!','H',' ','-', '=', 'T', '^', '*');
    --  '*' for potential workdays prior to project start.
    ------------------------------------------------------------------

    type WORKDAY_FOOTERS is array (1 .. CAL_DAYS_PER_PERIOD / 7 + 1)
                   of PROJECT_DAYS_FOOTER;

    subtype OUTPUT_LINE_INDEX is INTEGER range 0 .. CAL_DAYS_PER_PERIOD;
    type OUTPUT_LINE is array (OUTPUT_LINE_INDEX) of CHARACTER;

    type MAPPING is array (1 .. CAL_DAYS_PER_PERIOD) of OUTPUT_LINE_INDEX;

    subtype JULIAN is DATE_AND_TIME.JULIAN_TYPE; --from date_and_time.
    type HOLIDAYS is array (1 .. ACTUAL_NUM_HOLIDAYS) of JULIAN;
    ------------------------------------------------------------------
    --TBD  Later, make HOLIDAYS a discr. record based on true value of
    -- ACTUAL_NUM_HOLIDAYS
    --only 1..ACTUAL_NUM_HOLIDAYS is valid at any time.
    ------------------------------------------------------------------

    SYMBOL     : CHARACTER;
    ACTIVITIES : ACTIVITIES_INFO (1 .. MAX_NUM_ACTIVITIES);
    ------------------------------------------------------------------
    -- make ACTIVITIES a discr. record of 1..NUM_ACTIVITIES
    ------------------------------------------------------------------
    WORKDAYS_ELAPSED          : PROJECT_DAYS := 0;
    PROJ_STOP_DAY             : PROJECT_DAYS; --read from file. Total no.
                          -- workdays in proj.
    WORKDAY_FOOTER            : WORKDAY_FOOTERS := (WORKDAY_FOOTERS'RANGE => 0);
    HOLIDAY_LINE              : OUTPUT_LINE := (others => ' ');
    ACTIVITY_OUTPUT_LINE      : OUTPUT_LINE; --build up per activity per time
                         -- period.
    INITIALIZED_ACTIVITY_LINE : OUTPUT_LINE;
    ------------------------------------------------------------------
    --contains weekend and holi symbols per period
    ------------------------------------------------------------------
    MAP_VIRTUAL_TO_WORKDAYS : MAPPING;
    ------------------------------------------------------------------
    --only 1..NUM_CURRENT_WORKDAYS is valid.
    -- MVTW(i) denotes index in ACTIVITY_OUTPUT_LINE of ith workday.
    ------------------------------------------------------------------

    TENTATIVE_START_INDEX : INTEGER range -999 .. 999;
    TENTATIVE_STOP_INDEX  : INTEGER range -999 .. 999;
    ACTIVITY_START_INDEX  : OUTPUT_LINE_INDEX;
    ACTIVITY_STOP_INDEX   : OUTPUT_LINE_INDEX;

    DESIRED_CAL_START_DAY : DATE_AND_TIME.CALENDAR_TYPE;
    HOLI                  : DATE_AND_TIME.CALENDAR_TYPE;
    DESIRED_START_DAY     : JULIAN;
    ACTUAL_START_DAY      : JULIAN;

    JULIAN_HOLIDAYS       : HOLIDAYS; --read from input file and convert to
                      -- Julian.
    NORMALIZED_HOLIDAYS   : HOLIDAYS; --relative to actual start day.

    FILLER_LINE           : OUTPUT_LINE := (others => ' '); --contains symbols
                                -- for weekends.

    type STRING_ACCESS_TYPE is access STRING;

    ERROR_INDENTATION : TEXT_IO.COUNT := 15;

    HEADER_TITLE      : constant STRING :=
            FILE_HANDLER.VERIFY_LABEL
               (WITH_PROMPT     =>
                  ASCII.FF & ASCII.LF & ASCII.CR & ASCII.LF &
                  ASCII.CR & ASCII.LF & ASCII.CR &
                  "ENTER a Title for the output report." &
                  "  [60 characters or less]",
                STRING_TYPE     => "Title",
                LENGTH_OF_LABEL => 60);

    ------------------------------------------------------------------
    --header info on each output page
    ------------------------------------------------------------------

    DATE_TODAY  : constant STRING := DATE_AND_TIME.CURRENT_DATE;

    PROB_HEADER : FLOAT;

    ------------------------------------------------------------------
    --Declarations for files follow.
    ------------------------------------------------------------------

    GANTT_OUTPUT_FILE_NAME : constant STRING :=
                 FILE_HANDLER.VERIFY_LABEL
                (WITH_PROMPT     =>
                   ASCII.FF & ASCII.LF & ASCII.CR & ASCII.LF &
                   ASCII.CR & ASCII.LF & ASCII.CR &
                   "In what file is Gantt output data stored?" &
                   "  [32 characters or less] -->  ",
                 STRING_TYPE     => "Title",
                 LENGTH_OF_LABEL => 32);
    INPUT_FILE_NAME        : constant STRING :=
                 FILE_HANDLER.VERIFY_INPUT
                (FILE_PROMPT          =>
                   ASCII.FF & ASCII.LF & ASCII.CR & ASCII.LF &
                   ASCII.CR & ASCII.LF & ASCII.CR &
                   "ENTER the name of the file containing " &
                   "Activity Information" & ASCII.LF &
                   ASCII.CR & "[32 characters or less].",
                 MAX_FILE_NAME_LENGTH => 32);

    HOLIDAY_FILE_NAME      : constant STRING :=
                 FILE_HANDLER.VERIFY_INPUT
                (FILE_PROMPT          =>
                   ASCII.LF & ASCII.CR & ASCII.LF & ASCII.CR &
                   ASCII.LF & ASCII.CR &
                   "ENTER the name of the file containing " &
                   "Holiday date" & ASCII.LF & ASCII.CR &
                   "[32 character or less].",
                 MAX_FILE_NAME_LENGTH => 32);

    END_VERIFY_OUTPUT, STOP_ON_USER_REQUEST, END_OUT_GANTT : exception;

    HOLIDAY_FILE : TEXT_IO.FILE_TYPE;
    INPUT_FILE   : TEXT_IO.FILE_TYPE;
    OUTPUT_FILE  : TEXT_IO.FILE_TYPE;


    package INT_IO is new TEXT_IO.INTEGER_IO (INTEGER);
    package FLT_IO is new TEXT_IO.FLOAT_IO (FLOAT);


    ------------------------------------------------------------------
    -- LOCAL SUBPROGRAMS FOLLOW
    ------------------------------------------------------------------

    procedure GANTT_INITIALIZE is separate;

    procedure FILL_HOLIDAY_LINE is separate;

    procedure INIT_ACTIVITY_LINE is separate;

    procedure FILL_WORKDAYS_FOOTER is separate;

    procedure VIRTUAL_MAP is separate;

    procedure PRINT_HEADER is separate;

    procedure PRINT_MONTH_DAY_HEADER is separate;

    procedure PRINT_ACTIVITY (I : INTEGER) is separate;

    procedure PRINT_FILLER is separate;

    procedure PRINT_FOOTER is separate;

    procedure LIMIT_PRINT is separate;





    procedure VERIFY_OUTPUT_FILE is

    type YN_TYPE is (Y, YE, YES, N, NO, NONE);

    function RETURN_YN is new SCREEN_IO.RETURNED_ENUMERATION (YN_TYPE);

    GO_AHEAD     : BOOLEAN := TRUE;

    THE_OUT_FILE : TEXT_IO.FILE_TYPE;

    END_RESET_EXISTING_OUTFILE, STOP_FILES_EXIST : exception;


    procedure RESET_EXISTING_OUTFILE is
    begin
        FILE_OPS.OPEN
           (THE_FILE         => THE_OUT_FILE,
        WITH_NAME        => GANTT_OUTPUT_FILE_NAME,
        TO_MODE          => TEXT_IO.OUT_FILE,
        CREATION_ENABLED => TRUE);

        TEXT_IO.DELETE (THE_OUT_FILE);
    exception

        when FILE_OPS.SYSTEM_CANNOT_CREATE_FILE =>
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("INPUT ERROR:");

        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE
           ("Program cannot create [" & GANTT_OUTPUT_FILE_NAME & "]");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("due to an access problem.");
                PRESS_RETURN_TO_CONTINUE;
        raise END_RESET_EXISTING_OUTFILE;

        when FILE_OPS.FILE_ALREADY_OPEN =>
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE ("INPUT ERROR:");

        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE
           ("[" & GANTT_OUTPUT_FILE_NAME & "] is currently in use.");

        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE ("Program cannot access it");
                PRESS_RETURN_TO_CONTINUE;
        raise END_RESET_EXISTING_OUTFILE;

    end RESET_EXISTING_OUTFILE;


    begin

    if FILE_OPS.FILE_EXISTS (WITH_NAME => GANTT_OUTPUT_FILE_NAME) then
        TEXT_IO.NEW_LINE (2);

        if FILE_OPS.FILE_EXISTS (WITH_NAME => GANTT_OUTPUT_FILE_NAME) then
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT ("WARNING !!!  [" & GANTT_OUTPUT_FILE_NAME & "]");
        TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
        TEXT_IO.PUT_LINE (" will be overwritten.  ");
        GO_AHEAD := FALSE;
        end if;
    end if;

    if GO_AHEAD then
        RESET_EXISTING_OUTFILE;
    else
        if (RETURN_YN
           (PROMPT     => ASCII.LF & ASCII.CR &
                  "Do you wish to CONTINUE?  (y/n) -->  ",
            DEFAULT    => NONE,
            FROM_VALUE => Y,
            TO_VALUE   => NO,
            ERROR_TEXT => ASCII.LF & ASCII.CR & "INPUT ERROR:  " &
                  "Answer must be either Y or N." & ASCII.LF &
                  ASCII.CR) in Y .. YES) then
        RESET_EXISTING_OUTFILE;
        else
        raise STOP_FILES_EXIST;

        end if;
    end if;

    exception

    when END_RESET_EXISTING_OUTFILE =>
         raise END_OUT_GANTT;

    when STOP_FILES_EXIST =>
        raise STOP_ON_USER_REQUEST;

    end VERIFY_OUTPUT_FILE;

    ------------------------------------------------------------------
    --Begin OUT_GANTT
    ------------------------------------------------------------------
begin

    VERIFY_OUTPUT_FILE;

    if (INPUT_FILE_NAME = " ") or (HOLIDAY_FILE_NAME = " ") then
    TEXT_IO.NEW_LINE (2);
    TEXT_IO.PUT_LINE ("MISSING REQUIRED INPUT-FILE(s) !!!");
    TEXT_IO.NEW_LINE;
    TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
    TEXT_IO.PUT_LINE ("Program terminates on user request");
    TEXT_IO.NEW_LINE (2);
    raise END_VERIFY_OUTPUT;

    else
    GANTT_INITIALIZE;
    LIMIT_PRINT;
    FILL_HOLIDAY_LINE;
    INIT_ACTIVITY_LINE;
    FILL_WORKDAYS_FOOTER;
    VIRTUAL_MAP;

    while WORKDAYS_ELAPSED < PROJ_STOP_DAY loop
        --main loop, over all time periods

        ACTIVITY_COUNTER := 0;

        PRINT_HEADER;

        PRINT_MONTH_DAY_HEADER;

        for I in 1 .. NUM_ACTIVITIES loop
        --20 activities per page for current time period.
        PRINT_ACTIVITY (I);
        PRINT_FILLER;
        ACTIVITY_COUNTER := ACTIVITY_COUNTER + 1;

        if ACTIVITY_COUNTER = 20 then
            PRINT_FOOTER;
            ACTIVITY_COUNTER := 0;

            if I < NUM_ACTIVITIES then
            PRINT_HEADER;
            PRINT_MONTH_DAY_HEADER;
            end if;
        end if;

        end loop;


        --  All activities have been processed for this time period.
        --  Now check to see if the final set of activities has to be
        --  flushed out

        if ACTIVITY_COUNTER > 0 then
--flush out page
        for I in ACTIVITY_COUNTER + 1 .. 20 loop
            PRINT_FILLER;
            PRINT_FILLER; --first one corresponds to printing blank
                  -- activity.
        end loop;

        PRINT_FOOTER;
        ACTIVITY_COUNTER := 0; --defensive programming
        end if;

        --Now reset variables for the next time period.

        WORKDAYS_ELAPSED := WORKDAYS_ELAPSED + NUM_CURRENT_WORKDAYS;
        CAL_DAYS_ELAPSED := CAL_DAYS_ELAPSED + CAL_DAYS_PER_PERIOD;
        FILL_HOLIDAY_LINE;
        INIT_ACTIVITY_LINE;
        FILL_WORKDAYS_FOOTER;
        VIRTUAL_MAP;

    end loop;

    FILE_OPS.CLOSE (OUTPUT_FILE);
    FILE_OPS.CLOSE (INPUT_FILE);
    FILE_OPS.CLOSE (HOLIDAY_FILE);
    end if;

exception

    when END_VERIFY_OUTPUT | STOP_ON_USER_REQUEST =>
    null;

    when END_OUT_GANTT  =>
    TEXT_IO.NEW_LINE;
    TEXT_IO.SET_COL (TO => ERROR_INDENTATION);
    TEXT_IO.PUT_LINE ("A fatal error ocurred.  Program cannot continue.");
        PRESS_RETURN_TO_CONTINUE;

    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named [OUT_GANTT]");

end OUT_GANTT;




with SCREEN_IO;

separate (SCHEDULE.OUT_GANTT)
procedure GANTT_INITIALIZE is
-----------------------------------------------------------
-- Author:     Larry Yelowitz, T. C. Bryan
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :     May 25 1985
-- Summary:    This procedure ...
-----------------------------------------------------------

    END_TIME : FLOAT; -- to read in float total project schedule
    function IS_HOLIDAY (DAY           : JULIAN;
             PROJ_HOLIDAYS : HOLIDAYS) return BOOLEAN is
    begin
    for I in 1 .. ACTUAL_NUM_HOLIDAYS loop
        if PROJ_HOLIDAYS (I) = DAY then
        return TRUE;

        elsif PROJ_HOLIDAYS (I) > DAY then
        return FALSE;
        end if;
    end loop;

    return FALSE; --DAY is beyond all recorded holidays.
    end IS_HOLIDAY;


begin
    TEXT_IO.OPEN (FILE => INPUT_FILE,
          NAME => INPUT_FILE_NAME,
          MODE => TEXT_IO.IN_FILE);

    TEXT_IO.OPEN (FILE => HOLIDAY_FILE,
          NAME => HOLIDAY_FILE_NAME,
          MODE => TEXT_IO.IN_FILE);

    TEXT_IO.CREATE (FILE => OUTPUT_FILE,
            NAME => GANTT_OUTPUT_FILE_NAME,
            MODE => TEXT_IO.OUT_FILE);

    TEXT_IO.NEW_LINE (2);

    TEXT_IO.SET_LINE (INPUT_FILE, 23);
    INT_IO.GET (INPUT_FILE, NUM_ACTIVITIES);
    TEXT_IO.SET_LINE (INPUT_FILE, 24);
    FLT_IO.GET (INPUT_FILE, END_TIME);
    PROJ_STOP_DAY := INTEGER (END_TIME);
    PROJ_STOP_DAY := PROJ_STOP_DAY + 1;
    TEXT_IO.SET_LINE (INPUT_FILE, 25);
    TEXT_IO.SET_COL (INPUT_FILE, 2);
    INT_IO.GET (INPUT_FILE, WORKDAYS_PER_WEEK);
    TEXT_IO.SET_LINE (INPUT_FILE, 26);
    FLT_IO.GET (INPUT_FILE, PROB_HEADER);

    TEXT_IO.SET_LINE (INPUT_FILE, 27);
    INT_IO.GET (INPUT_FILE, DESIRED_CAL_START_DAY.DAY);
    INT_IO.GET (INPUT_FILE, DESIRED_CAL_START_DAY.MONTH);
    INT_IO.GET (INPUT_FILE, DESIRED_CAL_START_DAY.YEAR);

    DESIRED_START_DAY := DATE_AND_TIME.JULIAN_DATE (DESIRED_CAL_START_DAY);

    TEXT_IO.SET_LINE (INPUT_FILE, 36); --start of activities

    declare
    C : CHARACTER;
    begin
    for I in 1 .. NUM_ACTIVITIES loop
        TEXT_IO.SET_COL (INPUT_FILE, 12);
        TEXT_IO.GET (INPUT_FILE, ACTIVITIES (I).NAME);
        TEXT_IO.SET_COL (INPUT_FILE, 48);
        TEXT_IO.GET (INPUT_FILE, C);

        if C = 'C' then
        ACTIVITIES (I).CRITICAL := TRUE;
        else
        ACTIVITIES (I).CRITICAL := FALSE;
        end if;

        TEXT_IO.SET_COL (INPUT_FILE, 72);
        INT_IO.GET (INPUT_FILE, ACTIVITIES (I).START);
        TEXT_IO.SET_COL (INPUT_FILE, 80);
        INT_IO.GET (INPUT_FILE, ACTIVITIES (I).STOP);

        if I < NUM_ACTIVITIES then
        TEXT_IO.SKIP_LINE (INPUT_FILE);
        end if;
    end loop;
    end;
    --block

    --Now read the holiday file

    ACTUAL_NUM_HOLIDAYS := 0;

    while not TEXT_IO.END_OF_FILE (HOLIDAY_FILE) loop
    INT_IO.GET (HOLIDAY_FILE, HOLI.DAY, WIDTH => 2);
    TEXT_IO.SET_COL (HOLIDAY_FILE, 4);
    INT_IO.GET (HOLIDAY_FILE, HOLI.MONTH, WIDTH => 2);
    TEXT_IO.SET_COL (HOLIDAY_FILE, 7);
    INT_IO.GET (HOLIDAY_FILE, HOLI.YEAR, WIDTH => 2);
    ACTUAL_NUM_HOLIDAYS := ACTUAL_NUM_HOLIDAYS + 1;

    if ACTUAL_NUM_HOLIDAYS > MAX_NUM_HOLIDAYS then
        ACTUAL_NUM_HOLIDAYS := MAX_NUM_HOLIDAYS;
        exit;
    end if;

    JULIAN_HOLIDAYS (ACTUAL_NUM_HOLIDAYS) :=
      DATE_AND_TIME.JULIAN_DATE (HOLI);
    TEXT_IO.SKIP_LINE (HOLIDAY_FILE);
    end loop;

    --Now compute ACTUAL_START_DAY

    ACTUAL_START_DAY := DESIRED_START_DAY; --now check for weekend or holiday
    loop
--until ACTUAL_START_DAY is past all weekends and holidays
--first do SAT check
    if (ACTUAL_START_DAY rem 7) = 6 and WORKDAYS_PER_WEEK = 5 then
        ACTUAL_START_DAY := ACTUAL_START_DAY + 2; --try Monday
    elsif (ACTUAL_START_DAY rem 7) = 0 and WORKDAYS_PER_WEEK < 7 then
        --Sunday
        ACTUAL_START_DAY := ACTUAL_START_DAY + 1; --try Monday
    elsif IS_HOLIDAY (ACTUAL_START_DAY, JULIAN_HOLIDAYS) then
        ACTUAL_START_DAY := ACTUAL_START_DAY + 1; --try next day
    else
        exit; --found first available start day
    end if;
    end loop;

    --Now ACTUAL_START_DAY is determined.
    START_DAY_INDEX := ACTUAL_START_DAY rem 7;

    --Next, normalize the holidays relative to ACTUAL_START_DAY
    for I in 1 .. ACTUAL_NUM_HOLIDAYS loop
    NORMALIZED_HOLIDAYS (I) := JULIAN_HOLIDAYS (I) - ACTUAL_START_DAY;
    end loop;
    --some normalized holidays may be negative, but that's OK.



    --Put the weekend symbol '!' in appropriate places in FILLER_LINE

    WEEKENDS_PER_PERIOD := 0;
    FILLER_LINE (CAL_DAYS_PER_PERIOD) := '!'; --right margin
    if WORKDAYS_PER_WEEK = 5 then
    for I in 0 .. 12 loop
        FILLER_LINE (I * 7) := '!'; --Sunday
        FILLER_LINE (I * 7 + 6) := '!'; --Saturday
        WEEKENDS_PER_PERIOD := 26;
    end loop;

    elsif WORKDAYS_PER_WEEK = 6 then
    for I in 0 .. 12 loop
        FILLER_LINE (I * 7) := '!'; --Sundays only
        WEEKENDS_PER_PERIOD := 13;
    end loop;
    end if;

exception
    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " &
               "[OUT_GANTT.GANTT_INITIALIZE]");

end GANTT_INITIALIZE;




with MENU;
with SCREEN_IO;

separate (SCHEDULE.OUT_GANTT)
procedure LIMIT_PRINT is
-----------------------------------------------------------------------------
-- Author:     Larry Yelowitz
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :     May 5 1985
-- Summary:    This procedure allows user to limit the amount of printout
--     by specifying print start and stop dates which may be a smaller
--     interval than the project start and stop dates read from the
--     input file.
-----------------------------------------------------------------------------

    NEW_START   : DATE_AND_TIME.CALENDAR_TYPE;
    NEW_STOP    : DATE_AND_TIME.CALENDAR_TYPE;
    PRINT_START : DATE_AND_TIME.JULIAN_TYPE;
    PRINT_STOP  : DATE_AND_TIME.JULIAN_TYPE;
    USER_CHOICE : POSITIVE;

    package PRINT_LIMITER is new MENU;

    TITLE : PRINT_LIMITER.STRING_ACCESS_TYPE;

    type CHOICES is
     (HAPPY_WITH_START_STOP_DATES_IN_INPUT_FILE,
      WANT_TO_INPUT_NEW_PRINT_STARTING_DATE_ONLY,
      WANT_TO_INPUT_NEW_PRINT_STOPPING_DATE_ONLY,
      WANT_TO_INPUT_NEW_PRINT_START_STOP_DATES);

    function PRODUCE_MENU is new PRINT_LIMITER.ENUMERATION_MENU (CHOICES);


    function GET_NEW_START return DATE_AND_TIME.CALENDAR_TYPE is
    begin
    NEW_START.DAY := SCREEN_IO.RETURNED_INTEGER
                (PROMPT     => ASCII.LF & ASCII.CR &
                       "Enter print start day -->  ",
                 FROM_VALUE => 1,
                 TO_VALUE   => 31,
                 CONFIRM    => FALSE);

    NEW_START.MONTH := SCREEN_IO.RETURNED_INTEGER
                  (PROMPT     => ASCII.LF & ASCII.CR &
                         "Enter print start month -->  ",
                   FROM_VALUE => 1,
                   TO_VALUE   => 12,
                   CONFIRM    => FALSE);
    NEW_START.YEAR := SCREEN_IO.RETURNED_INTEGER
                 (PROMPT     => ASCII.LF & ASCII.CR &
                        "Enter print start year -->  ",
                  FROM_VALUE => 75,
                  TO_VALUE   => 99,
                  CONFIRM    => FALSE);
    return NEW_START;
    end GET_NEW_START;


    function GET_NEW_STOP return DATE_AND_TIME.CALENDAR_TYPE is
    begin
    NEW_STOP.DAY := SCREEN_IO.RETURNED_INTEGER
               (PROMPT     => ASCII.LF & ASCII.CR &
                      "Enter print stop day --> ",
                FROM_VALUE => 1,
                TO_VALUE   => 31,
                CONFIRM    => FALSE);

    NEW_STOP.MONTH := SCREEN_IO.RETURNED_INTEGER
                 (PROMPT     => ASCII.LF & ASCII.CR &
                        "Enter print stop month -->  ",
                  FROM_VALUE => 1,
                  TO_VALUE   => 12,
                  CONFIRM    => FALSE);
    NEW_STOP.YEAR := SCREEN_IO.RETURNED_INTEGER
                (PROMPT     => ASCII.LF & ASCII.CR &
                       "Enter print stop year -->  ",
                 FROM_VALUE => 75,
                 TO_VALUE   => 99,
                 CONFIRM    => FALSE);
    return NEW_STOP;
    end GET_NEW_STOP;

    function NUMBER_HOLIDAYS (HOLIDAY_LIST : HOLIDAYS;
                  LOW          : DATE_AND_TIME.JULIAN_TYPE;
                  HIGH         : DATE_AND_TIME.JULIAN_TYPE)
                   return INTEGER is
--return the number of holidays falling between LOW and HIGH inclusive
    COUNT : INTEGER := 0;
    begin
    for I in 1 .. ACTUAL_NUM_HOLIDAYS loop
        if HOLIDAY_LIST (I) in LOW .. HIGH then
        COUNT := COUNT + 1;
        end if;
    end loop;

    return COUNT;
    end NUMBER_HOLIDAYS;

begin
    TITLE := new STRING'
           ("Limit printout by specifying print start or stop date");
    PRINT_LIMITER.GET_MENU_VALUE (PRODUCE_MENU, TITLE, USER_CHOICE);

    case USER_CHOICE is
    when 1 =>  null;

    when 2 =>  PRINT_START := DATE_AND_TIME.JULIAN_DATE (GET_NEW_START);

    when 3 =>  PRINT_STOP := DATE_AND_TIME.JULIAN_DATE (GET_NEW_STOP);

    when 4 =>
        PRINT_START := DATE_AND_TIME.JULIAN_DATE (GET_NEW_START);
        PRINT_STOP := DATE_AND_TIME.JULIAN_DATE (GET_NEW_STOP);

    when others =>  null;
    end case;
    --have now received user's choice and inputs.  Next process it.

    if (USER_CHOICE = 2 or USER_CHOICE = 4) then
--process new printing starting date
    if PRINT_START >= ACTUAL_START_DAY then
        CAL_DAYS_ELAPSED :=
          DATE_AND_TIME.NEAREST_PRECEDING_MONDAY (PRINT_START);
        CAL_DAYS_ELAPSED :=
          CAL_DAYS_ELAPSED -
          DATE_AND_TIME.NEAREST_PRECEDING_MONDAY (ACTUAL_START_DAY);
        WORKDAYS_ELAPSED :=
          CAL_DAYS_ELAPSED -
          ((CAL_DAYS_ELAPSED / 7) * (7 - WORKDAYS_PER_WEEK));
        --Workdays_elapsed has now subtracted weekends.
        WORKDAYS_ELAPSED :=
          WORKDAYS_ELAPSED -
          NUMBER_HOLIDAYS (JULIAN_HOLIDAYS, ACTUAL_START_DAY + 1,
                   DATE_AND_TIME.NEAREST_PRECEDING_MONDAY
                  (PRINT_START) - 1);
        --Workdays_elapsed has now subtracted holidays
        WORKDAYS_ELAPSED := WORKDAYS_ELAPSED - START_DAY_INDEX;

        if WORKDAYS_PER_WEEK < 7 then
        WORKDAYS_ELAPSED := WORKDAYS_ELAPSED + 1;
        --subtracted too much in Start_Day_Index, so add 1 back
        end if;
    end if;
    end if;

    if (USER_CHOICE = 3) then
    if PRINT_STOP <
       DATE_AND_TIME.JULIAN_TYPE (PROJ_STOP_DAY + ACTUAL_START_DAY - 1) then
        PROJ_STOP_DAY := PRINT_STOP - ACTUAL_START_DAY + 1;
    end if;
    end if;

    if (USER_CHOICE = 4) then
    if PRINT_STOP >= PRINT_START then
        PROJ_STOP_DAY := PRINT_STOP - PRINT_START + 1;
    else
        PROJ_STOP_DAY := 0;
    end if;
    end if;

exception
    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " &
               "[OUT_GANTT.LIMIT_PRINT]");

end LIMIT_PRINT;





separate (SCHEDULE.OUT_GANTT)
procedure FILL_HOLIDAY_LINE is
----------------------------------------------------------------------------
-- Author:     Larry Yelowitz
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :     May 25 1985
-- Summary:    This procedure puts 'H' in HOLIDAY_LINE in positions corr.
--  to holiday in current time period.
--  In addition, determine NUM_CURRENT_WORKDAYS and NUM_CURRENT_HOLIDAYS
----------------------------------------------------------------------------

begin
    NUM_CURRENT_HOLIDAYS := 0;
    HOLIDAY_LINE := (HOLIDAY_LINE'RANGE => ' ');

    for I in 1 .. ACTUAL_NUM_HOLIDAYS loop
    if NORMALIZED_HOLIDAYS (I) in
       CAL_DAYS_ELAPSED - START_DAY_INDEX ..
       CAL_DAYS_ELAPSED + 90 - START_DAY_INDEX then
        HOLIDAY_LINE (NORMALIZED_HOLIDAYS (I) - CAL_DAYS_ELAPSED +
              START_DAY_INDEX) := 'H';

        if NORMALIZED_HOLIDAYS (I) > 0 then
        --only count holidays after proj start
        NUM_CURRENT_HOLIDAYS := NUM_CURRENT_HOLIDAYS + 1;
        end if;
    end if;

    exit when NORMALIZED_HOLIDAYS (I) >
          CAL_DAYS_ELAPSED + 90 - START_DAY_INDEX;
    end loop;

    --HOLIDAY_LINE is now filled with 'H' as appropriate.
    --Next determine NUM_CURRENT_WORKDAYS

    NUM_CURRENT_WORKDAYS := CAL_DAYS_PER_PERIOD - NUM_CURRENT_HOLIDAYS -
                WEEKENDS_PER_PERIOD;

    if CAL_DAYS_ELAPSED = 0 then
    --for first period only, maybe lose a
    --few workdays due to midweek project start

    NUM_CURRENT_WORKDAYS := NUM_CURRENT_WORKDAYS - START_DAY_INDEX;

    if WORKDAYS_PER_WEEK < 7 then
        NUM_CURRENT_WORKDAYS := NUM_CURRENT_WORKDAYS + 1;
        --first Sunday was subtracted twice;  add it back in once.
    end if;
    end if;

    return;

exception
    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " &
               "[OUT_GANTT.FILL_HOLIDAY_FILE]");

end FILL_HOLIDAY_LINE;





separate (SCHEDULE.OUT_GANTT)
procedure INIT_ACTIVITY_LINE is
-----------------------------------------------------------
-- Author:     Larry Yelowitz
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :     May 25 1985
-- Summary:    This procedure fills INITIALIZED_ACTIVITY_LINE
--             with weekend and holiday symbols.
-----------------------------------------------------------

begin
    INITIALIZED_ACTIVITY_LINE := FILLER_LINE; --copy weekend markings
    for I in OUTPUT_LINE_INDEX loop
    if HOLIDAY_LINE (I) = 'H' then
        INITIALIZED_ACTIVITY_LINE (I) := 'H'; --copy holiday markings
    end if;
    end loop;

    --Now copy '*' into unused project days during very first week.

    if WORKDAYS_ELAPSED = 0 then
    for I in 0 .. START_DAY_INDEX - 1 loop
        if INITIALIZED_ACTIVITY_LINE (I) = ' ' then
        INITIALIZED_ACTIVITY_LINE (I) := '*';
        end if;
    end loop;
    end if;

exception
    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " &
               "[OUT_GANTT.INIT_ACTIVITY_LINE]");


end INIT_ACTIVITY_LINE;





separate (SCHEDULE.OUT_GANTT)
procedure FILL_WORKDAYS_FOOTER is
-----------------------------------------------------------------------------
-- Author:     Larry Yelowitz
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :     May 25 1985
-- Summary:    This procedure computes number of project days into the
--   effort for each of the 13 weeks -- in the current time period.
--   And prints the information at the footer on each output page.
-----------------------------------------------------------------------------

    function NON_WORKDAYS (I : INTEGER) return INTEGER is
    COUNT : INTEGER := 0;
    begin
    for J in ((I - 2) * 7) .. ((I - 2) * 7 + 6) loop
--count nonworkdays in previous week
        if INITIALIZED_ACTIVITY_LINE (J) /= ' ' then
        COUNT := COUNT + 1;
        end if;
    end loop;

    return COUNT;
    end NON_WORKDAYS;


begin
    WORKDAY_FOOTER (1) := WORKDAYS_ELAPSED + 1;

    for I in 2 .. 14 loop
    WORKDAY_FOOTER (I) := WORKDAY_FOOTER (I - 1) + 7 - NON_WORKDAYS (I);
    end loop;
    --WORKDAY_FOOTER(14) now = workdays elapsed for next iteration.

exception
    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " &
               "[OUT_GANTT.FILL_WORKDAYS_FOOTER]");


end FILL_WORKDAYS_FOOTER;





separate (SCHEDULE.OUT_GANTT)
procedure VIRTUAL_MAP is
-----------------------------------------------------------------------------
-- Author:     Larry Yelowitz
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :     May 25 1985
-- Summary:    This procedure fills in the array MAP_VIRTUAL_TO_WORKDAYS.
--     The ith index of this array will contain the index value corresponding
--     to the ith available workday in INITIALIZED_ACTIVITY_LINE.
-----------------------------------------------------------------------------

    J : INTEGER := 0;
begin
    for I in 1 .. NUM_CURRENT_WORKDAYS loop
--find index of ith workday in INITIALIZED_ACTIVITY_LINE.
    while INITIALIZED_ACTIVITY_LINE (J) /= ' ' loop
        J := J + 1;
        exit when J > 91; --defensive
    end loop;

    --should do some defensive checking that j <= 91.

    MAP_VIRTUAL_TO_WORKDAYS (I) := J;
    J := J + 1;
    end loop;

exception
    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " &
               "[OUT_GANTT.VIRTUAL_MAP]");

end VIRTUAL_MAP;





separate (SCHEDULE.OUT_GANTT)
procedure PRINT_HEADER is
-----------------------------------------------------------
-- Author:     Larry Yelowitz
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :     May 25 1985
-- Summary:    This procedure prints topmost header at
--             beginning of each page of output
-----------------------------------------------------------

    LEFT_COLON  : TEXT_IO.COUNT := 31;
    LEFT        : TEXT_IO.COUNT := 35;
    CENTER      : TEXT_IO.COUNT := 60;
    RIGHT       : TEXT_IO.COUNT := 82;
    RIGHT_COLON : TEXT_IO.COUNT := 109;
    MOST_RIGHT  : TEXT_IO.COUNT := 113;

begin
    PAGE := PAGE + 1;
    TEXT_IO.NEW_LINE (OUTPUT_FILE, 2);
    TEXT_IO.SET_COL (OUTPUT_FILE, CENTER);
    TEXT_IO.PUT (OUTPUT_FILE, "GANTT CHART");
    TEXT_IO.SET_COL (OUTPUT_FILE, RIGHT);
    TEXT_IO.PUT (OUTPUT_FILE, "Page#");
    TEXT_IO.SET_COL (OUTPUT_FILE, RIGHT_COLON);
    TEXT_IO.PUT (OUTPUT_FILE, ":");
    TEXT_IO.SET_COL (OUTPUT_FILE, MOST_RIGHT);
    INT_IO.PUT (OUTPUT_FILE, PAGE, WIDTH => 3);

    TEXT_IO.NEW_LINE (OUTPUT_FILE, 2);
    TEXT_IO.PUT (OUTPUT_FILE, "Input File");
    TEXT_IO.SET_COL (OUTPUT_FILE, LEFT_COLON);
    TEXT_IO.PUT (OUTPUT_FILE, ":");
    TEXT_IO.SET_COL (OUTPUT_FILE, LEFT);
    TEXT_IO.PUT (OUTPUT_FILE, INPUT_FILE_NAME);
    TEXT_IO.SET_COL (OUTPUT_FILE, RIGHT);
    TEXT_IO.PUT (OUTPUT_FILE, "Date Today");
    TEXT_IO.SET_COL (OUTPUT_FILE, RIGHT_COLON);
    TEXT_IO.PUT (OUTPUT_FILE, ":");
    TEXT_IO.SET_COL (OUTPUT_FILE, MOST_RIGHT);
    TEXT_IO.PUT (OUTPUT_FILE, DATE_TODAY);

    TEXT_IO.NEW_LINE (OUTPUT_FILE);
    TEXT_IO.PUT (OUTPUT_FILE, "Project Start Date (dd/mm/yy)");
    TEXT_IO.SET_COL (OUTPUT_FILE, LEFT_COLON);
    TEXT_IO.PUT (OUTPUT_FILE, ":");
    TEXT_IO.SET_COL (OUTPUT_FILE, LEFT);
    INT_IO.PUT (OUTPUT_FILE, DESIRED_CAL_START_DAY.DAY, WIDTH => 3);
    INT_IO.PUT (OUTPUT_FILE, DESIRED_CAL_START_DAY.MONTH, WIDTH => 3);
    INT_IO.PUT (OUTPUT_FILE, DESIRED_CAL_START_DAY.YEAR, WIDTH => 3);
    TEXT_IO.SET_COL (OUTPUT_FILE, RIGHT);
    TEXT_IO.PUT (OUTPUT_FILE, "Probability of Completion:");
    TEXT_IO.SET_COL (OUTPUT_FILE, RIGHT_COLON);
    TEXT_IO.PUT (OUTPUT_FILE, ":");
    TEXT_IO.SET_COL (OUTPUT_FILE, MOST_RIGHT);
    FLT_IO.PUT (OUTPUT_FILE, PROB_HEADER, EXP => 0, FORE => 2, AFT => 2);

    TEXT_IO.NEW_LINE (OUTPUT_FILE);
    TEXT_IO.PUT (OUTPUT_FILE, "Project Title");
    TEXT_IO.SET_COL (OUTPUT_FILE, LEFT_COLON);
    TEXT_IO.PUT (OUTPUT_FILE, ":");
    TEXT_IO.SET_COL (OUTPUT_FILE, LEFT);
    TEXT_IO.PUT_LINE (OUTPUT_FILE, HEADER_TITLE);

    TEXT_IO.NEW_LINE (OUTPUT_FILE, 2);
    TEXT_IO.PUT (OUTPUT_FILE, "Legend");
    TEXT_IO.SET_COL (OUTPUT_FILE, LEFT_COLON);
    TEXT_IO.PUT (OUTPUT_FILE, ":");

    TEXT_IO.SET_COL (OUTPUT_FILE, LEFT);
    TEXT_IO.PUT (OUTPUT_FILE, "H     -->    holiday");
    TEXT_IO.SET_COL (OUTPUT_FILE, RIGHT);
    TEXT_IO.PUT_LINE (OUTPUT_FILE, "-     -->    non-critical activity");

    TEXT_IO.SET_COL (OUTPUT_FILE, LEFT);
    TEXT_IO.PUT (OUTPUT_FILE, "=     -->    critical activity");
    TEXT_IO.SET_COL (OUTPUT_FILE, RIGHT);
    TEXT_IO.PUT_LINE (OUTPUT_FILE, "^     -->    project start or stop");

    TEXT_IO.SET_COL (OUTPUT_FILE, LEFT);
    TEXT_IO.PUT_LINE (OUTPUT_FILE,
     "*     -->    day(s) of first week not used");
    TEXT_IO.NEW_LINE (OUTPUT_FILE, 2);

exception
    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " &
               "[OUT_GANTT.PRINT_HEADER]");

end PRINT_HEADER;





separate (SCHEDULE.OUT_GANTT)
procedure PRINT_FILLER is
-----------------------------------------------------------
-- Author:     Larry Yelowitz
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :     May 25 1985
-- Summary:    This procedure prints line between activities
--             containing only weekend and border markings.
-----------------------------------------------------------

begin
    TEXT_IO.PUT (OUTPUT_FILE, '!');
    TEXT_IO.SET_COL (OUTPUT_FILE, 34); -- Skip over 32 char name field
    for I in FILLER_LINE'RANGE loop
    TEXT_IO.PUT (OUTPUT_FILE, FILLER_LINE (I));
    end loop;

    TEXT_IO.NEW_LINE (OUTPUT_FILE);

exception
    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " &
               "[OUT_GANTT.PRINT_FILLER]");

end PRINT_FILLER;





separate (SCHEDULE.OUT_GANTT)
procedure PRINT_ACTIVITY (I : INTEGER) is
-----------------------------------------------------------
-- Author:     Larry Yelowitz
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :     May 25 1985
-- Summary:    This procedure fills in ACTIVITY_OUTPUT_LINE
--             for the current activity, then print it.
-----------------------------------------------------------

    procedure FILL_ACT_OUT_LINE (I : INTEGER) is

    begin
--check if activity start day overlaps current time period
    if ACTIVITIES (I).CRITICAL then
        SYMBOL := '=';
    else
        SYMBOL := '-';
    end if;

    TENTATIVE_START_INDEX := ACTIVITIES (I).START - WORKDAYS_ELAPSED;
    TENTATIVE_STOP_INDEX := ACTIVITIES (I).STOP - WORKDAYS_ELAPSED;

    if TENTATIVE_START_INDEX in 1 .. NUM_CURRENT_WORKDAYS then
        ACTIVITY_START_INDEX :=
          MAP_VIRTUAL_TO_WORKDAYS (TENTATIVE_START_INDEX);
        ACTIVITY_OUTPUT_LINE (ACTIVITY_START_INDEX) := '^';
        --now check if stop day also overlaps current time period.
        if TENTATIVE_STOP_INDEX in 1 .. NUM_CURRENT_WORKDAYS then
        ACTIVITY_STOP_INDEX :=
          MAP_VIRTUAL_TO_WORKDAYS (TENTATIVE_STOP_INDEX);
        ACTIVITY_OUTPUT_LINE (ACTIVITY_STOP_INDEX) := '^';

        for J in TENTATIVE_START_INDEX + 1 ..
             TENTATIVE_STOP_INDEX - 1 loop
            ACTIVITY_OUTPUT_LINE (MAP_VIRTUAL_TO_WORKDAYS (J)) :=
              SYMBOL;
        end loop;
        else
--start overlaps, but stop date extends into future time period.
        for J in TENTATIVE_START_INDEX + 1 .. NUM_CURRENT_WORKDAYS loop
            --fill in remainder of this activity with SYMBOL
            ACTIVITY_OUTPUT_LINE (MAP_VIRTUAL_TO_WORKDAYS (J)) :=
              SYMBOL;
        end loop;
        end if;

    elsif TENTATIVE_STOP_INDEX in 1 .. NUM_CURRENT_WORKDAYS then
        --start day does not overlap, but stop day does
        ACTIVITY_STOP_INDEX :=
          MAP_VIRTUAL_TO_WORKDAYS (TENTATIVE_STOP_INDEX);
        ACTIVITY_OUTPUT_LINE (ACTIVITY_STOP_INDEX) := '^';

        for J in 1 .. TENTATIVE_STOP_INDEX - 1 loop
        ACTIVITY_OUTPUT_LINE (MAP_VIRTUAL_TO_WORKDAYS (J)) := SYMBOL;
        end loop;

    elsif TENTATIVE_START_INDEX < 1 and
          TENTATIVE_STOP_INDEX > NUM_CURRENT_WORKDAYS then
--neither start nor stop day overlaps.  See if activity spans
--entire time period.

        for J in 1 .. NUM_CURRENT_WORKDAYS loop
        ACTIVITY_OUTPUT_LINE (MAP_VIRTUAL_TO_WORKDAYS (J)) := SYMBOL;

        end loop;
    end if;
    end FILL_ACT_OUT_LINE;

begin
    ACTIVITY_OUTPUT_LINE := INITIALIZED_ACTIVITY_LINE; --copy weekend/holi marks
    FILL_ACT_OUT_LINE (I);
    --Now take other actions to print out the activity name,
    --plus ACTIVITY_OUTPUT_LINE.

    TEXT_IO.PUT (OUTPUT_FILE, '!');
    TEXT_IO.PUT (OUTPUT_FILE, ACTIVITIES (I).NAME);

    for I in ACTIVITY_OUTPUT_LINE'RANGE loop
    TEXT_IO.PUT (OUTPUT_FILE, ACTIVITY_OUTPUT_LINE (I));
    end loop;

    TEXT_IO.NEW_LINE (OUTPUT_FILE);

exception
    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " &
               "[OUT_GANTT.PRINT_ACTIVITY]");

end PRINT_ACTIVITY;




separate (SCHEDULE.OUT_GANTT)
procedure PRINT_MONTH_DAY_HEADER is
-----------------------------------------------------------
-- Author:     Larry Yelowitz
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :     May 25 1985
-- Summary:    This procedure prints calendar data near the
--             top of each output page.
-----------------------------------------------------------

    CAL_DAYS_INTO_PROJECT : JULIAN;
    HEADER                : array (1 .. CAL_DAYS_PER_PERIOD / 7)
                   of DATE_AND_TIME.CALENDAR_TYPE;

    procedure SPACE (I : INTEGER) is
    begin
    for J in 1 .. I loop
        TEXT_IO.PUT (OUTPUT_FILE, ' ');
    end loop;
    end SPACE;


begin
    CAL_DAYS_INTO_PROJECT := CAL_DAYS_ELAPSED + ACTUAL_START_DAY -
                 START_DAY_INDEX + 1;
    -- julian of first monday of the time period.

    for I in HEADER'RANGE loop
    HEADER (I) := DATE_AND_TIME.CALENDAR_DATE
             (CAL_DAYS_INTO_PROJECT + JULIAN ((I - 1) * 7));
    end loop;


    TEXT_IO.PUT (OUTPUT_FILE, '+');

    for I in 1 .. 123 loop
    TEXT_IO.PUT (OUTPUT_FILE, '-');
    end loop;

    TEXT_IO.PUT_LINE (OUTPUT_FILE, "+");



    TEXT_IO.PUT (OUTPUT_FILE, '!');
    TEXT_IO.SET_COL (OUTPUT_FILE, 28);
    TEXT_IO.PUT (OUTPUT_FILE, "MONTH !");
    INT_IO.PUT (OUTPUT_FILE, HEADER (1).MONTH, WIDTH => 3);
    INT_IO.PUT (OUTPUT_FILE, HEADER (1).YEAR, WIDTH => 3);

    for I in 2 .. HEADER'LAST loop
    if HEADER (I).MONTH = HEADER (I - 1).MONTH then
        SPACE (7);
    else
        TEXT_IO.PUT (OUTPUT_FILE, '!');
        INT_IO.PUT (OUTPUT_FILE, HEADER (I).MONTH, WIDTH => 3);

        if HEADER (I).MONTH = 1 then
        INT_IO.PUT (OUTPUT_FILE, HEADER (I).YEAR, WIDTH => 3);
        else
        SPACE (3);
        end if;
    end if;
    end loop;

    TEXT_IO.PUT_LINE (OUTPUT_FILE, "!");
    --Month, year line has been printed; now print day line.

    TEXT_IO.PUT (OUTPUT_FILE, '!');
    TEXT_IO.SET_COL (OUTPUT_FILE, 29);
    TEXT_IO.PUT (OUTPUT_FILE, "DATE ");

    for I in HEADER'RANGE loop
    TEXT_IO.PUT (OUTPUT_FILE, '!');
    INT_IO.PUT (OUTPUT_FILE, HEADER (I).DAY, WIDTH => 2);
    SPACE (4);
    end loop;

    TEXT_IO.PUT_LINE (OUTPUT_FILE, "!");


    --copy text from print footer to print bottom line

    TEXT_IO.PUT (OUTPUT_FILE, '+');

    for I in 1 .. 32 loop
    TEXT_IO.PUT (OUTPUT_FILE, '-');
    end loop;

    for I in 1 .. 13 loop
    TEXT_IO.PUT (OUTPUT_FILE, "!------");
    end loop;

    TEXT_IO.PUT_LINE (OUTPUT_FILE, "+");

exception
    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " &
               "[OUT_GANTT.PRINT_MONTH_DAY_HEADER]");

end PRINT_MONTH_DAY_HEADER;





separate (SCHEDULE.OUT_GANTT)
procedure PRINT_FOOTER is
-----------------------------------------------------------
-- Author:     Larry Yelowitz
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date  :     May 25 1985
-- Summary:    This procedure prints days-into-project
--       (not counting holi and weekends) at bottom of page
-----------------------------------------------------------

begin
    TEXT_IO.PUT (OUTPUT_FILE, '+');

    for I in 1 .. 32 loop
    TEXT_IO.PUT (OUTPUT_FILE, '-');
    end loop;

    for I in 1 .. 13 loop
    TEXT_IO.PUT (OUTPUT_FILE, "!------");
    end loop;

    TEXT_IO.PUT_LINE (OUTPUT_FILE, "+");

    --Top line of footer has been printed.  Now print data.

    TEXT_IO.PUT (OUTPUT_FILE, '!');
    TEXT_IO.SET_COL (OUTPUT_FILE, 12);
    TEXT_IO.PUT (OUTPUT_FILE, "WORK DAYS INTO EFFORT");
    TEXT_IO.SET_COL (OUTPUT_FILE, 34);

    for I in 1 .. 13 loop
    TEXT_IO.PUT (OUTPUT_FILE, '!');
    INT_IO.PUT (OUTPUT_FILE, WORKDAY_FOOTER (I), WIDTH => 3);
    TEXT_IO.SET_COL (OUTPUT_FILE,
             TEXT_IO.POSITIVE_COUNT ((41 + (INTEGER (I) - 1) * 7)));
    end loop;

    TEXT_IO.PUT_LINE (OUTPUT_FILE, "!");

    --Data line has now been printed.  Next print bottom line of footer.

    TEXT_IO.PUT (OUTPUT_FILE, '+');

    for I in 1 .. 123 loop
    TEXT_IO.PUT (OUTPUT_FILE, '-');
    end loop;

    TEXT_IO.PUT_LINE (OUTPUT_FILE, "+");

    TEXT_IO.NEW_PAGE (OUTPUT_FILE);

exception
    when others =>
    FATAL (UNIT => "Schedule Tool - Unit named " &
               "[OUT_GANTT.PRINT_FOOTER]");

end PRINT_FOOTER;