	program more
c	lists file on screen
c	uses similar commands to dbs inskey utility
C	EXITS AUTOMATICALLY IF FILE LESS THAN ONE PAGE LONG
c	
	INTEGER	COMMND
	byte string(133),ERR
	BYTE PREFIX(4),SUFFIX(4)
C
	INTEGER*2 SPEC(39)
	REAL*4 DEF(2)
C	HLP DEFAULT EXTENSION
	DATA DEF/6RHLPHLP,6RHLPHLP/
	DATA PREFIX/27,'[','1','m'/
	DATA SUFFIX/27,'[','0','m'/
C
500	IF (ICSI(SPEC,DEF,,,0).NE.0) GOTO 500
C
C
c	now need to check if there is an input file
c	we have only two file handling options
c	"FILE" with no option to list that file
c	<RET> to display ident and help info
c
c	can identify blank-file options by lack of SPEC(16) OR SPEC(1)
600	IF (SPEC(16).NE.0) GOTO 700
	IF (SPEC(1).NE.0) GOTO 50
	TYPE 1
1	format(' MORE screen listing utility ---  GFF051285'/,
	1' Use only with VT100 compatible terminals to list file
	2s page by page',/,' Commands are single characters as p
	3er prompt at base of screen.',/,' USAGE: MORE DEV:FIL
	4E.[HLP]',/,)
	goto 500
c
700	SPEC(1)=SPEC(16)
	SPEC(2)=SPEC(17)
	SPEC(3)=SPEC(18)
	SPEC(4)=SPEC(19)
C	
C
c	only vt100 can use special commands - put in bold
c	set keyboard special mode
C
C	SET UP SPECIAL I/O MODE
50	CALL IPOKE("44,"10000.OR.IPEEK("44))
	IP=1

100	CALL IASIGN(2,SPEC(1),SPEC(2),0,32)

C
200	DO 1000 L = 1,22
	CALL GETSTR(2,STRING,132,ERR)
	IF (ERR) GOTO 1500
C	PROBLEM WITH BLANK LINES
	if (len(string).NE.0) goto 300

	STRING(1)=32
	STRING(2)=0
300	CALL PUTSTR(7,STRING,' ',ERR)
1000	CONTINUE
1050	type 10,PREFIX,SUFFIX
10	format(' ',4A1,' Press [E] to Exit, [M] or <SPACE> for More
	1, [R] to Restart!',4A1)
C	UPGRADE POINTER
	IF (IP.EQ.1) IP=2
C	GET A SINGLE CHARACTER
1100	COMMND=ITTINR()
C	IF NO CHARACTER TRY AGAIN
	IF (COMMND.LT.0) GOTO 1100
C
	CALL ERAPMT
	if ((commnd.eq."145).or.(commnd.eq."105)) goto 3000
	if ((commnd.eq."155).or.(commnd.eq."115)) goto 2500
	if ((commnd.eq.32)) goto 2500
	if ((commnd.eq."162).or.(commnd.eq."122)) goto 2000
	GOTO 1050
1500	IF (IP.EQ.1) GOTO 3000
	type 20,PREFIX,SUFFIX
20	format(' ',4A1,' Press [E] or <SPACE> to Exit, [R] t
	1o Restart!',4A1)
C	GET A SINGLE CHARACTER
1600	COMMND=ITTINR()
C	IF NO CHARACTER TRY AGAIN
	IF (COMMND.LT.0) GOTO 1600
	CALL ERAPMT
	if ((commnd.eq."145).or.(commnd.eq."105)) goto 3000
	if (commnd.eq.32) goto 3000
	if ((commnd.eq."162).or.(commnd.eq."122)) goto 2000
	GOTO 1500
2000	close(unit=2)
	goto 100
2500	goto 200
3000	close(unit=2)
c	reset special mode
	CALL IPOKE("44,"167777.AND.IPEEK("44))
c
C	call setcmd(extmes)
	call exit
C
	end
	SUBROUTINE ERAPMT
C	MOVE CURSOR BACK TO BEGINNING OF LINE AND ERASE LINE
	BYTE ERA(4)
	DATA ERA/27,'[','1','M'/
	TYPE 10,ERA
10	FORMAT('+',4A1,$)
	RETURN
	END
