C
C     4B WORKSHOP PROJECT  SEPT. 1974 - APRIL 1975
C      MAN,MOOG AND COMPUTER COMPOSING SYSTEM (MMACCS SHORTENS TO MAX)
C       R.B. ARNOLD  70018937
C      SYSTEMS DESIGN ENGINEERING
C
      LOGICAL IOFF,B(3),T,F,LTPEN,WAIT
      INTEGER*2 LIST(2),LIST2(2),LIS(2)
      INTEGER FNP(25),NTZ(7)/4,5,6,7,8,12,13/
      INTEGER MP1(75,2),MP2(75,2),MP3(75,2),MP4(75,2)
      INTEGER THM1(200,3),THM2(200,3),THM3(200,3),OUTP(200,3)
      INTEGER SDUR(10),NA,SUM,RL,INST(20,2)
      REAL FIL1(2),FIL2(2),FIL3(2),FIL4(2),FIL5(2)
      REAL FIL6(2),FIL7(2),FIL8(2)
      REAL DUR(10),DME(110),DM2(110)
      CHARACTER*3 NUR(10),NME(110),ZZ,FN(25),TRG(5),VOL(5),AB,AC,AD
      CHARACTER*3 CON/'CON'/,YES/'YES'/,END/'END'/
      CHARACTER*3 SLR/'SLR'/,STC/'STC'/,AA,BB,CC
      CHARACTER FOR*2(2)/'(I','4)'/
      CHARACTER TWO*3(2)/'(A3','0)'/,MSG*30
      COMMON DME,DUR
      COMMON/AAA/SDUR,NB,NGB
      COMMON/BBB/NME,NUR,TRG
      COMMON/CCC/ITAG,LTPEN,IX,IY
      COMMON/DDD/THM3,NST2
      COMMON/EEE/THM1,THM2,OUTP
      COMMON/FFF/MP1,MP2,MP3,MP4,DM2
      COMMON/HHH/TIN,BIN
      DATA FIL1(1),FIL1(2)/4HCOMP,4H SRC/
      DATA FIL2(1),FIL2(2)/4HTEMP,4H SRC/
      DATA FIL3(1),FIL3(2)/4HSCHA,4H SRC/
      DATA FIL4(1),FIL4(2)/4HSCAL,4H SRC/
C
C************************************************
C
C   CONTROL CENTRE
C
C   KNT IS THE INITIALIZATION INDICATOR
      KNT=1
      CALL OPEN(3,FIL1)
C   NCOMP IS # OF NOTES IN COMPOSITION FILE
      NCOMP=0
      AA='AAA'
      TRG(3)='NRM'
      TRG(4)='LEG'
C   ENABLE LIGHTPEN
      CALL SETPEN(ITAG,LTPEN,IX,IY)
      T=.TRUE.
      F=.FALSE.
C   READ IN SCALE ETC.
      GO TO 71
C
   80 KNT=KNT+1
      WRITE(7)F,F,F
C
C   ROUTINE TO REQUEST DIRECTION VIA CRT
C
C   WHAT DO YOU WANT TO DO?
C
  306 CALL CLEAR(.TRUE.)
      NMAX=7
      KNT=KNT+1
      N=0
      ZZ='CH1'
      CALL NCRT(ZZ,N,NMAX)
      IF(N.GT.6)GO TO 123
      GO TO (309,470,73,74,308,400),N
C
C   WHAT DO YOU WANT TO LIST?
C
  308 CALL CLEAR(.TRUE.)
      ZZ='CH2'
      N=0
      NMAX=7
      WRITE(7)F,F,F
      KNT=KNT+1
      CALL NCRT(ZZ,N,NMAX)
      IF(N.EQ.999)GO TO 123
      GO TO (75,76,82,79,77,78,306),N
C
C   SET - UP PROCEDURES
C
  309 CALL CLEAR(.TRUE.)
      NMAX=4
      N=0
      ZZ='CH3'
      CALL NCRT(ZZ,N,NMAX)
      IF(N.GT.3)GO TO 306
      GO TO (70,12,423),N
C
C************************************************
C
C   TRANSFORMATION SECTION
C
   73 CALL TRAN(NTZ)
      GO TO 306
C
C************************************************
C
C   LISTING OR PLAYBACK
C
  132 NOP=99
      CALL LISTA(NOP,THM2,MP2)
      GO TO 80
   75 NOP=0
      CALL LISTA(NOP,THM1,MP1)
      GO TO 308
   76 NOP=0
      CALL LISTA(NOP,THM2,MP2)
      GO TO 308
   79 NOP=0
      CALL LISTA(NOP,THM3,MP3)
      GO TO 308
