From dennis@peanuts.nosc.mil Wed Feb 17 15:50:15 1988 Date: Wed, 17 Feb 88 13:49:29 pst Subject: netlib submission: Apollo GONE Here is an updated version of the Apollo GONE program which you currently have in the library. The previous description still applies. --Dennis Dennis Cottel Naval Ocean Systems Center, San Diego, CA 92152 (619) 553-1645 dennis@nosc.MIL sdcsvax!noscvax!dennis #! /bin/sh # This is a shell archive, meaning: # 1. Remove everything above the #! /bin/sh line. # 2. Save the resulting text in a file. # 3. Execute the file with /bin/sh (not csh) to create the files: # readme # makeit # gone.hlp # gone.pas # gone.ins.pas # gone_routines.pas # This archive created: Wed Feb 17 13:44:16 1988 export PATH; PATH=/bin:$PATH echo shar: extracting "'readme'" '(1256 characters)' if test -f 'readme' then echo shar: will not over-write existing file "'readme'" else sed 's/^X//' << \SHAR_EOF > 'readme' XGONE PROGRAM NOTES $Date: 88/01/12 11:07:20 $ X XThis package contains routines to make the GONE program. X XWhen the user wants to leave the node unattended, the GONE routine borrows Xthe display, puts a message on the screen, and waits for the user to type Xa password. The user can specify the password and the message Xfont with a configuration file in the user's ~user_data directory. X XWhen compiling GONE_ROUTINES.PAS, you may need to change one of the Xconfiguration options (see MAKEIT): X X Use the SR9.2 option if you are compiling on a node running SR9.2 or X better. This allows checking for the DN3000, DN570, DN580, and other X newer display types. If the display type is unknown, parameters are X used that will work on all displays. X X Set the SR9.6 option for SR9.6 or newer versions of the operating system X to allow the program to disable the screen timeout while the message is X on the screen. X XPlease send me comments, bug fixes, or enhancements. In particular, we Xhave a rather limited hardware set so there may be cases for which this Xdoesn't work properly. X X Dennis Cottel X dennis@nosc.mil X sdcsvax!noscvax!dennis X 619-553-1645 X Code 635B X Naval Ocean Systems Center X San Diego, CA 92152-5000 SHAR_EOF if test 1256 -ne "`wc -c < 'readme'`" then echo shar: error transmitting "'readme'" '(should have been 1256 characters)' fi chmod +x 'readme' fi # end of overwriting check echo shar: extracting "'makeit'" '(282 characters)' if test -f 'makeit' then echo shar: will not over-write existing file "'makeit'" else sed 's/^X//' << \SHAR_EOF > 'makeit' X#!/com/sh X X# Compile and build the GONE program. X# Condensed from the Makefile for sites without RCS. X Xvon X X/com/pas gone.pas -comchk -dba -subchk -nopt X/com/pas gone_routines.pas -comchk -dba -subchk -nopt -config sr9.2 X/com/bind gone.bin gone_routines.bin -b gone X X SHAR_EOF if test 282 -ne "`wc -c < 'makeit'`" then echo shar: error transmitting "'makeit'" '(should have been 282 characters)' fi chmod +x 'makeit' fi # end of overwriting check echo shar: extracting "'gone.hlp'" '(2464 characters)' if test -f 'gone.hlp' then echo shar: will not over-write existing file "'gone.hlp'" else sed 's/^X//' << \SHAR_EOF > 'gone.hlp' XGONE -- Lock the node and leave a message on the screen. X XFORMAT X X GONE [ -i | message... ] X XARGUMENTS X X message All the arguments are displayed on the screen. X X -I Interactive mode. The program repeatedly solicits the X user for messages to leave on the screen. In this mode X the program can be left running in a window always X available for use. In addition, in this mode there are X no requirements to quote special characters and words X (see BUGS below). X XDESCRIPTION X X This program locks the node by taking over the screen and displaying X the given message. The user must type a password to terminate the X program. Programs running on the node continue to run until they X try to acquire the display (see BUGS below). X X To avoid damaging the screen, the program reverses the screen video X periodically. On pre-SR9.5 systems, this also prevents the screen X timout from hiding the message. On SR9.6 and later systems, the X program disables the screen timeout while the message is on the screen. X XCONFIGURATION X X To allow all users to have their own passwords, the program looks in X a configuration file called "~user_data/gone.config". The first X line of the file is the password. The second line is a full pathname X for the font to be used to display the message. If the configuration X file can't be found, then defaults are used. The default password X is a , and the default font name is "/sys/dm/fonts/std". X ___________________________________________________________________ X | | X | CAUTION: You should NOT use your "real" password -- the one that | X | you log into the Apollo or other computers with -- as this file | X | can be read by system administrators. | X |___________________________________________________________________| X XBUGS X X Programs which acquire the display (including those with Dialogue X interfaces) must wait until GONE terminates and releases the display. X X Certain words such as FOR in the message are caught by the Aegis shell X and can only be passed to GONE by enclosing them in double quotes ("). X Circumvent this by using the interactive mode. X XAUTHOR X X Dennis Cottel (dennis@nosc.mil) X Naval Ocean Systems Center, San Diego, CA X XIDENTIFICATION X X $Revision: 1.6 $ $Date: 88/01/12 11:00:04 $ SHAR_EOF if test 2464 -ne "`wc -c < 'gone.hlp'`" then echo shar: error transmitting "'gone.hlp'" '(should have been 2464 characters)' fi chmod +x 'gone.hlp' fi # end of overwriting check echo shar: extracting "'gone.pas'" '(4265 characters)' if test -f 'gone.pas' then echo shar: will not over-write existing file "'gone.pas'" else sed 's/^X//' << \SHAR_EOF > 'gone.pas' X{[r+,b+,o=80] pasmat options} X XPROGRAM gone_program; X X{ $Header: //pumpkin_patch/local/source/gone/gone.pas,v 1.5 88/01/12 10:03:52 dennis Exp $ } X X {This program locks the user's node with a message on the screen X and waits for the user to enter a password. X X Written by: X Dennis Cottel (dennis@nosc.mil) X Naval Ocean Systems Center, San Diego, CA } X X %nolist; X %include '/sys/ins/base.ins.pas'; X %include '/sys/ins/error.ins.pas'; X %include '/sys/ins/pgm.ins.pas'; X %list; X X %include 'gone.ins.pas'; X X CONST X max_args = 20; X X VAR X {force RCS string to be embedded in code} X ident: string_t := X'$Header: //pumpkin_patch/local/source/gone/gone.pas,v 1.5 88/01/12 10:03:52 dennis Exp $' X ; X X status: status_$t; X X msg: string_t; {assembled message to send to gone} X msg_len: pinteger; {chars in the message} X X X PROCEDURE check( IN str: string); X X {Prints an error message and terminates the program on bad status.} X X BEGIN X IF status.all <> status_$ok THEN X BEGIN X writeln('** Error in Gone ** :', str); X error_$print(status); X pgm_$exit; X END {not ok} ; X END {check} ; X X X PROCEDURE init(OUT ok: boolean; X OUT interactive: boolean); X X {Get arguments from command line. If none are given, print X a usage note.} X X VAR X nargs: pinteger; {number of program arguments counting program name} X arg_vector: pgm_$argv_ptr; {pointer to the arguments - ignored here} X ax: pinteger; {argument index} X arg: string_t; {value of an argument} X arg_len: integer; {length of an argument} X cx: integer; {character index} X X BEGIN X ok := true; X interactive := false; X pgm_$get_args(nargs, arg_vector); {how many arguments given?} X IF nargs = 1 THEN {usage note} X BEGIN X ok := false; X writeln('Usage: gone [-i | message...]'); X writeln(' -i = interactive'); X END {usage note} X ELSE IF nargs = 2 THEN {one argument, may be -i option} X BEGIN X arg_len := pgm_$get_arg(1, arg, status, max_string); X check('pgm_$get_arg'); X interactive := (arg_len = 2) AND (arg[1] = '-') AND (arg[2] IN ['i', X 'I']); X END {one argument given, check for -i option} ; X IF ok AND NOT interactive THEN {assemble arguments into message} X BEGIN X msg_len := 0; X FOR ax := 1 TO nargs - 1 DO {copy each argument} X BEGIN X IF ax <> 1 THEN {stick in a space before next argument} X BEGIN X msg_len := msg_len + 1; X msg[msg_len] := ' '; X END {add a space} ; X arg_len := pgm_$get_arg(ax, arg, status, max_string); X check('pgm_$get_arg'); X FOR cx := 1 TO arg_len DO {copy each character} X BEGIN X msg_len := msg_len + 1; X msg[msg_len] := arg[cx]; X END {copy chars} ; X END {copy each arg} ; X END {assemble args} ; X END; {init} X X X PROCEDURE get_msg(VAR done: boolean); X X {Interactively solicits the message from the user. This routine X insists on a non-blank message. The message is placed in the X global variables 'msg' and 'msg_len'. An EOF will terminate X the program.} X X VAR X c: char; X X BEGIN X REPEAT X write('Enter message: '); X msg_len := 0; X done := eof; {quit when user enters EOF} X IF NOT done THEN X BEGIN X WHILE NOT eoln DO X BEGIN X read(c); X msg_len := msg_len + 1; X msg[msg_len] := c; X END {not eoln} ; X readln; X END {not done} ; X UNTIL (msg_len <> 0) OR done; X END {get_msg} ; X X X PROCEDURE main_program; X X VAR X ok: boolean; {program arguments were ok} X interactive: boolean; {solicit messages from user} X done: boolean; {user entered EOF in interactive mode} X X BEGIN X init(ok, interactive); X IF ok THEN X IF NOT interactive THEN gone(msg, msg_len) X ELSE {interactive mode} X REPEAT X get_msg(done); X IF NOT done THEN gone(msg, msg_len); X UNTIL done; X END {main_program} ; X X BEGIN X main_program X END {gone_program} . SHAR_EOF if test 4265 -ne "`wc -c < 'gone.pas'`" then echo shar: error transmitting "'gone.pas'" '(should have been 4265 characters)' fi chmod +x 'gone.pas' fi # end of overwriting check echo shar: extracting "'gone.ins.pas'" '(397 characters)' if test -f 'gone.ins.pas' then echo shar: will not over-write existing file "'gone.ins.pas'" else sed 's/^X//' << \SHAR_EOF > 'gone.ins.pas' X{[r+,b+,o=80] pasmat options} X X{ $Header: //pumpkin_patch/local/source/gone/gone.ins.pas,v 1.2 86/08/10 11:17:00 dennis Exp $ } X X{These are definitions for the Gone program module.} X XCONST X max_string = 256; X XTYPE X string_t = PACKED ARRAY [1..max_string] OF char; X X XPROCEDURE gone(msg: string_t; {message to display on screen} X msg_len: integer); {length of the message} X EXTERN; SHAR_EOF if test 397 -ne "`wc -c < 'gone.ins.pas'`" then echo shar: error transmitting "'gone.ins.pas'" '(should have been 397 characters)' fi chmod +x 'gone.ins.pas' fi # end of overwriting check echo shar: extracting "'gone_routines.pas'" '(20447 characters)' if test -f 'gone_routines.pas' then echo shar: will not over-write existing file "'gone_routines.pas'" else sed 's/^X//' << \SHAR_EOF > 'gone_routines.pas' X{[r+,b+,o=80] pasmat options} X XMODULE gone_routines; X X {These routines implement the "gone" command.} X X {When the user wants to leave the node unattended, the gone routine borrows X the display, puts a message on the screen, and waits for the user to type X a password. X X To make this flexible, the user can specify the password and the message X font with a configuration file. This file is in the user's ~user_data X directory. The first line is a password, the second is a font pathname. X If not available, the password defaults to just a , and the X font pathname defaults to a standard. X X To avoid damaging the screen, it is switched to reverse video and back X occasionally. On pre-SR9.5 systems, this has the nice side effect of X defeating the screen timeout so the message is always visible. On X systems after SR9.6, the screen timeout is disabled by the program during X the time the message is on the screen. X X Written by: X Dennis Cottel (dennis@nosc.mil) X Naval Ocean Systems Center, San Diego, CA } X X {allow DN3000, DN570/DN580 displays, call to gpr_$inq_display_characteristics} X %var sr9.2; X X {use SR9.6 calls to disable screen timeout} X %var sr9.6; X X %nolist; X %include '/sys/ins/base.ins.pas'; X %include '/sys/ins/pad.ins.pas'; X %include '/sys/ins/error.ins.pas'; X %include '/sys/ins/streams.ins.pas'; X %include '/sys/ins/time.ins.pas'; X %include '/sys/ins/ec2.ins.pas'; X %include '/sys/ins/pm.ins.pas'; X %include '/sys/ins/pgm.ins.pas'; X %include '/sys/ins/gpr.ins.pas'; X %include '/sys/ins/kbd.ins.pas'; X %include '/sys/ins/fault.ins.pas'; X %include '/sys/ins/smdu.ins.pas'; X %list; X X DEFINE X gone; X X %include 'gone.ins.pas'; X X{*--------------------* X | local declarations | X *--------------------*} X X CONST X config_file_name = '/user_data/gone.config'; {relative to home directory} X config_file_name_len = 22; {chars in configuration file name} X X default_font_path = '/sys/dm/fonts/std'; X default_font_path_len = 17; {chars in default font path} X X VAR X {force RCS string to be embedded in code} X ident: string_t := X'$Header: //pumpkin_patch/local/source/gone/gone_routines.pas,v 1.15 88/01/12 10:44:23 dennis Exp $' X ; X X debug: boolean := false; {use VAR not CONST to avoid warnings} X status: status_$t; X X password: string_t; {password read from configuration file} X password_len: pinteger; {length of password string} X X font_path: string_t; {font path from configuration file} X font_path_len: pinteger; {length of font path name} X X font_id: integer; {identifying id for the display font} X vert_spacing: integer; {pixels between lines of the message} X need_a_space: boolean; {insert space before word if true} X X screen_bitmap: gpr_$bitmap_desc_t; {unique descriptor for screen bitmap} X max_screen_x, max_screen_y: integer; {actual size of display} X save_timeout: time_$clock_t; {original screen timeout value} X X{*-------------------* X | Internal Routines | X *-------------------*} X X X PROCEDURE check( IN str: string_t); X INTERNAL; X X {Prints an error message and terminates the program on bad status.} X X BEGIN X IF status.all <> status_$ok THEN X BEGIN X writeln('** Error in Gone ** :', str); X error_$print(status); X pgm_$exit; X END {not ok} ; X END {check} ; X X{*-------------------------* X | Initialization routines | X *-------------------------*} X X X PROCEDURE read_config_file; X X {This reads the user's "gone" configuration file for two parameters. X The first is a password for resuming the program, and the second X is a path name for the font to use when displaying the message. X X If for some reason either of the two parameters can't be found, X then we use the defaults.} X X VAR X home: string_t; {path to user's home directory} X home_len: pinteger; {length of home directory path} X cfile: text; X open_status: integer32; {returned from OPEN call} X no_password, no_font: boolean; X i: pinteger; X temp: string_t; {needed to copy the string constant} X X BEGIN X pm_$get_home_txt(max_string, home, home_len); X IF debug THEN writeln('home directory is "', home: home_len, '"'); X temp := config_file_name; {trick to allow one-at-a-time char copying} X FOR i := 1 TO config_file_name_len DO {append to home directory} X home[home_len + i] := temp[i]; X home_len := home_len + config_file_name_len; X home[home_len + 1] := ' '; {needed for OPEN to work} X IF debug THEN writeln('config file name is "', home: home_len, '"'); X X open(cfile, home, 'OLD', open_status); X IF open_status <> 0 THEN {no configuration file} X BEGIN X IF debug THEN writeln('gone config file not found'); X no_password := true; X no_font := true; X END {no config file} X ELSE {read the config file} X BEGIN X reset(cfile); X X IF eof(cfile) THEN no_password := true X ELSE {read the password} X BEGIN X i := 0; X WHILE NOT eoln(cfile) DO X BEGIN X i := i + 1; X read(cfile, password[i]); X END {while not eoln} ; X readln(cfile); X password_len := i; X no_password := false; X END {read the password} ; X IF debug THEN X BEGIN X write('password: "'); X FOR i := 1 TO password_len DO X write(password[i]); X writeln('"'); X END {debug} ; X X IF eof(cfile) THEN no_font := true X ELSE {read the font path} X BEGIN X i := 0; X WHILE NOT eoln(cfile) DO X BEGIN X i := i + 1; X read(cfile, font_path[i]); X END {while not eoln} ; X readln(cfile); X font_path_len := i; X no_font := false; X END {read the font path} ; X IF debug THEN X BEGIN X write('fontpath: "'); X FOR i := 1 TO font_path_len DO X write(font_path[i]); X writeln('"'); X END {debug} ; X END {read the config file} ; X close(cfile); X X IF no_password THEN {use default password} X BEGIN X password := ''; X password_len := 0; X END {use default password} ; X IF no_font THEN {use default font} X BEGIN X font_path := ''; X font_path_len := 0; X END {use default font} ; X END {read_config_file} ; X X X PROCEDURE set_screen_size; X X {Find out what display type is in use and set the global variables X describing the maximum screen size. The values max_screen_x and X max_screen_y actually represent the largest allowed value, not the X total size.} X X VAR X disp: gpr_$disp_char_t; X disp_len: integer16; X X {pre-sr9.2} X config: gpr_$display_config_t; X x, y: integer; X X BEGIN X %IF sr9.2 %THEN; X gpr_$inq_disp_characteristics(gpr_$borrow, 1, 56, disp, disp_len, status); X check('gpr_$inq_disp_characteristics'); X max_screen_x := disp.x_window_size - 1; X max_screen_y := disp.y_window_size - 1; X IF debug THEN X WITH disp DO X writeln('window_size: ', x_window_size: 1, ', ', y_window_size: 1); X X %ELSE; {pre-sr9.2} X gpr_$inq_config(config, status); X check('gpr_$inq_config'); X CASE config OF X X { black and white displays } X X gpr_$bw_800x1024: X BEGIN X x := 800; X y := 1024; X END; X gpr_$bw_1024x800: X BEGIN X x := 1024; X y := 800; X END; X X { color displays } X X gpr_$color_1024x1024x4, gpr_$color_1024x1024x8: X BEGIN X x := 1024; X y := 1024; X END; X gpr_$color_1024x800x4, gpr_$color_1024x800x8: X BEGIN X x := 1024; X y := 800; X END; X X OTHERWISE {assume the worst} X BEGIN X x := 800; X y := 800; X END; X END {case} ; X max_screen_x := x - 1; X max_screen_y := y - 1; X %ENDIF; {sr9.2} X X END {set_screen_size} ; X X X PROCEDURE set_vert_spacing; X INTERNAL; X X {Since we don't know what font will be used for the message, we X go through all the printable characters looking for the biggest.} X X CONST X min_chr = 32; {space} {first printing character in ASCII} X max_chr = 126; {~} {last printing character in ASCII} X X VAR X str: PACKED ARRAY [1..1] OF char; X size: gpr_$offset_t; {x_size, y_size} X i: integer; X max_y_size: integer; X X BEGIN X max_y_size := 0; X FOR i := min_chr TO max_chr DO X BEGIN X str[1] := chr(i); X gpr_$inq_text_extent(str, 1, size, status); X check('from gpr_$inq_text_extent in set_vert_spacing'); X IF size.y_size > max_y_size THEN max_y_size := size.y_size; X END; X vert_spacing := round(1.4 * max_y_size); X END; {set_vert_spacing} X X X PROCEDURE pad_init; X INTERNAL; X X VAR X mode: gpr_$display_mode_t; {borrow, direct, frame, etc} X unit: stream_$id_t; {stream id of window for frame mode otherwise 1} X size: gpr_$offset_t; {size of initial bitmap} X hi_plane_id: gpr_$plane_t; {highest bit plane} X text_color: gpr_$pixel_value_t; {drawing color for text} X timeout: time_$clock_t; {for turning off screen timeout} X X BEGIN X set_screen_size; X mode := gpr_$borrow; X unit := 1; {use 1 for frame mode} X hi_plane_id := 0; X size.x_size := max_screen_x + 1; X size.y_size := max_screen_y + 1; X gpr_$init(mode, unit, size, hi_plane_id, screen_bitmap, status); X check('gpr_$init'); X X %IF sr9.6 %THEN; X {disable screen timeout} X X gpr_$inq_blank_timeout(save_timeout, status); {save original value} X check('gpr_$inq_blank_timeout'); X timeout.high16 := 0; X timeout.low32 := 0; X gpr_$set_blank_timeout(timeout, status); {turn timeout off} X check('gpr_$set_blank_timeout'); X %ENDIF; {sr9.6} X X {set up the fonts} X X gpr_$load_font_file(font_path, font_path_len, font_id, status); X IF status.all <> status_$ok THEN {user's font not found - use default} X gpr_$load_font_file(default_font_path, default_font_path_len, font_id, X status); X check('gpr_$load_font_file'); X gpr_$set_text_font(font_id, status); X check('gpr_$set_text_font'); X X {set up color table so both black and white and color use white letters} X X text_color := 1; {always use color table location 1 for text} X gpr_$set_text_value(text_color, status); X check('gpr_$set_text_value'); X gpr_$set_color_map(1 {start} , 1 {how many slots} , gpr_$white, status); X check('gpr_$set_color_map'); X X set_vert_spacing; X X need_a_space := false; X gpr_$move(0, 2 * vert_spacing, status); {leave a blank line at top} X check('gpr_$move in pad_init'); X X END; {pad_init} X X X PROCEDURE initialize; X INTERNAL; X X BEGIN X read_config_file; X pad_init; X END {initialize} ; X X{*----------------------* X | Termination routines | X *----------------------*} X X X PROCEDURE pad_fin; X INTERNAL; X X VAR X delete_display: boolean; {ignored in borrow mode} X X BEGIN X %IF sr9.6 %THEN; X gpr_$set_blank_timeout(save_timeout, status); {restore original value} X check('gpr_$set_blank_timeout'); X %ENDIF; {sr9.6} X delete_display := false; X gpr_$terminate(delete_display, status); X check('gpr_$terminate'); X END {pad_fin} ; X X X PROCEDURE finalize; X INTERNAL; X X BEGIN X pad_fin; X END {finalize} ; X X{*---------------------------------------* X | Routines to handle text on the screen | X *---------------------------------------*} X X X PROCEDURE get_word( IN msg: string_t; {source of the message} X IN msg_len: pinteger; {total length of the message} X IN OUT cursor: pinteger; {current location in msg} X OUT word: string_t; {resulting word} X OUT word_len: pinteger {chars in resulting word} ); X X {Find the next space-separated word in the input message. Start X with the current cursor position and skip over leading blanks.} X X BEGIN X word_len := 0; X WHILE (msg[cursor] = ' ') AND (cursor <= msg_len) DO {skip spaces} X cursor := cursor + 1; X WHILE (msg[cursor] <> ' ') AND (cursor <= msg_len) DO {get chars} X BEGIN X word_len := word_len + 1; X word[word_len] := msg[cursor]; X cursor := cursor + 1; X END {while - pick up chars in word} X END {get_word} ; X X X PROCEDURE new_line; X INTERNAL; X X {Start a new line on the display.} X X VAR X x, y: gpr_$coordinate_t; {current position - 2 byte integer} X X BEGIN X gpr_$inq_cp(x, y, status); {find the current bitmap position} X check('gpr_$inq_cp'); X y := y + vert_spacing; X IF (y + vert_spacing) > max_screen_y THEN y := vert_spacing; X gpr_$move(0, y, status); X check('gpr_$move in new_line'); X need_a_space := false; X END {new_line} ; X X X PROCEDURE wrt_word( IN str: string_t; X IN len: integer); X INTERNAL; X X {Write a word of text to the screen. It is supposed to stay X together, so if it won't fit, start on a new line.} X X VAR X spacesize: integer; {width of a space} X size: gpr_$offset_t; {size of text lump - x_size, y_size} X x, y: gpr_$coordinate_t; {current position - 2 byte integer} X X BEGIN X IF debug THEN writeln('wrt_word'); X gpr_$inq_space_size(font_id, spacesize, status); {find the space size} X check('gpr_$inq_space_size'); X gpr_$inq_text_extent(str, len, size, status); {find the word size} X check('gpr_$inq_text_extent'); X gpr_$inq_cp(x, y, status); {find the current bitmap position} X check('gpr_$inq_cp'); X IF NOT need_a_space THEN spacesize := 0; X IF (x + spacesize + size.x_size) > max_screen_x THEN new_line; {too big X to fit} X IF need_a_space THEN {add a space} X BEGIN X x := x + spacesize; X gpr_$move(x, y, status); X check('gpr_$move for a space'); X END {add a space} ; X gpr_$text(str, len, status); {write the text to the screen} X check('wrt_str'); X need_a_space := true; {next time, space first} X END {wrt_word} ; X X X PROCEDURE display_message(msg: string_t; X msg_len: pinteger); X INTERNAL; X X {Display the given message on the screen.} X X VAR X cursor: pinteger; {current position in string} X word: string_t; X word_len: pinteger; X X BEGIN X IF debug THEN writeln('display_message()'); X cursor := 1; X WHILE cursor <= msg_len DO {do something with each character} X BEGIN X get_word(msg, msg_len, cursor, word, word_len); X wrt_word(word, word_len); X END {while < msg_len} ; X END {display_message} ; X X{*--------------------------------* X | Routines to get keyboard input | X *--------------------------------*} X X X PROCEDURE invert_screen; X X {To protect the screen if the message is left for a long time, X invert all the pixels. This routine assumes that the background X color is position zero in the color table, and the text is written X using location one in the color table. X X In order for this to properly protect the screen, each pixel must be X completely off half the time, so the color values must be restricted X to those which completely turn a color pixel on or off, and the X background and foreground color values must not contain the same X color pixel.} X X VAR X color_table: gpr_$color_vector_t; X temp: gpr_$pixel_value_t; X X BEGIN X gpr_$inq_color_map(0, 2, color_table, status); X check('gpr_$inq_color_map'); X temp := color_table[0]; X color_table[0] := color_table[1]; X color_table[1] := temp; X gpr_$set_color_map(0, 2, color_table, status); X check('gpr_$set_color_map'); X END {invert_screen} ; X X X PROCEDURE get_keyboard(OUT c: char); X INTERNAL; X X {Wait for an event from either the keyboard or the timer. If the event X is a valid keystroke, return the character. If it is a timer event, then X reverse the screen video.} X X CONST X time_ec = 1; {event index for timeout} X keys_ec = 2; {event index for keyboard (from GMR)} X wait_time = 30; {seconds desired} {reverse video interval} X X VAR X ec2_ptr: ARRAY [1..2] OF ec2_$ptr_t; {event count pointers} X ec2_val: ARRAY [1..2] OF integer32; {event count trigger values} X which: integer; {which of the two event types occurred} X got_a_char: boolean; {true when a char came in from keyboard} X X unobscured: boolean; X position: gpr_$position_t; X event_type: gpr_$event_t; X X BEGIN X time_$get_ec(time_$clockh_key, ec2_ptr[time_ec], status); X check('time_$get_ec'); X gpr_$get_ec(gpr_$input_ec, ec2_ptr[keys_ec], status); X check('gpr_$get_ec'); X X ec2_val[time_ec] := ec2_$read(ec2_ptr[time_ec]^) + wait_time * 4; X ec2_val[keys_ec] := ec2_$read(ec2_ptr[keys_ec]^); X X gpr_$enable_input(gpr_$keystroke, [chr(0)..chr(16), chr(17), X chr(18)..chr(127), kbd_$f1..kbd_$f8, kbd_$bs, kbd_$cr, X kbd_$tab], status); X check('gpr_$enable_input'); X X got_a_char := false; X REPEAT X which := ec2_$wait(ec2_ptr, ec2_val, 2 {entries} , status); X check('ec2_$wait'); X CASE which OF X time_ec: {timed out - reverse the video} X BEGIN X ec2_val[time_ec] := ec2_$read(ec2_ptr[time_ec]^) + wait_time * 4; X invert_screen; X IF debug THEN writeln('timeout event'); X END {timeout event} ; X keys_ec: {looks like a keyboard entry} X BEGIN X ec2_val[keys_ec] := ec2_$read(ec2_ptr[keys_ec]^) + 1; X unobscured := gpr_$cond_event_wait(event_type, c, position, status); X got_a_char := (event_type = gpr_$keystroke); X IF debug THEN writeln('key event, got_a_char =', got_a_char); X END {keyboard event} ; X END {case} ; X UNTIL got_a_char; X END; {get_keyboard} X X X PROCEDURE wait_for_password; X INTERNAL; X X {Read characters from the keyboard and test that they match the X password read from the user's configuration file. Backspaces X work to delete the previously entered character, and a X starts over.} X X CONST X bs = 8; {ascii back space} X cr = 13; {ascii carriage return} X tab = 9; {ascii tab} X X VAR X c_kbd: char; {character read from keyboard} X str: string_t; {assemble trial password from user} X str_l: integer; {length of trial password} X good_pwd: boolean; {true when trial matches user's password} X i: integer; X X BEGIN {wait_for_password} X IF debug THEN writeln('wait_for_password()'); X str_l := 0; X good_pwd := false; X X {disable quit character altogether for as long as we're in borrow mode} X smd_$set_quit_char(chr(0), status); X check('smd_$set_quit_char'); X X REPEAT X get_keyboard(c_kbd); X IF c_kbd = kbd_$bs THEN c_kbd := chr(bs) X ELSE IF c_kbd = kbd_$cr THEN c_kbd := chr(cr) X ELSE IF c_kbd = kbd_$tab THEN c_kbd := chr(tab); X IF c_kbd = chr(cr) THEN X BEGIN X IF str_l = password_len THEN X BEGIN X i := 1; X WHILE (i <= password_len) AND (str[i] = password[i]) DO X i := i + 1; X IF (i - 1) = password_len THEN good_pwd := true; X END; X str_l := 0; X END X ELSE IF c_kbd = chr(bs) THEN X BEGIN X str_l := str_l - 1; X IF str_l < 0 THEN str_l := 0; X END X ELSE X BEGIN X str_l := str_l + 1; X IF str_l > max_string THEN str_l := max_string; X str[str_l] := c_kbd; X END; X UNTIL good_pwd; X END; {wait_for_password} X X{*---------------* X | entry routine | X *---------------*} X X X PROCEDURE gone { (msg: string_t; msg_len: pinteger) } ; X X {This is called when the user wants to leave the node unattended X for a time.} X X BEGIN X IF debug THEN writeln('gone()'); X initialize; X display_message(msg, msg_len); X wait_for_password; X finalize; X END {gone} ; X X {END MODULE gone_routines} SHAR_EOF if test 20447 -ne "`wc -c < 'gone_routines.pas'`" then echo shar: error transmitting "'gone_routines.pas'" '(should have been 20447 characters)' fi chmod +x 'gone_routines.pas' fi # end of overwriting check # End of shell archive exit 0