1000  COM R1,R2,R3,R4,R$[72],N,C[30,4],A$[72],F1,F2,F[125]
1001  COM C1,C2,C4,B$[72],S[5,2],D$[5],A[150],L1,L2
1010  REM *** COFTAB - PROGRAM COFTA6 - 06/06/73
1012  REM *** PRINTS OUT THE TABLES GENERATED BY COFTA5.
1013  REM *** TRANSFERS CONTROL TO COFTA1 OR COFTA7.
1020  IF A$="ZYX"'7 THEN 2000
1030  IF A$='7"XYZ" THEN 8500
2000  FILES VARBLE,WORK1,WORK2
5000  DIM T$[72],S$[72],I[120],E$[10],C$[50],T[20]
5020  DIM U$[25]
5030  DIM N$[72]
5040  DIM R[120],O[20]
5050  D$=",;)(="
5060  S[1,1]=1
5070  S[1,2]=C[1,2]-C[1,1]+1
5080  FOR I=2 TO N
5090  S[I,1]=S[I-1,2]+1
5100  S[I,2]=S[I,1]+C[I,2]-C[I,1]
5110  NEXT I
5120  IF  END #F1 THEN 5490
5130  C2=1
5140  READ #F1,1
5150  C1=C2
5160  PRINT '10
5170  READ #F1;B$
5175  C4=1
5180  MAT T=ZER
5190  PRINT '10'10'10;
5200  PRINT #F2,1;B$[S[N-1,1],S[N,2]]
5210  C1=C1+1
5220  IF N <= 2 THEN 5240
5230  T$=B$[1,S[N-2,2]]
5240  FOR I=1 TO N
5250  READ #1,1
5260  READ #1;T1,A$
5270  IF T1#ABS(C[I,4]) THEN 5260
5280  P2=0
5290  GOSUB 6790
5300  GOSUB 6840
5310  PRINT U$":  ";
5320  IF I=N-1 THEN 5360
5330  IF I=N THEN 5380
5340  PRINT B$[S[I,1],S[I,2]];
5350  GOTO 5390
5360  PRINT "ROWS";
5370  GOTO 5390
5380  PRINT "COLUMNS";
5390  PRINT TAB(25);C$
5400  PRINT 
5410  NEXT I
5420  READ #F1;B$
5425  C4=C4+1
5430  IF N <= 2 THEN 5450
5440  IF T$#B$[1,S[N-2,2]] THEN 5480
5450  C1=C1+1
5460  PRINT #F;B$[S[N-1,1],S[N,2]]
5470  GOTO 5420
5480  N$=B$
5490  PRINT #F2; END 
5500  READ #F2,1
5510  S3=S[N-1,2]-S[N-1,1]+2
5520  C3=C1-C2
5530  MAT A=ZER
5540  T8=C2-1
5550  T7=0
5560  FOR I=1 TO C3
5570  T7=T7+F[T8+I]
5580  I[I]=I
5590  READ #F;T$
5600  I1=I+1
5610  FOR J=I1 TO C3
5620  READ #F2;S$
5630  IF S$[S3] >= T$[S3] THEN 5650
5640  A[I]=A[I]+1
5650  NEXT J
5660  READ #F2,1
5670  I2=I-1
5680  FOR J=1 TO I2
5690  READ #F2;S$
5700  IF S$[S3] >= T$[S3] THEN 5720
5710  A[I]=A[I]+1
5720  NEXT J
5730  READ #F2;T$
5740  NEXT I
5750  T1=C3-1
5760  FOR I=T1 TO 1 STEP -1
5770  FOR J=1 TO I
5780  IF A[I[J]] <= A[I[J+1]] THEN 5820
5790  T2=I[J]
5800  I[J]=I[J+1]
5810  I[J+1]=T2
5820  NEXT J
5830  NEXT I
5840  R[I[1]]=1
5850  READ #F2,1
5860  S4=S[N-1,2]-S[N-1,1]+1
5870  FOR I=1 TO I[1]
5880  READ #F2;T$
5890  NEXT I
5900  PRINT '10'10;
5910  E$=T$[S3]
5920  PRINT " CODE";
5930  IF E$#" " THEN 5960
5940  PRINT " BLANK";
5950  GOTO 5970
5960  PRINT TAB(11-LEN(E$));E$;
5970  I7=2
5980  FOR I=2 TO C3
5990  IF A[I[I]]=A[I[I-1]] THEN 6120
6000  READ #F2,1
6010  FOR J=1 TO I[I]
6020  READ #F2;T$
6030  NEXT J
6040  E$=T$[S3]
6050  IF E$#" " THEN 6080
6060  PRINT " BLANK";
6070  GOTO 6090
6080  PRINT TAB(5+6*I7-LEN(E$));E$;
6090  I7=I7+1
6100  R[I[I]]=R[I[I-1]]+1
6110  GOTO 6130
6120  R[I[I]]=R[I[I-1]]
6130  NEXT I
6140  PRINT " TOTAL"'10
6150  IF  END #F2 THEN 6680
6160  READ #F2,1;T$
6165  K1=L2=0
6170  L1=R[I[C3]]
6180  I1=1
6190  I2=C2
6200  B$=T$[1,S4]
6210  IF B$#" " THEN 6240
6220  PRINT "BLANK";
6230  GOTO 6250
6240  PRINT TAB(5-LEN(B$));B$;
6250  MAT O=ZER[L1]
6260  O[R[I1]]=F[I2]
6270  READ #F2;T$
6280  IF T$[1,S4]#B$ THEN 6330
6290  I1=I1+1
6300  I2=I2+1
6310  O[R[I1]]=F[I2]
6320  GOTO 6270
6330  GOSUB 6350
6336  L2=L2+1
6340  GOTO 6200
6350  Z$=" #####"
6360  T=0
6370  FOR I=1 TO L1
6375  K1=K1+1
6380  Z[1]=A[K1]=O[I]
6390  GOSUB 7480
6400  T=T+O[I]
6410  T[I]=T[I]+O[I]
6420  NEXT I
6425  K1=K1+1
6430  Z[1]=A[K1]=T
6440  GOSUB 7480
6450  PRINT 
6460  PRINT TAB(5);
6470  Z$=" ###.#"
6480  FOR I=1 TO L1
6490  Z[1]=100*O[I]/T
6500  Z[1]=Z[1]+.05
6510  GOSUB 7480
6520  NEXT I
6530  Z[1]=100*T/T
6540  GOSUB 7480
6550  PRINT 
6560  PRINT TAB(5);
6570  FOR I=1 TO L1
6580  Z[1]=100*O[I]/T7
6590  Z[1]=Z[1]+.05
6600  GOSUB 7480
6610  NEXT I
6620  Z[1]=100*T/T7
6630  GOSUB 7480
6640  PRINT '10'10'13;
6650  I1=I1+1
6660  I2=I2+1
6670  RETURN 
6680  GOSUB 6350
6685  L2=L2+1
6690  PRINT "TOTAL";
6700  FOR I=1 TO L1
6710  O[I]=T[I]
6720  NEXT I
6730  GOSUB 6350
6740  C2=C1
6750  B$=N$
6755  GOSUB 8100
6760  GOTO TYP(F1) OF 5180,5180,6770
6770  PRINT '10'10
6780  CHAIN "COFTA1"
6790  REM *** ROUTINE FOR DECODING VAR. STRING INTO VARIABLE LABEL
6800  B1=0
6810  GOSUB 6930
6820  U$=A$[P1,P4]
6830  RETURN 
6840  REM *** ROUTINE FOR UNPACKING COLUMN NOS. FOR VAR. STRING
6850  B1=0
6860  GOSUB 6930
6870  B1=0
6880  GOSUB 6930
6890  C$=""
6900  IF P2 >= A9 THEN 6920
6910  C$=A$[P2+1]
6920  RETURN 
6930  REM ***** SCANNER
6940  A9=LEN(A$)
6950  P2=P1=P2+1
6960  IF P2 <= A9 THEN 7000
6970  P4=P2-1
6980  S1=7
6990  RETURN 
7000  GOSUB 7410
7010  IF S1=7 THEN 6970
7020  A9=LEN(A$)
7030  IF A$[P2,P2]#" " THEN 7100
7040  GOTO B1+1 OF 7070,7050,7100
7050  S1=8
7060  GOTO 7390
7070  IF P2 >= A9 THEN 6970
7080  A$=A$[P2+1]
7090  GOTO 7020
7100  IF A$[P2,P2]#"'" THEN 7270
7110  IF P2<A9 THEN 7150
7120  PRINT "*****MISMATCHED '"
7130  S1=0
7140  REM *** ROUTINE FOR SCANNING LEADING BLANKS
7150  A$[P2]=A$[P2+1]
7160  A9=LEN(A$)
7170  P2=P2+1
7180  IF P2>A9 THEN 7120
7190  IF A$[P2,P2]#"'" THEN 7170
7200  IF P2 >= A9 THEN 7230
7210  A$[P2]=A$[P2+1]
7220  GOTO 7020
7230  P2=P2-1
7240  A$=A$[1,P2]
7250  P4=P2
7260  GOTO 6980
7270  E$=A$[P2,P2]
7280  IF B1#2 THEN 7320
7290  IF E$#D$[2,2] THEN 7350
7300  I2=2
7310  GOTO 7380
7320  FOR I2=1 TO 5
7330  IF E$=D$[I2,I2] THEN 7380
7340  NEXT I2
7350  P2=P2+1
7360  IF P2>A9 THEN 6970
7370  GOTO 7020
7380  S1=I2
7390  P4=P2-1
7400  RETURN 
7410  REM ***** ROUTINE FOR SCANNING LEADING BLANKS
7420  S1=0
7430  IF A$[P2,P2]#" " THEN 7470
7440  P1=P2=P2+1
7450  IF P2 <= A9 THEN 7430
7460  S1=7
7470  RETURN 
7480  REM *** SUBROUTINE TO FORMAT PROGRAM OUTPUT
7510  LET Z2=Z3=Z4=Z5=Z7=Z8=Z9=1
7520  DIM Y$[10],Z$[72]
7530  LET Y$="0123456789"
7540  LET Z0=Z9-1
7550  LET Z0=Z0+1
7560  IF Z0=LEN(Z$)+1 THEN 8070
7570  IF Z$[Z0,Z0]="#" THEN 7640
7580  IF Z$[Z0,Z0+1]=".#" THEN 7640
7590  IF Z$[Z0,Z0+1]="+#" THEN 7620
7600  PRINT Z$[Z0,Z0];
7610  GOTO 7550
7620  LET Z4=0
7630  GOTO 7550
7640  LET Z=100
7650  LET Z6=Z[Z2]
7660  LET Z9=Z0-1
7670  LET Z9=Z9+1
7680  IF Z$[Z9,Z9]="." THEN 7710
7690  IF Z$[Z9,Z9]="#" THEN 7670
7700  GOTO 7750
7710  IF Z5#1 THEN 7750
7720  LET Z5=0
7730  LET Z=Z9
7740  GOTO 7670
7750  IF Z#100 THEN 7770
7760  LET Z=Z9
7770  IF Z4=1 THEN 7820
7780  IF Z6 >= 0 THEN 7810
7790  PRINT "-";
7800  GOTO 7820
7810  PRINT " ";
7820  LET Z6=ABS(Z6)+10^(Z-Z9-1)
7830  FOR Z1=Z-Z0 TO Z+1-Z9 STEP -1
7840  IF Z$[Z-Z1,Z-Z1]#"." THEN 7890
7850  PRINT ".";
7860  LET Z3=0
7870  LET Z7=2
7880  GOTO 8030
7890  LET Z8=INT(Z6/(10^(Z1+Z7-2)))
7900  IF Z6<10^(Z-Z0) THEN 7930
7910  PRINT "#";
7920  GOTO 8030
7930  LET Z6=Z6-Z8*10^(Z1+Z7-2)
7940  IF Y$[Z8+1,Z8+1]="0" THEN 7960
7950  LET Z3=0
7960  IF Z3=0 THEN 8020
7970  IF Z1#1 THEN 8000
7980  PRINT "0";
7990  GOTO 8030
8000  PRINT " ";
8010  GOTO 8030
8020  PRINT Y$[Z8+1,Z8+1];
8030  NEXT Z1
8040  LET Z3=Z4=Z5=Z7=1
8050  LET Z2=Z2+1
8060  GOTO 7540
8070  RETURN 
8100  CHAIN "COFTA7"
8500  REM *** CHAINED BACK HERE FROM COFTA7
8505  FOR I=1 TO C4
8510  READ #F1;A$
8520  NEXT I
8525  IF  END #F1 THEN 5490
8530  GOTO 6760
9999  END 
