00100	C  THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
00200	C  AT STANFORD UNIVERSITY.  IT MAY NOT BE COPIED OR ALTERED IN ANY
00300	C  WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.
00400	
00500	
00600	C  7/74 **********  SCORE  **********  LELAND SMITH, SEP.1969
00700	
00800	C   THIS PROGRAM WRITES NOTE LISTS FOR THE PDP10 SOUND 
00900	C   GENERATION PROGRAM.
01000	C   IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO'('HELP') FORMAT.
01100	C   LOAD 'S1' WITH S2,S3,SCANZ,RAND AND SPRINT 
01200	C   (AND QUAD AND QUADO WHEN THEY ARE READY) AND
01300	C   IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
01400	C	SUBROUTINE SUBR
01500	C	COMMON /INS/ INST(27),BG(60)
01600	C	COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
01700	C   INUM=INST#  IPAR=PARAM#  
01800	C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
01900	C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
02000	C   INST=INST. NAME,  BG=INSTS' BEGIN TIMES.
02100	C   NOTE #S IN SUBROUTINE: (1-84)  C4=37  FS4=43  C5=49  ETC.
02200	C   F1=86  F15=100 (NO F16!)
02300	
02400		COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
02500		1 LN,ITYP,TPALN(4),JED
02600	CC 7/74 COLGATE  COMMON/TYP/ IS FOR COLTTY ROUT.
02700		COMMON/A/ V(2000),ROFF(27),NP(27),PCH(27,32),
02800		1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
02900		1 ,P1(27),JFM(4),COPY(30),IFM(80)
03000		1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
03100		DIMENSION LIST(78),JNP(80)
03200	C   WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY 
03300	C   40 LIT CHARS + 30 PARAMS PER INST.
03400	C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.
03500		COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
03600		1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
03700		1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
03800		COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
03900		1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
04000		1 ZZ,CHN,YY 
04100		1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
04200		1  /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
04300		1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
04400		1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
04500	C  /C/=26
04600		EQUIVALENCE (LIST,IFM(3)),(JNP,INP)
04700		DATA KZY/27/,ISEMI/';'/,IQT/'"'/
04800		1, JFM(3)/','/
04900	C  IAA=A  ID=D  IE=E  IF=F  IEN=N  IPP=P  ISS=S  ITT=T
05000		DATA IBLA/' '/,IXX/'X'/
05100		1 ,ISCA/'C','P','D','O','E','F','PLAY;','G','S','A','T','B'/
05200		1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
05300		LPAR=0
05400		IPRN=0
05500		QX=0.
05600		MOT=0
05700		RETRO=-1.
05800		INVRT=-1
05900		ICON=-1
06000		LCNT=1
06100		PARENS=0
06200	      JZ=1  
06300		CALL RNDINT
06400	C  INIT RAND NUM GENERATOR.
06500	CC    PR=0  
06600		IAMP=0
06700	C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
06800	      T5=0  
06900	      NINS=0
07000		K=0
07100		IDALL=-1
07200		QTS=-1.
07300	      KB=0  
07400	      NWZ=1
07500		BNW(1)=0
07600		I=1
07700	      KL=0  
07800	      TP=0  
07900	      RA=0  
08000	      CHN=0 
08100		DO 127 K=1,77,3
08200	127	LIST(K)=0
08300	C  INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
08400		NWX=0
08500		BY=-1
08600	      DO 1128 K=1,KZY     
08700		INVIS(K)=0
08800		INST(K)=0
08900		CNT(K)=0
09000		RDEV(K)=0
09100	C  RDEV IS FOR RAND DEVIATIONS AT RUN TIME
09200		NP(K)=0
09300		IQ(K)=0
09400	C   IQ IS FOR RESTART FLAG
09500		IPT(K,1)=0
09600	      DO 1128 L=1,32    
09700	1128   PCH(K,L)=0 
09800	
09900		ITYP=-1
10000	C   TYPE 'FILE NAME', TEMPO FACTOR(0=1), AMPL.FACT(0=1),
10100	C   SECONDS TO BE OMITTED, DUR AT CUTOFF.
10200		JED=-1
10300	2112	TYPE 8002
10400	1112	ACCEPT 77732,JNP
10500		JFM(4)='5F)'
10600		JFM(1)='   (A'
10700	C   FOR FREE 'A' FORMAT
10800		CALL FMT(JFM,JNP,MLX)
10900		REREAD JFM,K,TF,AMPFAC,OP1,DURX
11000	C  JFM IS THE CURRENT FORMAT STATEMENT
11100		IF(K.NE.'EDIT')GO TO 3112
11200		JED=0
11300		GO TO 2112
11400	C  'E(DIT)' GOES TO EDIT MODE
11500	3112	IF(TF.EQ.0)TF=1.
11600		IF(AMPFAC.EQ.0)AMPFAC=1.
11700	21122	IF(K.NE.'TYPE')GO TO 128
11800		ITYP=0
11900		DATA FINM/30H(' TYPE OUTPUT FILE NAME'/)   /
12000		IFLNM='FOR21'
12100		REWIND 21
12200		GO TO 3127
12300	8001	FORMAT(A5,5F)
12400	77732	FORMAT(80A1)
12500	300	FORMAT(I,3F)
12600	128	IF(K.EQ.'INFO')GO TO 1280
12650		IF(K.NE.'HELP')GO TO 3128
12700	1280	TYPE 8002
12800		TYPE 1113
12900		TYPE 118
13000		TYPE 1114
13100		TYPE 8002
13200		GO TO 1112
13300	118	FORMAT(' TO DSK=1, TTY=2, BOTH=0, LPT=22, PROOF=3, DEBUG=4'/)
13400	CC***  TEMPORARY ***8002	FORMAT(' TYPE FILE NAME'/)
13500	8002	FORMAT(' TYPE FILE NAME--  '$)
13600	1113	FORMAT('     NAME  TF  AMPFAC  OMIT"  DUR"'/)
13700	1114	FORMAT(' N1, N2=RAN NUM, N3=0 LISTS INPUT, N4=SINGLE INST.'/
13800		1 ' IF -- N1=3 DURS ONLY, =4 V ARRAY'/
13900		1 3X' 27 INSTRUMENTS ARE AVAILABLE'/)
14000	
14100	3128	IF(K.NE.IBLA)IFLNM=K
14200		CALL IFILE(1,IFLNM)
14300		READ(1,300)LN,IXIN
14400	C  CHECK FOR LINE NUMBERS ONLY.
14500		REWIND 1
14600		CALL IFILE(1,IFLNM)
14700	
14800	3127	ISLAC=(IFLNM.AND."003777777777).OR."550000000000
14900	C MAGIC TO CHANGE LFT. LETTER TO Z(INP. ABCDE BECOMES ZBCDE.DAT)
15000	5127	TYPE 118
15100		IF(DURX.EQ.0)DURX=19999.
15200		IXIN=1
15300		INONLY=-1
15400		ACCEPT 300,MX,X,Y,Z
15500		IF(MX.NE.99)GO TO 6127
15600		TYPE FINM
15700		ACCEPT 8001,ISLAC
15800		GO TO 5127
15900	6127	IF(Z.NE.0)INONLY=Z
16000		IF(X.NE.0)IXIN=X
16100	C   MX=3 GIVES DURS ONLY
16200	C  TO SUPPRESS LIST OF INPUT DATA, TYPE ANY 3RD NUM. (BUT 9.)
16300	C  (1 1 1 =RECORD,RAN. NUM=1,SUPPRESS INPUT.)
16400		MZ=0
16500		JOUT=5
16600	C  5=OUTPUT TO TTY
16700		SOS=-1.
16800		IF(Y.NE.0)SOS=0  
16900	C  IF 3RD NUM=0, EDIT FILE WILL PRINT AS IT IS READ.
17000		IF(MX.NE.22)GO TO 2107
17100	CC	JOUT=3
17200	C DIRECT TO LPT AT COLGATE 6/74
17300		JOUT=22
17400		REWIND 22
17500	2107	IF(MX.LE.1)MX=MX-2
17600		IF(MX.EQ.-2)GO TO 77
17700		IF(MX.EQ.2)GO TO 77
17800		IF(MX.NE.22)GO TO 177
17900	77	MZ=-1
18000	177	IF(MX.EQ.4)MZ=-4
18100	      CALL READIT
18200	      END