C+ SUBROUTINE FINOUT C Author: T. R. Wyant C Date: 07-Oct-1985 C Modified: C Remarks: C This subroutine (in module FINGEROUT) handles all output C that might go to either terminal or net, depending on C how FINGER was invoked. All input is from common areas. C From IPCOMM: C IPBUF - Text to output. Byte 1 is carriage C control. C IPSLOC - Location of start of text in IPBUF. C This must be at least 2 for "0" C carriage control to work right C over the net. C IPSLEN - Size of text. C From FINCOM: C NETMOD - .TRUE. if output is to be over the C net, .FALSE. if it is to the C terminal. C C The output is converted from "Fortran" implied carriage C control to "No" implied carriage control, and is segmen- C ted after each carriage return before being sent over C the net or written to the terminal. C- C======================================================================= C C Declarations, etcetera. C C....................................................................... C C Includes. C INCLUDE 'FINGERCOM' ! FINGER common area. INCLUDE 'IPCOMM' ! Parser common, subverted. C C....................................................................... C C Local variables. C LOGICAL*1 CCTBL(6) ! Carriage ctrl trans. table. LOGICAL*1 CR ! ASCII carriage return. LOGICAL*1 LF ! ASCII line feed. LOGICAL*1 FF ! ASCII form feed. LOGICAL*1 NULL ! ASCII C C....................................................................... C C Data. C DATA CR /13/ ! is decimal 13. DATA LF /10/ ! is decimal 10. DATA FF /12/ ! is decimal 12. DATA NULL /0/ ! is zero in any radix. DATA CCTBL /'+','$','0','1','@',0/ C C....................................................................... C C Formats. C 94200 FORMAT (A1,A1) ! "Short form" format. 94400 FORMAT (A1,(128A1),A1) ! "Long form" format. C C======================================================================= C C Code. C C....................................................................... C C Translate the carriage control. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Translate CC byte and dispatch. C 3000 IF (IPSLEN .GT. 0) GO TO 3010 ! If we have some, fine. IF (IPSLOC .LE. 0) IPSLOC = 0 ! Be sure start is OK. IPBUF(IPSLOC) = ' ' ! Fake a blank line. IPSLEN = 1 ! Fake in its length. 3010 IPSLEN = IPSLOC + IPSLEN - 1 ! Point to last char. DO 3020 I=1,6 ! Loop thru the translation tbl. IF (IPBUF(IPSLOC) .EQ. ! If a match, 1 CCTBL(I)) GO TO 3040 ! dispatch it. 3020 CONTINUE ! Repeat as needed. I = 7 ! No match. Force one. 3040 IPSLOC = IPSLOC + 1 ! Take CC byte out of buffer. GO TO (3100,3200,3300,3400, ! Go to the proper 1 3500,3600,3700) I ! handler. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C "+" - Overprint. C 3100 IPSLEN = IPSLEN + 1 ! Update length. IPBUF(IPSLEN) = CR ! Carriage return after, GO TO 3900 ! Go handle. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C "$" - Continued line. C 3200 IPSLOC = IPSLOC - 1 ! Update start. IPBUF(IPSLOC) = LF ! Linefeed before. GO TO 3900 ! Go send. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C "0" - Double space. C 3300 IPSLEN = IPSLEN + 1 ! Update length. IPBUF(IPSLEN) = CR ! Carriage return after. IPSLOC = IPSLOC - 1 ! Update start. IPBUF(IPSLOC) = LF ! Linefeed before. IF (IPSLOC .LE. 1) GO TO 3900 ! If no more room, quit. IPSLOC = IPSLOC - 1 ! Update start again. IPBUF(IPSLOC) = LF ! Insert another linefeed. GO TO 3900 ! Go send. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C "1" - Top of form. C 3400 IPSLEN = IPSLEN + 1 ! Update length. IPBUF(IPSLEN) = CR ! Carriage return after. IPSLOC = IPSLOC - 1 ! Update start. IPBUF(IPSLOC) = FF ! Formfeed before. GO TO 3900 ! Go send. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C "@" - Proxy for null, no cc. C 3500 GO TO 3900 ! Send it as is. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C - No implied carriage control. C 3600 GO TO 3900 ! Send it as is. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Anything else - Single space. C 3700 IPSLEN = IPSLEN + 1 ! Update length. IPBUF(IPSLEN) = CR ! Carriage return after. IPSLOC = IPSLOC - 1 ! Update start. IPBUF(IPSLOC) = LF ! Linefeed before. GO TO 3900 ! Go send. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Carriage control translated. C 3900 IPLOC = IPSLOC ! Initialize segment pointer. C C....................................................................... C C Segment the buffer, and transmit. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Segment the buffer. C 4000 DO 4040 IPLEN=IPLOC,IPSLEN ! Loop thru rest of buffer. IF (IPBUF(IPLEN) .EQ. CR) ! If a carriage return, 1 GO TO 4060 ! segment it here. 4040 CONTINUE ! Repeat until end of buffer. IPLEN = IPSLEN ! No found. Take it all. 4060 IFREMD = IPLEN - IPLOC + 1 ! Size of whole thing. IF (NETMOD) GO TO 4600 ! If in network mode, send. IF (IPLEN - IPLOC .GE. 128) ! If too big for one format, 1 GO TO 4400 ! split it further. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Small message. C WRITE (LUNOUT,94200) NULL, ! Write the message out 1 (IPBUF(I),I=IPLOC,IPLEN) ! to the user's terminal. GO TO 4900 ! Take common exit. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Large message. C 4400 IFREPT = (IFREMD - 1)/128 ! Number of repeats. IFREMD = IFREMD - IFREPT*128 ! Amount left over. WRITE (LUNOUT,94400) NULL, ! Write the message out 1 (IPBUF(I),I=IPLOC,IPLEN) ! to the user's terminal. GO TO 4900 ! Take common exit. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Transmit the buffer over the net. C 4600 CALL SNDNTW(LUNLIN,,IFREMD, ! Send the biffer to the 1 IPBUF(IPLOC)) ! requestor. GO TO 4900 ! If not, take common exit. C C. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C Common exit for buffer transmit. C 4900 IPLOC = IPLEN + 1 ! Point to next segment. IF (IPLOC .LT. IPSLEN) ! If there is one, 1 GO TO 4000 ! get it and send it. IPSLEN = IPSLEN - IPSLOC ! Recover the length. GO TO 9000 ! Go exit. C C....................................................................... C C Well done, thou good and faithful servant. C 9000 RETURN ! Return to caller. END