Category : BASIC Source Code
Archive   : VBMPU.ZIP
Filename : MPUDEMO1.TXT
' * *
' * This file is named 'MPUDEMO1.BAS' and was converted from the file *
' * MPUDEMO1.BAS created by By Gino Silvestri [71505,1436] for Turbo Basic. *
' * In addition it uses INOUT.DLL created By Bill Faggart [73075,645] that *
' * gives Visual Basic the ability to access ports. Both of these *
' * individuals are active on Compuserve *
' * There have been no major enhancements to this pgm just a straight port *
' * and the creation of a WAIT function for Visual Basic that mimics the *
' * WAIT function in Turbo Basic. *
' * *
' * Requirements: Requires VBRUN100.DLL and INOUT.DLL *
' * Note: INOUT.DLL must be either in your Windows directory or a directory *
' * on your path statement *
' * WARNING: If you don't HAVE an MPU-401 hooked up, program hangs up! *
' * *
' * Have Fun!! *
' * *
' * Michael Love Graves [72240,1123] *
' ***************************************************************************
' ***************************************************************************
' * D E F I N I T I O N S *
' ***************************************************************************
DefInt A-Z
'
Const True = -1
Const False = 0
Const ComdPort = &H331 ' MPU-401 Command Port on IBM
Const statport = &H331 ' MPU-401 Status Port on IBM
Const DataPort = &H330 ' MPU-401 Data I/O Port on IBM
Const DRR = &H40 ' Mask for Data Read Reg. Bit
Const DSR = &H80 ' Mask for Data Set Ready Bit
Const ACK = &HFE ' MPU-401 Acknowledge Response
Const maskflip = &HFF ' WAIT Function Bit Mask XOR
Const MPUReset = &HFF ' MPU-401 Total Reset Command
Const UARTMode = &H3F ' MPU-401 "Dumb UART Mode"
Const NoteOn1 = &H90 ' MIDI Note On for Channel 1
Const Velocity = 64 ' MIDI Medium Key Velocity
Const NoteOff = 0 ' 0 Velocity = Note Off
Const FirstNote = 36 ' First note synth can play
Const LastNote = 96 ' Last note synth can play
' ***************************************************************************
' * I N I T I A L I Z A T I O N *
' ***************************************************************************
Sub RSTMPU () ' Reset the MPU-401
OUT ComdPort, MPUReset ' Send MPU-401 RESET Command
a = INP(DataPort) ' Dummy read to clear buffer
Wait statport, DRR, maskflip ' Wait for port ready
OUT ComdPort, UARTMode ' Set MPU-401 "Dumb UART" Mode
a = INP(DataPort) ' Dummy Read to clear buffer
Wait statport, DSR, maskflip ' Wait for "UART" port ready -
' Really crucial!!!!
End Sub
' ***************************************************************************
' * M A I N P R O G R A M *
' ***************************************************************************
Sub MpuPlay ()
Form1.text1.text = " MPUDEMO1 playing a fast scale on MIDI Channel 1"
For note = FirstNote To LastNote ' Ascending Scale
Call Playit(note) ' Play a note
Delay 3000 ' Duration of note ON
Call Offit(note) ' Stop that same note
Next ' Play next note
Delay 4000 ' Pause between scales
For note = LastNote To FirstNote Step -1 ' Descending Scales
Call Playit(note) ' Play a note
Delay 3000 ' Duration of note ON
Call Offit(note) ' Stop that same note
Next
Delay 10000 ' Pause between demos
Form1.text1.text = " MPUDEMO1 now playing some chords on MIDI Channel 1"
For n = 1 To 3 ' Playing first chord thrice
note = 65 ' F3
Call Playit(note) ' Start a chord
note = 69 ' A3
Call Playit(note)
note = 72 ' C4
Call Playit(note)
Delay 14000 ' Duration of held chord
note = 65 ' F3
Call Offit(note) ' Stop the chord
note = 69 ' A3
Call Offit(note)
note = 72 ' C4
Call Offit(note)
Delay 14000 ' Duration of rest
Next ' Play chord again
note = 64 ' E3
Call Playit(note) ' Start last chord
note = 67 ' G3
Call Playit(note)
note = 72 ' C4
Call Playit(note)
Delay 32000 ' Duration of held chord
note = 64
Call Offit(note) ' Stop the chord
note = 67
Call Offit(note)
note = 72
Call Offit(note)
Form1.text1.text = " MPUDEMO1 is through - Tinker with it!"
End Sub
' ***************************** Playit SUBROUTINE ***************************
Sub Playit (note As Integer) ' Play a MIDI Note
OUT DataPort, NoteOn1 ' Send Chan. 1 note ON code
a = INP(DataPort) ' Dummy Read to clear buffer *
Wait statport, DRR, maskflip ' Wait for port ready
OUT DataPort, note ' Send note Number to turn ON
a = INP(DataPort) ' Dummy Read to clear buffer *
Wait statport, DRR, maskflip ' Wait for port ready
OUT DataPort, Velocity ' Send medium velocity
a = INP(DataPort) ' Dummy Read to clear buffer *
Wait statport, DRR, maskflip ' Wait for port ready
End Sub
Sub Offit (note) ' Turn off a MIDI Note
'****************************** Offit routine ******************************
' * Note: Read of DataPort prevents hang-up if MIDI IN from a keyboard is
' connected and played - WAIT would stay FOREVER if you hit any key once!
OUT DataPort, NoteOn1 ' Send Chan. 1 note ON code
a = INP(DataPort) ' Dummy Read to clear buffer *
Wait statport, DRR, maskflip ' Wait for port ready
OUT DataPort, note ' Send note number to turn OFF
a = INP(DataPort) ' Dummy Read to clear buffer *
Wait statport, DRR, maskflip ' Wait for port ready
OUT DataPort, NoteOff ' Send 0 Velocity = Note Off
a = INP(DataPort) ' Dummy Read to clear buffer *
Wait statport, DRR, maskflip ' Wait for port ready
End Sub
Sub Delay (count)
For x = 1 To count
Next x
End Sub
' ************************** WAIT subroutine **********************************
' * This routine reads the statport, xor's the data with maskflip (0FFH) and *
' * ANDs it with DRR or DSR (MpuData). *
' *****************************************************************************
'
Sub Wait (statport, MpuData, maskflip)
Statportbyte = INP(statport) ' Get any data at midi statport
While ((Statportbyte Xor maskflip) And MpuData) = False ' Loop until either bit 6 or 7
' (DRR or DSR) are set
Statportbyte = INP(statport) ' Get data again if necessary
Wend
End Sub
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/