'===========================================================================
' Subject: MPU-401 I/O ROUTINES               Date: 11-06-97 (16:33)       
'  Author: Andrew Below                       Code: QB, QBasic, PDS        
'  Origin: bel@obninsk.ru                   Packet: SOUND.ABC
'===========================================================================
'.---==== MPU-401 IO Routines ====----.
'------------Public Domain-------------
'Some MIDI information taken from SWAG FAQs from John Guillory
'(UART Info, Read/Write bitmasks), Colin Buckley (assembler routines
'code, Note On/Note Off messages), Steven Tallent (some other Pascal
'MIDI routines), Gunter Nagler (messages help) and, of course, from
'Jeff Glatts technical MIDI page (link from http://www.iicm.edu/midilinks)
'contains full MIDI specification, command and controllers descriptions
'and SysEx information, with C/C++ examples.
'ALL this code translated from assembler and Pascal, so I can't
'preview that these SUBs will work on all MPU-401 compatible synthesizers,
'but on my (Turtle Beach Tropez Classic, ICS WaveFront chip and MPU
'emulation) all of these works OK.
'
'Remember, some of these SUBs works ONLY on TB Tropez (I take them from
'TB User Guide) and using SysEx messages that won't work on other cards
'(in these messages used Manufacturer ID and Product ID for TB). Here are
'these SUBs: SetDrumChannel, ClearDrumChannel, SetSynthVolume,
'DisableMIDIIn, EnableMIDIIn. All other SUBs use standart MIDI commands
'and should work on all MPU-401 synthesizers.
'
'Code translated by Andrew Below,
'all your additions and updated/modified versions of this program
'please E-mail to: bel@obninsk.ru or onxman@geocities.com.
'
DECLARE SUB MPUReset ()
DECLARE SUB ChangeProgram (Channel!, PNumber!)
DECLARE SUB SendSysEx (s$)
DECLARE SUB NoteOn (Channel!, Note!, Velocity!)
DECLARE SUB NoteOff (Channel!, Note!, Velocity!)
DECLARE SUB Delay (d&)
DECLARE SUB MPUSendString (s$)
DECLARE SUB MPUSendByte (b!)
DECLARE FUNCTION Hx$ (N!)
DECLARE FUNCTION MPUByteHere! ()
DECLARE FUNCTION MPUGetByte! ()
'Constants
CONST Address = &H330               'Change this for your address
CONST NOn = &H90, NOff = &H80       'Note On and Note Off command codes
CONST PChange = &HC0                'Change Program command code
CONST Receive = &H40, Send = &H80   'Receive/Send bit maskes
CONST MReset = &HFF, UART = &H3F    'Reset and UART mode command codes
CONST True = 1, False = NOT True    'True/False constants

'The next part of a program is MIDI In command analyzer. I have only
'MIDI keyboard, NOT external synthesizer, so actual commands for me are
'Note On (press key), Note Off (release key) and Controller Change
'(on/off keyboard). If you have external synthesizer you may have
'also Program Change (included here) and Pitch Wheel (not included here).
'So, modify the next code for work with your keyboard/synthesizer.

WIDTH 80, 50            'Set 50 strokes mode
CLS
MPUReset                'Reset MPU
ChangeProgram 0, 50     'Set THRU channel program - Synth Strings 1
DO UNTIL INKEY$ <> ""
 IF MPUByteHere = True THEN
    b = MPUGetByte
    h$ = Hx$(b)
    PRINT USING ("&&"); h$; " ³ ";
    PRINT USING ("###"); b;
    PRINT " ³ ";
    HN$ = MID$(h$, 1, 1)           'Get high nibble (status byte)
    LN$ = MID$(h$, 2, 1)           'Get low nibble (command byte)
   SELECT CASE HN$
     CASE "9":
       PRINT "Note On on channel " + LN$
       NNum = True: NType = 1
     CASE "8":
       PRINT "Note Off on channel " + LN$
       NNum = True: NType = 0
     CASE "C":
       PRINT "Program Change on channel " + LN$
       PNum = True
     CASE "B":
       PRINT "Controller Change on channel " + LN$
       CNum = True
     CASE "F": IF LN$ = "0" THEN PRINT "SysEx start"
     CASE "F": IF LN$ = "7" THEN PRINT "SysEx end"
     CASE ELSE
      IF NVel = True THEN
         IF NType = 1 THEN PRINT "Attack Velocity"
         IF NType = 0 THEN PRINT "Decay Velocity"
         NVel = False
      END IF
      IF NNum = True THEN
         PRINT "Note Number"
         NNum = False
         NVel = True
      END IF
      IF PNum = True THEN
         PRINT "Program Number"
         PNum = False
      END IF
      IF CValue = True THEN
         PRINT "Controller Value"
         CValue = False
      END IF
      IF CNum = True THEN
         PRINT "Controller Number"
         CNum = False
         CValue = True
      END IF
   END SELECT
 END IF
