PDP-10 Archive: dx/sources/wp8flx.for from BB-D875A-SM

Trailing-Edge - PDP-10 Archives - BB-D875A-SM - dx/sources/wp8flx.for
There is 1 other file named wp8flx.for in the archive. Click here to see a list.
C	       PACKAGE	       :       DX/TOPS20
C	       VERSION         :       V1.0
C	       OP. SYSTEM      :       TOPS20 V3.0
C
C              PROGRAM         :       WFLX
C	       MODULE          :       WP8FLX.FOR
C	       MODULE #        :       1 OF 17
C	       EDIT            :       013
C	       EDIT DATE       :       29-AUG-78
C
C
C
C**********************************************************************
C
C	       C O P Y R I G H T
C
C
C	COPYRIGHT (C) 1978
C       DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS
C
C
C       THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY  ON  A
C       SINGLE  COMPUTER  SYSTEM  AND  MAY  BE  COPIED  ONLY  WITH THE
C       INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS  SOFTWARE,  OR
C       ANY  OTHER  COPIES  THEREOF,  MAY NOT BE PROVIDED OR OTHERWISE
C       MADE AVAILABLE TO ANY OTHER PERSON  EXCEPT  FOR  USE  ON  SUCH
C       SYSTEM AND TO ONE WHO AGREES TO THESE LICENSE TERMS.  TITLE TO
C       AND OWNERSHIP OF THE SOFTWARE SHALL AT  ALL  TIMES  REMAIN  IN
C       DIGITAL.
C  
C       THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT
C       NOTICE  AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
C       EQUIPMENT CORPORATION.
C  
C       DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE  OR  RELIABILITY
C       OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
C  
C**********************************************************************
C
C
C	E D I T   H I S T O R Y
C
C
C  EDIT #000	5/4/78		GARTH REID
C	INITIAL IMPLEMENTATION.
C
C  EDIT #001	5/8/78		J. COHEN
C	INITIAL CHANGES FOR TOPS20.
C
C  EDIT #002	5/8/78		G. A. REID
C	ENABLED US OF ERRSET TO TURN OFF UNNECESSARY ERROR MESSAGES.
C
C  EDIT #003	5/8/78		G. A. REID
C	CHANGED SO THAT WHEN A DOCnnn.W11 FILE DOES NOT HAVE A
C	CORRESPONDING ENTRY IN THE INDEX, WP8FLX SIMPLY OPENS
C	THE FILE AS NEW.
C
C  EDIT #004	5/8/78		G. A. REID
C	FIX PROBLEM WHERE OUTPUT FILENAME LENGTH IS SOMETIMES WRONG.
C
C  EDIT #005	5/11/78		J. COHEN
C	ADD NEW ERROR MESSAGE TO TELL WHEN A WORD PROCESSING
C	FILE IS FOUND WHICH IS NOT LISTED IN THE HOST'S INDEX.
C
C  EDIT #006	5/12/78		J. COHEN
C	MODIFICATION TO ALLOW FOR THE CORRECT FILE TO BE OPENED
C	IN THE CASE WHERE BOTH INPUT AND OUTPUT FILES ARE WORD
C	PROCESSING FILES.
C
C  EDIT #007	5/23/78		G. A. REID
C	MINOR COSMETIC CHANGES.

C  EDIT #008	5/31/78		J. COHEN
C	INITIALIZE HEADER(11) AND HEADER(12) TO ZERO.
C
C  EDIT #009	7/10/78		G. A. REID
C	FIX SO THAT TWO WORD PROCESSING FILES (ONE WITH
C	ZERO LENGTH) ARE NOT CREATED WHEN CONVERTING FROM
C	TEXT TO WORD PROCESSING AND CREATING A NEW FILE.
C
C  EDIT #010	8/10/78		G. A. REID
C	CHANGE SO THAT ALL WORD PROCESSING DOCUMENT FILES ARE DIRECT
C	ACCESS INSTEAD OF SEQUENTIAL.  THIS CHANGE WAS NECESSARY
C	IN WPIP TO HELP CORRECT TIMING PROBLEMS WHICH COULD CAUSE
C	THE WORK STATION TO TIME OUT WHILE THE HOST WAS BUSY
C	FINISHING ITS FILE I/O.  THE SITUATION MOST OFTEN OCCURRED
C	WHEN ADDING TO THE TOP OR BOTTOM AND THE FILES WERE LARGE.
C
C  EDIT #011	8/14/78		G. A. REID
C	CHANGE CALLS TO SUBROUTINE Q TO PASS LENGTH OF BUFFER TO Q.
C
C  EDIT #012	8/18/78		J. COHEN
C	FIX SO THAT WFLX RECOGNIZES EXTERNAL RULER SETTING OF H WHICH
C	IS USED TO DEFINE A HYPHENATION ZONE.
C
C  EDIT #013	8/30/78		G. A. REID
C	FIX SUCH THAT WHEN OPENING THE OUTPUT FILENAME WE DON'T
C	ATTEMPT TO OPEN UNIT 2 WHEN THERE IS ALREADY A FILE OPEN
C	ON IT (THUS AVOIDING ERROR STOPS).
C
C********************************************************************
C
C
C
C
C		W P 8 F L X . F T N
C
C	This program accepts files transferred from the WPS-8
C	Word Processing System to a PDP-11 running IAS.  
C
	INCLUDE 'SPCFLX.FTN'
