|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 79956 (0x13854)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
with Data_Pkg;
use Data_Pkg;
with Text_Io;
use Text_Io;
package body Prompt_Pkg is
----------------------------------------------------------------------
--|
--| NAME: PROMPT_PKG
--|
--| OVERVIEW:
--| This package contains the user prompt messages that will be displayed
--| on the screen. The prompts will only return valid data. The user is
--| trapped until a valid entry is received. If the data being requested
--| has a default value, the user may respond with a carriage return. If,
--| the user responds with '?' ( or anything else that causes an exception),
--| then the prompt will be expanded to give the user more information on
--| the type of data to enter. For data that does not have a default value,
--| a carriage return or '?' will display the extended prompt. Otherwise,
--| the data is received from the user and processed accordingly. If the
--| data is invalid, the user will be prompted again until valid data
--| can be returned.
--|
--| EXCEPTIONS HANDLED:
--| others any illegal input from the user
--|
--| HISTORY:
--| written by May Lee March 1985
--|
--| NOTES:
--| The search key for each data type has two types of prompts :
--| one for an existing key, and one for a new key that is not
--| already in the list.
--|
--| This package also provides procedures to display the keys of each
--| data list to the screen.
----------------------------------------------------------------------
use Integer_Text_Io;
use Float_Text_Io;
-- instantiation of generic list handler is done in data_pkg
use Ac_List_Pkg; -- to get the activity completeness
use El_List_Pkg;
use Ms_List_Pkg;
use Pr_List_Pkg;
use Ss_List_Pkg;
Line_Lngth : Integer := 1;
Line : String (1 .. 132) := (others => ' ');
Tab : constant Character := Ascii.Ht;
-- to convert the enumeration type activity_phase_percent to character
-- for read and write into the file only
type Ac_Phase_Char_Type is array (1 .. 10) of Character;
Char_Ac_Completeness : Ac_Phase_Char_Type := (others => ' ');
function Project_Name return String is
begin
-- blank out the input line
Line := (others => ' ');
-- ask abbreviated question
Put (" Project Name : ");
loop
while End_Of_Line loop
Skip_Line;
New_Line;
Put_Line
(" What is the name of the project in 30 characters or less?");
New_Line;
Put (" Project Name : ");
end loop;
-- get the record field
Get_Line (Line, Line_Lngth);
New_Line (2);
exit when Line (1) /= '?';
Put_Line
(" What is the name of the project in 30 characters or less?");
New_Line;
Put (" Project Name : ");
end loop;
return Line (1 .. Data_Pkg.Project_Name'Last);
end Project_Name;
function Project_Num return Integer is
---------------------------------
-- Project Number
---------------------------------
An_Integer : Integer range 0 .. 999;
Valid_Input : Boolean := False; -- if user input was valid
begin
while not Valid_Input loop
begin
-- ask abbreviated question
Put (" Project Number : ");
while End_Of_Line loop
-- keep asking question if the user hits <cr>
Skip_Line;
New_Line;
Put_Line (" What is the 3 digit project number? ");
Put_Line (" Enter an integer in the range 0 to 999 ");
New_Line;
Put (" Project Number : ");
end loop;
Get (An_Integer);
Skip_Line;
New_Line (2);
Valid_Input := True;
exception
when others =>
Skip_Line;
New_Line;
Put_Line (" What is the 3 digit project number? ");
Put_Line (" Enter an integer in the range 0 to 999 ");
New_Line;
end;
end loop;
return An_Integer;
end Project_Num;
function Task_Numbers (Ss_Record : in Subsystem_Pointer)
return Task_Numbers_Type is
Ac_Record : Activity_Pointer;
Blanks : constant String (1 .. Sub_Name_Max_Len + 2) := (others => ' ');
End_List : Boolean := True;
Input_Line : String (1 .. 80) := (others => ' ');
Last_Char : Integer := 0;
Last : Integer := 0;
New_Task_Num : Task_Numbers_Type := (others => 0);
Num_Read : Integer := 0; -- num of new task numbers read
Tasknum_End : Integer := 1;
Tasknum_Start : Integer := 1;
begin
loop
begin
Put_Line
(" Enter the new task numbers directly below the old task numbers. ");
Put_Line
(" You may enter blanks for the task numbers that you want to leave");
Put_Line
(" the same, so that you can change one task number at a time.");
Put_Line
(" DO NOT USE TABS! [ <cr> = no change ]");
New_Line;
-- print header
Put (Blanks);
Start_Walk (Ac_List);
loop
Walk (Ac_List, Ac_Record, End_List);
exit when End_List;
Put (Ac_Record.Name (1 .. 4));
Put (" ");
end loop;
New_Line;
Put (Blanks);
for I in 1 .. Num_Of_Activities loop
Put ("---- ");
end loop;
New_Line;
-- output the task numbers
Put (Ss_Record.Name);
Put (" ");
for I in 1 .. Num_Of_Activities loop
Put (Ss_Record.Task_Numbers (I), 4);
Put (" ");
end loop;
New_Line;
Put (Ss_Record.Name);
Put (": ");
if End_Of_Line then
Skip_Line;
return Ss_Record.Task_Numbers;
else
Tasknum_Start := 1;
Get_Line (Input_Line, Last_Char);
-- parse the line
for I in 1 .. Num_Of_Activities loop
exit when Tasknum_Start > Last_Char;
Num_Read := Num_Read + 1;
Tasknum_End := Tasknum_Start + 3;
if Tasknum_End > Last_Char then
Tasknum_End := Last_Char;
end if;
if Input_Line (Tasknum_Start .. Tasknum_End) =
Blanks (1 .. Tasknum_End - Tasknum_Start + 1) then
-- default to old task number
New_Task_Num (Num_Read) :=
Ss_Record.Task_Numbers (Num_Read);
else
-- get new task number
Get (Input_Line (Tasknum_Start .. Tasknum_End),
New_Task_Num (Num_Read), Last);
end if;
-- skip task num and blank
Tasknum_Start := Tasknum_Start + 6;
end loop;
if Num_Read < Num_Of_Activities then
-- didn't change all task numbers
-- leave the rest of the task numbers unchanged
New_Task_Num (Num_Read + 1 .. Num_Of_Activities) :=
Ss_Record.Task_Numbers
(Num_Read + 1 .. Num_Of_Activities);
end if;
return New_Task_Num;
end if;
exception
when others =>
New_Line;
Put_Line
(" That was not a valid input. Enter the four digit ");
Put_Line (" task number for each activity. ");
New_Line;
end;
end loop;
end Task_Numbers;
function Task_Number_By_Ac
(Ss_Record : in Subsystem_Pointer) return Integer is
Ac_Record : Activity_Pointer;
A_Task_Num : Integer range 0 .. 9999 := 0;
Ac_Index : Integer := 0;
Blanks : constant String (1 .. Sub_Name_Max_Len + 2) := (others => ' ');
End_List : Boolean := True;
begin
Put_Line (" Enter the new task number (range 0 to 9999).");
Put_Line (" DO NOT USE TABS! [ <cr> = 0 ]");
New_Line;
loop
begin
-- print header of the last activity
Put (Blanks);
Start_Walk (Ac_List);
loop
Walk (Ac_List, Ac_Record, End_List);
exit when End_List;
Ac_Index := Ac_Index + 1;
end loop;
Put (Ac_Record.Name (1 .. 4));
Put (" ");
New_Line;
Put (Blanks);
Put ("---- ");
New_Line;
-- output the task number prompt
Put (Ss_Record.Name);
Put (": ");
if End_Of_Line then
Skip_Line;
New_Line;
return A_Task_Num;
else
Get (A_Task_Num);
Skip_Line;
New_Line;
return A_Task_Num;
end if;
exception
when others =>
Skip_Line;
New_Line;
Put_Line (" Enter the new task number (range 0 to 9999).");
Put_Line (" DO NOT USE TABS! [ <cr> = 0 ]");
New_Line;
end;
end loop;
end Task_Number_By_Ac;
function Manager_Name return String is
begin
-- blank out the input line
Line := (others => ' ');
-- ask abbreviated question
Put (" Manager Name : ");
loop
while End_Of_Line loop
-- keep asking question if the user hits <cr>
New_Line;
Skip_Line;
Put_Line
(" What is the project manager's name in 30 characters or less?");
New_Line;
Put (" Manager Name : ");
end loop;
-- get the record field
Get_Line (Line, Line_Lngth);
New_Line (2);
exit when Line (1) /= '?';
Put_Line
(" What is the project manager's name in 30 characters or less?");
New_Line;
Put (" Manager Name : ");
end loop;
return Line (1 .. Data_Pkg.Manager_Name'Last);
end Manager_Name;
function Ele_Description return String is
---------------------------------
-- Element Description
---------------------------------
begin
-- blank out the input line
Line := (others => ' ');
loop
-- ask abbreviated question
Put (" Element description : ");
while End_Of_Line loop
-- keep asking question if the user hits <cr>
Skip_Line;
New_Line;
Put_Line
(" What is the description of the element in 35 characters or less?");
New_Line;
Put (" Element description : ");
end loop;
-- get the record field
Get_Line (Line, Line_Lngth);
New_Line (2);
exit when Line (1) /= '?';
New_Line;
Put_Line
(" What is the description of the element in 35 characters or less?");
New_Line;
end loop;
return Line (1 .. 35);
end Ele_Description;
procedure Display_Element_Data is
------------------------------------------------------------------------------
--|
--| NAME: DISPLAY_ELEMENT_DATA
--|
--| OVERVIEW:
--| This procedure walks the list and prints the name of each element
--| to the screen.
--|
--| EXCEPTIONS HANDLED:
--| none
--|
--| HISTORY:
--| written by May Lee March 1985
--|
------------------------------------------------------------------------------
Tab : constant Character := Ascii.Ht;
El_Record : Element_Pointer; -- pointer to the element record
End_List : Boolean := False; -- parameter to WALK
begin
if not Empty_List (El_List) then
Put_Line (" The existing elements are : ");
New_Line;
Start_Walk (El_List);
End_List := False;
loop
Walk (El_List, El_Record, End_List);
exit when End_List;
Put (El_Record.Desc_Key);
Put (Tab);
Put (El_Record.Description);
New_Line;
end loop;
New_Line;
end if;
end Display_Element_Data;
procedure Existing_Ele_Key
(Abort_Proc : out Boolean; Key : out El_Key_Type) is
---------------------------------
-- Description Key, Abbreviation
---------------------------------
-- for modifying and deleting an element
A_Char :
Character; -- to see if the user wants to abort this function
El_Record : Element_Pointer;
Found : Boolean; -- parameter to FIND
Valid_Input : Boolean := False; -- if user input was valid
begin
Abort_Proc := False;
while not Valid_Input loop
begin
-- blank out the input line
Line := (others => ' ');
-- ask abbreviated question
Put (" Description Abbreviation : ");
while End_Of_Line loop
-- keep asking question if the user hits <cr>
Skip_Line;
New_Line;
Put_Line
(" Enter a unique description key of 6 characters or ");
Put_Line
(" less that abbreviates an existing element description. ");
New_Line;
Display_Element_Data;
New_Line;
Put (" Description Abbreviation: ");
end loop;
Get_Line (Line, Line_Lngth);
New_Line (2);
-- check if more information requested
if Line (1) = '?' then
New_Line;
Put_Line
(" Enter a unique description key of 6 characters or ");
Put_Line
(" less that abbreviates an existing element description. ");
New_Line;
Display_Element_Data;
New_Line;
else
-- checks to see if the element exists or not
Find (El_List, Line (1 .. El_Key_Max_Len),
El_Record, Found);
Valid_Input := Found;
if not Valid_Input then
-- warn user, loop again
Put_Line (" Sorry, but that element doesn't exists. ");
New_Line;
Put_Line
(" Press the return key to see the list of existing elements. ");
Put_Line (" Enter 'a' to abort this procedure ");
Put_Line (" Enter any other key to continue. ");
if End_Of_Line then
-- pressed <cr>, show list of desc_key
Skip_Line;
Display_Element_Data;
else
-- loop again on any input except <cr> or 'a'
Get (A_Char);
Skip_Line;
if A_Char = 'a' or A_Char = 'A' then
Abort_Proc := True;
Valid_Input := True;
end if;
end if;
end if;
end if;
exception
when others =>
Skip_Line;
Put_Line
(" That was not a valid abbreviation. TRY AGAIN! ");
New_Line;
Display_Element_Data;
end;
end loop; -- valid input
Key := Line (1 .. El_Key_Max_Len);
end Existing_Ele_Key;
function New_Ele_Key return El_Key_Type is
-- prompt for adding an new element
---------------------------------
-- Description Key, Abbreviation
---------------------------------
Found : Boolean; -- parameter to FIND
El_Record : Element_Pointer;
Valid_Input : Boolean := False; -- if user input was valid
begin
while not Valid_Input loop
begin
-- blank out the input line
Line := (others => ' ');
-- ask abbreviated question
Put (" Unique abbreviation : ");
while End_Of_Line loop
-- keep asking question if the user hits <cr>
Skip_Line;
Put_Line
(" Enter a unique description key of 6 characters or ");
Put_Line
(" less that abbreviates the element description. ");
New_Line;
Display_Element_Data;
New_Line;
Put (" Unique Abbreviation : ");
end loop;
Get_Line (Line, Line_Lngth);
New_Line (2);
-- check if more information requested
if Line (1) = '?' then
Put_Line
(" Enter a unique description key of 6 characters or ");
Put_Line
(" less that abbreviates the element description. ");
New_Line;
Display_Element_Data;
New_Line;
else
-- want the element to be unique
Find (El_List, Line (1 .. El_Key_Max_Len),
El_Record, Found);
Valid_Input := not Found;
if not Valid_Input then
-- warn user, loop again
Put (" Sorry, but element ");
Put (Line (1 .. Line_Lngth));
Put (" already exists. ");
New_Line;
Put_Line (" You must enter a new unique element. ");
New_Line;
Put_Line
(" Press the return key to see the list of existing elements. ");
Put_Line (" Enter any other key to continue. ");
if End_Of_Line then
-- pressed <cr>, show ss list
Skip_Line;
Display_Element_Data;
else
-- loop again on any input except <cr>
Skip_Line;
end if;
end if;
end if;
exception
when others =>
Skip_Line;
Put_Line
(" That was not a valid abbreviation. TRY AGAIN! ");
New_Line;
end;
end loop; -- valid input
return Line (1 .. El_Key_Max_Len);
end New_Ele_Key;
procedure Display_Subsystem_Data is
------------------------------------------------------------------------------
--|
--| NAME: DISPLAY_SUBSYSTEM_DATA
--|
--| OVERVIEW:
--| This procedure walks the list and prints the name of each subsystem
--| to the screen.
--|
--| EXCEPTIONS HANDLED:
--| none
--|
--| HISTORY:
--| Written by May Lee March 1985
--|
------------------------------------------------------------------------------
End_List : Boolean := False;
Ss_Record : Subsystem_Pointer;
begin
if not Empty_List (Ss_List) then
Put_Line (" The existing subsystems are : ");
New_Line;
Start_Walk (Ss_List);
End_List := False;
loop
Walk (Ss_List, Ss_Record, End_List);
exit when End_List;
Put (Ss_Record.Name);
New_Line;
end loop;
New_Line;
end if;
end Display_Subsystem_Data;
procedure Existing_Subsys_Name
(Abort_Proc : out Boolean; Key : out Ss_Name_Type) is
-- to modify or delete
---------------------------------
-- Subsystem Name
---------------------------------
A_Char :
Character; -- to see if the user wants to abort this function
Found : Boolean; -- parameter to FIND
Ss_Record : Subsystem_Pointer;
Valid_Input : Boolean := False; -- if user input was valid
begin
Abort_Proc := False;
while not Valid_Input loop
begin
-- blank out the input line
Line := (others => ' ');
-- ask abbreviated question
Put (" Subsystem Name : ");
while End_Of_Line loop
-- keep asking question if the user hits <cr>
Skip_Line;
New_Line;
Put_Line (" Enter the name of the subsystem, which is a ");
Put_Line (" string of up to 10 characters.");
New_Line;
Display_Subsystem_Data;
New_Line;
Put (" Subsystem Name : ");
end loop;
Get_Line (Line, Line_Lngth);
New_Line (2);
-- check to see if more information is requested
if Line (1) = '?' then
New_Line;
Put_Line (" Enter the name of the subsystem, which is a ");
Put_Line (" string of up to 10 characters.");
New_Line;
Display_Subsystem_Data;
New_Line;
else
-- check to see if ss is defined
Find (Ss_List, Line (1 .. Sub_Name_Max_Len),
Ss_Record, Found);
Valid_Input := Found;
if not Valid_Input then
-- warn user, loop again
Put (" Sorry, but subsystem ");
Put (Line (1 .. Line_Lngth));
Put (" does not exist. ");
New_Line;
Put_Line
(" You must enter an existing subsystem. ");
New_Line;
Put_Line
(" Press the return key to see the list of existing elements. ");
Put_Line (" Enter 'a' to abort this procedure ");
Put_Line (" Enter any other key to continue. ");
if End_Of_Line then
-- pressed <cr>, show ss list
Skip_Line;
Display_Subsystem_Data;
else
-- loop again on any input except <cr> or 'a'
Get (A_Char);
Skip_Line;
if A_Char = 'a' or A_Char = 'A' then
Abort_Proc := True;
Valid_Input := True;
end if;
end if;
end if;
end if;
exception
when others =>
Skip_Line;
Put_Line (" That was not a valid name. TRY AGAIN! ");
end;
end loop;
Key := Line (1 .. Sub_Name_Max_Len);
end Existing_Subsys_Name;
function New_Subsys_Name return Ss_Name_Type is
-- to add a new ss
---------------------------------
-- Subsystem Name
---------------------------------
Found : Boolean; -- parameter to FIND
Ss_Record : Subsystem_Pointer;
Valid_Input : Boolean := False; -- if user input was valid
begin
while not Valid_Input loop
begin
-- blank out the input line
Line := (others => ' ');
-- ask abbreviated question
Put (" Subsystem Name : ");
while End_Of_Line loop
-- keep asking question if the user hits <cr>
Skip_Line;
New_Line;
Put_Line (" Enter the name of the subsystem, which is a ");
Put_Line (" string of up to 10 characters.");
New_Line;
Display_Subsystem_Data;
New_Line;
Put (" Subsystem Name : ");
end loop;
Get_Line (Line, Line_Lngth);
New_Line (2);
-- check to see if more information is requested
if Line (1) = '?' then
New_Line;
Put_Line (" Enter the name of the subsystem, which is a ");
Put_Line (" string of up to 10 characters.");
New_Line;
Display_Subsystem_Data;
else
-- check to see if this ss is defined
Find (Ss_List, Line (1 .. Sub_Name_Max_Len),
Ss_Record, Found);
Valid_Input := not Found;
if not Valid_Input then
-- warn user, loop again
Put (" Sorry, but subsystem ");
Put (Line (1 .. Line_Lngth));
Put (" already exists. ");
New_Line;
Put_Line
(" You must enter a new unique subsystem. ");
New_Line;
Put_Line
(" Press the return key to see the list of existing subsystems. ");
Put_Line (" Enter any other key to continue. ");
if End_Of_Line then
-- pressed <cr>, show ss list
Skip_Line;
Display_Subsystem_Data;
else
-- loop again on any input except <cr>
Skip_Line;
end if;
end if;
end if;
exception
when others =>
Skip_Line;
Put_Line (" That was not a valid name. TRY AGAIN! ");
end;
end loop;
return Line (1 .. Sub_Name_Max_Len);
end New_Subsys_Name;
procedure Display_Personnel_Data is
------------------------------------------------------------------------------
--|
--| NAME: DISPLAY_PERSONNEL_DATA
--|
--| OVERVIEW:
--| This procedure walks the list and prints the name of each person
--| to the screen.
--|
--| EXCEPTIONS HANDLED:
--| none
--|
--| HISTORY:
--| Written by May Lee March 1985
--|
------------------------------------------------------------------------------
End_List : Boolean := False;
Pr_Record : Personnel_Pointer;
Tab : constant Character := Ascii.Ht;
begin
if not Empty_List (Pr_List) then
Put_Line (" The existing people are : ");
New_Line;
Start_Walk (Pr_List);
End_List := False;
loop
Walk (Pr_List, Pr_Record, End_List);
exit when End_List;
Put (Pr_Record.Initials);
Put (Tab);
Put (Pr_Record.Name);
New_Line;
end loop;
New_Line;
end if;
end Display_Personnel_Data;
procedure Existing_Person_Initials
(Abort_Proc : out Boolean; Key : out Pr_Init_Type) is
---------------------------------
-- Person's Initials
---------------------------------
A_Char :
Character; -- to see if the user wants to abort this function
Found : Boolean; -- parameter to FIND
Pr_Record : Personnel_Pointer;
Valid_Input : Boolean := False; -- if user input was valid
begin
Abort_Proc := False;
while not Valid_Input loop
begin
-- blank out the input line
Line := (others => ' ');
-- ask abbreviated question
Put (" Person's Initials : ");
while End_Of_Line loop
-- keep asking question if the user hits <cr>
Skip_Line;
New_Line;
Put_Line
(" Enter a string of up to 2 characters that represents the initials ");
Put_Line (" of the person. ");
New_Line;
Display_Personnel_Data;
New_Line;
Put (" Person's Initials : ");
end loop;
Get_Line (Line, Line_Lngth);
New_Line (2);
-- check if more information is requested
if Line (1) = '?' then
New_Line;
Put_Line
(" Enter a string of up to 2 characters that represents the initials ");
Put_Line (" of the person. ");
New_Line;
Display_Personnel_Data;
New_Line;
else
-- check to see if this person exists
Find (Pr_List, Line (1 .. Pr_Init_Max_Len),
Pr_Record, Found);
Valid_Input := Found;
if not Valid_Input then
-- warn user, loop again
Put_Line
(" Sorry, but no one with those initials exists. ");
Put_Line (" You must enter an existing person. ");
New_Line;
Put_Line
(" Press the return key to see the list of defined people and their initials. ");
Put_Line (" Enter 'a' to abort this procedure. ");
Put_Line (" Enter any other key to continue. ");
if End_Of_Line then
-- pressed <cr>, show ss list
Skip_Line;
Display_Personnel_Data;
else
-- loop again on any input except <cr> or 'a'
Get (A_Char);
Skip_Line;
if A_Char = 'a' or A_Char = 'A' then
Abort_Proc := True;
Valid_Input := True;
end if;
end if;
New_Line;
end if;
end if;
exception
when others =>
Skip_Line;
Put_Line (" That was not a valid value. TRY AGAIN! ");
end;
end loop;
Key := Line (1 .. Pr_Init_Max_Len);
end Existing_Person_Initials;
function New_Person_Initials return Pr_Init_Type is
---------------------------------
-- Person's Initials
---------------------------------
Found : Boolean; -- parameter to FIND
Pr_Record : Personnel_Pointer;
Valid_Input : Boolean := False; -- if user input was valid
begin
while not Valid_Input loop
begin
-- blank out the input line
Line := (others => ' ');
-- ask abbreviated question
Put (" Person's Initials : ");
while End_Of_Line loop
-- keep asking question if the user hits <cr>
Skip_Line;
New_Line;
Put_Line
(" Enter a string of up to 2 characters that represents the initials ");
Put_Line (" of the person. ");
New_Line;
Display_Personnel_Data;
New_Line;
Put (" Person's Initials : ");
end loop;
Get_Line (Line, Line_Lngth);
New_Line (2);
-- check if more information is requested
if Line (1) = '?' then
New_Line;
Put_Line
(" Enter a string of up to 2 characters that represents the initials ");
Put_Line (" of the person. ");
New_Line;
Display_Personnel_Data;
New_Line;
else
-- check to see if this person exists
Find (Pr_List, Line (1 .. Pr_Init_Max_Len),
Pr_Record, Found);
Valid_Input := not Found;
if not Valid_Input then
-- warn user, loop again
Put (" Sorry, but ");
Put (Pr_Record.Initials);
Put (" already exists. ");
New_Line;
Put_Line (" You must enter new unique initials. ");
New_Line;
Display_Personnel_Data;
New_Line;
end if;
end if;
exception
when others =>
Skip_Line;
Put_Line (" That was not a valid value. TRY AGAIN! ");
end;
end loop;
return Line (1 .. Pr_Init_Max_Len);
end New_Person_Initials;
procedure Display_Milestone_Data is
------------------------------------------------------------------------------
--|
--| NAME: DISPLAY_MILESTONE_DATA
--|
--| OVERVIEW:
--| This procedure walks the list and prints the number of each
--| milestone to the screen.
--|
--| EXCEPTIONS HANDLED:
--| none
--|
--| HISTORY:
--| Written by May Lee March 1985
--|
------------------------------------------------------------------------------
End_List : Boolean := False;
Ms_Record : Milestone_Pointer;
begin
if not Empty_List (Ms_List) then
Put_Line (" The existing milestones are : ");
New_Line;
Start_Walk (Ms_List);
End_List := False;
loop
Walk (Ms_List, Ms_Record, End_List);
exit when End_List;
Put (Ms_Record.Number, 2);
Put (" ");
Put (Ms_Record.Description);
New_Line;
end loop;
New_Line;
end if;
end Display_Milestone_Data;
procedure Existing_Milstone_Number
(Abort_Proc : out Boolean; Key : out Ms_Num_Type) is
---------------------------------
-- Milestone Number
---------------------------------
A_Char :
Character; -- to see if the user wants to abort this function
An_Integer : Ms_Num_Type;
Found : Boolean; -- parameter to FIND
Ms_Record : Milestone_Pointer;
Valid_Input : Boolean := False; -- if user input was valid
begin
Abort_Proc := False;
while not Valid_Input loop
begin
-- ask abbreviated question
Put (" Milestone Number : ");
while End_Of_Line loop
-- keep asking question if the user hits <cr>
Skip_Line;
New_Line;
Put_Line (" Enter an integer in the range 1..99 ");
New_Line;
Display_Milestone_Data;
New_Line;
Put (" Milestone Number : ");
end loop;
Get (An_Integer);
Skip_Line;
New_Line (2);
-- make sure milestone exists
Find (Ms_List, An_Integer, Ms_Record, Found);
Valid_Input := Found;
if not Valid_Input then
-- warn user, loop again
Put (" Sorry, but milestone ");
Put (An_Integer, 2);
Put (" does not exist. ");
New_Line;
Put_Line (" You must enter an existing milestone. ");
New_Line;
Put_Line
(" Press the return key to see the list of existing milestones. ");
Put_Line (" Enter 'a' to abort this procedure. ");
Put_Line (" Enter any other key to continue. ");
if End_Of_Line then
-- pressed <cr>, show ms list
Skip_Line;
Display_Milestone_Data;
else
-- loop again on any input except <cr> or 'a'
Get (A_Char);
Skip_Line;
if A_Char = 'a' or A_Char = 'A' then
Abort_Proc := True;
Valid_Input := True;
end if;
end if;
end if;
exception
when others =>
Skip_Line;
New_Line;
Put_Line (" Enter an integer in the range 1..99 ");
New_Line;
Display_Milestone_Data;
New_Line;
end;
end loop;
Key := An_Integer;
end Existing_Milstone_Number;
function New_Milstone_Number return Ms_Num_Type is
---------------------------------
-- Milestone Number
---------------------------------
Found : Boolean; -- parameter to FIND
An_Integer : Ms_Num_Type;
Ms_Record : Milestone_Pointer;
Valid_Input : Boolean := False; -- if user input was valid
begin
while not Valid_Input loop
begin
-- ask abbreviated question
Put (" Milestone Number : ");
while End_Of_Line loop
-- keep asking question if the user hits <cr>
Skip_Line;
New_Line;
Put_Line (" Enter an integer in the range 1..99 ");
New_Line;
Display_Milestone_Data;
New_Line;
Put (" Milestone Number : ");
end loop;
Get (An_Integer);
Skip_Line;
New_Line (2);
-- check to see if this milestone exists
Find (Ms_List, An_Integer, Ms_Record, Found);
Valid_Input := not Found;
if not Valid_Input then
-- warn user, loop again
Put (" Sorry, but milestone ");
Put (An_Integer, 2);
Put (" already exists. ");
New_Line;
Put_Line (" You must enter a new unique milestone. ");
New_Line;
Put_Line
(" Press the return key to see the list of existing milestones. ");
Put_Line (" Enter any other key to continue. ");
if End_Of_Line then
-- pressed <cr>, show ms list
Skip_Line;
Display_Milestone_Data;
else
-- loop again
Skip_Line;
end if;
end if;
exception
when others =>
Skip_Line;
New_Line;
Put_Line (" Enter an integer in the range 1..99 ");
New_Line;
Display_Milestone_Data;
New_Line;
end;
end loop;
return An_Integer;
end New_Milstone_Number;
function Element_Priority (Default : in Ms_Num_Type) return Ms_Num_Type is
An_Integer : Ms_Num_Type;
begin
loop
begin
-- ask abbreviated question
Put (" Element Priority ( <cr> = milestone number ) : ");
if End_Of_Line then
-- default
Skip_Line;
New_Line (2);
return Default;
end if;
Get (An_Integer);
Skip_Line;
New_Line (2);
return An_Integer;
exception
when others =>
Skip_Line;
New_Line;
Put_Line (" Enter an integer in the range 1..99 ");
New_Line;
end;
end loop;
end Element_Priority;
function Milestone_Completion_Number
(Default : in Ms_Num_Type) return Ms_Num_Type is
An_Integer : Ms_Num_Type;
begin
loop
begin
-- ask abbreviated question
Put
(" Milestone Completion Number ( <cr> = milestone number ) : ");
if End_Of_Line then
-- default
Skip_Line;
New_Line (2);
return Default;
end if;
Get (An_Integer);
Skip_Line;
New_Line (2);
return An_Integer;
exception
when others =>
Skip_Line;
New_Line (2);
Put_Line (" Enter an integer in the range 1..99 ");
New_Line;
end;
end loop;
end Milestone_Completion_Number;
function Current_Size_Est return Integer is
---------------------------------
-- Current Size Estimate
---------------------------------
An_Integer : Integer range 0 .. 99_999;
Valid_Input : Boolean := False; -- if user input was valid
begin
while not Valid_Input loop
begin
-- ask abbreviated question
Put (" Current Size : ");
while End_Of_Line loop
-- keep asking question if the user hits <cr>
Skip_Line;
New_Line;
Put_Line
(" What do you currently estimate the size of the element to be ? ");
Put_Line (" Enter an integer in the range 0 to 99_999 ");
New_Line;
Put (" Current Size : ");
end loop;
Get (An_Integer);
Skip_Line;
New_Line (2);
Valid_Input := True;
exception
when others =>
Skip_Line;
New_Line;
Put_Line
(" What do you currently estimate the size of the element to be ? ");
Put_Line (" Enter an integer in the range 0 to 99_999 ");
New_Line;
end;
end loop;
return An_Integer;
end Current_Size_Est;
function Orig_Size_Est (Default : in Integer := 0) return Integer is
---------------------------------
-- Original Size Estimate
---------------------------------
An_Integer : Integer range 0 .. 99_999;
begin
loop
begin
-- ask abbreviated question
Put (" Original size ( <cr> = current size) : ");
if End_Of_Line then
-- default
Skip_Line;
New_Line (2);
return Default;
end if;
Get (An_Integer);
Skip_Line;
New_Line (2);
return An_Integer;
exception
when others =>
Skip_Line;
New_Line (2);
Put_Line
(" What do you estimate the original size of the element to be ? ");
Put_Line (" Enter an integer in the range 0 to 99_999 ");
New_Line;
end;
end loop;
end Orig_Size_Est;
function Update_Current_Size (Old_Size : in Integer) return Integer is
An_Integer : Integer range 0 .. 99_999;
begin
loop
begin
-- ask abbreviated question
Set_Col (51);
Put (" [ <cr> = no change ]");
New_Line;
Put (" Old current size = ");
Put (Old_Size, 1);
New_Line;
Put (" New current size : ");
if End_Of_Line then
-- don't change the value
Skip_Line;
New_Line (2);
return Old_Size;
else
Get (An_Integer);
Skip_Line;
New_Line (2);
return An_Integer;
end if;
exception
when others =>
Skip_Line;
Put_Line (" Try something in the range 0 to 99_999. ");
New_Line;
end;
end loop;
end Update_Current_Size;
function Complexity_Factor return Float is
---------------------------------
-- Complexity
---------------------------------
A_Float : Float range 0.01 .. 5.0 := 0.01;
begin
loop
begin
-- ask abbreviated question
Put (" Complexity [ <cr> = 1.0 ] : ");
if End_Of_Line then
-- default
Skip_Line;
A_Float := 1.0;
New_Line (2);
return A_Float;
end if;
Get (A_Float);
Skip_Line;
New_Line (2);
return A_Float;
exception
when others =>
Skip_Line;
New_Line;
Put_Line
(" Enter a real number in the range 0.01 to 5.00 ");
New_Line;
end;
end loop;
end Complexity_Factor;
function Activ_Completeness return Activity_Phase_Percent is
---------------------------------
-- Activity Completeness
---------------------------------
A_Char : Character := ' ';
Ac_Record : Activity_Pointer;
Count : Integer := 1;
End_List : Boolean := False; -- parameter to WALK
Ac_Comp_Array : Activity_Phase_Percent := (others => ' ');
-- array of activity percents
Valid_Input : Boolean := False; -- if user input was valid
begin
begin
-- ask abbreviated question, assuming the format is known.
-- any fields not entered default to ' ' or 0
Put (" Activity Completeness : ");
-- describe the input line in detail
if End_Of_Line then
-- default
Skip_Line;
Ac_Comp_Array := (others => ' ');
return Ac_Comp_Array;
end if;
-- parse the input
Count := 1;
while not End_Of_Line and Count <= Num_Of_Activities loop
Get (A_Char);
Ac_Comp_Array (Count) := Convert (A_Char);
Count := Count + 1;
end loop;
Skip_Line;
New_Line (2);
return Ac_Comp_Array;
exception
-- ask expanded question
when others =>
Ac_Comp_Array := (others => ' ');
Skip_Line;
New_Line (2);
Put_Line
(" For each activity, enter one character (0 through 9 or ' ', or 'd') ");
Put_Line
(" indicating that activity's completeness. Put all the data on");
Put_Line (" one input line. ");
New_Line;
Put_Line (" For Example: ");
Put_Line
(" If you have 5 activities: HLD, DD, CD, UT, and I, ");
Put_Line (" and you enter ");
New_Line;
Put_Line (" Activity Completeness : d86 1 ");
New_Line;
Put_Line
(" HLD is 100% done. DD is 80% done. CD is 60% done. ");
Put_Line
(" UT is 0% done. I is 10% done. ");
New_Line;
Put_Line
(" Enter '?' if you would still like more help on how to ");
Put_Line
(" enter this data. Otherwise, enter the data as described. ");
New_Line;
Put (" Activity Completeness : ");
end;
-- prompt with the expanded question
begin
if End_Of_Line then
-- default
Skip_Line;
Ac_Comp_Array := (others => ' ');
return Ac_Comp_Array;
end if;
Count := 1;
while not End_Of_Line and Count <= Num_Of_Activities loop
Get (A_Char);
Ac_Comp_Array (Count) := Convert (A_Char);
Count := Count + 1;
end loop;
Skip_Line;
New_Line (2);
return Ac_Comp_Array;
exception
when others =>
-- prompt for each activity separately rather than on one line of input
Ac_Comp_Array := (others => ' ');
Skip_Line;
New_Line (2);
Put_Line
("You will be prompted for the completeness of each activity. ");
New_Line;
end;
-- prompt for the individual activities
Start_Walk (Ac_List);
for I in 1 .. Num_Of_Activities loop
Valid_Input := False;
Walk (Ac_List, Ac_Record, End_List);
while not End_List and not Valid_Input loop
begin
Put (" How complete is activity ");
Put (Ac_Record.Name);
Put (" : ");
if End_Of_Line then
Skip_Line;
Valid_Input := False;
else
Get (A_Char);
Ac_Comp_Array (I) := Convert (A_Char);
Skip_Line;
Valid_Input := True;
end if;
New_Line (2);
exception
when others =>
Skip_Line;
Ac_Comp_Array (I) := ' ';
New_Line (2);
Put_Line (" That was not a valid value. TRY AGAIN! ");
Put_Line
(" Enter a number from 0 to 9, or ' ', or 'd' to indicate the percent complete. ");
Put_Line
(" 'd' or 'D' means it is 100% complete or Done. ");
Put_Line
(" ' ' or '0' means it is 0% complete. ");
Put_Line
(" '1' means it is 10% complete. ");
Put_Line
(" '2' means it is 20% complete. etc. ");
New_Line;
Valid_Input := False;
end;
end loop;
end loop;
return Ac_Comp_Array;
end Activ_Completeness;
function Update_Activ_Completeness
(Old_Pct_Complete : in Activity_Phase_Percent)
return Activity_Phase_Percent is
A_Char : Character := ' ';
Count : Integer := 1;
Ac_Comp_Array : Activity_Phase_Percent := (others => ' ');
-- array of activity percents
begin
loop
begin
-- ask abbreviated question
Set_Col (50);
Put (" [ <cr> = no change ]");
New_Line;
Put (" Old percent complete = ");
for I in 1 .. Num_Of_Activities loop
Put (Convert (Old_Pct_Complete (I)));
end loop;
New_Line;
Put (" New percent complete : ");
if End_Of_Line then
-- don't change the value
Skip_Line;
New_Line (2);
return Old_Pct_Complete;
else
while not End_Of_Line and Count <= Num_Of_Activities loop
Get (A_Char);
Ac_Comp_Array (Count) := Convert (A_Char);
Count := Count + 1;
end loop;
Skip_Line;
New_Line (2);
return Ac_Comp_Array;
end if;
exception
when others =>
Skip_Line;
Ac_Comp_Array := (others => ' ');
Put_Line (" That was not a valid value. ");
Put_Line (" Enter a number from 0 to 9, or ' ', or 'd' ");
Put_Line
(" to indicate the percent complete for each activity. ");
New_Line;
end;
end loop;
end Update_Activ_Completeness;
----------------------------------------------------------------------------
-- ACTIVITY DATA PROMPTS --
----------------------------------------------------------------------------
procedure Display_Activity_Data is
------------------------------------------------------------------------------
--|
--| NAME: DISPLAY_ACTIVITY_DATA
--|
--| OVERVIEW:
--| This procedure walks the list and prints the name of each activity
--| to the screen.
--|
--| EXCEPTIONS HANDLED:
--| none
--|
--| HISTORY:
--| Written by May Lee March 1985
--|
------------------------------------------------------------------------------
End_List : Boolean := False;
Ac_Record : Activity_Pointer;
begin
if not Empty_List (Ac_List) then
Put_Line (" The existing activities are : ");
New_Line;
Start_Walk (Ac_List);
End_List := False;
loop
Walk (Ac_List, Ac_Record, End_List);
exit when End_List;
Put (Ac_Record.Name);
New_Line;
end loop;
New_Line;
end if;
end Display_Activity_Data;
procedure Existing_Activ_Name
(Abort_Proc : out Boolean; Key : out Ac_Name_Type) is
-- want to modify or delete and existing activity
---------------------------------
-- Activity Name
---------------------------------
A_Char :
Character; -- to see if the user wants to abort this function
Ac_Record : Activity_Pointer;
Found : Boolean; -- parameter to FIND
Valid_Input : Boolean := False; -- if user input was valid
begin
Abort_Proc := False;
while not Valid_Input loop
begin
-- blank out the input line
Line := (others => ' ');
-- ask abbreviated question
Put (" Activity Name : ");
while End_Of_Line loop
-- keep asking question if the user hits <cr>
Skip_Line;
New_Line;
Put_Line (" Enter the name of the activity which is a ");
Put_Line (" string of up to 10 characters.");
New_Line;
Display_Activity_Data;
New_Line;
Put (" Activity Name : ");
end loop;
Get_Line (Line, Line_Lngth);
New_Line (2);
if Line (1) = '?' then
New_Line;
Put_Line (" Enter the name of the activity which is a ");
Put_Line (" string of up to 10 characters.");
New_Line;
Display_Activity_Data;
New_Line;
else
-- check to see if this activity exists
Find (Ac_List, Line (1 .. Act_Name_Max_Len),
Ac_Record, Found);
Valid_Input := Found;
if not Valid_Input then
-- warn user, loop again
Put (" Sorry, but activity ");
Put (Line (1 .. Line_Lngth));
Put (" does not exist. ");
New_Line;
Put_Line (" You must enter an existing activity. ");
New_Line;
Put_Line
(" Press the return key to see the list of existing activities. ");
Put_Line (" Enter 'a' to abort this procedure ");
Put_Line (" Enter any other key to continue. ");
if End_Of_Line then
-- pressed <cr>, show ac list
Skip_Line;
Display_Activity_Data;
else
-- loop again on any input except <cr> or 'a'
Get (A_Char);
Skip_Line;
if A_Char = 'a' or A_Char = 'A' then
Abort_Proc := True;
Valid_Input := True;
end if;
end if;
end if;
end if;
exception
when others =>
Skip_Line;
New_Line;
Put_Line (" Enter the name of the activity which is a ");
Put_Line (" string of up to 10 characters.");
New_Line;
Display_Activity_Data;
New_Line;
end;
end loop;
Key := Line (1 .. Act_Name_Max_Len);
end Existing_Activ_Name;
function New_Activ_Name return Ac_Name_Type is
---------------------------------
-- Activity Name
---------------------------------
Found : Boolean; -- parameter to FIND
Ac_Record : Activity_Pointer;
Valid_Input : Boolean := False; -- if user input was valid
begin
while not Valid_Input loop
begin
-- blank out the input line
Line := (others => ' ');
-- ask abbreviated question
Put (" Activity Name : ");
while End_Of_Line loop
-- keep asking question if the user hits <cr>
Skip_Line;
New_Line;
Put_Line (" Enter the name of the activity which is a ");
Put_Line (" string of up to 10 characters.");
New_Line;
Display_Activity_Data;
New_Line;
Put (" Activity Name : ");
end loop;
Get_Line (Line, Line_Lngth);
New_Line (2);
if Line (1) = '?' then
New_Line;
Put_Line (" Enter the name of the activity which is a ");
Put_Line (" string of up to 10 characters.");
New_Line;
Display_Activity_Data;
New_Line;
else
-- check to see if this ac is defined
Find (Ac_List, Line (1 .. Act_Name_Max_Len),
Ac_Record, Found);
Valid_Input := not Found;
if not Valid_Input then
-- warn user, loop again
Put (" Sorry, but activity ");
Put (Line (1 .. Line_Lngth));
Put (" already exists. ");
New_Line;
Put_Line (" You must enter a new unique activity. ");
New_Line;
Put_Line
(" Press the return key to see the list of existing activities. ");
Put_Line (" Enter any other key to continue. ");
if End_Of_Line then
-- pressed <cr>, show aclist
Skip_Line;
Display_Activity_Data;
else
-- loop again on any input except <cr>
Skip_Line;
end if;
end if;
end if;
exception
when others =>
Skip_Line;
New_Line;
Put_Line (" Enter the name of the activity which is a ");
Put_Line (" string of up to 10 characters.");
New_Line;
end;
end loop;
return Line (1 .. Act_Name_Max_Len);
end New_Activ_Name;
function Activ_Priority return Integer is
---------------------------------
-- Activity Priority
---------------------------------
An_Integer : Integer range 1 .. 10;
begin
loop
begin
-- ask abbreviated question
Put (" Priority : ");
while End_Of_Line loop
-- keep asking question if the user hits <cr>
Skip_Line;
New_Line;
Put_Line
(" Enter the priority of the activity on a scale of 1 to 10. ");
New_Line;
Put (" Priority : ");
end loop;
Get (An_Integer);
Skip_Line;
New_Line (2);
exit;
exception
when others =>
Skip_Line;
New_Line;
Put_Line
(" Enter the priority of the activity on a scale of 1 to 10. ");
New_Line;
end;
end loop;
return An_Integer;
end Activ_Priority;
function Consider_Ac_In_Calc return Boolean is
---------------------------------
-- Consider this activity in the Tracker calculations
---------------------------------
A_Char : Character := 'y';
begin
loop
begin
-- ask abbreviated question
Put (" Consider [ y or n <cr>=y ] : ");
if End_Of_Line then
-- keep asking question if the user hits <cr>
Skip_Line;
New_Line (2);
return True;
end if;
Get (A_Char);
Skip_Line;
New_Line (2);
if A_Char = 'Y' or A_Char = 'y' then
return True;
elsif A_Char = 'N' or A_Char = 'n' then
return False;
end if;
Put (" Do you want to consider this activity in the ");
Put_Line ("Tracker calculations? ");
New_Line;
exception
when others =>
Skip_Line;
New_Line (2);
Put (" Do you want to consider this activity in the ");
Put_Line ("Tracker calculations? ");
New_Line;
end;
end loop;
end Consider_Ac_In_Calc;
----------------------------------------------------------------------------
-- MILESTONE DATA
----------------------------------------------------------------------------
function Ms_Description return String is
---------------------------------
-- Milestone Description
---------------------------------
begin
loop
-- blank out the input line
Line := (others => ' ');
-- ask abbreviated question
Put_Line (" Milestone description : ");
New_Line;
while End_Of_Line loop
-- keep asking question if the user hits <cr>
Skip_Line;
Put_Line
(" Enter the description of the milestone in 50 characters or less : ");
New_Line;
end loop;
-- get the record field
Get_Line (Line, Line_Lngth);
New_Line (2);
if Line (1) = '?' then
Put_Line
(" Enter the description of the milestone in 50 characters or less : ");
New_Line;
else
return Line (1 .. 50);
end if;
end loop;
end Ms_Description;
----------------------------------------------------------------------------
-- PERSONNEL DATA PROMPTS
----------------------------------------------------------------------------
function Persons_Name return String is
---------------------------------
-- Person's Name
---------------------------------
begin
loop
-- blank out the input line
Line := (others => ' ');
-- ask abbreviated question
Put (" Person's Name : ");
while End_Of_Line loop
-- keep asking question if the user hits <cr>
Skip_Line;
New_Line;
Put_Line
(" Enter the name of the person in 20 characters or less. ");
Put_Line (" Anything longer will be truncated. ");
New_Line;
Put (" Person's Name : ");
end loop;
-- get the record field
Get_Line (Line, Line_Lngth);
New_Line (2);
if Line (1) = '?' then
New_Line;
Put_Line
(" Enter the name of the person in 20 characters or less. ");
Put_Line (" Anything longer will be truncated. ");
New_Line;
else
return Line (1 .. 20);
end if;
end loop;
end Persons_Name;
function Pr_Production_Rate return Float is
---------------------------------
-- Person's production rate
---------------------------------
A_Float : Float range 0.01 .. 99.99 := 1.00;
begin
loop
begin
-- ask abbreviated question
Put (" Production Rate ( <cr> = 1.0) : ");
if End_Of_Line then
-- default
Skip_Line;
New_Line (2);
return 1.0;
end if;
Get (A_Float);
Skip_Line;
New_Line (2);
return A_Float;
exception
-- default value
when others =>
Skip_Line;
New_Line (2);
Put_Line
(" How many units of work can this person complete per hour ? ");
Put_Line (" Enter a float in the range 0.01..99.99 ");
New_Line;
end;
end loop;
end Pr_Production_Rate;
function Pr_Hrs_Per_Week return Integer is
---------------------------------
-- Hours per week the person works
---------------------------------
An_Integer : Integer range 1 .. 84 := 40;
begin
loop
begin
-- ask abbreviated question
Put (" Hours Per Week ( <cr> = 40) : ");
if End_Of_Line then
-- default
Skip_Line;
New_Line (2);
return 40;
end if;
Get (An_Integer);
Skip_Line;
New_Line (2);
return An_Integer;
exception
-- default value
when others =>
Skip_Line;
New_Line;
Put_Line
(" How many hours per week (1..84) does this person work ? ");
Put_Line
(" The default is 40 hours. Press <cr> for the default. ");
New_Line;
end;
end loop;
end Pr_Hrs_Per_Week;
function Percent return Float is
---------------------------------
-- Percent value
---------------------------------
A_Float : Float range 0.0 .. 100.0 := 0.0;
begin
loop
begin
-- ask abbreviated question
Put (" Percent ( <cr> = 0.0) : ");
if End_Of_Line then
-- default
Skip_Line;
A_Float := 0.0;
New_Line (2);
else
Get (A_Float);
Skip_Line;
New_Line (2);
end if;
exit;
exception
-- keep prompting the user until he enters a valid number
when others =>
Skip_Line;
New_Line;
Put_Line (" Enter a number in the range 0.0 .. 100.0 ");
New_Line;
end;
end loop;
return A_Float;
end Percent;
function Date return Date_Type is
-----------------------------------
-- DATE
-----------------------------------
-- This function prompts for and returns a valid date (month, day and year).
Day_Integer : Integer := 0; -- user input date on one line
Default : Boolean := False; -- if the user chooses the default date
Dummy_Char : Character; -- character to separate date '/'
Month_Integer : Integer := 0; -- user input date on one line
User_Input : Boolean := False; -- if the user entered date on one line
Valid_Date : Date_Type; -- the date returned
Valid_Day : Day_Number; -- day from detailed item prompt
Valid_Input : Boolean := False; -- if input is within type range
Valid_Month : Month_Number; -- month from detailed item prompt
Valid_Year : Year_Number; -- year from detailed item prompt
Year_Integer : Integer := 0; -- user input date on one line
function Month return Month_Number is
---------------------------------
-- Month for type date_type
---------------------------------
begin
Valid_Input := False;
while not Valid_Input loop
begin
-- ask abbreviated question
Put (" Month (1..12) : ");
while End_Of_Line loop
-- keep asking question if the user hits <cr>
Skip_Line;
Put (" Enter the month (1..12) : ");
end loop;
Get (Valid_Month);
Skip_Line;
New_Line (2);
Valid_Input := True;
exception
when others =>
Skip_Line;
Put_Line (" What is the number of the month?");
New_Line;
Valid_Input := False;
end;
end loop;
return Valid_Month;
end Month;
function Day return Day_Number is
---------------------------------
-- Day in date_type
---------------------------------
begin
Valid_Input := False;
while not Valid_Input loop
begin
-- ask abbreviated question
Put (" Day (1..31) : ");
while End_Of_Line loop
-- keep asking question if the user hits <cr>
Skip_Line;
New_Line;
Put (" Enter the day of the month (1..31) : ");
end loop;
Get (Valid_Day);
Skip_Line;
New_Line (2);
Valid_Input := True;
exception
when others =>
Skip_Line;
New_Line;
Put_Line (" What is the day of the month? ");
New_Line;
Valid_Input := False;
end;
end loop;
return Valid_Day;
end Day;
function Year return Year_Number is
---------------------------------
-- Year in date_type
---------------------------------
begin
Valid_Input := False;
while not Valid_Input loop
begin
-- ask abbreviated question
Put (" Year (1901..2099) : ");
while End_Of_Line loop
-- keep asking question if the user hits <cr>
Skip_Line;
New_Line;
Put (" Enter is the year (1901..2099) : ");
end loop;
Get (Valid_Year);
Skip_Line;
New_Line (2);
Valid_Input := True;
exception
when others =>
Skip_Line;
Valid_Input := False;
New_Line;
Put_Line (" What is the year ? ");
New_Line;
end;
end loop;
return Valid_Year;
end Year;
begin
loop
Put (" e.g. 12/6/1985 ( <cr> = null date) : ");
if End_Of_Line then
Skip_Line;
New_Line (2);
return Null_Date;
else
begin
-- get the date
Get (Month_Integer);
if not End_Of_Line then
Get (Dummy_Char); -- the slash between numbers
end if;
if not End_Of_Line then
Get (Day_Integer);
end if;
if not End_Of_Line then
Get (Dummy_Char); -- the slash between numbers
end if;
if not End_Of_Line then
Get (Year_Integer);
end if;
Skip_Line;
New_Line (2);
if not Valid (Month_Integer, Day_Integer, Year_Integer) then
Put_Line (" That was not a valid date! ");
loop
Valid_Month := Month;
Valid_Day := Day;
Valid_Year := Year;
if Valid (Valid_Month, Valid_Day, Valid_Year) then
return (Valid_Month, Valid_Day, Valid_Year);
end if;
Put_Line (" That was not a valid date! ");
end loop;
end if;
return (Month_Integer, Day_Integer, Year_Integer);
exception
when others =>
-- user wants more information
Skip_Line;
Put_Line
(" Enter month/day/year where the month is 1..12, the day ");
Put_Line (" is 1..31, and the year is 1901..2099 ");
New_Line;
end;
end if;
end loop;
end Date;
end Prompt_Pkg;