home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / VISUAL_B / CODIGO_2 / VB_MPU / MPUDEMO1.BAS < prev    next >
Encoding:
BASIC Source File  |  1991-10-12  |  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. ' ***************************************************************************
  46. ' *                       I N I T I A L I Z A T I O N                       *
  47. ' ***************************************************************************
  48. Sub RSTMPU ()                                   ' Reset the MPU-401
  49.     
  50.     OUT ComdPort, MPUReset                  ' Send MPU-401 RESET Command
  51.     a = INP(DataPort)                       ' Dummy read to clear buffer
  52.  
  53.     Wait statport, DRR, maskflip            ' Wait for port ready
  54.  
  55.     OUT ComdPort, UARTMode                  ' Set MPU-401 "Dumb UART" Mode
  56.     a = INP(DataPort)                       ' Dummy Read to clear buffer
  57.  
  58.     Wait statport, DSR, maskflip            ' Wait for "UART" port ready -
  59.                         ' Really crucial!!!!
  60. End Sub
  61.  
  62. ' ***************************************************************************
  63. ' *                         M A I N   P R O G R A M                         *
  64. ' ***************************************************************************
  65. Sub MpuPlay ()
  66.  
  67.     Form1.text1.text = "  MPUDEMO1 playing a fast scale on MIDI Channel 1"
  68.  
  69.     For note = FirstNote To LastNote           ' Ascending Scale
  70.  
  71.         
  72.       Call Playit(note)                        ' Play a note
  73.                     
  74.       Delay 3000                               ' Duration of note ON
  75.       Call Offit(note)                         ' Stop that same note
  76.  
  77.     Next                                       ' Play next note
  78.  
  79.  
  80.     Delay 4000                                 ' Pause between scales
  81.  
  82.  
  83.     For note = LastNote To FirstNote Step -1      ' Descending Scales
  84.  
  85.       Call Playit(note)                        ' Play a note
  86.  
  87.       Delay 3000                               ' Duration of note ON
  88.  
  89.       Call Offit(note)                         ' Stop that same note
  90.  
  91.     Next
  92.  
  93.  
  94.     Delay 10000                              ' Pause between demos
  95.  
  96.  
  97.     Form1.text1.text = " MPUDEMO1 now playing some chords on MIDI Channel 1"
  98.  
  99.     For n = 1 To 3                          ' Playing first chord thrice
  100.  
  101.         note = 65                       ' F3
  102.         Call Playit(note)               ' Start a chord
  103.         note = 69                       ' A3
  104.         Call Playit(note)
  105.         note = 72                       ' C4
  106.         Call Playit(note)
  107.  
  108.         Delay 14000                      ' Duration of held chord
  109.  
  110.         note = 65                       ' F3
  111.         Call Offit(note)                ' Stop the chord
  112.         note = 69                       ' A3
  113.         Call Offit(note)
  114.         note = 72                       ' C4
  115.         Call Offit(note)
  116.  
  117.         Delay 14000                      ' Duration of rest
  118.  
  119.  
  120.     Next                                    ' Play chord again
  121.  
  122.  
  123.         note = 64                       ' E3
  124.         Call Playit(note)               ' Start last chord
  125.         note = 67                       ' G3
  126.         Call Playit(note)
  127.         note = 72                       ' C4
  128.         Call Playit(note)
  129.  
  130.         Delay 32000                     ' Duration of held chord
  131.  
  132.         note = 64
  133.         Call Offit(note)                ' Stop the chord
  134.         note = 67
  135.         Call Offit(note)
  136.         note = 72
  137.         Call Offit(note)
  138.  
  139.     
  140.     Form1.text1.text = "       MPUDEMO1 is through - Tinker with it!"
  141.  
  142. End Sub
  143.  
  144. ' ***************************** Playit SUBROUTINE ***************************
  145. Sub Playit (note As Integer)                    ' Play a MIDI Note
  146.  
  147.     OUT DataPort, NoteOn1                   ' Send Chan. 1 note ON code
  148.     a = INP(DataPort)                       ' Dummy Read to clear buffer *
  149.     Wait statport, DRR, maskflip            ' Wait for port ready
  150.     
  151.     OUT DataPort, note                      ' Send note Number to turn ON
  152.     a = INP(DataPort)                       ' Dummy Read to clear buffer *
  153.     Wait statport, DRR, maskflip            ' Wait for port ready
  154.  
  155.     OUT DataPort, Velocity                  ' Send medium velocity
  156.     a = INP(DataPort)                       ' Dummy Read to clear buffer *
  157.     Wait statport, DRR, maskflip            ' Wait for port ready
  158.  
  159. End Sub
  160.  
  161. Sub Offit (note)                ' Turn off a MIDI Note
  162.  
  163. '****************************** Offit routine ******************************
  164. ' * Note: Read of DataPort prevents hang-up if MIDI IN from a keyboard is
  165. '   connected and played - WAIT would stay FOREVER if you hit any key once!
  166.  
  167.  
  168.     OUT DataPort, NoteOn1                   ' Send Chan. 1 note ON code
  169.     a = INP(DataPort)                       ' Dummy Read to clear buffer *
  170.     Wait statport, DRR, maskflip            ' Wait for port ready
  171.  
  172.     OUT DataPort, note                      ' Send note number to turn OFF
  173.     a = INP(DataPort)                       ' Dummy Read to clear buffer *
  174.     Wait statport, DRR, maskflip            ' Wait for port ready
  175.  
  176.     OUT DataPort, NoteOff                   ' Send 0 Velocity = Note Off
  177.     a = INP(DataPort)                       ' Dummy Read to clear buffer *
  178.     Wait statport, DRR, maskflip            ' Wait for port ready
  179.  
  180. End Sub
  181.  
  182. Sub Delay (count)
  183.   For x = 1 To count
  184.   Next x
  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.