C PROGRAM MSGWTR C C THIS IS THE INFAMOUS 'MESSAGEWRITER' PROGRAM. C COURTESY OF SAUL ROSENBERG C STATE UNIVERSITY OF NEW YORK AT STONY BROOK C COMMON LINE COMMON PUT,ALPHA,HOLD,INFO DIMENSION PUT (3, 150), ALPHA(41, 101), HOLD(42, 102), 1 INFO(60, 5, 5), FIXED(60), LIM(60), OUT(60) INTEGER FR, WIDTH INTEGER HOLD,ALPHA,PUT,CHAR,OUT,BLANK,FIXED,SET C ************************************************************************** C ORDER OF THE DATA DECK. C REFER TO THE APPROPRIATE 'FORMAT' STATEMENTS. C C 'LARGE' CARD. CURRENTLY SET TO 47. C 47 CARDS CONTAINING CHARACTER GENERATION INFORMATION. C 'KHAR', 'LINE', 'WIDTH', 'SET' CARD. C CARD(S) CONTAINING CHARACTERS TO BE PRINTED. C '9' CARD. LAST CARD INDICATOR. C C ************************************************************************** CALL OPEN (2,'MSGWRT.DAT',0,'RDO') BLANK=1H WRITE(6,1000) 1000 FORMAT (1H1) C THIS AND THE NEXT READ CHANGED FROM 5 TO 8 TO ALLOW DATA TO BE STORED ON DISK READ (2, 101) LARGE C LARGE - = OF SYMBOLS AND CHARACTERS IN CHARACTER SET. 101 FORMAT (I4) DO 42 K=1,LARGE READ(2,100) OUT(K),FIXED(K),MAX,((INFO(K,J,L),L=1,5),J=1,MAX) 100 FORMAT (2X 2A1, 2I2, 24I3) IF (OUT(K) .NE. BLANK) GO TO 42 OUT(K) = FIXED(K) 42 LIM(K) = MAX C KHAR - = OF CHARACTERS TO BE READ IN FROM CARD. C LINE - = OF LINES / PAGE. MAXIMUM OF 3. C WIDTH - = OF LETTERS FORMING THE WIDTH OF AN OUTPUT CHARACTER. MAX 19 C SET - DEFINES COMPOSITION OF LETTERS. IF BLANK, LETTER IS FORMED C OF ITSELF. IF A CHARACTER IS PRESENT, IT IS USED. 28 READ (2,102,END=44) KHAR, LINE, WIDTH, SET C NEXT CARD CHANGED SO ONLY TWO DIGITS NEED BE SPECIFIED FOR CONTROL 102 FORMAT (3I2, 1X A1) C IF (KHAR .GT. 8000) STOP IF (KHAR .GT. 80 ) STOP 43 NOLD = 0 IF (LINE .LT. 1) GO TO 1 IF (LINE .LT. 4) GO TO 2 WRITE (6, 202) LINE 202 FORMAT (/ 21H ERROR I CAN'T WRITE I4, 15H LINES TOGETHER ) READ (2,103,END=44) ( PUT(1, K), K=1,LINE) 103 FORMAT (A1) GO TO 28 1 LINE = 1 2 IF (WIDTH .LT. 1 .OR. WIDTH .GT. 19) WIDTH = (LINE / 3) * 2 + 7 DO 3 L=1,LINE READ (2,104,END=44) ( PUT(L, K), K=1,KHAR) 104 FORMAT (80A1) 3 CONTINUE NAD = MOD(KHAR, LINE) IF (NAD .LT. 1) GO TO 5 NAD = LINE - NAD DO 4 N=1,NAD K = KHAR + N DO 4 L = 1, LINE 4 PUT(L,K) = BLANK KHAR = KHAR + NAD 5 LOW = WIDTH + 1 LTON = WIDTH/2 + 1 KWID = IFIX(10.0/6.0 * FLOAT(WIDTH) + 0.5) KOW = KWID + 1 KTON = KWID / 2 + 1 JUM = 1 IF (SET .NE. BLANK) JUM = 2 NOL = 1 NOP = KHAR / LINE DO 27 NUM = 1, NOP IND = NUM IF (LINE .LT. 2) GO TO 33 DO 30 J = 1, 42 DO 30 K = 1, 102 30 HOLD(J,K) = BLANK NOK = 1 25 IND = (NUM-1) * LINE + NOK NOL = 1 33 CHAR = PUT (NOL,IND) IF (CHAR.EQ.BLANK) GO TO 29 DO 21 LET = 1, LARGE IF (CHAR .EQ. FIXED(LET)) GO TO 22 21 CONTINUE WRITE(6,222) NOL, IND, CHAR 222 FORMAT (/12H ERROR LINE I2, 5H KHAR I3, 4H IS A1, 21H IT IS NOT 1ON MY LIST ) 29 IF (LINE .GT. 1) GO TO 35 WRITE(6,206) 206 FORMAT(1H1,//) GO TO 27 22 IF (NOLD .EQ. LET) GO TO 41 NOLD = LET CHAR = OUT(LET) IF (JUM .GT. 1) CHAR = SET DO 23 J = 1, 41, LINE DO 23 K = 1, 101, LINE 23 ALPHA(J,K) = BLANK ML = LIM(LET) DO 6 FR = 1, ML MN = INFO(LET,FR,2) MX = INFO (LET, FR, 3) MZ = INFO (LET, FR, 4) MA = INFO (LET, FR, 5) IP = INFO (LET, FR, 1) IF (IP .LT. 0) IP = IP + 12 GOTO(301,302,303,304,305,306,295,296),IP C THE FOLLOWING ROUTINES USE THE DATA IN INFO AND CONVERT IT TO LINES ON ALPHA C PARALLEL LINE (TO THE DIRECTION OF MOTION OF THE PAPER) ...L.J.B. 301 KR = MZ + KTON IF (MZ .LT. 4) KR = KOW IF (MZ .GT. 98) KR = 102 CALL LAJ(MN, MX) DO 7 J = MN, MX, LINE DO 7 L = 1, KWID K = KR - L 7 ALPHA (J,K) = CHAR GO TO 6 C PERPENDICULAR LINE (LJB WAS HERE TOO) 302 JR = MZ + LTON IF (MZ .LT. 4) JR = LOW IF (MZ .GT. 38) JR = 42 CALL LAJ(MN,MX) DO 8 K=MN,MX,LINE DO 8 L=1,WIDTH J = JR - L 8 ALPHA(J, K) = CHAR GO TO 6 C DIAGONAL LINE 303 IF (MN .LT. 4) MN = LTON IF (MZ .GT. 38) MZ = 42 - LTON SLOPE = FLOAT (MZ - MN) / FLOAT (MA - MX) BINT = FLOAT (MN) - SLOPE * FLOAT (MX) + 0.5 CALL LAJ(MX, MA) DO 9 K=MX, MA, LINE JR = IFIX (FLOAT (K) * SLOPE + BINT) + LTON DO 9 L=1,WIDTH J = JR - L 9 ALPHA(J, K) = CHAR GO TO 6 C VERTICAL ELLIPSE 296 JUMP=1 GO TO 12 304 JUMP=2 12 IF (MX .LT. 4) MX = KTON IF (MA .GT. 98) MA = 102 - KTON K = MA + MX MA = MA - MOD(K, 2) KONK = (MA + MX) / 2 B = FLOAT(KONK - MX) RANJ = FLOAT((MZ - MN) ** 2) CALL LAJ(MN, MZ) DO 10 J=MN, MZ, LINE GO TO (13,14,17,18) JUMP 13 CJ = FLOAT((MZ - J) ** 2) GO TO 15 14 CJ = FLOAT((J - MN) ** 2) 15 KR = IFIX(B * SQRT(1.0 - CJ / RANJ)) KR1 = KONK + KR + KTON KR2 = KONK - KR + KTON DO 10 L=1,KWID K1 = KR1 - L K2 = KR2 - L ALPHA(J, K1) = CHAR 10 ALPHA(J, K2) = CHAR GO TO 6 C HORIZONTAL ELLIPSE 295 JUMP=3 GO TO 16 305 JUMP=4 16 IF (MX .LT. 4) MX = LTON IF (MA .GT. 38) MA = 42 - LTON J = MX + MA MA = MA - MOD(J, 2) KONK = (MA + MX) / 2 B = FLOAT(KONK - MX) RANJ = FLOAT((MZ - MN) ** 2) CALL LAJ(MN, MZ) DO 11 K=MN, MZ, LINE GO TO (13,14,17,18) JUMP 17 CJ = FLOAT((MZ - K) ** 2) GO TO 19 18 CJ = FLOAT((K - MN) ** 2) 19 KR = IFIX(B * SQRT(1.0 - CJ / RANJ)) JR1 = KONK + KR + LTON JR2 = KONK - KR + LTON DO 11 L=1,WIDTH J1 = JR1 - L J2 = JR2 - L ALPHA(J1, K) = CHAR 11 ALPHA(J2, K) = CHAR GO TO 6 C AREA CIRCLE 306 MAX = 2 * MX RAD = FLOAT(MZ ** 2) MZ1 = MZ + 1 DO 20 KR=1,MZ1 K = KR - 1 K1 = MX + K K2 = MAX - K1 JR = IFIX(0.6 * SQRT(RAD - FLOAT(K ** 2))) J1 = MN - JR J2 = MN + JR CALL LAJ(J1, J2) DO 20 J=J1, J2, LINE ALPHA(J, K1) = CHAR 20 ALPHA(J, K2) = CHAR 6 CONTINUE 41 IF (LINE .LT. 2) GO TO 26 JR = (NOK - 1) * (-7 * LINE + 35) K = (LINE - NOL) * (-17 * LINE + 85) DO 24 JA=1,41, LINE JR = JR + 1 KR = K DO 24 KA=1,101,LINE KR = KR + 1 24 HOLD(JR, KR) = ALPHA(JA, KA) 35 NOL = NOL + 1 IF (NOL .LE. LINE) GO TO 33 NOK = NOK + 1 IF (NOK .LE. LINE) GO TO 25 IF (LINE .GT. 2) GO TO 50 WRITE (6, 212) ((HOLD(J, K), K=1,102), J=1,42) 212 FORMAT (1H ///21(/ 10X 51A1, 10X 51A1), /1H- /1H- /1H- /1H- 21(/ 1 10X 51A1, 10X 51A1) ) GO TO 27 50 WRITE (6, 213) ((HOLD(J, K), K=1,102), J=1,42) 213 FORMAT (1H ///14(/ 7X34A1, 7X34A1, 7X34A1), /1H- /1H- /1H0 14(/ 1 7X 34A1, 7X 34A1, 7X 34A1), /1H- /1H- /1H0 14(/ 7X 34A1, 7X 34A1, 2 7X 34A1) ) GO TO 27 26 WRITE (6, 205) ((ALPHA(J, K), K=1, 101), J=1,41) 205 FORMAT (1H ////////// (15X 101A1)) 27 CONTINUE GO TO 28 44 STOP END SUBROUTINE LAJ(J, K) COMMON LINE IF (LINE - 2) 1, 2, 3 2 J = (J/2) * 2 + 1 1 RETURN 3 L = ((J + 1)/ 3)* 3 + 1 IF (L .GT. K) GO TO 1 J = L RETURN END FUNCTION MOD(I,J) MOD=I-((I/J)*J) RETURN END