PDP-10 Archive: decus/20-0055/sign.for from decuslib20-02

Trailing-Edge - PDP-10 Archives - decuslib20-02 - decus/20-0055/sign.for
There is 1 other file named sign.for in the archive. Click here to see a list.
C	*****************************SIGN MAKER***********************
C	WRITTEN BY IRWIN L. GOVERMAN  BRANDEIS '75
C	USES RANDOM ACCESS FILE IN 1,4 CALLED "SIGN.LIB"
C	PROGRAM ASSUMES UNIT#5 IS USER TELETYPE
C	READS SYMBOL LIBRARY ON UNIT#1 AND WRITES SIGN
C	ON DEVICE "LPT" WHICH IS NORMALLY 3.
C
C
C
C
C
C
C
C
C
C
C----------------MAIN PROGRAM---------------------------
C
	DOUBLE PRECISION LINBF,BLANKS,NEWSYM
	DIMENSION LINBF(10,12,8),NEWSYM(8),
	1 IBUFF(13),ISYM(62), INDREM(10),ICMND(9)
	LOGICAL FFORM,ERASE,DEFLG,NOFLG
	DATA NEWSYM/8*'???????'/
C
C	THIS IS THE AREA THAT THE PROGRAM EXPECTS SIGN.LIB TO BE IN
C	DATA PROJ/"1/,PROG/"4/
	DEV='SYS'
C
C	INITIALIZE COUNTER OF SIGNS AND THE FLAG THAT TELLS THAT A
C	PRINT HAS JUST BEEN DONE
	DATA ISICNT/0/,IPRFLG/1/
