/**************************************************************************** * * * Copyright (c) 1987 * * by DIGITAL Equipment Corporation, Maynard, Mass. * * * * This software is furnished under a license and may be used and copied * * only in accordance with the terms of such license and with the * * inclusion of the above copyright notice. This software or any other * * copies thereof may not be provided or otherwise made available to any * * other person. No title to and ownership of the software is hereby * * transferred. * * * * The information in this software is subject to change without notice * * and should not be construed as a commitment by DIGITAL Equipment * * Corporation. * * * * DIGITAL assumes no responsibility for the use or reliability of its * * software on equipment which is not supplied by DIGITAL. * * * ****************************************************************************/ /* **++ ** FACILITY: ** ** PLI Sample Program - Phone Book Database ** ** ABSTRACT: ** ** This module contains all the necessary routine to put up the terminal ** screens using SMG. It also contains the routines to set up the keypad ** and read in keys. ** ** AUTHORS: ** ** Karen Michaels ** ** ** CREATION DATE: 16-Feb-1987 ** ** MODIFICATION HISTORY: **-- **/ %include 'constants.pli'; %include 'entry.pli'; %include $smgdef; /* * Global variables. */ dcl board_id fixed binary(31) static; /* The internal id of the pasteboard */ dcl display_id fixed binary(31) static; /* The internal id of the display */ dcl key_id fixed binary(31) static; /* The internal id the keyboard */ dcl rows fixed binary(31) static; /* The number of rows on the screen */ dcl columns fixed binary(31) static; /* The number of columns on the */ %replace FIRST_CODE_VALUE by 1; %replace LAST_NAME_CODE by 1; %replace FIRST_NAME_CODE by 2; %replace ADDRESS1_CODE by 3; %replace ADDRESS2_CODE by 4; %replace CITY_CODE by 5; %replace STATE_CODE by 6; %replace ZIP_CODE by 7; %replace HOME_AREA_CODE by 8; %replace HOME_EXCHANGE_CODE by 9; %replace HOME_NUMBER_CODE by 10; %replace OFFICE_AREA_CODE by 11; %replace OFFICE_EXCHANGE_CODE by 12; %replace OFFICE_NUMBER_CODE by 13; %replace EXTENSION_CODE by 14; %replace B_DAY_CODE by 15; %replace B_MONTH_CODE by 16; %replace B_YEAR_CODE by 17; %replace A_DAY_CODE by 18; %replace A_MONTH_CODE by 19; %replace A_YEAR_CODE by 20; %replace LAST_CODE_VALUE by 20; /* * Array containing the size of all the fields. */ dcl size_array(LAST_CODE_VALUE) fixed binary(31) static readonly init( 32,32,60,60,32,2,5,3,3,4,3,3,4,4,2,3,4,2,3,4); /* * Arrays the rows and columns for the current fields. */ dcl row_array(LAST_CODE_VALUE) static readonly fixed binary(31) init( 2,4,6,7,9,11,13,15,15,15,17,17,17,17,19,19,19,21,21,21); dcl column_array(LAST_CODE_VALUE) static readonly fixed binary(31) init( 20,20,20,20,20,20,20,20,24,28,20,24,28,55,20,23,27,20,23,27); /* * External routine declarations. */ %include lib$signal; /* * Preprocessor routine to check for and signal an error. */ %check_status: procedure (status_value) returns(character); dcl status_value character; return( 'if posint('||status_value||',1,1) = 0 '|| 'then '|| 'call lib$signal('||status_value||')' ); %end; /* * Preprocessor routine to upcase a string. */ %upcase: procedure (string) returns(character); dcl string character; return( string||' = translate(' ||string|| ',''ABCDEFGHIJKLMNOPQRTSUVWXYZ'',''abcdefghijklmnopqrtsuvwxyz'')' ); %end; /* **++ ** FUNCTIONAL DESCRIPTION: ** ** This routine initializes the screen so that SMG can be used to put up ** displays and read keys from the keyboard. ** ** FORMAL PARAMETERS: ** ** none ** ** IMPLICIT INPUTS: ** ** none ** ** IMPLICIT OUTPUTS: ** ** board_id : the id number of the pasteboard ** key_id : the id number of the keyboard ** display_id : The id number of the display ** rows : the number of rows on the screen ** columns : the number of columns on the screen ** ** RETURN VALUE: ** ** none ** ** SIDE EFFECTS: ** ** none ** **-- **/ initialize_screen: procedure options(ident('V1.0')); dcl status fixed binary(31); /* The status returned from SMG */ %include smg$create_virtual_keyboard; %include smg$create_pasteboard; %include smg$paste_virtual_display; %include smg$create_virtual_display; %include smg$set_cursor_mode; /* * Set up the pasteboard. */ status = smg$create_pasteboard(board_id,'SYS$OUTPUT',rows,columns); check_status(status); /* * Remove the cursor from the pasteboard. */ status = smg$set_cursor_mode(board_id,true); check_status(status); /* * Setup the keyboard. */ status = smg$create_virtual_keyboard(key_id); check_status(status); /* * Setup the display. */ status = smg$create_virtual_display(rows,columns,display_id); check_status(status); /* * Paste the border display onto the pasteboard. */ status = smg$paste_virtual_display(display_id,board_id,1,1); check_status(status); end initialize_screen; /* **++ ** FUNCTIONAL DESCRIPTION: ** ** This routine cleans the screen. It should be called when the program ** terminates. ** ** FORMAL PARAMETERS: ** ** none ** ** IMPLICIT INPUTS: ** ** board_id : the id number of the pasteboard ** ** IMPLICIT OUTPUTS: ** ** none ** ** RETURN VALUE: ** ** none ** ** SIDE EFFECTS: ** ** none ** **-- **/ clear_screen: procedure; dcl status fixed binary(31); /* The status returned from SMG */ %include smg$erase_pasteboard; %include smg$set_cursor_mode; /* * Erase everything. */ status = smg$erase_pasteboard(board_id); /* * Restore the cursor. */ status = smg$set_cursor_mode(board_id,false); check_status(status); end clear_screen; /* **++ ** FUNCTIONAL DESCRIPTION: ** ** This routine reads a key from the keypad and returns its value. ** ** FORMAL PARAMETERS: ** ** none ** ** IMPLICIT INPUTS: ** ** key_id : the id number of the keyboard ** ** IMPLICIT OUTPUTS: ** ** none ** ** RETURN VALUE: ** ** The keynumber that was pushed. ** ** SIDE EFFECTS: ** ** none ** **-- **/ read_a_key: procedure returns(fixed binary(31)); dcl terminator fixed binary(15); /* The last key hit */ dcl status fixed binary(31); /* The status returned from SMG */ %include smg$read_keystroke; status = smg$read_keystroke(key_id,terminator); check_status(status); return(terminator); end read_a_key; /* **++ ** FUNCTIONAL DESCRIPTION: ** ** This routine displays a menu of possible operations. ** ** FORMAL PARAMETERS: ** ** none ** ** IMPLICIT INPUTS: ** ** display_id : The id number of the display ** rows : the number of rows on the screen ** columns : the number of columns on the screen ** ** IMPLICIT OUTPUTS: ** ** none ** ** RETURN VALUE: ** ** none ** ** SIDE EFFECTS: ** ** none ** **-- **/ display_menu: procedure; dcl status fixed binary(31); /* The status returned from SMG */ dcl center fixed binary(31); /* The center of the line */ %include smg$erase_display; %include smg$put_chars_highwide; %include smg$put_chars; %replace title_line by 'Choose an Operation:'; %replace lookup_line by 'KP1 - Lookup Entry'; %replace add_line by 'KP2 - Add Entry'; %replace modify_line by 'KP3 - Modify Entry'; %replace delete_line by 'KP4 - Delete Entry'; %replace month_line by 'KP5 - Events for a Given Month'; %replace date_line by 'KP6 - Events for a Given Date'; %replace exit_line by 'KP0 - Exit'; %replace average_length by 20; /* * Erase the current display. */ status = smg$erase_display(display_id); check_status(status); /* * Calculate center of the line. */ center = divide(2*average_length,2,31) + 1; /* * Write a header line. */ status = smg$put_chars_highwide(display_id,title_line,1, divide(columns-2*length(title_line),2,31)+1); check_status(status); /* * Write the rest of the lines. */ status = smg$put_chars(display_id,LOOKUP_LINE,5,center); check_status(status); status = smg$put_chars(display_id,ADD_LINE,7,center); check_status(status); status = smg$put_chars(display_id,MODIFY_LINE,9,center); check_status(status); status = smg$put_chars(display_id,DELETE_LINE,11,center); check_status(status); status = smg$put_chars(display_id,MONTH_LINE,13,center); check_status(status); status = smg$put_chars(display_id,DATE_LINE,15,center); check_status(status); status = smg$put_chars(display_id,EXIT_LINE,17,center); check_status(status); end display_menu; /* **++ ** FUNCTIONAL DESCRIPTION: ** ** This routine determines what key the user selected for an operation. ** When it gets a valid key it returns the operation value. ** ** FORMAL PARAMETERS: ** ** none ** ** IMPLICIT INPUTS: ** ** display_id : The id number of the display ** rows : the number of rows on the screen ** ** IMPLICIT OUTPUTS: ** ** none ** ** RETURN VALUE: ** ** The operation code of the selected operation ** ** SIDE EFFECTS: ** ** none ** **-- **/ select_operation: procedure returns(fixed binary(31)); dcl key fixed binary(31); /* The selected key */ dcl operation fixed binary(31) init(0); /* The corresponding operation */ dcl status fixed binary(31); /* The status returned from SMG */ %include smg$put_chars; %include 'operations.pli'; /* * Wait for a legal operation. */ do while(operation = 0); key = read_a_key(); select (key); when (SMG$K_TRM_KP0) operation = EXIT_KEY; when (SMG$K_TRM_KP1) operation = LOOKUP_KEY; when (SMG$K_TRM_KP2) operation = ADD_KEY; when (SMG$K_TRM_KP3) operation = MODIFY_KEY; when (SMG$K_TRM_KP4) operation = DELETE_KEY; when (SMG$K_TRM_KP5) operation = MONTH_KEY; when (SMG$K_TRM_KP6) operation = DATE_KEY; otherwise do; status = smg$put_chars(display_id,'Illegal Key Entered',rows,5,, SMG$M_REVERSE | SMG$M_BLINK); check_status(status); end; end; end; return(operation); end select_operation; /* **++ ** FUNCTIONAL DESCRIPTION: ** ** This routine displays a template for an entry. It writes the labels ** for the fields, but not the values. ** ** FORMAL PARAMETERS: ** ** none ** ** IMPLICIT INPUTS: ** ** display_id : The id number of the display ** ** IMPLICIT OUTPUTS: ** ** none ** ** RETURN VALUE: ** ** none ** ** SIDE EFFECTS: ** ** none ** **-- **/ display_entry_template: procedure; dcl status fixed binary(31); /* The status returned from SMG */ %include smg$erase_display; %include smg$put_chars; /* * Erase the current display. */ status = smg$erase_display(display_id); check_status(status); /* * Write the labels */ status = smg$put_chars(display_id,'Last Name:',2,5,,SMG$M_UNDERLINE); check_status(status); status = smg$put_chars(display_id,'First Name:',4,5,,SMG$M_UNDERLINE); check_status(status); status = smg$put_chars(display_id,'Address:',6,5,,SMG$M_UNDERLINE); check_status(status); status = smg$put_chars(display_id,'City:',9,5,,SMG$M_UNDERLINE); check_status(status); status = smg$put_chars(display_id,'State:',11,5,,SMG$M_UNDERLINE); check_status(status); status = smg$put_chars(display_id,'Zip Code:',13,5,,SMG$M_UNDERLINE); check_status(status); status = smg$put_chars(display_id,'Home Phone:',15,5,,SMG$M_UNDERLINE); check_status(status); status = smg$put_chars(display_id,'Office Phone:',17,5,,SMG$M_UNDERLINE); check_status(status); status = smg$put_chars(display_id,'Extension:',17,40,,SMG$M_UNDERLINE); check_status(status); status = smg$put_chars(display_id,'Birthdate:',19,5,,SMG$M_UNDERLINE); check_status(status); status = smg$put_chars(display_id,'Anniversary:',21,5,,SMG$M_UNDERLINE); check_status(status); end display_entry_template; /* **++ ** FUNCTIONAL DESCRIPTION: ** ** This routine displays the contents of a given entry. ** ** FORMAL PARAMETERS: ** ** record_ptr : A pointer to the record to display ** reverse_flag : True if field should be displayed in reverse video ** ** IMPLICIT INPUTS: ** ** display_id : The id number of the display ** ** IMPLICIT OUTPUTS: ** ** none ** ** RETURN VALUE: ** ** none ** ** SIDE EFFECTS: ** ** none ** **-- **/ display_record: procedure(record_ptr, reverse_flag); dcl record_ptr pointer value; /* A pointer to the record to display */ dcl reverse_flag bit(1) aligned value; /* True if field should be displayed in reverse video */ dcl status fixed binary(31); /* The status returned from SMG */ %include smg$put_chars; /* * Write the fields */ status = smg$put_chars(display_id,record_ptr->name.last, row_array(LAST_NAME_CODE),column_array(LAST_NAME_CODE),, copy(reverse_flag,32) & SMG$M_REVERSE); check_status(status); status = smg$put_chars(display_id,record_ptr->name.first, row_array(FIRST_NAME_CODE),column_array(FIRST_NAME_CODE),, copy(reverse_flag,32) & SMG$M_REVERSE); check_status(status); status = smg$put_chars(display_id,record_ptr->address1, row_array(ADDRESS1_CODE),column_array(ADDRESS1_CODE),, copy(reverse_flag,32) & SMG$M_REVERSE); check_status(status); status = smg$put_chars(display_id,record_ptr->address2, row_array(ADDRESS2_CODE),column_array(ADDRESS2_CODE),, copy(reverse_flag,32) & SMG$M_REVERSE); check_status(status); status = smg$put_chars(display_id,record_ptr->city, row_array(CITY_CODE),column_array(CITY_CODE),, copy(reverse_flag,32) & SMG$M_REVERSE); check_status(status); status = smg$put_chars(display_id,record_ptr->state, row_array(STATE_CODE),column_array(STATE_CODE),, copy(reverse_flag,32) & SMG$M_REVERSE); check_status(status); status = smg$put_chars(display_id,record_ptr->zip, row_array(ZIP_CODE),column_array(ZIP_CODE),, copy(reverse_flag,32) & SMG$M_REVERSE); check_status(status); status = smg$put_chars(display_id,record_ptr->home_phone.area_code, row_array(HOME_AREA_CODE),column_array(HOME_AREA_CODE),, copy(reverse_flag,32) & SMG$M_REVERSE); check_status(status); status = smg$put_chars(display_id,record_ptr->home_phone.exchange, row_array(HOME_EXCHANGE_CODE),column_array(HOME_EXCHANGE_CODE),, copy(reverse_flag,32) & SMG$M_REVERSE); check_status(status); status = smg$put_chars(display_id,record_ptr->home_phone.number, row_array(HOME_NUMBER_CODE),column_array(HOME_NUMBER_CODE),, copy(reverse_flag,32) & SMG$M_REVERSE); check_status(status); status = smg$put_chars(display_id,record_ptr->office_phone.area_code, row_array(OFFICE_AREA_CODE),column_array(OFFICE_AREA_CODE),, copy(reverse_flag,32) & SMG$M_REVERSE); check_status(status); status = smg$put_chars(display_id,record_ptr->office_phone.exchange, row_array(OFFICE_EXCHANGE_CODE),column_array(OFFICE_EXCHANGE_CODE),, copy(reverse_flag,32) & SMG$M_REVERSE); check_status(status); status = smg$put_chars(display_id,record_ptr->office_phone.number, row_array(OFFICE_NUMBER_CODE),column_array(OFFICE_NUMBER_CODE),, copy(reverse_flag,32) & SMG$M_REVERSE); check_status(status); status = smg$put_chars(display_id,record_ptr->extension, row_array(EXTENSION_CODE),column_array(EXTENSION_CODE),, copy(reverse_flag,32) & SMG$M_REVERSE); check_status(status); status = smg$put_chars(display_id,record_ptr->birthdate.day, row_array(B_DAY_CODE),column_array(B_DAY_CODE),, copy(reverse_flag,32) & SMG$M_REVERSE); check_status(status); status = smg$put_chars(display_id,record_ptr->birthdate.month, row_array(B_MONTH_CODE),column_array(B_MONTH_CODE),, copy(reverse_flag,32) & SMG$M_REVERSE); check_status(status); status = smg$put_chars(display_id,record_ptr->birthdate.year, row_array(B_YEAR_CODE),column_array(B_YEAR_CODE),, copy(reverse_flag,32) & SMG$M_REVERSE); check_status(status); status = smg$put_chars(display_id,record_ptr->anniversary.day, row_array(A_DAY_CODE),column_array(A_DAY_CODE),, copy(reverse_flag,32) & SMG$M_REVERSE); check_status(status); status = smg$put_chars(display_id,record_ptr->anniversary.month, row_array(A_MONTH_CODE),column_array(A_MONTH_CODE),, copy(reverse_flag,32) & SMG$M_REVERSE); check_status(status); status = smg$put_chars(display_id,record_ptr->anniversary.year, row_array(A_YEAR_CODE),column_array(A_YEAR_CODE),, copy(reverse_flag,32) & SMG$M_REVERSE); check_status(status); end display_record; /* **++ ** FUNCTIONAL DESCRIPTION: ** ** This routine displays an entry. Only the name fields are displayed. ** ** FORMAL PARAMETERS: ** ** record_ptr : A pointer to the record to be displayed ** ** IMPLICIT INPUTS: ** ** display_id : The id number of the display ** ** IMPLICIT OUTPUTS: ** ** none ** ** RETURN VALUE: ** ** none ** ** SIDE EFFECTS: ** ** none ** **-- **/ display_name_record: procedure (record_ptr); dcl record_ptr pointer value; /* A pointer to the record to be displayed */ dcl status fixed binary(31); /* The status returned from SMG */ %include smg$erase_display; %include smg$put_chars; /* * Erase the current display. */ status = smg$erase_display(display_id); check_status(status); /* * Write the labels */ status = smg$put_chars(display_id,'Last Name:',2,5,,SMG$M_UNDERLINE); check_status(status); status = smg$put_chars(display_id,'First Name:',4,5,,SMG$M_UNDERLINE); check_status(status); /* * Write the fields */ status = smg$put_chars(display_id,record_ptr->name.last, row_array(LAST_NAME_CODE),column_array(LAST_NAME_CODE)); check_status(status); status = smg$put_chars(display_id,record_ptr->name.first, row_array(FIRST_NAME_CODE),column_array(FIRST_NAME_CODE)); end display_name_record; /* **++ ** FUNCTIONAL DESCRIPTION: ** ** This routine allows the user to modify the fields in an entry. ** ** FORMAL PARAMETERS: ** ** record_ptr : A pointer to the current record. ** ** IMPLICIT INPUTS: ** ** display_id : The id number of the display ** ** IMPLICIT OUTPUTS: ** ** none ** ** RETURN VALUE: ** ** True if record should be added to the database. ** ** SIDE EFFECTS: ** ** The value of the record pointed to by record_ptr has changed. ** **-- **/ enter_record: procedure (record_ptr) returns(bit(1) aligned); dcl record_ptr pointer value; /* A pointer to the record to display */ dcl status fixed binary(31); /* The status returned from SMG */ dcl code fixed binary(31); /* Current Field being modified */ dcl done bit(1) aligned init(false); /* True when all desired fields are entered */ dcl temp_string character(NAME_SIZE);/* A string to hold the input of a field */ dcl ret_size fixed binary(15); /* The specified size of the field */ dcl terminator fixed binary(15); /* The terminator key entered */ %include smg$set_cursor_mode; %include smg$set_cursor_abs; %include smg$read_string; /* * Give directions. */ call write_info_message( 'Enter Field Values. Hit When Done or to abort.'); /* * Turn the cursor on. */ status = smg$set_cursor_mode(board_id,false); check_status(status); /* * Start with the first field. */ code = FIRST_CODE_VALUE; do while (^done); /* * Position at the current field. */ status = smg$set_cursor_abs(display_id,row_array(code), column_array(code)); check_status(status); /* * Read in current field value and upcase it. */ status = smg$read_string(key_id,temp_string,,size_array(code),,,,ret_size, terminator,display_id,,,SMG$M_REVERSE); upcase(temp_string); /* * See if we're done. */ done = (terminator = SMG$K_TRM_ENTER) | (terminator = SMG$K_TRM_KP0); /* * If a value was entered move the value in. */ if ret_size ^= 0 then select(code); when(LAST_NAME_CODE) do; record_ptr->name.last = temp_string; end; when(FIRST_NAME_CODE) do; record_ptr->name.first = temp_string; end; when(ADDRESS1_CODE) do; record_ptr->address1 = temp_string; end; when(ADDRESS2_CODE) do; record_ptr->address2 = temp_string; end; when(CITY_CODE) do; record_ptr->city = temp_string; end; when(STATE_CODE) do; record_ptr->state = temp_string; end; when(ZIP_CODE) do; record_ptr->zip = temp_string; end; when(HOME_AREA_CODE) do; record_ptr->home_phone.area_code = temp_string; end; when(HOME_EXCHANGE_CODE) do; record_ptr->home_phone.exchange = temp_string; end; when(HOME_NUMBER_CODE) do; record_ptr->home_phone.number = temp_string; end; when(OFFICE_AREA_CODE) do; record_ptr->office_phone.area_code = temp_string; end; when(OFFICE_EXCHANGE_CODE) do; record_ptr->office_phone.exchange = temp_string; end; when(OFFICE_NUMBER_CODE) do; record_ptr->office_phone.number = temp_string; end; when(EXTENSION_CODE) do; record_ptr->extension = temp_string; end; when(B_DAY_CODE) do; record_ptr->birthdate.day = temp_string; end; when(B_MONTH_CODE) do; record_ptr->birthdate.month = temp_string; end; when(B_YEAR_CODE) do; record_ptr->birthdate.year = temp_string; end; when(A_DAY_CODE) do; record_ptr->anniversary.day = temp_string; end; when(A_MONTH_CODE) do; record_ptr->anniversary.month = temp_string; end; when(A_YEAR_CODE) do; record_ptr->anniversary.year = temp_string; end; end; /* * Do the next field. */ if code = LAST_CODE_VALUE then code = FIRST_CODE_VALUE; else code = code + 1; end; /* * Turn the cursor off. */ status = smg$set_cursor_mode(board_id,true); check_status(status); return(terminator = SMG$K_TRM_ENTER); end enter_record; /* **++ ** FUNCTIONAL DESCRIPTION: ** ** This routine displays a menu to prompt the user for a last name. ** It gets this name from the user and returns it to the caller. ** ** FORMAL PARAMETERS: ** ** menu_title : The title to display for the menu. ** ** IMPLICIT INPUTS: ** ** board_id : the id number of the pasteboard ** key_id : the id number of the keyboard ** display_id : The id number of the display ** columns : the number of columns on the screen ** ** IMPLICIT OUTPUTS: ** ** none ** ** RETURN VALUE: ** ** The name that was entered. ** ** SIDE EFFECTS: ** ** none ** **-- **/ get_a_name: procedure (menu_title) returns(character(NAME_SIZE)); dcl menu_title character(*) varying; /* The title of the menu */ dcl name character(NAME_SIZE); /* The name that was entered */ dcl status fixed binary(31); /* The status returned from SMG */ %include smg$erase_display; %include smg$put_chars_highwide; %include smg$put_chars; %include smg$set_cursor_mode; %include smg$set_cursor_abs; %include smg$read_string; /* * Erase the current display. */ status = smg$erase_display(display_id); check_status(status); /* * Write the title. */ status = smg$put_chars_highwide(display_id,menu_title,2, divide(columns-2*length(menu_title),2,31)+1,,SMG$M_BOLD); check_status(status); /* * Prompt for name. */ status = smg$put_chars(display_id,copy(' ',NAME_SIZE),6, divide(columns-NAME_SIZE,2,31)+1,,SMG$M_REVERSE); check_status(status); /* * Restore the cursor and position it at the beginning of the input area. */ status = smg$set_cursor_abs(display_id,6,divide(columns-NAME_SIZE,2,31)+1); check_status(status); status = smg$set_cursor_mode(board_id,false); check_status(status); /* * Read in the name and change it to upper case */ status = smg$read_string(key_id,name,,NAME_SIZE,,,,,,display_id,,, SMG$M_REVERSE); upcase(name); /* * Remove the Cursor. */ status = smg$set_cursor_mode(board_id,true); check_status(status); return(name); end get_a_name; /* **++ ** FUNCTIONAL DESCRIPTION: ** ** This routine displays a menu to prompt the user for a month. ** It gets this month from the user and returns it to the caller. ** ** FORMAL PARAMETERS: ** ** none ** ** IMPLICIT INPUTS: ** ** board_id : the id number of the pasteboard ** key_id : the id number of the keyboard ** display_id : The id number of the display ** columns : the number of columns on the screen ** ** IMPLICIT OUTPUTS: ** ** none ** ** RETURN VALUE: ** ** The month that was entered. ** ** SIDE EFFECTS: ** ** none ** **-- **/ get_a_month: procedure returns(character(MONTH_SIZE)); dcl month character(MONTH_SIZE); /* The month that was entered */ dcl status fixed binary(31); /* The status returned from SMG */ %replace month_title by 'ENTER MONTH TO SEE EVENTS FOR'; %include smg$erase_display; %include smg$put_chars_highwide; %include smg$put_chars; %include smg$set_cursor_mode; %include smg$set_cursor_abs; %include smg$read_string; /* * Erase the current display. */ status = smg$erase_display(display_id); check_status(status); /* * Write the title. */ status = smg$put_chars_highwide(display_id,month_title,2, divide(columns-2*length(month_title),2,31)+1,,SMG$M_BOLD); check_status(status); /* * Prompt for month. */ status = smg$put_chars(display_id,copy(' ',MONTH_SIZE),6, divide(columns-MONTH_SIZE,2,31)+1,,SMG$M_REVERSE); check_status(status); /* * Restore the cursor and position it at the beginning of the input area. */ status = smg$set_cursor_abs(display_id,6,divide(columns-MONTH_SIZE,2,31)+1); check_status(status); status = smg$set_cursor_mode(board_id,false); check_status(status); /* * Read in the month and change it to upper case */ status = smg$read_string(key_id,month,,MONTH_SIZE,,,,,,display_id,,, SMG$M_REVERSE); upcase(month); /* * Remove the Cursor. */ status = smg$set_cursor_mode(board_id,true); check_status(status); return(month); end get_a_month; /* **++ ** FUNCTIONAL DESCRIPTION: ** ** This routine displays a menu to prompt the user for a date. ** It gets this date from the user and returns it to the caller. ** ** FORMAL PARAMETERS: ** ** none ** ** IMPLICIT INPUTS: ** ** board_id : the id number of the pasteboard ** key_id : the id number of the keyboard ** display_id : The id number of the display ** columns : the number of columns on the screen ** ** IMPLICIT OUTPUTS: ** ** none ** ** RETURN VALUE: ** ** The date that was entered. ** ** SIDE EFFECTS: ** ** none ** **-- **/ get_a_date: procedure returns(character(DATE_SIZE)); dcl 1 date like birthdate.date_union;/* The date that was entered */ dcl start fixed binary(31); /* The character position to start the prompts at */ dcl status fixed binary(31); /* The status returned from SMG */ %replace date_title by 'ENTER DATE TO SEE EVENTS FOR'; %replace day_prompt by 'Day of Month:'; %replace month_prompt by 'Month:'; %include smg$erase_display; %include smg$put_chars_highwide; %include smg$put_chars; %include smg$set_cursor_mode; %include smg$set_cursor_abs; %include smg$read_string; /* * Erase the current display. */ status = smg$erase_display(display_id); check_status(status); /* * Write the title. */ status = smg$put_chars_highwide(display_id,date_title,2, divide(columns-2*length(date_title),2,31)+1,,SMG$M_BOLD); check_status(status); /* * Detemine where to start the prompt. */ start = divide(columns - max(length(DAY_PROMPT)+DAY_SIZE, length(MONTH_PROMPT)+MONTH_SIZE),2,31) + 1; /* * Prompt for month. */ status = smg$put_chars(display_id,MONTH_PROMPT,6,start,,SMG$M_UNDERLINE); check_status(status); status = smg$put_chars(display_id,copy(' ',MONTH_SIZE),6,start + length(DAY_PROMPT) + 1,,SMG$M_REVERSE); check_status(status); /* * Prompt for day. */ status = smg$put_chars(display_id,DAY_PROMPT,8,start,,SMG$M_UNDERLINE); check_status(status); status = smg$put_chars(display_id,copy(' ',DAY_SIZE),8,start + length(DAY_PROMPT) + 1,,SMG$M_REVERSE); check_status(status); /* * Restore the cursor */ status = smg$set_cursor_mode(board_id,false); check_status(status); /* * Position the cursor at the beginning of the month area and read in the * month. */ status = smg$set_cursor_abs(display_id,6,start + length(DAY_PROMPT) + 1); check_status(status); status = smg$read_string(key_id,date.month,,MONTH_SIZE,,,,,,display_id,,, SMG$M_REVERSE); upcase(date.month); /* * Position the cursor at the beginning of the day area and read in the * day. */ status = smg$set_cursor_abs(display_id,8,start + length(DAY_PROMPT) + 1); check_status(status); status = smg$read_string(key_id,date.day,,DAY_SIZE,,,,,,display_id,,, SMG$M_REVERSE); upcase(date.day); /* * Remove the Cursor. */ status = smg$set_cursor_mode(board_id,true); check_status(status); return(date.date); end get_a_date; /* **++ ** FUNCTIONAL DESCRIPTION: ** ** This routine displays a title for a new screen. ** ** FORMAL PARAMETERS: ** ** title : The title to display. ** ** IMPLICIT INPUTS: ** ** display_id : The id number of the display ** columns : the number of columns on the screen ** ** IMPLICIT OUTPUTS: ** ** none ** ** RETURN VALUE: ** ** The date that was entered. ** ** SIDE EFFECTS: ** ** none ** **-- **/ write_title_message: procedure (title); dcl title character(*) varying; /* The screen title to display */ dcl status fixed binary(31); /* The status returned from SMG */ %include smg$erase_display; %include smg$put_chars_highwide; %include smg$set_cursor_abs; /* * Erase the current display. */ status = smg$erase_display(display_id); check_status(status); /* * Write the title. */ status = smg$put_chars_highwide(display_id,title,2, divide(columns-2*length(title),2,31)+1,,SMG$M_BOLD); check_status(status); /* * Position the cursor two lines down. * month. */ status = smg$set_cursor_abs(display_id,5,1); check_status(status); end write_title_message; /* **++ ** FUNCTIONAL DESCRIPTION: ** ** This routine displays the name a date for a given event. ** ** FORMAL PARAMETERS: ** ** record_ptr : A pointer to the record to be displayed. ** bday_flag : True if birthday should be displayed. ** ** IMPLICIT INPUTS: ** ** display_id : The id number of the display ** columns : the number of columns on the screen ** ** IMPLICIT OUTPUTS: ** ** none ** ** RETURN VALUE: ** ** The date that was entered. ** ** SIDE EFFECTS: ** ** none ** **-- **/ write_date_line: procedure (record_ptr, bday_flag); dcl record_ptr pointer value; /* A pointer to the current record */ dcl bday_flag bit(1) aligned value; /* True if birthday is to be displayed */ dcl status fixed binary(31); /* The status returned from SMG */ dcl name character(NAME_SIZE); /* Name to display */ %include smg$put_line; /* * Build name. */ name = trim(record_ptr->name.first)||' '||trim(record_ptr->name.last); /* * Write the line with the date. */ if bday_flag then status = smg$put_line(display_id,name||record_ptr->birthdate.day||' '|| record_ptr->birthdate.month||' '||record_ptr->birthdate.year); else status = smg$put_line(display_id,name||record_ptr->anniversary.day||' '|| record_ptr->anniversary.month||' '||record_ptr->anniversary.year); check_status(status); end write_date_line; /* **++ ** FUNCTIONAL DESCRIPTION: ** ** This routine displays the specified message and instructions in reverse ** video in the center of the bottom of the screen. It then waits for the ** user to hit a key. ** ** FORMAL PARAMETERS: ** ** message : The message to display ** instr : Instructions to the user on the key to use ** keys : The number of choices of keys ** ** IMPLICIT INPUTS: ** ** display_id : The id number of the display ** columns : The number of columns on the screen ** rows : The number of rows on the screen ** ** IMPLICIT OUTPUTS: ** ** none ** ** RETURN VALUE: ** ** The key value of the key hit ** ** SIDE EFFECTS: ** ** none ** **-- **/ write_inquiry_message: procedure (message,instr,keys) returns(fixed binary(31)); dcl instr char(*) varying; /* The message telling the user what to do */ dcl message char(*) varying; /* The error message to display */ dcl status fixed binary(31); /* The status returned from SMG */ dcl keys fixed binary(31) value;/* The number of recognizable keys */ dcl key_value fixed binary(31); /* The key value of the selected key */ %include 'keys.pli'; %include smg$put_chars; %include smg$erase_line; /* * Write the message on line row-3. */ status = smg$put_chars(display_id,message,rows-2,divide(columns-length(message), 2,31)+1,,SMG$M_REVERSE); check_status(status); /* * Tell the user what to do. */ status = smg$put_chars(display_id,instr,rows, divide(columns-length(instr),2,31)+1,,SMG$M_REVERSE); check_status(status); /* * Let the user hit a key and determine its value. */ key_value = read_a_key(); select(key_value); when (SMG$K_TRM_ENTER) if keys >= ENTER_KEY then key_value = ENTER_KEY; else key_value = OTHER_KEY; when (SMG$K_TRM_KP0) if keys >= KP0_KEY then key_value = KP0_KEY; else key_value = OTHER_KEY; when (SMG$K_TRM_KP1) if keys >= KP1_KEY then key_value = KP1_KEY; else key_value = OTHER_KEY; otherwise key_value = OTHER_KEY; end; /* * Erase the message. */ status = smg$erase_line(display_id,rows-2); check_status(status); status = smg$erase_line(display_id,rows); check_status(status); return(key_value); end write_inquiry_message; /* **++ ** FUNCTIONAL DESCRIPTION: ** ** This routine displays the specified message in reverse video ** in the center of the bottom of the screen. ** ** FORMAL PARAMETERS: ** ** message : the message to display. ** ** IMPLICIT INPUTS: ** ** display_id : The id number of the display ** rows : the number of rows on the screen ** ** IMPLICIT OUTPUTS: ** ** none ** ** RETURN VALUE: ** ** none ** ** SIDE EFFECTS: ** ** none ** **-- **/ write_info_message: procedure (message); dcl message char(*) varying; /* The message to display */ dcl status fixed binary(31); /* The status returned from SMG */ %include smg$put_chars; /* * Delete the previous message. */ call erase_info_message; /* * Write the message on line row. */ status = smg$put_chars(display_id,message,rows,divide(columns-length(message), 2,31)+1,,SMG$M_REVERSE); check_status(status); end write_info_message; /* **++ ** FUNCTIONAL DESCRIPTION: ** ** This routine errases the information message written on the last row of ** the screen. ** ** FORMAL PARAMETERS: ** ** none ** ** IMPLICIT INPUTS: ** ** display_id : The id number of the display ** rows : the number of rows on the screen ** ** IMPLICIT OUTPUTS: ** ** none ** ** RETURN VALUE: ** ** none ** ** SIDE EFFECTS: ** ** none ** **-- **/ erase_info_message: procedure; dcl status fixed binary(31); /* The status returned from SMG */ %include smg$erase_line; /* * Erase the message. */ status = smg$erase_line(display_id,rows); check_status(status); end erase_info_message;