C
C   LIST SCALE
C
   77 NMAX=0
      N=777
      CALL NCRT('CHO',N,NMAX)
      WRITE(4,204)
      DO 147 I=1,NSCL
      READ(7)B(1)
      IF(B(1))GO TO 308
  147 WRITE(4,203)NME(I),DME(I),DM2(I)
      GO TO 308
C
C   LIST DURATIONS
C
   78 NMAX=0
      N=777
      CALL NCRT('CHO',N,NMAX)
      WRITE(4,204)
      DO 148 I=1,10
      READ(7)B(1)
      IF(B(1))GO TO 308
  148 WRITE(4,208)NUR(I),DUR(I),SDUR(I)
      GO TO 308
C
C   LIST MOTIVE POINTERS
C
   82 NMAX=0
      N=777
      CALL NCRT('CHO',N,NMAX)
      WRITE(4,204)
      NAT=MP2(75,1)
      DO 247 I=1,NAT
      READ(7)B(1)
      IF(B(1))GO TO 308
  247 WRITE(4,209)I,MP2(I,1),MP2(I,2)
      WRITE(4,204)
      GO TO 308
C
C************************************************
C
C   INSTRUMENT SELECTION
C
  423 NMAX=18
      INS=0
      ZZ='CHL'
      CALL NCRT(ZZ,INS,NMAX)
C   TIN = TOP OF INSTRUMENT RANGE
      TIN=INST(INS,2)
C   BIN= BOTTOM OF INSTRUMENT RANGE
      BIN=INST(INS,1)
      GO TO 309
C
C   METRONOME
C
   70 NMAX=12
      CALL CLEAR(.TRUE.)
      NN=0
      ZZ='CHA'
      CALL NCRT(ZZ,NN,NMAX)
      NN=NN*10
      CALL NDUR(NN,DUR)
      IF(KNT.EQ.1)GO TO 12
      GO TO 309
C
C   TIMING SECTION
C
   12 NMAX=6
      CALL CLEAR(.TRUE.)
      NGB=0
      ZZ='CHB'
      CALL NCRT(ZZ,NGB,NMAX)
      NMAX=4
      NB=0
      ZZ='CHC'
      CALL NCRT(ZZ,NB,NMAX)
      IF(KNT.EQ.1)GO TO 452
      GO TO 309
C
C************************************************
C
C   INITIALIZATION - SCALES,DURATIONS&NAMES
C
   71 CALL OPEN(1,FIL4)
C   READ VOLUME LABELS
      DO 17 I=1,5
   17 READ(1,202)VOL(I)
C   READ SPECIAL TRIGGER HEADINGS
      DO 10 I=1,2
   10 READ(1,202)TRG(I)
C   READ DURATIONS IN 64THS FOR INTERPRETATION USE
      DO 18 I=1,10
   18 READ(1,*)SDUR(I)
C   READ NOTE DURATION NAMES
      DO 11 I=1,10
   11 READ(1,202)NUR(I)
C   READ INSTRUMENT RANGES
      DO 643 I=1,18
  643 READ(1,*)INST(I,1),INST(I,2)
C   SET INITIAL RANGES AS ENTIRE SCALE
      BIN=1
      TIN=98
      READ(1,*)ZZ
C   READ IN THE SCALE
      I=1
   15 READ(1,203)NME(I),DME(I),DM2(I)
      IF(NME(I).EQ.END)GO TO 16
      I=I+1
      GO TO 15
C   RECORD # OF NOTES READ IN FOR SCALE
   16 NSCL=I-1
      IF(KNT.EQ.1)GO TO 70
      GO TO 80
C
C************************************************
C
C   THIS SECTION INPUTS A SPECIFIED THEME FROM FILE TEMP SRC
C   TRANSLATES TO MOTIVE FORM AND PUTS IN THM1 AND THM2
C
C   SEE WHAT IS IN TEMP FILE & BUILD MENU
  452 N=777
      NMAX=0
      CALL NCRT('CHZ',N,NMAX)
      CALL OPEN(1,FIL2)
      N=1
C   NTH IS COUNTER FOR # OF THEMES IN TEMP
      NTH=0
C   NNIT IS PUT IN FNP AND IS START LINE # OF EACH THEME IN TEMP
      NNIT=0
  450 READ(1,202)AB
      NNIT=NNIT+1
      IF(AB.EQ.END)GO TO 450
      IF(AB.EQ.CON)GO TO 453
      DO 451 I=1,98
  451 IF(AB.EQ.NME(I))GO TO 450
C   NAMES OF THEMES ARE PUT IN FN
      FN(N)=AB
      FNP(N)=NNIT
      N=N+1
      NTH=NTH+1
      GO TO 450