C
C	THESE ARE THE AVAILABLE SYMBOLS, BACKARROW AND SQUARE
C	BRACKETS ARE IN OCTAL BECAUSE THE COMPILER DOESN'T RECOGNIZE
C	THEM.
	DATA ISYM/'A','B','C','D','E','F','G','H','I',
	1 'J','K','L','M','N','O','P','Q','R','S',
	2 'T','U','V','W','X','Y','Z',' ','0','1','2','3','4',
	3 '5','6','7','8','9','.',',','?','-','$','*',
	4 '=','&','<','>','+','/','!','''',':','#',
	5 '"','^',"575004020100 ,'%',';','(',')',
	6  "555004020100,"565004020100/
C
C	THIS IS THE LIST OF AVAILBLE COMMANDS.
	DATA ICMND/'ERASE','INLIN','H','PRINT','    ','EXIT','DEFSY',
	1 'INSIG','WIPE '/
C
C	THIS IS THE DEV. NO. THAT THE SIGNS ARE WRITTEN ON.
	LPT=3
C
	DATA BLANKS/'          '/
	DATA FFORM,ERASE,DEFLG,NOFLG/4*.FALSE./
C
C	OPEN UP THE LIBRARY OF SYMBOLS
C	CALL DEFINE FILE(1,56,NERD,'SIGN.LIB',PROJ,PROG)
	OPEN (UNIT=1,DEVICE=DEV,FILE='SIGN.LIB',ACCESS='RANDOM',
	1  RECORDSIZE=56)
C
C	NOTIFY USER THAT HELP IS AVAILABLE
	WRITE(5,2)
2	FORMAT(' TYPE "H" FOR HELP',/)
C
C	THIS IS WHERE THE INTERACTIVE PART STARTS. INDICATE READINESS
C	FOR COMMAND BY TYPING A STAR, AND WAIT.
1	WRITE (5,3)
3	FORMAT (' *',$)
C
C	ACCEPT A COMMAND
	READ(5,4)INDO
4	FORMAT(A5)
C
C	CHECK FOR BLANK, NO NEED TO SEARCH COMMAND LIST.
	IF(INDO.EQ.'   ')GO TO 1
C
C	CHECK THE COMMAND INPUT AGAINST VALID COMMANDS.
	DO 5 J=1,9
5	IF(INDO.EQ.ICMND(J)) GO TO 6
C
C	NOT A RECOGNIZED COMMAND
	WRITE(5,7)INDO
7	FORMAT(' ?NOT A COMMAND: ',A5)
	WRITE(5,2)
C
C	LOOP BACK FOR ANOTHER COMMAND
	GO TO 1
C
C	JUMP TO SPECIFIED PLACE
6	GO TO (100,200,300,400,900,600,700,800,1000),J
C
C
C
C
C
C	***ERASE***
C
C	CHECK TO SEE IF THERE IS AN UNPRINTED SIGN OPEN, AND
C	THAT IT CONTAINS DATA (LINCNT NOT EQUAL TO ZERO)
100	IF(LINCNT.NE.0.AND.IPRFLG.EQ.0)GO TO 101
	WRITE(5,103)
103	FORMAT(' ?NO SIGN IN CORE',/)
C
C	LOOP BACK FOR ANOTHER COMMAND
	GO TO 1
C
C	DID HE INCLUDE NUMBER IN COMMAND STRING?
101	REREAD 113,INDO
	IF(INDO.NE.0)GO TO 117
113	FORMAT(5X,I)
C
C	NO, GET IT NOW
	WRITE(5,102)
102	FORMAT(' WHAT LINE NUMBER? ',$)
	READ (5,106)INDO
106	FORMAT(I)
C
C	CHECK FOR EXISTENCE OF SUCH A LINE
117	IF(INDO.LE.0)GO TO 111
	IF(LINCNT-INDO)111,120,120
111	WRITE(5,112)INDO
112	FORMAT(' ?LINE #',I2,' DOES NOT EXIST')
C
C	LOOP BACK FOR ANOTHER COMMAND
	GO TO 1
C
C	STORE CURRENT VALUE OF LINCNT IN TEMP, JUMP TO INLINE
C	TO REPLACE LINE. ERASE IS FLAG TO RETURN HERE
120	ITEMP=LINCNT
	WRITE(5,126)
126	FORMAT('+(NEW) ',$)
	LINCNT=INDO-1
	ERASE=.TRUE.
	GO TO 200
C
C	JUMP BACK HERE AND RESTORE EVERYTHING TO ORIGINAL STATE
125	LINCNT=ITEMP
	ERASE=.FALSE.
C
C	LOOP BACK FOR ANOTHER COMMAND
	GO TO 1
C
C
C
C
C
C
C	***INLINE***
C
C	INCREMENT LINCNT
200	LINCNT=LINCNT+1
C
C	CHECK AGAINST THE MAXIMUM NO. OF LINES.
	IF(LINCNT.LE.10)GO TO 297
	WRITE(5,242)
242	FORMAT(' ?TOO MANY LINES- "PRINT" THE SIGN.',/)
	GO TO 298
C
C	INITIALIZE CHARACTER COUNTER
297	ICRCNT=0
C
C	CHECK TO SEE IF WE HAVE TO JUMP TO FILE-OPEN SECTION.
C	IF IPRFLG=1 THEN A PRINT HAS BEEN DONE AND WE MUST OPEN
	IF(IPRFLG)202,203,202
C
C	SET IRET SO WE RETURN HERE AFTER THE OPENING.
202	IRET=1
C
C	JUMP TO OPENING PROCEDURE.
	GO TO 500
C
C	IF THIS IS AN INSIGN, USE THE SECOND OUTPUT FORMAT.
203	IF(FFORM)GO TO 280
	WRITE(5,204)ISICNT,LINCNT
204	FORMAT('+SIGN:'I2,'  LINE:',I2,' STRING:',$)
	GO TO 283
280	WRITE(5,855)LINCNT
C
C	READ THE INPUT STRING, CHECK FOR ^Z (EOF)
C	THE EOF MEANS THAT THE USER HAS FINISHED INPUT TO INSIGN.
283	READ(5,205,END=298,ERR=298)IBUFF
205	FORMAT(13A1)
C
C	CHECK FOR STRING DELIMITER
	IF (IBUFF(13).EQ.' ')GO TO 276
206	WRITE(5,207)
207	FORMAT(' ?TOO MANY CHARACTERS --LINE NOT COMPILED')
C
C	ERROR TRAP FOR INLINE AND INSIGN
C	CLEARS LOGICAL FLAGS ,DECREMENTS LINCNT, GOES TO COMMAND MODE
C	EXCEPT IF WE CAME FROM ERASE (WE HAVE TO RESTORE LINCNT)
298	IF(ERASE)GO TO 125
	LINCNT=LINCNT-1
	FFORM=.FALSE.
C
C	LOOP BACK FOR ANOTHER COMMAND
	GO TO 1
C
C	GET ACTUAL LENGTH OF LINE
276	DO 270 KK=13,1,-1
	IF(IBUFF(KK).NE.' ')GO TO 290
270	CONTINUE
	KK=1
C
C	COMPUTE THE AMOUNT OF INDENTATION NESS.
290	INDENT=(12-KK)/2
C
C	SET THE INDENT VARIABLE FOR THIS LINE (1=ODD,0=EVEN # OF CHARS.)
	INDREM(LINCNT)=0
	IF(KK.NE. (KK/2)*2) INDREM(LINCNT)=1
C
C	CHECK TO SEE IF LAST CHARACTER HAS BEEN PROCESSED
271	IF(ICRCNT-KK)272,230,230
C
C	INCREMENT CHARACTER COUNTER
272	ICRCNT=ICRCNT+1
C
C	CALCULATE THE POSITION IN THE BUFFER THAT THIS CHARACTER
C	SHOULD GO INTO.
	IPOS=INDENT+ICRCNT
C
C	CHECK FOR USER DEFINED SYMBOL
	IF(IBUFF(ICRCNT).EQ.'@')GO TO 750
C
C	CHECK FOR VALID CHARACTER AND GET INDEX
	DO 210 J=1,62
210	IF(IBUFF(ICRCNT).EQ.ISYM(J)) GO TO 214
	WRITE(5,211)IBUFF(ICRCNT)
211	FORMAT(' ?NOT A RECOGNIZED SYMBOL: 'A2,'  TRY AGAIN')
	GO TO 298
C
C	GET THAT CHARACTER'S DATA FROM SYMBOL LIBRARY
214	READ(1#J,215,END=240,ERR=240)(LINBF(LINCNT,IPOS,I),I=1,8)
215	FORMAT(8A7)
C
C	LOOP BACK FOR ANOTHER CHARACTER
	GO TO 271
C
C	BLANK OUT THE PARTS OF THE BUFFER NOT USED TO HOLD CHARACTERS
230	IF(INDENT)252,252,249
249	DO 250 KL=1,INDENT
	DO 250 KM=1,8
250	LINBF(LINCNT,KL,KM)= BLANKS
C
C	CHECK IF THERE IS BLANK SPACE AT END OF LINE
252	IF(12-(INDENT+ICRCNT))262,262,256
256	DO 258 KL=INDENT+ICRCNT+1,12
	DO 258 KM=1,8
C
C	USE NULLS INSTEAD OF BLANKS TO CONSERVE SPACE.
258	LINBF(LINCNT,KL,KM)= 0
C
C	IF FASTFORM (INSIGN)AND MAX. NUMBER OF LINES IS NOT
C	EXCEEDED GO BACK FOR ANOTHER LINE.
262	IF((FFORM).AND.(LINCNT.LT.10))GO TO 200
C
C	CLEAR THE INSIGN FLAG SO ERASES AND INLINES WONT LOOP
	FFORM=.FALSE.
C
C	JUMP BACK TO ERASE IF WE CAME FROM THERE
	IF(ERASE)GO TO 125
C
C	LOOP BACK FOR ANOTHER COMMAND
	GO TO 1
C
C	ERROR TRAP FOR TROUBLE READING SYMBOL LIBRARY.
240	WRITE(5,241)
241	FORMAT(' ?CANNOT ACCESS SYMBOL DATA FILE SYS:SIGN.LIB ')
C
C	LOOP BACK FOR ANOTHER COMMAND
	GO TO 1
C
C
C
C
C
C	***H***
C	THIS IS THE HELP TEXT.
300	WRITE(5,301)
301	FORMAT(' SIGN MAKER  V.4',/,' COMMANDS:'/,
	2' INLINE-TYPED TO INPUT EACH LINE OF A SIGN',/,
	3' INSIGN- TYPED TO INPUT A WHOLE SIGN, RATHER THAN',/,
	3'     A LINE AT A TIME.',/,
	4' PRINT-PRINTS ASSEMBLED SIGN AND CLOSES FILE',/,
	5' DEFSYM-LETS USER DEFINE A CHARACTER OR SYMBOL',/,
	7' ERASE N- TO REPLACE THE NTH LINE OF A SIGN',/,
	7' WIPE- ZEROES OUT THE SIGN IN CORE AND RESETS LINE-COUNTER',/,
	8' H-THIS TEXT',/,
	9' EXIT -TO EXIT FROM THE PROGRAM',/,
	1' PARAMETERS:',/,
	2' 12 CHARS/LINE 10 LINES/SIGN',/,
	3'  THE  USER DEFINED SYMBOL IS',/,
	4' INCLUDED IN A SIGN BY TYPE THE CHARACTER "@" IN ITS',/,
	5' PLACE WHEN YOU INPUT A STRING TO "INLINE"',/,
	6' OR "INSIGN" AFTER USING "DEFSYM"'/,
	7' FURTHER INSTRUCTIONS FOR USE OF "INSIGN " AND "DEFSYM"',/,
	8' WILL BE OFFERED AT APPROPRIATE TIMES.',/,
	7' ALL SIGNS ARE CENTERED AUTOMATICALLY'/)
C
	WRITE(5,350)
350	FORMAT(' DO YOU WISH TO SEE CHARACTER SET?(Y OR N)',$)
	READ(5,302)IANSW
302	FORMAT(A1)
C
C	LOOP BACK FOR ANOTHER COMMAND
	IF(IANSW.EQ.'N') GO TO 1
	WRITE(5,303)ISYM
303	FORMAT(1X,30A2,/,1X,32A2,/)
C
C	LOOP BACK FOR ANOTHER COMMAND
	GO TO 1
C
C
C
C
C
C	***PRINT***
C
C	CHECK TO SEE IF THERE IS A SIGN OPEN (IPRFLG=0)
400	IF(IPRFLG)401,401,433
433	WRITE(5,444)
444	FORMAT(' ?NOTHING TO PRINT',/)
C
C	LOOP BACK FOR ANOTHER COMMAND
	GO TO 1
C
C	SKIP LINES ON PAGE TO CENTER SIGN
401	ISKIP=(60-(LINCNT*12))/2
C
C	SPACING, USED TO ADJUST SO THAT CHARRIAGE CONTROL IS NOT
C	NESS.
	WRITE(LPT,404)
	WRITE(LPT,404)
	IF (ISKIP)410,410,402
402	DO 403 KK=1,ISKIP-2
403	WRITE(LPT,404)
404	FORMAT(' ')
C
C	ACTUAL WRITING TAKES PLACE
410	DO 499 J=1,LINCNT
C
C	CHECK FOR ODD NUMBER OF CHARACTERS (USE SECOND FORMAT)
	IF(INDREM(J))415,415,450
415	WRITE(LPT,408)((LINBF(J,K,I),K=1,12),I=1,8)
408	FORMAT(8(' ',7X,12(A7,3X)/)/)
C
C	NO SKIP AFTER FIFTH LINE BECAUSE PAGE THROW DOES THAT
	IF(J.NE.5)WRITE(LPT,482)
482	FORMAT(' ',/,' ')
	GO TO 499
450	WRITE(LPT,455)((LINBF(J,K,I),K=1,12),I=1,8)
C
C	THIS IS THE SECOND FORMAT
455	FORMAT(8(' ',11X,12(A7,3X)/)/)
	IF(J.NE.5)WRITE(LPT,482)
499	CONTINUE
C
C	CLOSE THE FILE
C
C	THIS RELEASE IS DONE BECAUSE USER MAY CONTROL C OUT
C	OF PROGRAM, AND AN END-FILE LOSES THE LAST BIT OF THE BUFFER.
	CALL RELEAS(LPT)
C
C	INITIALIZE LINE COUNTER
	LINCNT=0
C
C	SET IPRFLG TO INDICATE THAT A PRINT WAS JUST DONE
	IPRFLG=1
C
C	LOOP BACK FOR ANOTHER COMMAND
	GO TO 1
C
C
C
C
C
C
C-----OPENING PROCEDURE USED BY BOTH INLINE AND INSIGN
C-----WHEN THERE IS NO OPEN FILE (I.E. A PRINT WAS DONE)
C
C	INCREMENT SIGN COUNTER BY 1
500	ISICNT=ISICNT+1
C
C	CLEAR IPRFLG TO INDICATE THERE IS AN OPEN SIGN
508	IPRFLG=0
C
C	MAKE A NAME FOR THE FILE.
	ENCODE(5,504,INAME)ISICNT
504	FORMAT('SGN',I2)
C
C	OPEN UP THE FILE
	CALL OFILE(LPT,INAME)
C
C	JUMP BACK TO INLINE OR INSIGN.
	GO TO (203,805),IRET
C
C
C
C
C
C
C
C	***EXIT***
C
C	CHECK FOR OPEN SIGNS
600	IF(IPRFLG.EQ.1.OR. LINCNT.EQ.0)GO TO 605
	WRITE(5,537)ISICNT
537	FORMAT(' ?YOU HAVE NOT PRINTED SIGN',I3,' YET')
C
C	LOOP BACK FOR ANOTHER COMMAND
	GO TO 1
605	WRITE(5,601)ISICNT
601	FORMAT(' TOTAL OF ',I3,' SIGNS CREATED')
	STOP
C
C
C
C
C
C
C
C	***DEFSYM***
C
C	ASK IF THEY WANT INSTRUCTIONS
700	WRITE(5,804)
	READ(5,4)INDO
	IF(INDO.EQ.'N')GO TO 780
	WRITE(5,710)
710	FORMAT(' EACH SYMBOL IS 7 CHARACTERS ACROSS AND 8',/,
	1 ' CHARACTERS HIGH.  YOUR DEFINED SYMBOL IS CALLED BY',/,
	2 ' TYPING THE CHARACTER "@" IN ITS PLACE WHEN YOU',/,
	3 ' INPUT A STRING TO THE COMMAND "INLINE". NOW TYPE IN A',/,
	4 ' ROW OF YOUR SYMBOL AFTER EACH "^" APPEARS.',/,
	5 ' (<CR> AFTER EACH ROW)')
780	WRITE(5,785)
785	FORMAT('   1234567',/)
C
C	GET THE USER DEFINED SYMBOL FROM THE TTY
	DO 725 KL=1,8
	WRITE(5,713)KL
713	FORMAT('+',I1,'^',$)
725	READ(5,715)NEWSYM(KL)
715	FORMAT(A7)
	WRITE(5,730)
730	FORMAT(' NEW SYMBOL DEFINED'/)
C
C	SET DEFLG TO INDICATE THAT THERE IS A USER DEFINED SYMBOL
	DEFLG=.TRUE.
C
C	LOOP BACK FOR ANOTHER COMMAND
	GO TO 1
C
C	INSIGN AND INLINE JUMP HERE WHEN '@' IS FOUND IN INPUT STRING
C
C	CHECK IF THERE IS A USER DEFINED SYMBOL
750	IF(.NOT.DEFLG)GO TO 790
C
C	TRANSFER USER SYMBOL TO CHARACTER BUFFER
	DO 775 J=1,8
775	LINBF(LINCNT,IPOS,J)=NEWSYM(J)
C
C	RETURN TO INLINE PORTION.
	GO TO 271
790	WRITE(5,793)
793	FORMAT(' "@" MUST NOT APPEAR IN AN INPUT STRING UNTIL',/,
	1 ' YOU HAVE GONE THRU DEFSYM DIALOG TO DEFINE THE SYMBOL',/,
	2 ' THE LINE HAS NOT BEEN COMPILED.'/)
	GO TO 298
C
C
C
C
C
C	***INSIGN***
C
C	IF A PRINT WAS JUST DONE JUMP TO OPENING ROUTINE.
800	IF(IPRFLG)803,805,803
803	IRET=2
	GO TO 500
C
C	CHECK IF USER HAS SAID HE DOESN'T WANT INSRUCTIONS
805	IF(NOFLG)GO TO 850
	WRITE(5,804)
804	FORMAT(' INSTRUCTIONS? (Y OR N):',$)
	READ(5,806)INDO
806	FORMAT(A1)
	WRITE(5,801)
801	FORMAT(' ')
	IF(INDO.EQ.'N')GO TO 840
	WRITE(5,810)
810	FORMAT(' FAST FORM OF INLINE COMMAND',/,
	1' KEEPS YOU IN INLINE MODE. TYPE IN A LINE OF THE',/,
	2' SIGN AFTER EACH "LINE NO.:" APPEARS. TO RETURN TO',/,
	4' COMMAND LEVEL, TYPE  A ^Z. ANY ERROR RETURNS',/,
	5' YOU TO COMMAND MODE . THERE IS AN AUTOMATIC',/,
	1' RETURN TO COMMAND MODE AFTER THE',/,
	2' TENTH LINE OF A SIGN IS INPUT.'//)
C
C	SET FLAG TO INDICATE THAT USER HAS EITHER HAD INSTRUCTION
C	OR DOESN'T WANT IT
840	NOFLG=.TRUE.
C
C	SET FAST FORM FLAG FOR INSIGN TO USE INLINE
850	FFORM=.TRUE.
C
C	FORMAT USED BY INLINE WHEN FFORM IS SET
855	FORMAT('+LINE ',I2,': ',$)
C
C	JUMP FROM HERE INTO THE INLINE PORTION.
	GO TO 200
C
C
C
C
C
C	***FOR EXPANSION***
900	CONTINUE
C
C	LOOP BACK FOR ANOTHER COMMAND
	GO TO 1
C
C
C
C
C
C
C	*** WIPE ***
1000	LINCNT=0
C
C	LOOP BACK FOR ANOTHER COMMAND
	GO TO 1
	END