LOOP

END

'Change program on specified MIDI channel
'Program cannot be changed if this MIDI channel sets as
'"Enhanced Drum Program channel"
SUB ChangeProgram (Channel, PNumber)
MPUSendByte (PChange + Channel)
MPUSendByte (PNumber)
END SUB

'Clears channel from Enhanced Drum Program
SUB ClearDrumChannel (Channel)
SendSysEx ("F0 00 00 65 10 00 22 " + Hx$(Channel) + " F7")
ChangeProgram Channel, 0
END SUB

'Just a delay
SUB Delay (d&)
FOR i& = 0 TO d&: NEXT i&
END SUB

'Disables MIDI-In to Synthesizer directive
SUB DisableMIDIIn
SendSysEx ("F0 00 00 65 10 00 1D F7")
END SUB

'Enables MIDI-In to Synthesizer directive
SUB EnableMIDIIn
SendSysEx ("F0 00 00 65 10 00 1E F7")
END SUB

FUNCTION Hx$ (N)
h$ = HEX$(N)
IF LEN(h$) < 2 THEN h$ = "0" + h$
Hx$ = h$
END FUNCTION

'Is there a byte ready to be received?
'If yes, return True (1), else - return False
FUNCTION MPUByteHere
IF (INP(Address + 1) AND Send) = 0 THEN
   MPUByteHere = True
ELSE
   MPUByteHere = False
END IF
END FUNCTION

'Get byte from MPU
'If you want to get byte only from buffer use
'the MPUByteHere function for check bytes in buffer
FUNCTION MPUGetByte
MPUGetByte = INP(&H330)
END FUNCTION

'Reset MPU-401
'This is not 100% right code, becouse sometimes after execution
'of this SUB synthesizer plays a "garbage notes"
SUB MPUReset
MPUSendByte (MReset)
IF MPUByteHere THEN MPUSendByte (UART)
END SUB

'Send a byte to MPU when MPU is ready
SUB MPUSendByte (b)
DO UNTIL (INP(Address + 1) AND Receive) = 0: LOOP
OUT Address, b
END SUB

'Send a string to MPU (useful for multi-command messages)
SUB MPUSendString (s$)
FOR i = 1 TO LEN(s$)
 MPUSendByte (ASC(MID$(s$, i, 1)))
NEXT i
END SUB

'Note Off
'Quiets specified note (0-127) on one of MIDI channels (0-15)
'with specified "out" Velocity (Volume)
SUB NoteOff (Channel, Note, Velocity)
MPUSendByte (NOff + Channel)
MPUSendByte (Note)
MPUSendByte (Velocity)
END SUB

'Note On
'Plays specified Note (0-127) on one of MIDI channels (0-15)
'with specified attack Velocity (Volume)
SUB NoteOn (Channel, Note, Velocity)
MPUSendByte (NOn + Channel)
MPUSendByte (Note)
MPUSendByte (Velocity)
END SUB

'Send SysEx message to the MPU
'String s$ contains the SysEx messages in hex format, e.g.
'SendSysEx("F0 00 14 50 20 1F 00 F7")
'This message don't do anything, it is just example
'All SysEx messages must be starting from F0 byte and ended with F7
SUB SendSysEx (s$)
FOR i = 1 TO LEN(s$) STEP 3
 b$ = MID$(s$, i, 2)
 MPUSendByte (VAL("&H" + b$))
NEXT i
END SUB

'Set specified MIDI channel as Enhanced Drum Program channel
SUB SetDrumChannel (Channel)
SendSysEx ("F0 00 00 65 10 00 33 " + Hx$(Channel) + "F7")
END SUB

'Sets synthesizer volume (0-127)
SUB SetSynthVolume (V)
SendSysEx ("F0 00 00 65 10 00 09 " + Hx$(V) + " F7")
END SUB