From tomj@paper.wps.com Sun Mar  6 23:13:38 2005
Date: Sun, 06 Mar 2005 23:13:02 -0800
From: Tom Jennings <tomj@paper.wps.com>
To: tomj@wps.com
Subject: more.fr

TYPE MORE.FR
C
C DISPLAY A TEXT FILE ON $TTO, PAUSING EVERY
C 24 LINES FOR INPUT, AS PER BELOW:
C
C CR      NEXT SCREENFUL
C Q       QUIT
C
C TOM JENNINGS
C 3 MARCH 2005
C
C FOR D.G. FORTRAN5
C
        INTEGER CONSNAME(3)     ; NAME OF CONSOLE DEVICE
        INTEGER TTO             ; CONSOLE OUTPUT UNIT NUMBER
        INTEGER TTI             ; CONSOLE INPUT UNIT NUMBER
        INTEGER LN(133)         ; LINE BUFFER
        INTEGER SW(20)          ; CMD LINE SWITCHES
        INTEGER N               ; CHAR COUNT READ/WRITE
        INTEGER LINENO
        INTEGER ERRNO
        INTEGER FILENO
C
        TTO= 10
        TTI= 11
        FILENO= 1
        LINENO= 0
C OPEN CONSOLE FOR READING AND WRITING.
C       CALL GCOUT (CONSNAME, ERRNO)
C       CALL CHECK (ERRNO)
C       CALL OPEN (TTO,CONSNAME,0,ERRNO)
C       CALL CHECK (ERRNO)
C
C       CALL GCIN (CONSNAME, ERRNO)
C       CALL CHECK (ERRNO)
C       CALL OPEN (TTI, CONSNAME, 0, ERRNO)
C       CALL CHECK (ERRNO)
C
C PARSE THE COMMAND LINE.
        OPEN 0, "COM.CM"
        CALL COMARG (0, LN, SW, ERRNO)  ; PROGNAME
        CALL COMARG (0, LN, SW, ERRNO)  ; 1ST ARG
C OPEN FILE.
                        TYPE ""         ; THIS OPENS CONSOLE!
C       CALL WRLIN (TTO,LN,N,ERRNO)
        CALL OPEN(FILENO,LN,1,ERRNO)
        IF (ERRNO .NE. 1) GO TO 410
        CALL CHECK(ERRNO)

C LOOP, READING LINES FROM THE FILE THEN 
C WRITING TO CONSOLE OUT.
100     CALL RDLIN (FILENO,LN,N,ERRNO)
        CALL CHECK (ERRNO)
        CALL WRLIN (10,LN,N,ERRNO)
        CALL CHECK (ERRNO)
C
                LINENO= LINENO + 1              ; EVERY 24 LINES...
        IF (LINENO .LT. 23) GO TO 100
        LINENO= 0
        CALL RCHAR (N, ERRNO)
        IF (N .EQ. 81) GO TO 420                ; "Q"
        IF (N .EQ. 113) GO TO 420               ; "q"
        CALL CHECK (ERRNO)
        GO TO 100


410     TYPE "FILE DOESN'T EXIST"
        STOP

420     CALL CLOSE (FILENO,ERRNO)
        STOP

        END
R