--::::::::::
--form2.pro
--::::::::::
-------- SIMTEL20 Ada Software Repository Prologue ------------
-- -*
-- Unit name : User Interface Forms Generator
-- Version : 1.0
-- Author : John Foreman
-- : Texas Instruments, Inc.
-- : P.O. Box 801 MS 8007
-- : McKinney, TX 75069
-- Contact : Lt. Colonel Falgiano
-- : ESD/SCW
-- : Hanscom AFB, MA 01731
-- DDN Address :
-- Copyright : (c) 1985 Texas Instruments, Inc.
-- Date created : 10 November 1984
-- Release date : 1 March 1985
-- Last update : 1 March 1985
-- Machine/System Compiled/Run on :
-- -*
---------------------------------------------------------------
-- -*
-- Keywords :
----------------:
--
-- Abstract : This tool is used to seperate an application's
----------------: procedural code from the code required to
----------------: drive a terminal. The system will provide both
----------------: an interactive and batch interface that enables
----------------: an application programmer to design a screen
----------------: format and save the representation in a machine
----------------: readable form. The Form Executor package will
----------------: provide procedural and functional interfaces
----------------: that enable a program to access the output of
----------------: the system and present it to a terminal. This
----------------: toolset will support asynchronous ASCII
----------------: terminals with single character transmission
----------------: capabilities.
----------------:
----------------: This tool was developed as a precursor for
----------------: the WMCCS Information System (WIS). An
----------------: executable version of the tool has been
----------------: demonstrated. This source code has sub-
----------------: sequently been recompiled but has not under-
----------------: gone extensive testing.
----------------:
-- -*
------------------ Revision history ---------------------------
-- -*
-- DATE VERSION AUTHOR HISTORY
-- 03/85 1.0 John Foreman Initial Release
-- -*
------------------ Distribution and Copyright -----------------
-- -*
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
-- software released to the Public Domain is not subject
-- to copyright protection).
-- Restrictions on use or distribution: NONE
-- -*
----------------- Disclaimer ----------------------------------
-- -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
--
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered. The user is advised to
-- test the software thoroughly before relying on it. The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
-- -*
----------------- END-PROLOGUE -------------------------------
--::::::::::
--form2.cmm
--::::::::::
Comments on Porting
Formgen
by TI
to DEC Ada
Tool 8_3
Tool 8_5
June 1, 1985
COMPILATION
-----------
The Screen Generator and Forms Generator were delivered as one tool
called Formgen.
A VMS command file was created from the ordered list of compilation
units provided in FORMGEN_CMP.DIS.
FORMGEN is dependent on the packages in VIRTERM, another tool developed
by TI. We were able to compile FORMGEN after making the packages in
VIRTERM visible and afer deleting references to the Data General
supplied package CURRENT_EXCEPTION. References to the pragma MAIN
were also eliminated.
EXECUTION
---------
The interactive form generator INTERACT was linked. Upon execution
however, the program looped infinitely. This looping is most probably
due to the fact that host dependencies in the SYSDEP_BODY.ADA file in
VIRTERM were not rewritten.
COMMENT
-------
The relationship between FORMGEN and VIRTERM should be clarified. It
should be stated which subset of VIRTERM (if it is a subset) is needed.
Consideration should be given to including VIRTERM source as part of
FORMGEN.
--::::::::::
--form2.ada
--::::::::::
-------- SIMTEL20 Ada Software Repository Prologue ------------
-- -*
-- Unit name : User Interface Forms Generator
-- Version : 1.0
-- Contact : Lt. Colonel Falgiano
-- : ESD/SCW
-- : Hanscom AFB, MA 01731
-- Author : John Foreman
-- : Texas Instruments, Inc.
-- : P.O. Box 801 MS 8007
-- : McKinney, TX 75069
-- DDN Address :
-- Copyright : (c) 1985 Texas Instruments, Inc.
-- Date created : 10 November 1984
-- Release date : 1 March 1985
-- Last update :
-- -*
---------------------------------------------------------------
-- -*
-- Keywords :
----------------:
--
-- Abstract : This tool is used to seperate an application's
----------------: procedural code from the code required to
----------------: drive a terminal. The system will provide both
----------------: an interactive and batch interface that enables
----------------: an application programmer to design a screen
----------------: format and save the representation in a machine
----------------: readable form. The Form Executor package will
----------------: provide procedural and functional interfaces
----------------: that enable a program to access the output of
----------------: the system and present it to a terminal. This
----------------: toolset will support asynchronous ASCII
----------------: terminals with single character transmission
----------------: capabilities.
----------------:
----------------: This tool was developed as a precursor for
----------------: the WMCCS Information System (WIS). An
----------------: executable version of the tool has been
----------------: demonstrated. This source code has sub-
----------------: sequently been recompiled but has not under-
----------------: gone extensive testing.
----------------:
-- -*
------------------ Revision history ---------------------------
-- -*
-- DATE VERSION AUTHOR HISTORY
-- 03/85 1.0 John Foreman Initial Release
-- -*
------------------ Distribution and Copyright -----------------
-- -*
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
-- software released to the Public Domain is not subject
-- to copyright protection).
-- Restrictions on use or distribution: NONE
-- -*
----------------- Disclaimer ----------------------------------
-- -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
--
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered. The user is advised to
-- test the software thoroughly before relying on it. The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
-- -*
----------------- END-PROLOGUE -------------------------------
::::::::::
--fgs_cmp.dis
::::::::::
--
-- Compilation order for Form Generator System
--
-- Support packages
FORM_TYPES.ADA
MANAGER_SPEC.ADA
MANAGER_BODY.ADA
TERMINAL_SPEC.ADA
TERMINAL_BODY.ADA
EXECUTOR_SPEC.ADA
EXECUTOR_BODY.ADA
-- Batch Generator
BATCH_SPEC.ADA
BATCH_BODY.ADA
BATCH_GEN.ADA
-- Link Batch_Gen
-- Interactive Generator
FORMS.ADA
EDITOR_SPEC.ADA
EDITOR_BODY.ADA
COMMANDS.ADA
INTERACT.ADA
SUBMENUS.ADA
-- Link Interact
::::::::::
fgs_src.dis
::::::::::
--
-- Source for Form Generator System
--
-- Batch_Generator_Support spec & body -
BATCH_SPEC.ADA
BATCH_BODY.ADA
-- Batch_Gen - Batch Gen. main procedure
BATCH_GEN.ADA
-- Subcommands of form Editor
COMMANDS.ADA
-- Editor spec & body - Interactive Gen. for Editor
EDITOR_BODY.ADA
EDITOR_SPEC.ADA
-- Form_Executor spec & body
EXECUTOR_BODY.ADA
EXECUTOR_SPEC.ADA
-- Forms spec & body - defines Interactive Gen. menus and forms
FORMS.ADA
-- Form_Types spec - defines global types
FORM_TYPES.ADA
-- Interact - Interactive Gen. main procedure
INTERACT.ADA
-- Form_Manager spec & body
MANAGER_BODY.ADA
MANAGER_SPEC.ADA
-- Submenus for Interactive Gen.
SUBMENUS.ADA
-- Terminal_Interface spec & body
TERMINAL_BODY.ADA
TERMINAL_SPEC.ADA
::::::::::
BATCH_SPEC.ADA
::::::::::
--------------------------------------------------------------------------
-- Abstract : This package is a support package for the Batch Generator
-- program. It defines routines to scan and syntax check
-- the input form definition file.
--------------------------------------------------------------------------
package BATCH_GENERATOR_SUPPORT is
type KEYWORD is
(FIELD,
FORM,
TEXT, -- statement keywords
CLEAR_SCREEN,
DEFAULT,
LENGTH, -- parameter keywords
LIMITATION,
MODE,
NAME,
POSITION,
RENDITION,
SIZE,
VALUE,
YES,
NO, -- clear options
NONE,
PRIMARY,
SECONDARY, -- rendition options
ALPHABETIC,
ALPHANUMERIC,
NUMERIC,
NOT_LIMITED, -- character limits
INPUT_OUTPUT,
OUTPUT_ONLY); -- input/output options
type TOKEN is
(IDENTIFIER, NUMBER, TEXT_STRING,
LEFT_PARENTHESIS, RIGHT_PARENTHESIS, ARROW,
COMMA, SEMICOLON, COMMENT);
CURRENT_IDENTIFIER : STRING (1 .. 80);
CURRENT_NUMBER : NATURAL;
IDENTIFIER_LENGTH : NATURAL;
KEYWORD_LENGTH : constant NATURAL := 12;
KEYWORD_TABLE : constant array (KEYWORD)
of STRING (1 .. KEYWORD_LENGTH) :=
("FIELD ", "FORM ", "TEXT ",
"CLEAR_SCREEN", "DEFAULT ", "LENGTH ",
"LIMITATION ", "MODE ", "NAME ",
"POSITION ", "RENDITION ", "SIZE ",
"VALUE ", "YES ", "NO ",
"NONE ", "PRIMARY ", "REVERSE ",
"ALPHABETIC ", "ALPHANUMERIC", "NUMERIC ",
"NOT_LIMITED ", "INPUT_OUTPUT", "OUTPUT_ONLY ");
UNKNOWN_KEYWORD : exception;
UNKNOWN_TOKEN : exception;
INVALID_IDENTIFIER : exception;
INVALID_NUMBER : exception;
INVALID_STRING : exception;
INVALID_PARAMETER : exception;
INVALID_PARAMETER_VALUE : exception;
UNEXPECTED_TOKEN : exception;
FILE_INIT_ERROR : exception;
END_OF_INPUT_FILE : exception;
ADD_FIELD_ERROR : exception;
CREATE_FORM_ERROR : exception;
--
-- Supporing Routines
--
function LOOKUP_KEYWORD return KEYWORD;
procedure GET_TOKEN (NEXT_TOKEN : out TOKEN);
procedure CHECK_TOKEN (EXPECTED_TOKEN : TOKEN);
procedure FLUSH_STATEMENT;
procedure ERROR_MESSAGE (MESSAGE : STRING);
--
-- Statement Processing Routines
--
procedure FORM_STATEMENT;
procedure FIELD_STATEMENT (FORM_OPEN : BOOLEAN);
procedure TEXT_STATEMENT (FORM_OPEN : BOOLEAN);
--
-- File Open/Close
--
procedure OPEN_FILES;
procedure CLOSE_FILES;
--
-- Error Reporting
--
procedure PRINT_COUNT_OF_ERRORS;
function COUNT_OF_ERRORS return NATURAL;
procedure INCREMENT_COUNT_OF_ERRORS;
end BATCH_GENERATOR_SUPPORT;
::::::::::
BATCH_BODY.ADA
::::::::::
--------------------------------------------------------------------------
-- Abstract : This package body defines the routines which support the
-- Batch Generator. They provide the functions to handle
-- input file processing, token scanning, statement syntax
-- and semantic checking, and output listing file processing.
--------------------------------------------------------------------------
with FORM_TYPES;
with FORM_MANAGER;
with TEXT_IO;
with CALENDAR;
package body BATCH_GENERATOR_SUPPORT is
--
-- Support for File I/O
--
LST : TEXT_IO.FILE_TYPE;
INPUT_FILE : TEXT_IO.FILE_TYPE;
--
-- Support for GETCH/UNGETCH
--
CHARACTER_PENDING : BOOLEAN := FALSE; -- initially no char pending
SAVED_CHARACTER : CHARACTER;
INLINE : STRING (1 .. 256);
INLINE_POSITION : NATURAL := 1; -- position of next char
INLINE_LAST : NATURAL := 0; -- set for initial GET_LINE
--
-- Globals for FORM, FIELD, TEXT
--
CURRENT_FORM : FORM_MANAGER.FORM_ACCESS;
CURRENT_FIELD : FORM_MANAGER.FIELD_ACCESS;
ERROR_COUNT : NATURAL := 0;
LINE_NUMBER : NATURAL := 0;
--
-- Global Form File Name
--
FORM_FILE_NAME : STRING (1 .. 50) := (others => ' ');
FORM_FILE_LAST : NATURAL;
--
-- I/O for Natural and Integer Numbers
--
package NAT_IO is new TEXT_IO.INTEGER_IO (NATURAL);
package INT_IO is new TEXT_IO.INTEGER_IO (INTEGER);
--
--=====================================================================
--
procedure NOTE_MESSAGE (MESSAGE : STRING) is
--
-- Print note message in listing.
--
begin
TEXT_IO.PUT (LST, "<<<<< ");
TEXT_IO.PUT (LST, MESSAGE);
TEXT_IO.PUT_LINE (LST, " >>>>>");
end NOTE_MESSAGE;
--
--====================================================================
--
procedure OPEN_FILES is
--
-- Opens the file identified by INPUT_FILE and creates the file
-- identified by LST.
--
SOURCE_FILE_NAME : STRING (1 .. 50) := (others => ' ');
LISTING_FILE_NAME : STRING (1 .. 50) := (others => ' ');
LAST : NATURAL;
--
CURRENT_TIME : CALENDAR.TIME;
CURRENT_YEAR : CALENDAR.YEAR_NUMBER;
CURRENT_MONTH : CALENDAR.MONTH_NUMBER;
CURRENT_DAY : CALENDAR.DAY_NUMBER;
--
begin
--
-- Get date
--
CURRENT_TIME := CALENDAR.CLOCK;
CURRENT_YEAR := CALENDAR.YEAR (CURRENT_TIME);
CURRENT_MONTH := CALENDAR.MONTH (CURRENT_TIME);
CURRENT_DAY := CALENDAR.DAY (CURRENT_TIME);
--
-- Print banner on console
--
TEXT_IO.PUT ("Batch Forms Generator running on ");
INT_IO.PUT (CURRENT_MONTH, 2);
TEXT_IO.PUT ('/');
INT_IO.PUT (CURRENT_DAY, 2);
TEXT_IO.PUT ('/');
INT_IO.PUT (CURRENT_YEAR, 4);
TEXT_IO.NEW_LINE;
--
-- Get name of source file
--
TEXT_IO.PUT ("Source File > ");
TEXT_IO.GET_LINE (SOURCE_FILE_NAME, LAST);
TEXT_IO.OPEN (INPUT_FILE, TEXT_IO.IN_FILE,
SOURCE_FILE_NAME (1 .. LAST));
--
-- Get name of listing file
--
TEXT_IO.PUT ("Listing File > ");
TEXT_IO.GET_LINE (LISTING_FILE_NAME, LAST);
TEXT_IO.CREATE (LST, TEXT_IO.OUT_FILE, LISTING_FILE_NAME (1 .. LAST));
--
-- Get name of Form output File for use later when form is saved
--
TEXT_IO.PUT ("Form File > ");
TEXT_IO.GET_LINE (FORM_FILE_NAME, FORM_FILE_LAST);
--
-- Put header on listing output (title, name of source, name of output)
--
TEXT_IO.PUT (LST, "Batch Forms Generator running on ");
INT_IO.PUT (LST, CURRENT_MONTH, 2);
TEXT_IO.PUT (LST, '/');
INT_IO.PUT (LST, CURRENT_DAY, 2);
TEXT_IO.PUT (LST, '/');
INT_IO.PUT (LST, CURRENT_YEAR, 4);
TEXT_IO.NEW_LINE (LST);
TEXT_IO.PUT (LST, " Input File: ");
TEXT_IO.PUT (LST, SOURCE_FILE_NAME);
TEXT_IO.NEW_LINE (LST);
TEXT_IO.PUT (LST, " Output File: ");
TEXT_IO.PUT (LST, FORM_FILE_NAME);
TEXT_IO.NEW_LINE (LST, 2);
--
exception
when others =>
raise FILE_INIT_ERROR;
end OPEN_FILES;
--
--====================================================================
--
procedure CLOSE_FILES is
--
-- Close the Input and Listing Files
-- Close the form file if ERROR_COUNT = 0
--
begin
TEXT_IO.CLOSE (INPUT_FILE);
if ERROR_COUNT = 0 then
FORM_MANAGER.SAVE_FORM
(CURRENT_FORM, FORM_FILE_NAME (1 .. FORM_FILE_LAST));
NOTE_MESSAGE ("Form Saved");
else
NOTE_MESSAGE ("Form NOT Saved");
end if;
TEXT_IO.CLOSE (LST);
end CLOSE_FILES;
--
--====================================================================
--
procedure PRINT_COUNT_OF_ERRORS is
--
-- Print ERROR_COUNT to LST and Console
--
begin
--
-- Print error count on console
--
TEXT_IO.NEW_LINE;
TEXT_IO.PUT ("<<<<< ");
NAT_IO.PUT (ERROR_COUNT);
TEXT_IO.PUT_LINE (" Error(s) Detected >>>>>");
--
-- Print error count on listing
--
TEXT_IO.NEW_LINE (LST);
TEXT_IO.PUT (LST, "<<<<< ");
NAT_IO.PUT (LST, ERROR_COUNT);
TEXT_IO.PUT_LINE (LST, " Error(s) Detected >>>>>");
--
end PRINT_COUNT_OF_ERRORS;
--
--====================================================================
--
procedure INCREMENT_COUNT_OF_ERRORS is
--
-- Increment ERROR_COUNT
--
begin
ERROR_COUNT := ERROR_COUNT + 1;
end INCREMENT_COUNT_OF_ERRORS;
--
--====================================================================
--
function COUNT_OF_ERRORS return NATURAL is
--
-- Return value of ERROR_COUNT
--
begin
return (ERROR_COUNT);
end COUNT_OF_ERRORS;
--
--====================================================================
--
function LOOKUP_KEYWORD return KEYWORD is
--
-- Searches the keyword table to determine if the current identifier
-- is a keyword and returns the keyword value.
--
-- Raises UNKNOWN_KEYWORD if the CURRENT_IDENTIFIER is not a known
-- keyword in KEYWORD_TABLE.
--
KEYWORD_OUTPUT : KEYWORD;
FOUND_KEYWORD : BOOLEAN;
--
-- Compare string TABLE to string ID; capitalize string ID
--
function LOOK_EQUAL (TABLE : STRING; ID : STRING) return BOOLEAN is
EQUAL : BOOLEAN;
--
function CAPS (INCHAR : CHARACTER) return CHARACTER is
begin
if INCHAR in 'a' .. 'z' then
return CHARACTER'VAL
(CHARACTER'POS (INCHAR) - CHARACTER'POS ('a') +
CHARACTER'POS ('A'));
else
return INCHAR;
end if;
end CAPS;
--
begin
EQUAL := TRUE;
for I in 1 .. KEYWORD_LENGTH loop
if TABLE (I) /= CAPS (ID (I)) then
EQUAL := FALSE;
exit;
end if;
end loop;
return EQUAL;
end LOOK_EQUAL;
--
-- Body of LOOKUP_KEYWORD
--
begin
FOUND_KEYWORD := FALSE;
for KEYWORD_INDEX in KEYWORD'FIRST .. KEYWORD'LAST loop
if LOOK_EQUAL (KEYWORD_TABLE (KEYWORD_INDEX),
CURRENT_IDENTIFIER) then
KEYWORD_OUTPUT := KEYWORD_INDEX;
FOUND_KEYWORD := TRUE;
exit;
end if;
end loop;
if not FOUND_KEYWORD then
raise UNKNOWN_KEYWORD;
end if;
return KEYWORD_OUTPUT; -- correct Ada
end LOOKUP_KEYWORD;
--
--====================================================================
--
procedure FLUSH_INPUT_LINE is
--
-- Flushes rest of input line
--
begin
INLINE_LAST := 0;
INLINE_POSITION := 1;
CHARACTER_PENDING := FALSE;
end FLUSH_INPUT_LINE;
procedure UNGETCH (INCHAR : CHARACTER) is
--
-- Saves the indicated character for the following GETCH
--
begin
SAVED_CHARACTER := INCHAR;
CHARACTER_PENDING := TRUE;
end UNGETCH;
function GETCH return CHARACTER is
--
-- Returns the next character from the input file. If EOL, returns
-- ASCII.CR.
--
INCHAR : CHARACTER;
begin
if CHARACTER_PENDING then
CHARACTER_PENDING := FALSE;
return SAVED_CHARACTER;
else
if INLINE_POSITION > INLINE_LAST then
TEXT_IO.GET_LINE (INPUT_FILE, INLINE, INLINE_LAST);
LINE_NUMBER := LINE_NUMBER + 1;
NAT_IO.PUT (LST, LINE_NUMBER, 5);
TEXT_IO.PUT (LST, ' ');
for I in 1 .. INLINE_LAST loop
TEXT_IO.PUT (LST, INLINE (I));
end loop;
TEXT_IO.NEW_LINE (LST);
INLINE_POSITION := 1;
return ASCII.CR;
else
INCHAR := INLINE (INLINE_POSITION);
INLINE_POSITION := INLINE_POSITION + 1;
return INCHAR;
end if;
end if;
exception
when others =>
raise END_OF_INPUT_FILE;
end GETCH;
--
--====================================================================
--
procedure GET_TOKEN (NEXT_TOKEN : out TOKEN) is
--
-- Scans the input file for the next token. A token can be an
-- identifier, number, string, or special symbol. Special symbols
-- include arrow "=>", comma ",", left parenthesis "(", right
-- parenthesis ")", semicolon ";", and comment "--".
--
-- Raises INVALID_IDENTIFIER, INVALID_NUMBER, INVALID_STRING, and
-- UNKNOWN_TOKEN.
--
--
-- Global Identifiers
--
FIRST_CHARACTER : CHARACTER;
INDEX : NATURAL;
--
-- If the indicated character is a white space character (non-printing
-- character in this case), return TRUE else return FALSE.
--
function IS_WHITE_SPACE (INCHAR : CHARACTER) return BOOLEAN is
begin
if INCHAR <= ' ' or INCHAR = ASCII.DEL then
return TRUE;
else
return FALSE;
end if;
end IS_WHITE_SPACE;
--
-- Fill CURRENT_IDENTIFIER from INDEX+1 to end with spaces
--
procedure FILL_IDENTIFIER is
begin
for I in INDEX + 1 .. CURRENT_IDENTIFIER'LAST loop
CURRENT_IDENTIFIER (I) := ' ';
end loop;
end FILL_IDENTIFIER;
--
-- Extract identifier into CURRENT_IDENTIFIER
--
procedure EXTRACT_IDENTIFIER is
NEXT_CHARACTER : CHARACTER;
begin
INDEX := 1;
CURRENT_IDENTIFIER (INDEX) := FIRST_CHARACTER;
loop
NEXT_CHARACTER := GETCH;
case NEXT_CHARACTER is
when 'a' .. 'z' | 'A' .. 'Z' | '_' =>
INDEX := INDEX + 1;
if INDEX > CURRENT_IDENTIFIER'LAST then
IDENTIFIER_LENGTH := INDEX - 1;
raise INVALID_IDENTIFIER;
end if;
CURRENT_IDENTIFIER (INDEX) := NEXT_CHARACTER;
when others =>
UNGETCH (NEXT_CHARACTER);
exit;
end case;
end loop;
IDENTIFIER_LENGTH := INDEX;
FILL_IDENTIFIER;
end EXTRACT_IDENTIFIER;
--
-- Store characters making up number in CURRENT_IDENTIFIER
--
procedure EXTRACT_NUMBER is
NEXT_CHARACTER : CHARACTER;
begin
INDEX := 1;
CURRENT_IDENTIFIER (INDEX) := FIRST_CHARACTER;
loop
NEXT_CHARACTER := GETCH;
case NEXT_CHARACTER is
when '0' .. '9' =>
INDEX := INDEX + 1;
if INDEX > CURRENT_IDENTIFIER'LAST then
IDENTIFIER_LENGTH := INDEX - 1;
raise INVALID_NUMBER;
end if;
CURRENT_IDENTIFIER (INDEX) := NEXT_CHARACTER;
when others =>
UNGETCH (NEXT_CHARACTER);
exit;
end case;
end loop;
IDENTIFIER_LENGTH := INDEX;
FILL_IDENTIFIER;
CURRENT_NUMBER := NATURAL'VALUE (CURRENT_IDENTIFIER);
exception
when others =>
raise INVALID_NUMBER;
end EXTRACT_NUMBER;
--
-- Extract the string into CURRENT_IDENTIFIER
--
procedure EXTRACT_STRING is
NEXT_CHARACTER : CHARACTER;
begin
INDEX := 0;
loop
NEXT_CHARACTER := GETCH;
case NEXT_CHARACTER is
when '"' =>
exit; -- end of string
when ASCII.CR =>
IDENTIFIER_LENGTH := INDEX;
FILL_IDENTIFIER;
raise INVALID_STRING; -- EOL error
when others =>
INDEX := INDEX + 1;
if INDEX > CURRENT_IDENTIFIER'LAST then
IDENTIFIER_LENGTH := INDEX - 1;
raise INVALID_STRING;
end if;
CURRENT_IDENTIFIER (INDEX) := NEXT_CHARACTER;
end case;
end loop;
IDENTIFIER_LENGTH := INDEX;
FILL_IDENTIFIER;
end EXTRACT_STRING;
--
-- Check to see if next character is indeed a ">" to complete the arrow "=>"
--
procedure EXTRACT_ARROW is
NEXT_CHARACTER : CHARACTER;
begin
NEXT_CHARACTER := GETCH;
if NEXT_CHARACTER = '>' then
return; -- OK
else
UNGETCH (NEXT_CHARACTER);
raise UNKNOWN_TOKEN;
end if;
end EXTRACT_ARROW;
--
-- Check to see if next character is a "-" to complete the "--"
--
procedure EXTRACT_COMMENT is
NEXT_CHARACTER : CHARACTER;
begin
NEXT_CHARACTER := GETCH;
if NEXT_CHARACTER = '-' then
FLUSH_INPUT_LINE; -- throw away comment chars
return; -- OK
else
UNGETCH (NEXT_CHARACTER);
raise UNKNOWN_TOKEN;
end if;
end EXTRACT_COMMENT;
--
begin
loop
FIRST_CHARACTER := GETCH; -- look for first char
exit when not IS_WHITE_SPACE (FIRST_CHARACTER);
end loop;
case FIRST_CHARACTER is
when 'A' .. 'Z' | 'a' .. 'z' =>
EXTRACT_IDENTIFIER;
NEXT_TOKEN := IDENTIFIER;
when '0' .. '9' =>
EXTRACT_NUMBER;
NEXT_TOKEN := NUMBER;
when '"' =>
EXTRACT_STRING;
NEXT_TOKEN := TEXT_STRING;
when '(' =>
CURRENT_IDENTIFIER := (others => ' ');
CURRENT_IDENTIFIER (1) := '(';
IDENTIFIER_LENGTH := 1;
NEXT_TOKEN := LEFT_PARENTHESIS;
when ')' =>
CURRENT_IDENTIFIER := (others => ' ');
CURRENT_IDENTIFIER (1) := ')';
IDENTIFIER_LENGTH := 1;
NEXT_TOKEN := RIGHT_PARENTHESIS;
when '=' =>
EXTRACT_ARROW;
CURRENT_IDENTIFIER := (others => ' ');
CURRENT_IDENTIFIER (1 .. 2) := "=>";
IDENTIFIER_LENGTH := 2;
NEXT_TOKEN := ARROW;
when '-' =>
EXTRACT_COMMENT;
CURRENT_IDENTIFIER := (others => ' ');
CURRENT_IDENTIFIER (1 .. 2) := "--";
IDENTIFIER_LENGTH := 2;
NEXT_TOKEN := COMMENT;
when ',' =>
CURRENT_IDENTIFIER := (others => ' ');
CURRENT_IDENTIFIER (1) := ',';
IDENTIFIER_LENGTH := 1;
NEXT_TOKEN := COMMA;
when ';' =>
CURRENT_IDENTIFIER := (others => ' ');
CURRENT_IDENTIFIER (1) := ';';
IDENTIFIER_LENGTH := 1;
NEXT_TOKEN := SEMICOLON;
when others =>
CURRENT_IDENTIFIER := (others => ' ');
CURRENT_IDENTIFIER (1) := FIRST_CHARACTER;
IDENTIFIER_LENGTH := 1;
raise UNKNOWN_TOKEN;
end case;
end GET_TOKEN;
--
--====================================================================
--
procedure ERROR_MESSAGE (MESSAGE : STRING) is
--
-- Outputs an error message to the listing file following the
-- statement which had the error.
--
begin
TEXT_IO.PUT (LST, "***** ");
TEXT_IO.PUT (LST, MESSAGE);
TEXT_IO.NEW_LINE (LST);
TEXT_IO.PUT (LST, " Error is at or near ");
for I in 1 .. IDENTIFIER_LENGTH loop
TEXT_IO.PUT (LST, CURRENT_IDENTIFIER (I));
end loop;
TEXT_IO.NEW_LINE (LST);
end ERROR_MESSAGE;
--
--====================================================================
--
procedure FLUSH_STATEMENT is
NEXT_TOKEN : TOKEN;
begin
loop
GET_TOKEN (NEXT_TOKEN);
exit when NEXT_TOKEN = SEMICOLON;
end loop;
end FLUSH_STATEMENT;
--
--====================================================================
--
procedure CHECK_TOKEN (EXPECTED_TOKEN : TOKEN) is
NEXT_TOKEN : TOKEN;
begin
--
-- Flush comments
--
loop
GET_TOKEN (NEXT_TOKEN);
exit when NEXT_TOKEN /= COMMENT;
end loop;
--
-- Test and print error messages
--
if NEXT_TOKEN /= EXPECTED_TOKEN then
case EXPECTED_TOKEN is
when IDENTIFIER =>
ERROR_MESSAGE ("Expected Identifier");
when NUMBER =>
ERROR_MESSAGE ("Expected Number");
when TEXT_STRING =>
ERROR_MESSAGE ("Expected String");
when LEFT_PARENTHESIS =>
ERROR_MESSAGE ("Expected '('");
when RIGHT_PARENTHESIS =>
ERROR_MESSAGE ("Expected ')'");
when ARROW =>
ERROR_MESSAGE ("Expected '=>'");
when COMMA =>
ERROR_MESSAGE ("Expected ','");
when SEMICOLON =>
ERROR_MESSAGE ("Expected ';'");
when others =>
null; -- not encountered
end case;
raise UNEXPECTED_TOKEN;
end if;
end CHECK_TOKEN;
--
--=====================================================================
--
procedure GET_PARAMETER (PARAMETER : out KEYWORD) is
begin
CHECK_TOKEN (IDENTIFIER);
PARAMETER := LOOKUP_KEYWORD;
CHECK_TOKEN (ARROW);
end GET_PARAMETER;
--
--=====================================================================
--
procedure GET_ROW_COL (ROW, COL : out NATURAL) is
begin
CHECK_TOKEN (LEFT_PARENTHESIS);
CHECK_TOKEN (NUMBER);
ROW := CURRENT_NUMBER;
CHECK_TOKEN (COMMA);
CHECK_TOKEN (NUMBER);
COL := CURRENT_NUMBER;
CHECK_TOKEN (RIGHT_PARENTHESIS);
end GET_ROW_COL;
--
--====================================================================
--
procedure FORM_STATEMENT is
--
-- Parses the "FORM" statement which begins a form definition by
-- giving the form size, position, and whether the screen should
-- be cleared whenever the form is displayed. If the form definition
-- is correct, the form definition is saved by calling CREATE_FORM
-- in the FORM_MANAGER. The form statement definition is copied
-- to the listing file including any errors that are detected.
--
-- Possible Error Messages (sent to listing file):
-- Form not contained within screen display boundaries
-- Incorrect position parameter syntax
-- Incorrect size parameter syntax
-- Invalid clear screen option
-- Invalid form statement parameter
--
PARAMETER : KEYWORD;
VALUE : KEYWORD;
CLS : FORM_MANAGER.OPTION_TYPE;
NEXT_TOKEN : TOKEN;
SIZE_ROW, POSITION_ROW : FORM_TYPES.ROW_RANGE;
SIZE_COL, POSITION_COL : FORM_TYPES.COLUMN_RANGE;
begin
--
-- Default Values
--
SIZE_ROW := 24; -- number of rows and columns on form
SIZE_COL := 80;
POSITION_ROW := 1; -- at upper left
POSITION_COL := 1;
CLS := FORM_MANAGER.CLEAR; -- clear screen
--
-- Interpret parameters and extract information from them
--
loop
GET_PARAMETER (PARAMETER);
case PARAMETER is
when SIZE =>
GET_ROW_COL (SIZE_ROW, SIZE_COL);
when POSITION =>
GET_ROW_COL (POSITION_ROW, POSITION_COL);
when CLEAR_SCREEN =>
CHECK_TOKEN (IDENTIFIER);
VALUE := LOOKUP_KEYWORD;
case VALUE is
when YES => CLS := FORM_MANAGER.CLEAR;
when NO => CLS := FORM_MANAGER.NO_CLEAR;
when others =>
ERROR_MESSAGE ("Expected YES or NO");
raise INVALID_PARAMETER_VALUE;
end case;
when others =>
raise INVALID_PARAMETER;
end case;
--
-- Next token should be a comma (to continue) or right paren (to stop)
--
loop
GET_TOKEN (NEXT_TOKEN);
exit when NEXT_TOKEN /= COMMENT;
end loop;
exit when NEXT_TOKEN = RIGHT_PARENTHESIS;
if NEXT_TOKEN /= COMMA then
ERROR_MESSAGE ("Expected ',' or ')'");
raise UNEXPECTED_TOKEN;
end if;
end loop;
--
-- Proceed to create the form
--
begin
FORM_MANAGER.CREATE_FORM
(SIZE => (SIZE_ROW, SIZE_COL),
POSITION => (POSITION_ROW, POSITION_COL),
CLEAR_OPTION => CLS,
FORM => CURRENT_FORM);
exception
when others =>
raise CREATE_FORM_ERROR;
end;
end FORM_STATEMENT;
--
--====================================================================
--
procedure FIELD_STATEMENT (FORM_OPEN : BOOLEAN) is
--
-- Parses the "FIELD" statement that defines an input or output field
-- for a form by giving the field name, position, length, display
-- rendition, character limitation, default value, and input and/or
-- output mode. If the field definition is correct, the field is
-- saved by calling ADD_FIELD in the FORM_MANAGER. The field statement
-- definition is copied to the listing file including any errors that
-- are detected.
--
-- Possible Error Messages (sent to listing file):
-- Field not contained within form boundaries
-- Incorrect default parameter syntax
-- Incorrect length parameter syntax
-- Incorrect name parameter syntax
-- Incorrect position parameter syntax
-- Invalid character limitation option
-- Invalid display mode option
-- Invalid display rendition option
-- Invalid field statement parameter
-- Length parameter must be provided
-- Name parameter must be provided
-- Position parameter must be provided
--
NEXT_TOKEN : TOKEN;
PARAMETER : KEYWORD;
TEXT_VALUE : KEYWORD;
TEXT_RENDITION : FORM_MANAGER.FIELD_RENDITIONS;
IO_MODE : FORM_MANAGER.FIELD_MODE;
TEXT_LIMITS : FORM_MANAGER.CHAR_TYPE;
VALUE_STRING : STRING (1 .. 80);
NAME_STRING : STRING (1 .. 80);
DEFAULT_STRING : STRING (1 .. 80) := (others => ' ');
LENGTH_VALUE : FORM_MANAGER.FIELD_LENGTH;
NAME_SET : BOOLEAN;
LENGTH_SET : BOOLEAN;
POSITION_SET : BOOLEAN;
POSITION_ROW : FORM_TYPES.ROW_RANGE;
POSITION_COL : FORM_TYPES.COLUMN_RANGE;
begin
--
-- Default Parameter Values
--
POSITION_SET := FALSE;
NAME_SET := FALSE;
LENGTH_SET := FALSE;
TEXT_RENDITION := FORM_TYPES.PRIMARY_RENDITION;
-- DEFAULT_STRING := " "; -- set in declaration
IO_MODE := FORM_MANAGER.INPUT_OUTPUT;
TEXT_LIMITS := FORM_MANAGER.NOT_LIMITED;
--
-- Process each parameter in turn
--
loop
GET_PARAMETER (PARAMETER);
case PARAMETER is
when NAME =>
CHECK_TOKEN (TEXT_STRING);
NAME_STRING := CURRENT_IDENTIFIER;
NAME_SET := TRUE;
when POSITION =>
GET_ROW_COL (POSITION_ROW, POSITION_COL);
POSITION_SET := TRUE;
when LENGTH =>
CHECK_TOKEN (NUMBER);
LENGTH_VALUE := CURRENT_NUMBER;
LENGTH_SET := TRUE;
when RENDITION =>
CHECK_TOKEN (IDENTIFIER);
TEXT_VALUE := LOOKUP_KEYWORD;
case TEXT_VALUE is
when PRIMARY =>
TEXT_RENDITION := FORM_TYPES.PRIMARY_RENDITION;
when SECONDARY =>
TEXT_RENDITION := FORM_TYPES.REVERSE_RENDITION;
when others =>
ERROR_MESSAGE ("Expected PRIMARY or REVERSE");
raise INVALID_PARAMETER_VALUE;
end case;
when LIMITATION =>
CHECK_TOKEN (IDENTIFIER);
TEXT_VALUE := LOOKUP_KEYWORD;
case TEXT_VALUE is
when ALPHABETIC =>
TEXT_LIMITS := FORM_MANAGER.ALPHA;
when NUMERIC =>
TEXT_LIMITS := FORM_MANAGER.NUMERIC;
when ALPHANUMERIC =>
TEXT_LIMITS := FORM_MANAGER.ALPHA_NUMERIC;
when NOT_LIMITED =>
TEXT_LIMITS := FORM_MANAGER.NOT_LIMITED;
when others =>
ERROR_MESSAGE
("Expected Text Limitation Specification");
raise INVALID_PARAMETER_VALUE;
end case;
when DEFAULT =>
CHECK_TOKEN (TEXT_STRING);
DEFAULT_STRING := CURRENT_IDENTIFIER;
when MODE =>
CHECK_TOKEN (IDENTIFIER);
TEXT_VALUE := LOOKUP_KEYWORD;
case TEXT_VALUE is
when OUTPUT_ONLY =>
IO_MODE := FORM_MANAGER.OUTPUT_ONLY;
when INPUT_OUTPUT =>
IO_MODE := FORM_MANAGER.INPUT_OUTPUT;
when others =>
ERROR_MESSAGE
("Expected OUTPUT_ONLY or INPUT_OUTPUT");
raise INVALID_PARAMETER_VALUE;
end case;
when others =>
raise INVALID_PARAMETER;
end case;
--
-- Next token should be a comma (to continue) or right paren (to stop)
--
loop
GET_TOKEN (NEXT_TOKEN);
exit when NEXT_TOKEN /= COMMENT;
end loop;
exit when NEXT_TOKEN = RIGHT_PARENTHESIS;
if NEXT_TOKEN /= COMMA then
ERROR_MESSAGE ("Expected ',' or ')'");
raise UNEXPECTED_TOKEN;
end if;
end loop;
--
-- If no error, then check for all required parameters and process
--
if not (NAME_SET and POSITION_SET and LENGTH_SET) then
if not NAME_SET then
ERROR_MESSAGE ("NAME Parameter is Missing");
INCREMENT_COUNT_OF_ERRORS;
end if;
if not POSITION_SET then
ERROR_MESSAGE ("POSITION Parameter is Missing");
INCREMENT_COUNT_OF_ERRORS;
end if;
if not LENGTH_SET then
ERROR_MESSAGE ("LENGTH Parameter is Missing");
INCREMENT_COUNT_OF_ERRORS;
end if;
else
begin
if FORM_OPEN then
FORM_MANAGER.ADD_FIELD
(FORM => CURRENT_FORM,
NAME => NAME_STRING,
POSITION => (POSITION_ROW, POSITION_COL),
LENGTH => LENGTH_VALUE,
RENDITION => TEXT_RENDITION,
CHAR_LIMITS => TEXT_LIMITS,
INIT_VALUE => DEFAULT_STRING,
MODE => IO_MODE,
FIELD => CURRENT_FIELD);
else
NOTE_MESSAGE ("FIELD Statement Correct but FORM Not Open");
if ERROR_COUNT = 0 then ERROR_COUNT := 1; end if;
end if;
exception
when FORM_MANAGER.DUPLICATE_FIELD_NAME =>
ERROR_MESSAGE ("Field name is not unique");
when FORM_MANAGER.FIELD_EXTENDS_PAST_FORM |
FORM_MANAGER.POSITION_OUT_OF_FORM_RANGE =>
ERROR_MESSAGE ("Field not within form boundary");
when FORM_MANAGER.FIELD_OVERLAP_OCCURRED =>
ERROR_MESSAGE ("Field overlaps another field");
when others =>
raise ADD_FIELD_ERROR;
end;
end if;
end FIELD_STATEMENT;
--
--====================================================================
--
procedure TEXT_STATEMENT (FORM_OPEN : BOOLEAN) is
--
-- Parses the "TEXT" statement that defines a text label for a form
-- by giving the label text, position, and display rendition. If
-- the text label definition is correct, the text label is saved by
-- calling ADD_FIELD in the FORM_MANAGER. The text statement definition
-- is copied to the listing file including any errors that are
-- detected.
--
-- Possible Error Messages (sent to listing file):
-- Incorrect position parameter syntax
-- Incorrect value parameter syntax
-- Invalid display rendition option
-- Invalid text statement parameter
-- Position parameter must be provided
-- Text field not contained within form boundaries
-- Value parameter must be provided
--
NEXT_TOKEN : TOKEN;
PARAMETER : KEYWORD;
TEXT_VALUE : KEYWORD;
TEXT_RENDITION : FORM_MANAGER.FIELD_RENDITIONS;
VALUE_STRING : STRING (1 .. 80);
VALUE_LENGTH : NATURAL;
VALUE_SET : BOOLEAN;
POSITION_SET : BOOLEAN;
POSITION_ROW : FORM_TYPES.ROW_RANGE;
POSITION_COL : FORM_TYPES.COLUMN_RANGE;
begin
--
-- Default parameter values
--
VALUE_SET := FALSE;
POSITION_SET := FALSE;
TEXT_RENDITION := FORM_TYPES.PRIMARY_RENDITION;
--
-- Process each parameter encountered in turn
--
loop
GET_PARAMETER (PARAMETER);
case PARAMETER is
when VALUE =>
CHECK_TOKEN (TEXT_STRING);
VALUE_STRING := CURRENT_IDENTIFIER;
VALUE_LENGTH := IDENTIFIER_LENGTH;
VALUE_SET := TRUE;
when POSITION =>
GET_ROW_COL (POSITION_ROW, POSITION_COL);
POSITION_SET := TRUE;
when RENDITION =>
CHECK_TOKEN (IDENTIFIER);
TEXT_VALUE := LOOKUP_KEYWORD;
case TEXT_VALUE is
when PRIMARY =>
TEXT_RENDITION := FORM_TYPES.PRIMARY_RENDITION;
when SECONDARY =>
TEXT_RENDITION := FORM_TYPES.REVERSE_RENDITION;
when others =>
ERROR_MESSAGE ("Expected PRIMARY or REVERSE");
raise INVALID_PARAMETER_VALUE;
end case;
when others =>
raise INVALID_PARAMETER;
end case;
--
-- Next token should be a comma (to continue) or a right paren (to stop)
--
loop
GET_TOKEN (NEXT_TOKEN);
exit when NEXT_TOKEN /= COMMENT;
end loop;
exit when NEXT_TOKEN = RIGHT_PARENTHESIS;
if NEXT_TOKEN /= COMMA then
ERROR_MESSAGE ("Expected ',' or ')'");
raise UNEXPECTED_TOKEN;
end if;
end loop;
--
-- If no error, then complete processing with requirements check
--
if not (VALUE_SET and POSITION_SET) then
if not VALUE_SET then
ERROR_MESSAGE ("VALUE Parameter is Missing");
INCREMENT_COUNT_OF_ERRORS;
end if;
if not POSITION_SET then
ERROR_MESSAGE ("POSITION Parameter is Missing");
INCREMENT_COUNT_OF_ERRORS;
end if;
else
begin
if FORM_OPEN then
FORM_MANAGER.ADD_FIELD
(FORM => CURRENT_FORM,
NAME => "",
POSITION => (POSITION_ROW, POSITION_COL),
LENGTH => VALUE_LENGTH,
RENDITION => TEXT_RENDITION,
INIT_VALUE => VALUE_STRING,
MODE => FORM_MANAGER.CONSTANT_TEXT,
FIELD => CURRENT_FIELD);
else
NOTE_MESSAGE ("TEXT Statement Correct but FORM Not Open");
if ERROR_COUNT = 0 then ERROR_COUNT := 1; end if;
end if;
exception
when FORM_MANAGER.FIELD_EXTENDS_PAST_FORM |
FORM_MANAGER.POSITION_OUT_OF_FORM_RANGE =>
ERROR_MESSAGE ("Text field not within form boundary");
when FORM_MANAGER.FIELD_OVERLAP_OCCURRED =>
ERROR_MESSAGE ("Text field overlaps another field");
when others =>
raise ADD_FIELD_ERROR;
end;
end if;
end TEXT_STATEMENT;
end BATCH_GENERATOR_SUPPORT;
::::::::::
BATCH_GEN.ADA
::::::::::
--------------------------------------------------------------------------
-- Abstract : This is the main procedure for the Batch Generator of
-- the Form Generator system. It inputs a form definition
-- language file, syntax checks it, and output a form
-- definition file.
--------------------------------------------------------------------------
with TEXT_IO;
with BATCH_GENERATOR_SUPPORT;
use BATCH_GENERATOR_SUPPORT;
with CURRENT_EXCEPTION;
procedure BATCH_GEN is
--
-- Variables
--
FORM_DECLARED : BOOLEAN := FALSE; -- indicates FORM statement issued
CURRENT_TOKEN : TOKEN; -- token now being processed
CURRENT_KEYWORD : KEYWORD; -- keyword now being processed
begin
--
-- Open input files
--
OPEN_FILES;
--
-- Statement Processing Loop
-- Processes three basic statements: FORM, FIELD, TEXT
--
loop
--
-- Begin/End Block for Exceptions within main loop
--
begin
--
-- Flush comments
--
loop
GET_TOKEN (CURRENT_TOKEN);
exit when CURRENT_TOKEN /= COMMENT;
end loop;
--
-- Process current token
--
if CURRENT_TOKEN = IDENTIFIER then
--
-- Current token is an identifier
-- It must be FORM, FIELD, or TEXT
--
CURRENT_KEYWORD := LOOKUP_KEYWORD;
--
-- Process FORM, FIELD and TEXT, and other Keywords
--
case CURRENT_KEYWORD is
when FORM =>
--
-- FORM may be declared only once
--
if not FORM_DECLARED then
--
-- Left Paren must be first non-comment token
-- after FORM statement
--
CHECK_TOKEN (LEFT_PARENTHESIS);
FORM_STATEMENT;
FORM_DECLARED := TRUE;
else
ERROR_MESSAGE ("Multiple FORM Statements");
INCREMENT_COUNT_OF_ERRORS;
FLUSH_STATEMENT;
end if;
when FIELD | TEXT =>
--
-- Left Paren must be first non-comment token after
-- FIELD or TEXT statements
--
CHECK_TOKEN (LEFT_PARENTHESIS);
if CURRENT_KEYWORD = FIELD then
FIELD_STATEMENT (FORM_DECLARED);
else
TEXT_STATEMENT (FORM_DECLARED);
end if;
when others =>
ERROR_MESSAGE
("Expected FORM, FIELD, or TEXT Statement");
INCREMENT_COUNT_OF_ERRORS;
FLUSH_STATEMENT;
end case;
else
--
-- Current token is not an identifier
-- It must be a semicolon; else, we have an error
--
if CURRENT_TOKEN /= SEMICOLON then
ERROR_MESSAGE ("Expected Identifier");
INCREMENT_COUNT_OF_ERRORS;
end if;
end if;
--
-- Exception Processing for main loop
--
exception
when UNKNOWN_KEYWORD =>
ERROR_MESSAGE ("Unrecognized Keyword Encountered");
INCREMENT_COUNT_OF_ERRORS;
FLUSH_STATEMENT;
when UNKNOWN_TOKEN =>
ERROR_MESSAGE ("Unrecognized Token Encountered");
INCREMENT_COUNT_OF_ERRORS;
FLUSH_STATEMENT;
when INVALID_IDENTIFIER =>
ERROR_MESSAGE ("Invalid Format for Identifier");
INCREMENT_COUNT_OF_ERRORS;
FLUSH_STATEMENT;
when INVALID_NUMBER =>
ERROR_MESSAGE ("Invalid Format for Number");
INCREMENT_COUNT_OF_ERRORS;
FLUSH_STATEMENT;
when INVALID_STRING =>
ERROR_MESSAGE ("Invalid Format for String");
INCREMENT_COUNT_OF_ERRORS;
FLUSH_STATEMENT;
when INVALID_PARAMETER =>
ERROR_MESSAGE ("Invalid Parameter");
INCREMENT_COUNT_OF_ERRORS;
FLUSH_STATEMENT;
when INVALID_PARAMETER_VALUE =>
INCREMENT_COUNT_OF_ERRORS;
FLUSH_STATEMENT;
when UNEXPECTED_TOKEN =>
INCREMENT_COUNT_OF_ERRORS;
FLUSH_STATEMENT;
when END_OF_INPUT_FILE =>
exit;
when ADD_FIELD_ERROR =>
ERROR_MESSAGE ("Error in Adding Field to Form");
INCREMENT_COUNT_OF_ERRORS;
FLUSH_STATEMENT;
when CREATE_FORM_ERROR =>
ERROR_MESSAGE ("Error in Creating Form");
INCREMENT_COUNT_OF_ERRORS;
FLUSH_STATEMENT;
when others =>
ERROR_MESSAGE ("Unknown Exception Raised");
INCREMENT_COUNT_OF_ERRORS;
FLUSH_STATEMENT;
TEXT_IO.PUT_LINE (CURRENT_EXCEPTION.NAME); -- DEBUG
end;
end loop;
PRINT_COUNT_OF_ERRORS;
CLOSE_FILES;
exception
when FILE_INIT_ERROR =>
TEXT_IO.PUT_LINE ("File Name/Open/Create Error");
when others =>
ERROR_MESSAGE ("Abnormal Error Condition");
end BATCH_GEN;
pragma MAIN;
::::::::::
COMMANDS.ADA
::::::::::
separate (EDITOR)
procedure COM_LINE -------------------------------------------------------------------------
-- Abstract : This procedure presents and services the Command Line of
-- of the Form Editor. This Command Line is an alternative
-- method of invoking the editor commands. This Command Line
-- provides command completion. This command line can only
-- be invoked using a single keystroke operation.
-------------------------------------------------------------------------
-- Parameters : none.
-------------------------------------------------------------------------
-- Algorithm : The command completion of this Command Line is completion
-- which is triggered by blanks or the return key. Upon
-- encountering one of these delimiters, the command will be
-- completed as far as possible given the current input.
-------------------------------------------------------------------------
is
SIZE : TERMINAL_INTERFACE.SCREEN_POSITION;
MAX_COMMAND_LINE_LENGTH : constant INTEGER := 16;
subtype COMMAND_LINE_RANGE is INTEGER range 1 .. MAX_COMMAND_LINE_LENGTH;
subtype COMMAND_STRING is STRING (COMMAND_LINE_RANGE);
COMMAND : COMMAND_STRING := (COMMAND_LINE_RANGE => ' ');
START : COMMAND_LINE_RANGE;
LENGTH : NATURAL;
CHAR : CHARACTER;
CHARTYPE : TERMINAL_INTERFACE.CHAR_ENUM;
FUNCT : TERMINAL_INTERFACE.FUNCTION_KEY_ENUM;
-------------------------------------------------------------------------
-- Abstract : This procedure performs the actual completions of the
-- commands.
-------------------------------------------------------------------------
-- Parameters : COMMAND - The command string as currently recognized.
-- START - The starting position for completion within
-- this command string. ( Portions may have
-- already been completed. )
-- LENGTH - The current length of the command string
-- ( being measured from START above ).
-------------------------------------------------------------------------
-- Algorithm : The command completion is triggered by either a blank that
-- separated the command words or by the return key.
-------------------------------------------------------------------------
procedure COMMAND_COMPLETION (COMMAND : in out COMMAND_STRING;
START : COMMAND_LINE_RANGE;
LENGTH : in out NATURAL) is
TEMPLATE : STRING (1 .. 9);
INVALID_PREFIX : exception;
-------------------------------------------------------------------------
-- This procedure is used to recognize characters within the COMMAND
-- string starting at START until a blank is encountered and insuring
-- that these character match one-for-one with the characters of the
-- TEMPLATE, up until the blank was encountered.
procedure ABSORB_CHARACTERS (COMMAND : COMMAND_STRING;
START : COMMAND_LINE_RANGE;
TEMPLATE : STRING) is
COMMAND_INDEX : COMMAND_LINE_RANGE := START;
TEMPLATE_INDEX : INTEGER := 1;
begin
-- Continue to match characters until a blank is encountered in COMMAND.
while COMMAND (COMMAND_INDEX) /= ' ' loop
-- If the characters do not match, then raise an exception.
if COMMAND (COMMAND_INDEX) /= TEMPLATE (TEMPLATE_INDEX) then
raise INVALID_PREFIX;
end if;
if COMMAND_INDEX + 1 > MAX_COMMAND_LINE_LENGTH then
exit;
else
TEMPLATE_INDEX := TEMPLATE_INDEX + 1;
COMMAND_INDEX := COMMAND_INDEX + 1;
end if;
end loop;
end ABSORB_CHARACTERS;
-------------------------------------------------------------------------
begin
-- If there are no characters recognized so far, then simply return.
if LENGTH = 0 then
return;
else
case COMMAND (START) is
when 'c' | 'C' =>
COMMAND (START) := 'c';
-- If there are no characters after the 'c', then send a
-- message
-- back to the user indicating an ambiguous condition.
if LENGTH /= 1 then
case COMMAND (START + 1) is
when 'h' | 'H' =>
-- The prefix for CHARACTER has been found.
COMMAND (START + 1) := 'h';
TEMPLATE := "character";
ABSORB_CHARACTERS (COMMAND, START, TEMPLATE);
-- If the rest of the user input was matched
-- correctly,
-- then substitute the completed string.
COMMAND (START .. START + 8) := "character";
LENGTH := 9;
TERMINAL_INTERFACE.PUT_FIELD
((SIZE.LINE, 10 + START - 1), 9,
FORM_TYPES.PRIMARY_RENDITION, "character");
when 'o' | 'O' =>
-- The prefix for COPY has been found.
COMMAND (START + 1) := 'o';
TEMPLATE := "copy ";
ABSORB_CHARACTERS (COMMAND, START, TEMPLATE);
-- If the rest of the user input was matched
-- correctly,
-- then substitute the completed string.
COMMAND (START .. START + 4) := "copy ";
LENGTH := 5;
TERMINAL_INTERFACE.PUT_FIELD
((SIZE.LINE, 10 + START - 1), 5,
FORM_TYPES.PRIMARY_RENDITION, "copy ");
when 'r' | 'R' =>
-- The prefix for CREATE FIELD has been found.
COMMAND (START + 1) := 'r';
TEMPLATE := "create ";
ABSORB_CHARACTERS (COMMAND, START, TEMPLATE);
-- If the rest of the user input was matched
-- correctly,
-- then substitute the completed string.
COMMAND (START .. START + 11) := "create field";
LENGTH := 12;
TERMINAL_INTERFACE.PUT_FIELD
((SIZE.LINE, 10 + START - 1), 12,
FORM_TYPES.PRIMARY_RENDITION,
"create field");
when others =>
null;
end case;
else
TERMINAL_INTERFACE.PUT_MESSAGE
("Ambiguous - CHaracter, COpy, CReate");
end if;
when 'd' | 'D' =>
-- The prefix for DELETE has been found.
COMMAND (START) := 'd';
TEMPLATE := "delete ";
ABSORB_CHARACTERS (COMMAND, START, TEMPLATE);
-- If the rest of the user input was matched correctly,
-- then substitute the completed string.
COMMAND (START .. START + 6) := "delete ";
LENGTH := 7;
TERMINAL_INTERFACE.PUT_FIELD
((SIZE.LINE, 10 + START - 1), 7,
FORM_TYPES.PRIMARY_RENDITION, "delete ");
when 'f' | 'F' =>
-- The prefix for FIELD has been found.
COMMAND (START) := 'f';
TEMPLATE := "field ";
ABSORB_CHARACTERS (COMMAND, START, TEMPLATE);
-- If the rest of the user input was matched correctly,
-- then substitute the completed string.
COMMAND (START .. START + 4) := "field";
LENGTH := 5;
TERMINAL_INTERFACE.PUT_FIELD
((SIZE.LINE, 10 + START - 1), 5,
FORM_TYPES.PRIMARY_RENDITION, "field");
when 'h' | 'H' =>
-- The prefix for HELP has been found.
COMMAND (START) := 'h';
TEMPLATE := "help ";
ABSORB_CHARACTERS (COMMAND, START, TEMPLATE);
-- If the rest of the user input was matched correctly,
-- then substitute the completed string.
COMMAND (START .. START + 3) := "help";
LENGTH := 4;
TERMINAL_INTERFACE.PUT_FIELD
((SIZE.LINE, 10 + START - 1), 4,
FORM_TYPES.PRIMARY_RENDITION, "help");
when 'i' | 'I' =>
-- The prefix for INSERT has been found.
COMMAND (START) := 'i';
TEMPLATE := "insert ";
ABSORB_CHARACTERS (COMMAND, START, TEMPLATE);
-- If the rest of the user input was matched correctly,
-- then substitute the completed string.
COMMAND (START .. START + 6) := "insert ";
LENGTH := 7;
TERMINAL_INTERFACE.PUT_FIELD
((SIZE.LINE, 10 + START - 1), 7,
FORM_TYPES.PRIMARY_RENDITION, "insert ");
when 'l' | 'L' =>
-- The prefix for LINE has been found.
COMMAND (START) := 'l';
TEMPLATE := "line ";
ABSORB_CHARACTERS (COMMAND, START, TEMPLATE);
-- If the rest of the user input was matched correctly,
-- then substitute the completed string.
COMMAND (START .. START + 3) := "line";
LENGTH := 4;
TERMINAL_INTERFACE.PUT_FIELD
((SIZE.LINE, 10 + START - 1), 4,
FORM_TYPES.PRIMARY_RENDITION, "line");
when 'm' | 'M' =>
COMMAND (START) := 'm';
-- If there are no characters after the 'm', then send a
-- message
-- back to the user indicating an ambiguous condition.
if LENGTH /= 1 then
case COMMAND (START + 1) is
when 'o' | 'O' =>
COMMAND (START + 1) := 'o';
-- If there are no characters after the 'mo',
-- then send a message
-- back to the user indicating an ambiguous
-- condition.
if LENGTH /= 2 then
case COMMAND (START + 2) is
when 'd' | 'D' =>
-- The prefix for MODIFY FIELD has been found.
COMMAND (START + 2) := 'd';
TEMPLATE := "modify ";
ABSORB_CHARACTERS
(COMMAND, START, TEMPLATE);
-- If the rest of the user input was
-- matched correctly,
-- then substitute the completed
-- string.
COMMAND (START .. START + 11) :=
"modify field";
LENGTH := 12;
TERMINAL_INTERFACE.PUT_FIELD
((SIZE.LINE, 10 + START - 1),
12, FORM_TYPES
.PRIMARY_RENDITION,
"modify field");
when 'v' | 'V' =>
-- The prefix for MOVE has been found.
COMMAND (START + 2) := 'v';
TEMPLATE := "move ";
ABSORB_CHARACTERS
(COMMAND, START, TEMPLATE);
-- If the rest of the user input was
-- matched correctly,
-- then substitute the completed
-- string.
COMMAND (START .. START + 4) :=
"move ";
LENGTH := 5;
TERMINAL_INTERFACE.PUT_FIELD
((SIZE.LINE, 10 + START - 1),
5, FORM_TYPES.PRIMARY_RENDITION,
"move ");
when others =>
null;
end case;
else
TERMINAL_INTERFACE.PUT_MESSAGE
("Ambiguous - MODify or MOVe ?");
end if;
when others =>
null;
end case;
else
TERMINAL_INTERFACE.PUT_MESSAGE
("Ambiguous - MODify or MOVe ?");
end if;
when 'q' | 'Q' =>
-- The prefix for QUIT has been found.
COMMAND (START) := 'q';
TEMPLATE := "quit ";
ABSORB_CHARACTERS (COMMAND, START, TEMPLATE);
-- If the rest of the user input was matched correctly,
-- then substitute the completed string.
COMMAND (START .. START + 3) := "quit";
LENGTH := 4;
TERMINAL_INTERFACE.PUT_FIELD
((SIZE.LINE, 10 + START - 1), 4,
FORM_TYPES.PRIMARY_RENDITION, "quit");
when 'r' | 'R' =>
-- The prefix for RUBOUT CHARACTER has been found.
COMMAND (START) := 'r';
TEMPLATE := "rubout ";
ABSORB_CHARACTERS (COMMAND, START, TEMPLATE);
-- If the rest of the user input was matched correctly,
-- then substitute the completed string.
COMMAND (START .. START + 15) := "rubout character";
LENGTH := 16;
TERMINAL_INTERFACE.PUT_FIELD
((SIZE.LINE, 10 + START - 1), 16,
FORM_TYPES.PRIMARY_RENDITION, "rubout character");
when others =>
null;
end case;
end if;
exception
when INVALID_PREFIX =>
TERMINAL_INTERFACE.PUT_MESSAGE
("Command completion failed for current command string.");
end COMMAND_COMPLETION;
-------------------------------------------------------------------------
-- Abstract : This function compared two string to see if the contents
-- are identical. The command string is allowed to have
-- trailing blanks.
-------------------------------------------------------------------------
-- Parameters : TEMPLATE - The string begin compared to.
-- COMMAND - The command string which is being compared.
-------------------------------------------------------------------------
function EQUAL_STRINGS (TEMPLATE, COMMAND : STRING) return BOOLEAN is
INDEX : INTEGER := 1;
begin
while INDEX <= TEMPLATE'LENGTH loop
if TEMPLATE (INDEX) /= COMMAND (INDEX) then
return FALSE;
end if;
INDEX := INDEX + 1;
end loop;
return TRUE;
end EQUAL_STRINGS;
-------------------------------------------------------------------------
begin
TERMINAL_INTERFACE.SCREEN_SIZE (SIZE);
-- Put the command line prompt on the screen.
TERMINAL_INTERFACE.PUT_FIELD
((SIZE.LINE, 1), 9, FORM_TYPES.PRIMARY_RENDITION, "Command: ");
START := 1;
LENGTH := 0;
-- Keep retrieving characters until the return key is encountered.
loop
-- Position cursor and retrieve next character.
TERMINAL_INTERFACE.PUT_CURSOR ((SIZE.LINE, 10 + START + LENGTH - 1));
TERMINAL_INTERFACE.GET_CHARACTER (CHARTYPE, CHAR, FUNCT);
case CHARTYPE is
when TERMINAL_INTERFACE.TIMEOUT => null;
when TERMINAL_INTERFACE.FUNC_TYPE =>
-- Only the RETURN_KEY and RUBOUT function keys are legal.
case FUNCT is
-- Exit upon receiving the return key.
when TERMINAL_INTERFACE.RETURN_KEY =>
exit;
-- Rubout the previous character.
when TERMINAL_INTERFACE.RUBOUT =>
if START > 1 and then LENGTH = 1 then
LENGTH := START;
START := 1; -- Mark beginning of first command word.
end if;
if LENGTH > 0 then
COMMAND (START + LENGTH - 1) := ' ';
LENGTH := LENGTH - 1;
end if;
TERMINAL_INTERFACE.PUT_CHARACTER
(' ', (SIZE.LINE, 10 + START + LENGTH - 1));
when others => null;
end case;
when TERMINAL_INTERFACE.CHAR_TYPE =>
-- Only the alphabet and the blank character are legal.
case CHAR is
-- Insert the alphabet character into the current command string.
when 'a' .. 'z' | 'A' .. 'Z' =>
if LENGTH + 1 > MAX_COMMAND_LINE_LENGTH then
TERMINAL_INTERFACE.PUT_MESSAGE
("Maximum command length reached!");
else
if LENGTH /= 0 and then COMMAND (LENGTH) = ' ' then
START := LENGTH + 1;
LENGTH := 1;
else
LENGTH := LENGTH + 1;
end if;
COMMAND (START + LENGTH - 1) := CHAR;
TERMINAL_INTERFACE.PUT_CHARACTER
(CHAR, (SIZE.LINE, 10 + START + LENGTH - 2));
end if;
-- Perform command completion upon receiving the blank
-- character.
when ' ' =>
COMMAND_COMPLETION (COMMAND, START, LENGTH);
when others => null;
end case;
end case;
end loop;
COMMAND_COMPLETION (COMMAND, START, LENGTH);
TERMINAL_INTERFACE.SPLIT_DISPLAY (SIZE);
TERMINAL_INTERFACE.PUT_CURSOR
((CURSOR.LINE + CURRENT_POSITION.LINE - 1,
CURSOR.COLUMN + CURRENT_POSITION.COLUMN - 1));
-- Now, attempt to match the completed command string. If recognized, then
-- execute the respective command. If the command line is simply a blank,
-- then do nothing. Otherwise, display an Invalid Command message.
if EQUAL_STRINGS ("copy field", COMMAND) then
DUPLICATE_FIELD (COPY);
elsif EQUAL_STRINGS ("copy line", COMMAND) then
DUPLICATE_LINE (COPY);
elsif EQUAL_STRINGS ("create field", COMMAND) then
MODIFY_FIELD (CREATE);
elsif EQUAL_STRINGS ("delete character", COMMAND) then
DELETE_CHARACTER;
elsif EQUAL_STRINGS ("delete field", COMMAND) then
DELETE_FIELD;
elsif EQUAL_STRINGS ("delete line", COMMAND) then
DELETE_LINE;
elsif EQUAL_STRINGS ("help", COMMAND) then
HELP;
elsif EQUAL_STRINGS ("insert character", COMMAND) then
INSERT_CHARACTER;
elsif EQUAL_STRINGS ("insert line", COMMAND) then
INSERT_LINE;
elsif EQUAL_STRINGS ("modify field", COMMAND) then
MODIFY_FIELD (MODIFY);
elsif EQUAL_STRINGS ("move field", COMMAND) then
DUPLICATE_FIELD (MOVE);
elsif EQUAL_STRINGS ("move line", COMMAND) then
DUPLICATE_LINE (MOVE);
elsif EQUAL_STRINGS ("quit", COMMAND) then
raise EDITOR_DRIVER_EXIT;
elsif EQUAL_STRINGS ("rubout character", COMMAND) then
RUBOUT_CHARACTER;
elsif COMMAND (1) /= ' ' then
TERMINAL_INTERFACE.PUT_MESSAGE ("Invalid command.");
else
null;
end if;
exception
when CONSTRAINT_ERROR =>
TERMINAL_INTERFACE.PUT_MESSAGE
("Constraint error occurred in Command Line");
end COM_LINE;
separate (EDITOR)
procedure MODIFY_FIELD -------------------------------------------------------------------------
-- Abstract : This procedure implements the Create Field and Modify
-- Field operations on the Form Editor. These operations
-- are only operational when invoked with the cursor
-- positioned somewhere within a field. The command line
-- syntax for these operations are: CR and MOD F, respectively.
-------------------------------------------------------------------------
-- Parameters : MOD_TYPE - a tag indicating whether to execute the Create
-- Field operation or the Modify Field operation.
-------------------------------------------------------------------------
-- Algorithm : This procedure requests information regarding the creation
-- or modification of fields by using the Form Executor and
-- predefined forms to service the user interaction.
-------------------------------------------------------------------------
(MOD_TYPE : FIELD_MODIFICATION_TYPE) is
TEMP_FIELD : FORM_MANAGER.FIELD_ACCESS;
TEMP_NAME : FORM_MANAGER.FIELD_NAME;
TEMP_POS : FORM_MANAGER.FIELD_POSITION;
TEMP_LEN : FORM_MANAGER.FIELD_LENGTH;
TEMP_REND : FORM_MANAGER.FIELD_RENDITIONS;
TEMP_LIMITS : FORM_MANAGER.CHAR_TYPE;
TEMP_INIT : FORM_MANAGER.FIELD_VALUE;
TEMP_VAL : FORM_MANAGER.FIELD_VALUE;
TEMP_MODE : FORM_MANAGER.FIELD_MODE;
END_FIELD : FORM_MANAGER.FIELD_ACCESS;
NEW_FIELD : FORM_MANAGER.FIELD_ACCESS;
NEW_NAME : FORM_MANAGER.FIELD_NAME;
NEW_POS : FORM_MANAGER.FIELD_POSITION;
OLD_LEN : FORM_MANAGER.FIELD_LENGTH;
OLD_REND : FORM_MANAGER.FIELD_RENDITIONS;
OLD_LIMITS : FORM_MANAGER.CHAR_TYPE;
OLD_INIT : FORM_MANAGER.FIELD_VALUE;
OLD_MODE : FORM_MANAGER.FIELD_MODE;
ADD_IT : BOOLEAN := true;
NEXT_IS_NULL, PREV_IS_NULL : BOOLEAN := false;
SIZE : TERMINAL_INTERFACE.SCREEN_POSITION;
begin
TERMINAL_INTERFACE.SCREEN_SIZE (SIZE);
-- If Modify Field, then save the old field's attributes and values.
if MOD_TYPE = MODIFY then
FIELD := FORM_MANAGER.GET_FIELD_POINTER (CURRENT_FORM, CURSOR);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE,
VALUE, MODE);
OLD_LEN := LENGTH;
OLD_REND := RENDITION;
OLD_LIMITS := CHAR_LIMITS;
OLD_INIT := INIT_VALUE;
OLD_MODE := MODE;
if MODE = FORM_MANAGER.CONSTANT_TEXT then
raise FORM_MANAGER.FIELD_POSITION_NOT_FOUND;
end if;
-- Use the Form Executor to request the new field information
-- from the user.
FORMS.GET_FIELD_INFO
(NAME, LENGTH, CHAR_LIMITS, MODE, RENDITION, INIT_VALUE, false);
-- Delete the old field.
FORM_MANAGER.DELETE_FIELD (FIELD);
else
-- Use the Form Executor to request the new field information
-- from the user.
FORMS.GET_FIELD_INFO
(NAME, LENGTH, CHAR_LIMITS, MODE, RENDITION, INIT_VALUE, true);
POSITION := CURSOR;
end if;
-- Add the new field.
loop
begin
FORM_MANAGER.ADD_FIELD
(CURRENT_FORM, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, MODE, FIELD);
exit;
exception
-- A duplicate field name has been found, if Create Field then
-- prompt user for another field name.
when FORM_MANAGER.DUPLICATE_FIELD_NAME =>
if MOD_TYPE = CREATE then
TERMINAL_INTERFACE.PUT_MESSAGE
("Field name already exists -- choose another");
delay 0.5;
TERMINAL_INTERFACE.SPLIT_DISPLAY (SIZE);
FORMS.GET_FIELD_NAME (NAME);
else
raise;
end if;
end;
end loop;
-- Redisplay the entire form. This is to get rid of the field
-- creation/modification menu.
begin
TERMINAL_INTERFACE.CLEAR_SCREEN;
FIELD := FORM_MANAGER.GET_FIRST_FIELD (CURRENT_FORM);
loop
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
POSITION.LINE := POSITION.LINE + CURRENT_POSITION.LINE - 1;
POSITION.COLUMN := POSITION.COLUMN + CURRENT_POSITION.COLUMN - 1;
TRANSFORM_AND_PUT_FIELD
(POSITION, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE, MODE);
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
end loop;
exception
when FORM_MANAGER.FIELD_NOT_FOUND => null;
end;
exception
when FORM_MANAGER.DUPLICATE_FIELD_NAME =>
TERMINAL_INTERFACE.PUT_MESSAGE ("Duplicate field name encountered");
delay 1.0;
-- If Modify Field, then add the old field back.
if MOD_TYPE = MODIFY then
FORM_MANAGER.ADD_FIELD
(CURRENT_FORM, NAME, POSITION, OLD_LEN, OLD_REND, OLD_LIMITS,
OLD_INIT, OLD_MODE, FIELD);
end if;
-- Redisplay the entire form.
begin
TERMINAL_INTERFACE.CLEAR_SCREEN;
FIELD := FORM_MANAGER.GET_FIRST_FIELD (CURRENT_FORM);
loop
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
POSITION.LINE := POSITION.LINE + CURRENT_POSITION.LINE - 1;
POSITION.COLUMN :=
POSITION.COLUMN + CURRENT_POSITION.COLUMN - 1;
TRANSFORM_AND_PUT_FIELD
(POSITION, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE, MODE);
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
end loop;
exception
when FORM_MANAGER.FIELD_NOT_FOUND => null;
end;
when FORM_MANAGER.FIELD_POSITION_NOT_FOUND =>
TERMINAL_INTERFACE.PUT_MESSAGE ("Cursor not positioned in a field!");
delay 1.0;
-- Redisplay the entire form.
begin
TERMINAL_INTERFACE.CLEAR_SCREEN;
FIELD := FORM_MANAGER.GET_FIRST_FIELD (CURRENT_FORM);
loop
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
POSITION.LINE := POSITION.LINE + CURRENT_POSITION.LINE - 1;
POSITION.COLUMN :=
POSITION.COLUMN + CURRENT_POSITION.COLUMN - 1;
TRANSFORM_AND_PUT_FIELD
(POSITION, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE, MODE);
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
end loop;
exception
when FORM_MANAGER.FIELD_NOT_FOUND => null;
end;
when FORM_MANAGER.FIELD_EXTENDS_PAST_FORM =>
TERMINAL_INTERFACE.PUT_MESSAGE ("Field extends past form!");
delay 1.0;
-- If Modify Field, then add the old field back.
if MOD_TYPE = MODIFY then
FORM_MANAGER.ADD_FIELD
(CURRENT_FORM, NAME, POSITION, OLD_LEN, OLD_REND, OLD_LIMITS,
OLD_INIT, OLD_MODE, FIELD);
end if;
-- Redisplay the entire form.
begin
TERMINAL_INTERFACE.CLEAR_SCREEN;
FIELD := FORM_MANAGER.GET_FIRST_FIELD (CURRENT_FORM);
loop
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
POSITION.LINE := POSITION.LINE + CURRENT_POSITION.LINE - 1;
POSITION.COLUMN :=
POSITION.COLUMN + CURRENT_POSITION.COLUMN - 1;
TRANSFORM_AND_PUT_FIELD
(POSITION, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE, MODE);
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
end loop;
exception
when FORM_MANAGER.FIELD_NOT_FOUND => null;
end;
when FORM_MANAGER.FIELD_ALLOCATION_ERROR =>
TERMINAL_INTERFACE.PUT_MESSAGE ("Memory full");
delay 1.0;
-- Redisplay the entire form.
begin
TERMINAL_INTERFACE.CLEAR_SCREEN;
FIELD := FORM_MANAGER.GET_FIRST_FIELD (CURRENT_FORM);
loop
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
POSITION.LINE := POSITION.LINE + CURRENT_POSITION.LINE - 1;
POSITION.COLUMN :=
POSITION.COLUMN + CURRENT_POSITION.COLUMN - 1;
TRANSFORM_AND_PUT_FIELD
(POSITION, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE, MODE);
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
end loop;
exception
when FORM_MANAGER.FIELD_NOT_FOUND => null;
end;
when FORM_MANAGER.FIELD_OVERLAP_OCCURRED =>
-- When the new field overlapped existing fields AND the existing
-- fields were only text fields, then add the new field anyway.
-- Traverse through the form field list to a point where PREV_FIELD
-- is the field just before the cursor and, at the same time,
-- NEXT_FIELD is the field just after the cursor.
NEXT_FIELD := FORM_MANAGER.GET_FIRST_FIELD (CURRENT_FORM);
FORM_MANAGER.GET_FIELD_INFO
(NEXT_FIELD, NEXT_NAME, NEXT_POS, NEXT_LEN, NEXT_REND, NEXT_LIMITS,
NEXT_INIT, NEXT_VAL, NEXT_MODE);
begin
loop
if (POSITION.LINE > NEXT_POS.LINE or else
(POSITION.LINE = NEXT_POS.LINE and then
POSITION.COLUMN > NEXT_POS.COLUMN)) then
PREV_FIELD := NEXT_FIELD;
NEXT_FIELD := FORM_MANAGER.GET_NEXT_FIELD (PREV_FIELD);
FORM_MANAGER.GET_FIELD_INFO
(NEXT_FIELD, NEXT_NAME, NEXT_POS, NEXT_LEN, NEXT_REND,
NEXT_LIMITS, NEXT_INIT, NEXT_VAL, NEXT_MODE);
else
exit;
end if;
end loop;
exception
when FORM_MANAGER.FIELD_NOT_FOUND =>
null;
end;
-- Check to see if PREV_FIELD is on the same line as the cursor.
-- If not, then PREV_IS_NULL is true.
begin
FORM_MANAGER.GET_FIELD_INFO
(PREV_FIELD, PREV_NAME, PREV_POS, PREV_LEN, PREV_REND,
PREV_LIMITS, PREV_INIT, PREV_VAL, PREV_MODE);
if PREV_POS.LINE /= POSITION.LINE or else
PREV_POS.COLUMN >= POSITION.COLUMN then
PREV_IS_NULL := true;
end if;
exception
when FORM_MANAGER.NULL_FIELD_POINTER =>
PREV_IS_NULL := true;
end;
-- Check to see if NEXT_FIELD is on the same line as the cursor.
-- If not, then NEXT_IS_NULL is true.
begin
FORM_MANAGER.GET_FIELD_INFO
(NEXT_FIELD, NEXT_NAME, NEXT_POS, NEXT_LEN, NEXT_REND,
NEXT_LIMITS, NEXT_INIT, NEXT_VAL, NEXT_MODE);
if NEXT_POS.LINE /= POSITION.LINE then
NEXT_IS_NULL := true;
end if;
exception
when FORM_MANAGER.NULL_FIELD_POINTER =>
NEXT_IS_NULL := true;
end;
-- Check to see if the field to be added overlaps any non-text
-- fields, either before it or after it.
if not PREV_IS_NULL and then
(PREV_POS.COLUMN + PREV_LEN - 1) >= POSITION.COLUMN and then
PREV_POS.LINE = POSITION.LINE and then
PREV_MODE /= FORM_MANAGER.CONSTANT_TEXT then
ADD_IT := false;
else
begin
END_FIELD := NEXT_FIELD; -- END_FIELD indicates the last field
-- that FIELD overlaps
TEMP_FIELD := NEXT_FIELD;
FORM_MANAGER.GET_FIELD_INFO
(TEMP_FIELD, TEMP_NAME, TEMP_POS, TEMP_LEN, TEMP_REND,
TEMP_LIMITS, TEMP_INIT, TEMP_VAL, TEMP_MODE);
loop
if (POSITION.COLUMN + LENGTH - 1) >=
TEMP_POS.COLUMN and then
POSITION.LINE = TEMP_POS.LINE and then
TEMP_MODE /= FORM_MANAGER.CONSTANT_TEXT then
ADD_IT := false;
exit;
elsif TEMP_POS.COLUMN >
(POSITION.COLUMN + LENGTH - 1) or else
POSITION.LINE < TEMP_POS.LINE then
exit;
else
END_FIELD := TEMP_FIELD;
TEMP_FIELD := FORM_MANAGER.GET_NEXT_FIELD (TEMP_FIELD);
FORM_MANAGER.GET_FIELD_INFO
(TEMP_FIELD, TEMP_NAME, TEMP_POS, TEMP_LEN,
TEMP_REND, TEMP_LIMITS, TEMP_INIT, TEMP_VAL,
TEMP_MODE);
end if;
end loop;
exception
when FORM_MANAGER.FIELD_NOT_FOUND => null;
end;
end if;
-- Check to see if it is o.k. to add the field.
if ADD_IT then
if not PREV_IS_NULL and then
(PREV_POS.COLUMN + PREV_LEN - 1) >
(POSITION.COLUMN + LENGTH - 1) then
TEMP_POS.COLUMN := PREV_POS.COLUMN + PREV_LEN - 1;
-- Add the new field into the middle of PREV_FIELD.
TEMP_POS.LINE := PREV_POS.LINE;
FORM_MANAGER.MODIFY_FIELD_LENGTH
(PREV_FIELD, POSITION.COLUMN - PREV_POS.COLUMN);
TEMP_INIT := PREV_INIT
((POSITION.COLUMN + LENGTH) -
PREV_POS.COLUMN + 1 .. PREV_LEN) &
(TEMP_POS.COLUMN - (POSITION.COLUMN + LENGTH) +
2 .. FORM_MANAGER.MAX_FIELD_VALUE => ' ');
FORM_MANAGER.ADD_FIELD
(CURRENT_FORM, PREV_NAME,
(POSITION.LINE, POSITION.COLUMN + LENGTH),
TEMP_POS.COLUMN - (POSITION.COLUMN + LENGTH) + 1,
PREV_REND, PREV_LIMITS, TEMP_INIT, PREV_MODE, TEMP_FIELD);
TRANSFORM_AND_PUT_FIELD
((CURRENT_POSITION.LINE + POSITION.LINE - 1,
CURRENT_POSITION.COLUMN + POSITION.COLUMN + LENGTH - 1),
TEMP_POS.COLUMN - (POSITION.COLUMN + LENGTH) + 1,
PREV_REND, PREV_LIMITS, TEMP_INIT, PREV_MODE);
elsif not PREV_IS_NULL and then
(PREV_POS.COLUMN + PREV_LEN - 1) >= POSITION.COLUMN then
-- The new field overlaps with the end of PREV_FIELD only.
FORM_MANAGER.MODIFY_FIELD_LENGTH
(PREV_FIELD, POSITION.COLUMN - PREV_POS.COLUMN);
else
-- The new field overlaps some of the following fields.
-- So, delete the fields that the new field entirely overlaps
-- and modify the value and length of the following field that
-- is only partially covered.
while NEXT_FIELD /= END_FIELD loop
TEMP_FIELD := FORM_MANAGER.GET_NEXT_FIELD (NEXT_FIELD);
FORM_MANAGER.DELETE_FIELD (NEXT_FIELD);
NEXT_FIELD := TEMP_FIELD;
end loop;
begin
TEMP_LEN := NEXT_LEN;
NEXT_LEN :=
(NEXT_POS.COLUMN + NEXT_LEN) - (POSITION.COLUMN + LENGTH);
NEXT_INIT :=
NEXT_INIT
(POSITION.COLUMN + LENGTH - NEXT_POS.COLUMN + 1 ..
TEMP_LEN) &
(NEXT_LEN + 1 .. FORM_MANAGER.MAX_FIELD_VALUE => ' ');
FORM_MANAGER.DELETE_FIELD (NEXT_FIELD);
FORM_MANAGER.ADD_FIELD
(CURRENT_FORM, NEXT_NAME,
(POSITION.LINE, POSITION.COLUMN + LENGTH), NEXT_LEN,
NEXT_REND, NEXT_LIMITS, NEXT_INIT, NEXT_MODE,
NEXT_FIELD);
exception
when CONSTRAINT_ERROR =>
FORM_MANAGER.DELETE_FIELD (NEXT_FIELD);
end;
end if;
FORM_MANAGER.ADD_FIELD
(CURRENT_FORM, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, MODE, FIELD);
-- Update the terminal display.
NEW_POS.LINE := POSITION.LINE + CURRENT_POSITION.LINE - 1;
NEW_POS.COLUMN := POSITION.COLUMN + CURRENT_POSITION.COLUMN - 1;
TRANSFORM_AND_PUT_FIELD
(NEW_POS, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE, MODE);
else
TERMINAL_INTERFACE.PUT_MESSAGE
("New field overlaps existing fields!");
delay 1.0;
TERMINAL_INTERFACE.PUT_MESSAGE ("Not creating new field!!");
-- If Modify Field, the add the old field back again.
if MOD_TYPE = MODIFY then
FORM_MANAGER.ADD_FIELD
(CURRENT_FORM, NAME, POSITION, OLD_LEN, OLD_REND,
OLD_LIMITS, OLD_INIT, OLD_MODE, FIELD);
end if;
end if;
-- Redisplay the entire form.
begin
TERMINAL_INTERFACE.CLEAR_SCREEN;
FIELD := FORM_MANAGER.GET_FIRST_FIELD (CURRENT_FORM);
loop
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
POSITION.LINE := POSITION.LINE + CURRENT_POSITION.LINE - 1;
POSITION.COLUMN :=
POSITION.COLUMN + CURRENT_POSITION.COLUMN - 1;
TRANSFORM_AND_PUT_FIELD
(POSITION, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE, MODE);
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
end loop;
exception
when FORM_MANAGER.FIELD_NOT_FOUND => null;
end;
end MODIFY_FIELD;
separate (EDITOR)
procedure DUPLICATE_FIELD ------------------------------------------------------
-------------------
-- Abstract : This procedure implements the Move Field and Copy Field
-- operations of the Form Editor. The cursor must be within
-- the confines of a field before either of these operations
-- will work. Command line syntax for these operations:
-- MOV F and CO F, respectively.
-------------------------------------------------------------------------
-- Parameters : DUP_TYPE - tag for determining whether to execute the
-- Move Field or the Copy Field operation.
-------------------------------------------------------------------------
(DUP_TYPE : FIELD_DUPLICATION_TYPE) is
-- Temporary field variables for inserting a field into the
-- middle of a text field.
TEMP_FIELD : FORM_MANAGER.FIELD_ACCESS;
TEMP_NAME : FORM_MANAGER.FIELD_NAME;
TEMP_POS : FORM_MANAGER.FIELD_POSITION;
TEMP_LEN : FORM_MANAGER.FIELD_LENGTH;
TEMP_REND : FORM_MANAGER.FIELD_RENDITIONS;
TEMP_LIMITS : FORM_MANAGER.CHAR_TYPE;
TEMP_INIT : FORM_MANAGER.FIELD_VALUE;
TEMP_VAL : FORM_MANAGER.FIELD_VALUE;
TEMP_MODE : FORM_MANAGER.FIELD_MODE;
END_FIELD : FORM_MANAGER.FIELD_ACCESS;
NEW_FIELD : FORM_MANAGER.FIELD_ACCESS;
NEW_NAME : FORM_MANAGER.FIELD_NAME;
NEW_POS : FORM_MANAGER.FIELD_POSITION;
ADD_IT : BOOLEAN := true;
NEXT_IS_NULL, PREV_IS_NULL : BOOLEAN := false;
SIZE : TERMINAL_INTERFACE.SCREEN_POSITION;
begin
TERMINAL_INTERFACE.SCREEN_SIZE (SIZE);
-- Check to see if the cursor positioned within a field at all.
FIELD := FORM_MANAGER.GET_FIELD_POINTER (CURRENT_FORM, CURSOR);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE,
VALUE, MODE);
-- Also check to see if it is a non-text field. If not, raise
-- an exception.
if MODE = FORM_MANAGER.CONSTANT_TEXT then
raise FORM_MANAGER.FIELD_POSITION_NOT_FOUND;
end if;
-- Request user to indicate, using the arrow keys, the beginning of the
-- new field location.
TERMINAL_INTERFACE.PUT_MESSAGE
("Position cursor at beginning of new field position");
delay 1.0;
TERMINAL_INTERFACE.PUT_MESSAGE
("Use the arrow keys...terminate with the return key");
GET_CURSOR_POSITION (CURSOR, NEW_POS);
-- Clear message line.
TERMINAL_INTERFACE.SPLIT_DISPLAY (SIZE);
if DUP_TYPE = MOVE then
-- If Move Field, then delete field at OLD location and add it back
-- at the NEW location.
FORM_MANAGER.DELETE_FIELD (FIELD);
FORM_MANAGER.ADD_FIELD
(CURRENT_FORM, NAME, NEW_POS, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, MODE, NEW_FIELD);
else
-- If Copy Field, then request the name of the new copied field
-- and then add the new field.
loop
begin
FORM_EXECUTOR.PRESENT_FORM (FORMS.FIELD_NAME_MENU);
FORM_EXECUTOR.QUERY_FIELD
(FORMS.FIELD_NAME_MENU, "Field Name", NEW_NAME);
FORM_MANAGER.ADD_FIELD
(CURRENT_FORM, NEW_NAME, NEW_POS, LENGTH, RENDITION,
CHAR_LIMITS, INIT_VALUE, MODE, NEW_FIELD);
exit;
exception
when FORM_MANAGER.DUPLICATE_FIELD_NAME =>
TERMINAL_INTERFACE.PUT_MESSAGE
("Field name already exists - choose another");
delay 0.5;
TERMINAL_INTERFACE.SPLIT_DISPLAY (SIZE);
end;
end loop;
end if;
-- Update the cursor position to the beginning of the new field.
CURSOR := NEW_POS;
-- Update the terminal display.
POSITION.LINE := POSITION.LINE + CURRENT_POSITION.LINE - 1;
POSITION.COLUMN := POSITION.COLUMN + CURRENT_POSITION.COLUMN - 1;
NEW_POS.LINE := NEW_POS.LINE + CURRENT_POSITION.LINE - 1;
NEW_POS.COLUMN := NEW_POS.COLUMN + CURRENT_POSITION.COLUMN - 1;
if DUP_TYPE = MOVE then
TERMINAL_INTERFACE.ERASE_FIELD (POSITION, LENGTH);
end if;
TRANSFORM_AND_PUT_FIELD
(NEW_POS, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE, MODE);
exception
when FORM_MANAGER.FIELD_POSITION_NOT_FOUND =>
TERMINAL_INTERFACE.PUT_MESSAGE ("Cursor not positioned in a field!");
when FORM_MANAGER.FIELD_EXTENDS_PAST_FORM =>
TERMINAL_INTERFACE.PUT_MESSAGE ("New field extends past form boundary");
delay 1.0;
TERMINAL_INTERFACE.PUT_MESSAGE ("Not creating new field!!");
-- If Move Field, then add the old field back.
if DUP_TYPE = MOVE then
FORM_MANAGER.ADD_FIELD
(CURRENT_FORM, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, MODE, FIELD);
end if;
delay 1.0;
TERMINAL_INTERFACE.SPLIT_DISPLAY (SIZE);
when FORM_MANAGER.DUPLICATE_FIELD_NAME =>
TERMINAL_INTERFACE.PUT_MESSAGE ("Duplicate field name encountered");
delay 1.0;
TERMINAL_INTERFACE.PUT_MESSAGE ("Not creating new field!!");
-- If Move Field, then add the old field back.
if DUP_TYPE = MOVE then
FORM_MANAGER.ADD_FIELD
(CURRENT_FORM, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, MODE, FIELD);
end if;
delay 1.0;
TERMINAL_INTERFACE.SPLIT_DISPLAY (SIZE);
when FORM_MANAGER.FIELD_OVERLAP_OCCURRED =>
-- If the added field overlapped existing fields AND these existing
-- fields were simply TEXT fields, then add the field anyway.
-- Traverse through the field list until PREV_FIELD is the field
-- whose beginning is just before the NEW_POS, while at the
-- same time, NEXT_FIELD is the field whose beginning is just
-- after the NEW_POS in the list structure.
NEXT_FIELD := FORM_MANAGER.GET_FIRST_FIELD (CURRENT_FORM);
FORM_MANAGER.GET_FIELD_INFO
(NEXT_FIELD, NEXT_NAME, NEXT_POS, NEXT_LEN, NEXT_REND, NEXT_LIMITS,
NEXT_INIT, NEXT_VAL, NEXT_MODE);
begin
loop
if (NEW_POS.LINE > NEXT_POS.LINE or else
(NEW_POS.LINE = NEXT_POS.LINE and then
NEW_POS.COLUMN > NEXT_POS.COLUMN)) then
PREV_FIELD := NEXT_FIELD;
NEXT_FIELD := FORM_MANAGER.GET_NEXT_FIELD (PREV_FIELD);
FORM_MANAGER.GET_FIELD_INFO
(NEXT_FIELD, NEXT_NAME, NEXT_POS, NEXT_LEN, NEXT_REND,
NEXT_LIMITS, NEXT_INIT, NEXT_VAL, NEXT_MODE);
else
exit;
end if;
end loop;
exception
when FORM_MANAGER.FIELD_NOT_FOUND =>
null;
end;
-- Check to see if the PREV_FIELD is on the same line as the NEW_POS.
begin
FORM_MANAGER.GET_FIELD_INFO
(PREV_FIELD, PREV_NAME, PREV_POS, PREV_LEN, PREV_REND,
PREV_LIMITS, PREV_INIT, PREV_VAL, PREV_MODE);
if PREV_POS.LINE /= NEW_POS.LINE or else
PREV_POS.COLUMN >= NEW_POS.COLUMN then
PREV_IS_NULL := true;
end if;
exception
when FORM_MANAGER.NULL_FIELD_POINTER =>
PREV_IS_NULL := true;
end;
-- Check to see if the NEXT_FIELD is on the same line as the NEW_POS.
-- If not, then NEXT_IS_NULL is true.
begin
FORM_MANAGER.GET_FIELD_INFO
(NEXT_FIELD, NEXT_NAME, NEXT_POS, NEXT_LEN, NEXT_REND,
NEXT_LIMITS, NEXT_INIT, NEXT_VAL, NEXT_MODE);
if NEXT_POS.LINE /= NEW_POS.LINE then
NEXT_IS_NULL := true;
end if;
exception
when FORM_MANAGER.NULL_FIELD_POINTER =>
NEXT_IS_NULL := true;
end;
-- If the previous field overlaps the new field and the previous
-- field is not text, then don't add the new field.
if not PREV_IS_NULL and then
(PREV_POS.COLUMN + PREV_LEN - 1) >= NEW_POS.COLUMN and then
PREV_POS.LINE = NEW_POS.LINE and then
PREV_MODE /= FORM_MANAGER.CONSTANT_TEXT then
ADD_IT := false;
else
-- Check to see if the new field overlap ANY non-text fields
-- ahead of it.
begin
END_FIELD := NEXT_FIELD;
TEMP_FIELD := NEXT_FIELD;
FORM_MANAGER.GET_FIELD_INFO
(TEMP_FIELD, TEMP_NAME, TEMP_POS, TEMP_LEN, TEMP_REND,
TEMP_LIMITS, TEMP_INIT, TEMP_VAL, TEMP_MODE);
loop
if (NEW_POS.COLUMN + LENGTH - 1) >= TEMP_POS.COLUMN and then
NEW_POS.LINE = TEMP_POS.LINE and then
TEMP_MODE /= FORM_MANAGER.CONSTANT_TEXT then
ADD_IT := false;
exit;
elsif TEMP_POS.COLUMN >
(NEW_POS.COLUMN + LENGTH - 1) or else
NEW_POS.LINE < TEMP_POS.LINE then
exit;
else
END_FIELD := TEMP_FIELD;
TEMP_FIELD := FORM_MANAGER.GET_NEXT_FIELD (TEMP_FIELD);
FORM_MANAGER.GET_FIELD_INFO
(TEMP_FIELD, TEMP_NAME, TEMP_POS, TEMP_LEN,
TEMP_REND, TEMP_LIMITS, TEMP_INIT, TEMP_VAL,
TEMP_MODE);
end if;
end loop;
exception
when FORM_MANAGER.FIELD_NOT_FOUND => null;
end;
end if;
-- If it is o.k. to add it, then ADD IT!
if ADD_IT then
if not PREV_IS_NULL and then
(PREV_POS.COLUMN + PREV_LEN - 1) >
(NEW_POS.COLUMN + LENGTH - 1) then
-- The new field is being inserted into the middle of the
-- previous field AND the previous field is a text field.
TEMP_POS.COLUMN := PREV_POS.COLUMN + PREV_LEN - 1;
TEMP_POS.LINE := PREV_POS.LINE;
FORM_MANAGER.MODIFY_FIELD_LENGTH
(PREV_FIELD, NEW_POS.COLUMN - PREV_POS.COLUMN);
TEMP_INIT := PREV_INIT
((NEW_POS.COLUMN + LENGTH) - PREV_POS.COLUMN +
1 .. PREV_LEN) &
(TEMP_POS.COLUMN - (NEW_POS.COLUMN + LENGTH) + 2 ..
FORM_MANAGER.MAX_FIELD_VALUE => ' ');
FORM_MANAGER.ADD_FIELD
(CURRENT_FORM, PREV_NAME,
(NEW_POS.LINE, NEW_POS.COLUMN + LENGTH),
TEMP_POS.COLUMN - (NEW_POS.COLUMN + LENGTH) + 1,
PREV_REND, PREV_LIMITS, TEMP_INIT, PREV_MODE, TEMP_FIELD);
TRANSFORM_AND_PUT_FIELD
((CURRENT_POSITION.LINE + NEW_POS.LINE - 1,
CURRENT_POSITION.COLUMN + NEW_POS.COLUMN + LENGTH - 1),
TEMP_POS.COLUMN - (NEW_POS.COLUMN + LENGTH) + 1,
PREV_REND, PREV_LIMITS, TEMP_INIT, PREV_MODE);
elsif not PREV_IS_NULL and then
(PREV_POS.COLUMN + PREV_LEN - 1) >= NEW_POS.COLUMN then
-- The new field is going to overlap the end of the previous
-- field AND the previous field is a text field.
FORM_MANAGER.MODIFY_FIELD_LENGTH
(PREV_FIELD, NEW_POS.COLUMN - PREV_POS.COLUMN);
else
-- The new field is going to overlap some of the next fields
-- and they are all going to be text fields.
begin
while NEXT_FIELD /= END_FIELD loop
TEMP_FIELD := FORM_MANAGER.GET_NEXT_FIELD (NEXT_FIELD);
FORM_MANAGER.DELETE_FIELD (NEXT_FIELD);
NEXT_FIELD := TEMP_FIELD;
end loop;
TEMP_LEN := NEXT_LEN;
NEXT_LEN :=
(NEXT_POS.COLUMN + NEXT_LEN) - (NEW_POS.COLUMN + LENGTH);
NEXT_INIT :=
NEXT_INIT
(NEW_POS.COLUMN + LENGTH - NEXT_POS.COLUMN + 1 ..
TEMP_LEN) &
(NEXT_LEN + 1 .. FORM_MANAGER.MAX_FIELD_VALUE => ' ');
FORM_MANAGER.DELETE_FIELD (NEXT_FIELD);
FORM_MANAGER.ADD_FIELD
(CURRENT_FORM, NEXT_NAME,
(NEW_POS.LINE, NEW_POS.COLUMN + LENGTH), NEXT_LEN,
NEXT_REND, NEXT_LIMITS, NEXT_INIT, NEXT_MODE,
NEXT_FIELD);
exception
when CONSTRAINT_ERROR =>
FORM_MANAGER.DELETE_FIELD (NEXT_FIELD);
end;
end if;
if DUP_TYPE = COPY then
NAME := NEW_NAME;
end if;
-- Add the new field.
FORM_MANAGER.ADD_FIELD
(CURRENT_FORM, NAME, NEW_POS, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, MODE, FIELD);
-- Update the cursor position and the terminal display.
CURSOR := NEW_POS;
POSITION.LINE := POSITION.LINE + CURRENT_POSITION.LINE - 1;
POSITION.COLUMN := POSITION.COLUMN + CURRENT_POSITION.COLUMN - 1;
NEW_POS.LINE := NEW_POS.LINE + CURRENT_POSITION.LINE - 1;
NEW_POS.COLUMN := NEW_POS.COLUMN + CURRENT_POSITION.COLUMN - 1;
if DUP_TYPE = MOVE then
TERMINAL_INTERFACE.ERASE_FIELD (POSITION, LENGTH);
end if;
TRANSFORM_AND_PUT_FIELD
(NEW_POS, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE, MODE);
-- Clear the message line.
TERMINAL_INTERFACE.SPLIT_DISPLAY (SIZE);
else
TERMINAL_INTERFACE.PUT_MESSAGE
("New field overlaps existing fields!");
delay 1.0;
TERMINAL_INTERFACE.PUT_MESSAGE ("Not creating new field!!");
-- If Move Field, then add the old field back.
if DUP_TYPE = MOVE then
FORM_MANAGER.ADD_FIELD
(CURRENT_FORM, NAME, POSITION, LENGTH, RENDITION,
CHAR_LIMITS, INIT_VALUE, MODE, FIELD);
end if;
delay 1.0;
TERMINAL_INTERFACE.SPLIT_DISPLAY (SIZE);
end if;
end DUPLICATE_FIELD;
separate (EDITOR)
procedure DELETE_FIELD -------------------------------------------------------------------------
-- Abstract : This procedure implements the Delete Field operation on
-- the Form Editor. The cursor must be placed somewhere
-- within the confines of a field before this operation will
-- work. Command Line abbreviation: D F
-------------------------------------------------------------------------
-- Parameters : none.
-------------------------------------------------------------------------
is
begin
-- Check to see if the cursor is positioned within a field.
FIELD := FORM_MANAGER.GET_FIELD_POINTER (CURRENT_FORM, CURSOR);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE,
VALUE, MODE);
-- Also make sure that the cursor is positioned within a non-text field.
if MODE = FORM_MANAGER.CONSTANT_TEXT then
raise FORM_MANAGER.FIELD_POSITION_NOT_FOUND;
end if;
-- Delete the field from the form structure.
FORM_MANAGER.DELETE_FIELD (FIELD);
-- Update the terminal display.
POSITION.LINE := POSITION.LINE + CURRENT_POSITION.LINE - 1;
POSITION.COLUMN := POSITION.COLUMN + CURRENT_POSITION.COLUMN - 1;
TERMINAL_INTERFACE.ERASE_FIELD (POSITION, LENGTH);
exception
when FORM_MANAGER.FIELD_POSITION_NOT_FOUND =>
TERMINAL_INTERFACE.PUT_MESSAGE ("Cursor not positioned in a field!");
end DELETE_FIELD;
separate (EDITOR)
procedure INSERT_LINE -------------------------------------------------------------------------
-- Abstract : This procedure implements the Insert Line operation of
-- the Form Editor. Command line abbreviation: I L
-------------------------------------------------------------------------
-- Parameters : none.
-------------------------------------------------------------------------
-- Algorithm : This procedure inserts a blank line above the line that
-- the cursor was positioned on. This line and rest of the
-- lines below it are shifted down one line. The cursor
-- will be positioned on this new blank line. If there
-- exists any non-text fields on the last line of the form,
-- then this insert line operation will not work.
-------------------------------------------------------------------------
is
TEMP_FIELD : FORM_MANAGER.FIELD_ACCESS;
FIELDS_FOUND_ON_LAST_LINE : exception;
CLEAR_LAST_LINE : exception;
begin
-- Locate the first field with a line number greater than or equal
-- to the cursor's line number.
FIELD := FORM_MANAGER.GET_FIRST_FIELD (CURRENT_FORM);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE,
VALUE, MODE);
while POSITION.LINE < CURSOR.LINE loop
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE,
VALUE, MODE);
end loop;
TEMP_FIELD := FIELD;
-- Raise an exception if there exists any fields on the last line
-- of the form.
begin
loop
if POSITION.LINE = CURRENT_SIZE.ROWS and then
MODE /= FORM_MANAGER.CONSTANT_TEXT then
raise FIELDS_FOUND_ON_LAST_LINE;
end if;
PREV_FIELD := FIELD;
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
end loop;
exception
when FORM_MANAGER.FIELD_NOT_FOUND =>
null;
end;
FIELD := PREV_FIELD;
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE,
VALUE, MODE);
begin
-- Clear the last line of the form.
while POSITION.LINE = CURRENT_SIZE.ROWS loop
if TEMP_FIELD = FIELD then
raise CLEAR_LAST_LINE;
end if;
PREV_FIELD := FORM_MANAGER.GET_PREVIOUS_FIELD (FIELD);
TERMINAL_INTERFACE.ERASE_FIELD
((POSITION.LINE + CURRENT_POSITION.LINE - 1,
POSITION.COLUMN + CURRENT_POSITION.COLUMN - 1), LENGTH);
FORM_MANAGER.DELETE_FIELD (FIELD);
FIELD := PREV_FIELD;
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
end loop;
exception
when CLEAR_LAST_LINE =>
FORM_MANAGER.DELETE_FIELD (FIELD);
TERMINAL_INTERFACE.ERASE_FIELD
((POSITION.LINE + CURRENT_POSITION.LINE - 1,
POSITION.COLUMN + CURRENT_POSITION.COLUMN - 1), LENGTH);
raise;
end;
-- Move the rest of the fields from the end form to the cursor's line
-- down one line position.
while FIELD /= TEMP_FIELD loop
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE,
VALUE, MODE);
FORM_MANAGER.MOVE_FIELD (FIELD, (POSITION.LINE + 1, POSITION.COLUMN));
FIELD := FORM_MANAGER.GET_PREVIOUS_FIELD (FIELD);
end loop;
if POSITION.LINE < CURRENT_SIZE.ROWS then
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE,
VALUE, MODE);
FORM_MANAGER.MOVE_FIELD (FIELD, (POSITION.LINE + 1, POSITION.COLUMN));
end if;
-- Update the terminal display.
TERMINAL_INTERFACE.SPLIT_DISPLAY
((CURRENT_POSITION.LINE + CURSOR.LINE - 1,
CURRENT_POSITION.COLUMN + CURSOR.COLUMN - 1));
exception
when FORM_MANAGER.FIELD_NOT_FOUND => null;
when FIELDS_FOUND_ON_LAST_LINE =>
TERMINAL_INTERFACE.PUT_MESSAGE ("Must clear field from last line!");
when CLEAR_LAST_LINE =>
TERMINAL_INTERFACE.SPLIT_DISPLAY
((CURRENT_POSITION.LINE + CURSOR.LINE - 1,
CURRENT_POSITION.COLUMN + CURSOR.COLUMN - 1));
end INSERT_LINE;
separate (EDITOR)
procedure DUPLICATE_LINE -------------------------------------------------------
------------------
-- Abstract : This procedure implements the Move Line and Copy Line
-- operations of the Form Editor. The syntax for these
-- commands are: MOV L and CO L, respectively.
-------------------------------------------------------------------------
-- Parameters : DUP_TYPE - tag for determining whether to execute the
-- Move Line or Copy Line command.
-------------------------------------------------------------------------
-- Algorithm : This procedure either moves or copies a form line.
-- The move and copy operations are almost identical except
-- that the copy does not delete the copied line and it
-- also request new field names for the non-text fields of
-- the copied line.
-------------------------------------------------------------------------
(DUP_TYPE : LINE_DUPLICATION_TYPE) is
-- Temporary field storage structures for storing the line that
-- is being copied or moved.
type LINE_REC;
type LINE_REC_ACCESS is access LINE_REC;
type LINE_REC is
record
NAME : FORM_MANAGER.FIELD_NAME;
POSITION : FORM_MANAGER.FIELD_POSITION;
LENGTH : FORM_MANAGER.FIELD_LENGTH;
RENDITION : FORM_MANAGER.FIELD_RENDITIONS;
CHAR_LIMITS : FORM_MANAGER.CHAR_TYPE;
INIT_VALUE : FORM_MANAGER.FIELD_VALUE;
VALUE : FORM_MANAGER.FIELD_VALUE;
MODE : FORM_MANAGER.FIELD_MODE;
NEXT_FIELD : LINE_REC_ACCESS := null;
end record;
SIZE : TERMINAL_INTERFACE.SCREEN_POSITION;
LINE, CURRENT_FIELD : LINE_REC_ACCESS;
NEW_POS : FORM_MANAGER.FIELD_POSITION;
TEMP_FIELD : FORM_MANAGER.FIELD_ACCESS;
TEMP_POS : FORM_MANAGER.FIELD_POSITION;
CLEAR_LAST_LINE : exception;
FIELDS_FOUND_ON_LAST_LINE : exception;
begin
TERMINAL_INTERFACE.SCREEN_SIZE (SIZE);
-- Request user to identify new line using the arrow keys.
TERMINAL_INTERFACE.PUT_MESSAGE
("Use arrow keys to locate new line position.");
GET_CURSOR_POSITION (CURSOR, NEW_POS);
-- Clear the message line.
TERMINAL_INTERFACE.SPLIT_DISPLAY (SIZE);
-- Ignore everything if the newly indicated line is the same as the
-- original cursor's line.
if CURSOR.LINE /= NEW_POS.LINE then
-- If Copy Line, check to see if non-text fields exist on the
-- last form line.
if DUP_TYPE = COPY then
begin
FIELD := FORM_MANAGER.GET_FIRST_FIELD
(CURRENT_FORM, CURRENT_SIZE.ROWS);
loop
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
-- If so, raise an exception.
if MODE /= FORM_MANAGER.CONSTANT_TEXT then
raise FIELDS_FOUND_ON_LAST_LINE;
end if;
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
end loop;
exception
when FORM_MANAGER.FIELD_NOT_FOUND => null;
end;
end if;
-- Save the line that is being moved or copied in a temporary
-- linked list storage structure.
begin
FIELD := FORM_MANAGER.GET_FIRST_FIELD (CURRENT_FORM, CURSOR.LINE);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
LINE := new LINE_REC;
LINE.NAME := NAME;
LINE.POSITION := POSITION;
LINE.LENGTH := LENGTH;
LINE.RENDITION := RENDITION;
LINE.CHAR_LIMITS := CHAR_LIMITS;
LINE.INIT_VALUE := INIT_VALUE;
LINE.VALUE := VALUE;
LINE.MODE := MODE;
CURRENT_FIELD := LINE;
begin
loop
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
if POSITION.LINE = CURSOR.LINE then
CURRENT_FIELD.NEXT_FIELD := new LINE_REC;
CURRENT_FIELD := CURRENT_FIELD.NEXT_FIELD;
CURRENT_FIELD.NAME := NAME;
CURRENT_FIELD.POSITION := POSITION;
CURRENT_FIELD.LENGTH := LENGTH;
CURRENT_FIELD.RENDITION := RENDITION;
CURRENT_FIELD.CHAR_LIMITS := CHAR_LIMITS;
CURRENT_FIELD.INIT_VALUE := INIT_VALUE;
CURRENT_FIELD.VALUE := VALUE;
CURRENT_FIELD.MODE := MODE;
end if;
end loop;
exception
when FORM_MANAGER.FIELD_NOT_FOUND => null;
end;
exception
when FORM_MANAGER.FIELD_NOT_FOUND =>
-- This means that there was nothing on the moved or copied line.
LINE := null;
end;
-- If Move Line, then delete the line on which the cursor was
-- originally located.
if DUP_TYPE = MOVE then
begin
FIELD := FORM_MANAGER.GET_FIRST_FIELD
(CURRENT_FORM, CURSOR.LINE);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
while POSITION.LINE = CURSOR.LINE loop
-- Delete cursor line's fields.
FORM_MANAGER.DELETE_FIELD (FIELD);
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
end loop;
-- Move the rest up one line.
begin
loop
FORM_MANAGER.MOVE_FIELD
(FIELD, (POSITION.LINE - 1, POSITION.COLUMN));
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION,
CHAR_LIMITS, INIT_VALUE, VALUE, MODE);
end loop;
exception
-- These should NEVER happen!!!
when FORM_MANAGER.FIELD_OVERLAP_OCCURRED =>
TERMINAL_INTERFACE.PUT_MESSAGE
("Internal move line error.");
when FORM_MANAGER.FIELD_EXTENDS_PAST_FORM =>
TERMINAL_INTERFACE.PUT_MESSAGE
("Internal move line error.");
end;
exception
when FORM_MANAGER.FIELD_NOT_FOUND =>
null;
end;
if CURSOR.LINE < NEW_POS.LINE then
NEW_POS.LINE := NEW_POS.LINE - 1;
end if;
-- Update the terminal display to reflect the deleted line.
TERMINAL_INTERFACE.CLOSE_UP_DISPLAY
((CURSOR.LINE + CURRENT_POSITION.LINE - 1,
CURSOR.COLUMN + CURRENT_POSITION.COLUMN - 1));
end if;
-- Now, insert a blank line above the line indicated by the new
-- cursor position.
begin
-- Locate the fields at or below new cursor's line.
FIELD := FORM_MANAGER.GET_FIRST_FIELD (CURRENT_FORM);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
while POSITION.LINE < NEW_POS.LINE loop
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
end loop;
TEMP_FIELD := FIELD; -- First field at or below new cursor's line.
-- Locate last form field.
begin
loop
PREV_FIELD := FIELD;
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
end loop;
exception
when FORM_MANAGER.FIELD_NOT_FOUND =>
null;
end;
-- Delete fields located on the last form line and update the
-- the terminal display to reflect these deletes.
-- (Note: if this is Move Line, then there will not be any
-- fields on the last form line.)
FIELD := PREV_FIELD;
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
begin
while POSITION.LINE = CURRENT_SIZE.ROWS loop
if TEMP_FIELD = FIELD then
raise CLEAR_LAST_LINE;
end if;
PREV_FIELD := FORM_MANAGER.GET_PREVIOUS_FIELD (FIELD);
FORM_MANAGER.DELETE_FIELD (FIELD);
TERMINAL_INTERFACE.ERASE_FIELD
((POSITION.LINE + CURRENT_POSITION.LINE - 1,
POSITION.COLUMN + CURRENT_POSITION.COLUMN - 1),
LENGTH);
FIELD := PREV_FIELD;
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
end loop;
exception
when CLEAR_LAST_LINE =>
FORM_MANAGER.DELETE_FIELD (FIELD);
TERMINAL_INTERFACE.ERASE_FIELD
((POSITION.LINE + CURRENT_POSITION.LINE - 1,
POSITION.COLUMN + CURRENT_POSITION.COLUMN - 1),
LENGTH);
raise;
end;
-- Move the rest of the fields from the end of the form up to
-- the first field of the new cursor's line down one line
-- position.
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
while FIELD /= TEMP_FIELD loop
FORM_MANAGER.MOVE_FIELD
(FIELD, (POSITION.LINE + 1, POSITION.COLUMN));
FIELD := FORM_MANAGER.GET_PREVIOUS_FIELD (FIELD);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
end loop;
if POSITION.LINE < CURRENT_SIZE.ROWS then
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
FORM_MANAGER.MOVE_FIELD
(FIELD, (POSITION.LINE + 1, POSITION.COLUMN));
end if;
-- Update the terminal display to reflect this line insert.
TERMINAL_INTERFACE.SPLIT_DISPLAY
((CURRENT_POSITION.LINE + NEW_POS.LINE - 1,
CURRENT_POSITION.COLUMN + NEW_POS.COLUMN - 1));
exception
when FORM_MANAGER.FIELD_NOT_FOUND => null;
when FIELDS_FOUND_ON_LAST_LINE =>
TERMINAL_INTERFACE.PUT_MESSAGE
("Must clear field from last line!");
when CLEAR_LAST_LINE =>
TERMINAL_INTERFACE.SPLIT_DISPLAY
((CURRENT_POSITION.LINE + NEW_POS.LINE - 1,
CURRENT_POSITION.COLUMN + NEW_POS.COLUMN - 1));
end;
-- Insert the saved fields into this new blank line.
CURRENT_FIELD := LINE;
while CURRENT_FIELD /= null loop
-- If Copy Line, then request new names for all of the non-text
-- fields.
if DUP_TYPE = COPY and then
CURRENT_FIELD.MODE /= FORM_MANAGER.CONSTANT_TEXT then
-- Highlight the field corresponding to the requested name.
TRANSFORM_AND_PUT_FIELD
((NEW_POS.LINE + CURRENT_POSITION.LINE - 1,
CURRENT_FIELD.POSITION.COLUMN + CURRENT_POSITION.COLUMN -
1), CURRENT_FIELD.LENGTH, FORM_TYPES.REVERSE_RENDITION,
CURRENT_FIELD.CHAR_LIMITS, CURRENT_FIELD.INIT_VALUE,
CURRENT_FIELD.MODE);
TERMINAL_INTERFACE.PUT_MESSAGE ("Enter name for this field.");
FORMS.GET_FIELD_NAME (CURRENT_FIELD.NAME);
end if;
-- Add the field to the form structure.
loop
begin
FORM_MANAGER.ADD_FIELD
(CURRENT_FORM, CURRENT_FIELD.NAME,
(NEW_POS.LINE, CURRENT_FIELD.POSITION.COLUMN),
CURRENT_FIELD.LENGTH, CURRENT_FIELD.RENDITION,
CURRENT_FIELD.CHAR_LIMITS, CURRENT_FIELD.INIT_VALUE,
CURRENT_FIELD.MODE, TEMP_FIELD);
exit;
exception
when FORM_MANAGER.DUPLICATE_FIELD_NAME =>
if DUP_TYPE = COPY then
TERMINAL_INTERFACE.PUT_MESSAGE
("Field name already exists -- choose another");
delay 1.0;
TERMINAL_INTERFACE.SPLIT_DISPLAY (SIZE);
FORMS.GET_FIELD_NAME (CURRENT_FIELD.NAME);
end if;
end;
end loop;
-- Update terminal display to reflect the new field.
TRANSFORM_AND_PUT_FIELD
((NEW_POS.LINE + CURRENT_POSITION.LINE - 1,
CURRENT_FIELD.POSITION.COLUMN + CURRENT_POSITION.COLUMN - 1),
CURRENT_FIELD.LENGTH, CURRENT_FIELD.RENDITION,
CURRENT_FIELD.CHAR_LIMITS, CURRENT_FIELD.INIT_VALUE,
CURRENT_FIELD.MODE);
CURRENT_FIELD := CURRENT_FIELD.NEXT_FIELD;
end loop;
-- Clear the message line.
TERMINAL_INTERFACE.SPLIT_DISPLAY (SIZE);
CURSOR := NEW_POS;
end if;
exception
when FIELDS_FOUND_ON_LAST_LINE =>
TERMINAL_INTERFACE.PUT_MESSAGE ("Cannot copy -- fields on last line!");
end DUPLICATE_LINE;
separate (EDITOR)
procedure DELETE_LINE -------------------------------------------------------------------------
-- Abstract : This procedure implements the Delete Line operation of
-- the Form Editor. Command line abbreviation: D L
-------------------------------------------------------------------------
-- Parameters : none.
-------------------------------------------------------------------------
-- Algorithm : This procedure deletes a line of a form that the cursor
-- was positioned on. The rest of the lines below this
-- deleted line are shifted up one line. A blank line is
-- inserted as the new last line of the form. A line cannot
-- be deleted if it still contains non-text fields.
-------------------------------------------------------------------------
is
SIZE : TERMINAL_INTERFACE.SCREEN_POSITION;
TEMP_POS : FORM_MANAGER.FIELD_POSITION;
TEMP_FIELD : FORM_MANAGER.FIELD_ACCESS;
FIELDS_FOUND_ON_LINE : exception;
begin
-- Locate first field at or below cursor's line.
FIELD := FORM_MANAGER.GET_FIRST_FIELD (CURRENT_FORM);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE,
VALUE, MODE);
while POSITION.LINE < CURSOR.LINE loop
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE,
VALUE, MODE);
end loop;
TEMP_FIELD := FIELD;
-- Check cursor's line to see if it contains non-text fields.
if POSITION.LINE = CURSOR.LINE then
begin
while POSITION.LINE = CURSOR.LINE loop
-- If so, raise an exception.
if MODE /= FORM_MANAGER.CONSTANT_TEXT then
raise FIELDS_FOUND_ON_LINE;
end if;
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
end loop;
exception
when FORM_MANAGER.FIELD_NOT_FOUND =>
null;
end;
end if;
FIELD := TEMP_FIELD;
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE,
VALUE, MODE);
begin
-- Delete the fields on the cursor's line.
while POSITION.LINE = CURSOR.LINE loop
FORM_MANAGER.DELETE_FIELD (FIELD);
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
end loop;
-- Move the fields below cursor's line up one line position.
begin
loop
FORM_MANAGER.MOVE_FIELD
(FIELD, (POSITION.LINE - 1, POSITION.COLUMN));
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
end loop;
exception
-- These exceptions should NEVER occur!!
when FORM_MANAGER.FIELD_OVERLAP_OCCURRED =>
TERMINAL_INTERFACE.PUT_MESSAGE ("Internal delete line error.");
when FORM_MANAGER.FIELD_EXTENDS_PAST_FORM =>
TERMINAL_INTERFACE.PUT_MESSAGE ("Internal delete line error.");
end;
exception
when FORM_MANAGER.FIELD_NOT_FOUND =>
null;
end;
-- Update the terminal display.
TERMINAL_INTERFACE.SCREEN_SIZE (SIZE);
TERMINAL_INTERFACE.SPLIT_DISPLAY (SIZE);
TEMP_POS.LINE := CURSOR.LINE + CURRENT_POSITION.LINE - 1;
TEMP_POS.COLUMN := CURSOR.COLUMN + CURRENT_POSITION.COLUMN - 1;
TERMINAL_INTERFACE.CLOSE_UP_DISPLAY (TEMP_POS);
exception
when FORM_MANAGER.FIELD_NOT_FOUND =>
null;
when FIELDS_FOUND_ON_LINE =>
TERMINAL_INTERFACE.PUT_MESSAGE ("Cannot delete -- field found on line");
end DELETE_LINE;
separate (EDITOR)
procedure INSERT_CHARACTER -------------------------------------------------------------------------
-- Abstract : This procedure implements the Insert Character operation
-- of the Form Editor. This operation can only be used on
-- text characters. Command line abbreviation: I CH
-------------------------------------------------------------------------
-- Parameters : none.
-------------------------------------------------------------------------
-- Algorithm : This procedure inserts a blank into a line of a form. The
-- blank is inserted just to the left of the cursor and the
-- cursor is positioned on this new blank character. All
-- characters and fields from the original cursor position
-- to the end of the line are shifted right one position.
-------------------------------------------------------------------------
is
TEMP_POS : FORM_MANAGER.FIELD_POSITION;
NOT_IN_TEXT_FIELD : exception;
begin
-- Don't do anything is positioned in last form column.
if CURSOR.COLUMN /= CURRENT_SIZE.COLUMNS then
begin
-- Check to see if a field extends TO the end of the line.
TEMP_POS.LINE := CURSOR.LINE;
TEMP_POS.COLUMN := CURRENT_SIZE.COLUMNS;
FIELD := FORM_MANAGER.GET_FIELD_POINTER (CURRENT_FORM, TEMP_POS);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
-- If so, raise an exception
if MODE /= FORM_MANAGER.CONSTANT_TEXT then
raise FORM_MANAGER.FIELD_EXTENDS_PAST_FORM;
end if;
exception
when FORM_MANAGER.FIELD_POSITION_NOT_FOUND =>
null;
end;
-- Make sure that the cursor is positioned in a TEXT field.
begin
FIELD := FORM_MANAGER.GET_FIELD_POINTER (CURRENT_FORM, CURSOR);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
if MODE /= FORM_MANAGER.CONSTANT_TEXT then
raise NOT_IN_TEXT_FIELD;
end if;
exception
when FORM_MANAGER.FIELD_POSITION_NOT_FOUND => null;
end;
begin
-- Locate the last field on the cursor's line.
FIELD := FORM_MANAGER.GET_FIRST_FIELD (CURRENT_FORM, CURSOR.LINE);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
begin
while POSITION.LINE = CURSOR.LINE loop
PREV_FIELD := FIELD;
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
end loop;
exception
when FORM_MANAGER.FIELD_NOT_FOUND => null;
end;
-- Move the fields one position to the right.
FIELD := PREV_FIELD;
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
begin
while POSITION.COLUMN > CURSOR.COLUMN loop
FORM_MANAGER.MOVE_FIELD
(FIELD, (POSITION.LINE, POSITION.COLUMN + 1));
FIELD := FORM_MANAGER.GET_PREVIOUS_FIELD (FIELD);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
end loop;
-- If cursor is positioned in a text field, then insert the
-- character in this field.
if POSITION.COLUMN + LENGTH >= CURSOR.COLUMN then
INIT_VALUE
(CURSOR.COLUMN - POSITION.COLUMN + 1 ..
FORM_MANAGER.MAX_FIELD_VALUE) :=
' ' &
INIT_VALUE
(CURSOR.COLUMN - POSITION.COLUMN + 1 ..
FORM_MANAGER.MAX_FIELD_VALUE - 1);
FORM_MANAGER.MODIFY_FIELD_INIT (FIELD, INIT_VALUE);
FORM_MANAGER.MODIFY_FIELD_LENGTH (FIELD, LENGTH + 1);
end if;
exception
when FORM_MANAGER.FIELD_NOT_FOUND =>
null;
end;
-- Insert character into the terminal display.
TEMP_POS.LINE := CURSOR.LINE + CURRENT_POSITION.LINE - 1;
TEMP_POS.COLUMN := CURSOR.COLUMN + CURRENT_POSITION.COLUMN - 1;
TERMINAL_INTERFACE.INSERT_CHARACTER (' ', TEMP_POS);
exception
when FORM_MANAGER.FIELD_NOT_FOUND => null;
end;
end if;
exception
when FORM_MANAGER.FIELD_EXTENDS_PAST_FORM =>
TERMINAL_INTERFACE.PUT_MESSAGE ("No room in line to insert character!");
when NOT_IN_TEXT_FIELD =>
TERMINAL_INTERFACE.PUT_MESSAGE ("Cannot insert characters in a field!");
end INSERT_CHARACTER;
separate (EDITOR)
procedure DELETE_CHARACTER -------------------------------------------------------------------------
-- Abstract : This procedure implements the Delete Character operation
-- of the Form Editor. This operation only can be used on
-- text characters. Command line abbreviation: D CH
-------------------------------------------------------------------------
-- Parameters : none.
-------------------------------------------------------------------------
-- Algorithm : This procedure deletes a character from a form line and
-- shifts all other characters and fields to the left. The
-- cursor remains in its original position. The character
-- located UNDER the cursor is the one that is deleted.
-------------------------------------------------------------------------
is
TEMP_FIELD : FORM_MANAGER.FIELD_ACCESS;
TEMP_POS : FORM_MANAGER.FIELD_POSITION;
NEXT_IS_NULL : BOOLEAN := false;
DEGENERATED_FIELD : exception;
NOT_IN_TEXT_FIELD : exception;
begin
-- Make sure that cursor is located in a TEXT field.
begin
FIELD := FORM_MANAGER.GET_FIELD_POINTER (CURRENT_FORM, CURSOR);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE,
VALUE, MODE);
-- If not, raise an exception.
if MODE /= FORM_MANAGER.CONSTANT_TEXT then
raise NOT_IN_TEXT_FIELD;
end if;
-- If the field only has one character then raise the degenerated
-- field exception. This will simply delete the field and send
-- a blank to the screen.
if LENGTH = 1 then
raise DEGENERATED_FIELD;
end if;
-- If the cursor is positioned on a field position, other than the
-- LAST field position, then alter the fields contents.
if CURSOR.COLUMN /= POSITION.COLUMN + LENGTH - 1 then
INIT_VALUE
(CURSOR.COLUMN - POSITION.COLUMN + 1 ..
FORM_MANAGER.MAX_FIELD_VALUE) :=
INIT_VALUE
(CURSOR.COLUMN - POSITION.COLUMN + 2 ..
FORM_MANAGER.MAX_FIELD_VALUE) & ' ';
FORM_MANAGER.MODIFY_FIELD_INIT (FIELD, INIT_VALUE);
end if;
FORM_MANAGER.MODIFY_FIELD_LENGTH (FIELD, LENGTH - 1);
-- Locate first field after the cursor position.
begin
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
exception
when FORM_MANAGER.FIELD_NOT_FOUND =>
NEXT_IS_NULL := true;
end;
exception
-- This is where the degenerated field case is handled.
when DEGENERATED_FIELD =>
TEMP_FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
FORM_MANAGER.DELETE_FIELD (FIELD);
FIELD := TEMP_FIELD;
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
-- Since the cursor wasn't positioned in a field, then locate the
-- first field past the cursor position.
when FORM_MANAGER.FIELD_POSITION_NOT_FOUND =>
FIELD := FORM_MANAGER.GET_FIRST_FIELD (CURRENT_FORM, CURSOR.LINE);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
while POSITION.COLUMN <= CURSOR.COLUMN and then
POSITION.LINE = CURSOR.LINE loop
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
end loop;
end;
-- From this field to the end of the line, move the field to the left
-- one position.
begin
loop
if NEXT_IS_NULL or else POSITION.LINE /= CURSOR.LINE then
exit;
else
FORM_MANAGER.MOVE_FIELD
(FIELD, (POSITION.LINE, POSITION.COLUMN - 1));
end if;
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
end loop;
exception
when FORM_MANAGER.FIELD_NOT_FOUND =>
null;
end;
-- Update the terminal display.
TEMP_POS.LINE := CURSOR.LINE + CURRENT_POSITION.LINE - 1;
TEMP_POS.COLUMN := CURSOR.COLUMN + CURRENT_POSITION.COLUMN - 1;
TERMINAL_INTERFACE.ERASE_CHARACTER (TEMP_POS);
exception
when NOT_IN_TEXT_FIELD =>
TERMINAL_INTERFACE.PUT_MESSAGE ("Cannot delete a field character!");
when FORM_MANAGER.FIELD_NOT_FOUND =>
null;
end DELETE_CHARACTER;
separate (EDITOR)
procedure RUBOUT_CHARACTER -------------------------------------------------------------------------
-- Abstract : This procedure implements the Rubout Character operation
-- of the Form Editor. This operation only can be used on
-- text character. Command line abbreviation: R
-------------------------------------------------------------------------
-- Parameters : none
-------------------------------------------------------------------------
-- Algorithm : This procedure replaces a text character with a blank
-- and does not shift any of the characters and fields on
-- the line. The rubbed out characters is the one just to
-- the left of the cursor and the cursor is shifted one
-- position to the left.
-------------------------------------------------------------------------
is
TEMP_POS : FORM_MANAGER.FIELD_POSITION;
begin
-- Don't do anything if in column one.
if CURSOR.COLUMN /= 1 then
TEMP_POS.LINE := CURSOR.LINE;
TEMP_POS.COLUMN := CURSOR.COLUMN - 1;
FIELD := FORM_MANAGER.GET_FIELD_POINTER (CURRENT_FORM, TEMP_POS);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE,
VALUE, MODE);
-- Raise exception if not rubbing out a text character.
if MODE /= FORM_MANAGER.CONSTANT_TEXT then
raise FORM_MANAGER.FIELD_NOT_FOUND;
end if;
-- Modify the form structure.
INIT_VALUE (TEMP_POS.COLUMN - POSITION.COLUMN + 1) := ' ';
FORM_MANAGER.MODIFY_FIELD_INIT (FIELD, INIT_VALUE);
-- Modify the terminal display.
CURSOR.COLUMN := CURSOR.COLUMN - 1;
TEMP_POS.LINE := CURSOR.LINE + CURRENT_POSITION.LINE - 1;
TEMP_POS.COLUMN := CURSOR.COLUMN + CURRENT_POSITION.COLUMN - 1;
TERMINAL_INTERFACE.PUT_CURSOR (TEMP_POS);
TERMINAL_INTERFACE.PUT_CHARACTER (' ');
end if;
exception
when FORM_MANAGER.FIELD_NOT_FOUND =>
TERMINAL_INTERFACE.PUT_MESSAGE ("Cannot rubout a field character!");
when FORM_MANAGER.FIELD_POSITION_NOT_FOUND =>
-- If not located in a field at all, then simply backup the
-- cursor one position on the terminal display.
CURSOR.COLUMN := CURSOR.COLUMN - 1;
TEMP_POS.LINE := CURSOR.LINE + CURRENT_POSITION.LINE - 1;
TEMP_POS.COLUMN := CURSOR.COLUMN + CURRENT_POSITION.COLUMN - 1;
TERMINAL_INTERFACE.PUT_CURSOR (TEMP_POS);
end RUBOUT_CHARACTER;
separate (EDITOR)
procedure HELP is
CHARTYPE : TERMINAL_INTERFACE.CHAR_ENUM;
CHAR : CHARACTER;
FUNCT : TERMINAL_INTERFACE.FUNCTION_KEY_ENUM;
function "=" (LEFT, RIGHT : TERMINAL_INTERFACE.CHAR_ENUM) return BOOLEAN
renames TERMINAL_INTERFACE."=";
begin
TERMINAL_INTERFACE.CLEAR_SCREEN;
TERMINAL_INTERFACE.PUT_FIELD
((1, 5), 66, FORM_TYPES.PRIMARY_RENDITION,
"This Form Editor allows editor commands to be entered in two ways:");
TERMINAL_INTERFACE.PUT_FIELD
((2, 1), 77, FORM_TYPES.PRIMARY_RENDITION,
"single keystroke or Command Line entry. All of the single " &
"keystrokes for the");
TERMINAL_INTERFACE.PUT_FIELD
((3, 1), 78, FORM_TYPES.PRIMARY_RENDITION,
"editor commands are mapped to keyboard keys through the TCF " &
"file. The Command");
TERMINAL_INTERFACE.PUT_FIELD
((4, 1), 73, FORM_TYPES.PRIMARY_RENDITION,
"Line provides command completion triggered by the space " &
"character and the");
TERMINAL_INTERFACE.PUT_FIELD
((5, 1), 78, FORM_TYPES.PRIMARY_RENDITION,
"RETURN KEY. The Command Line abbreviations necessary are " &
"indicated by capital");
TERMINAL_INTERFACE.PUT_FIELD
((6, 1), 14, FORM_TYPES.PRIMARY_RENDITION, "letters below:");
TERMINAL_INTERFACE.PUT_FIELD
((8, 5), 61, FORM_TYPES.PRIMARY_RENDITION,
"CReate field - Create a new field starting at the cursor.");
TERMINAL_INTERFACE.PUT_FIELD
((9, 5), 71, FORM_TYPES.PRIMARY_RENDITION,
"MODify field - Modify the value or attributes of an existing field.");
TERMINAL_INTERFACE.PUT_FIELD
((10, 5), 44, FORM_TYPES.PRIMARY_RENDITION,
"Delete Field - Delete an existing field.");
TERMINAL_INTERFACE.PUT_FIELD
((11, 5), 70, FORM_TYPES.PRIMARY_RENDITION,
"MOVe Field - Move a field to a position indicated by the cursor.");
TERMINAL_INTERFACE.PUT_FIELD
((12, 5), 74, FORM_TYPES.PRIMARY_RENDITION,
"COpy Field - Move a field to a position " &
"indicated by the cursor and.");
TERMINAL_INTERFACE.PUT_FIELD
((13, 24), 38, FORM_TYPES.PRIMARY_RENDITION,
"provide a new name for this new field.");
TERMINAL_INTERFACE.PUT_FIELD
((14, 5), 71, FORM_TYPES.PRIMARY_RENDITION,
"Insert Line - Insert a blank line above the line the cursor is on.");
TERMINAL_INTERFACE.PUT_FIELD
((15, 5), 75, FORM_TYPES.PRIMARY_RENDITION,
"MOVe Line - Move a line and insert it above " &
"the new cursor position.");
TERMINAL_INTERFACE.PUT_FIELD
((16, 5), 74, FORM_TYPES.PRIMARY_RENDITION,
"COPy Line - Copy a line and insert it " &
"above the new cursor position");
TERMINAL_INTERFACE.PUT_FIELD
((17, 24), 46, FORM_TYPES.PRIMARY_RENDITION,
"and provide new names for the non-text fields.");
TERMINAL_INTERFACE.PUT_FIELD
((18, 5), 68, FORM_TYPES.PRIMARY_RENDITION,
"Delete Line - Delete a line (as long as no fields exist on it).");
TERMINAL_INTERFACE.PUT_FIELD
((19, 5), 60, FORM_TYPES.PRIMARY_RENDITION,
"Insert CHaracter - Insert a blank to the left of the cursor.");
TERMINAL_INTERFACE.PUT_FIELD
((20, 5), 57, FORM_TYPES.PRIMARY_RENDITION,
"Delete CHaracter - Delete the character under the cursor.");
TERMINAL_INTERFACE.PUT_FIELD
((21, 5), 73, FORM_TYPES.PRIMARY_RENDITION,
"Rubout character - Replace the character left of the cursor with a blank.");
TERMINAL_INTERFACE.PUT_FIELD
((22, 5), 46, FORM_TYPES.PRIMARY_RENDITION,
"Help - Display this help facility.");
TERMINAL_INTERFACE.PUT_FIELD
((24, 1), 40, FORM_TYPES.REVERSE_RENDITION,
"Strike any key to return to Form Editor.");
TERMINAL_INTERFACE.GET_CHARACTER (CHARTYPE, CHAR, FUNCT);
while CHARTYPE = TERMINAL_INTERFACE.TIMEOUT loop
TERMINAL_INTERFACE.GET_CHARACTER (CHARTYPE, CHAR, FUNCT);
end loop;
begin
TERMINAL_INTERFACE.CLEAR_SCREEN;
FIELD := FORM_MANAGER.GET_FIRST_FIELD (CURRENT_FORM);
loop
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS,
INIT_VALUE, VALUE, MODE);
POSITION.LINE := POSITION.LINE + CURRENT_POSITION.LINE - 1;
POSITION.COLUMN := POSITION.COLUMN + CURRENT_POSITION.COLUMN - 1;
TRANSFORM_AND_PUT_FIELD
(POSITION, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE, MODE);
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
end loop;
exception
when FORM_MANAGER.FIELD_NOT_FOUND => null;
end;
end HELP;
::::::::::
EDITOR_BODY.ADA
::::::::::
-------------------------------------------------------------------------
-- Abstract : This package is the driver for the Form Editor. Provided
-- are all of the services for characters, functions, and
-- execution of the respective commands when necessary.
-------------------------------------------------------------------------
package body EDITOR is
CURRENT_FORM : FORM_MANAGER.FORM_ACCESS;
CURRENT_SIZE : FORM_MANAGER.FORM_SIZE;
CURRENT_POSITION : FORM_MANAGER.FORM_POSITION;
CURRENT_OPTION : FORM_MANAGER.OPTION_TYPE;
type FIELD_DUPLICATION_TYPE is (MOVE, COPY);
type FIELD_MODIFICATION_TYPE is (CREATE, MODIFY);
type LINE_DUPLICATION_TYPE is (MOVE, COPY);
EDITOR_DRIVER_EXIT : exception;
CHAR : CHARACTER;
CHARTYPE : TERMINAL_INTERFACE.CHAR_ENUM;
FUNCT : TERMINAL_INTERFACE
.FUNCTION_KEY_ENUM;
CURSOR : FORM_MANAGER.FIELD_POSITION;
MERGE_RIGHT, MERGE_LEFT : BOOLEAN;
FIELD, NEXT_FIELD, PREV_FIELD, NEW_FIELD : FORM_MANAGER.FIELD_ACCESS;
NAME, NEXT_NAME, PREV_NAME : FORM_MANAGER.FIELD_NAME;
POSITION, NEXT_POS, PREV_POS : FORM_MANAGER.FIELD_POSITION;
LENGTH, NEXT_LEN, PREV_LEN : FORM_MANAGER.FIELD_LENGTH;
RENDITION, NEXT_REND, PREV_REND : FORM_MANAGER.FIELD_RENDITIONS;
CHAR_LIMITS, NEXT_LIMITS, PREV_LIMITS : FORM_MANAGER.CHAR_TYPE;
INIT_VALUE, NEXT_INIT, PREV_INIT : FORM_MANAGER.FIELD_VALUE;
VALUE, NEXT_VAL, PREV_VAL : FORM_MANAGER.FIELD_VALUE;
MODE, NEXT_MODE, PREV_MODE : FORM_MANAGER.FIELD_MODE;
function "=" (LEFT, RIGHT : TERMINAL_INTERFACE.FUNCTION_KEY_ENUM)
return BOOLEAN renames TERMINAL_INTERFACE."=";
function "=" (LEFT, RIGHT : TERMINAL_INTERFACE.CHAR_ENUM) return BOOLEAN
renames TERMINAL_INTERFACE."=";
function "=" (LEFT, RIGHT : FORM_MANAGER.FIELD_MODE) return BOOLEAN
renames FORM_MANAGER."=";
function "=" (LEFT, RIGHT : FORM_MANAGER.FIELD_ACCESS) return BOOLEAN
renames FORM_MANAGER."=";
-------------------------------------------------------------------------
-- Abstract : This function determines whether the given cursor position
-- is within the confines of a NON-TEXT field.
-------------------------------------------------------------------------
-- Parameters : CURSOR - The cursor position in question.
-------------------------------------------------------------------------
function IN_FIELD (CURSOR : TERMINAL_INTERFACE.SCREEN_POSITION)
return BOOLEAN is
begin
FIELD := FORM_MANAGER.GET_FIELD_POINTER (CURRENT_FORM, CURSOR);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS, INIT_VALUE,
VALUE, MODE);
return (MODE /= FORM_MANAGER.CONSTANT_TEXT);
exception
when FORM_MANAGER.NULL_FORM_POINTER |
FORM_MANAGER.FIELD_POSITION_NOT_FOUND =>
return FALSE;
end IN_FIELD;
-------------------------------------------------------------------------
-- Abstract : This procedure transforms the value of a non-text field
-- for display on the terminal display. The field is then
-- displayed on the terminal.
-------------------------------------------------------------------------
-- Parameters : POSITION - The field's beginning screen position
-- LEN - The field's length
-- RENDITION - The field's display rendition
-- LIMITS - The field's character limitations
-- INIT - The field's initial value
-- MODE - The field's display mode
-------------------------------------------------------------------------
-- Algorithm : If the given field is a text field then the value passed
-- in through INIT is simply displayed. If the field is a
-- non_text field, then the INIT value is altered to reflect
-- the field's character limitations. The character codes
-- for the limitations are as follows:
--
-- a - Alphabetic
-- n - Numeric
-- b - Alphanumeric
-- x - Not Limited
--
-- Enough of these character codes will be displayed to also
-- indicate the length of the field.
-------------------------------------------------------------------------
procedure TRANSFORM_AND_PUT_FIELD
(POSITION : FORM_MANAGER.FIELD_POSITION;
LEN : FORM_MANAGER.FIELD_LENGTH;
RENDITION : FORM_MANAGER.FIELD_RENDITIONS;
LIMITS : FORM_MANAGER.CHAR_TYPE;
INIT : FORM_MANAGER.FIELD_VALUE;
MODE : FORM_MANAGER.FIELD_MODE) is
TEMP_INIT : FORM_MANAGER.FIELD_VALUE;
begin
-- If not constant text, then transform the field's initial value.
if MODE /= FORM_MANAGER.CONSTANT_TEXT then
case LIMITS is
when FORM_MANAGER.ALPHA =>
TEMP_INIT (1 .. LEN) := (1 .. LEN => 'a');
when FORM_MANAGER.NUMERIC =>
TEMP_INIT (1 .. LEN) := (1 .. LEN => 'n');
when FORM_MANAGER.ALPHA_NUMERIC =>
TEMP_INIT (1 .. LEN) := (1 .. LEN => 'b');
when FORM_MANAGER.NOT_LIMITED =>
TEMP_INIT (1 .. LEN) := (1 .. LEN => 'x');
end case;
else
-- Otherwise, simply display the field's original initial value.
TEMP_INIT := INIT;
end if;
TERMINAL_INTERFACE.PUT_FIELD (POSITION, LEN, RENDITION, TEMP_INIT);
end TRANSFORM_AND_PUT_FIELD;
-------------------------------------------------------------------------
-- Abstract : This procedure allows the user to indicate a new cursor
-- position using the arrow keys.
-------------------------------------------------------------------------
-- Parameters : OLD_POS - The original cursor position.
-- NEW_POS - The cursor position indicated by the user.
-------------------------------------------------------------------------
procedure GET_CURSOR_POSITION
(OLD_POS : FORM_MANAGER.FIELD_POSITION;
NEW_POS : in out FORM_MANAGER.FIELD_POSITION) is
CHAR : CHARACTER;
CHARTYPE : TERMINAL_INTERFACE.CHAR_ENUM;
FUNCT : TERMINAL_INTERFACE.FUNCTION_KEY_ENUM;
begin
NEW_POS := OLD_POS;
TERMINAL_INTERFACE.GET_CHARACTER (CHARTYPE, CHAR, FUNCT);
-- Retrieve arrow keys until a RETURN_KEY is encountered.
while (CHARTYPE /= TERMINAL_INTERFACE.FUNC_TYPE or else
FUNCT /= TERMINAL_INTERFACE.RETURN_KEY) loop
case CHARTYPE is
when TERMINAL_INTERFACE.TIMEOUT |
TERMINAL_INTERFACE.CHAR_TYPE =>
null;
when TERMINAL_INTERFACE.FUNC_TYPE =>
case FUNCT is
when TERMINAL_INTERFACE.DOWN_ARROW =>
if NEW_POS.LINE + 1 > CURRENT_SIZE.ROWS then
NEW_POS.LINE := 1;
else
NEW_POS.LINE := NEW_POS.LINE + 1;
end if;
TERMINAL_INTERFACE.PUT_CURSOR
((CURRENT_POSITION.LINE + NEW_POS.LINE - 1,
CURRENT_POSITION.COLUMN + NEW_POS.COLUMN - 1));
when TERMINAL_INTERFACE.UP_ARROW =>
if NEW_POS.LINE = 1 then
NEW_POS.LINE := CURRENT_SIZE.ROWS;
else
NEW_POS.LINE := NEW_POS.LINE - 1;
end if;
TERMINAL_INTERFACE.PUT_CURSOR
((CURRENT_POSITION.LINE + NEW_POS.LINE - 1,
CURRENT_POSITION.COLUMN + NEW_POS.COLUMN - 1));
when TERMINAL_INTERFACE.LEFT_ARROW =>
if NEW_POS.COLUMN = 1 then
NEW_POS.COLUMN := CURRENT_SIZE.COLUMNS;
else
NEW_POS.COLUMN := NEW_POS.COLUMN - 1;
end if;
TERMINAL_INTERFACE.PUT_CURSOR
((CURRENT_POSITION.LINE + NEW_POS.LINE - 1,
CURRENT_POSITION.COLUMN + NEW_POS.COLUMN - 1));
when TERMINAL_INTERFACE.RIGHT_ARROW =>
if NEW_POS.COLUMN + 1 > CURRENT_SIZE.COLUMNS then
NEW_POS.COLUMN := 1;
else
NEW_POS.COLUMN := NEW_POS.COLUMN + 1;
end if;
TERMINAL_INTERFACE.PUT_CURSOR
((CURRENT_POSITION.LINE + NEW_POS.LINE - 1,
CURRENT_POSITION.COLUMN + NEW_POS.COLUMN - 1));
when others =>
null;
end case;
end case;
TERMINAL_INTERFACE.GET_CHARACTER (CHARTYPE, CHAR, FUNCT);
end loop;
end GET_CURSOR_POSITION;
-----------------------------------------------------------------------
-- Separate commands of the Form Editor.
procedure MODIFY_FIELD (MOD_TYPE : FIELD_MODIFICATION_TYPE) is separate;
procedure DUPLICATE_FIELD (DUP_TYPE : FIELD_DUPLICATION_TYPE) is separate;
procedure DELETE_FIELD is separate;
procedure INSERT_LINE is separate;
procedure DUPLICATE_LINE (DUP_TYPE : LINE_DUPLICATION_TYPE) is separate;
procedure DELETE_LINE is separate;
procedure INSERT_CHARACTER is separate;
procedure DELETE_CHARACTER is separate;
procedure RUBOUT_CHARACTER is separate;
procedure HELP is separate;
procedure COM_LINE is separate;
-------------------------------------------------------------------------
-- Abstract : This procedure is the actual body of the Editor driver.
-------------------------------------------------------------------------
-- Parameters : CURRENT - The Current Form
-------------------------------------------------------------------------
procedure EDITOR_DRIVER (CURRENT : in out FORM_MANAGER.FORM_ACCESS) is
-- This is the driver routine for the Form Editor. This routine fields and
-- services all user requests for the interactive creation and modificatio
-- of a form. Fields can be created, modified, moved, copied, and deleted
-- Lines can be inserted, moved, copied, and deleted. Text characters can
-- be inserted, deleted, and rubbed out. A list of user commands can also
begin
-- Set up the Current Form attributes.
CURRENT_FORM := CURRENT;
FORM_MANAGER.GET_FORM_INFO
(CURRENT_FORM, CURRENT_SIZE, CURRENT_POSITION, CURRENT_OPTION);
-- Position cursor in upper, left-hand corner of the form.
CURSOR := (1, 1);
loop
TERMINAL_INTERFACE.PUT_CURSOR
((CURSOR.LINE + CURRENT_POSITION.LINE - 1,
CURSOR.COLUMN + CURRENT_POSITION.COLUMN - 1));
TERMINAL_INTERFACE.GET_CHARACTER (CHARTYPE, CHAR, FUNCT);
case CHARTYPE is
when TERMINAL_INTERFACE.TIMEOUT =>
null;
when TERMINAL_INTERFACE.FUNC_TYPE =>
case FUNCT is
-- Arrow key processing...
when TERMINAL_INTERFACE.DOWN_ARROW |
TERMINAL_INTERFACE.RETURN_KEY =>
if CURSOR.LINE + 1 > CURRENT_SIZE.ROWS then
CURSOR.LINE := 1;
else
CURSOR.LINE := CURSOR.LINE + 1;
end if;
if FUNCT = TERMINAL_INTERFACE.RETURN_KEY then
CURSOR.COLUMN := 1;
end if;
when TERMINAL_INTERFACE.UP_ARROW =>
if CURSOR.LINE = 1 then
CURSOR.LINE := CURRENT_SIZE.ROWS;
else
CURSOR.LINE := CURSOR.LINE - 1;
end if;
when TERMINAL_INTERFACE.LEFT_ARROW =>
if CURSOR.COLUMN = 1 then
CURSOR.COLUMN := CURRENT_SIZE.COLUMNS;
else
CURSOR.COLUMN := CURSOR.COLUMN - 1;
end if;
when TERMINAL_INTERFACE.RIGHT_ARROW =>
if CURSOR.COLUMN + 1 > CURRENT_SIZE.COLUMNS then
CURSOR.COLUMN := 1;
else
CURSOR.COLUMN := CURSOR.COLUMN + 1;
end if;
-- This is the only normal exit from the Form
-- Editor.
when TERMINAL_INTERFACE.EXIT_FORM =>
raise EDITOR_DRIVER_EXIT;
-- Other Form Editor command processing...
when TERMINAL_INTERFACE.COMMAND_LINE =>
COM_LINE;
when TERMINAL_INTERFACE.HELP =>
HELP;
when TERMINAL_INTERFACE.DEL_CHAR =>
DELETE_CHARACTER;
when TERMINAL_INTERFACE.INS_CHAR =>
INSERT_CHARACTER;
when TERMINAL_INTERFACE.RUBOUT =>
RUBOUT_CHARACTER;
when TERMINAL_INTERFACE.COPY_LINE =>
DUPLICATE_LINE (COPY);
when TERMINAL_INTERFACE.DEL_LINE =>
DELETE_LINE;
when TERMINAL_INTERFACE.INS_LINE =>
INSERT_LINE;
when TERMINAL_INTERFACE.MOVE_LINE =>
DUPLICATE_LINE (MOVE);
when TERMINAL_INTERFACE.COPY_FIELD =>
DUPLICATE_FIELD (COPY);
when TERMINAL_INTERFACE.CREATE_FIELD =>
MODIFY_FIELD (CREATE);
when TERMINAL_INTERFACE.DEL_FIELD =>
DELETE_FIELD;
when TERMINAL_INTERFACE.MODIFY_FIELD =>
MODIFY_FIELD (MODIFY);
when TERMINAL_INTERFACE.MOVE_FIELD =>
DUPLICATE_FIELD (MOVE);
when others =>
TERMINAL_INTERFACE.PUT_MESSAGE
("Illegal function key");
end case;
when TERMINAL_INTERFACE.CHAR_TYPE =>
-- Character processing...
if IN_FIELD (CURSOR) then
TERMINAL_INTERFACE.PUT_MESSAGE
("Cannot enter text in field" -- Cannot enter text
-- character into
-- fields!!
);
else
begin
-- Check to see if the cursor is positioned in a
-- text field.
-- If so, place the character into the text field
-- in overstrike mode.
FIELD := FORM_MANAGER.GET_FIELD_POINTER
(CURRENT_FORM, CURSOR);
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION,
CHAR_LIMITS, INIT_VALUE, VALUE, MODE);
INIT_VALUE (CURSOR.COLUMN - POSITION.COLUMN + 1) :=
CHAR;
FORM_MANAGER.MODIFY_FIELD_INIT (FIELD, INIT_VALUE);
exception
when CONSTRAINT_ERROR =>
TERMINAL_INTERFACE.PUT_MESSAGE
("Constraint error on field initial value");
when FORM_MANAGER.NULL_FORM_POINTER =>
TERMINAL_INTERFACE.PUT_MESSAGE
("No Current Form!");
when FORM_MANAGER.FIELD_POSITION_NOT_FOUND =>
-- When the cursor was not positioned in a field at all, then
-- create a new field with this character in it. Also, an
-- attempt will be made to merge this new text field with
-- other adjacent text fields.
begin
-- Add the character to the form in a field
-- of its own.
FORM_MANAGER.ADD_FIELD
(CURRENT_FORM, "", CURSOR, 1,
INIT_VALUE => STRING'(1 => CHAR),
MODE => FORM_MANAGER.CONSTANT_TEXT,
FIELD => FIELD);
-- Allow merging to the left if the previous
-- field was a
-- constant text field also.
begin
PREV_FIELD :=
FORM_MANAGER.GET_PREVIOUS_FIELD
(FIELD);
FORM_MANAGER.GET_FIELD_INFO
(PREV_FIELD, PREV_NAME, PREV_POS,
PREV_LEN, PREV_REND, PREV_LIMITS,
PREV_INIT, PREV_VAL, PREV_MODE);
MERGE_LEFT :=
(PREV_MODE =
FORM_MANAGER.CONSTANT_TEXT) and then
(PREV_POS.LINE = CURSOR.LINE);
exception
when FORM_MANAGER.FIELD_NOT_FOUND =>
MERGE_LEFT := FALSE;
end;
-- Allow merging to the right if the next
-- field was a
-- constant text field also.
begin
NEXT_FIELD :=
FORM_MANAGER.GET_NEXT_FIELD (FIELD);
FORM_MANAGER.GET_FIELD_INFO
(NEXT_FIELD, NEXT_NAME, NEXT_POS,
NEXT_LEN, NEXT_REND, NEXT_LIMITS,
NEXT_INIT, NEXT_VAL, NEXT_MODE);
MERGE_RIGHT :=
(NEXT_MODE =
FORM_MANAGER.CONSTANT_TEXT) and then
(NEXT_POS.LINE = CURSOR.LINE);
exception
when FORM_MANAGER.FIELD_NOT_FOUND =>
MERGE_RIGHT := FALSE;
end;
if MERGE_LEFT then
if MERGE_RIGHT then
-- Merge both the previous and the
-- next fields with this
-- single character field
-- resulting in one long field.
FORM_MANAGER.DELETE_FIELD (FIELD);
FORM_MANAGER.DELETE_FIELD
(NEXT_FIELD);
FORM_MANAGER.MODIFY_FIELD_LENGTH
(PREV_FIELD,
NEXT_POS.COLUMN + NEXT_LEN -
PREV_POS.COLUMN);
PREV_INIT
(CURSOR.COLUMN -
PREV_POS.COLUMN + 1) := CHAR;
PREV_INIT
((NEXT_POS.COLUMN -
PREV_POS.COLUMN + 1) ..
(NEXT_POS.COLUMN + NEXT_LEN -
PREV_POS.COLUMN)) :=
NEXT_INIT (1 .. NEXT_LEN);
FORM_MANAGER.MODIFY_FIELD_INIT
(PREV_FIELD, PREV_INIT);
else
-- Merge the previous field with
-- this single character
-- field.
FORM_MANAGER.DELETE_FIELD (FIELD);
FORM_MANAGER.MODIFY_FIELD_LENGTH
(PREV_FIELD,
CURSOR.COLUMN -
PREV_POS.COLUMN + 1);
PREV_INIT
(CURSOR.COLUMN -
PREV_POS.COLUMN + 1) := CHAR;
FORM_MANAGER.MODIFY_FIELD_INIT
(PREV_FIELD, PREV_INIT);
end if;
elsif MERGE_RIGHT then
-- Merge the next field with this single
-- character
-- field.
FORM_MANAGER.DELETE_FIELD (NEXT_FIELD);
FORM_MANAGER.MODIFY_FIELD_LENGTH
(FIELD,
NEXT_POS.COLUMN + NEXT_LEN -
CURSOR.COLUMN);
FORM_MANAGER.MODIFY_FIELD_INIT
(FIELD,
CHAR &
(1 .. NEXT_POS.COLUMN -
CURSOR.COLUMN - 1 => ' ') &
NEXT_INIT &
(1 .. FORM_MANAGER
.MAX_FIELD_VALUE +
NEXT_LEN - NEXT_POS.COLUMN +
1 => ' '));
end if;
exception
when FORM_MANAGER.FIELD_ALLOCATION_ERROR =>
TERMINAL_INTERFACE.PUT_MESSAGE
("Could not add field -- " &
"Memory full");
end;
end;
-- Output the character to the terminal display, and
-- update the
-- cursor position.
TERMINAL_INTERFACE.PUT_CHARACTER
(CHAR,
(CURSOR.LINE + CURRENT_POSITION.LINE - 1,
CURSOR.COLUMN + CURRENT_POSITION.COLUMN - 1));
if CURSOR.COLUMN + 1 > CURRENT_SIZE.COLUMNS then
CURSOR.COLUMN := CURRENT_SIZE.COLUMNS;
else
CURSOR.COLUMN := CURSOR.COLUMN + 1;
end if;
end if;
end case;
end loop;
exception
when EDITOR_DRIVER_EXIT => null;
end EDITOR_DRIVER;
end EDITOR;
::::::::::
EDITOR_SPEC.ADA
::::::::::
-------------------------------------------------------------------------
-- Abstract : This is the package specification for the driver of the
-- Form Editor. This package only has one visible entry,
-- the procedure EDITOR_DRIVER.
-------------------------------------------------------------------------
-- Parameters : CURRENT - The Current Form
-------------------------------------------------------------------------
with FORM_MANAGER;
with TERMINAL_INTERFACE;
with FORM_EXECUTOR;
with FORM_TYPES;
with FORMS;
package EDITOR is
procedure EDITOR_DRIVER (CURRENT : in out FORM_MANAGER.FORM_ACCESS);
end EDITOR;
::::::::::
EXECUTOR_BODY.ADA
::::::::::
--------------------------------------------------------------------------
-- Abstract : This package defines the body of the Form Executor which
-- allows a user program interface with a form and the user.
--------------------------------------------------------------------------
with FORM_MANAGER,
TERMINAL_INTERFACE;
use FORM_MANAGER, TERMINAL_INTERFACE;
package body FORM_EXECUTOR is
OPEN_FORMS : NATURAL := 0;
--------------------------------------------------------------------------
-- Abstract : ACCESS_FORM loads a form definition from an external file
-- and returns a pointer to the form data structure.
--------------------------------------------------------------------------
-- Parameters : PATHNAME - name of file which contains the form definition
--------------------------------------------------------------------------
function ACCESS_FORM (PATHNAME : STRING) return FORM_PTR is
FORM : FORM_PTR; -- data base file pathname
begin
FORM_MANAGER.LOAD_FORM (PATHNAME, FORM);
if OPEN_FORMS = 0 then
TERMINAL_INTERFACE.OPEN;
end if;
OPEN_FORMS := OPEN_FORMS + 1;
return FORM;
exception
when FORM_MANAGER.FILE_NOT_FOUND | FORM_MANAGER.FILE_ALREADY_OPEN =>
raise FORM_ACCESS_ERROR;
end ACCESS_FORM;
--------------------------------------------------------------------------
-- Abstract : CLEAR_FORM sets the current values of each field of the
-- form to their initial value.
--------------------------------------------------------------------------
-- Parameters : FORM - pointer to the form data structure
--------------------------------------------------------------------------
procedure CLEAR_FORM (FORM : FORM_PTR) is
begin
FORM_MANAGER.CLEAR_FORM (FORM);
exception
when FORM_MANAGER.NULL_FORM_POINTER =>
raise INVALID_FORM;
end CLEAR_FORM;
--------------------------------------------------------------------------
-- Abstract : MODIFY_FIELD modifies the value of specific field of a
-- form given is name.
--------------------------------------------------------------------------
-- Parameters : FORM - form data structure pointer
-- FIELD - name of the field to be modified
-- VALUE - new value of the field when it is displayed
--------------------------------------------------------------------------
procedure MODIFY_FIELD (FORM : FORM_PTR;
FIELD : STRING;
VALUE : STRING) is
FIELD_PTR : FORM_MANAGER.FIELD_ACCESS;
begin
FIELD_PTR := FORM_MANAGER.GET_FIELD_POINTER (FORM, FIELD);
FORM_MANAGER.MODIFY_FIELD_VALUE (FIELD_PTR, VALUE);
exception
when FORM_MANAGER.NULL_FORM_POINTER =>
raise INVALID_FORM;
when FORM_MANAGER.CONSTANT_FIELD_ERROR |
FORM_MANAGER.FIELD_NAME_NOT_FOUND |
FORM_MANAGER.NULL_FIELD_POINTER =>
raise INVALID_FIELD;
end MODIFY_FIELD;
--------------------------------------------------------------------------
-- Abstract : PRESENT_FORM displays the form on the terminal and
-- interacts with the user to modify the contents of the
-- input fields.
--------------------------------------------------------------------------
-- Parameters : FORM - form data structure
-- BELL - signal bell after form is displayed
-- FIELD - the field to position the cursor at
--------------------------------------------------------------------------
-- Algorithm : The current value of each field is displayed, the bell
-- is optionally rung, and then input information into the
-- fields.
--------------------------------------------------------------------------
procedure PRESENT_FORM (FORM : FORM_PTR;
BELL : BOOLEAN := FALSE;
FIELD : STRING := "") is
CLEAR_OPTION : FORM_MANAGER.OPTION_TYPE;
BASE_POSITION : FORM_MANAGER.FORM_POSITION;
SIZE : FORM_MANAGER.FORM_SIZE;
FIELD_PTR : FORM_MANAGER.FIELD_ACCESS;
CHAR_LIMITS : FORM_MANAGER.CHAR_TYPE;
LENGTH : FORM_MANAGER.FIELD_LENGTH;
MODE : FORM_MANAGER.FIELD_MODE;
NAME : FORM_MANAGER.FIELD_NAME;
POSITION : FORM_MANAGER.FIELD_POSITION;
RENDITION : FORM_MANAGER.FIELD_RENDITIONS;
VALUE : FORM_MANAGER.FIELD_VALUE;
procedure GET_INFO (FIELD : FORM_MANAGER.FIELD_ACCESS) is
-- get field information
begin
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, CHAR_LIMITS, VALUE,
VALUE, MODE);
end GET_INFO;
procedure EDIT_FORM is
-- edit input fields of form
CHAR : CHARACTER;
CHARTYPE : TERMINAL_INTERFACE.CHAR_ENUM;
FUNCT : TERMINAL_INTERFACE.FUNCTION_KEY_ENUM;
procedure EDIT_FIELD is
-- edit the contents of a field
I : NATURAL;
OK : BOOLEAN;
begin
POSITION.LINE := POSITION.LINE + BASE_POSITION.LINE - 1;
POSITION.COLUMN := POSITION.COLUMN + BASE_POSITION.COLUMN - 1;
loop
TERMINAL_INTERFACE.EDIT_FIELD
(POSITION, LENGTH, RENDITION, VALUE);
OK := TRUE;
if CHAR_LIMITS /= FORM_MANAGER.NOT_LIMITED then
for I in 1 .. LENGTH loop
case VALUE (I) is
when ' ' => -- blanks ok anytime
null;
when '0' .. '9' =>
if CHAR_LIMITS = FORM_MANAGER.ALPHA then
OK := FALSE;
end if;
when 'A' .. 'Z' | 'a' .. 'z' | '_' =>
if CHAR_LIMITS = FORM_MANAGER.NUMERIC then
OK := FALSE;
end if;
when '$' | '%' | '+' =>
if CHAR_LIMITS /= FORM_MANAGER.NUMERIC then
OK := FALSE;
end if;
when ''' =>
if CHAR_LIMITS = FORM_MANAGER.NUMERIC then
OK := FALSE;
end if;
when ',' | '.' | '-' =>
null;
when others =>
OK := FALSE;
end case;
exit when not OK;
end loop;
end if;
if not OK then
TERMINAL_INTERFACE.GET_CHARACTER
(CHARTYPE, CHAR, FUNCT);
case CHAR_LIMITS is
when FORM_MANAGER.ALPHA =>
TERMINAL_INTERFACE.PUT_MESSAGE
("Alphabetic Field");
when FORM_MANAGER.ALPHA_NUMERIC =>
TERMINAL_INTERFACE.PUT_MESSAGE
("Alphanumeric Field");
when FORM_MANAGER.NUMERIC =>
TERMINAL_INTERFACE.PUT_MESSAGE
("Numeric Field");
when others =>
null;
end case;
else
exit;
end if;
end loop;
FORM_MANAGER.MODIFY_FIELD_VALUE (FIELD_PTR, VALUE);
end EDIT_FIELD;
function FIRST_FIELD (FORM : FORM_MANAGER.FORM_ACCESS)
return FORM_MANAGER.FIELD_ACCESS is
-- get the first input field of a form
FIELD : FORM_MANAGER.FIELD_ACCESS;
begin
FIELD := FORM_MANAGER.GET_FIRST_FIELD (FORM);
loop
GET_INFO (FIELD);
exit when MODE = FORM_MANAGER.INPUT_OUTPUT;
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
end loop;
return FIELD;
end FIRST_FIELD;
function NEXT_FIELD (FIELD : FORM_MANAGER.FIELD_ACCESS)
return FORM_MANAGER.FIELD_ACCESS is
-- get the next input field of a form
NEXT : FORM_MANAGER.FIELD_ACCESS;
begin
NEXT := FIELD;
loop
NEXT := FORM_MANAGER.GET_NEXT_FIELD (NEXT);
GET_INFO (NEXT);
exit when MODE = FORM_MANAGER.INPUT_OUTPUT;
end loop;
return NEXT;
exception
when FORM_MANAGER.FIELD_NOT_FOUND =>
GET_INFO (FIELD);
return FIELD;
end NEXT_FIELD;
function PREVIOUS_FIELD (FIELD : FORM_MANAGER.FIELD_ACCESS)
return FORM_MANAGER.FIELD_ACCESS is
-- get the next input field of a form
PREVIOUS : FORM_MANAGER.FIELD_ACCESS;
begin
PREVIOUS := FIELD;
loop
PREVIOUS := FORM_MANAGER.GET_PREVIOUS_FIELD (PREVIOUS);
GET_INFO (PREVIOUS);
exit when MODE = FORM_MANAGER.INPUT_OUTPUT;
end loop;
return PREVIOUS;
exception
when FORM_MANAGER.FIELD_NOT_FOUND =>
GET_INFO (FIELD);
return FIELD;
end PREVIOUS_FIELD;
begin
if FIELD'LAST = 0 then
FIELD_PTR := FIRST_FIELD (FORM);
else
FIELD_PTR := FORM_MANAGER.GET_FIELD_POINTER (FORM, FIELD);
GET_INFO (FIELD_PTR);
if MODE /= FORM_MANAGER.INPUT_OUTPUT then
raise INVALID_FIELD;
end if;
end if;
loop
EDIT_FIELD;
TERMINAL_INTERFACE.GET_CHARACTER (CHARTYPE, CHAR, FUNCT);
if CHARTYPE = TERMINAL_INTERFACE.FUNC_TYPE then
case FUNCT is
when TERMINAL_INTERFACE.DOWN_ARROW |
TERMINAL_INTERFACE.TAB_KEY => -- next field
FIELD_PTR := NEXT_FIELD (FIELD_PTR);
when TERMINAL_INTERFACE.UP_ARROW |
TERMINAL_INTERFACE.BACK_TAB => -- previous field
FIELD_PTR := PREVIOUS_FIELD (FIELD_PTR);
when TERMINAL_INTERFACE.RETURN_KEY => -- accept input
return;
when others =>
GET_INFO (FIELD_PTR);
end case;
else
GET_INFO (FIELD_PTR);
end if;
end loop;
exception
when FORM_MANAGER.FIELD_NOT_FOUND =>
raise INVALID_FIELD;
end EDIT_FORM;
begin
FORM_MANAGER.GET_FORM_INFO (FORM, SIZE, BASE_POSITION, CLEAR_OPTION);
if CLEAR_OPTION = FORM_MANAGER.CLEAR then
TERMINAL_INTERFACE.CLEAR_SCREEN;
end if;
begin
-- display fields
FIELD_PTR := FORM_MANAGER.GET_FIRST_FIELD (FORM);
loop
GET_INFO (FIELD_PTR);
POSITION.LINE := POSITION.LINE + BASE_POSITION.LINE - 1;
POSITION.COLUMN := POSITION.COLUMN + BASE_POSITION.COLUMN - 1;
TERMINAL_INTERFACE.PUT_FIELD
(POSITION, LENGTH, RENDITION, VALUE);
FIELD_PTR := FORM_MANAGER.GET_NEXT_FIELD (FIELD_PTR);
end loop;
exception
when FORM_MANAGER.FIELD_NOT_FOUND =>
null;
end;
if BELL then
null; -- no routine to ring bell yet
end if;
EDIT_FORM;
exception
when FORM_MANAGER.NULL_FORM_POINTER =>
raise INVALID_FORM;
end PRESENT_FORM;
--------------------------------------------------------------------------
-- Abstract : QUERY_FIELD is used to get the current value of a field.
--------------------------------------------------------------------------
-- Parameters : FORM - pointer to the form data structure
-- FIELD - name of the field get the value for
-- VALUE - current value of the field
--------------------------------------------------------------------------
procedure QUERY_FIELD (FORM : FORM_PTR;
FIELD : STRING;
VALUE : in out STRING) is
LENGTH : NATURAL;
LOCAL_VALUE : FORM_MANAGER.FIELD_VALUE;
begin
LOCAL_VALUE := FORM_MANAGER.GET_FIELD_VALUE (FORM, FIELD);
LENGTH := VALUE'LAST - VALUE'FIRST + 1;
VALUE (VALUE'FIRST .. VALUE'LAST) := LOCAL_VALUE (1 .. LENGTH);
exception
when FORM_MANAGER.NULL_FORM_POINTER =>
raise INVALID_FORM;
when FORM_MANAGER.FIELD_NAME_NOT_FOUND =>
raise INVALID_FIELD;
end QUERY_FIELD;
--------------------------------------------------------------------------
-- Abstract : RELEASE_FORM releases the form data structure
--------------------------------------------------------------------------
-- Parameters : FORM - pointer to the form data structure
--------------------------------------------------------------------------
procedure RELEASE_FORM (FORM : FORM_PTR) is
begin
FORM_MANAGER.RELEASE_FORM (FORM);
OPEN_FORMS := OPEN_FORMS - 1;
if OPEN_FORMS = 0 then
TERMINAL_INTERFACE.CLOSE;
end if;
exception
when FORM_MANAGER.NULL_FORM_POINTER =>
raise INVALID_FORM;
end RELEASE_FORM;
end FORM_EXECUTOR;
::::::::::
EXECUTOR_SPEC.ADA
::::::::::
--------------------------------------------------------------------------
-- Abstract : This package defines the interfaces to the Form Executor
-- which allows a user program to load a form, display it,
-- and interface with a user at a terminal.
--------------------------------------------------------------------------
with FORM_MANAGER;
package FORM_EXECUTOR is
subtype FORM_PTR is FORM_MANAGER.FORM_ACCESS;
-- open a new form
function ACCESS_FORM (PATHNAME : STRING) return FORM_PTR;
-- get field
procedure QUERY_FIELD (FORM : FORM_PTR;
FIELD : STRING;
VALUE : in out STRING);
-- reinitialize field values
procedure CLEAR_FORM (FORM : FORM_PTR);
-- modify field value
procedure MODIFY_FIELD (FORM : FORM_PTR; FIELD : STRING; VALUE : STRING);
-- display form and accept input
procedure PRESENT_FORM (FORM : FORM_PTR;
BELL : BOOLEAN := FALSE;
FIELD : STRING := "");
-- release form after use
procedure RELEASE_FORM (FORM : FORM_PTR);
-- Exceptions
FORM_ACCESS_ERROR : exception;
INVALID_FORM : exception;
INVALID_FIELD : exception;
end FORM_EXECUTOR;
::::::::::
FORMS.ADA
::::::::::
-------------------------------------------------------------------------
-- Abstract : This package contains all of the form definitions and
-- operations necessary for executing the Interactive
-- Form Generator System.
-------------------------------------------------------------------------
with FORM_TYPES;
with FORM_MANAGER;
package FORMS is
MAIN_MENU : FORM_MANAGER.FORM_ACCESS;
FIELD_MENU : FORM_MANAGER.FORM_ACCESS;
FIELD_NAME_MENU : FORM_MANAGER.FORM_ACCESS;
FORM_MENU : FORM_MANAGER.FORM_ACCESS;
FORM_FILE_MENU : FORM_MANAGER.FORM_ACCESS;
procedure GET_FIELD_INFO
(NAME : in out FORM_MANAGER.FIELD_NAME;
LENGTH : in out FORM_MANAGER.FIELD_LENGTH;
CHAR_LIMITS : in out FORM_MANAGER.CHAR_TYPE;
MODE : in out FORM_MANAGER.FIELD_MODE;
RENDITION : in out FORM_MANAGER.FIELD_RENDITIONS;
INITIAL_VALUE : in out FORM_MANAGER.FIELD_VALUE;
CREATE_FIELD : BOOLEAN);
procedure GET_FIELD_NAME (NAME : in out FORM_MANAGER.FIELD_NAME);
procedure GET_FILE_NAME (NAME : in out STRING; LOAD_FORM : BOOLEAN);
procedure GET_FORM_INFO (SIZE : in out FORM_MANAGER.FORM_SIZE;
POSITION : in out FORM_MANAGER.FORM_POSITION;
CLEAR_OPTION : in out FORM_MANAGER.OPTION_TYPE;
CREATE_FORM : BOOLEAN);
procedure INITIALIZE_FORMS;
end FORMS;
-------------------------------------------------------------------------
-------------------------------------------------------------------------
with FORM_EXECUTOR;
with TEXT_IO;
package body FORMS is
package INTEGER_IO is new TEXT_IO.INTEGER_IO (INTEGER);
-----------------------------------------------------------------------
-- This procedure retrieves a field value from one of the form's fields.
procedure GET_VALUE (FORM : FORM_MANAGER.FORM_ACCESS;
FIELD : STRING;
MIN, MAX : INTEGER;
DEFAULT : INTEGER;
VALUE : out INTEGER) is
BUFFER : STRING (1 .. 3);
LAST : POSITIVE;
TEMP : INTEGER;
begin
FORM_EXECUTOR.QUERY_FIELD (FORM, FIELD, BUFFER);
INTEGER_IO.GET (BUFFER, TEMP, LAST);
if TEMP >= MIN and TEMP <= MAX then
VALUE := TEMP;
else
VALUE := DEFAULT;
end if;
exception
when TEXT_IO.DATA_ERROR | TEXT_IO.END_ERROR =>
VALUE := DEFAULT;
end GET_VALUE;
-----------------------------------------------------------------------
-- This puts a new value into the field of one of the form's fields.
procedure PUT_VALUE (FORM : FORM_MANAGER.FORM_ACCESS;
FIELD : STRING;
VALUE : INTEGER) is
BUFFER : STRING (1 .. 3);
begin
INTEGER_IO.PUT (BUFFER, VALUE);
FORM_EXECUTOR.MODIFY_FIELD (FORM, FIELD, BUFFER);
end PUT_VALUE;
-------------------------------------------------------------------------
-- Abstract : This procedure presents the menu for retrieving field
-- values and attributes.
-------------------------------------------------------------------------
-- Parameters : NAME - The field's name.
-- LENGTH - The field's length.
-- CHAR_LIMITS - The field's character limitations.
-- MODE - The field's display mode.
-- RENDITION - The field's display rendition.
-- INITIAL_VALUE - The field's initial value.
-- CREATE_FIELD - A flag indicating whether this field
-- information retrieval is for a Create
-- Field operation or a Modify Field operation.
-------------------------------------------------------------------------
-- Algorithm : This procedure utilized the Form Executor for retrieving
-- the field's information.
-------------------------------------------------------------------------
procedure GET_FIELD_INFO
(NAME : in out FORM_MANAGER.FIELD_NAME;
LENGTH : in out FORM_MANAGER.FIELD_LENGTH;
CHAR_LIMITS : in out FORM_MANAGER.CHAR_TYPE;
MODE : in out FORM_MANAGER.FIELD_MODE;
RENDITION : in out FORM_MANAGER.FIELD_RENDITIONS;
INITIAL_VALUE : in out FORM_MANAGER.FIELD_VALUE;
CREATE_FIELD : BOOLEAN) is
FIELD : FORM_MANAGER.FIELD_ACCESS;
VALUE : INTEGER;
begin
FORM_EXECUTOR.CLEAR_FORM (FIELD_MENU);
-- If this request is from Modify Field, then insert the field's
-- values and attributes as the initial values for this
-- FIELD_MENU.
if not CREATE_FIELD then
FORM_EXECUTOR.MODIFY_FIELD (FIELD_MENU, "Field Name", NAME);
PUT_VALUE (FIELD_MENU, "Field Length", LENGTH);
-- Transform character limitations to numeric codes.
case CHAR_LIMITS is
when FORM_MANAGER.ALPHA =>
VALUE := 1;
when FORM_MANAGER.NUMERIC =>
VALUE := 2;
when FORM_MANAGER.ALPHA_NUMERIC =>
VALUE := 3;
when FORM_MANAGER.NOT_LIMITED =>
VALUE := 4;
end case;
PUT_VALUE (FIELD_MENU, "Field Limits", VALUE);
-- Transform the display rendition to numeric codes.
case RENDITION is
when FORM_TYPES.PRIMARY_RENDITION =>
VALUE := 1;
when FORM_TYPES.SECONDARY_RENDITION =>
VALUE := 2;
when FORM_TYPES.REVERSE_RENDITION =>
VALUE := 3;
when FORM_TYPES.UNDERLINE_RENDITION =>
VALUE := 4;
end case;
PUT_VALUE (FIELD_MENU, "Field Rendition", VALUE);
-- Transform the display mode to numeric codes.
case MODE is
when FORM_MANAGER.INPUT_OUTPUT =>
VALUE := 1;
when FORM_MANAGER.OUTPUT_ONLY =>
VALUE := 2;
when others =>
VALUE := 0;
end case;
PUT_VALUE (FIELD_MENU, "Field Mode", VALUE);
FORM_EXECUTOR.MODIFY_FIELD
(FIELD_MENU, "Initial Value", INITIAL_VALUE);
end if;
-- If this request is from Modify Field, then do not allow the
-- user to modify the field's name.
if not CREATE_FIELD then
FIELD := FORM_MANAGER.GET_FIELD_POINTER (FIELD_MENU, "Field Name");
FORM_MANAGER.MODIFY_FIELD_MODE (FIELD, FORM_MANAGER.OUTPUT_ONLY);
end if;
-- Present the form to the user.
FORM_EXECUTOR.PRESENT_FORM (FIELD_MENU);
-- Retrieve the inputs from the user.
if CREATE_FIELD then
FORM_EXECUTOR.QUERY_FIELD (FIELD_MENU, "Field Name", NAME);
end if;
GET_VALUE (FIELD_MENU, "Field Length", 1, 80, 10, LENGTH);
-- Transform from numeric codes back to character limitations.
GET_VALUE (FIELD_MENU, "Field Limits", 1, 4, 4, VALUE);
case VALUE is
when 1 =>
CHAR_LIMITS := FORM_MANAGER.ALPHA;
when 2 =>
CHAR_LIMITS := FORM_MANAGER.NUMERIC;
when 3 =>
CHAR_LIMITS := FORM_MANAGER.ALPHA_NUMERIC;
when 4 =>
CHAR_LIMITS := FORM_MANAGER.NOT_LIMITED;
when others =>
CHAR_LIMITS := FORM_MANAGER.NOT_LIMITED;
end case;
-- Transform from numeric codes back to display renditions.
GET_VALUE (FIELD_MENU, "Field Rendition", 1, 4, 1, VALUE);
case VALUE is
when 1 =>
RENDITION := FORM_TYPES.PRIMARY_RENDITION;
when 2 =>
RENDITION := FORM_TYPES.SECONDARY_RENDITION;
when 3 =>
RENDITION := FORM_TYPES.REVERSE_RENDITION;
when 4 =>
RENDITION := FORM_TYPES.UNDERLINE_RENDITION;
when others =>
RENDITION := FORM_TYPES.PRIMARY_RENDITION;
end case;
-- Transform from numeric codes back to display modes.
GET_VALUE (FIELD_MENU, "Field Mode", 1, 2, 1, VALUE);
case VALUE is
when 1 =>
MODE := FORM_MANAGER.INPUT_OUTPUT;
when 2 =>
MODE := FORM_MANAGER.OUTPUT_ONLY;
when others =>
MODE := FORM_MANAGER.INPUT_OUTPUT;
end case;
FORM_EXECUTOR.QUERY_FIELD (FIELD_MENU, "Initial Value", INITIAL_VALUE);
-- If Modify Field, then restore the mode of the Field Name field.
if not CREATE_FIELD then
FORM_MANAGER.MODIFY_FIELD_MODE (FIELD, FORM_MANAGER.INPUT_OUTPUT);
end if;
end GET_FIELD_INFO;
-------------------------------------------------------------------------
-- Abstract : This procedure is used to retrieve the name of a field
-- from the user.
-------------------------------------------------------------------------
-- Parameters : NAME - The field's name.
-------------------------------------------------------------------------
-- Algorithm : This procedure utilizes the Form Executor for retrieving
-- the field name from the user.
-------------------------------------------------------------------------
procedure GET_FIELD_NAME (NAME : in out FORM_MANAGER.FIELD_NAME) is
begin
FORM_EXECUTOR.CLEAR_FORM (FIELD_NAME_MENU);
FORM_EXECUTOR.PRESENT_FORM (FIELD_NAME_MENU);
FORM_EXECUTOR.QUERY_FIELD (FIELD_NAME_MENU, "Field Name", NAME);
end GET_FIELD_NAME;
-------------------------------------------------------------------------
-- Abstract : This procedure is used to retrieve the name of a file
-- from the user.
-------------------------------------------------------------------------
-- Parameters : NAME - The external file's name.
-- LOAD_FORM - A flag indicating whether this filename is
-- being retrived for Load Form or Save Form.
-------------------------------------------------------------------------
-- Algorithm : This procedure utilizes the Form Executor for retrieving
-- the file name from the user.
-------------------------------------------------------------------------
procedure GET_FILE_NAME (NAME : in out STRING; LOAD_FORM : BOOLEAN) is
begin
FORM_EXECUTOR.CLEAR_FORM (FORM_FILE_MENU);
if not LOAD_FORM then
FORM_EXECUTOR.MODIFY_FIELD (FORM_FILE_MENU, "File Name", NAME);
end if;
FORM_EXECUTOR.PRESENT_FORM (FORM_FILE_MENU);
FORM_EXECUTOR.QUERY_FIELD (FORM_FILE_MENU, "File Name", NAME);
end GET_FILE_NAME;
-------------------------------------------------------------------------
-- Abstract : This procedure retrieves the attribute values for a form
-- from the user.
-------------------------------------------------------------------------
-- Parameters : SIZE - The form's size.
-- POSITION - The form's screen position.
-- CLEAR_OPTION - The form's clear screen option.
-- CREATE_FORM - A flag indicating whether this information
-- is being retrieved for Create Form or
-- Modify Form Attributes.
-------------------------------------------------------------------------
-- Algorithm : This procedure utilizes the Form Executor for retrieving
-- the form information from the user.
-------------------------------------------------------------------------
procedure GET_FORM_INFO
(SIZE : in out FORM_MANAGER.FORM_SIZE;
POSITION : in out FORM_MANAGER.FORM_POSITION;
CLEAR_OPTION : in out FORM_MANAGER.OPTION_TYPE;
CREATE_FORM : BOOLEAN) is
BUFFER : STRING (1 .. 4);
begin
FORM_EXECUTOR.CLEAR_FORM (FORM_MENU);
-- If Modify Form Attributes is using this procedure, then
-- initialize this menu with the form's attribute values.
if not CREATE_FORM then
PUT_VALUE (FORM_MENU, "Size Rows", SIZE.ROWS);
PUT_VALUE (FORM_MENU, "Size Columns", SIZE.COLUMNS);
PUT_VALUE (FORM_MENU, "Position Row", POSITION.LINE);
PUT_VALUE (FORM_MENU, "Position Column", POSITION.COLUMN);
case CLEAR_OPTION is
when FORM_MANAGER.CLEAR =>
BUFFER := "Yes ";
when FORM_MANAGER.NO_CLEAR =>
BUFFER := "No ";
when others => null;
end case;
FORM_EXECUTOR.MODIFY_FIELD (FORM_MENU, "Clear Option", BUFFER);
end if;
FORM_EXECUTOR.PRESENT_FORM (FORM_MENU);
-- Retrieve the user supplied values.
GET_VALUE (FORM_MENU, "Size Rows", 1, 24, 24, SIZE.ROWS);
GET_VALUE (FORM_MENU, "Size Columns", 1, 80, 80, SIZE.COLUMNS);
GET_VALUE (FORM_MENU, "Position Row", 1, 24, 1, POSITION.LINE);
GET_VALUE (FORM_MENU, "Position Column", 1, 80, 1, POSITION.COLUMN);
FORM_EXECUTOR.QUERY_FIELD (FORM_MENU, "Clear Option", BUFFER);
case BUFFER (1) is
when 'Y' | 'y' =>
CLEAR_OPTION := FORM_MANAGER.CLEAR;
when 'N' | 'n' =>
CLEAR_OPTION := FORM_MANAGER.NO_CLEAR;
when others => null;
end case;
end GET_FORM_INFO;
-------------------------------------------------------------------------
-- Abstract : This procedure is used to simply create all of the
-- necessary forms that are used by the Interactive
-- Forms Generator System.
-------------------------------------------------------------------------
-- Parameters : none.
-------------------------------------------------------------------------
procedure INITIALIZE_FORMS is
FIELD : FORM_MANAGER.FIELD_ACCESS;
-------------------------------------------------------------------------
-- Build the field values and attributes modification menu.
procedure INIT_FIELD_MENU is
begin
-- Create the Field Menu
FORM_MANAGER.CREATE_FORM
((8, 60), (10, 10), FORM_MANAGER.CLEAR, FIELD_MENU);
FORM_MANAGER.ADD_FIELD
(FIELD_MENU, "", (1, 8), 11, INIT_VALUE => "Field name:",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FIELD_MENU, "Field Name", (1, 20), 32,
CHAR_LIMITS => FORM_MANAGER.ALPHA, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FIELD_MENU, "", (2, 6), 13, INIT_VALUE => "Field length:",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FIELD_MENU, "Field Length", (2, 20), 3,
CHAR_LIMITS => FORM_MANAGER.NUMERIC, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FIELD_MENU, "", (3, 2), 17, INIT_VALUE => "Character limits:",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FIELD_MENU, "Field Limits", (3, 20), 3,
CHAR_LIMITS => FORM_MANAGER.NUMERIC, INIT_VALUE => " 4",
FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FIELD_MENU, "", (3, 25), 27,
INIT_VALUE => "(1-Alphabetic, 2-Numeric,",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FIELD_MENU, "", (4, 26), 30,
INIT_VALUE => "3-Alphanumeric, 4-Not Limited)",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FIELD_MENU, "", (5, 1), 18,
INIT_VALUE => "Display rendition:",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FIELD_MENU, "Field Rendition", (5, 20), 3,
CHAR_LIMITS => FORM_MANAGER.NUMERIC, INIT_VALUE => " 1",
FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FIELD_MENU, "", (5, 25), 24,
INIT_VALUE => "(1-Normal, 2-Secondary,",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FIELD_MENU, "", (6, 26), 23,
INIT_VALUE => "3-Reverse, 4-Underline)",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FIELD_MENU, "", (7, 8), 11, INIT_VALUE => "Field mode:",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FIELD_MENU, "Field Mode", (7, 20), 3,
CHAR_LIMITS => FORM_MANAGER.NUMERIC, INIT_VALUE => " 1",
FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FIELD_MENU, "", (7, 25), 31,
INIT_VALUE => "(1-Input/Output, 2-Output Only)",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FIELD_MENU, "", (8, 5), 14, INIT_VALUE => "Initial value:",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FIELD_MENU, "Initial Value", (8, 20), 40, FIELD => FIELD);
end INIT_FIELD_MENU;
---------------------------------------------------------------------------
-- Build the field name retrieval menu.
procedure INIT_FIELD_NAME_MENU is
begin
-- Create the Field Name Menu
FORM_MANAGER.CREATE_FORM
((1, 70), (24, 1), FORM_MANAGER.NO_CLEAR, FIELD_NAME_MENU);
FORM_MANAGER.ADD_FIELD
(FIELD_NAME_MENU, "", (1, 1), 18,
INIT_VALUE => "Enter field name: ",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FIELD_NAME_MENU, "Field Name", (1, 19), 32,
CHAR_LIMITS => FORM_MANAGER.ALPHA, FIELD => FIELD);
end INIT_FIELD_NAME_MENU;
-------------------------------------------------------------------------
-- Build the file name retrieval menu.
procedure INIT_FILE_MENU is
begin
-- Create the Form File Menu
FORM_MANAGER.CREATE_FORM
((1, 70), (24, 1), FORM_MANAGER.NO_CLEAR, FORM_FILE_MENU);
FORM_MANAGER.ADD_FIELD
(FORM_FILE_MENU, "", (1, 1), 17,
INIT_VALUE => "Enter file name: ",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FORM_FILE_MENU, "File Name", (1, 18), 48, FIELD => FIELD);
end INIT_FILE_MENU;
---------------------------------------------------------------------------
-- Build the form attributes modification menu.
procedure INIT_FORM_MENU is
begin
-- Create the Form Menu
FORM_MANAGER.CREATE_FORM
((3, 60), (10, 18), FORM_MANAGER.CLEAR, FORM_MENU);
FORM_MANAGER.ADD_FIELD
(FORM_MENU, "", (1, 5), 17, INIT_VALUE => "Form size - Rows:",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FORM_MENU, "Size Rows", (1, 23), 3,
CHAR_LIMITS => FORM_MANAGER.NUMERIC, INIT_VALUE => " 24",
FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FORM_MENU, "", (1, 29), 8, INIT_VALUE => "Columns:",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FORM_MENU, "Size Columns", (1, 38), 3,
CHAR_LIMITS => FORM_MANAGER.NUMERIC, INIT_VALUE => " 80",
FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FORM_MENU, "", (2, 1), 21,
INIT_VALUE => "Form position - Row:",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FORM_MENU, "Position Row", (2, 23), 3,
CHAR_LIMITS => FORM_MANAGER.NUMERIC, INIT_VALUE => " 1",
FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FORM_MENU, "", (2, 30), 7, INIT_VALUE => "Column:",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FORM_MENU, "Position Column", (2, 38), 3,
CHAR_LIMITS => FORM_MANAGER.NUMERIC, INIT_VALUE => " 1",
FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FORM_MENU, "", (3, 2), 20,
INIT_VALUE => "Clear screen option:",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FORM_MENU, "Clear Option", (3, 23), 3,
CHAR_LIMITS => FORM_MANAGER.ALPHA, INIT_VALUE => "Yes",
FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(FORM_MENU, "", (3, 29), 9, INIT_VALUE => "(Yes, No)",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
end INIT_FORM_MENU;
--------------------------------------------------------------------------
-- Build the Main Menu
procedure INIT_MAIN_MENU is
begin
-- Create the Main Menu
FORM_MANAGER.CREATE_FORM
((12, 40), (7, 25), FORM_MANAGER.CLEAR, MAIN_MENU);
FORM_MANAGER.ADD_FIELD
(MAIN_MENU, "", (1, 1), 30, FORM_TYPES.UNDERLINE_RENDITION,
INIT_VALUE => "The Interactive Form Generator",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(MAIN_MENU, "", (3, 1), 30,
INIT_VALUE => "Choose ""one"" of the following:",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(MAIN_MENU, "", (5, 6), 21,
INIT_VALUE => "C - Create a new form",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(MAIN_MENU, "", (6, 6), 25,
INIT_VALUE => "L - Load an external form",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(MAIN_MENU, "", (7, 6), 25,
INIT_VALUE => "E - Edit the current form",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(MAIN_MENU, "", (8, 6), 32,
INIT_VALUE => "M - Modify the form's attributes",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(MAIN_MENU, "", (9, 6), 25,
INIT_VALUE => "S - Save the current form",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(MAIN_MENU, "", (10, 6), 8, INIT_VALUE => "Q - Quit",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(MAIN_MENU, "", (12, 6), 10, INIT_VALUE => "Selection:",
MODE => FORM_MANAGER.CONSTANT_TEXT, FIELD => FIELD);
FORM_MANAGER.ADD_FIELD
(MAIN_MENU, "Response", (12, 16), 4,
FORM_TYPES.REVERSE_RENDITION, INIT_VALUE => "____",
FIELD => FIELD);
end INIT_MAIN_MENU;
---------------------------------------------------------------------------
begin
INIT_FIELD_MENU;
INIT_FIELD_NAME_MENU;
INIT_FILE_MENU;
INIT_FORM_MENU;
INIT_MAIN_MENU;
end INITIALIZE_FORMS;
end FORMS;
::::::::::
FORM_TYPES.ADA
::::::::::
--------------------------------------------------------------------------
-- Abstract : This package defines some of the data types for the
-- Form Generator system. These data types are needed by
-- all packages in the system.
--------------------------------------------------------------------------
package FORM_TYPES is
MAX_ROWS : constant INTEGER := 24;
MAX_COLUMNS : constant INTEGER := 80;
subtype ROW_RANGE is INTEGER range 1 .. MAX_ROWS;
subtype COLUMN_RANGE is INTEGER range 1 .. MAX_COLUMNS;
type XY_POSITION is -- defines a screen position
record
LINE : ROW_RANGE;
COLUMN : COLUMN_RANGE;
end record;
type DISPLAY_RENDITIONS is
(PRIMARY_RENDITION, REVERSE_RENDITION, SECONDARY_RENDITION,
UNDERLINE_RENDITION);
end FORM_TYPES;
::::::::::
INTERACT.ADA
::::::::::
-------------------------------------------------------------------------
-- Abstract : This procedure is the entry point for executing the
-- Interactive Form Generator System. This procedure
-- services the Main Menu for the system and called the
-- appropriate routines accordingly.
-------------------------------------------------------------------------
-- Parameters : none.
-------------------------------------------------------------------------
with FORMS;
with FORM_TYPES;
with FORM_EXECUTOR;
with FORM_MANAGER;
with TERMINAL_INTERFACE;
with EDITOR;
procedure INTERACT is
-- These four objects depict the Current Form.
CURRENT_FORM : FORM_MANAGER.FORM_ACCESS;
CURRENT_SIZE : FORM_MANAGER.FORM_SIZE;
CURRENT_POSITION : FORM_MANAGER.FORM_POSITION;
CURRENT_OPTION : FORM_MANAGER.OPTION_TYPE;
CHAR : CHARACTER;
FUNCT : TERMINAL_INTERFACE.FUNCTION_KEY_ENUM;
CHARTYPE : TERMINAL_INTERFACE.CHAR_ENUM;
RESPONSE : STRING (1 .. 6);
FILENAME : STRING (1 .. 48);
CURRENT_FORM_HAS_BEEN_ALTERED : BOOLEAN := false;
CHECK_FOR_FORM_OVERWRITE : exception;
MENU_TOO_LARGE : exception;
SIZE : TERMINAL_INTERFACE.SCREEN_POSITION;
function "=" (LEFT, RIGHT : TERMINAL_INTERFACE.CHAR_ENUM) return BOOLEAN
renames TERMINAL_INTERFACE."=";
function "=" (LEFT, RIGHT : TERMINAL_INTERFACE.FUNCTION_KEY_ENUM)
return BOOLEAN renames TERMINAL_INTERFACE."=";
-- These are the separate procedures that can be called using the
-- user input from the Main Menu.
procedure EDIT_FORM is separate;
procedure CREATE_FORM is separate;
procedure LOAD_FORM is separate;
procedure MODIFY_FORM_ATTRIBUTES is separate;
procedure SAVE_FORM is separate;
-----------------------------------------------------------------
-----------------------------------------------------------------
-- Main menu service routine
-----------------------------------------------------------------
-----------------------------------------------------------------
-- Displays the main level menu to the user and requests that one option
-- be chosen. The possible options to choose are:
--
-- 1) Create a new form,
-- 2) Edit the current form,
-- 3) Load an external form,
-- 4) Modify the current form's attributes,
-- 5) Save the current form, and
-- 6) Quit
begin
-- Open the terminal and initialize the necessary forms.
TERMINAL_INTERFACE.OPEN;
FORMS.INITIALIZE_FORMS; -- Initialize the menu forms.
-- Check terminal size.
TERMINAL_INTERFACE.SCREEN_SIZE (SIZE);
if SIZE.LINE < 12 or else SIZE.COLUMN < 40 then
raise MENU_TOO_LARGE;
end if;
-- Clear the screen and present the Main Menu.
TERMINAL_INTERFACE.CLEAR_SCREEN;
FORM_EXECUTOR.PRESENT_FORM (FORMS.MAIN_MENU);
FORM_EXECUTOR.QUERY_FIELD (FORMS.MAIN_MENU, "Response", RESPONSE);
-- Retrieve user responses until a "quit" is encountered. ( Only the
-- first character of the user responses is used for determining the
-- procedure to call. )
loop
loop
begin
case RESPONSE (1) is
when 'C' | 'c' =>
if CURRENT_FORM_HAS_BEEN_ALTERED then
raise CHECK_FOR_FORM_OVERWRITE;
else
CREATE_FORM;
end if;
when 'L' | 'l' =>
if CURRENT_FORM_HAS_BEEN_ALTERED then
raise CHECK_FOR_FORM_OVERWRITE;
else
LOAD_FORM;
end if;
when 'E' | 'e' =>
EDIT_FORM;
CURRENT_FORM_HAS_BEEN_ALTERED := true;
when 'M' | 'm' => MODIFY_FORM_ATTRIBUTES;
when 'S' | 's' =>
SAVE_FORM;
when 'Q' | 'q' =>
exit;
when others =>
TERMINAL_INTERFACE.PUT_MESSAGE
("Invalid Menu choice -- try again.");
end case;
exit;
exception
when CHECK_FOR_FORM_OVERWRITE =>
TERMINAL_INTERFACE.PUT_MESSAGE
("Enter a RETURN to overwrite Current Form; any " &
"other to abort");
TERMINAL_INTERFACE.GET_CHARACTER (CHARTYPE, CHAR, FUNCT);
while CHARTYPE = TERMINAL_INTERFACE.TIMEOUT loop
TERMINAL_INTERFACE.GET_CHARACTER
(CHARTYPE, CHAR, FUNCT);
end loop;
if CHARTYPE = TERMINAL_INTERFACE.FUNC_TYPE and then
FUNCT = TERMINAL_INTERFACE.RETURN_KEY then
CURRENT_FORM_HAS_BEEN_ALTERED := false;
else
exit;
end if;
end;
end loop;
if RESPONSE (1) = 'Q' or else RESPONSE (1) = 'q' then
if CURRENT_FORM_HAS_BEEN_ALTERED then
TERMINAL_INTERFACE.PUT_MESSAGE
("Enter a RETURN to exit without saving; " &
"any other to abort this quit");
TERMINAL_INTERFACE.GET_CHARACTER (CHARTYPE, CHAR, FUNCT);
while CHARTYPE = TERMINAL_INTERFACE.TIMEOUT loop
TERMINAL_INTERFACE.GET_CHARACTER (CHARTYPE, CHAR, FUNCT);
end loop;
if CHARTYPE = TERMINAL_INTERFACE.FUNC_TYPE and then
FUNCT = TERMINAL_INTERFACE.RETURN_KEY then
exit;
end if;
else
exit;
end if;
end if;
FORM_EXECUTOR.PRESENT_FORM (FORMS.MAIN_MENU);
FORM_EXECUTOR.QUERY_FIELD (FORMS.MAIN_MENU, "Response", RESPONSE);
end loop;
-- When finished, dispose of the Current Form and close the terminal.
FORM_MANAGER.RELEASE_FORM (CURRENT_FORM);
TERMINAL_INTERFACE.CLOSE;
exception
when MENU_TOO_LARGE =>
TERMINAL_INTERFACE.PUT_MESSAGE
("Screen size is too small to display Main Menu");
-- These exception handlers are included so that, in the event that some
-- exception is inadvertently raised internally and not properly handled,
-- that it will not be propagated out as an unhandled exception thereby
-- giving the program user no idea what caused the problem.
when CONSTRAINT_ERROR =>
TERMINAL_INTERFACE.PUT_MESSAGE
("An internal CONSTRAINT_ERROR has been encountered!");
when NUMERIC_ERROR =>
TERMINAL_INTERFACE.PUT_MESSAGE
("An internal NUMERIC_ERROR has been encountered!");
when PROGRAM_ERROR =>
TERMINAL_INTERFACE.PUT_MESSAGE
("An internal PROGRAM_ERROR has been encountered!");
when STORAGE_ERROR =>
TERMINAL_INTERFACE.PUT_MESSAGE
("Memory is full -- STORAGE_ERROR has been encountered!");
when TASKING_ERROR =>
TERMINAL_INTERFACE.PUT_MESSAGE
("An internal TASKING_ERROR has been encountered!");
end INTERACT;
pragma MAIN;
::::::::::
MANAGER_BODY.ADA
::::::::::
--------------------------------------------------------------------------
-- Abstract : This module contains the body for the Form Manager
-- which defines the routines which operate on forms and
-- fields of a form.
--------------------------------------------------------------------------
with TEXT_IO;
package body FORM_MANAGER is
package CHAR_TYPE_IO is new TEXT_IO.ENUMERATION_IO (CHAR_TYPE);
package FIELD_MODE_IO is new TEXT_IO.ENUMERATION_IO (FIELD_MODE);
package RENDITION_IO is new TEXT_IO.ENUMERATION_IO (FIELD_RENDITIONS);
package OPTION_TYPE_IO is new TEXT_IO.ENUMERATION_IO (OPTION_TYPE);
package NUMBER_IO is new TEXT_IO.INTEGER_IO (NATURAL);
--------------------------------------------------------------------------
-- Abstract : CREATE_FORM creates a new form data structure and
-- initializes the attributes of the form.
--------------------------------------------------------------------------
-- Parameters : SIZE - size of the form in rows and columns
-- POSITION - position of the upper left hand corner of the
-- form on the screen in row and column
-- CLEAR_OPTION - indicates whether the screen should be
-- cleared whenever the form is displayed
-- FORM - pointer to the form data structure which is
-- allocated for the form information
--------------------------------------------------------------------------
procedure CREATE_FORM (SIZE : FORM_SIZE;
POSITION : FORM_POSITION;
CLEAR_OPTION : OPTION_TYPE;
FORM : out FORM_ACCESS) is
NEW_FORM : FORM_ACCESS;
begin
if SIZE.ROWS + POSITION.LINE - 1 > FORM_TYPES.MAX_ROWS or
SIZE.COLUMNS + POSITION.COLUMN - 1 > FORM_TYPES.MAX_COLUMNS then
raise FORM_TOO_BIG;
end if;
NEW_FORM := new FORM_RECORD'
(SIZE => (24, 80),
POSITION => (1, 1),
CLEAR_OPTION => CLEAR,
FIRST_FIELD => null);
NEW_FORM.SIZE := SIZE;
NEW_FORM.POSITION := POSITION;
NEW_FORM.CLEAR_OPTION := CLEAR_OPTION;
FORM := NEW_FORM;
exception
when STORAGE_ERROR => -- cannot allocate form data structure
raise FORM_ALLOCATION_ERROR;
end CREATE_FORM;
--------------------------------------------------------------------------
-- Abstract : GET_FORM_INFO returns the current information about a
-- specific form. This information is obtained from the
-- form data structure.
--------------------------------------------------------------------------
-- Parameters : FORM - pointer to the form data structure
-- SIZE - size of the form in rows and columns
-- POSITION - position of the upper left hand corner of the
-- form on the screen in row and column
-- CLEAR_OPTION - indicates whether the screen should be
-- cleared whenever the form is displayed
--------------------------------------------------------------------------
procedure GET_FORM_INFO (FORM : FORM_ACCESS;
SIZE : out FORM_SIZE;
POSITION : out FORM_POSITION;
CLEAR_OPTION : out OPTION_TYPE) is
begin
SIZE := FORM.SIZE;
POSITION := FORM.POSITION;
CLEAR_OPTION := FORM.CLEAR_OPTION;
exception
when CONSTRAINT_ERROR =>
if FORM = null then
raise NULL_FORM_POINTER;
else
raise;
end if;
end GET_FORM_INFO;
--------------------------------------------------------------------------
-- Abstract : MODIFY_FORM_SIZE modifies the size attribute for a form.
--------------------------------------------------------------------------
-- Parameters : FORM - pointer to the form data structure
-- SIZE - size of the form in rows and columns
--------------------------------------------------------------------------
procedure MODIFY_FORM_SIZE (FORM : FORM_ACCESS; SIZE : FORM_SIZE) is
begin
FORM.SIZE := SIZE;
exception
when CONSTRAINT_ERROR =>
if FORM = null then
raise NULL_FORM_POINTER;
else
raise;
end if;
end MODIFY_FORM_SIZE;
--------------------------------------------------------------------------
-- Abstract : MODIFY_FORM_POSITION modifies the position attribute for
-- a form.
--------------------------------------------------------------------------
-- Parameters : FORM - pointer to the form data structure
-- POSITION - position of the upper left hand corner of the
-- form on the screen in row and column
--------------------------------------------------------------------------
procedure MODIFY_FORM_POSITION (FORM : FORM_ACCESS;
POSITION : FORM_POSITION) is
begin
FORM.POSITION := POSITION;
exception
when CONSTRAINT_ERROR =>
if FORM = null then
raise NULL_FORM_POINTER;
else
raise;
end if;
end MODIFY_FORM_POSITION;
--------------------------------------------------------------------------
-- Abstract : MODIFY_FORM_OPTION modifies the clear display option
-- for a form when it is presented.
--------------------------------------------------------------------------
-- Parameters : FORM - pointer to the form data structure
-- CLEAR_OPTION - indicates whether the screen should be
-- cleared whenever the form is displayed
--------------------------------------------------------------------------
procedure MODIFY_FORM_OPTION (FORM : FORM_ACCESS;
CLEAR_OPTION : OPTION_TYPE) is
begin
FORM.CLEAR_OPTION := CLEAR_OPTION;
exception
when CONSTRAINT_ERROR =>
if FORM = null then
raise NULL_FORM_POINTER;
else
raise;
end if;
end MODIFY_FORM_OPTION;
--------------------------------------------------------------------------
-- Abstract : CLEAR_FORM resets the values of all the fields to their
-- initial value.
--------------------------------------------------------------------------
-- Parameters : FORM - pointer to the form data structure
--------------------------------------------------------------------------
procedure CLEAR_FORM (FORM : FORM_ACCESS) is
FIELD : FIELD_ACCESS;
begin
FIELD := FORM.FIRST_FIELD;
while FIELD /= null loop
FIELD.VALUE := FIELD.INIT_VALUE;
FIELD := FIELD.NEXT_FIELD;
end loop;
exception
when CONSTRAINT_ERROR =>
if FORM = null then
raise NULL_FORM_POINTER;
else
raise;
end if;
end CLEAR_FORM;
--------------------------------------------------------------------------
-- Abstract : LOAD_FORM loads a form definition from an external file.
--------------------------------------------------------------------------
-- Parameters : PATHNAME - string which contains the pathname of the file
-- to be loaded
-- FORM - pointer to the data structure for the loaded form
--------------------------------------------------------------------------
-- Algorithm : Standard Text I/O is used to load the file definition.
-- Packages are used to read values of the enumerations.
--------------------------------------------------------------------------
procedure LOAD_FORM (PATHNAME : STRING; FORM : out FORM_ACCESS) is
INPUT : TEXT_IO.FILE_TYPE;
FIRST : NATURAL;
LAST : NATURAL;
NEW_FORM : FORM_ACCESS;
CLEAR_OPTION : OPTION_TYPE;
COLUMN : FORM_TYPES.COLUMN_RANGE;
LINE : FORM_TYPES.ROW_RANGE;
SIZE : FORM_SIZE;
NEW_FIELD : FIELD_ACCESS;
CHAR_LIMITS : CHAR_TYPE;
INIT_VALUE : FIELD_VALUE;
LENGTH : FIELD_LENGTH;
MODE : FIELD_MODE;
NAME : FIELD_NAME;
RENDITION : FIELD_RENDITIONS;
begin
FIRST := PATHNAME'FIRST;
LAST := PATHNAME'LAST;
while FIRST < LAST and PATHNAME (FIRST) = ' ' loop
-- trim leading blanks
FIRST := FIRST + 1;
end loop;
while FIRST < LAST and PATHNAME (LAST) = ' ' loop
-- trim trailing blanks
LAST := LAST - 1;
end loop;
TEXT_IO.OPEN (INPUT, TEXT_IO.IN_FILE, PATHNAME (FIRST .. LAST));
NUMBER_IO.GET (INPUT, SIZE.ROWS);
NUMBER_IO.GET (INPUT, SIZE.COLUMNS);
NUMBER_IO.GET (INPUT, LINE);
NUMBER_IO.GET (INPUT, COLUMN);
OPTION_TYPE_IO.GET (INPUT, CLEAR_OPTION);
TEXT_IO.SKIP_LINE (INPUT);
CREATE_FORM (SIZE, (LINE, COLUMN), CLEAR_OPTION, NEW_FORM);
while not TEXT_IO.END_OF_FILE (INPUT) loop
TEXT_IO.GET (INPUT, NAME);
TEXT_IO.SKIP_LINE (INPUT);
NUMBER_IO.GET (INPUT, LINE);
NUMBER_IO.GET (INPUT, COLUMN);
NUMBER_IO.GET (INPUT, LENGTH);
CHAR_TYPE_IO.GET (INPUT, CHAR_LIMITS);
FIELD_MODE_IO.GET (INPUT, MODE);
RENDITION_IO.GET (INPUT, RENDITION);
TEXT_IO.SKIP_LINE (INPUT);
TEXT_IO.GET (INPUT, INIT_VALUE);
TEXT_IO.SKIP_LINE (INPUT);
ADD_FIELD
(NEW_FORM, NAME, (LINE, COLUMN), LENGTH, RENDITION,
CHAR_LIMITS, INIT_VALUE, MODE, NEW_FIELD);
end loop;
TEXT_IO.CLOSE (INPUT);
FORM := NEW_FORM;
exception
when TEXT_IO.NAME_ERROR =>
raise FILE_NOT_FOUND;
when TEXT_IO.STATUS_ERROR =>
raise FILE_ALREADY_OPEN;
when TEXT_IO.DATA_ERROR =>
raise FILE_DATA_ERROR;
end LOAD_FORM;
--------------------------------------------------------------------------
-- Abstract : SAVE_FORM saves a form definition in an external file.
--------------------------------------------------------------------------
-- Parameters : FORM - pointer to the form data structure to be saved
-- PATHNAME - string which contains the pathname of the file
-- where the form is to be saved
--------------------------------------------------------------------------
-- Algorithm : Standard Text I/O is used to save the file definition.
-- Packages are used to write values of the enumerations.
--------------------------------------------------------------------------
procedure SAVE_FORM (FORM : FORM_ACCESS; PATHNAME : STRING) is
FIELD : FIELD_ACCESS;
FIRST : NATURAL;
LAST : NATURAL;
OUTPUT : TEXT_IO.FILE_TYPE;
begin
if FORM = null then
raise NULL_FORM_POINTER;
end if;
FIRST := PATHNAME'FIRST;
LAST := PATHNAME'LAST;
while FIRST < LAST and PATHNAME (FIRST) = ' ' loop
-- trim leading blanks
FIRST := FIRST + 1;
end loop;
while FIRST < LAST and PATHNAME (LAST) = ' ' loop
-- trim trailing blanks
LAST := LAST - 1;
end loop;
TEXT_IO.CREATE (OUTPUT, TEXT_IO.OUT_FILE, PATHNAME (FIRST .. LAST));
NUMBER_IO.PUT (OUTPUT, FORM.SIZE.ROWS, 3);
NUMBER_IO.PUT (OUTPUT, FORM.SIZE.COLUMNS, 3);
NUMBER_IO.PUT (OUTPUT, FORM.POSITION.LINE, 3);
NUMBER_IO.PUT (OUTPUT, FORM.POSITION.COLUMN, 3);
TEXT_IO.PUT (OUTPUT, ' ');
OPTION_TYPE_IO.PUT (OUTPUT, FORM.CLEAR_OPTION);
TEXT_IO.NEW_LINE (OUTPUT);
FIELD := FORM.FIRST_FIELD;
while FIELD /= null loop
TEXT_IO.PUT (OUTPUT, FIELD.NAME);
TEXT_IO.NEW_LINE (OUTPUT);
NUMBER_IO.PUT (OUTPUT, FIELD.POSITION.LINE, 3);
NUMBER_IO.PUT (OUTPUT, FIELD.POSITION.COLUMN, 3);
NUMBER_IO.PUT (OUTPUT, FIELD.LENGTH, 3);
TEXT_IO.PUT (OUTPUT, ' ');
CHAR_TYPE_IO.PUT (OUTPUT, FIELD.CHAR_LIMITS);
TEXT_IO.PUT (OUTPUT, ' ');
FIELD_MODE_IO.PUT (OUTPUT, FIELD.MODE);
TEXT_IO.PUT (OUTPUT, ' ');
RENDITION_IO.PUT (OUTPUT, FIELD.RENDITION);
TEXT_IO.NEW_LINE (OUTPUT);
TEXT_IO.PUT (OUTPUT, FIELD.INIT_VALUE);
TEXT_IO.NEW_LINE (OUTPUT);
FIELD := FIELD.NEXT_FIELD;
end loop;
TEXT_IO.CLOSE (OUTPUT);
exception
when TEXT_IO.STATUS_ERROR =>
raise FILE_ALREADY_OPEN;
end SAVE_FORM;
--------------------------------------------------------------------------
-- Abstract : RELEASE_FORM releases all the memory allocated for a
-- form and its fields.
--------------------------------------------------------------------------
-- Parameters : FORM - pointer to the form data structure
--------------------------------------------------------------------------
-- Algorithm : Currently this routine does nothing because memory
-- deallocation is not supported the some versions of Ada.
--------------------------------------------------------------------------
procedure RELEASE_FORM (FORM : FORM_ACCESS) is
begin
null; -- stub
end RELEASE_FORM;
procedure INSERT_FIELD (FIELD : FIELD_ACCESS);
procedure REMOVE_FIELD (FIELD : FIELD_ACCESS);
--------------------------------------------------------------------------
-- Abstract : ADD_FIELD adds a field to a form and initializes the
-- the field information data structure.
--------------------------------------------------------------------------
-- Parameters : FORM - pointer to the form data structure
-- NAME - name of the field as a string
-- POSITION - position of the field within the form
-- LENGTH - length of the field
-- RENDITION - rendition in which the field is displayed
-- CHAR_LIMITS - character limitation for field contents
-- INIT_VALUE - initial value of field if not modified
-- MODE - type of field (constant, output only, input/output)
-- FIELD - pointer to created field data structure
--------------------------------------------------------------------------
procedure ADD_FIELD
(FORM : FORM_ACCESS;
NAME : STRING;
POSITION : FIELD_POSITION;
LENGTH : FIELD_LENGTH;
RENDITION : FIELD_RENDITIONS :=
FORM_TYPES.PRIMARY_RENDITION;
CHAR_LIMITS : CHAR_TYPE := NOT_LIMITED;
INIT_VALUE : STRING := "";
MODE : FIELD_MODE := INPUT_OUTPUT;
FIELD : out FIELD_ACCESS) is
NEW_FIELD : FIELD_ACCESS;
STRING_LENGTH : NATURAL;
INDEX : INTEGER;
begin
if NAME'LENGTH > 0 then
begin
-- see if field name already exists
NEW_FIELD := GET_FIELD_POINTER (FORM, NAME);
for INDEX in NAME'FIRST .. NAME'LAST loop
if NAME (INDEX -- field found
) /= ' ' then
raise DUPLICATE_FIELD_NAME;
end if;
end loop;
exception
when FIELD_NAME_NOT_FOUND => -- no field found
null;
end;
end if;
NEW_FIELD := new FIELD_RECORD;
STRING_LENGTH := NAME'LENGTH;
if (STRING_LENGTH > MAX_FIELD_NAME) then
STRING_LENGTH := MAX_FIELD_NAME;
else
NEW_FIELD.NAME := (1 .. MAX_FIELD_NAME => ' ');
end if;
NEW_FIELD.NAME (1 .. STRING_LENGTH) :=
NAME (NAME'FIRST .. NAME'FIRST + STRING_LENGTH - 1);
NEW_FIELD.POSITION := POSITION;
NEW_FIELD.LENGTH := LENGTH;
NEW_FIELD.RENDITION := RENDITION;
NEW_FIELD.CHAR_LIMITS := CHAR_LIMITS;
STRING_LENGTH := INIT_VALUE'LENGTH;
if (STRING_LENGTH > MAX_FIELD_VALUE) then
STRING_LENGTH := MAX_FIELD_VALUE;
else
NEW_FIELD.INIT_VALUE := (1 .. MAX_FIELD_VALUE => ' ');
end if;
NEW_FIELD.INIT_VALUE (1 .. STRING_LENGTH) :=
INIT_VALUE (INIT_VALUE'FIRST .. INIT_VALUE'FIRST + STRING_LENGTH - 1);
NEW_FIELD.VALUE := NEW_FIELD.INIT_VALUE;
NEW_FIELD.MODE := MODE;
NEW_FIELD.FORM := FORM;
INSERT_FIELD (NEW_FIELD);
FIELD := NEW_FIELD;
exception
when STORAGE_ERROR =>
raise FIELD_ALLOCATION_ERROR;
when CONSTRAINT_ERROR =>
if FORM = null then
raise NULL_FORM_POINTER;
else
raise;
end if;
end ADD_FIELD;
--------------------------------------------------------------------------
-- Abstract : COPY_FIELD creates a new field from information from
-- another field in the form.
--------------------------------------------------------------------------
-- Parameters : FIELD - pointer to the field data structure to be copied
-- NEW_NAME - name of the new field
-- NEW_POSITION - position of the new field with the form
-- NEW_FIELD - pointer to the create field data structure
--------------------------------------------------------------------------
procedure COPY_FIELD (FIELD : FIELD_ACCESS;
NEW_NAME : STRING;
NEW_POSITION : FIELD_POSITION;
NEW_FIELD : out FIELD_ACCESS) is
begin
ADD_FIELD
(FIELD.FORM, NEW_NAME, NEW_POSITION, FIELD.LENGTH, FIELD.RENDITION,
FIELD.CHAR_LIMITS, FIELD.INIT_VALUE, FIELD.MODE, NEW_FIELD);
exception
when CONSTRAINT_ERROR =>
if FIELD = null then
raise NULL_FIELD_POINTER;
else
raise;
end if;
end COPY_FIELD;
--------------------------------------------------------------------------
-- Abstract : DELETE_FIELD deletes a field from a form
--------------------------------------------------------------------------
-- Parameters : FIELD - pointer to the field data structure to be deleted
--------------------------------------------------------------------------
procedure DELETE_FIELD (FIELD : FIELD_ACCESS) is
begin
REMOVE_FIELD (FIELD);
end DELETE_FIELD;
--------------------------------------------------------------------------
-- Abstract : INSERT_FIELD inserts a field data structure into the
-- list of fields for a form based on its position
--------------------------------------------------------------------------
-- Parameters : FIELD - pointer to the field data structure
--------------------------------------------------------------------------
-- Algorithm : The field is inserted into the list of fields in order
-- of position within the form (left to right, top to bottom)
--------------------------------------------------------------------------
procedure INSERT_FIELD (FIELD : FIELD_ACCESS) is
FORM : FORM_ACCESS;
NEXT_FIELD : FIELD_ACCESS;
PREV_FIELD : FIELD_ACCESS;
begin
FORM := FIELD.FORM;
if FIELD.POSITION.LINE > FORM.SIZE.ROWS or
FIELD.POSITION.COLUMN > FORM.SIZE.COLUMNS then
raise POSITION_OUT_OF_FORM_RANGE;
end if;
if FIELD.POSITION.COLUMN + FIELD.LENGTH - 1 > FORM.SIZE.COLUMNS then
raise FIELD_EXTENDS_PAST_FORM;
end if;
NEXT_FIELD := FORM.FIRST_FIELD;
PREV_FIELD := null;
while NEXT_FIELD /= null and then
(FIELD.POSITION.LINE > NEXT_FIELD.POSITION.LINE or else
(FIELD.POSITION.LINE = NEXT_FIELD.POSITION.LINE and then
FIELD.POSITION.COLUMN > NEXT_FIELD.POSITION.COLUMN)) loop
PREV_FIELD := NEXT_FIELD;
NEXT_FIELD := PREV_FIELD.NEXT_FIELD;
end loop;
if PREV_FIELD /= null and then
PREV_FIELD.POSITION.LINE = FIELD.POSITION.LINE and then
PREV_FIELD.POSITION.COLUMN + PREV_FIELD.LENGTH >
FIELD.POSITION.COLUMN then
raise FIELD_OVERLAP_OCCURRED;
end if;
if NEXT_FIELD /= null and then
FIELD.POSITION.LINE = NEXT_FIELD.POSITION.LINE and then
FIELD.POSITION.COLUMN + FIELD.LENGTH >
NEXT_FIELD.POSITION.COLUMN then
raise FIELD_OVERLAP_OCCURRED;
end if;
FIELD.PREV_FIELD := PREV_FIELD;
FIELD.NEXT_FIELD := NEXT_FIELD;
if PREV_FIELD = null then
FORM.FIRST_FIELD := FIELD;
else
PREV_FIELD.NEXT_FIELD := FIELD;
end if;
if NEXT_FIELD /= null then
NEXT_FIELD.PREV_FIELD := FIELD;
end if;
exception
when CONSTRAINT_ERROR =>
if FIELD = null then
raise NULL_FIELD_POINTER;
elsif FORM = null then
raise NULL_FORM_POINTER;
else
raise;
end if;
end INSERT_FIELD;
--------------------------------------------------------------------------
-- Abstract : MOVE_FIELD moves a field from one location in the form
-- to another without changing any other attributes.
--------------------------------------------------------------------------
-- Parameters : FIELD - pointer to the field data structure to be moved
-- NEW_POSITION - position where the field is to be moved
--------------------------------------------------------------------------
-- Algorithm : The field is removed from form and then reinserted at the
-- new location.
--------------------------------------------------------------------------
procedure MOVE_FIELD (FIELD : FIELD_ACCESS;
NEW_POSITION : FIELD_POSITION) is
begin
REMOVE_FIELD (FIELD);
FIELD.POSITION := NEW_POSITION;
INSERT_FIELD (FIELD);
end MOVE_FIELD;
--------------------------------------------------------------------------
-- Abstract : REMOVE_FIELD removes a field from the list of fields for
-- a form.
--------------------------------------------------------------------------
-- Parameters : FIELD - pointer to the field data structure to be removed
--------------------------------------------------------------------------
procedure REMOVE_FIELD (FIELD : FIELD_ACCESS) is
begin
if FIELD.PREV_FIELD = null then
FIELD.FORM.FIRST_FIELD := FIELD.NEXT_FIELD;
else
FIELD.PREV_FIELD.NEXT_FIELD := FIELD.NEXT_FIELD;
end if;
if FIELD.NEXT_FIELD /= null then
FIELD.NEXT_FIELD.PREV_FIELD := FIELD.PREV_FIELD;
end if;
exception
when CONSTRAINT_ERROR =>
if FIELD = null then
raise NULL_FIELD_POINTER;
else
raise;
end if;
end REMOVE_FIELD;
--------------------------------------------------------------------------
-- Abstract : GET_FIELD_VALUE returns the current value of a field
-- given its name.
--------------------------------------------------------------------------
-- Parameters : FORM - pointer to the form data structure
-- NAME - name of the field for which the value is desired
--------------------------------------------------------------------------
function GET_FIELD_VALUE (FORM : FORM_ACCESS;
NAME : STRING) return FIELD_VALUE is
FIELD : FIELD_ACCESS;
begin
FIELD := GET_FIELD_POINTER (FORM, NAME);
return FIELD.VALUE;
end GET_FIELD_VALUE;
--------------------------------------------------------------------------
-- Abstract : GET_FIELD_POINTER returns the pointer to a field given
-- its field name.
--------------------------------------------------------------------------
-- Parameters : FORM - pointer to form data structure
-- NAME - name of the field whose pointer is desired
--------------------------------------------------------------------------
-- Algorithm : Searches the list of fields until it comes to the
-- field whose name matches the input name.
--------------------------------------------------------------------------
function GET_FIELD_POINTER (FORM : FORM_ACCESS;
NAME : STRING) return FIELD_ACCESS is
FIELD : FIELD_ACCESS;
FULL_NAME : FIELD_NAME;
STRING_LENGTH : NATURAL;
begin
STRING_LENGTH := NAME'LENGTH;
if (STRING_LENGTH > MAX_FIELD_NAME) then
STRING_LENGTH := MAX_FIELD_NAME;
else
FULL_NAME := (1 .. MAX_FIELD_NAME => ' ');
end if;
FULL_NAME (1 .. STRING_LENGTH) :=
NAME (NAME'FIRST .. NAME'FIRST + STRING_LENGTH - 1);
FIELD := FORM.FIRST_FIELD;
while FIELD /= null loop
if FULL_NAME = FIELD.NAME then
return FIELD;
end if;
FIELD := FIELD.NEXT_FIELD;
end loop;
raise FIELD_NAME_NOT_FOUND;
exception
when CONSTRAINT_ERROR =>
if FORM = null then
raise NULL_FORM_POINTER;
else
raise;
end if;
end GET_FIELD_POINTER;
--------------------------------------------------------------------------
-- Abstract : GET_FIELD_POINTER returns the pointer to a field given
-- its field position.
--------------------------------------------------------------------------
-- Parameters : FORM - pointer to form data structure
-- POSITION - position of the field with the form
--------------------------------------------------------------------------
-- Algorithm : Searches the list of fields until it comes to the
-- field whose position matches the input position.
--------------------------------------------------------------------------
function GET_FIELD_POINTER (FORM : FORM_ACCESS;
POSITION : FIELD_POSITION)
return FIELD_ACCESS is
FIELD : FIELD_ACCESS;
begin
FIELD := FORM.FIRST_FIELD;
while FIELD /= null loop
if POSITION.LINE = FIELD.POSITION.LINE and then
POSITION.COLUMN >= FIELD.POSITION.COLUMN and then
POSITION.COLUMN < FIELD.POSITION.COLUMN + FIELD.LENGTH then
return FIELD;
end if;
FIELD := FIELD.NEXT_FIELD;
end loop;
raise FIELD_POSITION_NOT_FOUND;
exception
when CONSTRAINT_ERROR =>
if FORM = null then
raise NULL_FORM_POINTER;
else
raise;
end if;
end GET_FIELD_POINTER;
--------------------------------------------------------------------------
-- Abstract : GET_FIELD_INFO returns the current information for a
-- field.
--------------------------------------------------------------------------
-- Parameters : FIELD - pointer to the field data structure
-- NAME - name of the field as a string
-- POSITION - position of the field within the form
-- LENGTH - length of the field
-- RENDITION - rendition in which the field is displayed
-- CHAR_LIMITS - character limitation for field contents
-- INIT_VALUE - initial value of field if not modified
-- VALUE - current value of the field
-- MODE - type of field (constant, output only, input/output)
--------------------------------------------------------------------------
procedure GET_FIELD_INFO (FIELD : FIELD_ACCESS;
NAME : out FIELD_NAME;
POSITION : out FIELD_POSITION;
LENGTH : out FIELD_LENGTH;
RENDITION : out FIELD_RENDITIONS;
CHAR_LIMITS : out CHAR_TYPE;
INIT_VALUE : out FIELD_VALUE;
VALUE : out FIELD_VALUE;
MODE : out FIELD_MODE) is
begin
NAME := FIELD.NAME;
POSITION := FIELD.POSITION;
LENGTH := FIELD.LENGTH;
RENDITION := FIELD.RENDITION;
CHAR_LIMITS := FIELD.CHAR_LIMITS;
INIT_VALUE := FIELD.INIT_VALUE;
VALUE := FIELD.VALUE;
MODE := FIELD.MODE;
exception
when CONSTRAINT_ERROR =>
if FIELD = null then
raise NULL_FIELD_POINTER;
else
raise;
end if;
end GET_FIELD_INFO;
--------------------------------------------------------------------------
-- Abstract : MODIFY_FIELD_LENGTH modifies the length of a field.
--------------------------------------------------------------------------
-- Parameters : FIELD - pointer to the field data structure
-- LENGTH - length of the field
--------------------------------------------------------------------------
procedure MODIFY_FIELD_LENGTH (FIELD : FIELD_ACCESS;
LENGTH : FIELD_LENGTH) is
NEXT_FIELD : FIELD_ACCESS;
begin
if FIELD.POSITION.COLUMN + LENGTH - 1 > FIELD.FORM.SIZE.COLUMNS then
raise FIELD_EXTENDS_PAST_FORM;
end if;
if FIELD.NEXT_FIELD /= null then
NEXT_FIELD := FIELD.NEXT_FIELD;
if FIELD.POSITION.LINE = NEXT_FIELD.POSITION.LINE and then
FIELD.POSITION.COLUMN + LENGTH - 1 >
NEXT_FIELD.POSITION.COLUMN then
raise FIELD_OVERLAP_OCCURRED;
end if;
end if;
FIELD.LENGTH := LENGTH;
exception
when CONSTRAINT_ERROR =>
if FIELD = null then
raise NULL_FIELD_POINTER;
else
raise;
end if;
end MODIFY_FIELD_LENGTH;
--------------------------------------------------------------------------
-- Abstract : MODIFY_FIELD_RENDITION modifies the display rendition
-- for a field.
--------------------------------------------------------------------------
-- Parameters : FIELD - pointer to the field data structure
-- RENDITION - rendition in which the field is displayed
--------------------------------------------------------------------------
procedure MODIFY_FIELD_RENDITION (FIELD : FIELD_ACCESS;
RENDITION : FIELD_RENDITIONS) is
begin
FIELD.RENDITION := RENDITION;
exception
when CONSTRAINT_ERROR =>
if FIELD = null then
raise NULL_FIELD_POINTER;
else
raise;
end if;
end MODIFY_FIELD_RENDITION;
--------------------------------------------------------------------------
-- Abstract : MODIFY_FIELD_LIMITS modifies the character limitation
-- for a field
--------------------------------------------------------------------------
-- Parameters : FIELD - pointer to the field data structure
-- CHAR_LIMITS - character limitation for field contents
--------------------------------------------------------------------------
procedure MODIFY_FIELD_LIMITS (FIELD : FIELD_ACCESS;
CHAR_LIMITS : CHAR_TYPE) is
begin
FIELD.CHAR_LIMITS := CHAR_LIMITS;
exception
when CONSTRAINT_ERROR =>
if FIELD = null then
raise NULL_FIELD_POINTER;
else
raise;
end if;
end MODIFY_FIELD_LIMITS;
--------------------------------------------------------------------------
-- Abstract : MODIFY_FIELD_INIT modifies the initial value of a field
--------------------------------------------------------------------------
-- Parameters : FIELD - pointer to the field data structure
-- INIT_VALUE - initial value of field if not modified
--------------------------------------------------------------------------
procedure MODIFY_FIELD_INIT (FIELD : FIELD_ACCESS;
INIT_VALUE : STRING) is
STRING_LENGTH : NATURAL;
begin
STRING_LENGTH := INIT_VALUE'LENGTH;
if (STRING_LENGTH > MAX_FIELD_VALUE) then
STRING_LENGTH := MAX_FIELD_VALUE;
else
FIELD.INIT_VALUE := (1 .. MAX_FIELD_VALUE => ' ');
end if;
FIELD.INIT_VALUE (1 .. STRING_LENGTH) :=
INIT_VALUE (INIT_VALUE'FIRST .. INIT_VALUE'FIRST + STRING_LENGTH - 1);
exception
when CONSTRAINT_ERROR =>
if FIELD = null then
raise NULL_FIELD_POINTER;
else
raise;
end if;
end MODIFY_FIELD_INIT;
--------------------------------------------------------------------------
-- Abstract : MODIFY_FIELD_VALUE modifies the current value of a field
--------------------------------------------------------------------------
-- Parameters : FIELD - pointer to the field data structure
-- VALUE - current value of the field
--------------------------------------------------------------------------
-- Algorithm : Cannot change the value of a constant field.
--------------------------------------------------------------------------
procedure MODIFY_FIELD_VALUE (FIELD : FIELD_ACCESS; VALUE : STRING) is
STRING_LENGTH : NATURAL;
begin
if FIELD.MODE = CONSTANT_TEXT then
raise CONSTANT_FIELD_ERROR;
end if;
STRING_LENGTH := VALUE'LENGTH;
if (STRING_LENGTH > MAX_FIELD_VALUE) then
STRING_LENGTH := MAX_FIELD_VALUE;
else
FIELD.VALUE := (1 .. MAX_FIELD_VALUE => ' ');
end if;
FIELD.VALUE (1 .. STRING_LENGTH) :=
VALUE (VALUE'FIRST .. VALUE'FIRST + STRING_LENGTH - 1);
exception
when CONSTRAINT_ERROR =>
if FIELD = null then
raise NULL_FIELD_POINTER;
else
raise;
end if;
end MODIFY_FIELD_VALUE;
--------------------------------------------------------------------------
-- Abstract : MODIFY_FIELD_MODE modifies the mode attribute of a field
--------------------------------------------------------------------------
-- Parameters : FIELD - pointer to the field data structure
-- MODE - type of field (constant, output only, input/output)
--------------------------------------------------------------------------
procedure MODIFY_FIELD_MODE (FIELD : FIELD_ACCESS; MODE : FIELD_MODE) is
begin
FIELD.MODE := MODE;
exception
when CONSTRAINT_ERROR =>
if FIELD = null then
raise NULL_FIELD_POINTER;
else
raise;
end if;
end MODIFY_FIELD_MODE;
--------------------------------------------------------------------------
-- Abstract : GET_FIRST_FIELD returns the first field of the form.
--------------------------------------------------------------------------
-- Parameters : FORM - pointer to the form data structure
--------------------------------------------------------------------------
function GET_FIRST_FIELD (FORM : FORM_ACCESS) return FIELD_ACCESS is
begin
if FORM.FIRST_FIELD = null then
raise FIELD_NOT_FOUND;
else
return FORM.FIRST_FIELD;
end if;
exception
when CONSTRAINT_ERROR =>
if FORM = null then
raise NULL_FORM_POINTER;
else
raise;
end if;
end GET_FIRST_FIELD;
--------------------------------------------------------------------------
-- Abstract : GET_FIRST_FIELD returns the first field of a row of a form
--------------------------------------------------------------------------
-- Parameters : FORM - pointer to the form data structure
-- ROW - row for which the field is desired
--------------------------------------------------------------------------
function GET_FIRST_FIELD (FORM : FORM_ACCESS;
ROW : FORM_TYPES.ROW_RANGE)
return FIELD_ACCESS is
FIELD : FIELD_ACCESS;
begin
if ROW < 1 or ROW > FORM.SIZE.ROWS then
raise INVALID_ROW_NUMBER;
end if;
FIELD := FORM.FIRST_FIELD;
while FIELD /= null and then FIELD.POSITION.LINE < ROW loop
FIELD := FIELD.NEXT_FIELD;
end loop;
if FIELD = null or else FIELD.POSITION.LINE > ROW then
raise FIELD_NOT_FOUND;
end if;
return FIELD;
exception
when CONSTRAINT_ERROR =>
if FORM = null then
raise NULL_FORM_POINTER;
else
raise;
end if;
end GET_FIRST_FIELD;
--------------------------------------------------------------------------
-- Abstract : GET_NEXT_FIELD returns the next field after a field.
--------------------------------------------------------------------------
-- Parameters : FIELD - pointer to the field data structure
--------------------------------------------------------------------------
function GET_NEXT_FIELD (FIELD : FIELD_ACCESS) return FIELD_ACCESS is
begin
if FIELD.NEXT_FIELD = null then
raise FIELD_NOT_FOUND;
else
return FIELD.NEXT_FIELD;
end if;
exception
when CONSTRAINT_ERROR =>
if FIELD = null then
raise NULL_FIELD_POINTER;
else
raise;
end if;
end GET_NEXT_FIELD;
--------------------------------------------------------------------------
-- Abstract : GET_PREVIOUS_FIELD returns the field in front of a field.
--------------------------------------------------------------------------
-- Parameters : FIELD - pointer to the field data structure
--------------------------------------------------------------------------
function GET_PREVIOUS_FIELD (FIELD : FIELD_ACCESS) return FIELD_ACCESS is
begin
if FIELD.PREV_FIELD = null then
raise FIELD_NOT_FOUND;
else
return FIELD.PREV_FIELD;
end if;
exception
when CONSTRAINT_ERROR =>
if FIELD = null then
raise NULL_FIELD_POINTER;
else
raise;
end if;
end GET_PREVIOUS_FIELD;
end FORM_MANAGER;
::::::::::
MANAGER_SPEC.ADA
::::::::::
--------------------------------------------------------------------------
-- Abstract : This package defines the types and routines to operate
-- on forms and fields of a form.
--------------------------------------------------------------------------
with FORM_TYPES;
package FORM_MANAGER is
-- Visible Form Types
MAX_FIELD_NAME : constant INTEGER := 32;
MAX_FIELD_VALUE : constant INTEGER := 80;
subtype FORM_POSITION is FORM_TYPES.XY_POSITION;
type FORM_SIZE is -- form size record
record
ROWS : FORM_TYPES.ROW_RANGE;
COLUMNS : FORM_TYPES.COLUMN_RANGE;
end record;
type OPTION_TYPE is (CLEAR, NO_CLEAR);
-- Visible Field Types
type CHAR_TYPE is (ALPHA, NUMERIC, ALPHA_NUMERIC, NOT_LIMITED);
subtype FIELD_LENGTH is INTEGER range 1 .. FORM_TYPES.MAX_COLUMNS;
type FIELD_MODE is (CONSTANT_TEXT, OUTPUT_ONLY, INPUT_OUTPUT);
subtype FIELD_NAME is STRING (1 .. MAX_FIELD_NAME);
subtype FIELD_POSITION is FORM_TYPES.XY_POSITION;
subtype FIELD_RENDITIONS is FORM_TYPES.DISPLAY_RENDITIONS;
subtype FIELD_VALUE is STRING (1 .. MAX_FIELD_VALUE);
-- Access types
type FORM_ACCESS is private;
type FIELD_ACCESS is private;
-- Form operations
procedure CREATE_FORM (SIZE : FORM_SIZE;
POSITION : FORM_POSITION;
CLEAR_OPTION : OPTION_TYPE;
FORM : out FORM_ACCESS);
procedure GET_FORM_INFO (FORM : FORM_ACCESS;
SIZE : out FORM_SIZE;
POSITION : out FORM_POSITION;
CLEAR_OPTION : out OPTION_TYPE);
procedure MODIFY_FORM_SIZE (FORM : FORM_ACCESS; SIZE : FORM_SIZE);
procedure MODIFY_FORM_POSITION (FORM : FORM_ACCESS;
POSITION : FORM_POSITION);
procedure MODIFY_FORM_OPTION (FORM : FORM_ACCESS;
CLEAR_OPTION : OPTION_TYPE);
procedure CLEAR_FORM (FORM : FORM_ACCESS);
procedure LOAD_FORM (PATHNAME : STRING; FORM : out FORM_ACCESS);
procedure SAVE_FORM (FORM : FORM_ACCESS; PATHNAME : STRING);
procedure RELEASE_FORM (FORM : FORM_ACCESS);
-- Field operations
procedure ADD_FIELD
(FORM : FORM_ACCESS;
NAME : STRING;
POSITION : FIELD_POSITION;
LENGTH : FIELD_LENGTH;
RENDITION : FIELD_RENDITIONS :=
FORM_TYPES.PRIMARY_RENDITION;
CHAR_LIMITS : CHAR_TYPE := NOT_LIMITED;
INIT_VALUE : STRING := "";
MODE : FIELD_MODE := INPUT_OUTPUT;
FIELD : out FIELD_ACCESS);
procedure COPY_FIELD (FIELD : FIELD_ACCESS;
NEW_NAME : STRING;
NEW_POSITION : FIELD_POSITION;
NEW_FIELD : out FIELD_ACCESS);
procedure DELETE_FIELD (FIELD : FIELD_ACCESS);
procedure MOVE_FIELD (FIELD : FIELD_ACCESS;
NEW_POSITION : FIELD_POSITION);
function GET_FIELD_VALUE (FORM : FORM_ACCESS;
NAME : STRING) return FIELD_VALUE;
function GET_FIELD_POINTER (FORM : FORM_ACCESS;
NAME : STRING) return FIELD_ACCESS;
function GET_FIELD_POINTER (FORM : FORM_ACCESS;
POSITION : FIELD_POSITION) return FIELD_ACCESS;
procedure GET_FIELD_INFO (FIELD : FIELD_ACCESS;
NAME : out FIELD_NAME;
POSITION : out FIELD_POSITION;
LENGTH : out FIELD_LENGTH;
RENDITION : out FIELD_RENDITIONS;
CHAR_LIMITS : out CHAR_TYPE;
INIT_VALUE : out FIELD_VALUE;
VALUE : out FIELD_VALUE;
MODE : out FIELD_MODE);
procedure MODIFY_FIELD_LENGTH (FIELD : FIELD_ACCESS;
LENGTH : FIELD_LENGTH);
procedure MODIFY_FIELD_RENDITION (FIELD : FIELD_ACCESS;
RENDITION : FIELD_RENDITIONS);
procedure MODIFY_FIELD_LIMITS (FIELD : FIELD_ACCESS;
CHAR_LIMITS : CHAR_TYPE);
procedure MODIFY_FIELD_INIT (FIELD : FIELD_ACCESS; INIT_VALUE : STRING);
procedure MODIFY_FIELD_VALUE (FIELD : FIELD_ACCESS; VALUE : STRING);
procedure MODIFY_FIELD_MODE (FIELD : FIELD_ACCESS; MODE : FIELD_MODE);
function GET_FIRST_FIELD (FORM : FORM_ACCESS) return FIELD_ACCESS;
function GET_FIRST_FIELD (FORM : FORM_ACCESS;
ROW : FORM_TYPES.ROW_RANGE) return FIELD_ACCESS;
function GET_NEXT_FIELD (FIELD : FIELD_ACCESS) return FIELD_ACCESS;
function GET_PREVIOUS_FIELD (FIELD : FIELD_ACCESS) return FIELD_ACCESS;
-- Exceptions
CONSTANT_FIELD_ERROR : exception;
DUPLICATE_FIELD_NAME : exception;
FILE_ALREADY_OPEN : exception;
FILE_NOT_FOUND : exception;
FILE_DATA_ERROR : exception;
FIELD_ALLOCATION_ERROR : exception;
FIELD_EXTENDS_PAST_FORM : exception;
FIELD_NAME_NOT_FOUND : exception;
FIELD_NOT_FOUND : exception;
FIELD_OVERLAP_OCCURRED : exception;
FIELD_POSITION_NOT_FOUND : exception;
FORM_ALLOCATION_ERROR : exception;
FORM_TOO_BIG : exception;
INVALID_ROW_NUMBER : exception;
NULL_FORM_POINTER : exception;
NULL_FIELD_POINTER : exception;
POSITION_OUT_OF_FORM_RANGE : exception;
private
-- Form structure
type FORM_RECORD is
record
SIZE : FORM_SIZE;
POSITION : FORM_POSITION;
CLEAR_OPTION : OPTION_TYPE;
FIRST_FIELD : FIELD_ACCESS;
end record;
type FORM_ACCESS is access FORM_RECORD;
-- Field structure
type FIELD_RECORD is
record
NAME : FIELD_NAME;
POSITION : FIELD_POSITION;
LENGTH : FIELD_LENGTH;
RENDITION : FIELD_RENDITIONS;
CHAR_LIMITS : CHAR_TYPE;
VALUE : FIELD_VALUE;
INIT_VALUE : FIELD_VALUE;
MODE : FIELD_MODE;
FORM : FORM_ACCESS;
NEXT_FIELD : FIELD_ACCESS;
PREV_FIELD : FIELD_ACCESS;
end record;
type FIELD_ACCESS is access FIELD_RECORD;
end FORM_MANAGER;
::::::::::
SUBMENUS.ADA
::::::::::
separate (INTERACT)
procedure CREATE_FORM -------------------------------------------------------------------------
-- Abstract : This procedure creates a new blank form and enters the
-- Form Editor with this blank form. The user is prompted
-- for the attributes of this new form.
-------------------------------------------------------------------------
-- Parameters : none.
-------------------------------------------------------------------------
-- Algorithm : The Form Executor is utilized for retrieving the form
-- attributes from the user.
-------------------------------------------------------------------------
is
SIZE : FORM_MANAGER.FORM_SIZE;
POSITION : FORM_MANAGER.FORM_POSITION;
OPTION : FORM_MANAGER.OPTION_TYPE;
FORM_SIZE_TOO_LARGE : exception;
begin
FORMS.GET_FORM_INFO (SIZE, POSITION, OPTION, CREATE_FORM => TRUE);
if SIZE.ROWS > FORM_TYPES.MAX_ROWS or else
SIZE.COLUMNS > FORM_TYPES.MAX_COLUMNS then
raise FORM_SIZE_TOO_LARGE;
end if;
FORM_MANAGER.CREATE_FORM (SIZE, POSITION, OPTION, CURRENT_FORM);
FORM_MANAGER.GET_FORM_INFO
(CURRENT_FORM, CURRENT_SIZE, CURRENT_POSITION, CURRENT_OPTION);
FILENAME := (1 .. 48 => ' ');
EDIT_FORM;
CURRENT_FORM_HAS_BEEN_ALTERED := TRUE;
exception
when FORM_SIZE_TOO_LARGE =>
TERMINAL_INTERFACE.PUT_MESSAGE
("Form size is too large to fit on display!!");
delay 1.0;
when FORM_MANAGER.FORM_ALLOCATION_ERROR =>
TERMINAL_INTERFACE.PUT_MESSAGE
("Storage error - form was not created.");
delay 1.0;
when CONSTRAINT_ERROR =>
TERMINAL_INTERFACE.PUT_MESSAGE ("Error in retrieving form information");
delay 1.0;
end CREATE_FORM;
separate (INTERACT)
procedure LOAD_FORM -------------------------------------------------------------------------
-- Abstract : This procedure loads in a form from an external file.
-- The name of this external file is provided by the user.
-- The Form Editor is automatically entered with this loaded
-- form being displayed.
-------------------------------------------------------------------------
-- Parameters : none.
-------------------------------------------------------------------------
-- Algorithm : The Form Executor is used for retrieving the name of the
-- external file from the user.
-------------------------------------------------------------------------
is
begin
FORMS.GET_FILE_NAME (FILENAME, LOAD_FORM => TRUE);
FORM_MANAGER.LOAD_FORM (FILENAME, CURRENT_FORM);
EDIT_FORM;
CURRENT_FORM_HAS_BEEN_ALTERED := TRUE;
exception
when FORM_MANAGER.FILE_NOT_FOUND =>
TERMINAL_INTERFACE.PUT_MESSAGE ("File not found with the given name.");
delay 1.0;
when FORM_MANAGER.FILE_ALREADY_OPEN =>
TERMINAL_INTERFACE.PUT_MESSAGE ("File being used by another user!");
delay 1.0;
when others =>
TERMINAL_INTERFACE.PUT_MESSAGE
("File does not contain a valid form format!");
delay 1.0;
end LOAD_FORM;
separate (INTERACT)
procedure EDIT_FORM -------------------------------------------------------------------------
-- Abstract : This procedure is the initialization for the Form Editor.
-- The screen is cleared and the Current Form is displayed.
-------------------------------------------------------------------------
-- Parameters : none.
-------------------------------------------------------------------------
is
FIELD : FORM_MANAGER.FIELD_ACCESS;
NAME : FORM_MANAGER.FIELD_NAME;
POSITION : FORM_MANAGER.FIELD_POSITION;
LENGTH : FORM_MANAGER.FIELD_LENGTH;
RENDITION : FORM_MANAGER.FIELD_RENDITIONS;
LIMITS : FORM_MANAGER.CHAR_TYPE;
INIT_VALUE : FORM_MANAGER.FIELD_VALUE;
VALUE : FORM_MANAGER.FIELD_VALUE;
MODE : FORM_MANAGER.FIELD_MODE;
TEMP_INIT : FORM_MANAGER.FIELD_VALUE;
SIZE : TERMINAL_INTERFACE.SCREEN_POSITION;
function "=" (LEFT, RIGHT : FORM_MANAGER.FIELD_MODE) return BOOLEAN
renames FORM_MANAGER."=";
---------------------------------------------------------------------
procedure GET_INFO (FIELD : FORM_MANAGER.FIELD_ACCESS) is
begin
FORM_MANAGER.GET_FIELD_INFO
(FIELD, NAME, POSITION, LENGTH, RENDITION, LIMITS, INIT_VALUE,
VALUE, MODE);
end GET_INFO;
---------------------------------------------------------------------
begin
-- Clear screen and display introductory message.
TERMINAL_INTERFACE.SCREEN_SIZE (SIZE);
TERMINAL_INTERFACE.CLEAR_SCREEN;
TERMINAL_INTERFACE.PUT_FIELD
((SIZE.LINE, 1), 40, FORM_TYPES.REVERSE_RENDITION,
"Entering the Interactive Form Editor....");
delay 0.5;
-- Clear the message line.
TERMINAL_INTERFACE.SPLIT_DISPLAY (SIZE);
-- Display the Current Form with the non-text fields coded according
-- to the individual field's character limitations.
FORM_MANAGER.GET_FORM_INFO
(CURRENT_FORM, CURRENT_SIZE, CURRENT_POSITION, CURRENT_OPTION);
begin
FIELD := FORM_MANAGER.GET_FIRST_FIELD (CURRENT_FORM);
loop
GET_INFO (FIELD);
POSITION.LINE := POSITION.LINE + CURRENT_POSITION.LINE - 1;
POSITION.COLUMN := POSITION.COLUMN + CURRENT_POSITION.COLUMN - 1;
TEMP_INIT := INIT_VALUE;
if MODE /= FORM_MANAGER.CONSTANT_TEXT then
case LIMITS is
when FORM_MANAGER.ALPHA =>
TEMP_INIT (1 .. LENGTH) := (1 .. LENGTH => 'a');
when FORM_MANAGER.NUMERIC =>
TEMP_INIT (1 .. LENGTH) := (1 .. LENGTH => 'n');
when FORM_MANAGER.ALPHA_NUMERIC =>
TEMP_INIT (1 .. LENGTH) := (1 .. LENGTH => 'b');
when FORM_MANAGER.NOT_LIMITED =>
TEMP_INIT (1 .. LENGTH) := (1 .. LENGTH => 'x');
end case;
end if;
TERMINAL_INTERFACE.PUT_FIELD
(POSITION, LENGTH, RENDITION, TEMP_INIT);
FIELD := FORM_MANAGER.GET_NEXT_FIELD (FIELD);
end loop;
exception
when FORM_MANAGER.FIELD_NOT_FOUND =>
null;
end;
EDITOR.EDITOR_DRIVER (CURRENT_FORM);
exception
when FORM_MANAGER.NULL_FORM_POINTER =>
TERMINAL_INTERFACE.PUT_MESSAGE ("There is no Current Form!!");
delay 1.0;
end EDIT_FORM;
separate (INTERACT)
procedure SAVE_FORM -------------------------------------------------------------------------
-- Abstract : This procedure saves a form and all of its fields off
-- into an external file. The user is prompted for this
-- external file name. When this Save Form procedure is
-- executed, the name of the external file is initially
-- assumed if the Current Form was originally loaded in
-- using Load Form. The user can, of course, override this
-- assumed file name.
-------------------------------------------------------------------------
-- Parameters : none.
-------------------------------------------------------------------------
-- Abstract : The Form Executor is utilized for retrieving the name
-- of the external file name.
-------------------------------------------------------------------------
is
begin
FORMS.GET_FILE_NAME (FILENAME, LOAD_FORM => FALSE);
FORM_MANAGER.SAVE_FORM (CURRENT_FORM, FILENAME);
CURRENT_FORM_HAS_BEEN_ALTERED := FALSE;
exception
when FORM_MANAGER.NULL_FORM_POINTER =>
TERMINAL_INTERFACE.PUT_MESSAGE ("There is no Current Form!");
delay 1.0;
when FORM_MANAGER.FILE_ALREADY_OPEN =>
TERMINAL_INTERFACE.PUT_MESSAGE
("File currently being used by another user.");
delay 1.0;
when others =>
TERMINAL_INTERFACE.PUT_MESSAGE
("Error in attempting to save the Current Form");
delay 1.0;
end SAVE_FORM;
separate (INTERACT)
procedure MODIFY_FORM_ATTRIBUTES -------------------------------------------------------------------------
-- Abstract : This procedure retrives the attributes of a form from
-- the user.
-------------------------------------------------------------------------
-- Parameters : none.
-------------------------------------------------------------------------
-- Algorithm : The Form Executor is used to retrieve the form attribute
-- values from the user.
-------------------------------------------------------------------------
is
OLD_SIZE : FORM_MANAGER.FORM_SIZE;
OLD_POSITION : FORM_MANAGER.FORM_POSITION;
OLD_OPTION : FORM_MANAGER.OPTION_TYPE;
FORM_SIZE_TOO_LARGE : exception;
begin
FORM_MANAGER.GET_FORM_INFO
(CURRENT_FORM, CURRENT_SIZE, CURRENT_POSITION, CURRENT_OPTION);
OLD_SIZE := CURRENT_SIZE;
OLD_POSITION := CURRENT_POSITION;
OLD_OPTION := CURRENT_OPTION;
FORMS.GET_FORM_INFO
(CURRENT_SIZE, CURRENT_POSITION, CURRENT_OPTION, CREATE_FORM => FALSE);
if CURRENT_SIZE.ROWS > FORM_TYPES.MAX_ROWS or else
CURRENT_SIZE.COLUMNS > FORM_TYPES.MAX_COLUMNS then
raise FORM_SIZE_TOO_LARGE;
end if;
FORM_MANAGER.MODIFY_FORM_SIZE (CURRENT_FORM, CURRENT_SIZE);
FORM_MANAGER.MODIFY_FORM_POSITION (CURRENT_FORM, CURRENT_POSITION);
FORM_MANAGER.MODIFY_FORM_OPTION (CURRENT_FORM, CURRENT_OPTION);
exception
when FORM_SIZE_TOO_LARGE =>
TERMINAL_INTERFACE.PUT_MESSAGE
("Specified form size to too large for display!!!");
CURRENT_SIZE := OLD_SIZE;
CURRENT_POSITION := OLD_POSITION;
CURRENT_OPTION := OLD_OPTION;
when FORM_MANAGER.NULL_FORM_POINTER =>
TERMINAL_INTERFACE.PUT_MESSAGE ("There is no Current Form!");
end MODIFY_FORM_ATTRIBUTES;
::::::::::
TERMINAL_BODY.ADA
::::::::::
--------------------------------------------------------------------------
-- Abstract : This package body defines the routines which interface
-- the Form Generator to the terminal. This version uses
-- the Virtual Terminal to provide the terminal interface.
--------------------------------------------------------------------------
with PAGE_TERMINAL;
package body TERMINAL_INTERFACE is
--
-- Global Data of Use Throughout Life of Package
--
DATA : STRING (1 .. 40);
LAST : NATURAL;
KEYS : PAGE_TERMINAL.FUNCTION_KEY_DESCRIPTOR (2);
NUMBER_OF_FUNCTION_KEYS : NATURAL;
CHAR_INDEX : NATURAL;
FUNC_INDEX : NATURAL;
NUMBER_OF_KEYS : NATURAL := 0; -- init to 0 for proper
-- initial invocation
FKEY_ID : PAGE_TERMINAL.FUNCTION_KEY_ENUM;
FKEY_POSITION : NATURAL;
UNGET_CHARTYPE : CHAR_ENUM;
UNGET_CHAR : CHARACTER;
UNGET_FUNC : FUNCTION_KEY_ENUM;
UNGET_PENDING : BOOLEAN := FALSE;
--
-- General screen manipulation routines
--
--------------------------------------------------------------------------
-- Abstract : OPEN initializes the terminal for processing by the
-- Form Generator.
--------------------------------------------------------------------------
-- Parameters : none
--------------------------------------------------------------------------
-- Algorithm : It calls the Virtual Terminal Open routine with the name
-- "fgs" which is should define the terminal interface for
-- the Form Generator routines.
--------------------------------------------------------------------------
procedure OPEN is
begin
PAGE_TERMINAL.OPEN ("fgs");
end OPEN;
--------------------------------------------------------------------------
-- Abstract : CLOSE terminates the connection with the terminal.
--------------------------------------------------------------------------
-- Parameters : none
--------------------------------------------------------------------------
procedure CLOSE is
begin
CLEAR_SCREEN;
PAGE_TERMINAL.CLOSE; -- close terminal
end CLOSE;
--------------------------------------------------------------------------
-- Abstract : REFRESH makes sure the the terminal displays what the
-- Form Generator routines have output to the terminal.
--------------------------------------------------------------------------
-- Parameters : none
--------------------------------------------------------------------------
procedure REFRESH is
begin
PAGE_TERMINAL.REDRAW_SCREEN;
end REFRESH;
--------------------------------------------------------------------------
-- Abstract : CLEAR_SCREEN erases the text from the entire screen and
-- displays blanks.
--------------------------------------------------------------------------
-- Parameters : none
--------------------------------------------------------------------------
procedure CLEAR_SCREEN is
begin
PAGE_TERMINAL.ERASE_IN_DISPLAY (PAGE_TERMINAL.ALL_POSITIONS);
PAGE_TERMINAL.REDRAW_SCREEN;
end CLEAR_SCREEN;
--------------------------------------------------------------------------
-- Abstract : PUT_MESSAGE outputs a warning or error message at the
-- bottom right hand corner of the display in secondary
-- rendition.
--------------------------------------------------------------------------
-- Parameters : TEXT - string of message to be displayed
-- (Parameters are only required for routines)
--------------------------------------------------------------------------
procedure PUT_MESSAGE (TEXT : STRING) is
NEW_POSITION : PAGE_TERMINAL.XY_POSITION;
CURRENT_POSITION : SCREEN_POSITION;
begin
GET_CURSOR (CURRENT_POSITION);
NEW_POSITION := PAGE_TERMINAL.SIZE;
NEW_POSITION.COLUMN := 32;
PAGE_TERMINAL.SET_POSITION (NEW_POSITION);
PAGE_TERMINAL.ERASE_IN_LINE (PAGE_TERMINAL.FROM_XY_POSITION_TO_END);
NEW_POSITION := PAGE_TERMINAL.SIZE; -- compute new position
if NEW_POSITION.COLUMN > TEXT'LENGTH then
NEW_POSITION.COLUMN := NEW_POSITION.COLUMN - TEXT'LENGTH;
else
NEW_POSITION.COLUMN := 1; -- live with overflow
end if;
PAGE_TERMINAL.SET_POSITION (NEW_POSITION);
SELECT_RENDITION (FORM_TYPES.SECONDARY_RENDITION);
PAGE_TERMINAL.PUT (TEXT);
SELECT_RENDITION (FORM_TYPES.PRIMARY_RENDITION);
PAGE_TERMINAL.BELL;
PAGE_TERMINAL.UPDATE_LINE (NEW_POSITION.LINE);
PUT_CURSOR (CURRENT_POSITION);
end PUT_MESSAGE;
--------------------------------------------------------------------------
-- Abstract : PUT_CURSOR positions the cursor to a specific location
-- on the screen.
--------------------------------------------------------------------------
-- Parameters : POSITION - desired position of cursor in row and column
--------------------------------------------------------------------------
procedure PUT_CURSOR (POSITION : SCREEN_POSITION) is
PAGE_POSITION : PAGE_TERMINAL.XY_POSITION;
begin
PAGE_POSITION.LINE := POSITION.LINE; -- translate to page terminal
PAGE_POSITION.COLUMN := POSITION.COLUMN;
PAGE_TERMINAL.SET_POSITION (PAGE_POSITION);
PAGE_TERMINAL.UPDATE_CURSOR;
end PUT_CURSOR;
--------------------------------------------------------------------------
-- Abstract : GET_CURSOR returns the current position of the cursor.
--------------------------------------------------------------------------
-- Parameters : POSITION - current position of cursor in row and column
--------------------------------------------------------------------------
procedure GET_CURSOR (POSITION : out SCREEN_POSITION) is
PAGE_POSITION : PAGE_TERMINAL.XY_POSITION;
begin
PAGE_POSITION := PAGE_TERMINAL.POSITION;
POSITION.LINE := PAGE_POSITION.LINE;
POSITION.COLUMN := PAGE_POSITION.COLUMN;
end GET_CURSOR;
--------------------------------------------------------------------------
-- Abstract : SELECT_RENDITION sets the display rendition of the screen.
--------------------------------------------------------------------------
-- Parameters : RENDITION - desired display rendition
--------------------------------------------------------------------------
-- Algorithm : Primary and Underline => Primary
-- Secondary and Reverse => Reverse
--------------------------------------------------------------------------
procedure SELECT_RENDITION (RENDITION : GRAPHIC_TYPE) is
PAGE_RENDITION : PAGE_TERMINAL.GRAPHIC_RENDITION_ENUMERATION;
begin
case RENDITION is
when FORM_TYPES.PRIMARY_RENDITION =>
PAGE_RENDITION := PAGE_TERMINAL.PRIMARY_RENDITION;
when FORM_TYPES.REVERSE_RENDITION |
FORM_TYPES.SECONDARY_RENDITION =>
PAGE_RENDITION := PAGE_TERMINAL.REVERSE_IMAGE;
when others =>
PAGE_RENDITION := PAGE_TERMINAL.PRIMARY_RENDITION;
end case;
PAGE_TERMINAL.SELECT_GRAPHIC_RENDITION (PAGE_RENDITION);
end SELECT_RENDITION;
--------------------------------------------------------------------------
-- Abstract : SCREEN_SIZE returns the size of the screen display in
-- rows and columns.
--------------------------------------------------------------------------
-- Parameters : SIZE - size of screen in rows and columns
--------------------------------------------------------------------------
procedure SCREEN_SIZE (SIZE : out SCREEN_POSITION) is
PAGE_SIZE : PAGE_TERMINAL.XY_POSITION;
begin
PAGE_SIZE := PAGE_TERMINAL.SIZE;
SIZE.LINE := PAGE_SIZE.LINE;
SIZE.COLUMN := PAGE_SIZE.COLUMN;
end SCREEN_SIZE;
--
-- Screen and line shifting routines
--
--------------------------------------------------------------------------
-- Abstract : SPLIT_DISPLAY inserts a blank line into the display at
-- the desired cursor position and causing the current line
-- and all following lines to be scrolled down one line.
-- The last line of the display is scrolled off the display.
--------------------------------------------------------------------------
-- Parameters : POSITION - position at which the line is to be inserted
--------------------------------------------------------------------------
procedure SPLIT_DISPLAY (POSITION : SCREEN_POSITION) is
begin
PUT_CURSOR (POSITION);
PAGE_TERMINAL.INSERT_LINE (1);
PAGE_TERMINAL.UPDATE_SCREEN (POSITION.LINE, PAGE_TERMINAL.SIZE.LINE);
end SPLIT_DISPLAY;
--------------------------------------------------------------------------
-- Abstract : CLOSE_UP_DISPLAY deletes a line of text from the display
-- and all lines below it are shifted upward to fill in the
-- line.
--------------------------------------------------------------------------
-- Parameters : POSITION - position at which the line is to be deleted
--------------------------------------------------------------------------
procedure CLOSE_UP_DISPLAY (POSITION : SCREEN_POSITION) is
begin
PUT_CURSOR (POSITION);
PAGE_TERMINAL.DELETE_LINE (1);
PAGE_TERMINAL.UPDATE_SCREEN (POSITION.LINE, PAGE_TERMINAL.SIZE.LINE);
end CLOSE_UP_DISPLAY;
--
-- Field display routines
--
--------------------------------------------------------------------------
-- Abstract : PUT_FIELD outputs the contents of a field at a specific
-- location on the screen given the length of the field,
-- display
--------------------------------------------------------------------------
-- Parameters : POSITION - position of the beginning of the field
-- LENGTH - length of the field is number of characters
-- RENDITION - display rendition of field
-- VALUE - value to be display in field
--------------------------------------------------------------------------
procedure PUT_FIELD (POSITION : SCREEN_POSITION;
LENGTH : NATURAL;
RENDITION : GRAPHIC_TYPE;
VALUE : STRING) is
begin
PUT_CURSOR (POSITION);
SELECT_RENDITION (RENDITION);
PAGE_TERMINAL.PUT (VALUE (1 .. LENGTH));
SELECT_RENDITION (FORM_TYPES.PRIMARY_RENDITION);
PAGE_TERMINAL.UPDATE_LINE (POSITION.LINE);
end PUT_FIELD;
--------------------------------------------------------------------------
-- Abstract : ERASE_FIELD erases the field by writing blanks into the
-- field
--------------------------------------------------------------------------
-- Parameters : POSITION - position of the beginning of the field
-- LENGTH - length of the field is number of characters
--------------------------------------------------------------------------
procedure ERASE_FIELD (POSITION : SCREEN_POSITION; LENGTH : NATURAL) is
begin
PUT_CURSOR (POSITION);
SELECT_RENDITION (FORM_TYPES.PRIMARY_RENDITION);
PAGE_TERMINAL.PUT ((1 .. LENGTH => ' ')); -- write spaces in field
PAGE_TERMINAL.UPDATE_LINE (POSITION.LINE);
end ERASE_FIELD;
--------------------------------------------------------------------------
-- Abstract : EDIT_FIELD handles the modification of a field value with
-- editing functions
--------------------------------------------------------------------------
-- Parameters : POSITION - position of the beginning of the field
-- LENGTH - length of the field is number of characters
-- RENDITION - display rendition of field
-- VALUE - value to be display in field
--------------------------------------------------------------------------
-- Algorithm : LEFT_ARROW and RIGHT_ARROW - moves cursor left and right
-- DEL_CHAR - deletes the current character
-- DEL_EOLN - deletes to end of field
-- INS_CHAR - toggles insert/overtype mode
-- RUBOUT - deletes the previous character
--------------------------------------------------------------------------
procedure EDIT_FIELD (POSITION : SCREEN_POSITION;
LENGTH : NATURAL;
RENDITION : GRAPHIC_TYPE;
VALUE : in out STRING) is
CHAR : CHARACTER;
CHARTYPE : CHAR_ENUM;
CURSOR : SCREEN_POSITION;
FUNCT : FUNCTION_KEY_ENUM;
INDEX : NATURAL := 1;
INSERT_MODE : BOOLEAN := FALSE;
procedure DELETE_CHAR (INDEX : NATURAL) is
i : NATURAL;
begin
for i in INDEX .. LENGTH - 1 loop
VALUE (i) := VALUE (i + 1);
end loop;
VALUE (LENGTH) := ' ';
PUT_FIELD (POSITION, LENGTH, RENDITION, VALUE);
end DELETE_CHAR;
procedure DELETE_EOLN (INDEX : NATURAL) is
i : NATURAL;
begin
for i in INDEX .. LENGTH loop
VALUE (i) := ' ';
end loop;
PUT_FIELD (POSITION, LENGTH, RENDITION, VALUE);
end DELETE_EOLN;
procedure INSERT_CHAR (INDEX : NATURAL; CHAR : CHARACTER) is
i : NATURAL;
begin
i := LENGTH;
while i > INDEX loop
VALUE (i) := VALUE (i - 1);
i := i - 1;
end loop;
VALUE (INDEX) := CHAR;
PUT_FIELD (POSITION, LENGTH, RENDITION, VALUE);
end INSERT_CHAR;
begin
PUT_FIELD (POSITION, LENGTH, RENDITION, VALUE);
CURSOR := POSITION;
loop
PUT_CURSOR (CURSOR);
GET_CHARACTER (CHARTYPE, CHAR, FUNCT);
case CHARTYPE is
when TIMEOUT =>
null; -- just wait for next character
when FUNC_TYPE =>
case FUNCT is
when RIGHT_ARROW => -- move cursor right
if INDEX < LENGTH then
INDEX := INDEX + 1;
CURSOR.COLUMN := CURSOR.COLUMN + 1;
else
PAGE_TERMINAL.BELL;
end if;
when LEFT_ARROW | RUBOUT => -- move cursor left
if INDEX > 1 then
INDEX := INDEX - 1;
CURSOR.COLUMN := CURSOR.COLUMN - 1;
if FUNCT = RUBOUT then
DELETE_CHAR (INDEX);
end if;
else
PAGE_TERMINAL.BELL;
end if;
when DEL_CHAR => -- delete character
DELETE_CHAR (INDEX);
when DEL_EOLN => -- delete to end-of-line
DELETE_EOLN (INDEX);
when INS_CHAR => -- insert character
INSERT_MODE := not INSERT_MODE;
when others => -- save for caller
UNGET_CHARACTER (CHARTYPE, CHAR, FUNCT);
return;
end case;
when CHAR_TYPE => -- add character to line
if CHAR >= ' ' and CHAR <= '~' then
if INDEX <= LENGTH then
if INSERT_MODE then
INSERT_CHAR (INDEX, CHAR);
else
PUT_CHARACTER (CHAR);
VALUE (INDEX) := CHAR;
end if;
if INDEX <= LENGTH then
INDEX := INDEX + 1;
CURSOR.COLUMN := CURSOR.COLUMN + 1;
end if;
else
PAGE_TERMINAL.BELL;
end if;
else
PAGE_TERMINAL.BELL;
end if;
end case;
end loop;
end EDIT_FIELD;
--
-- Key Processing routines
--
--------------------------------------------------------------------------
-- Abstract : GET_CHARACTER returns the type and value of the next key
-- entered at the keyboard.
--------------------------------------------------------------------------
-- Parameters : CHARTYPE - type of key entered
-- CHAR - value of ASCII character if CHAR_TYPE
-- FUNC - value of function key if FUNC_TYPE
--------------------------------------------------------------------------
procedure GET_CHARACTER (CHARTYPE : out CHAR_ENUM;
CHAR : out CHARACTER;
FUNC : out FUNCTION_KEY_ENUM) is
PAGE_FKEY : PAGE_TERMINAL.FUNCTION_KEY_ENUM;
--
-- Global Variables used by GET_CHARACTER:
--
-- DATA String of character keys input
-- LAST Number of character keys in DATA
-- KEYS Private type used by FUNCTION_COUNT and
-- FUNCTION_KEY
-- NUMBER_OF_FUNCTION_KEYS
-- Number of function keys input
-- CHAR_INDEX Index (reverse order) of next character key;
-- LAST - CHAR_INDEX + 1 = index of next char key;
-- CHAR_INDEX = 0 means no more character keys
-- FUNC_INDEX Index (reverse order) of next function key;
-- NUMBER_OF_FUNCTION_KEYS - FUNC_INDEX + 1 =
-- index of next function key;
-- FUNC_INDEX = 0 means no more function keys
-- NUMBER_OF_KEYS Total number of keys remaining
-- (both char and function);
-- NUMBER_OF_KEYS = 0 means no more keys pending;
-- should be set to zero before first
-- GET_CHARACTER call
-- FKEY_ID ID of next function key (FUNCTION_KEY_ENUM)
-- FKEY_POSITION Position of next function key (index of char key
-- before it)
--
procedure RETURN_TIMEOUT is
begin
CHARTYPE := TIMEOUT;
CHAR := ASCII.nul;
FUNC := invalid;
end RETURN_TIMEOUT;
procedure RETURN_CHAR (INCHAR : CHARACTER) is
-- Map control characters to internal functions
begin
if INCHAR < ' ' or INCHAR = ASCII.DEL then
CHARTYPE := FUNC_TYPE;
CHAR := ASCII.nul;
case INCHAR is
when ASCII.STX => -- ctrl B
FUNC := INS_CHAR;
when ASCII.ETX => -- ctrl C
FUNC := COMMAND_LINE;
when ASCII.EOT => -- ctrl D
FUNC := DEL_CHAR;
when ASCII.ENQ => -- ctrl E
FUNC := DEL_EOLN;
when ASCII.BS => -- ctrl H
FUNC := LEFT_ARROW;
when ASCII.HT => -- ctrl I
FUNC := TAB_KEY;
when ASCII.LF => -- ctrl J
FUNC := DOWN_ARROW;
when ASCII.VT => -- ctrl K
FUNC := UP_ARROW;
when ASCII.FF => -- ctrl L
FUNC := RIGHT_ARROW;
when ASCII.CR => -- ctrl M
FUNC := RETURN_KEY;
when ASCII.SI => -- ctrl O
FUNC := BACK_TAB;
when ASCII.SYN => -- ctrl V
FUNC := INS_CHAR;
when ASCII.ETB => -- ctrl W
FUNC := DEL_LINE;
when ASCII.CAN => -- ctrl X
FUNC := EXIT_FORM;
when ASCII.DEL => -- ctrl bs
FUNC := RUBOUT;
when others =>
CHARTYPE := CHAR_TYPE;
CHAR := INCHAR;
FUNC := invalid;
end case;
else
CHARTYPE := CHAR_TYPE;
CHAR := INCHAR;
FUNC := invalid;
end if;
end RETURN_CHAR;
procedure RETURN_FUNC (INFUNC : PAGE_TERMINAL.FUNCTION_KEY_ENUM) is
-- Map VT functions into internal functions
begin
CHARTYPE := FUNC_TYPE;
CHAR := ASCII.nul;
case INFUNC is
when PAGE_TERMINAL.RIGHT_ARROW =>
FUNC := RIGHT_ARROW;
when PAGE_TERMINAL.LEFT_ARROW =>
FUNC := LEFT_ARROW;
when PAGE_TERMINAL.UP_ARROW =>
FUNC := UP_ARROW;
when PAGE_TERMINAL.DOWN_ARROW =>
FUNC := DOWN_ARROW;
when PAGE_TERMINAL.f1 =>
FUNC := BACK_TAB;
when PAGE_TERMINAL.f2 =>
FUNC := COMMAND_LINE;
when PAGE_TERMINAL.f3 =>
FUNC := HELP;
when PAGE_TERMINAL.f4 =>
FUNC := RETURN_KEY;
when PAGE_TERMINAL.f5 =>
FUNC := TAB_KEY;
when PAGE_TERMINAL.f6 =>
FUNC := DEL_CHAR;
when PAGE_TERMINAL.f7 =>
FUNC := INS_CHAR;
when PAGE_TERMINAL.f8 =>
FUNC := RUBOUT;
when PAGE_TERMINAL.f9 =>
FUNC := EXIT_FORM;
when PAGE_TERMINAL.f10 =>
FUNC := COPY_LINE;
when PAGE_TERMINAL.f11 =>
FUNC := DEL_EOLN;
when PAGE_TERMINAL.f12 =>
FUNC := DEL_LINE;
when PAGE_TERMINAL.f13 =>
FUNC := INS_LINE;
when PAGE_TERMINAL.f14 =>
FUNC := MOVE_LINE;
when PAGE_TERMINAL.f15 =>
FUNC := COPY_FIELD;
when PAGE_TERMINAL.f16 =>
FUNC := CREATE_FIELD;
when PAGE_TERMINAL.f17 =>
FUNC := DEL_FIELD;
when PAGE_TERMINAL.f18 =>
FUNC := MODIFY_FIELD;
when PAGE_TERMINAL.f19 =>
FUNC := MOVE_FIELD;
when others =>
FUNC := invalid;
end case;
end RETURN_FUNC;
begin
if UNGET_PENDING then
-- return values from last UNGET_CHARACTER
UNGET_PENDING := FALSE;
CHARTYPE := UNGET_CHARTYPE;
CHAR := UNGET_CHAR;
FUNC := UNGET_FUNC;
return;
end if;
if NUMBER_OF_KEYS = 0 then
-- get next set of keys
PAGE_TERMINAL.GET (DATA, LAST, KEYS);
NUMBER_OF_FUNCTION_KEYS := PAGE_TERMINAL.FUNCTION_COUNT (KEYS);
CHAR_INDEX := LAST; -- set indices
FUNC_INDEX := NUMBER_OF_FUNCTION_KEYS;
NUMBER_OF_KEYS := LAST + NUMBER_OF_FUNCTION_KEYS;
if FUNC_INDEX /= 0 then
-- get first function key
PAGE_TERMINAL.FUNCTION_KEY (KEYS, 1, FKEY_ID, FKEY_POSITION);
end if;
end if;
if CHAR_INDEX = 0 then
if FUNC_INDEX = 0 then
--
-- Scenario 1: No Character Keys and No Function Keys Remain;
-- TIMEOUT
--
RETURN_TIMEOUT;
else
--
-- Scenario 2: No Character Keys and Some Function Keys Remain
--
RETURN_FUNC (FKEY_ID);
NUMBER_OF_KEYS := NUMBER_OF_KEYS - 1;
FUNC_INDEX := FUNC_INDEX - 1;
PAGE_TERMINAL.FUNCTION_KEY
(KEYS, -- get next
-- function key
NUMBER_OF_FUNCTION_KEYS - FUNC_INDEX + 1,
FKEY_ID,
FKEY_POSITION);
end if;
else
if FUNC_INDEX = 0 then
--
-- Scenario 3: Character Keys and No Function Keys Remain
--
NUMBER_OF_KEYS := NUMBER_OF_KEYS - 1;
RETURN_CHAR (DATA (LAST - CHAR_INDEX + 1));
CHAR_INDEX := CHAR_INDEX - 1;
else
--
-- Scenario 4: Character Keys and Function Keys Remain
--
if FKEY_POSITION < LAST - CHAR_INDEX + 1 then
--
-- Next key is function key
--
RETURN_FUNC (FKEY_ID);
FUNC_INDEX := FUNC_INDEX - 1;
NUMBER_OF_KEYS := NUMBER_OF_KEYS - 1;
if FUNC_INDEX > 0 then
-- nxt fkey
PAGE_TERMINAL.FUNCTION_KEY
(KEYS, NUMBER_OF_FUNCTION_KEYS - FUNC_INDEX + 1,
FKEY_ID, FKEY_POSITION);
end if;
else
--
-- Next key is character key
--
NUMBER_OF_KEYS := NUMBER_OF_KEYS - 1;
RETURN_CHAR (DATA (LAST - CHAR_INDEX + 1));
CHAR_INDEX := CHAR_INDEX - 1;
end if;
end if;
end if;
end GET_CHARACTER;
--------------------------------------------------------------------------
-- Abstract : UNGET_CHARACTER save the previous character for later
-- processing.
--------------------------------------------------------------------------
-- Parameters : CHARTYPE - type of key entered
-- CHAR - value of ASCII character if CHAR_TYPE
-- FUNC - value of function key if FUNC_TYPE
--------------------------------------------------------------------------
procedure UNGET_CHARACTER (CHARTYPE : CHAR_ENUM;
CHAR : CHARACTER;
FUNC : FUNCTION_KEY_ENUM) is
begin
UNGET_PENDING := TRUE;
UNGET_CHARTYPE := CHARTYPE;
UNGET_CHAR := CHAR;
UNGET_FUNC := FUNC;
end UNGET_CHARACTER;
--
-- Text display routines
--
--------------------------------------------------------------------------
-- Abstract : PUT_CHARACTER outputs a character at the current cursor
-- position.
--------------------------------------------------------------------------
-- Parameters : CHAR - character to be output
--------------------------------------------------------------------------
procedure PUT_CHARACTER (CHAR : CHARACTER) is
begin
PAGE_TERMINAL.PUT (CHAR);
PAGE_TERMINAL.UPDATE_LINE (PAGE_TERMINAL.POSITION.LINE);
end PUT_CHARACTER;
--------------------------------------------------------------------------
-- Abstract : PUT_CHARACTER outputs a character at a specific cursor
-- position.
--------------------------------------------------------------------------
-- Parameters : CHAR - character to be output
-- POSITION - postion where cursor is to be displayed
--------------------------------------------------------------------------
procedure PUT_CHARACTER (CHAR : CHARACTER; POSITION : SCREEN_POSITION) is
begin
PUT_CURSOR (POSITION);
PAGE_TERMINAL.PUT (CHAR);
PAGE_TERMINAL.UPDATE_LINE (POSITION.LINE);
end PUT_CHARACTER;
--------------------------------------------------------------------------
-- Abstract : INSERT_CHARACTER outputs a character on a line while
-- moving the current characters from the cursor position
-- of the end of line right one position.
--------------------------------------------------------------------------
-- Parameters : CHAR - character to be output
-- POSITION - postion where cursor is to be inserted
--------------------------------------------------------------------------
procedure INSERT_CHARACTER (CHAR : CHARACTER;
POSITION : SCREEN_POSITION) is
CURRENT_POSITION : SCREEN_POSITION;
begin
GET_CURSOR (CURRENT_POSITION);
PUT_CURSOR (POSITION);
PAGE_TERMINAL.ENTER_INSERT_MODE;
PAGE_TERMINAL.PUT (CHAR);
PAGE_TERMINAL.EXIT_INSERT_MODE;
PAGE_TERMINAL.UPDATE_LINE (POSITION.LINE);
PUT_CURSOR (CURRENT_POSITION);
end INSERT_CHARACTER;
--------------------------------------------------------------------------
-- Abstract : ERASE_CHARACTER erases the character at the specified
-- position and causes all characters to the end of line to
-- be move left one position.
--------------------------------------------------------------------------
-- Parameters : POSITION - position at which character is to be deleted
--------------------------------------------------------------------------
procedure ERASE_CHARACTER (POSITION : SCREEN_POSITION) is
CURRENT_POSITION : SCREEN_POSITION;
begin
GET_CURSOR (CURRENT_POSITION);
PUT_CURSOR (POSITION);
PAGE_TERMINAL.DELETE_CHARACTER (1);
PAGE_TERMINAL.UPDATE_LINE (POSITION.LINE);
PUT_CURSOR (CURRENT_POSITION);
end ERASE_CHARACTER;
end TERMINAL_INTERFACE;
::::::::::
TERMINAL_SPEC.ADA
::::::::::
--------------------------------------------------------------------------
-- Abstract : This package defines the routines to interface to the
-- terminal for the Form Generator system.
--------------------------------------------------------------------------
-- Algorithm : Currently this package interfaces with the NOSC Virtual
-- Terminal, but it could be changed to go directly to any
-- terminal by changing the implementation of this package.
--------------------------------------------------------------------------
with FORM_TYPES;
package TERMINAL_INTERFACE is
--
-- CHAR_ENUM is used to GET_CHARACTER to return the next char/fct key/timeout
--
type CHAR_ENUM is (CHAR_TYPE, FUNC_TYPE, TIMEOUT);
--
-- FUNCTION_KEY_ENUM maps to PAGE_TERMINAL.FUNCTION_KEY_ENUM
-- Conversion done in RETURN_FUNC in GET_CHARACTER
--
type FUNCTION_KEY_ENUM is
(DOWN_ARROW, LEFT_ARROW, RIGHT_ARROW, UP_ARROW,
BACK_TAB, COMMAND_LINE, COPY_FIELD, COPY_LINE,
CREATE_FIELD, DEL_CHAR, DEL_EOLN, DEL_FIELD,
DEL_LINE, EXIT_FORM, HELP, INS_CHAR,
INS_LINE, MODIFY_FIELD, MOVE_FIELD, MOVE_LINE,
RETURN_KEY, RUBOUT, TAB_KEY, INVALID);
--
-- SCREEN_POSITION maps to PAGE_TERMINAL.XY_POSITION
--
subtype SCREEN_POSITION is FORM_TYPES.XY_POSITION;
--
-- GRAPHIS_TYPE maps to PAGE_TERMINAL.GRAPHIC_RENDITION_ENUMERATION
--
subtype GRAPHIC_TYPE is FORM_TYPES.DISPLAY_RENDITIONS;
--
-- General screen manipulation routines
--
procedure OPEN;
procedure CLOSE;
procedure REFRESH;
procedure CLEAR_SCREEN;
procedure PUT_MESSAGE (TEXT : STRING);
procedure PUT_CURSOR (POSITION : SCREEN_POSITION);
procedure GET_CURSOR (POSITION : out SCREEN_POSITION);
procedure SELECT_RENDITION (RENDITION : GRAPHIC_TYPE);
procedure SCREEN_SIZE (SIZE : out SCREEN_POSITION);
--
-- Screen shifting routines
--
procedure SPLIT_DISPLAY (POSITION : SCREEN_POSITION);
procedure CLOSE_UP_DISPLAY (POSITION : SCREEN_POSITION);
--
-- Field display routines
--
procedure PUT_FIELD (POSITION : SCREEN_POSITION;
LENGTH : NATURAL;
RENDITION : GRAPHIC_TYPE;
VALUE : STRING);
procedure ERASE_FIELD (POSITION : SCREEN_POSITION; LENGTH : NATURAL);
procedure EDIT_FIELD (POSITION : SCREEN_POSITION;
LENGTH : NATURAL;
RENDITION : GRAPHIC_TYPE;
VALUE : in out STRING);
--
-- Text retrieval/display routines
--
procedure GET_CHARACTER (CHARTYPE : out CHAR_ENUM;
CHAR : out CHARACTER;
FUNC : out FUNCTION_KEY_ENUM);
procedure UNGET_CHARACTER (CHARTYPE : CHAR_ENUM;
CHAR : CHARACTER;
FUNC : FUNCTION_KEY_ENUM);
procedure PUT_CHARACTER (CHAR : CHARACTER);
procedure PUT_CHARACTER (CHAR : CHARACTER; POSITION : SCREEN_POSITION);
procedure INSERT_CHARACTER (CHAR : CHARACTER;
POSITION : SCREEN_POSITION);
procedure ERASE_CHARACTER (POSITION : SCREEN_POSITION);
end TERMINAL_INTERFACE;
--::::::::::
--form2.doc
--::::::::::
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
Computer Program Test
Procedures for a
Forms Generator System
in Ada
Prepared for: |||||||||||||||||||||||||
|||||||||||||||||||||||||
Advanced Computer Systems Lab |||||||||||||||||||||||||
Texas Instruments |||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
Equipment Group - ACSL |||||||||||||||||||||||||
P.O. Box 801, M.S. 8007 |||||||||||||||||||||||||
McKinney, Texas 75069 |||||||||||||||||||||||||
15 January 1985 |||||||||||||||||||||||||
|||||||||||||||||||||||||
TEXAS INSTRUMENTS
INCORPORATED
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
CONTENTS
CHAPTER 1 INTRODUCTION
PURPOSE . . . . . . . . . . . . . . . . . . . . . 1-1
SCOPE . . . . . . . . . . . . . . . . . . . . . . 1-1
SUMMARY . . . . . . . . . . . . . . . . . . . . . 1-1
CHAPTER 2 APPLICABLE DOCUMENTS
CHAPTER 3 TESTING REQUIREMENTS
GENERAL . . . . . . . . . . . . . . . . . . . . . 3-1
FORMS GENERATOR ACCEPTANCE/PREOPERATING PROCEDURES 3-2
EQUIPMENT PREPARATION . . . . . . . . . . . . . . 3-2
DIGITAL PROCESSOR PREPARATION . . . . . . . . . . 3-2
TESTING PROCEDURE . . . . . . . . . . . . . . . . 3-2
CHAPTER 4 TEST MANAGEMENT
CHAPTER 5 PERSONNEL REQUIREMENTS
CHAPTER 6 HARDWARE REQUIREMENTS
CHAPTER 7 SOFTWARE REQUIREMENTS
CHAPTER 8 TESTING SCHEDULE
CHAPTER 9 QUALITY ASSURANCE
APPENDIX A TEST SPECIFICATIONS
CREATE/LOAD FORM . . . . . . . . . . . . . . . . . A-2
REQUIREMENTS MET BY TEST . . . . . . . . . . . . A-2
DESCRIPTION OF TEST . . . . . . . . . . . . . . A-2
ASSUMPTIONS . . . . . . . . . . . . . . . . . . A-2
TEST SYNOPSIS . . . . . . . . . . . . . . . . . A-2
EDIT FORM 1 . . . . . . . . . . . . . . . . . . . A-4
REQUIREMENTS MET BY TEST . . . . . . . . . . . . A-4
DESCRIPTION OF TEST . . . . . . . . . . . . . . A-4
ASSUMPTIONS . . . . . . . . . . . . . . . . . . A-4
TEST SYNOPSIS . . . . . . . . . . . . . . . . . A-4
EDIT FORM 2 . . . . . . . . . . . . . . . . . . . A-6
REQUIREMENTS MET BY TEST . . . . . . . . . . . . A-6
Page 2
DESCRIPTION OF TEST . . . . . . . . . . . . . . A-6
ASSUMPTIONS . . . . . . . . . . . . . . . . . . A-6
TEST SYNOPSIS . . . . . . . . . . . . . . . . . A-6
EDIT FORM 3 . . . . . . . . . . . . . . . . . . . A-8
REQUIREMENTS MET BY TEST . . . . . . . . . . . . A-8
DESCRIPTION OF TEST . . . . . . . . . . . . . . A-8
ASSUMPTIONS . . . . . . . . . . . . . . . . . . A-8
TEST SYNOPSIS . . . . . . . . . . . . . . . . . A-8
EDIT FORM 4 . . . . . . . . . . . . . . . . . . A-10
REQUIREMENTS MET BY TEST . . . . . . . . . . . A-10
DESCRIPTION OF TEST . . . . . . . . . . . . . A-10
ASSUMPTIONS . . . . . . . . . . . . . . . . . A-10
TEST SYNOPSIS . . . . . . . . . . . . . . . . A-10
MODIFY FORM . . . . . . . . . . . . . . . . . . A-12
REQUIREMENTS MET BY TEST . . . . . . . . . . . A-12
DESCRIPTION OF TEST . . . . . . . . . . . . . A-12
ASSUMPTIONS . . . . . . . . . . . . . . . . . A-12
TEST SYNOPSIS . . . . . . . . . . . . . . . . A-12
SAVE FORM . . . . . . . . . . . . . . . . . . . A-14
REQUIREMENTS MET BY TEST . . . . . . . . . . . A-14
DESCRIPTION OF TEST . . . . . . . . . . . . . A-14
ASSUMPTIONS . . . . . . . . . . . . . . . . . A-14
TEST SYNOPSIS . . . . . . . . . . . . . . . . A-14
EXIT INTERACTIVE FORM GENERATOR . . . . . . . . A-16
REQUIREMENTS MET BY TEST . . . . . . . . . . . A-16
DESCRIPTION OF TEST . . . . . . . . . . . . . A-16
ASSUMPTIONS . . . . . . . . . . . . . . . . . A-16
TEST SYNOPSIS . . . . . . . . . . . . . . . . A-16
BATCH FORMS GENERATOR . . . . . . . . . . . . . A-18
REQUIREMENTS MET BY TEST . . . . . . . . . . . A-18
DESCRIPTION OF TEST . . . . . . . . . . . . . A-18
ASSUMPTIONS . . . . . . . . . . . . . . . . . A-18
TEST SYNOPSIS . . . . . . . . . . . . . . . . A-18
FORM EXECUTOR . . . . . . . . . . . . . . . . . A-20
REQUIREMENTS MET BY TEST . . . . . . . . . . . A-20
DESCRIPTION OF TEST . . . . . . . . . . . . . A-20
ASSUMPTIONS . . . . . . . . . . . . . . . . . A-20
TEST SYNOPSIS . . . . . . . . . . . . . . . . A-20
APPENDIX B CROSS-REFERENCE MATRICES
TEST/REQUIREMENTS MATRIX . . . . . . . . . . . . . B-1
REQUIREMENTS/TEST MATRIX . . . . . . . . . . . . . B-2
TEST FILE MATRIX . . . . . . . . . . . . . . . . . B-4
APPENDIX C GLOSSARY
CHAPTER 1
INTRODUCTION
This Computer Program Test Procedures document is divided
into two major sections: (1) Sections (that have numeric
prefixes) which provide background information for the tests and
(2) Appendices (that have alphabetic prefixes) which contain the
tests themselves.
1.1 PURPOSE
This Computer Program Test Procedures document describes
the acceptance test procedures for the Forms Generator computer
program. This research and development is being done for the
Naval Ocean Systems Center (NOSC) under contract
N66001-84-R0030. Items 44 and 47 are the Forms Generator
System. Within this document, the Forms Generator System is
occasionally referred to as the Forms Generator or the FG.
This acceptance test procedures document has been prepared
in accordance with the Navy Data Item Description for a Computer
Program Test Procedures document [NAV78A].
1.2 SCOPE
This document describes the procedures for testing the
Forms Generator after it is developed. The test procedures
defined in this document will show compliance with the
requirements of the proposal.
1.3 SUMMARY
The objective of this document is to explain the test
procedures that are necessary for acceptance testing of the
Forms Generator. Acceptance testing will demonstrate that the
requirements of the proposal have been satisfied. A list of the
requirements that must be verified is provided in the
Requirements Cross Reference Matrix in Appendix B.
1-1
CHAPTER 2
APPLICABLE DOCUMENTS
________ ______ _______ ___ _______
[BEI84] Beizer, Borix, Software System Testing and Quality
_________
Assurance, Van Nostrand Reinhold Co., New York, 1984.
___ ________
[BRU82] Bruce, Phillip and Sam M. Pederson, The Software
___________ _______
Development Project, John Wiley and Sons, Inc., New
York, 1982.
__________ ________ ____
[EVA84] Evans, Michael W., Productive Software Test
__________
Management, John Wiley and Sons, Inc., New York, 1984.
___ ___ __ ________ _______
[MYE79] Myers, Glenford J., The Art of Software Testing, John
Wiley and Sons, Inc., New York, 1979.
[NAV78A] Navy, "Data Item Description, Computer Program Test
Procedures", Navy DI-T2144, 29 November 1978.
[NAV78B] Navy, "Data Item Description, Computer Program Test
Procedures", Navy DI-E-2143, 29 November 1978.
[TI84 ] Texas Instruments, Proposals Associated with the Forms
Generator System, Lewisville, Tx, January 1984.
2-1
CHAPTER 3
TESTING REQUIREMENTS
3.1 GENERAL
Acceptance testing of the Forms Generator must verify the
requirements in the proposal [TI84] for the Forms Generator. A
summary of the requirements from the proposal document is
provided in Appendix B in the Requirements Cross Reference
Matrix. Verifying that the requirements have been satisfied is
a process involving three main steps. A description of each
step is given below.
1. Develop Test Specifications - The first step is to develop
test specifications based on the requirements. The test
specifications outline the testing criteria that is
necessary to show that the Forms Generator satisfies its
original objectives. Appendix A contains the test
specifications for the Forms Generator.
2. Create Test Data - The second step is to create test data to
satisfy the test specifications. The test data is a library
of Ada source programs (which tests the Forms Executor), a
library of Batch Forms Generator tests, and libraries of
keystroke files which test the Interactive Forms Generator
and the Forms Executor.
3. Analyze Results - The third step is to conduct testing and
analyze the results. The Forms Generator is executed with
the test data and test programs that was created in step 2.
The results are analyzed and the appropriate matrices are
updated.
Some of the ideas from Myers [MYE79] were used to
facilitate the development of the test specifications.
Specifically, three acceptance test categories (facility,
volume, and usability) defined by Myers were used to help define
the test specifications. Myers' definitions for facility
testing, volume testing, and usability testing are provided
below.
3-1
TESTING REQUIREMENTS
Facility Facility testing is the determination of whether
each facility or function is actually implemented.
The procedure is to scan the requirements sentence
by sentence and when the sentence specifies a "what"
(e.g., "syntax should be consistent ...", "user
should be able to specify a range of locations
..."), determine if the program satisfies the
"what".
Volume Volume testing is subjecting the program to heavy
volumes of data. For instance, a compiler would be
fed an absurdly large source program to compile. A
linkage editor might be fed a program containing
thousands of modules. An operating system's job
queue would be filled to capacity. In other words,
the purpose of volume testing is to show that the
program cannot handle the volume of data specified
in its requirements.
Usability Usability testing is an attempt to find
human-factor, or usability problems. Unfortunately,
since the computing industry has placed insufficient
attention on studying and defining good human-factor
considerations of programming systems, an analysis
of human factors is still a highly subjective
matter.
3.2 FORMS GENERATOR ACCEPTANCE/PREOPERATING PROCEDURES
The following paragraphs explain the necessary preparations
and procedures for acceptance testing of the Forms Generator.
3.3 EQUIPMENT PREPARATION
In order to complete acceptance testing, the Forms
Generator must be available on a Data General MV 10000 running
under AOS/VS.
3.4 DIGITAL PROCESSOR PREPARATION
In order to complete acceptance testing, the ROLM/Data
General Ada Development Environment (ADE) must be available.
3.5 TESTING PROCEDURE
The procedure for acceptance testing is to fulfill all the
test specifications in Appendix A. This can be accomplished by
completing the second and third steps from Section 3.1.
As noted in step 2, input files for the Forms Generator
must be created to satisfy all of the test specifications in
Appendix A. In addition, the expected output forms for the
Forms Generator must be created based on the input files. Then,
3-2
TESTING REQUIREMENTS
when the Forms Generator tool is ready to undergo acceptance
testing, step 3 is started. Thus, the input files are executed
with the tool. The output files that are generated are compared
with the expected output files, which have already been
established as correct. The file names for the test data
library and the corresponding test specifications that are
satisfied need to be documented in the Test Data Matrix in
Appendix C. Finally, the results of testing are analyzed and
the Test Specification Matrix in Appendix B is updated.
NOTE
One Ada source program and corresponding
keystroke file may be used to satisfy a number
of test specifications in Appendix A. In other
words, it is not necessary to create a separate
set of input files for each test specification
in Appendix A.
3-3
CHAPTER 4
TEST MANAGEMENT
The Forms Generator development team is responsible for
management of the testing described in this document. The Forms
Generator development team responsibilities are to:
o create test data according to the test specifications in
Appendix A, and record the test data information in the Test
Data Matrix in Appendix B,
o conduct the test procedures described in the Testing
Requirements section,
o maintain the Test Specifications Matrix in Appendix B, and
o write an internal test report.
4-1
CHAPTER 5
PERSONNEL REQUIREMENTS
The software development team for the Forms Generator is
the only personnel required to complete the acceptance testing
described in this document.
5-1
CHAPTER 6
HARDWARE REQUIREMENTS
The acceptance testing described in this document shall be
conducted on a Data General MV 10000 running under AOS/VS.
If automated testing of the interactive tools is to be
performed (as opposed to manual testing), Input/Output
redirection is required. AOS/VS does not provide this. At the
customer's discretion, NOSC-TECR (using EUNICE) may be used to
perform automated testing of the interactive aspects of the
tools.
6-1
CHAPTER 7
SOFTWARE REQUIREMENTS
The acceptance testing described in this document requires
the ROLM/Data General Ada Development Environment (ADE).
If automated testing of the interactive tools is to be
performed (as opposed to manual testing), Input/Output
redirection is required. AOS/VS does not provide this. At the
customer's discretion, NOSC-TECR (using EUNICE) may be used to
perform automated testing of the interactive aspects of the
tools.
7-1
CHAPTER 8
TESTING SCHEDULE
The acceptance testing described in this document will take
1-2 weeks to complete.
8-1
CHAPTER 9
QUALITY ASSURANCE
ACSL personnel will be responsible for the following
Quality Assurance and Configuration Management tasks:
o verifying that the test data satisfies the test
specifications,
o verifying that the documentation of each test is complete,
and
o maintaining configuration control of all software undergoing
test.
9-1
APPENDIX A
TEST SPECIFICATIONS
This appendix contains the test specifications for the
Forms Generator System. Each test specification includes a list
of the requirements that are satisfied, a description of the
test, assumptions for the test, and a test synopsis. The test
synopsis describes the input and expected results for the test.
The test categories that are used for each test specification
are also provided in the synopsis. A description of the various
test categories is provided in the Testing Requirements section.
There are three distinct features of the Forms Generator
System that are exercised by the tests described in this
document:
* Interactive Forms Generator
* Batch Forms Generator
* Forms Executor
The Interactive Forms Generator is exercised in test sets 1
to 8. These tests are highly terminal interactive and require
much in the way of tester activity unless I/O redirection is
employed to input the tester's keystrokes. As a side effect of
these tests, the Forms Executor, which is employed heavily by
the Interactive Forms Generator, is exercised by these tests.
The Batch Forms Generator is exercised in test set 9.
Command and data files do most of the work of the test, and the
tester's role is primarily to invoke the required commands to
perform the tests.
The Forms Executor is exercised in test set 10. These
tests are moderately terminal interactive and also employ the
use of simple commands (invocations of the Ada compiler, for
instance). The tester's keystrokes may be provided by a data
file if I/O redirection is supported on the system on which the
tests are being run.
A-1
TEST SPECIFICATIONS
A.1 CREATE/LOAD FORM
A.1.1 REQUIREMENTS MET BY TEST
5 (see Appendix C)
A.1.2 DESCRIPTION OF TEST
The tester will invoke the Interactive Form Generator and
select either menu option 1 (Create a Form) or menu option 2
(Load a Form). He will then provide the inputs listed under
Test Synopsis (below) and observe/record the results. After
providing all inputs, he will selection menu option 6 (Exit) and
return to the operating system. These two menu options are
combined into this one test because they both involve loading in
a form.
A.1.3 ASSUMPTIONS
The tester knows the basics of using the host computer's
operating system and knows how to invoke the Interactive Form
Generator. The tester knows how to use the IFG and knows the
commands associated with it.
A.1.4 TEST SYNOPSIS
The following table summarizes the test data, expected
outputs, and test categories addressed by the associated test
data.
INDEX INPUT DATA EXPECTED RESULTS CATEGORIES
===== ========== ================ ==========
1 Select option 1; Blank form is FACILITY
strike RETURN key loaded
2 Exit the Edit, and Blank form is FACILITY
select option 2; displayed
strike any key except
for the RETURN key;
select option 3
3 Exit the Edit; and Form is loaded FACILITY
select option 2;
strike the RETURN
key; enter valid file
name for existing
form
4 Exit the Edit; and Form was not FACILITY
select option 1; cleared
strike any key except
A-2
TEST SPECIFICATIONS
for the RETURN key;
select option 3 (edit)
5 Exit the Edit; and Blank form is FACILITY
select option 1; loaded
enter RETURN key;
enter another RETURN
6 Select option 6 (exit); No unrecoverable FACILITY
strike RETURN key; errors
reinvoke IFG program;
select option 2; enter
a valid directory
reference with the
name of an existing
form file
7 Exit the Edit; select No unrecoverable FACILITY
option 2; enter the errors
RETURN key; enter
a valid directory
reference with the
name of a file that
exists but is not
a valid form file
8 Select option 2; No unrecoverable FACILITY
enter a valid errors
directory reference
with the name of a
file that does not exist
9 Select option 2; No unrecoverable FACILITY
enter an invalid error
directory reference with
the name of a file that
exists
10 Select option 2; No unrecoverable FACILITY
enter an invalid errors
directory reference
with the name of a file
that does not exist
11 Select option 2; No unrecoverable FACILITY
enter an invalid errors
file name
12 Select option 6 (exit) Cleanup for next FACILITY
test
A-3
TEST SPECIFICATIONS
A.2 EDIT FORM 1
A.2.1 REQUIREMENTS MET BY TEST
1, 3, 4, 5, 6, 7 (see Appendix C)
A.2.2 DESCRIPTION OF TEST
The tester will invoke the Interactive Form Generator and
select menu option 3 (Edit a Form). He will then provide the
inputs listed under Test Synopsis (below) and observe/record the
results.
A.2.3 ASSUMPTIONS
The tester knows the basics of using the host computer's
operating system and knows how to invoke the Interactive Form
Generator. The tester knows how to use the IFG and knows the
commands associated with it.
A.2.4 TEST SYNOPSIS
The following table summarizes the test data, expected
outputs, and test categories addressed by the associated test
data. These tests must be conducted in the sequence shown (test
1 before test 2, test 2 before test 3, etc).
INDEX INPUT DATA EXPECTED RESULTS CATEGORIES
===== ========== ================ ==========
1 Invoke the IFG; select No unrecoverable FACILITY
option 3 errors
2 Select option 1; Blank form is FACILITY
strike the RETURN displayed
key; enter another
RETURN
3 Use the arrow keys to Cursor Movement FACILITY
move about on the is correct
screen; try as a
minimum moving up
from HOME, left
from HOME, down
from the lower
right-hand corner,
right from the
lower right-hand
corner, left from
the lower left-hand
corner, down from
the lower left-hand
A-4
TEST SPECIFICATIONS
corner, right from
the upper right-hand
corner, up from the
upper right-hand corner,
and across line boundaries
(left and right) over the
form
4 Exit the Edit, select option 2; Test file is FACILITY
enter the RETURN key; displayed
and load the first
EDIT FORM test file
5 Copy the first field to after Copy a Field FACILITY
the last field; copy this last (A.2.1)
field to somewhere in the
middle of the form; try to
copy one field on top of
another; perform at least
5 more copy operations of
your choice; use both forms
of the Copy a Field command
(ie, keystroke and command line)
6 Copy the last line in the form Copy a Line FACILITY
to before the first line; copy (A.2.2)
the first line in the form
to before the last line;
perform at least 5 more copy
line operations of your
choice; use both forms of the
Copy a Line command
7 Exit the Edit; select option Cleanup for FACILITY
6; and do not save the form next test
A-5
TEST SPECIFICATIONS
A.3 EDIT FORM 2
A.3.1 REQUIREMENTS MET BY TEST
1, 3, 4, 5, 6, 7 (see Appendix C)
A.3.2 DESCRIPTION OF TEST
The tester will invoke the Interactive Form Generator and
select menu option 3 (Edit a Form). He will then provide the
inputs listed under Test Synopsis (below) and observe/record the
results.
A.3.3 ASSUMPTIONS
The tester knows the basics of using the host computer's
operating system and knows how to invoke the Interactive Form
Generator. The tester knows how to use the IFG and knows the
commands associated with it.
A.3.4 TEST SYNOPSIS
The following table summarizes the test data, expected
outputs, and test categories addressed by the associated test
data. These tests must be conducted in the sequence shown (test
1 before test 2, test 2 before test 3, etc).
INDEX INPUT DATA EXPECTED RESULTS CATEGORIES
===== ========== ================ ==========
1 Select option 2 and Test file is FACILITY
load the first EDIT displayed
FORM test file
2 Create four new fields, Create a New FACILITY
each of a different Field (A.2.3)
code (a,b,n,x)
3 Try to create a field Field not FACILITY
on top of an created
existing field
4 Try to create a field Field not FACILITY
that overlaps into created
the next field
5 Try at least 5 more Create a New FACILITY
fields on the form Field
6 Delete characters at Delete Char FACILITY
random; try to delete (A.2.4)
chars within a field;
A-6
TEST SPECIFICATIONS
delete the first
character in the form;
delete the last char
in the form
7 Delete the first field Delete Field FACILITY
on the form; delete (A.2.5)
the last field on the
form; try to delete
a field when the cursor
is not resting in a
field
8 Delete the first line Delete Line FACILITY
of the form; delete (A.2.6)
the last line of the
form; try to delete
a line with a field
in it; delete a line
which does not have
a field in it
9 Invoke the Help display Help (A.2.7) FACILITY
10 Exit the Help; Exit Cleanup FACILITY
the Edit; enter a
RETURN; and do
not save the form
A-7
TEST SPECIFICATIONS
A.4 EDIT FORM 3
A.4.1 REQUIREMENTS MET BY TEST
1, 3, 4, 5, 6, 7 (see Appendix C)
A.4.2 DESCRIPTION OF TEST
The tester will invoke the Interactive Form Generator and
select menu option 3 (Edit a Form). He will then provide the
inputs listed under Test Synopsis (below) and observe/record the
results.
A.4.3 ASSUMPTIONS
The tester knows the basics of using the host computer's
operating system and knows how to invoke the Interactive Form
Generator. The tester knows how to use the IFG and knows the
commands associated with it.
A.4.4 TEST SYNOPSIS
The following table summarizes the test data, expected
outputs, and test categories addressed by the associated test
data. These tests must be conducted in the sequence shown (test
1 before test 2, test 2 before test 3, etc).
INDEX INPUT DATA EXPECTED RESULTS CATEGORIES
===== ========== ================ ==========
1 Select option 2 and Test file is FACILITY
load the first EDIT displayed
FORM test file
2 Insert a char from Insert Char FACILITY
HOME positon; (A.2.8)
insert a char from
lower right-hand
corner; insert 5
chars at random;
try to insert a
char from within
a field
3 Insert a blank line Insert Line FACILITY
before the first (A.2.9)
line; insert a
blank line before
the last line;
insert a blank line
around the middle
of the form; insert
A-8
TEST SPECIFICATIONS
a blank line when
there is text or
one or more fields
on the last line
4 Position to an existing Modify Field FACILITY
field; perform 10 (A.2.10)
modifies on it; change
the modes to a,n,b,x
in 4 of the modifies;
overlap with the next
field in one of the
modifies; use both types
of renditions; one modify
should have no initial
field value
5 Exit the Edit; enter a Cleanup FACILITY
RETURN; and do
not save the form
A-9
TEST SPECIFICATIONS
A.5 EDIT FORM 4
A.5.1 REQUIREMENTS MET BY TEST
1, 3, 4, 5, 6, 7 (see Appendix C)
A.5.2 DESCRIPTION OF TEST
The tester will invoke the Interactive Form Generator and
select menu option 3 (Edit a Form). He will then provide the
inputs listed under Test Synopsis (below) and observe/record the
results.
A.5.3 ASSUMPTIONS
The tester knows the basics of using the host computer's
operating system and knows how to invoke the Interactive Form
Generator. The tester knows how to use the IFG and knows the
commands associated with it.
A.5.4 TEST SYNOPSIS
The following table summarizes the test data, expected
outputs, and test categories addressed by the associated test
data. These tests must be conducted in the sequence shown (test
1 before test 2, test 2 before test 3, etc).
INDEX INPUT DATA EXPECTED RESULTS CATEGORIES
===== ========== ================ ==========
1 Select option 2 and Test file is FACILITY
load the first EDIT displayed
FORM test file
2 Move the first field Move Field FACILITY
to after the last (A.2.11)
field; move the
last field to before
the first field;
perform 5 other
moves; try to move
a field into another
field
3 Move the first line Move Line FACILITY
to before the last (A.2.12)
line; move the last
line to before the
first line; perform
3 more moves
4 Rubout the first and Rubout Char FACILITY
A-10
TEST SPECIFICATIONS
last chars; rubout (A.2.13)
chars at random; try
to rubout a char in
a field
5 Exit the Edit; enter Cleanup FACILITY
a RETURN; and do
not save the form
A-11
TEST SPECIFICATIONS
A.6 MODIFY FORM
A.6.1 REQUIREMENTS MET BY TEST
1, 3, 4, 6 (see Appendix C)
A.6.2 DESCRIPTION OF TEST
The tester will invoke the Interactive Form Generator and
select menu option 4 (Modify a Form). He will then provide the
inputs listed under Test Synopsis (below) and observe/record the
results. After providing all inputs, he will selection menu
option 6 (Exit) and return to the operating system.
A.6.3 ASSUMPTIONS
The tester knows the basics of using the host computer's
operating system and knows how to invoke the Interactive Form
Generator. The tester knows how to use the IFG and knows the
commands associated with it.
A.6.4 TEST SYNOPSIS
The following table summarizes the test data, expected
outputs, and test categories addressed by the associated test
data.
INDEX INPUT DATA EXPECTED RESULTS CATEGORIES
===== ========== ================ ==========
1 Select option 2 and Test file is FACILITY
load the first EDIT displayed
FORM test file;
Exit the Edit
2 Select option 4; Modify Options FACILITY
examine current (A.3)
form options;
enter a RETURN
3 Vary the form size, Form Attributes FACILITY
form position, and modified
clear screen options;
return to Main Menu
by entering a RETURN
4 Repeat steps 2 and 3 Form Attributes FACILITY
several times, and modified
include at least the
following tests:
clear screen YES and
NO, form position at
A-12
TEST SPECIFICATIONS
home and lower right-
hand corner, form
position around the
middle of the screen,
form size=screen size,
form size < screen size,
form size > screen size;
return to Main Menu
by entering a RETURN
5 Exit the IFG via option 6 Cleanup FACILITY
and do not save form
A-13
TEST SPECIFICATIONS
A.7 SAVE FORM
A.7.1 REQUIREMENTS MET BY TEST
1, 4 (see Appendix C)
A.7.2 DESCRIPTION OF TEST
The tester will invoke the Interactive Form Generator and
select inputs listed under Test Synopsis (below) and
observe/record the results. After providing all inputs, he will
selection menu option 6 (Exit) and return to the operating
system.
A.7.3 ASSUMPTIONS
The tester knows the basics of using the host computer's
operating system and knows how to invoke the Interactive Form
Generator. The tester knows how to use the IFG and knows the
commands associated with it.
A.7.4 TEST SYNOPSIS
The following table summarizes the test data, expected
outputs, and test categories addressed by the associated test
data.
INDEX INPUT DATA EXPECTED RESULTS CATEGORIES
===== ========== ================ ==========
1 Select option 2; enter Form is loaded FACILITY
valid file name for
existing form; exit
the Edit
2 Select option 5; strike Current form is FACILITY
RETURN key saved in the
original file
3 Select option 5 and Current form is FACILITY
enter another file saved in
name another file
4 Select option 5 Current form is FACILITY
and enter another saved
directory reference
and file name
5 Select option 5 Current form is FACILITY
and enter invalid NOT saved
file name
A-14
TEST SPECIFICATIONS
6 Select option 5 Current form is FACILITY
and enter invalid NOT saved
directory reference
and file name
7 Select option 6 Cleanup FACILITY
and exit with no
save
A-15
TEST SPECIFICATIONS
A.8 EXIT INTERACTIVE FORM GENERATOR
A.8.1 REQUIREMENTS MET BY TEST
1 (see Appendix C)
A.8.2 DESCRIPTION OF TEST
The tester will invoke the Interactive Form Generator and
select inputs listed under Test Synopsis (below) and
observe/record the results. After providing all inputs, he will
selection menu option 6 (Exit) and return to the operating
system.
A.8.3 ASSUMPTIONS
The tester knows the basics of using the host computer's
operating system and knows how to invoke the Interactive Form
Generator. The tester knows how to use the IFG and knows the
commands associated with it.
A.8.4 TEST SYNOPSIS
The following table summarizes the test data, expected
outputs, and test categories addressed by the associated test
data.
INDEX INPUT DATA EXPECTED RESULTS CATEGORIES
===== ========== ================ ==========
1 Select option 2; enter Form is loaded FACILITY
valid file name for
existing form
2 Exit the Edit; Current form is FACILITY
Select option 5; saved
strike RETURN key
3 Select option 6 Exit without FACILITY
prompt
4 Enter IFG, select opt Form is loaded FACILITY
1, enter RETURN as blank
(blank form)
5 Exit the Edit; Form is still FACILITY
Select option 6; loaded, and
strike any character exit does not
except for RETURN happen.
key
6 Select option 6; Exit FACILITY
A-16
TEST SPECIFICATIONS
strike the RETURN
key
7 Try several "normal" General tests FACILITY
runs of the IFG,
saving the forms
each time; at least
one edit of a blank
form, one edit of
an old form, and
one load of a non-
existant form should
be done with exits
(opt 5) done each time
to see that proper
prompts appear
A-17
TEST SPECIFICATIONS
A.9 BATCH FORMS GENERATOR
A.9.1 REQUIREMENTS MET BY TEST
1, 4, 6, 7 (Appendix C)
A.9.2 DESCRIPTION OF TEST
The tester will invoke the Batch Forms Generator and
provide input data files to the program. Outputs, including
error messages, generated by the program will be observed.
A.9.3 ASSUMPTIONS
The tester knows the basics of using the host computer's
operating system and knows how to invoke the Batch Forms
Generator (BFG). The tester knows how to use the BFG and knows
the commands associated with it.
A.9.4 TEST SYNOPSIS
The following table summarizes the test data, expected
outputs, and test categories addressed by the associated test
data.
INDEX INPUT DATA EXPECTED RESULTS CATEGORIES
===== ========== ================ ==========
1 Invoke BFG; present Normal operation FACILITY
name of test file 1; with possible
observe results message generation
and note discrepancies
2 Invoke BFG; present BFG recovers FACILITY
invalid file name
3 Invoke BFG; present BFG recovers FACILITY
invalid dir name
4 Invoke BFG; present Normal operation FACILITY
name of test file 2; with possible
observe results and message generation
not discrepancies
5 Invoke BFG; present Normal operation FACILITY
name of test file 3; with possible
observe results and message generation
not discrepancies
6 Invoke BFG; present Normal operation FACILITY
name of test file 4; with possible
observe results and message generation
A-18
TEST SPECIFICATIONS
not discrepancies
7 Invoke BFG; present Normal operation FACILITY
name of test file 5; with possible
observe results and message generation
not discrepancies
A-19
TEST SPECIFICATIONS
A.10 FORM EXECUTOR
A.10.1 REQUIREMENTS MET BY TEST
1, 2, 3, 8 (see Appendix C)
A.10.2 DESCRIPTION OF TEST
The tester will compile and execute a group of test
programs. These programs WITH in the Form Executor package and
use it to manipulate forms. The tester will provide information
to the displayed forms, manipulate the cursor, test the field
data inputs, etc, and observe the results.
A.10.3 ASSUMPTIONS
The tester knows the basics of using the host computer's
operating system and knows how to invoke the Ada compiler on the
host computer and run programs compiled by this Ada compiler.
The tester knows how to provide input to forms presented by the
Forms Executor.
A.10.4 TEST SYNOPSIS
The following table summarizes the test data, expected
outputs, and test categories addressed by the associated test
data. Tests 1 and 2 are performed on one type of terminal,
tests 3 and 4 on another, and tests 5 and 6 on yet another.
INDEX INPUT DATA EXPECTED RESULTS CATEGORIES
===== ========== ================ ==========
1 Compile test program 1; Successful test FACILITY
execute it; provide
inputs to the form;
test for invalid
inputs (such as
alphabetic data in
a numeric field, etc)
2 Compile test program 2; Successful test FACILITY
execute it; provide
inputs to the form;
test for invalid
inputs (such as
alphabetic data in
a numeric field, etc)
3 Compile test program 3; Successful test FACILITY
execute it; provide
inputs to the form;
test for invalid
A-20
TEST SPECIFICATIONS
inputs (such as
alphabetic data in
a numeric field, etc);
do this test on a
different type of
terminal than tests
1 and 2
4 Compile test program 4; Successful test FACILITY
execute it; provide
inputs to the form;
test for invalid
inputs (such as
alphabetic data in
a numeric field, etc)
5 Compile test program 5; Successful test FACILITY
execute it; provide
inputs to the form;
test for invalid
inputs (such as
alphabetic data in
a numeric field, etc);
do this test on a
different type of
terminal than tests
1, 2, 3, and 4
6 Compile test program 6; Successful test FACILITY
execute it; provide
inputs to the form;
test for invalid
inputs (such as
alphabetic data in
a numeric field, etc)
A-21
APPENDIX B
CROSS-REFERENCE MATRICES
B.1 TEST/REQUIREMENTS MATRIX
-----------------------------------------------------------------------
| TEST SPEC | REQUIREMENTS | CHECK | COMMENTS |
|===========|==============|=======|==================================|
| 1 | 5 | | |
|-----------|--------------|-------|----------------------------------|
| 2 | 1,3,4,5,6,7 | | |
|-----------|--------------|-------|----------------------------------|
| 3 | 1,3,4,5,6,7 | | |
|-----------|--------------|-------|----------------------------------|
| 4 | 1,3,4,5,6,7 | | |
|-----------|--------------|-------|----------------------------------|
| 5 | 1,3,4,5,6,7 | | |
|-----------|--------------|-------|----------------------------------|
| 6 | 1,3,4,6 | | |
|-----------|--------------|-------|----------------------------------|
| 7 | 1,4 | | |
|-----------|--------------|-------|----------------------------------|
| 8 | 1 | | |
|-----------|--------------|-------|----------------------------------|
| 9 | 1,4,6,7 | | |
|-----------|--------------|-------|----------------------------------|
| 10 | 1,2,3,8 | | |
|-----------|--------------|-------|----------------------------------|
B-1
CROSS-REFERENCE MATRICES
B.2 REQUIREMENTS/TEST MATRIX
TEST
SPEC REQUIREMENT AND PROPOSAL SECTION
2,3,4, 1 Page 2-2, Section 3.2.3, A form is a collection of
5,6,7, screen formats, their components and attributes.
8,9,10 It consists of a rectangular region of a single
formatted screen the same width as a physical
display.
10 2 Page 2-2, Section 3.2.2, A form can be redesigned
or installed on a different terminal without
affecting the application. The application is
also relieved of handling simple input edit
errors.
2,3,4, 3 Page 2-2, Section 3.2.2, Interactions with the
5,6,10 terminal are shifted from the application
program to the Form Executor.
2,3,4, 4 Page 2-2, Section 3.2.1, Screen Generator will
5,6,7,9 translate a textual description of a virtual
terminal screen format into a structure which
is machine readable.
1,2,3, 5 Page 2-2, Section 3.2.4, User Interface Form
4,5 Generator will provide an interactive interface
to design a screen format and save the
representation in a machine readable structure.
2,3,4, 6 Page 2-2, Section 3.2.3, A form is described by
5,6,9 the values of the following attributes:
1. Size - the number of rows and columns in form
2. Position - the position on the physical screen
of the upper leftmost position of
the form when it is displayed
3. Clear Screen - indicates whether the entire
physical screen is to be
cleared before the form is
displayed
2,3,4, 7 Page 2-3, Section 3.2.3, The fields of a form are
5,9 described by the values of these attributes:
1. Name - an arbitrary character string that
uniquely identifies the field within
a form
2. Position - the row and column within the
B-2
CROSS-REFERENCE MATRICES
form at which the first character
of the field is located
3. Length - the number of characters in the
field
4. Graphic Rendition - the graphic rendition
of the characters in the
field
5. Character Limitation - the characters that are
permitted to be entered
into a field
6. Value - the initial value of the field when it
is displayed
7. Mode - indicates whether the field may be
modified during program execution
10 8 Page 2-3, Section 3.2.2, The Form Executor will
provide procedural and functional interfaces that
enable a program to access the output of the
Screen Generator or User Interface Form Generator
programs and present it to a physical terminal.
The following operations are provided:
1. Access Form - the location of a form is
specified and the form is
made available to the program
2. Modify Field - the value of a field is
changed (if permitted)
3. Present Form - the form is displayed on the
physical screen and the
terminal user is permitted
to modify those portions of
the form identified as being
modifiable
4. Query Form - determine information about the
form after the terminal user has
entered all data
B-3
CROSS-REFERENCE MATRICES
B.3 TEST FILE MATRIX
------------------------------------------------------------------
| TEST FILE NAME | TEST SPECIFICATION(S) SATISFIED |
|==================|=============================================|
| | |
|------------------|---------------------------------------------|
| | |
|------------------|---------------------------------------------|
| | |
|------------------|---------------------------------------------|
| | |
|------------------|---------------------------------------------|
| | |
|------------------|---------------------------------------------|
| | |
|------------------|---------------------------------------------|
| | |
|------------------|---------------------------------------------|
| | |
|------------------|---------------------------------------------|
B-4
APPENDIX C
GLOSSARY
__________ ____
1. Acceptance Test An acceptance test is a test conducted by a
customer to determine if the software or system contracted
for is performing as stated in the contractual requirements.
____
2. ACSL Advanced Computer Systems Laboratory, Texas
Instruments.
________ ____
3. Facility Test Facility testing is the determination of
whether each facility or function is actually implemented.
The procedure is to scan the requirements sentence by
sentence and when the sentence specifies a "what" (e.g.,
"syntax should be consistent ...", "user should be able to
specify a range of locations ..."), determine if the program
satisfies the "what".
____
4. NOSC Naval Ocean Systems Center.
_________ ____
5. Usability Test Usability testing is an attempt to find
human-factor, or usability problems. Unfortunately, since
the computing industry has placed insufficient attention on
studying and defining good human-factor considerations of
programming systems, an analysis of human factors is still a
highly subjective matter.
______ ____
6. Volume Test Volume testing is subjecting the program to
heavy volumes of data. For instance, a compiler would be
fed an absurdly large source program to compile. A linkage
editor might be fed a program containing thousands of
modules. An operating system's job queue would be filled to
capacity. In other words, the purpose of volume testing is
to show that the program cannot handle the volume of data
specified in its requirements.
C-1
--::::::::::
--form2man.doc
--::::::::::
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
User Manual
for an
Form Generator System
in Ada
Prepared for: |||||||||||||||||||||||||
|||||||||||||||||||||||||
Advanced Computer Systems Lab |||||||||||||||||||||||||
Texas Instruments |||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
Equipment Group - ACSL |||||||||||||||||||||||||
P.O. Box 801, M.S. 8007 |||||||||||||||||||||||||
McKinney, Texas 75069 |||||||||||||||||||||||||
15 March 1985 |||||||||||||||||||||||||
|||||||||||||||||||||||||
TEXAS INSTRUMENTS
INCORPORATED
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
|||||||||||||||||||||||||
CONTENTS
CHAPTER 1 INTRODUCTION
INTRODUCTION . . . . . . . . . . . . . . . . . . . 1-1
Problem Statement . . . . . . . . . . . . . . . 1-1
Objective . . . . . . . . . . . . . . . . . . . 1-1
Scope . . . . . . . . . . . . . . . . . . . . . 1-1
CHAPTER 2 BATCH FORMS GENERATOR
INTRODUCTION . . . . . . . . . . . . . . . . . . . 2-1
ERROR MESSAGES . . . . . . . . . . . . . . . . . . 2-2
CHAPTER 3 INTERACTIVE FORMS GENERATOR
THE MAIN MENU . . . . . . . . . . . . . . . . . . 3-1
Create A New Form . . . . . . . . . . . . . . . 3-2
Load In An External Form . . . . . . . . . . . . 3-2
Edit The Current Form . . . . . . . . . . . . . 3-2
Save The Current Form . . . . . . . . . . . . . 3-2
Modify The Current Form's Attributes . . . . . . 3-3
EXIT THE INTERACTIVE FORM GENERATOR . . . . . . . 3-3
THE FORM EDITOR . . . . . . . . . . . . . . . . . 3-3
The Command Line . . . . . . . . . . . . . . . . 3-4
Create A New Field . . . . . . . . . . . . . . . 3-5
Modify An Existing Field . . . . . . . . . . . . 3-5
Move A Field . . . . . . . . . . . . . . . . . . 3-6
Copy A Field . . . . . . . . . . . . . . . . . . 3-6
Delete A Field . . . . . . . . . . . . . . . . . 3-6
Insert A Line . . . . . . . . . . . . . . . . . 3-6
Move A Line . . . . . . . . . . . . . . . . . . 3-7
Copy A Line . . . . . . . . . . . . . . . . . . 3-7
Delete A Line . . . . . . . . . . . . . . . . . 3-7
Insert A Character . . . . . . . . . . . . . . . 3-7
Delete A Character . . . . . . . . . . . . . . . 3-8
Rubout A Character . . . . . . . . . . . . . . . 3-8
Help . . . . . . . . . . . . . . . . . . . . . . 3-8
ERROR MESSAGES . . . . . . . . . . . . . . . . . . 3-8
CHAPTER 4 FORM EXECUTOR INTERFACE
ACCESS A NEW FORM . . . . . . . . . . . . . . . . 4-1
Abstract . . . . . . . . . . . . . . . . . . . . 4-1
Parameters . . . . . . . . . . . . . . . . . . . 4-1
Exceptions Raised . . . . . . . . . . . . . . . 4-1
GET VALUE OF A FIELD . . . . . . . . . . . . . . . 4-1
Abstract . . . . . . . . . . . . . . . . . . . . 4-1
Parameters . . . . . . . . . . . . . . . . . . . 4-2
Exceptions Raised . . . . . . . . . . . . . . . 4-2
Page 2
CLEAR FORM VALUES . . . . . . . . . . . . . . . . 4-2
Abstract . . . . . . . . . . . . . . . . . . . . 4-2
Parameters . . . . . . . . . . . . . . . . . . . 4-2
Exceptions Raised . . . . . . . . . . . . . . . 4-2
MODIFY FORM FIELD VALUE . . . . . . . . . . . . . 4-2
Abstract . . . . . . . . . . . . . . . . . . . . 4-2
Parameters . . . . . . . . . . . . . . . . . . . 4-3
Exceptions Raised . . . . . . . . . . . . . . . 4-3
DISPLAY FORM AND ACCEPT INPUT . . . . . . . . . . 4-3
Abstract . . . . . . . . . . . . . . . . . . . . 4-3
Parameters . . . . . . . . . . . . . . . . . . . 4-4
Exceptions Raised . . . . . . . . . . . . . . . 4-4
RELEASE FORM . . . . . . . . . . . . . . . . . . . 4-4
Abstract . . . . . . . . . . . . . . . . . . . . 4-4
Parameters . . . . . . . . . . . . . . . . . . . 4-5
Exceptions . . . . . . . . . . . . . . . . . . . 4-5
EXCEPTIONS . . . . . . . . . . . . . . . . . . . . 4-5
APPENDIX A TERMINAL INTERFACE AND KEY MAPPING
APPENDIX B MAINTENANCE INFORMATION
AUTOMATED FORM GENERATION . . . . . . . . . . . . B-1
HUMAN READABLE FILE GENERATOR . . . . . . . . . . B-1
KEY MAPPING INTERFACE . . . . . . . . . . . . . . B-1
MORE DISPLAY RENDITIONS . . . . . . . . . . . . . B-1
MORE FIELD TYPES . . . . . . . . . . . . . . . . . B-2
REMOVE DEPENDENCY ON VIRTUAL TERMINAL . . . . . . B-2
DEFAULT CONTROL KEY MAPPING . . . . . . . . . . . B-2
ADDITIONAL INPUT FUNCTIONS . . . . . . . . . . . . B-2
TERMINAL SIZE . . . . . . . . . . . . . . . . . . B-2
CHAPTER 1
INTRODUCTION
1.1 INTRODUCTION
1.1.1 Problem Statement
Software development today is frequently done with interactive tools.
The two-dimensional aspect of a video terminal screen is frequently
used to present an interface between a tool and its user. The design
and implementation of interactive interfaces are, for the most part,
done in an "ad hoc" manner; that is, the user interface code is
intertwined with the application. This method of design and
implementation forces modification of the source code of the program
that is presenting the interface, resulting in much recoding of
software as modifications are made to the format of the interface.
A mechanism is needed to separate the design and presentation of a
screen format from the program that uses the screen format. Such a
mechanism permits a program to be written that can base its decisions
on information obtained from the fields of the screen without any need
to refer to specific screen positions.
1.1.2 Objective
The objective of the Form Generator System is to provide a convenient
and transportable toolset for the design and presentation of formats
for character-imaging video terminal displays.
1.1.3 Scope
The Form Generator System will enable an application programmer to
separate an application's procedural code from the code required to
drive a terminal. The Form Generator System will provide both an
interactive and batch interface that enables an applications
programmer to design a screen format and save the representation in a
machine readable form. The Form Executor package will provide
procedural and functional interfaces that enable a program to access
the output of the Form Generator System and present it to a terminal.
INTRODUCTION Page 1-2
Scope 17 March 1985
This toolset will support asynchronous ASCII terminals with single
character transmission capabilities.
CHAPTER 2
BATCH FORMS GENERATOR
2.1 INTRODUCTION
The Batch Forms Generator converts a human readable form definition
file into a machine readable form definition file. A single form can
be defined in each definition file. A listing file is also produced
which lists the form definition with any error messages produced by
the Batch Forms Generator.
The Form Definition Language described in this section is used in the
human readable definition file to define the form and its text labels
and fields. These statements look like standard Ada procedure calls
with named parameter associations. As each statement is described,
the default value for each parameter is given.
Only one form may be defined in each file and the first statement must
be the "FORM" definition statement. The "SIZE" parameter gives the
size of the form in number of rows and columns. The "POSITION"
parameter gives the position of the form on the display screen. The
position is specified by giving the row and column of the upper
left-hand corner for the form. The "CLEAR_SCREEN" parameter indicates
whether the display window should be cleared before presenting the
form.
FORM( SIZE => (24, 80), -- rows & columns of form
POSITION => (1, 1), -- row & column of upper left
CLEAR_SCREEN => YES ); -- YES or NO
Forms normally contain text labels which identify fields on the
screen. These text labels may be defined with the "TEXT" statement.
The "VALUE" parameter gives the text value for the label. Since each
text label must have a value, this parameter is not optional. The
"POSITION" parameter gives the row and column relative to the form of
the beginning of the text label. Since each text label must have a
position, this parameter is not optional. The "RENDITION" parameter
indicates how the label should be displayed ("PRIMARY" - normal
display; "REVERSE" - reverse video display).
TEXT( VALUE => "", -- text value
POSITION => (1, 1), -- row & column of left
RENDITION => PRIMARY); -- PRIMARY or REVERSE
BATCH FORMS GENERATOR Page 2-2
INTRODUCTION 17 March 1985
Forms contain one or more fields where information can be displayed
and user input can be obtained. These fields are defined by the
"FIELD" statement. The "NAME" parameter gives the field a name for
reference when information is to be displayed or input is to be
obtained. Since the field must be referenced by the user with this
name, this parameter is not optional. The "POSITION" parameter gives
the row and column relative to the form of the beginning of the field.
Since each field must have a position, this parameter is not optional.
The "LENGTH" parameter defines the length of the field. Since each
field must have a length, this parameter is not optional. The
"RENDITION" parameter indicates how the field should be displayed
("PRIMARY" - normal display; "REVERSE" - reverse video display). The
"LIMITATION" parameter indicates the type of characters which may be
entered into the field ("ALPHABETIC" - letters only; "ALPHANUMERIC" -
letters and digits; "NUMERIC" -- digits only; "NOT_LIMITED" - any
character). The "DEFAULT" parameter gives the value to be displayed
in the field if no other value is supplied. The "MODE" parameter
indicates whether the field is output only or output and input
("INPUT_OUTPUT" - input and output; "OUTPUT_ONLY" - output only).
FIELD( NAME => "", -- field name
POSITION => (1, 1), -- row & column of left
LENGTH => 10, -- length of field
RENDITION => PRIMARY; -- PRIMARY or REVERSE
LIMITATION => NOT_LIMITED, -- ALPHABETIC, ALPHANUMERIC,
-- NUMERIC, or NOT_LIMITED.
DEFAULT => "", -- initial value or text
MODE => INPUT_OUTPUT); -- OUTPUT_ONLY or INPUT_OUTPUT.
2.2 ERROR MESSAGES
Abnormal Error Condition
Internal error occurred which caused abnormal termination of Batch
Generator.
Error in Adding Field to Form
Internal error occurred adding the field definition to the form.
Error in Creating Form
Internal error occurred creating the form definition.
Expected FORM, FIELD, or TEXT Statement
A statement must begin the the keywords FORM, FIELD, or TEXT.
Expected Identifier
An identifier was expected but some other symbol was found.
BATCH FORMS GENERATOR Page 2-3
ERROR MESSAGES 17 March 1985
Expected Number
A number was expected but some other symbol was found.
Expected OUTPUT_ONLY or INPUT_OUTPUT
The OUTPUT_ONLY or INPUT_OUTPUT keyword was expected but some
other keyword was found.
Expected PRIMARY or REVERSE
The PRIMARY or REVERSE keyword was expected but some other keyword
was found.
Expected String
A string was expected but some other symbol was found.
Expected Text Limitation Specification
The ALPHABETIC, ALPHANUMERIC, NUMERIC, or NOT_LIMITED keyword was
expected but some other keyword was found.
Expected YES or NO
The CLEAR_SCREEN option must be followed by the keyword YES or NO.
Expected '('
A left parenthesis was expected but some other symbol was found.
Expected ')'
A right parenthesis was expected but some other symbol was found.
Expected '=>'
An arrow was expected but some other symbol was found.
Expected ','
A comma was expected but some other symbol was found.
Expected ',' or ')'
A comma or right parenthesis was expected to terminate a parameter
but some other symbol was found.
Expected ';'
A semicolon was expected but some other symbol was found.
BATCH FORMS GENERATOR Page 2-4
ERROR MESSAGES 17 March 1985
Field name is not unique
Each field must have a unique name.
Field not within form boundary
The field position is outside the boundary of the form or the
field extends past the boundary of the form.
Field overlaps another field
The field overlaps a previously defined field.
FIELD Statement Correct but FORM Not Open
The FIELD statement was specified correctly but the FORM was not
updated because the FORM statment was incorrect.
File Name/Open/Create Error
The file specified could not be opened or created.
Invalid Format for Identifier
The identifier was too long or contained an invalid character.
Invalid Format for Number
The number was too long or contained an nonnumeric character.
Invalid Format for String
The string was too long or was not terminated with a quote
character.
Invalid Parameter
The parameter name was not valid for the statement.
LENGTH Parameter is Missing
The FIELD statement requires a LENGTH parameter but it was
missing.
Multiple FORM Statements
Each input file can define only one form and thus must have only
one FORM statement.
NAME Parameter is Missing
The FIELD statement requires a NAME parameter but it was missing.
BATCH FORMS GENERATOR Page 2-5
ERROR MESSAGES 17 March 1985
POSITION Parameter is Missing
The FIELD and TEXT statements require a POSITION parameter but it
was missing.
Text field not within form boundary
The text field position is outside the boundary of the form or the
text field extends past the boundary of the form.
Text field overlaps another field
The text field overlaps a previously defined field.
TEXT Statement Correct but FORM Not Open
The TEXT statement was specified correctly but the FORM was not
updated because the FORM statment was incorrect.
Unrecognized Keyword Encountered
An identifier was found which was not a valid keyword.
Unrecognized Token Encountered
A symbol was found which was not one of the valid tokens.
VALUE Parameter is Missing
The TEXT statement requires a VALUE parameter but it was missing.
CHAPTER 3
INTERACTIVE FORMS GENERATOR
The Interactive Forms Generator is a tool designed to allow a user to
interactively create and alter forms. Facilities are also provided to
allow the user to save the edited forms in an external file. These
saved forms can then be used by applications programs, in cooperation
with the Form Executor, to interact with the user.
The driving procedure of the Interactive Forms Generator is entitled
INTERACT. Upon beginning execution of this procedure, the Main Menu
is displayed. There are essentially two major sections to this
Interactive Forms Generator. The first section is the Main Menu which
is the entire driver of the system. The second section is the Form
Editor itself. This Form Editor is the interactive editing facility
for creating and modifying forms. This Main Menu, the Form Editor,
and each of the individual menu choices and editor commands are
explained in detail below.
3.1 THE MAIN MENU
The Main Menu is the only entry point to the Interactive Forms
Generator. This Main Menu allow the user to select one of six
possible choices. The Main Menu appears as follows:
The Interactive Form Generator
Choose "one" of the following:
C - Create a new form
L - Load an external form
E - Edit the current form
M - Modify the form's attributes
S - Save the current form
Q - Quit
Selection: ____
Each of these menu choices can be selected by entering a single
letter, as indicated on the Main Menu. Any other letters entered on
the Selection line are ignored. In this manner, all of the following
would invoke the save option: S, SAVE, silk, and so on. Only the
first letter is the triggering mechanism. Within this Selection
INTERACTIVE FORMS GENERATOR Page 3-2
THE MAIN MENU 17 March 1985
field, the user may used the user-defined Backspace key to delete
errors.
3.1.1 Create A New Form
This Main Menu selection allows the user to create a new form from
scratch. The user is requested to supply the attributes ( size,
position, and clear screen option ) of this new form before the Form
Editor is entered.
The prompt for the form attributes appears as follows:
Form size - Rows: ___ Columns: ___
Form position - Row: ___ Column: ___
Clear screen option: ___ (Yes, No)
Once the attributes have been received, then the Form Editor is
entered with a blank form being displayed. This create operation is a
destructive create, so a protective mechanism has been included to
provent the accidental destruction of the Current Form. If there
exists a Current Form that has been altered (loaded, created,
modified, edited, etc.) and this Current Form has not been saved prior
to this Create Form command was invoked, then a message is displayed
allowing the user to abort this create operation if needed.
3.1.2 Load In An External Form
This Main Menu selection allows the user to load in a form from an
external file. The user is prompted for the name of the external
file. The Form Editor is then entered with this form from the
external file being displayed. This form is then considered the
Current Form. It is assumed that the external file being loaded was
originally created using either the Save Form option of this Main
Menu. By manually creating these external form files, the form
representations may become corrupted. If there exists a Current Form
that has been altered (loaded, created, modified, edited, etc.) and
this Current Form has not been saved prior to this Load Form command
was invoked, then a message is displayed allowing the user to abort
this load operation, if needed.
3.1.3 Edit The Current Form
This Main Menu selection enters the Form Editor with the Current Form
being displayed. No new form is created or loaded. The primary
purpose of this command is to allow the user to edit a form, save the
form in a file, and then re-enter the Form Editor to make other
alterations to the same form. In this manner, if similar forms are
being constructed, then a common template does not have to be reloaded
over and over again.
3.1.4 Save The Current Form
This Main Menu selection allows the user to save the contents of the
Current Form in an external file. The user is prompted for the name
INTERACTIVE FORMS GENERATOR Page 3-3
Save The Current Form 17 March 1985
of this external file and then the form is loaded into this file. The
format of this external file is specific to this Interactive Forms
Generator system. Altering these external files, without using this
system, may corrupt the form files.
3.1.5 Modify The Current Form's Attributes
This Main Menu selection allows the user to alter the attributes of
the Current Form. The attributes that are modifiable are the form
size, the form screen position, and the form clear screen option. The
form size is the size relative to the form position. The form
position is the upper left-hand screen coordinate of the form. The
clear screen option specifies whether the screen is to be cleared when
the form is presented on the user's screen by the Form Executor. The
form attributes modification is performed using the Form Executor to
service the following form:
Form size - Rows: ___ Columns: ___
Form position - Row: ___ Column: ___
Clear screen option: ___ (Yes, No)
3.2 EXIT THE INTERACTIVE FORM GENERATOR
This Main Menu selection, entitled QUIT, allows the user to legally
exit from the Interactive Form Generator. If there exists a Current
Form that has been altered (loaded, created, modified, edited, etc.)
and this Current Form has not been saved prior to this Quit, though,
then a message is displayed allowing the user to abort this quit
operation.
3.3 THE FORM EDITOR
The Form Editor is a full screen editor that provides all of the
needed functionality for creating and modifying forms. This Editor
allows the user to create and modify fields within a form or simply
add and delete text characters. There is a distinction within a form
between the characters within a field and simple text characters. The
contents of fields can only be created and altered using the Create
Field and Modify Field commands. Normal text entry with the Form
Editor outputs text characters in overstrike mode.
The Form Editor allows two methods for invoking the individual
commands. First, all of the editor commands can be invoked using
single keystroke commands. The physical keyboard keys for each of the
Form Editor commands is entirely user defined. The user can customize
the single keystroke Editor commands by customizing the TCF (Terminal
Capabilities File) which is utilized by the Virtual Terminal. Because
of this keystroke customizing, the single keystrokes necessary for
invoking the Editor commands cannot be determined at this point and
will not be discussed further.
The second method of invoking the Form Editor commands is by using the
Command Line. This Command Line provides command completion which is
INTERACTIVE FORMS GENERATOR Page 3-4
THE FORM EDITOR 17 March 1985
triggered by a blank or the RETURN KEY. All of the editor commands
can also be initiated via this Command Line except for the invoking of
the Command Line itself (which is logical, since it is already there
anyway). Each of the Form Editor commands and their Command Line
abbreviations are discussed below. The Command Line abbreviation here
refers to the minimum character strings necessary for command
completion to be utilized. Along with each of the Editor command
descriptions below the Command Line abbreviations are indicated as the
command name with capital letters indicating the abbreviations. For
example, for the Create Field command below, the Command Line
abbreviation is CReate field. This means that to invoke this create
command the user could simply type CR followed by the RETURN KEY and
the Create Field command would be invoked.
The fields that are displayed by the Form Editor are presented on the
terminal display in a coded format. This coded format displays fields
using code character to represent the character limitations of the
field, and a number of these code character to represent the field
length.
The character limitations code characters are as follows:
a - Alphabetic
n - Numeric
b - Alphanumeric
x - Not Limited
For example, a field with character limitations of both alphabetic and
numeric with a length of 10 would be represented as:
bbbbbbbbbb
The rendition and the position of the field would also be reflected in
the coded display of the fields by the Form Editor. This type of
coding scheme is to give the form designer some indication of the
fields length and its character limitations which would not be readily
visible when the form is presented as with using the Form Executor.
3.3.1 The Command Line
The Command Line is a Form Editor prompt which allows the user to type
in the name of an Editor command. The entering of a command via the
Command Line is entered using command completion which takes effect
upon encountering the space character or the RETURN KEY. Any number
of characters of a given command can be entered followed by a space
character and the command completion will fill in the command as far
as possible. The only prerequisite is that the user must have at
least typed in the Command Line abbreviation for the given command.
Otherwise, the command completion algorithm encounters an ambiguity in
attempting to complete the command. After issuing the "Invoke Command
Line" keystroke, the Command Line appears in the lower left-hand
corner of the user's terminal display. The cursor is positioned at
this Command Line even though the original cursor position is still
remembered.
INTERACTIVE FORMS GENERATOR Page 3-5
Create A New Field 17 March 1985
3.3.2 Create A New Field
Command Line abbreviation: CReate field
This command allows the user to create a new field. The beginning of
this new field is positioned where the cursor position was when this
command was invoked. Before the new field is displayed and entered
into the form's field list, the user is prompted to fill in the
attributes of this new field. The attributes of the new field include
the field's name, form position, length, rendition, character
limitations, initial value, value, and its display mode.
These field attributes are requested by using a form and the Form
Executor, so normal Form Executor field editing can be performed
within this request for the new field's attributes. The field
attribute retrieval form appears as follows:
Field name: ________________________________
Field length: ___
Character limits: ___ (1-Alphabetic, 2-Numeric,
3-Alphanumeric, 4-Not Limited)
Display rendition: ___ (1-Normal, 2-Secondary,
3-Reverse, 4-Underline)
Field mode: ___ (1-Input/Output, 2-Output Only)
Initial value: ________________________________________
After successfully retrieving the new field's attributes, the new
field is displayed in the coded format previously described.
3.3.3 Modify An Existing Field
Command Line abbreviation: MODify field
This command allows the user to modify most of the attributes
associated with an existing field. Only the field's length,
rendition, character limitations, initial value, and mode are
modifiable through this command. The field's name, position, and
value are not modifiable through this command. The field's original
attribute values are presented to the user using the Form Executor to
present a field attribute modifying form. Therefore, the values of
the field's attributes can be altered using the field editing
available through the Form Executor. The field attribute retrieval
form appears as follows:
Field name: ________________________________
Field length: ___
Character limits: ___ (1-Alphabetic, 2-Numeric,
3-Alphanumeric, 4-Not Limited)
Display rendition: ___ (1-Normal, 2-Secondary,
3-Reverse, 4-Underline)
Field mode: ___ (1-Input/Output, 2-Output Only)
Initial value: ________________________________________
After the field's altered attributes have been received, then the Form
INTERACTIVE FORMS GENERATOR Page 3-6
Modify An Existing Field 17 March 1985
Executor is re-entered with the field altered according to the new
retrieved attributes.
3.3.4 Move A Field
Command Line abbreviation: MOVe Field
This command allows to user to move a field within a form. When this
command is invoked, the cursor must be positioned within the
boundaries of the field to be moved. The user is then requested to
position the cursor at the point where the beginning of this moved
field is to be positioned. This cursor movement within this move
command is to be performed only using the arrow keys (or whatever keys
the user has bound to the cursor movements). The RETURN KEY is used
to activate the field movement. Upon encountering this field move
activation, the field at the original position is erased and is
redisplayed at the new indicated position.
3.3.5 Copy A Field
Command Line abbreviation: COpy Field
This command allows the user to copy a field to a different location
within a form. When this command is invoked, the cursor must be
positioned within the boundaries of the field to be copied. The user
is then requested to position the cursor at the point where the
beginning of this copied field is to be positioned. This cursor
movement within this copy command is to be performed only using the
arrow keys (or whatever keys the user has bound to the cursor
movements). The RETURN KEY is used to activate the field copy. Upon
encountering this field copy activation, the user is then prompted for
the new field's name. Upon supplying this field name, the new field
is then displayed on the form.
3.3.6 Delete A Field
Command Line abbreviation: Delete Field
This command allows the user to delete a field from a form. When this
command is invoked, the cursor must be positioned within the
boundaries of the field to be deleted. The field is then erased from
the form.
3.3.7 Insert A Line
Command Line abbreviation: Insert Line
This command inserts a blank line into a form. The blank line is
inserted above the line on which the cursor was positioned when this
insert command was invoked. All lines below this inserted blank line
are shifted down one line position. The last line of the form is
lost. Since this is a destructive operation to the last line of the
form, a protective mechanism is provided. Since the creation of a
field is the more difficult of the operations provided by the Form
INTERACTIVE FORMS GENERATOR Page 3-7
Insert A Line 17 March 1985
Editor, if any fields exist on the last line of the form, then this
insert command will have no effect. The fields must be deleted first.
3.3.8 Move A Line
Command Line abbreviation: MOVe Line
This command allows the user to move an entire line of a form to a
different form location. The line that the cursor is positioned on
when this command is invoked is the form line that is going to be
moved. The user is then requested to position the cursor on the form
line at which the moved line is to be inserted above. As with the
cursor positioning within Move Field, the RETURN KEY is used to
activate this move line command.
3.3.9 Copy A Line
Command Line abbreviation: COpy Line
This command allows the user to copy an entire line of a form to a
different form location. The line that the cursor is positioned on
when this command is invoked is the form line that is going to be
copied. The user is then requested to position the cursor on the form
line at which the copied line is to be inserted above. As with the
cursor positioning within Move Field, the RETURN KEY is used to
activate this copy line command. After the activation of this copy
command, new names are requested for each of the fields on the copied
line. As the new field's name is being requested, the field is
highlighted to indicate which field is being addressed. Since this
copy line command does not delete the original form line, as in Move
Line, then the last line of the form is checked for the presence of
fields. If they exist, then the Copy Line command does nothing. If
they do not exist, then the last line is scrolled off the end of the
form and lost.
3.3.10 Delete A Line
Command Line abbreviation: Delete Line
This command allows the user to delete an entire line from a form.
The line that the cursor is positioned on when this command is invoked
is the form line that is going to be deleted. If any fields exist on
this line, then the line is not deleted (as a precautionary measure).
Otherwise, the line is deleted and the lines below the deleted line
are moved up one line position.
3.3.11 Insert A Character
Command Line abbreviation: Insert CHaracter
This command allows the user to insert a blank character into a form
line. All of the characters under the cursor and to its right and
fields to the right of the cursor are shifted right one character
position, thereby creating the blank character. The cursor remains
INTERACTIVE FORMS GENERATOR Page 3-8
Insert A Character 17 March 1985
positioned on this new blank character. This insert character command
is only allowed to be used within text characters; not within fields.
The insert character command, though, does shift entire fields to the
right one position.
3.3.12 Delete A Character
Command Line abbreviation: Delete CHaracter
This command allows the user to delete a text character from a form
line. All of the characters and fields to the right of the cursor are
shifted one position to the left. The cursor must be positioned on
top of a text character for this Delete Character command to have any
effect.
3.3.13 Rubout A Character
Command Line abbreviation: Rubout character
This command allows the user to rubout a text character from a form
line. Rubbing out a character simply means replacing the text
character with a blank character. The character that is rubbed out is
the character immediately to the left of the cursor when this command
was invoked. The cursor is placed on top of this rubbed out
character. Field characters cannot be rubbed out.
3.3.14 Help
This command displays a help menu to the user which enumerates all of
the Form Editor commands and their respective Command Line
abbreviations. By striking any key, the Form Editor is re-entered in
the same place it was before the help screen was displayed.
3.4 ERROR MESSAGES
____ ____
Main Menu
"Invalid Menu choice -- try again" - occurs when a Main menu choice is
attempted that does not name one of the possible commands.
"Screen size too small to display Main Menu" - occurs when the
physical screen size is too small to even display the Main Menu.
______ ____
Create Form
"Form size too large to fit on display" - occurs when attributes
retrieved from the user describe a form too large to fit on the
physical display.
"Storage error - form was not created" - occurs when the dynamic
allocation of the form resulted in memory becoming full.
INTERACTIVE FORMS GENERATOR Page 3-9
ERROR MESSAGES 17 March 1985
"Error in retrieving form information" - occurs when the form
attribute values retrieved from the user are not legal values for the
attribute values. A constraint error occurred.
____ ____
Load Form
"File not found with the given name" - occurs when the file name
supplied by the user was not a path to an existing file.
"File being used by another user" - occurs when the file is currently
opened by another user.
____ ____
Edit Form
"There is no Current Form" - occurs when the Current Form pointer is
null. This implies that Current Form has not been initialized using
either Create Form or Load Form.
______ ____ __________
Modify Form Attributes
"Specified form size is too large for display" - occurs when the
attributes retrieved from the user describe a form that is too large
to fit on the physical terminal display.
"There is no Current Form" - occurs when the Current Form pointer is
null. This implies that Current Form has not been initialized using
either Create Form or Load Form.
____ ____
Save Form
"There is no Current Form" - occurs when the Current Form pointer is
null. This implies that Current Form has not been initialized using
either Create Form or Load Form.
"File currently being used by another user" - occurs when the file is
currently opened by another user.
____ ______
Form Editor
"Illegal function key" - occurs when the keystroke received from the
user was neither a character nor one of the function keys utilized by
the Interactive Forms Generator.
"Cannot enter text within field" - occurs when an attempt was made to
enter text character, in overstrike mode, within the bounds of a
field.
"Could not add field -- Memory full" - occurs when the dynamic
allocation of the form resulted in memory becoming full.
INTERACTIVE FORMS GENERATOR Page 3-10
ERROR MESSAGES 17 March 1985
_______ ____
Command Line
"Ambiguous - CHaracter, COpy, CReate" - occurs when the command
completion has not recognized enough characters to complete the
command.
"Ambiguous - MODify, MOVe" - occurs when the command completion has
not recognized enough characters to complete the command.
"Command completion failed for current command string" - occurs when
the recognized characters of the command are not part of any of the
legal command prefixs used in the command completion.
"Maximum command length reached" - occurs when the maximum command
line length is encountered. No more characters can be input into the
Command Line.
"Invalid command" - occurs when an attempt was made to execute an
illegal command name via the Command Line.
______ _____
Create Field
______ _____
Modify Field
"Field name already exists -- choose another" - occurs when the field
name supplied by the user already existed for one of the other fields
within the Current Form.
"Cursor not positioned in a field" - occurs when the cursor was not
positioned within the bounds of a field when the Modify Field command
was invoked.
"Field extends past form" - occurs when, given the field's current
field attributes, the field would extend past the end of the form
boundary, if displayed.
"Memory full" - occurs when the dynamic allocation of the field
resulted in memory becoming full.
"New field overlaps existing fields" - occurs when, given the field's
current field attributes, the field would overlap other existing
fields, if displayed.
____ _____
Move Field
____ _____
Copy Field
"Field name already exists -- choose another" - occurs when the field
name supplied by the user already existed for one of the other fields
within the Current Form.
"Cursor not positioned in a field" - occurs when the cursor was not
positioned within the bounds of a field when this command was invoked.
INTERACTIVE FORMS GENERATOR Page 3-11
ERROR MESSAGES 17 March 1985
"New field extends past form boundary" - occurs when, given the
field's current field attributes, the field would extend past the end
of the form boundary, if displayed.
"New field overlaps existing fields" - occurs when, given the field's
current field attributes, the field would overlap other existing
fields, if displayed.
______ _____
Delete Field
"Cursor not positioned in a field." - occurs when the cursor was not
positioned within the bounds of a field when this command was invoked.
______ ____
Insert Line
"Must clear field from last line" - occurs when the last line of the
form contains fields that would be lost if this line insert were
performed.
____ ____
Move Line
____ ____
Copy Line
"Must clear field from last line" - occurs when the last line of the
form contains fields that would be lost if the Copy Line were
performed.
"Field name already exists -- choose another" - occurs when the field
name supplied by the user already existed for one of the other fields
within the Current Form.
"Cannot copy -- fields on last line" - occurs when the last line of
the form contains fields that would be lost if the Copy Line were
performed.
______ ____
Delete Line
"Cannot delete -- fields found on line" - occurs when the last line of
the form contains fields that would be lost if this command were
performed.
______ _________
Insert Character
"No room in line to insert character" - occurs when there is a field
positioned against the right-hand side of the form. If this insert
were performed, then the field would extend past the boundary of the
form. Therefore, the insert is not performed.
"Cannot insert characters in a field" - occurs when the cursor was
positioned within the boundaries of a field when this command was
INTERACTIVE FORMS GENERATOR Page 3-12
ERROR MESSAGES 17 March 1985
invoked.
______ _________
Delete Character
"Cannot delete a field character" - occurs when the cursor was
positioned within the boundaries of a field when this command was
invoked.
______ _________
Rubout Character
"Cannot rubout a field character" - occurs when the cursor was
positioned within the boundaries of a field when this command was
invoked.
CHAPTER 4
FORM EXECUTOR INTERFACE
The Form Executor provides the interface between an application
program and a form created by the Form Generator System. Functions
are provided to access or load a form for use, clear the form values
for reuse, modify a value of a field before being displayed, display
and allow modification of input fields interactively by a user, get
the current value of a field, and release a form which will not be
used again.
4.1 ACCESS A NEW FORM
4.1.1 Abstract
Searches the data base for a form file, loads the form, and returns a
pointer to the form internal data structure.
function ACCESS_FORM(PATHNAME: in STRING)
return FORM_PTR;
4.1.2 Parameters
The following parameter is required:
* PATHNAME -- defines the name of the data base file which contains
the form definition.
4.1.3 Exceptions Raised
The following exception may be raised:
* FORM_ACCESS_ERROR -- if the form definition cannot be loaded.
4.2 GET VALUE OF A FIELD
4.2.1 Abstract
Returns the current value of a field of a form.
function QUERY_FIELD(FORM: in FORM_PTR;
FORM EXECUTOR INTERFACE Page 4-2
Abstract 17 March 1985
FIELD: in STRING)
return STRING;
4.2.2 Parameters
The following parameters are required:
* FIELD -- name of the field for which the value is desired.
* FORM -- pointer to the form internal data structure.
4.2.3 Exceptions Raised
The following exceptions may be raised:
* INVALID_FIELD -- if the field name is not found in the form.
* INVALID_FORM -- if the form does not point to a valid data
structure.
4.3 CLEAR FORM VALUES
4.3.1 Abstract
Reinitializes the values of the fields of the form to their initial
values.
procedure CLEAR_FORM(FORM: in FORM_PTR);
4.3.2 Parameters
The following parameter is required:
* FORM -- pointer to the form internal data structure.
4.3.3 Exceptions Raised
The following exception may be raised:
* INVALID_FORM -- if the form does not point to a valid data
structure.
4.4 MODIFY FORM FIELD VALUE
4.4.1 Abstract
Changes the current value of a field so that the next time the form is
display the new field value will be displayed also.
procedure MODIFY_FIELD(FORM: in FORM_PTR;
FORM EXECUTOR INTERFACE Page 4-3
Abstract 17 March 1985
FIELD: in STRING;
VALUE: in STRING);
4.4.2 Parameters
The following parameters are required:
* FIELD -- name of the field for which the value is to be changed.
* FORM -- pointer to the form internal data structure.
* VALUE -- new value of the field.
4.4.3 Exceptions Raised
The following exceptions may be raised:
* INVALID_FIELD -- if the field name is not found in the form.
* INVALID_FORM -- if the form does not point to a valid data
structure.
4.5 DISPLAY FORM AND ACCEPT INPUT
4.5.1 Abstract
Displays the form with the current values of the output fields and
accepts input for the fields which can be changed. The following
functions are supported for moving between fields, editing contents of
the fields, and accepting the modified form.
* Accept Form - accept the contents of the modified form. (Carriage
Return - Ctrl M - VT function 4)
* Clear End-of-Field - erase the contents of the field from the
cursor to the end of the field. (Delete End-of-Line - Ctrl E - VT
function 11)
* Delete Character - delete the character under the cursor and shift
all the characters to the right of the cursor left one position.
(Delete Character - Ctrl D - VT function 6)
* Delete Previous Character - delete the character to the left of
the cursor and shift all the characters to the right of the cursor
left one position. (Rubout - Del - VT function 8)
* Insert Character - insert a blank character at the cursor position
and shift all the characters to the right of the cursor right one
position. (Insert Character - Ctrl V - VT function 7)
FORM EXECUTOR INTERFACE Page 4-4
Abstract 17 March 1985
* Next Character - move the cursor to the next character position
within the field. If the cursor is at the end of the field, the
cursor is not moved. (Right - Ctrl L - VT function right arrow)
* Next Field - move the cursor to the next input field of the form.
If the cursor is on the last field, then it will be positioned at
the first field of the form. (Tab - Ctrl I - VT function 5) or
(Down - Ctrl J - VT function down arrow)
* Previous Character - move the cursor to the previous character
position within the field. If the cursor is at the beginning of
the field, the cursor is not moved. (Left - Ctrl H - VT function
left arrow)
* Previous Field - move the cursor to the previous input field of
the form. If the cursor is on the first field, then it will be
positioned at the last field of the form. (Up - Ctrl K - VT
function up arrow) or (Back Tab - Ctrl O - VT function 1)
procedure PRESENT_FORM(FORM: in FORM_PTR;
BELL: in BOOLEAN;
FIELD: in STRING);
4.5.2 Parameters
The following parameters are required:
* BELL -- flag indicating whether the bell on the terminal should be
sounded.
* FIELD -- name of the field to position the cursor initially.
* FORM -- pointer to the form internal data structure.
4.5.3 Exceptions Raised
The following exceptions may be raised:
* INVALID_FIELD -- if the field name is not found in the form.
* INVALID_FORM -- if the form does not point to a valid data
structure.
4.6 RELEASE FORM
4.6.1 Abstract
Release the form data structures if they are not to be used anymore.
procedure RELEASE_FORM(FORM: in FORM_PTR);
FORM EXECUTOR INTERFACE Page 4-5
Parameters 17 March 1985
4.6.2 Parameters
The following parameter is required:
* FORM -- pointer to the form internal data structure.
4.6.3 Exceptions
The following exception may be raised:
* INVALID_FORM -- if the form does not point to a valid data
structure.
4.7 EXCEPTIONS
Three exceptions are defined.
FORM_ACCESS_ERROR is raised when a new form cannot be loaded either
because the form pathname is incorrect or in use, or because not
enough memory is available to load the form.
INVALID_FORM is raised whenever one of the routines is invoked with an
invalid form pointer.
INVALID_FIELD is raised whenver one of the routines is invoked with an
invalid field name.
APPENDIX A
TERMINAL INTERFACE AND KEY MAPPING
The Form Generator System uses the Virtual Terminal (VT) to interface
to the terminal. The Virtual Terminal in turn uses a Terminal
Capabilities File (TCF) which is like the UNIX Termcap to describe the
interface to the terminal. This TCF gives the escape sequences
necessary to control the display and the mapping of key sequences to
VT functions. For more information about the TCF look at the VT
documentation.
The Form Generator System requires an entry in the TCF (file named
"TCF") which has the name "fgs". This entry must describe how to
control the display of the terminal plus define key sequences for Form
Generator internal commands. The following table shows the mapping of
FGS functions to VT function keys.
TERMINAL INTERFACE AND KEY MAPPING Page A-2
17 March 1985
FGS VT Key Label
Function Function Tag Tag
Down Arrow Down kd
Left Arrow Left kl
Right Arrow Right kr
Up Arrow Up ku
Back Tab F1 k1 l1
Command Line F2 k2 l2
Help F3 k3 l3
Return/Accept F4 k4 l4
Tab F5 k5 l5
Delete Char F6 k6 l6
Insert Char F7 k7 l7
Rubout F8 k8 l8
Exit Form F9 k9 l9
Copy Line F10 x0 y0
Delete Eoln F11 x1 y1
Delete Line F12 x2 y2
Insert Line F13 x3 y3
Move Line F14 x4 y4
Copy Field F15 x5 y5
Create Field F16 x6 y6
Delete Field F17 x7 y7
Modify Field F18 x8 y8
Move Field F19 x9 y9
The Form Generator System will operate with a TCF which does not
define key mapping because some of the basic functions are mapped to
control keys. These control keys may be used even though key mapping
have been defined. The following table gives the mapping of FGS
functions to control keys.
TERMINAL INTERFACE AND KEY MAPPING Page A-3
17 March 1985
FGS Control
Function Key
Down Arrow ^J - Line Feed
Left Arrow ^H - Back Space
Right Arrow ^L
Up Arrow ^K
Back Tab ^O
Command Line ^C
Return/Accept ^M - Return
Tab ^I - Tab
Delete Char ^D
Insert Char ^V
Rubout DEL
Exit Form ^X
Delete Eoln ^E
Delete Line ^W
Insert Line ^B
A sample TCF has been supplied with the Form Generator System which
supports the VT100 terminal and uses the Keypad to invoke the FGS
functions. The arrow keys are mapped to the cursor movement
functions.
+-------+-------+-------+-------+
| PF1 | PF2 | PF3 | PF4 |
| | | Exit | Delete|
|Command| Help | Form | Line |
+-------+-------+-------+-------+
| 7 | 8 | 9 | - |
| Create| Modify| Delete| Delete|
| Field | Field | Field | Eoln |
+-------+-------+-------+-------+
| 4 | 5 | 6 | , |
| Copy | Move | | Delete|
| Field | Field | | Char |
+-------+-------+-------+-------+
| 1 | 2 | 3 | |
| Copy | Move | | Enter |
| Line | Line | | |
+-------+-------+-------+ Accept|
| 0 | . | Form |
| Insert | Insert| |
| Line | Char | |
+---------------+-------+-------+
APPENDIX B
MAINTENANCE INFORMATION
B.1 AUTOMATED FORM GENERATION
An automated means of generating forms was suggested by Col. Whitaker
at our Critical Design Review. One way of accomplishing this would be
to write a Ada declaration processor which would take record type
declarations and build the forms which correspond to them. For
instance the types of the individual fields could be used to specify
valid values for the fields. This effort would require a new
front-end processor to take Ada source and prepare form definitions.
B.2 HUMAN READABLE FILE GENERATOR
If a form definition is created using the Batch Generator and then
modified using the Interactive Generator, there is no way to rebuild
the input to the Batch Generator from the modified form definition.
This would require a utility which would take a form definition and
produce the Form Definition Language file.
B.3 KEY MAPPING INTERFACE
Currently the mapping from terminal keys to internal Form Generator
functions is handled via the Terminal Capabilities File (TCF) of the
Virtual Terminal (VT). A special entry named "fgs" is used to map key
sequences to VT functions and in turn Form Generator functions. A
user interface could be developed to assist in the building of the
TCF. This utility could prompt for the key sequence to enable each
internal function. This would then be used to build the entries in
the TCF.
B.4 MORE DISPLAY RENDITIONS
Currently the Virtual Terminal (VT) only supports Normal and Reverse
display renditions. Logically it could support more as long as the
terminal interface supported them. Some terminals support
highlighted, underline, and blinking fields as well as colors. An
invisible rendition was suggested by Col. Whitaker for entering
things like passwords.
MAINTENANCE INFORMATION Page B-2
MORE FIELD TYPES 17 March 1985
B.5 MORE FIELD TYPES
Currently the Form Generator supports Alphabetic, Alphanumeric,
Numeric, and Not Limited input character types. The numeric field
types could be enhanced to differentiate between integer, floating
point, and fixed point. General arithmetic expression handling could
be added. Numeric fields could be restricted to a range of values.
Any field could be given a list of valid values which could be
entered.
B.6 REMOVE DEPENDENCY ON VIRTUAL TERMINAL
One could remove the dependency on the Virtual Terminal package if
desired, by simply changing the Terminal_Interface package. All
interfaces to the display terminal and keyboard are isolated to this
package. The Virtual Terminal is set up to support many types of
terminals using a Terminal Capability File, but it does require some
extra overhead.
B.7 DEFAULT CONTROL KEY MAPPING
Many of the functions used by the Interactive Generator and Form
Executor are bound to control keys. This mapping is controlled by
code in the Terminal_Interface package. The routine Return_Char in
Get_Character handles the mapping of control characters to interal
functions.
B.8 ADDITIONAL INPUT FUNCTIONS
Currently field editing is restricted to character movement, deletion,
insertion, and replacement. Movement to the beginning or end of
field, movement by words, and possibly word deletion could be added.
The field editing is handled by Edit_Field in the Terminal_Interface
package.
Currently form editing is restricted to field movement and accept
form. An abort form input could be added as well as movement to the
first or last field of a form. Then if multiple fields occur on a
line, it would be nice to add movement to a field on the next line
without going through each of the fields on the current line. These
functions would be handled by Edit_Form in Present_Form in the
Form_Executor package.
B.9 TERMINAL SIZE
Currently only 24 row by 80 column terminals are supports by the Form
Generator system. To support terminals larger than this will require
changes to the Terminal_Interface and some constants in other
packages.
--::::::::::
--form2.tst
--::::::::::
::::::::::
fgs_tst.dis
::::::::::
--
-- Test files for Form Generator System
--
-- Batch Generator tests
-- Test - input file
-- List - listing file
-- Form - form output file
BATCH_01.TST
BATCH_01.LST
BATCH_01.FRM
BATCH_02.TST
BATCH_02.LST
BATCH_03.TST
BATCH_03.LST
BATCH_04.TST
BATCH_04.LST
BATCH_05.TST
BATCH_05.LST
-- Form Executor tests
-- Test form
EXECUTOR.TST
EXECUTOR.LST
EXECUTOR.FRM
-- Test program & directions
EXEC_TEST.ADA
EXEC_TEST.TST
-- Secondary test & form
DISPLAY_FORM.ADA
DISPLAY_FORM.FRM
-- Interactive Generator test form
INTERACT.FRM
-- Terminal Capabilities File for VT100 terminal
TCF
::::::::::
BATCH_01.TST
::::::::::
--
-- Form Definition Language Example
-- Identification: BATCH_01
-- Correct form definition - no errors.
--
--
-- Form Defined
--
Form( Size => (18, 40), Position => (3, 20) );
--
-- Title on Form
--
Text( Value => "Employee Identification Record",
Position => (1, 6) );
--
-- Input Employee Name
--
Text( Value => "Name:", Position => (4, 13) );
Field( Name => "Name", Position => (4, 20), Length => 20,
Limitation => Alphabetic );
--
-- Input Employee Number
--
Text( Value => "Employee Number:", Position => (6, 2) );
Field( Name => "Employee Number", Position => (6, 20),
Length => 8, Limitation => Numeric );
--
-- Input Division
--
Text( Value => "Division:", Position => (8, 9) );
Field( Name => "Division", Position => (8, 20),
Length => 2, Limitation => Numeric );
--
-- Cost Center
--
Text( Value => "Cost Center:", Position => (10, 6) );
Field( Name => "Cost Center", Position => (10, 20),
Length => 4, Limitation => Numeric );
--
-- Location
--
Text( Value => "Location:", Position => (12, 9) );
Field( Name => "Location", Position => (12, 20),
Length => 20, Limitation => Alphabetic );
--
-- Mail Station
--
Text( Value => "Mail Station:", Position => (14, 5) );
Field( Name => "Mail Station", Position => (14, 20),
Length => 4, Limitation => Numeric );
--
-- Phone Number
--
Text( Value => "Phone Number:", Position => (16, 5) );
Field( Name => "Phone Number", Position => (16, 20),
Length => 15, Limitation => Not_Limited );
--
-- Message ID
--
Text( Value => "Message Id.:", Position => (18, 6) );
Field( Name => "Message Id.", Position => (18, 20),
Length => 4, Limitation => Alphanumeric );
::::::::::
BATCH_01.LST
::::::::::
Batch Forms Generator running on 3/17/1985
Input File: batch_01.test
Output File: batch_01.form
1 --
2 -- Form Definition Language Example
3 -- Identification: BATCH_01
4 -- Correct form definition - no errors.
5 --
6
7
8 --
9 -- Form Defined
10 --
11 Form( Size => (18, 40), Position => (3, 20) );
12
13 --
14 -- Title on Form
15 --
16 Text( Value => "Employee Identification Record",
17 Position => (1, 6) );
18
19 --
20 -- Input Employee Name
21 --
22 Text( Value => "Name:", Position => (4, 13) );
23
24 Field( Name => "Name", Position => (4, 20), Length => 20,
25 Limitation => Alphabetic );
26
27 --
28 -- Input Employee Number
29 --
30 Text( Value => "Employee Number:", Position => (6, 2) );
31
32 Field( Name => "Employee Number", Position => (6, 20),
33 Length => 8, Limitation => Numeric );
34
35 --
36 -- Input Division
37 --
38 Text( Value => "Division:", Position => (8, 9) );
39
40 Field( Name => "Division", Position => (8, 20),
41 Length => 2, Limitation => Numeric );
42
43 --
44 -- Cost Center
45 --
46 Text( Value => "Cost Center:", Position => (10, 6) );
47
48 Field( Name => "Cost Center", Position => (10, 20),
49 Length => 4, Limitation => Numeric );
50
51 --
52 -- Location
53 --
54 Text( Value => "Location:", Position => (12, 9) );
55
56 Field( Name => "Location", Position => (12, 20),
57 Length => 20, Limitation => Alphabetic );
58
59 --
60 -- Mail Station
61 --
62 Text( Value => "Mail Station:", Position => (14, 5) );
63
64 Field( Name => "Mail Station", Position => (14, 20),
65 Length => 4, Limitation => Numeric );
66
67 --
68 -- Phone Number
69 --
70 Text( Value => "Phone Number:", Position => (16, 5) );
71
72 Field( Name => "Phone Number", Position => (16, 20),
73 Length => 15, Limitation => Not_Limited );
74
75 --
76 -- Message ID
77 --
78 Text( Value => "Message Id.:", Position => (18, 6) );
79
80 Field( Name => "Message Id.", Position => (18, 20),
81 Length => 4, Limitation => Alphanumeric );
<<<<< 0 Error(s) Detected >>>>>
<<<<< Form Saved >>>>>
::::::::::
BATCH_01.FRM
::::::::::
18 40 3 20 CLEAR
1 6 30 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Employee Identification Record
4 13 5 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Name:
Name
4 20 20 ALPHA INPUT_OUTPUT PRIMARY_RENDITION
6 2 16 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Employee Number:
Employee Number
6 20 8 NUMERIC INPUT_OUTPUT PRIMARY_RENDITION
8 9 9 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Division:
Division
8 20 2 NUMERIC INPUT_OUTPUT PRIMARY_RENDITION
10 6 12 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Cost Center:
Cost Center
10 20 4 NUMERIC INPUT_OUTPUT PRIMARY_RENDITION
12 9 9 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Location:
Location
12 20 20 ALPHA INPUT_OUTPUT PRIMARY_RENDITION
14 5 13 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Mail Station:
Mail Station
14 20 4 NUMERIC INPUT_OUTPUT PRIMARY_RENDITION
16 5 13 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Phone Number:
Phone Number
16 20 15 NOT_LIMITED INPUT_OUTPUT PRIMARY_RENDITION
18 6 12 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Message Id.:
Message Id.
18 20 4 ALPHA_NUMERIC INPUT_OUTPUT PRIMARY_RENDITION
::::::::::
BATCH_02.TST
::::::::::
--
-- Form Definition Language Example
-- Identification: BATCH_02
-- Invalid parameter values and keywords (9 errors).
--
--
-- Form Defined
--
Form( Size => (18, 40), Position => (3, 20) );
--
-- Title on Form
--
Text( Value => "Employee Identification Record
Position => (1, 6) );
--
-- Input Employee Name
--
Text( Value => "Name:", Position => (4, 12) );
Field( Name => "Name", Potion => (4, 20), Length => 20,
Limitation => Alphabetic );
--
-- Input Employee Number
--
Text( Value => "Employee Number:", Position => (A, 2) );
Field( Name => "Employee Number", Position => (6; 20),
Length => 8, Limitation => Numeric );
--
-- Input Division
--
Text( Value => "Division:", Position => (8, -9) );
Field( Name => "Division", Position => (8, 20),
Length => 2, Limitation => Numeric );
--
-- Cost Center
--
Text( Value => "Cost Center:", Position => (10, 6)
Field( Name => "Cost Center", Position => (10, 20),
Length => 4, Limitation => Numeric );
--
-- Location
--
Text( Value => "Location:", Position => (12, 9) );
Field( Name => "Location", Position => (12, 20),
Length => a, Limitation => Alphabetic );
--
-- Mail Station
--
Text( Value => "Mail Station:", Position => (14, 5) );
Field( Name => "Mail Station", Position => (14, 20),
Length => 4, Limitation => Numeric );
--
-- Phone Number
--
Text( Value => "Phone Number:", Position => (16, 5) );
Field( Name => "Phone Number", Position => 20,
Length => 15, Limitation => Not_Limited );
--
-- Message ID
--
Text( Value => "Message Id.:", Position => (6) );
Field( Name => "Message Id.", Position => (18, 20),
Length => 20, Limitation => Alphanumeric );
::::::::::
BATCH_02.LST
::::::::::
Batch Forms Generator running on 3/17/1985
Input File: batch_02.test
Output File: batch_02.form
1 --
2 -- Form Definition Language Example
3 -- Identification: BATCH_02
4 -- Invalid parameter values and keywords (9 errors).
5 --
6
7
8 --
9 -- Form Defined
10 --
11 Form( Size => (18, 40), Position => (3, 20) );
12
13 --
14 -- Title on Form
15 --
16 Text( Value => "Employee Identification Record
17 Position => (1, 6) );
***** Invalid Format for String
Error is at or near Employee Identification Record
18
19 --
20 -- Input Employee Name
21 --
22 Text( Value => "Name:", Position => (4, 12) );
23
24 Field( Name => "Name", Potion => (4, 20), Length => 20,
***** Unrecognized Keyword Encountered
Error is at or near Potion
25 Limitation => Alphabetic );
26
27 --
28 -- Input Employee Number
29 --
30 Text( Value => "Employee Number:", Position => (A, 2) );
***** Expected Number
Error is at or near A
31
32 Field( Name => "Employee Number", Position => (6; 20),
***** Expected ','
Error is at or near ;
33 Length => 8, Limitation => Numeric );
34
35 --
36 -- Input Division
37 --
38 Text( Value => "Division:", Position => (8, -9) );
***** Unrecognized Token Encountered
Error is at or near ,
39
40 Field( Name => "Division", Position => (8, 20),
41 Length => 2, Limitation => Numeric );
42
43 --
44 -- Cost Center
45 --
46 Text( Value => "Cost Center:", Position => (10, 6)
47
48 Field( Name => "Cost Center", Position => (10, 20),
***** Expected ',' or ')'
Error is at or near Field
49 Length => 4, Limitation => Numeric );
50
51 --
52 -- Location
53 --
54 Text( Value => "Location:", Position => (12, 9) );
55
56 Field( Name => "Location", Position => (12, 20),
57 Length => a, Limitation => Alphabetic );
***** Expected Number
Error is at or near a
58
59 --
60 -- Mail Station
61 --
62 Text( Value => "Mail Station:", Position => (14, 5) );
63
64 Field( Name => "Mail Station", Position => (14, 20),
65 Length => 4, Limitation => Numeric );
66
67 --
68 -- Phone Number
69 --
70 Text( Value => "Phone Number:", Position => (16, 5) );
71
72 Field( Name => "Phone Number", Position => 20,
***** Expected '('
Error is at or near 20
73 Length => 15, Limitation => Not_Limited );
74
75 --
76 -- Message ID
77 --
78 Text( Value => "Message Id.:", Position => (6) );
***** Expected ','
Error is at or near )
79
80 Field( Name => "Message Id.", Position => (18, 20),
81 Length => 20, Limitation => Alphanumeric );
<<<<< 9 Error(s) Detected >>>>>
<<<<< Form NOT Saved >>>>>
::::::::::
BATCH_03.TST
::::::::::
--
-- Form Definition Language Example
-- Identification: BATCH_03
-- Invalid Form statement causing many warning messages (1 error).
--
--
-- Form Defined
--
Form( Size => (18, 40), Postion => (3, 20) );
--
-- Title on Form
--
Text( Value => "Employee Identification Record",
Position => (1, 6) );
--
-- Input Employee Name
--
Text( Value => "Name:", Position => (4, 12) );
Field( Name => "Name", Position => (4, 20), Length => 20,
Limitation => Alphabetic );
--
-- Input Employee Number
--
Text( Value => "Employee Number:", Position => (6, 2) );
Field( Name => "Employee Number", Position => (6, 20),
Length => 8, Limitation => Numeric );
--
-- Input Division
--
Text( Value => "Division:", Position => (8, 9) );
Field( Name => "Division", Position => (8, 20),
Length => 2, Limitation => Numeric );
--
-- Cost Center
--
Text( Value => "Cost Center:", Position => (10, 6) );
Field( Name => "Cost Center", Position => (10, 20),
Length => 4, Limitation => Numeric );
--
-- Location
--
Text( Value => "Location:", Position => (12, 9) );
Field( Name => "Location", Position => (12, 20),
Length => 20, Limitation => Alphabetic );
--
-- Mail Station
--
Text( Value => "Mail Station:", Position => (14, 5) );
Field( Name => "Mail Station", Position => (14, 20),
Length => 4, Limitation => Numeric );
--
-- Phone Number
--
Text( Value => "Phone Number:", Position => (16, 5) );
Field( Name => "Phone Number", Position => (16, 20),
Length => 15, Limitation => Not_Limited );
--
-- Message ID
--
Text( Value => "Message Id.:", Position => (18, 6) );
Field( Name => "Message Id.", Position => (18, 20),
Length => 20, Limitation => Alphanumeric );
::::::::::
BATCH_03.LST
::::::::::
Batch Forms Generator running on 3/17/1985
Input File: batch_03.test
Output File: batch_03.form
1 --
2 -- Form Definition Language Example
3 -- Identification: BATCH_03
4 -- Invalid Form statement causing many warning messages (1 error).
5 --
6
7
8 --
9 -- Form Defined
10 --
11 Form( Size => (18, 40), Postion => (3, 20) );
***** Unrecognized Keyword Encountered
Error is at or near Postion
12
13 --
14 -- Title on Form
15 --
16 Text( Value => "Employee Identification Record",
17 Position => (1, 6) );
<<<<< TEXT Statement Correct but FORM Not Open >>>>>
18
19 --
20 -- Input Employee Name
21 --
22 Text( Value => "Name:", Position => (4, 12) );
<<<<< TEXT Statement Correct but FORM Not Open >>>>>
23
24 Field( Name => "Name", Position => (4, 20), Length => 20,
25 Limitation => Alphabetic );
<<<<< FIELD Statement Correct but FORM Not Open >>>>>
26
27 --
28 -- Input Employee Number
29 --
30 Text( Value => "Employee Number:", Position => (6, 2) );
<<<<< TEXT Statement Correct but FORM Not Open >>>>>
31
32 Field( Name => "Employee Number", Position => (6, 20),
33 Length => 8, Limitation => Numeric );
<<<<< FIELD Statement Correct but FORM Not Open >>>>>
34
35 --
36 -- Input Division
37 --
38 Text( Value => "Division:", Position => (8, 9) );
<<<<< TEXT Statement Correct but FORM Not Open >>>>>
39
40 Field( Name => "Division", Position => (8, 20),
41 Length => 2, Limitation => Numeric );
<<<<< FIELD Statement Correct but FORM Not Open >>>>>
42
43 --
44 -- Cost Center
45 --
46 Text( Value => "Cost Center:", Position => (10, 6) );
<<<<< TEXT Statement Correct but FORM Not Open >>>>>
47
48 Field( Name => "Cost Center", Position => (10, 20),
49 Length => 4, Limitation => Numeric );
<<<<< FIELD Statement Correct but FORM Not Open >>>>>
50
51 --
52 -- Location
53 --
54 Text( Value => "Location:", Position => (12, 9) );
<<<<< TEXT Statement Correct but FORM Not Open >>>>>
55
56 Field( Name => "Location", Position => (12, 20),
57 Length => 20, Limitation => Alphabetic );
<<<<< FIELD Statement Correct but FORM Not Open >>>>>
58
59 --
60 -- Mail Station
61 --
62 Text( Value => "Mail Station:", Position => (14, 5) );
<<<<< TEXT Statement Correct but FORM Not Open >>>>>
63
64 Field( Name => "Mail Station", Position => (14, 20),
65 Length => 4, Limitation => Numeric );
<<<<< FIELD Statement Correct but FORM Not Open >>>>>
66
67 --
68 -- Phone Number
69 --
70 Text( Value => "Phone Number:", Position => (16, 5) );
<<<<< TEXT Statement Correct but FORM Not Open >>>>>
71
72 Field( Name => "Phone Number", Position => (16, 20),
73 Length => 15, Limitation => Not_Limited );
<<<<< FIELD Statement Correct but FORM Not Open >>>>>
74
75 --
76 -- Message ID
77 --
78 Text( Value => "Message Id.:", Position => (18, 6) );
<<<<< TEXT Statement Correct but FORM Not Open >>>>>
79
80 Field( Name => "Message Id.", Position => (18, 20),
81 Length => 20, Limitation => Alphanumeric );
<<<<< FIELD Statement Correct but FORM Not Open >>>>>
<<<<< 1 Error(s) Detected >>>>>
<<<<< Form NOT Saved >>>>>
::::::::::
BATCH_04.TST
::::::::::
--
-- Form Definition Language Example
-- Identification: BATCH_04
-- Missing parameters for Field and Text statements (11 errors).
--
--
-- Form Defined
--
Form( Size => (18, 40), Position => (3, 20) );
--
-- Title on Form
--
Text( Value => "Employee Identification Record",
Position => (1, 6) );
--
-- Input Employee Name
--
Text( Value => "Name:", Position => (4, 12) );
Field( Name => "Name", Position => (4, 20), Length => 20);
Field( Position => (2,2) );
Field( Length => 10);
Field (Name=>"Myname");
Field (Name=>"Myname 2",position=>(1,2));
Field (name=>"Myname 3",length=>2);
Field (position=>(1,5),length=>5);
Field ();
Text ();
--
-- Input Employee Number
--
Text( Value => "Employee Number:", Position => (6, 2) );
Field( Name => "Employee Number", Position => (6, 20),
Length => 8, Limitation => Numeric );
--
-- Input Division
--
Text( Value => "Division:", Position => (8, 9) );
Field( Name => "Division", Position => (8, 20),
Length => 2, Limitation => Numeric );
--
-- Cost Center
--
Text( Value => "Cost Center:", Position => (10, 6) );
Field( Name => "Cost Center", Position => (10, 20),
Length => 4, Limitation => Numeric );
--
-- Location
--
Text( Value => "Location:", Position => (12, 9) );
Field( Name => "Location", Position => (12, 20),
Length => 20, Limitation => Alphabetic );
--
-- Mail Station
--
Text( Value => "Mail Station:", Position => (14, 5) );
Field( Name => "Mail Station", Position => (14, 20),
Length => 4, Limitation => Numeric );
--
-- Phone Number
--
Text( Value => "Phone Number:", Position => (16, 5) );
Field( Name => "Phone Number", Position => (16, 20),
Length => 15, Limitation => Not_Limited );
--
-- Message ID
--
Text( Value => "Message Id.:", Position => (18, 6) );
Field( Name => "Message Id.", Position => (18, 20),
Length => 20, Limitation => Alphanumeric );
::::::::::
BATCH_04.LST
::::::::::
Batch Forms Generator running on 3/17/1985
Input File: batch_04.test
Output File: batch_04.form
1 --
2 -- Form Definition Language Example
3 -- Identification: BATCH_04
4 -- Missing parameters for Field and Text statements (11 errors).
5 --
6
7
8 --
9 -- Form Defined
10 --
11 Form( Size => (18, 40), Position => (3, 20) );
12
13 --
14 -- Title on Form
15 --
16 Text( Value => "Employee Identification Record",
17 Position => (1, 6) );
18
19 --
20 -- Input Employee Name
21 --
22 Text( Value => "Name:", Position => (4, 12) );
23
24 Field( Name => "Name", Position => (4, 20), Length => 20);
25 Field( Position => (2,2) );
***** NAME Parameter is Missing
Error is at or near )
***** LENGTH Parameter is Missing
Error is at or near )
26 Field( Length => 10);
***** NAME Parameter is Missing
Error is at or near )
***** POSITION Parameter is Missing
Error is at or near )
27 Field (Name=>"Myname");
***** POSITION Parameter is Missing
Error is at or near )
***** LENGTH Parameter is Missing
Error is at or near )
28 Field (Name=>"Myname 2",position=>(1,2));
***** LENGTH Parameter is Missing
Error is at or near )
29 Field (name=>"Myname 3",length=>2);
***** POSITION Parameter is Missing
Error is at or near )
30 Field (position=>(1,5),length=>5);
***** NAME Parameter is Missing
Error is at or near )
31 Field ();
***** Expected Identifier
Error is at or near )
32 Text ();
***** Expected Identifier
Error is at or near )
33
34 --
35 -- Input Employee Number
36 --
37 Text( Value => "Employee Number:", Position => (6, 2) );
38
39 Field( Name => "Employee Number", Position => (6, 20),
40 Length => 8, Limitation => Numeric );
41
42 --
43 -- Input Division
44 --
45 Text( Value => "Division:", Position => (8, 9) );
46
47 Field( Name => "Division", Position => (8, 20),
48 Length => 2, Limitation => Numeric );
49
50 --
51 -- Cost Center
52 --
53 Text( Value => "Cost Center:", Position => (10, 6) );
54
55 Field( Name => "Cost Center", Position => (10, 20),
56 Length => 4, Limitation => Numeric );
57
58 --
59 -- Location
60 --
61 Text( Value => "Location:", Position => (12, 9) );
62
63 Field( Name => "Location", Position => (12, 20),
64 Length => 20, Limitation => Alphabetic );
65
66 --
67 -- Mail Station
68 --
69 Text( Value => "Mail Station:", Position => (14, 5) );
70
71 Field( Name => "Mail Station", Position => (14, 20),
72 Length => 4, Limitation => Numeric );
73
74 --
75 -- Phone Number
76 --
77 Text( Value => "Phone Number:", Position => (16, 5) );
78
79 Field( Name => "Phone Number", Position => (16, 20),
80 Length => 15, Limitation => Not_Limited );
81
82 --
83 -- Message ID
84 --
85 Text( Value => "Message Id.:", Position => (18, 6) );
86
87 Field( Name => "Message Id.", Position => (18, 20),
88 Length => 20, Limitation => Alphanumeric );
<<<<< 11 Error(s) Detected >>>>>
<<<<< Form NOT Saved >>>>>
::::::::::
BATCH_05.TST
::::::::::
--
-- Form Definition Language Example
-- Identification: BATCH_05
-- No Form definition statement (3 errors).
--
--
-- No Form Definition
--
--
-- Title on Form
--
Text( Value => "Employee Identification Record",
Position => (1, 6) );
--
-- Input Employee Name
--
Text( Value => "Name:", Postion => (4, 12) );
Field( Name => "Name", Position => (4, 20), Length => 20,
Limitation => Alphabetic );
--
-- Input Employee Number
--
Text( Value => "Employee Number:", Position => (6, 2) );
Field( Name => "Employee Number", Position => (6, 20),
Length => 8, Limitation => Numeric );
--
-- Input Division
--
Text( Value => "Division:", Position => (8, 9) );
Field( Name => "Division", Position => (8, 20),
Length => 2, Limitation => Numeric );
--
-- Cost Center
--
Text( Value => "Cost Center:");
Field( Name => "Cost Center", Position => (10, 20),
Length => 4, Limitation => Numeric );
--
-- Location
--
Text( Value => "Location:", Position => (12, 9) );
Field( Name => "Location", Position => (12, 20),
Length => 20, Limitation => Alphabetic );
--
-- Mail Station
--
Text( Value => "Mail Station:", Position => (14, 5) );
Field( Name => "Mail Station", Position => (14, 20),
Length => 4, Limitation => Numeric );
--
-- Phone Number
--
Text( Value => "Phone Number:", Position => (16, 5) );
Field( Name => "Phone Number", Position => (16, 20),
Length => 15, Limitation => Not_Limited );
--
-- Message ID
--
Text( Value => "Message Id.:", Position => (18, 6) );
Field( Name => "Message Id.", Position => (18, 20),
Length => 20, Limitation => Alphanumeric );
::::::::::
BATCH_05.LST
::::::::::
Batch Forms Generator running on 3/17/1985
Input File: batch_05.test
Output File: batch_05.form
1 --
2 -- Form Definition Language Example
3 -- Identification: BATCH_05
4 -- No Form definition statement (3 errors).
5 --
6
7 --
8 -- No Form Definition
9 --
10
11 --
12 -- Title on Form
13 --
14 Text( Value => "Employee Identification Record",
15 Position => (1, 6) );
<<<<< TEXT Statement Correct but FORM Not Open >>>>>
16
17 --
18 -- Input Employee Name
19 --
20 Text( Value => "Name:", Postion => (4, 12) );
***** Unrecognized Keyword Encountered
Error is at or near Postion
21
22 Field( Name => "Name", Position => (4, 20), Length => 20,
23 Limitation => Alphabetic );
<<<<< FIELD Statement Correct but FORM Not Open >>>>>
24
25 --
26 -- Input Employee Number
27 --
28 Text( Value => "Employee Number:", Position => (6, 2) );
<<<<< TEXT Statement Correct but FORM Not Open >>>>>
29
30 Field( Name => "Employee Number", Position => (6, 20),
31 Length => 8, Limitation => Numeric );
<<<<< FIELD Statement Correct but FORM Not Open >>>>>
32
33 --
34 -- Input Division
35 --
36 Text( Value => "Division:", Position => (8, 9) );
<<<<< TEXT Statement Correct but FORM Not Open >>>>>
37
38 Field( Name => "Division", Position => (8, 20),
39 Length => 2, Limitation => Numeric );
<<<<< FIELD Statement Correct but FORM Not Open >>>>>
40
41 --
42 -- Cost Center
43 --
44 Text( Value => "Cost Center:");
***** POSITION Parameter is Missing
Error is at or near )
45
46 Field( Name => "Cost Center", Position => (10, 20),
47 Length => 4, Limitation => Numeric );
<<<<< FIELD Statement Correct but FORM Not Open >>>>>
48
49 --
50 -- Location
51 --
52 Text( Value => "Location:", Position => (12, 9) );
<<<<< TEXT Statement Correct but FORM Not Open >>>>>
53
54 Field( Name => "Location", Position => (12, 20),
55 Length => 20, Limitation => Alphabetic );
<<<<< FIELD Statement Correct but FORM Not Open >>>>>
56
57 --
58 -- Mail Station
59 --
60 Text( Value => "Mail Station:", Position => (14, 5) );
<<<<< TEXT Statement Correct but FORM Not Open >>>>>
61
62 Field( Name => "Mail Station", Position => (14, 20),
63 Length => 4, Limitation => Numeric );
<<<<< FIELD Statement Correct but FORM Not Open >>>>>
64
65 --
66 -- Phone Number
67 --
68 Text( Value => "Phone Number:", Position => (16, 5) );
<<<<< TEXT Statement Correct but FORM Not Open >>>>>
69
70 Field( Name => "Phone Number", Position => (16, 20),
71 Length => 15, Limitation => Not_Limited );
<<<<< FIELD Statement Correct but FORM Not Open >>>>>
72
73 --
74 -- Message ID
75 --
76 Text( Value => "Message Id.:", Position => (18, 6) );
<<<<< TEXT Statement Correct but FORM Not Open >>>>>
77
78 Field( Name => "Message Id.", Position => (18, 20),
79 Length => 20, Limitation => Alphanumeric );
<<<<< FIELD Statement Correct but FORM Not Open >>>>>
<<<<< 3 Error(s) Detected >>>>>
<<<<< Form NOT Saved >>>>>
::::::::::
EXECUTOR.TST
::::::::::
Form ( Size => (10, 60), Position => (10, 10) );
Text ( Value => "Form Executor Test", Position => (1, 10) );
Text ( Value => "Alphabetic Field ( A-Z a-z ' . , - ):",
Position => (3, 1) );
Field ( Name => "Alpha Field", Position => (3, 45),
Length => 10, Limitation => Alphabetic );
Text ( Value => "Alpha Numeric Field ( A-Z a-z 0-9 ' . , - ):",
Position => (5, 1) );
Field ( Name => "Alpha Numeric Field", Position => (5, 45),
Length => 10, Limitation => AlphaNumeric );
Text ( Value => "Numeric Field ( 0-9 , . - + $ % ):",
Position => (7, 1) );
Field ( Name => "Numeric Field", Position => (7, 45),
Length => 10, Limitation => Numeric );
Text ( Value => "Not Limited Field (anything):",
Position => (9, 1) );
Field ( Name => "Not Limited Field", Position => (9, 45),
Length => 10 );
::::::::::
EXECUTOR.LST
::::::::::
Batch Forms Generator running on 3/17/1985
Input File: executor.test
Output File: executor.form
1 Form ( Size => (10, 60), Position => (10, 10) );
2
3 Text ( Value => "Form Executor Test", Position => (1, 10) );
4
5 Text ( Value => "Alphabetic Field ( A-Z a-z ' . , - ):",
6 Position => (3, 1) );
7
8 Field ( Name => "Alpha Field", Position => (3, 45),
9 Length => 10, Limitation => Alphabetic );
10
11 Text ( Value => "Alpha Numeric Field ( A-Z a-z 0-9 ' . , - ):",
12 Position => (5, 1) );
13
14 Field ( Name => "Alpha Numeric Field", Position => (5, 45),
15 Length => 10, Limitation => AlphaNumeric );
16
17 Text ( Value => "Numeric Field ( 0-9 , . - + $ % ):",
18 Position => (7, 1) );
19
20 Field ( Name => "Numeric Field", Position => (7, 45),
21 Length => 10, Limitation => Numeric );
22
23 Text ( Value => "Not Limited Field (anything):",
24 Position => (9, 1) );
25
26 Field ( Name => "Not Limited Field", Position => (9, 45),
27 Length => 10 );
<<<<< 0 Error(s) Detected >>>>>
<<<<< Form Saved >>>>>
::::::::::
EXECUTOR.FRM
::::::::::
10 60 10 10 CLEAR
1 10 18 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Form Executor Test
3 1 37 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Alphabetic Field ( A-Z a-z ' . , - ):
Alpha Field
3 45 10 ALPHA INPUT_OUTPUT PRIMARY_RENDITION
5 1 44 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Alpha Numeric Field ( A-Z a-z 0-9 ' . , - ):
Alpha Numeric Field
5 45 10 ALPHA_NUMERIC INPUT_OUTPUT PRIMARY_RENDITION
7 1 34 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Numeric Field ( 0-9 , . - + $ % ):
Numeric Field
7 45 10 NUMERIC INPUT_OUTPUT PRIMARY_RENDITION
9 1 29 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Not Limited Field (anything):
Not Limited Field
9 45 10 NOT_LIMITED INPUT_OUTPUT PRIMARY_RENDITION
::::::::::
EXEC_TEST.ADA
::::::::::
with FORM_EXECUTOR,
CURRENT_EXCEPTION,
TEXT_IO;
procedure EXEC_TEST is
FORM : FORM_EXECUTOR.FORM_PTR;
begin
FORM := FORM_EXECUTOR.ACCESS_FORM (" EXECUTOR.FORM ");
FORM_EXECUTOR.PRESENT_FORM (FORM);
FORM_EXECUTOR.RELEASE_FORM (FORM);
exception
when others =>
TEXT_IO.PUT (CURRENT_EXCEPTION.NAME);
end EXEC_TEST;
pragma MAIN;
::::::::::
EXEC_TEST.TST
::::::::::
Form Executor Formal Test
Invoke the Form Executor test program 'Exec_Test'. This will
load and present a form.
1. Make sure legal characters can be entered into each field.
2. Make sure illegal characters cannot be entered into each field.
3. Test field editing functions
Delete char ^D VT-F6
Delete field ^E VT-F11
Insert char ^V VT-F7
Move left ^H Left arrow
Move right ^L Right arrow
Rubout DEL VT-F8
4. Test field movement functions
Next field ^I VT-F5
^J Down arrow
Previous field ^O VT-F1
^K Up arrow
Accept form ^M VT-F4
::::::::::
DISPLAY_FORM.ADA
::::::::::
with FORM_EXECUTOR, CURRENT_EXCEPTION, TEXT_IO;
procedure DISPLAY_FORM is
FORM: FORM_EXECUTOR.FORM_PTR;
NAME: STRING(1..20);
NUMBER: STRING(1..8);
DIVISION: STRING(1..2);
COST_CENTER: STRING(1..4);
LOCATION: STRING(1..20);
MAIL_STATION: STRING(1..4);
PHONE_NUMBER: STRING(1..15);
MESSAGE_ID: STRING(1..4);
begin
FORM := FORM_EXECUTOR.ACCESS_FORM( "DISPLAY_FORM.FORM" );
FORM_EXECUTOR.PRESENT_FORM( FORM );
FORM_EXECUTOR.QUERY_FIELD( FORM, "Cost Center", COST_CENTER );
FORM_EXECUTOR.QUERY_FIELD( FORM, "Division", DIVISION );
FORM_EXECUTOR.QUERY_FIELD( FORM, "Employee Number", NUMBER );
FORM_EXECUTOR.QUERY_FIELD( FORM, "Location", LOCATION );
FORM_EXECUTOR.QUERY_FIELD( FORM, "Mail Station", MAIL_STATION );
FORM_EXECUTOR.QUERY_FIELD( FORM, "Message Id.", MESSAGE_ID );
FORM_EXECUTOR.QUERY_FIELD( FORM, "Name", NAME );
FORM_EXECUTOR.QUERY_FIELD( FORM, "Phone Number", PHONE_NUMBER );
FORM_EXECUTOR.CLEAR_FORM( FORM );
FORM_EXECUTOR.MODIFY_FIELD( FORM, "Cost Center", COST_CENTER );
FORM_EXECUTOR.MODIFY_FIELD( FORM, "Division", DIVISION );
FORM_EXECUTOR.MODIFY_FIELD( FORM, "Employee Number", NUMBER );
FORM_EXECUTOR.MODIFY_FIELD( FORM, "Location", LOCATION );
FORM_EXECUTOR.MODIFY_FIELD( FORM, "Mail Station", MAIL_STATION );
FORM_EXECUTOR.MODIFY_FIELD( FORM, "Message Id.", MESSAGE_ID );
FORM_EXECUTOR.MODIFY_FIELD( FORM, "Name", NAME );
FORM_EXECUTOR.MODIFY_FIELD( FORM, "Phone Number", PHONE_NUMBER );
FORM_EXECUTOR.PRESENT_FORM( FORM );
FORM_EXECUTOR.RELEASE_FORM( FORM );
exception
when others=>
TEXT_IO.PUT( CURRENT_EXCEPTION.NAME );
end DISPLAY_FORM;
pragma MAIN;
::::::::::
DISPLAY_FORM.FRM
::::::::::
18 40 3 20 CLEAR
1 6 30 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Employee Identification Record
4 13 5 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Name:
Name
4 20 20 ALPHA INPUT_OUTPUT PRIMARY_RENDITION
6 2 16 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Employee Number:
Employee Number
6 20 8 NUMERIC INPUT_OUTPUT PRIMARY_RENDITION
8 9 9 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Division:
Division
8 20 2 NUMERIC INPUT_OUTPUT PRIMARY_RENDITION
10 6 12 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Cost Center:
Cost Center
10 20 4 NUMERIC INPUT_OUTPUT PRIMARY_RENDITION
12 9 9 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Location:
Location
12 20 20 ALPHA INPUT_OUTPUT PRIMARY_RENDITION
14 5 13 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Mail Station:
Mail Station
14 20 4 NUMERIC INPUT_OUTPUT PRIMARY_RENDITION
16 5 13 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Phone Number:
Phone Number
16 20 15 NOT_LIMITED INPUT_OUTPUT PRIMARY_RENDITION
18 6 12 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Message Id.:
Message Id.
18 20 4 ALPHA_NUMERIC INPUT_OUTPUT PRIMARY_RENDITION
::::::::::
INTERACT.FRM
::::::::::
24 80 1 1 CLEAR
1 9 24 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Here is some plain text.
3 9 26 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Here is the first field-->
Field One
3 35 10 ALPHA INPUT_OUTPUT REVERSE_RENDITION
5 1 34 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Here is the second field-->
Field Two
5 35 10 NUMERIC INPUT_OUTPUT REVERSE_RENDITION
7 1 34 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Here is the last field-->
Field Three
7 35 15 NOT_LIMITED INPUT_OUTPUT PRIMARY_RENDITION
23 9 24 NOT_LIMITED CONSTANT_TEXT PRIMARY_RENDITION
Here is more plain text.
::::::::::
TCF
::::::::::
fg|fgs|form generator for vt100:\
:co#80:li#24:am:cl=50\E[;H\E[2J:bs:cm=5\E[%i%2;%2H:nd=2\E[C:up=2\E[A:\
:ce=3\E[K:cd=50\E[J:so=2\E[7m:se=2\E[m:us=2\E[4m:ue=2\E[m:\
:is=\E<\E=\E[?1l\E[?3l\E[?5l:\
:ku=\E[A:kd=\E[B:kr=\E[C:kl=\E[D:\
:kh=\E[H:pt:sr=5\EM:\
:k1=\E[Z:l1=Back Tab:\
:k2=\EOP:l2=PF1-Command:\
:k3=\EOQ:l3=PF2-Help:\
:k4=\EOM:l4=Enter-Return:\
:k5=\T:l5=Tab-Tab:\
:k6=\EOl:l6=','-Char Delete:\
:k7=\EOn:l7='.'-Char Insert:\
:k8=\177:l8=Del:\
:k9=\EOR:l9=PF3-Exit Form:\
:x0=\EOq:y0='1'-Copy Line:\
:x1=\EOm:y1='-'-Line Erase:\
:x2=\EOS:y2=PF4-Line Delete:\
:x3=\EOp:y3='0'-Line Insert:\
:x4=\EOr:y4='2'-F4-Move Line:\
:x5=\EOt:y5='4'-Copy Field:\
:x6=\EOw:y6='7'-Create Field:\
:x7=\EOy:y7='9'-Delete Field:\
:x8=\EOx:y8='8'-Modify Field:\
:x9=\EOu:y9='5'-Move Field:
d1|vt100|vt-100|pt100|pt-100|dec vt100:\
:co#80:li#24:am:cl=50\E[;H\E[2J:bs:cm=5\E[%i%2;%2H:nd=2\E[C:up=2\E[A:\
:ce=3\E[K:cd=50\E[J:so=2\E[7m:se=2\E[m:us=2\E[4m:ue=2\E[m:\
:is=\E>\E[?3l\E[?4l\E[?5l\E[?7h\E[?8h:ks=\E[?1h\E=:ke=\E[?1l\E>:\
:if=/usr/lib/tabset/vt100:ku=\EOA:kd=\EOB:kr=\EOC:kl=\EOD:\
:kh=\E[H:k1=\EOP:k2=\EOQ:k3=\EOR:k4=\EOS:pt:sr=5\EM:
dt|vt100w|vt-100w|pt100w|pt-100w|dec vt100 132 cols:\
:co#128:li#24:is=\E>\E[?3h\E[?4l\E[?5l\E[?7h\E[?8h:tc=vt100:
dv|vt52|dec vt52:\
:bs:cd=\EJ:ce=\EK:cl=\EH\EJ:cm=\EY%+ %+ :co#80:li#24:nd=\EC:\
:pt:sr=\EI:up=\EA:ku=\EA:kd=\EB:kr=\EC:kl=\ED:
d5|vi50|Visual 50:\
:al=\EL:ca=\015\EK:\
:l1=F1:k1=\EP:l2=F2:k2=\EQ:\
:pt:bs:cd=\EJ:ce=\EK:cl=\EH\EJ:cm=\EY%+ %+ :co#80:dl=\EM:\
:li#24:nd=\EC:pt:se=\ET:so=\EU:sf=\ED:sr=\EI:up=\EA:\
:kl=\ED:vb=\E9@\E9P\E9@\E9P\E9@\E9P\E9@\E9P: