home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vb_mpu / mpudemo1.bas < prev    next >
Encoding:
BASIC Source File  |  1995-09-06  |  8.3 KB  |  200 lines
  1. ' ***************************************************************************
  2. ' *                                                                         *
  3. ' * This file is named 'MPUDEMO1.BAS' and was converted from the file       *
  4. ' * MPUDEMO1.BAS created by By Gino Silvestri [71505,1436] for Turbo Basic. *
  5. ' * In addition it uses INOUT.DLL created By Bill Faggart [73075,645] that  *
  6. ' * gives Visual Basic the ability to access ports. Both of these           *
  7. ' * individuals are active on Compuserve                                    *
  8. ' * There have been no major enhancements to this pgm just a straight port  *
  9. ' * and the creation of a WAIT function for Visual Basic that mimics the    *
  10. ' * WAIT function in Turbo Basic.                                           *
  11. ' *                                                                         *
  12. ' * Requirements: Requires VBRUN100.DLL and INOUT.DLL                       *
  13. ' * Note: INOUT.DLL must be either in your Windows directory or a directory *
  14. ' *       on your path statement                                            *
  15. ' * WARNING:  If you don't HAVE an MPU-401 hooked up, program hangs up!     *
  16. ' *                                                                         *
  17. ' * Have Fun!!                                                              *
  18. ' *                                                                         *
  19. ' * Michael Love Graves [72240,1123]                                        *
  20. ' ***************************************************************************
  21.  
  22.  
  23. ' ***************************************************************************
  24. ' *                        D E F I N I T I O N S                            *
  25. ' ***************************************************************************
  26. DefInt A-Z
  27. '
  28. Const True = -1
  29. Const False = 0
  30. Const ComdPort = &H331                          ' MPU-401 Command Port on IBM
  31. Const statport = &H331                        ' MPU-401 Status Port on IBM
  32. Const DataPort = &H330                        ' MPU-401 Data I/O Port on IBM
  33. Const DRR = &H40                              ' Mask for Data Read Reg. Bit
  34. Const DSR = &H80                              ' Mask for Data Set Ready Bit
  35. Const ACK = &HFE                              ' MPU-401 Acknowledge Response
  36. Const maskflip = &HFF                         ' WAIT Function Bit Mask XOR
  37. Const MPUReset = &HFF                         ' MPU-401 Total Reset Command
  38. Const UARTMode = &H3F                         ' MPU-401 "Dumb UART Mode"
  39. Const NoteOn1 = &H90                          ' MIDI Note On for Channel 1
  40. Const Velocity = 64                           ' MIDI Medium Key Velocity
  41. Const NoteOff = 0                             ' 0 Velocity = Note Off
  42. Const FirstNote = 36                          ' First note synth can play
  43. Const LastNote = 96                           ' Last note synth can play
  44.  
  45. Sub Delay (count)
  46.   For x = 1 To count
  47.   Next x
  48. End Sub
  49.  
  50. ' ***************************************************************************
  51. ' *                         M A I N   P R O G R A M                         *
  52. ' ***************************************************************************
  53. Sub MpuPlay ()
  54.  
  55.     Form1.text1.text = "  MPUDEMO1 playing a fast scale on MIDI Channel 1"
  56.  
  57.     For note = FirstNote To LastNote           ' Ascending Scale
  58.  
  59.         
  60.       Call Playit(note)                        ' Play a note
  61.                     
  62.       Delay 3000                               ' Duration of note ON
  63.       Call Offit(note)                         ' Stop that same note
  64.  
  65.     Next                                       ' Play next note
  66.  
  67.  
  68.     Delay 4000                                 ' Pause between scales
  69.  
  70.  
  71.     For note = LastNote To FirstNote Step -1      ' Descending Scales
  72.  
  73.       Call Playit(note)                        ' Play a note
  74.  
  75.       Delay 3000                               ' Duration of note ON
  76.  
  77.       Call Offit(note)                         ' Stop that same note
  78.  
  79.     Next
  80.  
  81.  
  82.     Delay 10000                              ' Pause between demos
  83.  
  84.  
  85.     Form1.text1.text = " MPUDEMO1 now playing some chords on MIDI Channel 1"
  86.  
  87.     For n = 1 To 3                          ' Playing first chord thrice
  88.  
  89.         note = 65                       ' F3
  90.         Call Playit(note)               ' Start a chord
  91.         note = 69                       ' A3
  92.         Call Playit(note)
  93.         note = 72                       ' C4
  94.         Call Playit(note)
  95.  
  96.         Delay 14000                      ' Duration of held chord
  97.  
  98.         note = 65                       ' F3
  99.         Call Offit(note)                ' Stop the chord
  100.         note = 69                       ' A3
  101.         Call Offit(note)
  102.         note = 72                       ' C4
  103.         Call Offit(note)
  104.  
  105.         Delay 14000                      ' Duration of rest
  106.  
  107.  
  108.     Next                                    ' Play chord again
  109.  
  110.  
  111.         note = 64                       ' E3
  112.         Call Playit(note)               ' Start last chord
  113.         note = 67                       ' G3
  114.         Call Playit(note)
  115.         note = 72                       ' C4
  116.         Call Playit(note)
  117.  
  118.         Delay 32000                     ' Duration of held chord
  119.  
  120.         note = 64
  121.         Call Offit(note)                ' Stop the chord
  122.         note = 67
  123.         Call Offit(note)
  124.         note = 72
  125.         Call Offit(note)
  126.  
  127.     
  128.     Form1.text1.text = "       MPUDEMO1 is through - Tinker with it!"
  129.  
  130. End Sub
  131.  
  132. Sub Offit (note)                ' Turn off a MIDI Note
  133.  
  134. '****************************** Offit routine ******************************
  135. ' * Note: Read of DataPort prevents hang-up if MIDI IN from a keyboard is
  136. '   connected and played - WAIT would stay FOREVER if you hit any key once!
  137.  
  138.  
  139.     OUT DataPort, NoteOn1                   ' Send Chan. 1 note ON code
  140.     a = INP(DataPort)                       ' Dummy Read to clear buffer *
  141.     Wait statport, DRR, maskflip            ' Wait for port ready
  142.  
  143.     OUT DataPort, note                      ' Send note number to turn OFF
  144.     a = INP(DataPort)                       ' Dummy Read to clear buffer *
  145.     Wait statport, DRR, maskflip            ' Wait for port ready
  146.  
  147.     OUT DataPort, NoteOff                   ' Send 0 Velocity = Note Off
  148.     a = INP(DataPort)                       ' Dummy Read to clear buffer *
  149.     Wait statport, DRR, maskflip            ' Wait for port ready
  150.  
  151. End Sub
  152.  
  153. ' ***************************** Playit SUBROUTINE ***************************
  154. Sub Playit (note As Integer)                    ' Play a MIDI Note
  155.  
  156.     OUT DataPort, NoteOn1                   ' Send Chan. 1 note ON code
  157.     a = INP(DataPort)                       ' Dummy Read to clear buffer *
  158.     Wait statport, DRR, maskflip            ' Wait for port ready
  159.     
  160.     OUT DataPort, note                      ' Send note Number to turn ON
  161.     a = INP(DataPort)                       ' Dummy Read to clear buffer *
  162.     Wait statport, DRR, maskflip            ' Wait for port ready
  163.  
  164.     OUT DataPort, Velocity                  ' Send medium velocity
  165.     a = INP(DataPort)                       ' Dummy Read to clear buffer *
  166.     Wait statport, DRR, maskflip            ' Wait for port ready
  167.  
  168. End Sub
  169.  
  170. ' ***************************************************************************
  171. ' *                       I N I T I A L I Z A T I O N                       *
  172. ' ***************************************************************************
  173. Sub RSTMPU ()                                   ' Reset the MPU-401
  174.     
  175.     OUT ComdPort, MPUReset                  ' Send MPU-401 RESET Command
  176.     a = INP(DataPort)                       ' Dummy read to clear buffer
  177.  
  178.     Wait statport, DRR, maskflip            ' Wait for port ready
  179.  
  180.     OUT ComdPort, UARTMode                  ' Set MPU-401 "Dumb UART" Mode
  181.     a = INP(DataPort)                       ' Dummy Read to clear buffer
  182.  
  183.     Wait statport, DSR, maskflip            ' Wait for "UART" port ready -
  184.                         ' Really crucial!!!!
  185. End Sub
  186.  
  187. ' ************************** WAIT subroutine **********************************
  188. ' * This routine reads the statport, xor's the data with maskflip (0FFH) and  *
  189. ' * ANDs it with DRR or DSR (MpuData).                                        *
  190. ' *****************************************************************************
  191. '
  192. Sub Wait (statport, MpuData, maskflip)
  193.   Statportbyte = INP(statport)                              ' Get any data at midi statport
  194.   While ((Statportbyte Xor maskflip) And MpuData) = False   ' Loop until either bit 6 or 7
  195.                                 '   (DRR or DSR) are set
  196.     Statportbyte = INP(statport)                            ' Get data again if necessary
  197.   Wend
  198. End Sub
  199.  
  200.