C MUSIC.F
C Usage: RUN386 -CALLBUFS 1 MUSIC
C Purpose: demonstrates interfacing between assembly
C language and NDP Fortran programs. The NDP code calls
C protected mode assembly language routines. These
C in turn communicate with a real mode assembly
C language routine. These assembly routines are used
C to control the underlying PC hardware. They do so
C by reading from and writing to ports and by
C taking over the timer tick interrupt.
C Copyright (C) MicroWay, Inc., 1989
C

      INTEGER WHOLE,WHOLEDOT,HALF,HALFDOT
      INTEGER QUARTER,QUARTERDOT,EIGHTH,EIGHTHDOT
      INTEGER SIXTEENTH,SIXTEENTHDOT
      INTEGER THIRTYSECOND,THIRTYSECONDDOT
      INTEGER SIXTYFOURTH,NONE

      PARAMETER (WHOLE=64,WHOLEDOT=WHOLE+WHOLE/2)
      PARAMETER (HALF=WHOLE/2,HALFDOT=WHOLE/2+WHOLE/4)
      PARAMETER (QUARTER=WHOLE/4,QUARTERDOT=WHOLE/4+WHOLE/8)
      PARAMETER (EIGHTH=WHOLE/8,EIGHTHDOT=WHOLE/8+WHOLE/16)
      PARAMETER (SIXTEENTH=WHOLE/16)
      PARAMETER (SIXTEENTHDOT=WHOLE/16+WHOLE/32)
      PARAMETER (THIRTYSECOND=WHOLE/32)
      PARAMETER (THIRTYSECONDDOT=WHOLE/32+WHOLE/64)
      PARAMETER (SIXTYFOURTH=WHOLE/64,NONE=0)

      INTEGER ERROR_VAL
      PARAMETER (ERROR_VAL=-1)

C assembly langauage functions called by main program
      INTEGER INIT_TIMER_ISR
      INTEGER PLAY
      INTEGER RESTORE_TIMER_ISR

C This example plays musical tunes. The tune is
C represented by a special data construct which
C is contrived to mimic the functionality of a
C a struct in C or a record in Pascal. Each 
C construct represents a note: the first field
C gives the note's duration and the second field
C denotes its name. Each name represents a note
C in the tempered chromatic scale. The names take
C one of three forms:
C            'A-G' ['#'|'b'] '0-8'
C   or       'A-G' '0-8'
C   or       'R'
C The first letter of every note must be in upper
C case - lower case 'b' is reserved to indicate the
C tone is a flat. If the note is a sharp or a flat,
C the second character is a '#' or a 'b' and the
C third character is a digit indicating the octave.
C If the note is not a sharp or a flat, then the
C second character is a digit indicating the octave.
C The only other character allowed is an upper case
C 'R', to denote rest or pause. Every name occupies
C 4 bytes and has 1, 2 or 3 visible characters, being
C padded on the right with blanks (value 32, hexadecimal
C 20). Since this is a tempered scale, the frequency of
C adjacent sharps and flats is the same, e.g., G#0 and
C Ab0 have the same pitch.
C The construct is created by a pair of EQUIVALENCED
C arrays, one being declared INTEGER*4, the other being
C declared CHARACTER*4

      INTEGER*4 DURATION (0:10)
      CHARACTER*4 NOTENAME (0:10)
      EQUIVALENCE (DURATION,NOTENAME)

C The two arrays declared above begin with element 0.
C The even numbered elements hold amount of time to
C sound the note, the odd numbered elements hold the
C name of the note.

C The following construct was contrived to overlay
C an array of structures defined in the assembly
C language module PLAY.S. Each structure holds
C information about a tone in the tempered chromatic
C scale and the entire array spans eight octaves.
C The first field of these is the name of the tone
C and takes essentially the same form as the name
C field in the NOTENAME array. The tones range from
C C0 to C8, middle C being C4. The second field is
C the frequency of the tone, e.g., A4 is 440 Hertz.
C The third field is the count between pulses to the
C speaker and is inversely proportional to the
C frequency. Notes C0 to E0 will not play, because
C their frequency is too low (i.e., their count is
C too high and occupies more than 16 bits) - using
C them will generate an error. For details on these
C structures, see PLAY.S.
C Each of the three equivalenced arrays below are used
C to access a field in the tone structure. The lowest
C element in all three is 0. Starting at element 0 in
C array TONENAME, every third element holds the name of
C the tone (e.g.,0,3,6,9...). Starting at element 1 in
C array FREQ, every third element holds the frequency of
C the tone (e.g.,1,4,7,10...). Starting at element 2 in
C array COUNT, every third element holds the count of the
C tone (e.g.,2,5,8,11...). Note that these arrays are
C placed in blank COMMON.

      CHARACTER*4 TONENAME (0:411)
      REAL*4 FREQ (0:411)
      INTEGER*4 COUNT (0:411)

      COMMON TONENAME

      EQUIVALENCE (TONENAME,FREQ,COUNT)
      INTEGER I

C next, the tune to be played
       DATA DURATION(0)/WHOLE/,    NOTENAME(1)/'C5'/
       DATA DURATION(2)/HALF/,     NOTENAME(3)/'E5'/
       DATA DURATION(4)/WHOLE/,    NOTENAME(5)/'G5'/
       DATA DURATION(6)/HALF/,     NOTENAME(7)/'E5'/
       DATA DURATION(8)/QUARTER/,  NOTENAME(9)/'R'/
       DATA DURATION(10)/WHOLE/,   NOTENAME(11)/'F4'/
       DATA DURATION(12)/QUARTER/, NOTENAME(13)/'D5'/
       DATA DURATION(14)/HALF/     NOTENAME(15)/'B4'/
       DATA DURATION(16)/WHOLE/,   NOTENAME(17)/'C5'/
       DATA DURATION(18)/NONE/,    NOTENAME(19)/''/

C begin main program

C initialize tempered chromatic scales
      CALL INIT_TCS

C display initialized tempered chromatic scales
      DO 1000, I = 0,410,3
          WRITE (*,1010) TONENAME(I),FREQ(I+1),COUNT(I+2)
 1000 CONTINUE
 1010 FORMAT (1X,A,2X,F10.2,2X,I5)

C skip a line
      WRITE (*,1050)
 1050 FORMAT(1X)

C set up new timer interrupt service routine
      I = INIT_TIMER_ISR()
      IF (I.EQ.ERROR_VAL) THEN
          WRITE (*,2000)
 2000 FORMAT (1X,'Problem in initializing new timer ISR')
          WRITE (*,2010)
 2010 FORMAT (1X,'Be sure to invoke RUN386.EXE with ',$)
          WRITE (*,2020)
 2020 FORMAT (1X,'-CALLBUFS equal to at least 1')
          STOP
      ENDIF

C play a little tune
      I = PLAY(DURATION(0))
      IF (I.EQ.ERROR_VAL) THEN
          WRITE (*,3000)
 3000 FORMAT (1X,'Problem in play function')
          STOP
      ENDIF

C restore old timer interrupt service routine
      I = RESTORE_TIMER_ISR()
      IF (I.EQ.ERROR_VAL) THEN
          WRITE (*,4000)
 4000 FORMAT (1X,'Problem in restoring old timer ISR')
          STOP
      ENDIF

      END
