Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0059/txtpad.for
There is 1 other file named txtpad.for in the archive. Click here to see a list.
BLOCK DATA
C
C TTTTTTTTT XXX XXX TTTTTTTTT PPPPPPPP AAA DDDDDDD
C TTT XXX XXX TTT PPP PPP AAA AAA DDD DDD
C TTT XXX TTT PPPPPPPP AAA AAA DDD DDD
C TTT XXX XXX TTT PPP AAAAAAAAA DDD DDD
C TTT XXX XXX TTT PPP AAA AAA DDDDDDD
C
C TXTPAD, A TEXT ILLUSTRATION SKETCHPAD
C
C CONSTRUCTS PICTURES FROM ALPHAMERIC CHARACTERS.
C
C DONALD E. BARTH, CHEMISTRY DEPT., HARVARD UNIVERSITY
C
COMMON/TXTPAD/LETTER(84),ISTORE(3600),LINE(1800),
1IERASE,IHIGH,ILOCK,INAME,INIT,IOFF,ISTART,ITAB,
2ITAPE,IX,IY,IZ,JHIGH,JLOCK,JNAME,JTAPE,JX,JY,JZ,
3KDST,KEY,KNTLTR,KOUNT,LDST,LTR,MAX,MODE,MOST,
4MOVTAB,NEAR,LOSE,IMIN,IMAX,JMIN,JMAX
C
C
C ITAB = THE TABULATION CHARACTER. WHEN PRINTED MOVES
C OUTPUT TO BEYOND THE NEXT MULTIPLE OF SOME
C SPACING INCREMENT INDICATED AT MOVTAB. WITH
C MOVTAB SET AT 8, AN X FOLLOWED BY A TABULATION
C CHARACTER FOLLOWED BY A Y WOULD PRINT AS X
C IN COLUMN 1 AND Y IN COLUMN 9. IF THE TABULATION
C CHARACTER IS NOT AVAILABLE, ITAB SHOULD BE
C DEFINED AS A BLANK (SPACE) CHARACTER.
C TABULATION CHARACTERS CAN BE READ IN THE
C INPUT FILE, BUT ARE TRANSLATED TO BLANKS.
C LETTER = ARRAY CONTAINING THE ALPHABET MENU. KNTLTR
C SET IN MAIN PROGRAM DETERMINES NUMBER OF ITEMS
C TO BE USED FROM LETTER ARRAY. KNTLTR IS
C SET AT 46 UNLESS LETTER ARRAY IS READ IN FROM
C FILE TXTPA.DAT.
C LOSE = NUMBER OF CHARACTERS TO BE REJECTED AT START
C OF TYPED CAPTION READ FROM TTY. WITH THE
C SYSTEM FOR WHICH THIS WAS WRITTEN, 1 GARBAGE
C CHARACTER AT END OF THE STYLUS COORDINATE
C MESSAGE MUST BE IGNORED SO LOSE IS 1.
C KDST = HALF-WIDTH OF PLOTTED TRACKING CHARACTERS.
C LDST = HALF-HEIGHT OF PLOTTED TRACKING CHARACTERS.
C MAX = DIMENSION OF THE ISTORE ARRAY.
C MOST = DIMENSION OF THE LINE ARRAY. THIS IS
C THE MAXIMUM NUMBER OF CHARACTERS WHICH CAN
C BE IDENTIFIED AS WITHIN A SINGLE STRUCTURE
C TO BE MOVED, COPIED OR KILLED.
C
DIMENSION LTRSML(46)
EQUIVALENCE (LETTER(1),LTRSML(1))
C
DATA ITAB/1H /
DATA LOSE/1/
DATA MAX/3600/
DATA MOST/1800/
DATA MOVTAB/8/
DATA LTRSML/
11HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
21HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,
31HU,1HV,1HW,1HX,1HY,1HZ,1H0,1H1,1H2,1H3,
41H4,1H5,1H6,1H7,1H8,1H9,1H(,1H),1H*,1H/,
51H+,1H-,1H.,1H,,1H',1H=/
DATA KDST,LDST/6,7/
END
C
C TTTTTTTTT XXX XXX TTTTTTTTT PPPPPPPP AAA DDDDDDD
C TTT XXX XXX TTT PPP PPP AAA AAA DDD DDD
C TTT XXX TTT PPPPPPPP AAA AAA DDD DDD
C TTT XXX XXX TTT PPP AAAAAAAAA DDD DDD
C TTT XXX XXX TTT PPP AAA AAA DDDDDDD
C
C TXTPAD, A TEXT ILLUSTRATION SKETCHPAD
C
C CONSTRUCTS PICTURES FROM ALPHAMERIC CHARACTERS.
C
C DONALD E. BARTH, CHEMISTRY DEPT., HARVARD UNIVERSITY
C
C KDST = HALF-WIDTH OF TRACKING CHARACTERS
C LDST = HALF-HEIGHT OF TRACKING CHARACTERS
C
C ITAPE = INITIALLY INPUT TAPE UNIT
C INAME = INITIALLY INPUT FILE NAME
C ILOCK = 0, INPUT FILE IS NOT OPEN
C = 1, INPUT FILE IS OPEN
C JTAPE = INITIALLY OUTPUT TAPE UNIT
C JNAME = INITIALLY OUTPUT FILE NAME
C JLOCK = 0, OUTPUT FILE IS NOT OPEN
C = 1, OUTPUT FILE IS OPEN
C
C IERASE = TEMPORARY VARIABLE USED DECIDE IF SCREEN
C NEEDS ERASING AFTER INSERTING OR ERASING
C CHARACTERS.
C IHIGH = HEIGHT OF SPACE FOR A SINGLE LETTER IN THE
C DISPLAYED GRID.
C INIT = POSITION IN ISTORE ARRAY OF FIRST
C CHARACTER POINTED TO WHILE PEN IS DOWN.
C IOFF = ISTART/60. THE NUMBER OF LINES NOT SHOWN.
C ISTART = OFFSET FROM START OF THE ISTORE ARRAY TO
C THE START OF THE SECTION TO BE DISPLAYED.
C IX = X COORDINATE OF STYLUS.
C IY = Y COORDINATE OF STYLUS.
C JHIGH = HALF OF IHIGH
C KEY = 0, PICTURE NOT CHANGED SINCE LAST STORE
C = 1, PICTURE HAS CHANGED SINCE LAST STORE
C KOUNT = NUMBER OF NON-BLANK CHARACTERS IN PICTURE.
C KX = X COORDINATE OF CENTER OF FIRST CHARACTER
C POINTED TO WHEN PEN IS DOWN.
C KY = Y COORDINATE OF CENTER OF FIRST CHARACTER
C POINTED TO WHEN PEN IS DOWN.
C LETTER = ARRAY CONTAINING INDIVIDUAL CHARACTERS FROM
C WHICH PICTURE GAN BE CONSTRUCTED.
C LINE = BUFFER ARRAY INTO WHICH NEW TEXT FROM
C INPUT FILE IS READ BEFORE BEING INSERTED
C INTO EXISTING PICTURE.
C LTR = SUBSCRIPT OF TRACKING LETTER WITHIN
C LETTER ARRAY.
C MAX = DIMENSION OF ISTORE ARRAY.
C MODE = IDENTIFIES SWITCH IN MENU POINTED TO.
C MOST = DIMENSION OF LINE ARRAY. MAXIMUM NUMBER OF
C CHARACTERS IN A STRUCTURE MANIPULATED BY THE
C MOVE, COPY OR KILL COMMANDS.
C
COMMON/TXTPAD/LETTER(84),ISTORE(3600),LINE(1800),
1IERASE,IHIGH,ILOCK,INAME,INIT,IOFF,ISTART,ITAB,
2ITAPE,IX,IY,IZ,JHIGH,JLOCK,JNAME,JTAPE,JX,JY,JZ,
3KDST,KEY,KNTLTR,KOUNT,LDST,LTR,MAX,MODE,MOST,
4MOVTAB,NEAR,LOSE,IMIN,IMAX,JMIN,JMAX
C
DIMENSION LINSML(60)
EQUIVALENCE (LINE(1),LINSML(1))
C
ITAPE=1
INAME=5HINPUT
ILOCK=0
JTAPE=21
JNAME=5HOUTPU
JLOCK=0
IX=512
IY=512
JX=512
JY=512
IHIGH=25
JHIGH=12
ISTART=0
IOFF=0
KNTLTR=46
MODE=1
C
C A MENU CONTAINING ONLY THE ALPHABET, DIGITS AND
C 10 PUNCTUATION MARKS IS PROVIDED BY THE DATA
C STATEMENT WHICH DEFINES THE LETTER ARRAY. IF
C OTHER CHARACTERS ARE DESIRED, THE 84 LOCATIONS
C OF THE LETTER ARRAY CAN BE READ IN AT THIS TIME.
WRITE(5,1)
1 FORMAT(1X,14HTXTPAD (10/72)//
11X,37HIS ALPHABET MENU TO BE READ FROM FILE/
21X,37HTXTPA.DAT IN YOUR DISK AREA (Y OR N) $)
READ(5,2)I
2 FORMAT(84A1)
IF(I.EQ.1HY)GO TO 3
IF(I.NE.1H )GO TO 6
3 CALL IFILE(ITAPE,5HTXTPA)
4 READ(ITAPE,2)LETTER
KNTLTR=85
5 KNTLTR=KNTLTR-1
IF(KNTLTR.EQ.0)GO TO 4
IF(LETTER(KNTLTR).EQ.1H )GO TO 5
C
C BLANK OUT THE STORAGE AREA
6 KOUNT=0
DO 7 I=1,MAX
7 ISTORE(I)=' '
C
C PLOT BORDERS
8 CALL CRTWIP
CALL CRTSTR(1)
I=1
IERASE=0
9 CALL CRTOFF(I,1023)
CALL CRTON (I,962)
I=I+73
IF(I.LE.1023)GO TO 9
CALL CRTON ( 1, 962)
CALL CRTOFF( 62, 962)
CALL CRTON ( 62, 62)
CALL CRTON ( 962, 62)
CALL CRTON ( 962, 962)
C
C PLOT THE MENU OF VARIOUS MODES
I=37-4*KDST
J=993-LDST
K=1
L=4
10 CALL CRTLTR(
156HTTY LINECOPYMOVETRIMKILLWIPEREADSWAPSAVEHIGHLOW ALL EXIT,
2K,L,I,J)
I=I+73
K=K+4
L=L+4
IF(K.LT.56)GO TO 10
C
C PLOT THE ALPHABET MENU
J=19-KDST
K=971-LDST
DO 13 I=1,KNTLTR
IF(I.LE.28)GO TO 12
IF(I.LE.57)GO TO 11
K=K+34
GO TO 13
11 J=J+34
GO TO 13
12 K=K-34
13 CALL CRTLTR(LETTER(I),1,1,J,K)
C
C PLOT PRESENT CURVE
IF(KOUNT.EQ.0)GO TO 17
I=1+ISTART
L=962-JHIGH-LDST
M=KOUNT
N=62-LDST
GO TO 15
14 I=I+1
J=J+1
K=K+15
IF(J.LE.60)GO TO 16
L=L-IHIGH
IF(L.LT.N)GO TO 17
15 K=70-KDST
J=1
16 IF(ISTORE(I).EQ.1H )GO TO 14
M=M-1
CALL CRTLTR(ISTORE(I),1,1,K,L)
IF(M.NE.0)GO TO 14
17 CALL CRTSTR(0)
GO TO 22
C
C WAIT FOR STATE SELECTION
18 JX=IX
JY=IY
JZ=0
GO TO 20
19 JZ=1
20 CALL CRTLTR(15HOOOOOOWRSSHLAEO,MODE,MODE,
1IX-KDST,IY-LDST)
CALL CRTXYZ(IX,IY,IZ)
21 IF(IZ.EQ.0)GO TO 18
IF(JZ.NE.0)GO TO 20
C
C SELECT LETTER FOR DRAW STATE
22 IF(JY.GE.962)GO TO 26
IF(IERASE.NE.0)GO TO 8
IF(JY.GT.JX)GO TO 23
IF(JY.GT.(1024-JX))GO TO 24
IF(JY.GT.62)GO TO 19
LTR=28+((JX-3)/34)
GO TO 25
23 IF(JX.GT.62)GO TO 19
LTR=28-((JY-3)/34)
GO TO 25
24 IF(JX.LT.962)GO TO 19
LTR=57+((JY-3)/34)
25 IF(LTR.LE.0)GO TO 19
IF(LTR.GT.KNTLTR)GO TO 19
IF(LETTER(LTR).EQ.1H )GO TO 19
MODE=15
GO TO 29
C
C SELECT STATE
26 IF(JX.LE.1)GO TO 19
IF(JX.GT.1023)GO TO 19
I=MODE
MODE=(JX+71)/73
GO TO(28,28,28,28,27,27,35,52,44,37,
130,33,34,63),MODE
27 IF(KOUNT.EQ.0)GO TO 36
IF(I.EQ.5)GO TO 29
IF(I.EQ.6)GO TO 29
28 IF(IERASE.NE.0)GO TO 8
IF(MODE.EQ.1)GO TO 29
IF(KOUNT.EQ.0)GO TO 19
29 CALL TXTTRK
GO TO 22
C
C STATE = HIGH
30 I=ISTART
J=IHIGH
ISTART=0
IOFF=0
31 IHIGH=25
JHIGH=12
32 IF(IERASE.NE.0)GO TO 8
IF(KOUNT.EQ.0)GO TO 19
IF(I.NE.ISTART)GO TO 8
IF(J.NE.IHIGH)GO TO 8
GO TO 19
C
C STATE = LOW
33 I=ISTART
J=IHIGH
ISTART=1440
IOFF=24
GO TO 31
C
C STATE = ALL
34 I=ISTART
J=IHIGH
ISTART=0
IOFF=0
IHIGH=15
JHIGH=7
GO TO 32
C
C STATE = WIPE
35 IF(KOUNT.NE.0)GO TO 6
36 IF(IERASE.NE.0)GO TO 8
GO TO 19
C
C STATE = SAVE
37 IF(IERASE.NE.0)GO TO 8
IF(KOUNT.EQ.0)GO TO 19
IF(KEY.EQ.0)GO TO 19
38 KEY=0
39 IF(JLOCK.NE.0)GO TO 40
JLOCK=1
CALL OFILE(JTAPE,JNAME)
40 I=61
J=1
41 I=I-1
IF(I.EQ.J)GO TO 42
IF(ISTORE(I).EQ.1H )GO TO 41
42 WRITE(JTAPE,43)(ISTORE(K),K=J,I)
43 FORMAT(60A1)
J=J+60
I=J+60
IF(J.LT.MAX)GO TO 41
IF(MODE.EQ.9)GO TO 6
IF(MODE.EQ.10)GO TO 19
GO TO 46
C
C STATE = SWAP
44 IF(KOUNT.EQ.0)GO TO 45
IF(KEY.NE.0)GO TO 38
GO TO 6
45 IF(IERASE.NE.0)GO TO 8
46 IF(ILOCK.EQ.0)GO TO 50
ILOCK=0
IF(JLOCK.NE.0)GO TO 47
JLOCK=1
CALL OFILE(JTAPE,JNAME)
47 READ(ITAPE,43,END=50)LINSML
I=61
48 I=I-1
IF(LINSML(I).NE.1H )GO TO 49
IF(I.NE.1)GO TO 48
49 WRITE(JTAPE,43)(LINSML(J),J=1,I)
GO TO 47
50 IF(MODE.EQ.14)GO TO 65
IF(JLOCK.EQ.0)GO TO 51
JLOCK=0
ENDFILE JTAPE
REWIND JTAPE
51 I=ITAPE
ITAPE=JTAPE
JTAPE=I
I=INAME
INAME=JNAME
JNAME=I
C
C STATE = READ
52 IF(IERASE.NE.0)GO TO 8
J=ILOCK
IF(ILOCK.NE.0)GO TO 54
ILOCK=1
53 CALL IFILE(ITAPE,INAME)
54 I=0
CALL CRTSTR(1)
IMAX=962-LDST
IMIN=62-LDST
L=IMAX-JHIGH+(IHIGH*(IOFF+1))
55 L=L-IHIGH
K=55-KDST
READ(ITAPE,43,END=61)LINSML
M=60
J=0
N=0
56 IF(N.NE.0)GO TO 57
N=MOVTAB
IF(N.GT.(M-J))N=M-J
57 J=J+1
N=N-1
K=K+15
I=I+1
IF(LINSML(J).EQ.1H )GO TO 59
IF(LINSML(J).NE.ITAB)GO TO 58
I=I+N
M=M-N
K=K+15*N
N=0
GO TO 59
58 IF(ISTORE(I).NE.1H )GO TO 59
KOUNT=KOUNT+1
KEY=1
ISTORE(I)=LINSML(J)
IF(L.GE.IMAX)GO TO 59
IF(L.GE.IMIN)CALL CRTLTR(LINSML(J),1,1,K,L)
59 IF(J.LT.M)GO TO 56
I=I+N
IF(I.LT.MAX)GO TO 55
60 CALL CRTSTR(0)
GO TO 19
61 IF(I.NE.0)GO TO 62
IF(J.EQ.0)GO TO 62
REWIND ITAPE
J=0
GO TO 53
62 ILOCK=0
GO TO 60
C
C STATE = EXIT
63 IF(KOUNT.EQ.0)GO TO 64
IF(KEY.NE.0)GO TO 39
64 IF(JLOCK.EQ.0)GO TO 66
IF(ILOCK.NE.0)GO TO 47
65 ENDFILE JTAPE
66 CALL CRTSTR(1)
STOP
END
SUBROUTINE TXTTRK
C
C TXTPAD ROUTINE TO TRACK THE STYLUS IN LINE, COPY,
C MOVE, TRIM AND KILL MODES AND IN SIMPLE CHARACTER
C INSERTION MODES. PERFORMS INDICATED OPERATION WHEN
C STYLUS IS RAISED.
C
C DONALD E. BARTH, CHEMISTRY DEPT., HARVARD UNIVERSITY
C
COMMON/TXTPAD/LETTER(84),ISTORE(3600),LINE(1800),
1IERASE,IHIGH,ILOCK,INAME,INIT,IOFF,ISTART,ITAB,
2ITAPE,IX,IY,IZ,JHIGH,JLOCK,JNAME,JTAPE,JX,JY,JZ,
3KDST,KEY,KNTLTR,KOUNT,LDST,LTR,MAX,MODE,MOST,
4MOVTAB,NEAR,LOSE,IMIN,IMAX,JMIN,JMAX
IF(MODE.EQ.15)GO TO 4
1 INIT=0
2 JZ=-1
3 CALL CRTLTR(6HTLCMTK,MODE,MODE,IX-KDST,IY-LDST)
GO TO 7
4 INIT=0
5 JZ=-1
6 CALL CRTLTR(LETTER(LTR),1,1,IX-KDST,IY-LDST)
7 CALL CRTXYZ(IX,IY,IZ)
IF(IZ.EQ.0)GO TO 10
C
C TRACK STYLUS
IF(JZ.EQ.0)GO TO 44
IF(JZ.GT.0)GO TO 8
IF(MODE.EQ.15)GO TO 6
IF(MODE.GE.5)GO TO 3
IF(INIT.EQ.0)GO TO 3
GO TO 10
8 IF(MODE.EQ.5)GO TO 22
IF(MODE.EQ.6)GO TO 26
IF(MODE.EQ.15)GO TO 20
IF(INIT.NE.0)GO TO 25
IF(MODE.EQ.1)GO TO 9
IF(ISTORE(JZ).EQ.1H )GO TO 2
9 INIT=JZ
KX=JX
KY=JY
10 IF(IX.LT.62)GO TO 16
IF(IX.GE.962)GO TO 16
IF(IY.LT.62)GO TO 16
IF(IY.GE.962)GO TO 16
JX=(IX-47)/15
JY=(961-IY)/IHIGH
JZ=ISTART+(60*JY)+JX
JX=55+15*JX
JY=962-JHIGH-(IHIGH*JY)
IF(INIT.EQ.0)GO TO 14
IF(JZ.EQ.INIT)GO TO 14
C TEST IF HORIZONTAL OR VERTICAL LINES
IF(JX.EQ.KX)GO TO 11
IF(JY.EQ.KY)GO TO 11
C TEST IF DIAGONAL LINE SHOULD BE DRAWN
I=INIT-JZ
IF(I.LT.0)I=-I
IF(I.EQ.(59*(I/59)))GO TO 11
IF(I.NE.(61*(I/61)))GO TO 12
11 CALL CRTOFF(KX,KY)
CALL CRTON (JX,JY)
GO TO 19
12 IF(ISTORE(INIT).EQ.1H )GO TO 13
CALL CRTOFF(KX-7,KY-JHIGH)
CALL CRTON (KX+7,KY-JHIGH)
CALL CRTON (KX+7,KY+JHIGH)
CALL CRTON (KX-7,KY+JHIGH)
CALL CRTON (KX-7,KY-JHIGH)
IF(ISTORE(JZ).NE.1H )GO TO 15
CALL CRTLTR(ISTORE(INIT),1,1,JX-KDST,JY-LDST)
GO TO 19
13 CALL CRTLTR(6HTLCMTK,MODE,MODE,KX-KDST,KY-LDST)
14 IF(ISTORE(JZ).EQ.1H )GO TO 17
15 CALL CRTOFF(JX-7,JY-JHIGH)
CALL CRTON (JX+7,JY-JHIGH)
CALL CRTON (JX+7,JY+JHIGH)
CALL CRTON (JX-7,JY+JHIGH)
CALL CRTON (JX-7,JY-JHIGH)
GO TO 19
16 IF(IZ.NE.0)GO TO 3
JX=IX
JY=IY
JZ=0
17 IF(MODE.NE.15)GO TO 18
CALL CRTLTR(LETTER(LTR),1,1,JX-KDST,JY-LDST)
GO TO 19
18 CALL CRTLTR(6HTLCMTK,MODE,MODE,JX-KDST,JY-LDST)
19 IF(IZ.NE.0)JZ=-1
GO TO 7
C
C MODE = 15 (INSERT SINGLE CHARACTER)
20 IF(ISTORE(JZ).EQ.LETTER(LTR))GO TO 5
IF(ISTORE(JZ).NE.1H )GO TO 23
KEY=1
CALL CRTSTR(1)
CALL CRTLTR(LETTER(LTR),1,1,JX-KDST,JY-LDST)
KOUNT=KOUNT+1
21 CALL CRTSTR(0)
ISTORE(JZ)=LETTER(LTR)
GO TO 5
C
C MODE = 5 (ERASE SINGLE CHARACTER)
22 IF(ISTORE(JZ).EQ.1H )GO TO 2
KOUNT=KOUNT-1
ISTORE(JZ)=' '
23 IERASE=1
KEY=1
CALL CRTSTR(1)
CALL CRTOFF(JX-7,JY-JHIGH)
CALL CRTON (JX+7,JY-JHIGH)
CALL CRTON (JX+7,JY+JHIGH)
CALL CRTON (JX-7,JY+JHIGH)
CALL CRTON (JX-7,JY-JHIGH)
IF(MODE.EQ.15)GO TO 21
24 CALL CRTSTR(0)
IF(KOUNT.NE.0)GO TO 2
JX=512
JY=512
GO TO 44
C
C MODE = 1 (INSERT TEXT READ FROM TTY)
C MODE = 2 (DUPLICATE LETTER TO FORM LINE)
25 IF(MODE.GT.2)GO TO 27
IF(JZ.EQ.INIT)GO TO 1
CALL CRTSTR(1)
CALL TXTLIN
CALL CRTSTR(0)
GO TO 1
C
C MODE = 3 (COPY SINGLE STRUCTURE)
C MODE = 4 (MOVE SINGLE STRUCTURE)
C MODE = 6 (KILL SINGLE STRUCTURE)
26 IF(ISTORE(JZ).EQ.1H )GO TO 2
INIT=JZ
GO TO 28
27 IF(INIT.EQ.JZ)GO TO 1
28 KEY=1
CALL TXTGRP
CALL CRTSTR(1)
IF(MODE.EQ.3)GO TO 35
IERASE=1
CALL TXTOUT
IF(MODE.NE.6)GO TO 30
KOUNT=KOUNT-NEAR
DO 29 I=1,NEAR
J=LINE(I)
29 ISTORE(J)=' '
INIT=0
GO TO 24
C
C ORDER THE ARRAY CONTAINING POINTERS TO THE
C STRUCTURE TO BE MOVED. ORDER IN INCREASING
C DIRECTION IF STRUCTURE TO BE MOVED LEFT OR
C UP (TO LOWER SUBSCRIPTS IN ISTORE ARRAY) OR
C DECREASING OTHERWISE.
30 JMIN=JMIN-KDST
JMAX=JMAX-KDST
IF(NEAR.EQ.1)GO TO 35
I=JMAX-JMIN-15
J=JX-KX
IF(J.GT.I)GO TO 35
IF(-J.GT.I)GO TO 35
J=JZ-INIT
I=IMAX-IMIN
IF(J.GT.I)GO TO 35
IF(-J.GT.I)GO TO 35
K=NEAR-1
DO 34 L=1,K
M=0
N=LINE(L)
II=L+1
DO 33 I=II,NEAR
IF(J.LT.0)GO TO 31
IF(N.GE.LINE(I))GO TO 33
GO TO 32
31 IF(N.LE.LINE(I))GO TO 33
32 N=LINE(I)
M=I
33 CONTINUE
IF(M.EQ.0)GO TO 34
LINE(M)=LINE(L)
LINE(L)=N
34 CONTINUE
C
C MOVE STRUCTURE
35 I=JX-KX
J=JY-KY
K=JZ-INIT
DO 43 L=1,NEAR
M=LINE(L)
N=M+K
IF(N.LE.0)GO TO 39
IF(N.GT.MAX)GO TO 39
JY=(M-1)/60
JX=55+I+15*(M-(60*JY))
IF(JX.LT.62)GO TO 39
IF(JX.GT.962)GO TO 39
JX=JX-KDST
JY=962-JHIGH+J-IHIGH*(JY-IOFF)
IF(MODE.EQ.3)GO TO 42
IF(ISTORE(N).NE.1H )GO TO 40
IF(JY.GE.962)GO TO 38
IF(JY.LT.62)GO TO 38
IF(N.LT.IMIN)GO TO 37
IF(N.GT.IMAX)GO TO 37
IF(JX.LT.JMIN)GO TO 37
IF(JX.GT.JMAX)GO TO 37
DO 36 II=1,NEAR
IF(LINE(II).EQ.N)GO TO 38
36 CONTINUE
37 CALL CRTLTR(ISTORE(M),1,1,JX,JY-LDST)
38 ISTORE(N)=ISTORE(M)
GO TO 41
39 IF(MODE.NE.4)GO TO 43
40 KOUNT=KOUNT-1
41 ISTORE(M)=' '
GO TO 43
42 IF(ISTORE(N).NE.1H )GO TO 43
KOUNT=KOUNT+1
KEY=1
ISTORE(N)=ISTORE(M)
IF(JY.GE.962)GO TO 43
IF(JY.GT.62)CALL CRTLTR(ISTORE(N),1,1,JX,JY-LDST)
43 CONTINUE
CALL CRTSTR(0)
GO TO 1
44 RETURN
END
SUBROUTINE TXTGRP
C
C TXTPAD ROUTINE TO FIND ALL MEMBERS OF THE STRUCTURE
C INDICATED BY POINTING TO INIT. ALL NEIGHBORS ARE
C FOUND OF INIT, THEN THEIR NEIGHBORS, AND SO ON.
C
C I = CENTER OF PRESENT SEARCH.
C J = BLOCK BEING TESTED TO SEE IF IS NEIGHBOR.
C K = POSITION OF I IN STORAGE ARRAY LINE.
C L = LEFT POSITION TO TEST IN PRESENT ROW.
C M = RIGHT POSITION TO TEST IN FINAL ROW.
C N = NUMBER OF POSITIONS TO TEST IN SINGLE ROW.
C II = INNER LOOP WHICH TESTS IF J IS ALREADY IN
C LINE ARRAY.
C JJ = NUMBER OF BLOCKS TESTED IN THIS ROW.
C
C INIT = POSITION IN ISTORE ARRAY OF CHARACTER POINTED
C TO.
C ISTORE = ARRAY CONTAINING CHARACTERS ON SCREEN.
C LINE = ARRAY RETURNED CONTAINING THE POSITIONS IN
C THE ISTORE ARRAY OF THE CHARACTERS IN THE
C STRUCTURE.
C NEAR = RETURNED WITH THE NUMBER OF CHARACTERS IN
C THE STRUCTURE.
C
C IMIN, IMAX, AND JMIN ARE HERE USED TO OBTAIN THE LIMITS
C OF THE LINE ARRAY WITHIN WHICH A NEWLY FOUND NON-BLANK
C CHARACTER WILL APPEAR IF IT HAS ALREADY BEEN RECOGNIZED.
C THESE FORM A PUSH-DOWN STACK WITH IMIN BEING THE
C START OF THE GRANDPARENT GENERATION.
C JMAX IS THE VALUE OF NEAR PRIOR TO GENERATION OF A
C FAMILY. JMAX RATHER THAN NEAR IS THE UPPER LIMIT
C OF THE SEARCH SINCE A PARTICULAR CHARACTER CAN ONLY BE
C FOUND ONCE WITHIN A PARTICULAR FAMILY.
C
C -----------------------------------------------------
C OLD GENERATION PARENT GENERATION CURRENT GENERATION
C -----------------------------------------------------
C IMIN IMAX K JMIN NEAR
C
COMMON/TXTPAD/LETTER(84),ISTORE(3600),LINE(1800),
1IERASE,IHIGH,ILOCK,INAME,INIT,IOFF,ISTART,ITAB,
2ITAPE,IX,IY,IZ,JHIGH,JLOCK,JNAME,JTAPE,JX,JY,JZ,
3KDST,KEY,KNTLTR,KOUNT,LDST,LTR,MAX,MODE,MOST,
4MOVTAB,NEAR,LOSE,IMIN,IMAX,JMIN,JMAX
C
NEAR=1
LINE(1)=INIT
K=1
IMIN=1
IMAX=1
JMIN=2
C
C DETERMINE LIMITS OF POSSIBLE NEIGHBORS
1 IF(K.LT.JMIN)GO TO 2
IMIN=IMAX
IMAX=JMIN
JMIN=NEAR+1
2 JMAX=NEAR
I=LINE(K)
N=3
L=I-61
M=I+61
IF(L.LT.0)L=I-1
IF(M.GT.(MAX+1))M=I+1
J=60*((I+59)/60)
IF(I.NE.J)GO TO 3
M=M-1
GO TO 4
3 IF(I.NE.(J-59))GO TO 5
L=L+1
4 N=2
5 J=L
JJ=0
C
C TEST IF BLOCK IS NEIGHBOR
6 IF(J.EQ.I)GO TO 8
IF(ISTORE(J).EQ.1H )GO TO 8
C
C TEST IF BLOCK HAS ALREADY BEEN FOUND
DO 7 II=IMIN,JMAX
IF(LINE(II).EQ.J)GO TO 8
7 CONTINUE
C
C IF NOT ALREADY FOUND, STORE IT
NEAR=NEAR+1
LINE(NEAR)=J
IF(NEAR.EQ.MOST)GO TO 9
C
C SELECT NEXT BLOCK TO BE TESTED
8 JJ=JJ+1
J=J+1
IF(JJ.LT.N)GO TO 6
L=L+60
IF(L.LT.M)GO TO 5
C
C SELECT NEXT CENTRAL BLOCK
K=K+1
IF(K.LE.NEAR)GO TO 1
9 RETURN
END
SUBROUTINE TXTLIN
C
C TXTPAD ROUTINE TO DRAW A LINE BY DUPLICATING THE
C CHARACTER AT INIT AND EXTENDING THESE THROUGH THE
C POSITION JZ.
C
C DONALD E. BARTH, CHEMISTRY DEPT., HARVARD UNIVERSITY
C
COMMON/TXTPAD/LETTER(84),ISTORE(3600),LINE(1800),
1IERASE,IHIGH,ILOCK,INAME,INIT,IOFF,ISTART,ITAB,
2ITAPE,IX,IY,IZ,JHIGH,JLOCK,JNAME,JTAPE,JX,JY,JZ,
3KDST,KEY,KNTLTR,KOUNT,LDST,LTR,MAX,MODE,MOST,
4MOVTAB,NEAR,LOSE,IMIN,IMAX,JMIN,JMAX
MOVEY=(JZ-1)/60
ILASTY=(INIT-1)/60
ILASTX=INIT-60*ILASTY
MOVEX=JZ-60*MOVEY-ILASTX
MOVEY=MOVEY-ILASTY
MODX=MOVEX
MODY=MOVEY
IF(MOVEX.LT.0)GO TO 2
IF(MOVEX.GT.0)GO TO 3
IF(MOVEY.GT.0)GO TO 1
MODY=-MODY
1 LAGX=0
LAGY=0
MULT=MODY
GO TO 7
2 MODX=-MODX
3 IF(MOVEY.LT.0)GO TO 4
IF(MOVEY.GT.0)GO TO 5
LAGX=0
LAGY=0
MULT=MODX
GO TO 7
4 MODY=-MODY
5 LAGX=(MOVEX*MODY)/(2*MODX)
LAGY=(MODX*MOVEY)/(2*MODY)
IF(MODX.GE.MODY)GO TO 6
MULT=MODY
GO TO 7
6 MULT=MODX
7 IF(MODE.NE.1)GO TO 14
K=LOSE+MULT+1
IF(K.GT.80)K=80
READ(5,8)(LINE(I),I=1,K)
8 FORMAT(80A1)
GO TO 10
9 K=K-1
10 IF(K.EQ.LOSE)GO TO 20
IF(LINE(K).EQ.1H )GO TO 9
IF(MOVEX.GT.0)GO TO 12
IF(MOVEX.LT.0)GO TO 11
IF(MOVEY.GT.0)GO TO 12
11 L=LOSE
M=-1
GO TO 13
12 L=K+1
K=LOSE+1
M=1
13 I=INIT
MODY=ILASTY
MODX=ILASTX
GO TO 16
14 K=0
M=1
L=MULT
15 LAGX=LAGX+MOVEX
LAGY=LAGY+MOVEY
MODX=ILASTX+(LAGX/MULT)
MODY=ILASTY+(LAGY/MULT)
I=MODX+60*MODY
16 IF(ISTORE(I).NE.1H )GO TO 19
IF(MODE.EQ.2)GO TO 17
IF(LINE(K).EQ.1H )GO TO 19
ISTORE(I)=LINE(K)
GO TO 18
17 ISTORE(I)=ISTORE(INIT)
18 MODX=55+15*MODX-KDST
MODY=962-JHIGH-(IHIGH*(MODY-IOFF))-LDST
CALL CRTLTR(ISTORE(I),1,1,MODX,MODY)
KOUNT=KOUNT+1
KEY=1
19 K=K+M
IF(K.NE.L)GO TO 15
20 RETURN
END
SUBROUTINE TXTOUT
C
C TXTPAD ROUTINE TO OUTLINE A SINGLE STRUCTURE WHICH
C TXTGRP HAS STORED IN THE LINE ARRAY. ONLY THE
C PORTION OF THE STRUCTURE WINDOWED ONTO THE SCREEN
C DISPLAY IS OUTLINED. THE SPACES WITHIN STRUCTURES
C ARE NOT INDICATED.
C
C DONALD E. BARTH, CHEMISTRY DEPT., HARVARD UNIVERSITY
C
C IMIN AND IMAX ARE RETURNED WITH THE MINIMUM AND
C MAXIMUM SUBSCRIPTS OF ISTORE ARRAY IN THE GROUP.
C JMIN AND JMAX ARE RETURNED WITH THE MINIMUM AND
C MAXIMUM HORIZONTAL SCOPE COORDINATE OF THE GROUP.
C
COMMON/TXTPAD/LETTER(84),ISTORE(3600),LINE(1800),
1IERASE,IHIGH,ILOCK,INAME,INIT,IOFF,ISTART,ITAB,
2ITAPE,IX,IY,IZ,JHIGH,JLOCK,JNAME,JTAPE,JX,JY,JZ,
3KDST,KEY,KNTLTR,KOUNT,LDST,LTR,MAX,MODE,MOST,
4MOVTAB,NEAR,LOSE,IMIN,IMAX,JMIN,JMAX
IMIN=MAX
IMAX=0
DO 1 K=1,NEAR
IF(IMAX.LT.LINE(K))IMAX=LINE(K)
IF(IMIN.GT.LINE(K))IMIN=LINE(K)
1 CONTINUE
2 IF(IMIN.LE.60)GO TO 3
IF(ISTORE(IMIN-60).EQ.1H )GO TO 3
IMIN=IMIN-60
GO TO 2
3 L=IMIN
K=(L-1)/60
J=47+15*(L-(60*K))
K=962+(IHIGH*(IOFF-K))
JMIN=J
JMAX=0
IF(K.LE.62)GO TO 5
IF(K.LT.962)CALL CRTOFF(J,K)
GO TO 5
C
C *****************
C * GOING RIGHT *
C *****************
C
C TEST FOR BLOCK ABOVE RIGHT
4 IF(L.EQ.IMIN)GO TO 17
5 J=J+15
IF(JMAX.LT.J)JMAX=J
IF(J.EQ.962)GO TO 7
IF(L.LE.60)GO TO 6
IF(ISTORE(L-59).EQ.1H )GO TO 6
L=L-59
GO TO 13
C
C TEST FOR BLOCK TO RIGHT
6 IF(ISTORE(L+1).EQ.1H )GO TO 7
C FOUND BLOCK TO RIGHT
L=L+1
GO TO 4
C
C UPPER RIGHT CORNER BLOCK
7 IF(K.LE.62)GO TO 8
IF(K.LT.962)CALL CRTON(J,K)
C
C ****************
C * GOING DOWN *
C ****************
C
C TEST FOR BLOCK BELOW RIGHT
8 IF(K.EQ.962)CALL CRTOFF(J,K)
K=K-IHIGH
IF((L+60).GT.MAX)GO TO 10
IF(J.EQ.962)GO TO 9
IF(ISTORE(L+61).EQ.1H )GO TO 9
L=L+61
IF(K.LT.62)GO TO 4
IF(K.LT.962)CALL CRTON(J,K)
GO TO 4
C
C TEST FOR BLOCK BELOW
9 IF(ISTORE(L+60).EQ.1H )GO TO 10
L=L+60
IF(K.EQ.62)CALL CRTON(J,K)
GO TO 8
C
C LOWER RIGHT CORNER BLOCK
10 IF(K.LT.62)GO TO 11
IF(K.LT.962)CALL CRTON(J,K)
C
C ****************
C * GOING LEFT *
C ****************
C
C TEST FOR BLOCK BELOW LEFT
11 J=J-15
IF(JMIN.GT.J)JMIN=J
IF(J.EQ.62)GO TO 13
IF((L+60).GT.MAX)GO TO 12
IF(ISTORE(L+59).EQ.1H )GO TO 12
L=L+59
GO TO 7
C
C TEST FOR BLOCK TO LEFT
12 IF(ISTORE(L-1).EQ.1H )GO TO 13
L=L-1
GO TO 11
C
C LOWER LEFT CORNER BLOCK
13 IF(K.LE.62)GO TO 14
IF(K.LT.962)CALL CRTON(J,K)
C
C **************
C * GOING UP *
C **************
C
C TEST FOR BLOCK ABOVE LEFT
14 IF(K.EQ.62)CALL CRTOFF(J,K)
K=K+IHIGH
IF(L.LE.60)GO TO 16
IF(J.EQ.62)GO TO 15
IF(ISTORE(L-61).EQ.1H )GO TO 15
L=L-61
IF(K.LE.62)GO TO 11
IF(K.LE.962)CALL CRTON(J,K)
GO TO 11
C
C TEST FOR BLOCK ABOVE
15 IF(ISTORE(L-60).EQ.1H )GO TO 16
L=L-60
IF(K.EQ.962)CALL CRTON(J,K)
GO TO 14
C
C UPPER LEFT BLOCK
16 IF(K.LE.62)GO TO 4
IF(K.LE.962)CALL CRTON(J,K)
GO TO 4
C
C RETURN TO CALLING PROGRAM
17 RETURN
END