C   NCON IS THE LINE # OF THE CON STATEMENT IN THE FILE
  453 NCON=NNIT
      IF(KNT.NE.1)GO TO 306
   43 IX=200
      CALL CLEAR(.TRUE.)
      IY=800
      DO 456 I=1,NTH
      AB=FN(I)
      K=I+10
      CALL TEXT(2,K,IX,IY,7,1,TWO,AB)
  456 IY=IY-35
      NMAX=50
      CALL NCRT('CHD',IY,NMAX)
      IF(IY.LT.11)GO TO 400
      IF(IY.GE.11)IY=IY-10
      ZZ=FN(IY)
      CALL OPEN(1,FIL2)
   40 READ(1,202)AB
      IF(ZZ.EQ.AB)GO TO 41
      IF(AB.EQ.CON)GO TO 42
      GO TO 40
C   3 LETTER CODE DOES NOT EXIST
   42 WRITE(4,107)
      GO TO 43
C   3 LETTER CODE FOUND
   41 NNT=0
      NATU=200
      NNMT=1
  126 DO 46 J=1,NATU
      READ(NNMT,206)AB,AC,AD
      IF(AB.EQ.END)GO TO 49
C   AB IS THE PITCH ALPHANUMERIC
C   AC IS THE DURATION ALPHANUMERIC
C   AD IS THE SPECIAL TRIGGER ALPHANUMERIC
C   DECODE THE ALPHANUMERICS
      DO 44 I=1,110
C   TRY TO MATCH THE NOTE NAME
   44 IF(AB.EQ.NME(I))GO TO 45
C   NOTE NAME DOESN'T EXIST
      WRITE(4,108)AB
C   RETURN TO CONTROL
      GO TO 400
C   NOTE NAME FOUND
   45 THM3(J,1)=I
      DO 47 I=1,10
   47 IF(AC.EQ.NUR(I))GO TO 48
      WRITE(4,109)AC
C   RETURN TO CONTROL SINCE DURATION IS UNINTERPRETABLE
      GO TO 400
   48 THM3(J,2)=I
C   TRY TO MATCH SPECIAL NAME
      IF(AD.NE.SLR)GO TO 322
      THM3(J,3)=1
      GO TO 321
  322 IF(AD.NE.STC)GO TO 320
      THM3(J,3)=2
      GO TO 321
  320 THM3(J,3)=3
C   COUNT THE # OF NOTES READ IN
  321 NNT=NNT+1
   46 CONTINUE
C   SECTION TO PLAY BACK COMPOSITION FILE
      IF(NNMT.EQ.1)GO TO 49
      CALL BACK(NATU,THM3)
      IF(K12.EQ.1)GO TO 127
      GO TO 349
   49 CONTINUE
C   PUT THEME IN THM2 AFTER MOTIVE ROUTINE
      CALL TRM(NNT,THM3,THM1,MP1)
C   TRANSFER TO THM2 FOR TRANSFORMATION
      CALL MOV(THM1,MP1,THM2,MP2)
      CALL MOV(THM1,MP1,THM3,MP3)
      IF(KNT.EQ.1)GO TO 80
      GO TO 306
C
C************************************************
C
C   STORAGE
C
  470 ZZ='CH4'
      NMAX=3
      N=0
      CALL NCRT(ZZ,N,NMAX)
      GO TO(120,121,306),N
C
C   STORE PERIOD IN TEMP
C
  120 ZZ='CHN'
      NMAX=0
      N=777
      CALL NCRT(ZZ,N,NMAX)
      READ(4,*)AA
      IF(AA.EQ.END)GO TO 306
      CALL OPEN(1,FIL2)
      CALL OPEN(5,FIL3)
      NTH=NTH+1
      FN(NTH)=AC
      FNP(NTH)=NCON
      NX=NCON-1
      DO 471 I=1,NX
      READ(1,206)AB,AC,AD
  471 WRITE(5,207)AB,AC,AD
      WRITE(5,207)AA
      NAX=MP2(75,2)
      DO 472 I=1,NAX
      NNIT=NNIT+1
  472 WRITE(5,207)NME(THM2(I,1)),NUR(THM2(I,2)),TRG(THM2(I,3))
      WRITE(5,207)END
      WRITE(5,207)CON
      NCON=NNIT+2
      CALL OPEN(1,FIL2)
      CALL OPEN(5,FIL3)
      DO 104 I=1,NCON
      READ(5,206)AB,AC,AD
  104 WRITE(1,207)AB,AC,AD
      GO TO 452
C
C************************************************
C
C   WRITE TO COMPOSITION FILE 'COMP'
C
  121 NAS=MP2(75,2)
      DO 122 I=1,NAS
      NCOMP=NCOMP+1
  122 WRITE(3,207)NME(THM2(I,1)),NUR(THM2(I,2)),TRG(THM2(I,3))
      GO TO 306
C
C   PLAY ON MOOG
C
   74 ZZ='CH5'
       NMAX=4
      N=0
      NSIM=0
      CALL NCRT(ZZ,N,NMAX)
      GO TO (132,124,984,306),N
  984 NSIM=1
      GO TO 124