C
C	SPCFLX.FTN is a file containing data declarations and a
C	Common block.  Note that there are no floating point
C	operations and that all variables are either LOGICAL*1
C	or INTEGER*2.
C
	DATA NAMLEN/10/
C
C	S T A R T   H E R E
C
	CALL ERRSET(0)
1	TYPE 100
100	FORMAT(//' WFLX V1.0')
2	CLOSE (UNIT=1)
	CLOSE (UNIT=2)
	TYPE 101
101	FORMAT(/,' Type name of file or document to be converted:')
	DO 2030 I = 1,80
	TTYIN(I) = 0
2030	CONTINUE
	READ(5,2100,END=99999) TTYIN
	CALL Q(TTYIN,IDNLEN,80)
2100	FORMAT(80R1)
C
C  IF NOTHING WAS ENTERED, SIMPLY REQUEST FILENAME AGAIN.
C
	IF(IDNLEN .LE. 0) GO TO 2
	IDOCNO = 0
C
C  The user may specify WPS-8 files either by document
C  name or by document number.  
C
C  First, see if a number was entered.  If a number assume
C  he meant a WPS-8 document with that document number.
C  If not a number, see if there is a document by that name
C  in the document directory (DOC001.W11).  If not, then
C  assume the input is not a WPS-8 file and validate the
C  name as a legal host system filename.
C
C  Now determine if he typed in a number or an alphabetic string.
C
	IF(IDNLEN .GT. 4) GO TO 2120
	DO 2326 I=IDNLEN,1,-1
	IF(TTYIN(I) .GE. 48 .AND. TTYIN(I) .LE. 57) GO TO 2325
	GO TO 2120
2325	IDOCNO = IDOCNO + (TTYIN(I) - 48) * (10 ** (IDNLEN-I))
2326	CONTINUE
	IF(IDOCNO .NE. 1) GO TO 2121
	TYPE 2322
2322	FORMAT(' *** USER MAY NOT REFERENCE DOCUMENT #1 ***')
	GO TO 2
C
C  An alphabetic string was typed.  Set IDOCNO to indicate we
C  are looking in the directory for a document name.
C
2120	IDOCNO = 0
2121	CONTINUE
	CALL LOOKUP(1, IDOCNO, TTYIN, IDNLEN, IEXIST, CREDAT,
	1  MODDAT, MODTIM, ISIZE, IVERSN, NAMIN, LEN)
	IF(IEXIST .NE. 1 .AND. IEXIST .NE. 5) GO TO 2310
	DECODE(10,14,NAMIN)NAMIN2
	GO TO 2311
2310	DO 2300 M=1,IDNLEN
	NAMIN2(M) = TTYIN(M)
2300	CONTINUE
C
C  Dispatch on IEXIST, where:
C
C	1 - file found
C	2 - file not found
C	3 - file in directory but not on disk
C	4 - non-unique file specification
C	5 - file found, created by WFLX and never processed by
C		a word processing system.
C
2311	GO TO ( 5, 3, 4, 6, 5), IEXIST
C
C  Should never get here!
C
	STOP 1000
99999	STOP
C
C  WAS A LEGAL HOST FILENAME ENTERED?
C
3	CALL REPLY(IDNLEN)
	CALL VALID(NAMIN2,IDNLEN)
	IF (OK) GO TO 5
C
C  WE HAVE EITHER AN ILLEGAL FILENAME, OR A FILENAME
C  WITH NO EXTENSION, OR A DOCUMENT NAME THAT DOESN'T
C  EXIST. IN ANY CASE, THE FILE DOESN'T EXIST.
C
	TYPE 102,TTYIN
102	FORMAT(1X,80R1,/,' does not exist'/)
	GO TO 2
C
C  The document name entered exists in the document directory
C  but the corresponding DOCnnn.W11 file does not exist on the
C  host's disk.
C
4	TYPE 1011,TTYIN
1011	FORMAT(' Corrupted file system -- File:',/,1X,80R1,/,
	1      ' is in the document index but is not on the disk')
	GO TO 2
C
C  Non-unique document name specification.
C
6	TYPE 1012,TTYIN
1012	FORMAT(1X,80R1,/,' is a non-unique document specification')
	GO TO 2
C
C  DETERMINE WHAT TYPE OF FILE WE HAVE, WHERE:
C
C	EXT	TYPE
C
C	W11	 0
C	BAS	 1
C	B2S	 2
C	CBL	 2
C	FTN	 2
C	FOR	 2
C	F4P	 2
C	MAC	 2
C    OTHERS	 3
C
5	CALL FILTYP(NAMIN2,INFILV)
	IF(IEXIST .EQ. 2)
	1	ENCODE(10,14,NAMIN)(NAMIN2(M),M=1,10)
14	FORMAT(10R1)
C
C  OPEN THE FILE AND VERIFY THAT IT'S A WPS FILE.
C
	OPEN (UNIT=1,FILE=NAMIN,DEVICE='DSK:',ACCESS='SEQIN',
	1  MODE='ASCII',ERR=600,DISPOSE='SAVE')
C
C  THE FILE DOES EXIST, NOW SEE IF IT'S A WPS FILE.
C
	READ(1,103,END=610) INCNT,(HEADER(I), I = 1,65)
	READ(1,103) INCNT,(HEADER(I), I = 66,130)
103	FORMAT(A2,80R1)
	IF (HEADER(1) .NE. "133 .OR. HEADER(2) .NE. "40) GO TO 630
	IF (HEADER(3) .NE. "137 .OR. HEADER(4) .NE. "47) GO TO 630
	IF (HEADER(9) .NE. "137 .OR. HEADER(10) .NE. "107) GO TO 630
	GO TO 620
C
C  FILE DOES NOT EXIST, TELL THE USER AND REQUEST ANOTHER NAME.
C
600	TYPE 106,(NAMIN2(I) , I = 1,NAMLEN)
106	FORMAT(1X,10R1,' does not exist')
	GO TO 2
C
C  File is empty, complain and go ask for another name.
C
610	TYPE 611,NAMIN2
611	FORMAT(1X,10R1,' is empty')
	GO TO 2
C
C  The file is a word processing file.  Check that it's extension
C  is W11.  If not, complain and go ask for another name.
C
620	IF(INFILV .NE. 0) GO TO 6201
C
C  THE INPUT FILE IS A WORD PROCESSING DOCUMENT.  CLOSE AND
C  REOPEN IT AS A DIRECT ACCESS FILE.
C
	CLOSE(UNIT=1)
	OPEN(UNIT=1,FILE=NAMIN,DEVICE='DSK:',ACCESS='RANDOM',
	1  RECORDSIZE=67,ERR=600,MODE='ASCII',
	2  DISPOSE='SAVE',ASSOCIATEVARIABLE=IAVI)
	GO TO 900
6201	TYPE 621,NAMIN2
621	FORMAT(1X,10R1,' is a Word Processing File which is not',
	1              ' listed in the index.')
	GO TO 2
C
C  Need to find out more exactly what kind of a file it is.
C
630	GO TO (640,800,800,650), INFILV+1
C
C  Should never get here.
C
	STOP 777
C
C  An input file whose contents are not word processing document but
C  whose extension is 'W11' is considered to be corrupted.
C
640	TYPE 641,NAMIN2
641	FORMAT(1X,10R1,' is corrupted')
	GO TO 2
C
C
650	TYPE 651
651	FORMAT(' Is it a program source file? (NO) -- ',$)
	READ(5,2100,END=99999) TTYIN
	CALL Q(TTYIN,LN,80)
	CALL REPLY(LN)
	IF (LN .EQ. 0 .OR. (TTYIN(1) .EQ. 78 .AND.
	1   TTYIN(2) .EQ. 79)) GO TO 660
	IF (TTYIN(1) .NE. 89 .OR. TTYIN(2) .NE. 69
	1   .OR. TTYIN(3) .NE. 83) GO TO 650
655	TYPE 656
656	FORMAT(' Is it a BASIC-PLUS program? (NO) -- ',$)
	READ(5,2100,END=99999) TTYIN
	CALL Q(TTYIN,LN,80)
	CALL REPLY(LN)
	IF (LN .EQ. 0 .OR. (TTYIN(1) .EQ. 78 .AND.
	1   TTYIN(2) .EQ. 79)) GO TO 657
	IF (TTYIN(1) .NE. 89 .OR. TTYIN(2) .NE. 69 .OR.
	1   TTYIN(3) .NE. 83) GO TO 655
	INFILV = 1
	GO TO 800
657	INFILV = 2
	GO TO 800
660	TYPE 661
661	FORMAT(' Try to form word processing paragraphs? (YES) -- ',$)
	READ(5,2100,END=99999) TTYIN
	CALL Q(TTYIN,LN,80)
	CALL REPLY(LN)
	IF (LN .EQ. 0 .OR. (TTYIN(1) .EQ. 89 .AND.
	1   TTYIN(2) .EQ. 69 .AND. TTYIN(3) .EQ. 83)) GO TO 665
	IF (TTYIN(1) .NE. 78 .OR. TTYIN(2) .NE. 79) GO TO 660
	REMLIN = .FALSE.
	GO TO 670
665	REMLIN = .TRUE.
	CMPSP = .TRUE.
	GO TO 690
670	TYPE 671
671	FORMAT(' Do you want multiple spaces reduced to just one',
	1      ' space? (NO) -- ',$)
	READ(5,2100,END=99999) TTYIN
	CALL Q(TTYIN,LN,80)
	CALL REPLY(LN)
	IF (LN .EQ. 0 .OR. (TTYIN(1) .EQ. 78 .AND.
	1   TTYIN(2) .EQ. 79))  GO TO 675
	IF (TTYIN(1) .NE. 89 .OR. TTYIN(2) .NE. 69 .OR.
	1   TTYIN(3) .NE. 83) GO TO 670
	CMPSP = .TRUE.
	GO TO 690
675	CMPSP = .FALSE.
680	TYPE 681
681	FORMAT(' Do you want multiple spaces replaced with a',
	1      ' tab? (YES) -- ',$)
	READ(5,2100,END=99999) TTYIN
	CALL Q(TTYIN,LN,80)
	CALL REPLY(LN)
	IF (LN .EQ. 0 .OR. (TTYIN(1) .EQ. 89 .AND.
	1   TTYIN(2) .EQ. 69 .AND. TTYIN(3) .EQ. 83)) GO TO 685
	IF (TTYIN(1) .NE. 78 .OR. TTYIN(2) .NE. 79) GO TO 680
	CVSPTB = .FALSE.
	GO TO 690
685	CVSPTB = .TRUE.
686	TYPE 687
687	FORMAT(' The minimum number of spaces to be converted to one',
	1      ' tab is 3.',/,' Specify the maximum.  Just press',
	2      ' RETURN to use 8. -- ',$)
	READ(5,2100,END=99999) TTYIN
	CALL Q(TTYIN,LN,80)
	CALL REPLY(LN)
	K = 8
	IPOS = 1
	IF (LN .NE. 0) CALL GETNUM(K)
	IF (K .LT. 4 .OR. K .GT. 158) GO TO 686
	SPTOTB = K
C
C  Set up a default ruler.
C
690	CALL DEFRUL
	HZ = 0
C
C  Display the ruler and give the user an opportunity to make
C  changes.
C
700	CALL DISRUL
	TYPE 701
701	FORMAT(' Just press RETURN to use the above ruler.',/
	1      ' Otherwise type new settings')
	READ(5,2100,END=99999) TTYIN
	CALL Q(TTYIN,LN,80)
	CALL REPLY(LN)
	IF (LN .NE. 0) GO TO 710
	DO 702 I = 1,158
	IF (RULER(I) .EQ. 76 .OR. RULER(I) .EQ. 68 .OR.
	1   RULER(I) .EQ. 78) GO TO 705
702	CONTINUE
	GO TO 707
C
C  Now make sure we have a right margin and that H is not before it.
C
705	DO 706 I = 1,158
	IF (RULER(I) .NE. 82 .AND. RULER(I) .NE. 74) GO TO 706
	IF (HZ .GE. I) GO TO 709
	GO TO 900
706	CONTINUE
C
C  Error in ruler settings.
C
707	TYPE 708
708	FORMAT(' Ruler must have a left margin (L, D, or N),',
	1      ' and a right margin (R or J)')
	GO TO 700
C
C  Error in H ruler setting.
C
709	TYPE 763
	HZ = 0
	GO TO 700
C
C  Remove a leading 43 if there.  If it is there don't
C  clear the existing ruler.  (Also, if a delimiter followed
C  the 43, remove it.)
C
710	IF (TTYIN(1) .NE. 43) GO TO 715
	IPOS = 2
	LN = LN - 1
	IF (TTYIN(2) .NE. 59 .OR. TTYIN(2) .NE. 44) GO TO 720
	IPOS = 3
	LN = LN - 1
	GO TO 720
C
C  Clear the existing ruler.
C
715	IPOS = 1
	DO 716 I = 1,158
	RULER(I) = SPACE
716	CONTINUE
720	IF (IPOS .GT. LN) GO TO 700
	CALL GETNM(K)
	IF (.NOT. OK) GO TO 717
	IF (K .GT. 0 .AND. K .LT. 159) GO TO 725
717	TYPE 721
721	FORMAT(' Ruler position must be a number from 1 to 158')
	GO TO 700
725	ICMD = TTYIN(IPOS)
	DO 726 I = 1,CMDCNT
	IF (ICMD .EQ. CMDS(I)) GO TO 728
726	CONTINUE
	IF (ICMD .EQ. 59 .OR.
	1   ICMD .EQ. 44 .OR.
	1   ICMD .EQ.  0  )    GO TO 727
	TYPE 729,(TTYIN(I), I = IPOS,LN)
729	FORMAT(' Error at ',80R1)
	GO TO 700
727	RULER(K) = SPACE
	IPOS = IPOS + 1
	GO TO 720
C
C  Dispatch to the appropriate ruler modification code.
C
728	GO TO (735,735,735,750,750,760,760,760,770,770,770,760), I
C
C  Should never get here.
C
	STOP 776
C
C  Handle ruler codes: L, D, N.
C
735	DO 736 I = 1,158
	IF (RULER(I) .NE. 76 .AND. RULER(I) .NE. 68 .AND.
	1   RULER(I) .NE. 78) GO TO 736
	RULER(I) = SPACE
736	CONTINUE
	RULER(K) = ICMD
	GO TO 780
C
C  Handle ruler codes: R, J.
C
750	DO 751 I = 1,158
	IF (RULER(I) .NE. 82 .AND. RULER(I) .NE. 74) GO TO 751
	RULER(I) = SPACE
751	CONTINUE
	RULER(K) = ICMD

C
C  Remember where right margin is.
C
	GO TO 780
C
C  Handle ruler codes: W, P, C, H.
C
760	DO 761 I = 1,158
	IF (RULER(I) .EQ. ICMD) RULER(I) = SPACE
761	CONTINUE
	RULER(K) = ICMD
	IF (ICMD .EQ. 72) HZ = K
763	FORMAT(' Hypenation zone (H) must come before the right ',
	1      'margin (R,J)')
	GO TO 780
C
C  Handle ruler codes: .,T,>.
C
770	RULER(K) = ICMD
C
C  Remove a delimiter if it exists.  If no delimiter and not
C  end of input, the input is erroneous.
C
780	IPOS = IPOS + 1
	IF (TTYIN(IPOS) .NE. 0 .AND.
	1   TTYIN(IPOS) .NE. 59 .AND.
	2   TTYIN(IPOS) .NE. 44) GO TO 785
	IF (TTYIN(IPOS) .EQ. 0) GO TO 720
	IPOS = IPOS + 1
	GO TO 720
785	TYPE 729,(TTYIN(I), I = IPOS,LN)
	GO TO 700
C
C  Come here if the input is a program file.  All types of program
C  get the default ruler.
C
800	CALL DEFRUL
C
C
C  G E T   T H E   O U T P U T   F I L E N A M E
C
C
900	TYPE 901
901	FORMAT(' Type name of output file or document:')
	DO 9010	I = 1,80
	TTYIN(I) = 0
9010	CONTINUE
	READ(5,2100,END=99999) TTYIN
	CALL Q(TTYIN,IDNLEN,80)
C
C  If nothing was entered, simply request filename again.
C
	IF(IDNLEN .LE. 0) GO TO 900
	IDOCNO = 0
C
C  Now determine if he typed in a number or an alphabetic string.
C
	IF(IDNLEN .GT. 4) GO TO 2220
	DO 2572 I=IDNLEN,1,-1
	IF(TTYIN(I) .GE. 48 .AND. TTYIN(I) .LE. 57) GO TO 2571
	GO TO 2220
2