OPTIONS Q
C
C *** PROGRAM TO CREATE CONFIGURATION FILE FOR RICHARD
C *** RUSSELL'S MUSIC 3.3 PROGRAM. WRITTEN BY DEREK
C *** FORDRED USING NEVADA FORTRAN. 19-03-1983.
C
C *** The Run-time package 'FRUN.COM' is Copyright Ellis Computing,
C *** 3917 Noriega Street, San Francisco, CA 94122.
C
      INTEGER FILNAM,COUNT,BUFF,ERLIN,BYTE,I,ER
      INTEGER OCTAVE,NOTE,R,PORT,SUM,POS,ADDR
      REAL FRIG,CLOCK, M,F,A
      DIMENSION BUFF(58),FILNAM(3)
      COMMON /BB/ COUNT,BUFF,SUM,POS,ADDR
C
C *** PREPARE ERROR TRAPPING FOR CONSOLE, CLEAR SCREEN AND SIGN ON.
C
      ERRSET 900,ER
      WRITE(1,1000)
1000  FORMAT(/////////////////////////)
      WRITE(1,1100)
1100  FORMAT(' *** MUSIC.COM CONFIGURATION PROGRAM *** '//)
C
C *** SET UP FILE FOR OUTPUT. ERASE ANY EXISTING FILE OF SAME NAME.
C
      POS=9
      WRITE(1,1150)
1150  FORMAT('Input name of configuration (.HEX) file: ',Z)
      READ(0,1200)FILNAM
1200  FORMAT(3A6)
      CALL DELET(FILNAM)
      CALL OPEN(3,FILNAM)
C
C *** CALCULATE NOTE VALUES AND WRITE TO OUTPUT FILE. THIS TAKES A
C *** FEW SECONDS SO TELL OPERATOR.
C
      ERLIN=1
110   ACCEPT 'Enter processor clock frequency (MHz): ',CLOCK
      TYPE ' '
      TYPE '*** Calculating Note Values. Please wait ***'
      CLOCK=CLOCK*1E6
      FRIG=65536*267/CLOCK
      SUM=0
      ADDR=$1600
      COUNT=0
      M=1.059463094
      F=32.70319563
      CALL INTEL(0)
      CALL INTEL(0)
      DO 130 OCTAVE=1,6
         DO 120  NOTE=1,12
            IF (NOTE.EQ.10)  F=IFIX(F+0.5)
            R=IFIX(F*FRIG+0.5)
            CALL INTEL(R)
            CALL INTEL(IFIX(R/256))
            F=F*M
            WRITE(1,1300)
1300        FORMAT('.',Z)
120      CONTINUE
130   CONTINUE
      A=256*CLOCK/2.458E6
      A=IFIX(A+0.5)
      CALL INTEL(A)
      CALL INTEL(IFIX(A/256))
      ERLIN=2
C
C *** THIS SECTION OBTAINS HARDWARE-DEPENDENT INFORMATION FOR
C *** CONFIGURING THE MUSIC PROGRAM.
C
      WRITE(1,1400)
1400  FORMAT(//'The following parameters must be given as decimal values:'/)
140   ACCEPT 'Output port number for DAC: ',PORT
      CALL INTEL($D3)
      CALL INTEL(PORT)
      ERLIN=3
150   ACCEPT 'Control port number for DAC ("N" if not used): ',PORT
160   IF(((PORT.GT.255).OR.(PORT.LT.0)).AND.(PORT.NE.999)) GOTO 150
      IF(PORT.EQ.999)THEN
      DO 170 I=1,8
         CALL INTEL(0)
170   CONTINUE
                 ELSE
      ERLIN=4
180   ACCEPT 'First initialisation byte for port: ',BYTE
      CALL INTEL($3E)
      CALL INTEL(BYTE)
      CALL INTEL($D3)
      CALL INTEL(PORT)
      ERLIN=5
190   ACCEPT 'Second initialisation byte ("N" if none required): ',BYTE
200   IF((BYTE.GT.255.OR.BYTE.LT.0).AND.BYTE.NE.999) GOTO 190
      IF(BYTE.EQ.999) THEN
           DO 210 J=1,4
              CALL INTEL(0)
210        CONTINUE
               ELSE
               CALL INTEL($3E)
               CALL INTEL(BYTE)
               CALL INTEL($D3)
               CALL INTEL(PORT)
               ENDIF
      ENDIF
      CALL LINE
      WRITE(3,1600)
1600  FORMAT(':00000001FF')
      ENDFILE 3
      CALL CLOSE(3)
      WRITE(1,1700)FILNAM
1700  FORMAT(//'*** Finished. Output in file ',3A6,/)
C
      CALL EXIT
C
C *** ERROR TRAPPING ROUTINES FOR CONSOLE INPUT
C
900   L=ERLIN
      IF(ERLIN.EQ.3)THEN
         PORT=999
         ENDIF
      IF(ERLIN.EQ.5) THEN
         BYTE=999
         ENDIF
C
      ERRSET 900,ER
      GOTO(110,140,160,180,200),L
      END
C
C *** SUBROUTINES FOLLOW.
C
      SUBROUTINE HEX(V)
C
C *** CONVERTS AN INTEGER TO ASCII HEX FORMAT. RESULT IN BUFF.
C
      INTEGER V,HI,LO,HX,TEMP1,TEMP2,COUNT,ADDR,SUM,POS
      COMMON /BB/ COUNT,BUFF(58),SUM,POS,ADDR
      DIMENSION HX(16)
      DATA HX(1)/'0'/,HX(2)/'1'/,HX(3)/'2'/
      DATA HX(4)/'3'/,HX(5)/'4'/,HX(6)/'5'/,HX(7)/'6'/
      DATA HX(8)/'7'/,HX(9)/'8'/,HX(10)/'9'/,HX(11)/'A'/
      DATA HX(12)/'B'/,HX(13)/'C'/,HX(14)/'D'/,HX(15)/'E'/
      DATA HX(16)/'F'/
C
      M=MOD(V,256)
      SUM=MOD(SUM+M,256)
      HI=IFIX(M/16)
      HI=HI+1
      LO=MOD(M,16)
      LO=LO+1
      ENCODE(TEMP1,1,1000) HX(HI)
      ENCODE(TEMP2,1,1000) HX(LO)
1000  FORMAT(A1)
      BUFF(POS)=TEMP1
      BUFF(POS+1)=TEMP2
      RETURN
      END
C
C
      SUBROUTINE INTEL(V)
C
C *** CONVERTS INTEGER V TO ASCII HEX FORMAT AND SAVES IT IN
C *** BUFF(). IF LINE IS FULL, WRITES IT TO THE OUTPUT FILE.
C
      INTEGER V,COUNT,SUM,POS,ADDR
      COMMON/BB/ COUNT,BUFF(58),SUM,POS,ADDR
C
      CALL HEX(V)
      COUNT=COUNT+1
      POS=POS+2
      IF (COUNT.LT.24) RETURN
      CALL LINE
      RETURN
      END
C
C
      SUBROUTINE LINE
C
C *** THIS ROUTINE 'TOPS AND TAILS' THE HEX DATA TO FORM AN
C *** INTEL HEX RECORD AND WRITES IT TO THE OUTPUT FILE.
C
      INTEGER POS,COUNT,ADDR,ENDPOS,SUM
      COMMON /BB/ COUNT,BUFF(58),SUM,POS,ADDR
C
      ENDPOS=POS
      POS=1
      CALL HEX(COUNT)
      POS=3
      CALL HEX(ADDR/256)
      POS=5
      CALL HEX(ADDR)
      POS=7
      CALL HEX(0)
      POS=ENDPOS
      ENDPOS=ENDPOS+1
      CALL HEX(256-SUM)
      POS=POS+2
      WRITE (3,1000)(BUFF(I),I=1,ENDPOS)
1000  FORMAT(':',58A1)
      SUM=0
      COUNT=0
      ADDR=ADDR+24
      POS=9
      RETURN
      END