C
C   INPUT FROM WHERE?
C
  400 NMAX=5
      N=0
      CALL NCRT('CHX',N,NMAX)
      IF(N.GT.3)GO TO 306
      GO TO (43,479,480),N
C
C   INPUT FROM CRT
C
  479 CALL KEY
      CALL TRM(NST2,THM3,THM1,MP1)
      CALL MOV(THM1,MP1,THM2,MP2)
      GO TO 306
C
C   INPUT FROM MOOG
C
  480 NMAX=0
      N=777
      NPT=1
      CALL NCRT('CHR',N,NMAX)
C   PITCH IS 18,TRIGGER IS 19
      LIST(1)=18
      LIST(2)=19
      LIS(1)=1
      LIS(2)=2
      WAIT=.TRUE.
      N=2
  407 WRITE(7)F,F,F
      NSX=0
      MSG='ENTER NOTE FROM KEYBOARD'
      CALL TEXT(2,35,50,100,7,2,TWO,MSG)
  402 CALL INPUT(N,LIST,LIST2,WAIT)
C   A KEY HAS BEEN PRESSED IF TRIGGER DROPS TO ZERO
      IF(LIST2(2).LT.200)GO TO 403
      READ(7)B(1),B(2)
      IF(B(1))GO TO 410
      IF(B(2))GO TO 406
      GO TO 402
  406 LIST2(2)=2047
      THM3(NPT,1)=1
      I=2
      NPT=NPT+1
      GO TO 405
  403 IF(NSX.EQ.1)GO TO 992
      NSX=1
      DO 993 I=1,175
  993 X=12*3.14159
      GO TO 402
C   TRY TO IDENTIFY THE NOTE
  992 CALL TEXT(3,35)
      NNZ=LIST2(1)
      DO 404 I=2,98
  404 IF(NNZ.LT.DM2(I))GO TO 499
C   NOTE IS UNIDENTIFIABLE
      WRITE(4,*)LIST2(1)
      GO TO 306
  405 I=I-1
  499 LIST2(1)=DME(I)
      CALL OUTPUT(N,LIS,LIST2)
      ZZ=NME(I)
      THM3(NPT,1)=I
      NPT=NPT+1
      IF(NPT.GT.195)NPT=1
      CALL TEXT(2,30,100,500,7,2,TWO,ZZ)
      WRITE(7)F
      IF(B(2))GO TO 407
  408 CALL INPUT(N,LIST,LIST2,WAIT)
      IF(LIST2(2).GT.200)GO TO 407
      READ(7)B(1)
      IF(B(1))GO TO 410
      GO TO 408
C   SET ALL AS NORMAL QUARTER NOTES)
  410 DO 411 I=1,NPT
      THM3(I,2)=4
  411 THM3(I,3)=3
      NPT=NPT-1
      CALL TRM(NPT,THM3,THM1,MP1)
      CALL MOV(THM1,MP1,THM2,MP2)
      GO TO 306
C
C   PLAY COMP FILE ON THE MOOG
C
  124 CALL OPEN(3,FIL1)
      NNMT=3
C   LOAD IN AND PLAY 150 NOTES AT A TIME
      NNN=NCOMP
      K12=0
  349 NNN=NNN-150
      IF(NNN.LE.0)GO TO 348
      NATU=150
      GO TO 126
  348 K12=1
      NATU=NNN+150
      GO TO 126
C
C   RESTORE COMP FILE FOR OUTPUT
C
  127 CALL OPEN(5,FIL3)
      CALL OPEN(3,FIL1)
      DO 128 I=1,NCOMP
      READ(3,206)AB,AC,AD
  128 WRITE(5,207)AB,AC,AD
      CALL OPEN(5,FIL3)
      CALL OPEN(3,FIL1)
      DO 129 I=1,NCOMP
      READ(5,206)AB,AC,AD
  129 WRITE(3,207)AB,AC,AD
      IF(NSIM.EQ.1)GO TO 132
      GO TO 306
C
  107 FORMAT(/39H SPECIFIED 3 LETTER CODE DOES NOT EXIST)
  108 FORMAT(/10H NOTE NAME,1X,A3,1X,14HDOES NOT MATCH)
  109 FORMAT(/14H DURATION NAME,1X,A3,1X,14HDOES NOT MATCH)
  202 FORMAT(1X,A3)
  203 FORMAT(1X,A3,2F10.3)
  204 FORMAT(//)
  206 FORMAT(3(1X,A3))
  207 FORMAT(1X,' ',A3,1X,A3,1X,A3)
  208 FORMAT(1X,A3,2(1X,I4))
  209 FORMAT(1X,I4,1X,I4,1X,I4)
C
  123 CONTINUE
      STOP
      END