'===========================================================================
' Subject: PLAY ADLIB W/TEMPO COMMAND        Date: 11-10-97 (00:29)       
' Author:  Andrew S. Gibson                  Code: QB, QBasic, PDS        
' Origin:  zapf_dingbat@juno.com           Packet: SOUND.ABC
'===========================================================================
DEFINT A-Z
DECLARE SUB PlayAdLib (comand$)
DECLARE SUB WriteReg (reg AS INTEGER, value AS INTEGER)

'You say you wanted SoundBlaser code?  I've written a SUB that works with
'an AdLib-compatible speaker.  I think a SoundBlaster works too (at least,
'mine does).  It is very easy to use.  It uses the same command string that
'the PLAY command does.  The only difference is that at the top of your
'program you have to do a

PlayAdLib "{INIT}"

'to set the variables.  Here's the code:

'(The WriteReg SUB is needed for PlayAdLib to work.)

'I have a few other SUBs on my WWW site.  The address is in my signature.
'Glad I could help.

'- Borg953@aol.com
'  http://home.aol.com/Borg953

' Zapf_DingBat@Juno.com
' Play Adlib version 1.2 (?) - added tempo command !

PlayAdLib "T255L64O2ADFEGBBGEFDA"

SUB PlayAdLib (comand$)
  STATIC tempo, length, music, octave

  IF comand$ = "{INIT}" THEN
    tempo = 120
    length = 4
    music = 7 / 8
    octave = 4
    EXIT SUB
  END IF

  comand$ = UCASE$(comand$)
  FOR i% = 0 TO 224
    WriteReg i%, 0 'Clear all registers
  NEXT i%
  WriteReg &H20, &H1 'Plays carrier note at specified octave ch. 1
  WriteReg &H23, &H1 'Plays modulator note at specified octave ch. 1
  WriteReg &H40, &H1F 'Set carrier total level to softest ch. 1
  WriteReg &H43, &H0 'Set modulator level to loudest ch. 1
  WriteReg &H60, &HE4 'Set carrier attack and decay ch. 1
  WriteReg &H63, &HE4 'Set modulator attack and decay ch. 1
  WriteReg &H80, &H9D 'Set carrier sustain and release ch. 1
  WriteReg &H83, &H9D 'Set modulator sustain and release ch. 1

  C% = 1
  max% = LEN(comand$)
  WHILE C% <= max%
    x$ = MID$(comand$, C%, 1): C% = C% + 1    'extract subcommand
    IF INSTR("ABCDEFG", x$) <> 0 AND (C% <> max% AND INSTR("+#-", MID$(comand$, C%, 1))) THEN
      x$ = x$ + MID$(comand$, C%, 1): C% = C% + 1
      IF RIGHT$(x$, 1) = "+" THEN x$ = LEFT$(x$, 1) + "#"
      IF x$ = "D-" THEN x$ = "C#"
      IF x$ = "E-" THEN x$ = "D#"
      IF x$ = "G-" THEN x$ = "F#"   'convert all flats into equivalent sharps
      IF x$ = "A-" THEN x$ = "G#"
      IF x$ = "B-" THEN x$ = "A#"
    ELSEIF x$ = "O" THEN
      adj% = VAL(MID$(comand$, C%, 1)): C% = C% + 1
      IF adj% >= 0 AND adj% <= 6 THEN octave = adj%
    ELSEIF x$ = "<" AND octave > 0 THEN
      octave = octave - 1
    ELSEIF x$ = ">" AND octave < 6 THEN
      octave = octave + 1
    ELSEIF x$ = "T" THEN
      num$ = ""
      WHILE INSTR("0123456789", MID$(comand$, C%, 1))
        num$ = num$ + MID$(comand$, C%, 1): C% = C% + 1
      WEND
      IF VAL(LTRIM$(num$)) >= 1 AND VAL(LTRIM$(num$)) <= 255 THEN tempo = VAL(LTRIM$(num$))
    ELSEIF x$ = "L" THEN
      num$ = ""
      WHILE INSTR("0123456789", MID$(comand$, C%, 1))
        num$ = num$ + MID$(comand$, C%, 1): C% = C% + 1
      WEND
      IF VAL(LTRIM$(num$)) >= 1 AND VAL(LTRIM$(num$)) <= 64 THEN length = VAL(LTRIM$(num$))
    ELSEIF x$ = "P" THEN
      dotfac = 1
      num$ = ""
      WHILE INSTR("0123456789", MID$(comand$, C%, 1))
        num$ = num$ + MID$(comand$, C%, 1): C% = C% + 1
      WEND
      WHILE MID$(comand$, C%, 1) = "."
        dotfac = dotfac * 1.5: C% = C% + 1
      WEND
      IF VAL(num$) >= 1 AND VAL(num$) <= 64 THEN
        start! = TIMER
        ender! = start! + (((1 / VAL(num$)) * dotfac) * ((tempo / 120) * 2) * music)
        DO
        LOOP UNTIL TIMER >= ender!  'start! + (1 / VAL(num$))
      END IF
    ELSEIF x$ = "M" THEN
      next$ = MID$(comand$, C%, 1): C% = C% + 1
      x$ = x$ + next$
      IF x$ = "MN" THEN music = 7 / 8
      IF x$ = "MS" THEN music = 3 / 4
      IF x$ = "ML" THEN music = 1

    END IF
    IF INSTR("ABCDEFG", LEFT$(x$, 1)) THEN
      dotfac = 1
      WHILE MID$(comand$, C%, 1) = "."
        dotfac = dotfac * 1.5: C% = C% + 1
      WEND
      SELECT CASE x$
      CASE "C#"
        WriteReg &HA0, &H6B                 'Set note number
        WriteReg &HB0, &H21 + 4 * octave    'Set octave and turn on voice
      CASE "D"
        WriteReg &HA0, &H81
        WriteReg &HB0, &H21 + 4 * octave
      CASE "D#"
        WriteReg &HA0, &H98
        WriteReg &HB0, &H21 + 4 * octave
      CASE "E"
        WriteReg &HA0, &HB0
        WriteReg &HB0, &H21 + 4 * octave
      CASE "F"
        WriteReg &HA0, &HCA
        WriteReg &HB0, &H21 + 4 * octave
      CASE "F#"
        WriteReg &HA0, &HE5
        WriteReg &HB0, &H21 + 4 * octave
      CASE "G"
        WriteReg &HA0, &H2
        WriteReg &HB0, &H22 + 4 * octave
      CASE "G#"
        WriteReg &HA0, &H20
        WriteReg &HB0, &H22 + 4 * octave
      CASE "A"
        WriteReg &HA0, &H41
        WriteReg &HB0, &H22 + 4 * octave
      CASE "A#"
        WriteReg &HA0, &H63
        WriteReg &HB0, &H22 + 4 * octave
      CASE "B"
        WriteReg &HA0, &H87
        WriteReg &HB0, &H22 + 4 * octave
      CASE "C"
        WriteReg &HA0, &HAE
        WriteReg &HB0, &H22 + 4 * (octave - 1)
      END SELECT
      start! = TIMER
      ender! = start! + (((1 / length) * dotfac) * (((ABS(NOT tempo AND 255)) / 120) * 2) * music)
      DO
      LOOP UNTIL TIMER >= ender!  '(start! + (1 / length))
      WriteReg &HB0, 0
    END IF
  WEND
END SUB

SUB WriteReg (reg AS INTEGER, value AS INTEGER)
                      '&H is QBASIC hexadecimal prefix
  OUT &H388, reg      '&H388 is AdLib register/status port
                      'tells what register to write to
 
  FOR C% = 0 TO 5     'reading hardware port 6 times creates manditory 3.3 ms
    a% = INP(&H388)   'delay
  NEXT C%

  OUT &H389, value    '&H389 is AdLib data port
                      'sends data to the register specified above
                     
  FOR C% = 0 TO 34    'reading reg/stat port 35 times creates manditory
    a% = INP(&H388)   '23 ms delay
  NEXT C%
END SUB