module CRT (main = PROCESS) = begin ! of CRT ! ! Author: Robert Adam II ! Written at: University of New Orleans ! Computer Research Center ! New Orleans, Louisiana 70148 ! ! Command type: define as a foreign command ! Link: LINK crt,myio ! Privileges: none needed ! require 'TUTIO.R32'; library 'SYS$LIBRARY:TPAMAC'; external literal MAX_CHANNEL, INPUT, OUTPUT, APPEND, SUCCESS, FAILURE; external routine FILE_EXISTS : addressing_mode( general ), OPEN_THE_FILE : addressing_mode( general ), CLOSE_THE_FILE : addressing_mode( general ), READ_FROM : addressing_mode( general ), scr$erase_line : addressing_mode( general ), scr$erase_page : addressing_mode( general ), scr$set_cursor : addressing_mode( general ), scr$put_screen : addressing_mode( general ), lib$tparse : addressing_mode( general ), lib$get_input : addressing_mode( general ), lib$put_output : addressing_mode( general ), lib$get_foreign : addressing_mode( general ), str$trim : addressing_mode( general ), str$upcase : addressing_mode( general ), str$copy_dx : addressing_mode( general ), lbr$output_help : addressing_mode( general ); ! Macros to make the TPARSE control block addressable as a block through ! the argument pointer macro TPARSE_ARGS = builtin AP; map AP : ref block [,byte]; %; bind MORE_TEXT_MESSAGE = $descriptor('< More text available; Space for more, S to stop listing >'); own FILENAME_BUF : vector[ 132, byte ], FILENAME_DESC : vector[ 2, long ] initial( 132, FILENAME_BUF ), INPUT_BUFFER : vector[ 132, byte ], INPUT_DESC : vector[ 2, long ] initial( 132, INPUT_BUFFER ), INPUT_LENGTH, COMMAND_BUFFER : vector[ 132, byte ], COMMAND_DESC : vector[ 2, long ] initial( 132, COMMAND_BUFFER ), START_LINE, NUMBER_OF_PAGES, WHOLE_FILE, NO_END, WAIT_ON; bind FILESPEC_PTR = ch$ptr( FILENAME_BUF ); ! TPARSE parameter block own TPARSE_BLOCK : block[ tpa$k_length0, byte ] initial( tpa$k_count0, ! Longword count tpa$m_abbrev ! Allow abbreviation ); forward routine ILLEGAL_START_LINE, ILLEGAL_NUMBER_PAGES, MAX_PARAM_EXCEEDED, ILLEGAL_FILESPEC, STORE_FILESPEC, SET_WHOLE_FILE, SET_NO_END; ! Initialize the TPARSE state tables $init_state( RANGE_STATE_TABLE, RANGE_KEY_TABLE ); ! $state( RANGE_LINE, ( (FILESPEC), FIRST_LINE, STORE_FILESPEC ), ( tpa$_lambda, tpa$_fail, ILLEGAL_FILESPEC ) ); $state( FIRST_LINE, ( tpa$_decimal, HOW_MANY,,, START_LINE ), ( tpa$_eos, tpa$_exit, SET_WHOLE_FILE ), ( tpa$_lambda, tpa$_fail, ILLEGAL_START_LINE ) ); $state( HOW_MANY, ( tpa$_decimal, , ,, NUMBER_OF_PAGES ), ( tpa$_eos, tpa$_exit, SET_NO_END ), ( tpa$_lambda, tpa$_fail, ILLEGAL_NUMBER_PAGES ) ); $state( , ( tpa$_eos, tpa$_exit ), ( tpa$_lambda, tpa$_fail, MAX_PARAM_EXCEEDED ) ); ! $state( FILESPEC, ( tpa$_blank, FILESPEC2 ), ( tpa$_lambda, FILESPEC2 ) ); $state( FILESPEC2, ( tpa$_blank, tpa$_exit ), ( tpa$_any, FILESPEC2 ), ( tpa$_eos, tpa$_exit ) ); routine ILLEGAL_START_LINE = begin ! of ILLEGAL_START_LINE lib$put_output( $descriptor('%RANGE-W-ILLSTART, illegal value for starting line number.') ); return 1; end; ! of ILLEGAL_START_LINE routine ILLEGAL_NUMBER_PAGES = begin ! of ILLEGAL_NUMBER_PAGES lib$put_output( $descriptor('%RANGE-W-ILLNUMPAG, illegal value for number of pages.') ); return 1; end; ! of ILLEGAL_NUMBER_PAGES routine ILLEGAL_FILESPEC = begin ! of ILLEGAL_FILESPEC lib$put_output( $descriptor('%RANGE-W-ILLFILSPEC, illegal file specification.') ); return 1; end; ! of ILLEGAL_FILESPEC routine MAX_PARAM_EXCEEDED = begin ! of MAX_PARAM_EXCEEDED lib$put_output( $descriptor('%RANGE-W-TOOMANYPARAM, too many parameters.') ); return 1; end; ! of MAX_PARAM_EXCEEDED routine SET_WHOLE_FILE = begin ! of SET_WHOLE_FILE WHOLE_FILE = TRUE; return TRUE; end; ! of SET_WHOLE_FILE routine SET_NO_END = begin ! of SET_NO_END NO_END = TRUE; return TRUE; end; ! of SET_NO_END routine STORE_FILESPEC = begin ! of STORE_FILESPEC TPARSE_ARGS; TPARSE_BLOCK[ tpa$v_blanks ] = 0; ! turn off TPARSE space processing FILENAME_DESC[ 1 ] = FILENAME_BUF; ch$move( .ap[ tpa$l_tokencnt ], ch$ptr( .ap[ tpa$l_tokenptr ] ), FILESPEC_PTR ); FILENAME_DESC[ 0 ] = .ap[ tpa$l_tokencnt ]; if FILE_EXISTS( FILENAME_DESC ) then return TRUE else ( lib$put_output( $descriptor('%RANGE-W-NOFILE, file does not exist.') ); return FALSE; ); end; ! of STORE_FILESPEC routine SCR_INVERS_SCREEN( LINE_NUM, COLUMN_NUM, CONTROL_DESC_ADR, PARAM1, PARAM2, PARAM3, PARAM4 ) : novalue = begin ! of SCR_INVERS_SCREEN own OUTPUT_BUFFER : vector[ 132, byte ], OUTPUT_DESC : vector[ 2, long ], LENGTH : word; OUTPUT_DESC[ 0 ] = 132; OUTPUT_DESC[ 1 ] = OUTPUT_BUFFER; $fao( .CONTROL_DESC_ADR, LENGTH, OUTPUT_DESC, .PARAM1, .PARAM2, .PARAM3, .PARAM4 ); OUTPUT_DESC[ 0 ] = .LENGTH; scr$put_screen( OUTPUT_DESC, .LINE_NUM, .COLUMN_NUM, 2 ); end; ! of SCR_INVERS_SCREEN routine SCR_OUTPUT_SCREEN( LINE_NUM, COLUMN_NUM, CONTROL_DESC_ADR, PARAM1, PARAM2, PARAM3, PARAM4 ) : novalue = begin ! of SCR_OUTPUT_SCREEN own OUTPUT_BUFFER : vector[ 132, byte ], OUTPUT_DESC : vector[ 2, long ], LENGTH : word; OUTPUT_DESC[ 0 ] = 132; OUTPUT_DESC[ 1 ] = OUTPUT_BUFFER; $fao( .CONTROL_DESC_ADR, LENGTH, OUTPUT_DESC, .PARAM1, .PARAM2, .PARAM3, .PARAM4 ); OUTPUT_DESC[ 0 ] = .LENGTH; scr$put_screen( OUTPUT_DESC, .LINE_NUM, .COLUMN_NUM, 0 ); end; ! of SCR_OUTPUT_SCREEN routine WINDOW_ERASE( STARTING_LINE, ENDING_LINE ) : novalue = begin ! of WINDOW_ERASE if .ENDING_LINE geq 24 then ! this is an erase to end-of-page so use scr$erase_page scr$erase_page( .STARTING_LINE, 1 ) else ! this is an area which does not extend to the end-of-page !so erase line by line incr I from .STARTING_LINE to .ENDING_LINE do scr$erase_line( .I, 1 ); end; ! of WINDOW_ERASE routine TYPE_THE_FILE( FILE_NAME_DESC, CHANNEL, STARTING_LINE, NUMBER_OF_LINES ) : novalue = begin ! of TYPE_THE_FILE map FILE_NAME_DESC : ref vector[ 2, long ]; own INPUT_BUFFER : vector[ 132, byte ], INPUT_DESC : vector[ 2, long ] initial( 132, INPUT_BUFFER ); bind INPUT_PTR = ch$ptr(INPUT_BUFFER); local LINE_PRINTED, INCREMENT, COUNT, PAGE_NUM_POS, LINE_NUM_POS, PAGE_NUMBER, DONE, TEMP_CHAR, ENDING_LINE, LINE_NUM, LENGTH; ENDING_LINE = .STARTING_LINE + .NUMBER_OF_LINES - 1; WINDOW_ERASE( .STARTING_LINE, .ENDING_LINE ); PAGE_NUMBER = 1; COUNT = 0; scr$erase_line( 1,1 ); SCR_INVERS_SCREEN( 1, 1, $descriptor('!#< File: !AS!>'), .PAGE_WIDTH, .FILE_NAME_DESC ); PAGE_NUM_POS = .PAGE_WIDTH - 8; LINE_NUM_POS = .PAGE_NUM_POS - 15; SCR_INVERS_SCREEN( 1, .LINE_NUM_POS, $descriptor('Top line:!SL'), 1 ); SCR_INVERS_SCREEN( 1, .PAGE_NUM_POS, $descriptor('Page:!SL'), .PAGE_NUMBER ); OPEN_THE_FILE( %( on this )% .CHANNEL, ch$ptr( .FILE_NAME_DESC[ 1 ] ), .FILE_NAME_DESC[ 0 ], INPUT ); LINE_NUM = .STARTING_LINE; DONE = FALSE; LINE_PRINTED = FALSE; while ( LENGTH = READ_FROM( %( channel )% .CHANNEL, 132, INPUT_PTR ) ) geq 0 and ((.NUMBER_OF_PAGES gtr 0) or .NO_END or .WHOLE_FILE ) and not .DONE do ( COUNT = .COUNT + 1; if (.LINE_NUM eql .ENDING_LINE) and .WAIT_ON then ( if .NUMBER_OF_PAGES gtr 0 then NUMBER_OF_PAGES = .NUMBER_OF_PAGES - 1; if (.NUMBER_OF_PAGES gtr 0) or .NO_END or .WHOLE_FILE then ( SCR_INVERS_SCREEN( .LINE_NUM, 1, $descriptor('!#< !AS!>'), .PAGE_WIDTH, MORE_TEXT_MESSAGE ); selectone tty_timed_get_char( 120 %( seconds )% ) of set [ %c's', %c'S' ] : ! stop the listing DONE = TRUE; [ otherwise ] : ( LINE_NUM = .STARTING_LINE; WINDOW_ERASE( .STARTING_LINE, .ENDING_LINE ); PAGE_NUMBER = .PAGE_NUMBER + 1; SCR_INVERS_SCREEN( 1, .PAGE_NUM_POS, $descriptor('Page:!SL'), .PAGE_NUMBER ); SCR_INVERS_SCREEN( 1, .LINE_NUM_POS, $descriptor('Top line:!SL'), .COUNT ); ); tes; ); ); if not .DONE and ((.NUMBER_OF_PAGES gtr 0) or .NO_END or .WHOLE_FILE ) and ((.COUNT geq .START_LINE) or .WHOLE_FILE ) then ( INPUT_DESC[ 0 ] = .LENGTH; SCR_OUTPUT_SCREEN( .LINE_NUM, 1, $descriptor('!AS'), INPUT_DESC ); LINE_PRINTED = TRUE; LINE_NUM = .LINE_NUM + 1; ) else ( INCREMENT = (if .COUNT leq 9 then 1 else if .COUNT leq 99 then 10 else if .COUNT leq 999 then 100 else 1000 ); if not .DONE and ( ((.COUNT+1) eql .START_LINE) or (((.COUNT+1) mod .INCREMENT) eql 0) ) then SCR_INVERS_SCREEN( 1, .LINE_NUM_POS + 9, $descriptor('!SL'), .COUNT + 1 ); ); ); CLOSE_THE_FILE( %( on channel )% .CHANNEL ); if not .LINE_PRINTED then SCR_INVERS_SCREEN( 2, 1, $descriptor(' !AS is only !SL line!%S long. '), .FILE_NAME_DESC, .COUNT ); if .DONE then scr$erase_line( .LINE_NUM, 1 ) else scr$set_cursor( 24, 1 ); end; ! of TYPE_THE_FILE routine PROCESS : novalue = begin ! of PROCESS TPARSE_ARGS; own STATUS; ! If this is a CRT_TERMINAL process then wait at screen full WAIT_ON = tty_scope_terminal(); INPUT_DESC[ 0 ] = 132; INPUT_DESC[ 1 ] = INPUT_BUFFER; lib$get_foreign( INPUT_DESC, 0, INPUT_LENGTH ); INPUT_DESC[ 0 ] = .INPUT_LENGTH; if .INPUT_LENGTH neq 0 then begin COMMAND_DESC[ 0 ] = .INPUT_LENGTH; COMMAND_DESC[ 1 ] = COMMAND_BUFFER; STATUS = str$upcase( COMMAND_DESC, INPUT_DESC ); START_LINE = 0; NUMBER_OF_PAGES = 0; WHOLE_FILE = FALSE; NO_END = FALSE; TPARSE_BLOCK[ tpa$l_stringcnt ] = .INPUT_LENGTH; TPARSE_BLOCK[ tpa$l_stringptr ] = COMMAND_BUFFER; TPARSE_BLOCK[ tpa$v_blanks ] = 1; ! turn on TPARSE blank processing STATUS = lib$tparse( TPARSE_BLOCK, RANGE_STATE_TABLE, RANGE_KEY_TABLE ); if .STATUS then ( TYPE_THE_FILE( FILENAME_DESC, 1, ! channel number to use 2, ! starting line number 23 ! number of lines ); ); end else lib$put_output( $descriptor('%RANGE-W-NOFILESPEC, there was no file spec supplied') ); $exit(); end; ! of PROCESS end ! of CRT eludom