Programmer's ROM - The Computer Language Library

home *** CD-ROM | disk | FTP | other *** search

/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / forms / form2.src < prev next >

Wrap

Text File | 1988-05-03 | 267.2 KB | 8,391 lines

-------- 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;