home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / msdos / basic / rukq10 / x02mx.bas < prev    next >
Encoding:
BASIC Source File  |  1993-02-15  |  6.8 KB  |  215 lines
  1.  
  2. REM $INCLUDE: 'RUCKMIDI.BI'
  3.  
  4. '----------------------------------------
  5. 'THIS EXAMPLE WORKS FOR QB, BASIC7, VBDOS
  6. '----------------------------------------
  7.  
  8. 'X02MX.BAS - OutMsg any particular sound via MIDI channel messages
  9. 'no string$ passing to RUCKUS-MIDI used so this will work with all BASICs
  10. '
  11. '31-Jan-93 -chh
  12. 'C>bc X02MX /o;
  13. 'C>link X02MX,X02MX.EXE,nul,RUCKMIDI.LIB;
  14. Version$ = " [930131]"
  15.  
  16.  
  17. DEFINT A-Z
  18.  
  19. DIM SMIP AS SysInfoMidiPackTYPE
  20. DIM MIMP AS mInitMidiPackTYPE
  21. DIM SMP AS SetMidiPackTYPE
  22. DIM SFMPP AS SetFMProPackTYPE
  23. DIM XMP AS XitMidiPackTYPE
  24. DIM OMMP AS OutMsgMidiPackTYPE
  25.  
  26. CLS
  27.  
  28. 'initialize device and register ExitMidi via AtExitMidi
  29. 'see X01M for more setup info
  30.  
  31. MIMP.Func = InitMidi
  32. MIMP.DeviceID = 1     'AdLib in percussive mode (for drums mapped to ch9)
  33. MIMP.IOport = &H388
  34. MIMP.ChMask = &H23F   '0000 0010 0011 1111 <-channel mask(1=play,0=ignore)
  35. MIMP.PercCh = 9       'MIDI ch9 (0-based) is mapped to the 5 AdLib percs
  36. MIMP.Flags = 0
  37. stat = RUCKMIDI(MIMP)
  38.  
  39. IF stat = 0 THEN
  40.  
  41.    'register ExitMidi and notify if failure occured, non-fatal and unlikely
  42.    'note that you only want to call AtExitMidi *once* in your program
  43.  
  44.    XMP.Func = AtExitMidi
  45.    stat2 = RUCKMIDI(XMP)
  46.    IF stat2 THEN INPUT "AtExitMidi failed, press ENTER to continue", a$
  47.  
  48.    'see if we have enough RAM in the OS pool to work with
  49.  
  50.    DEF SEG = MIMP.InfoPtrSeg
  51.    bp = MIMP.InfoPtrOff
  52.    DOSleftK = 256 * PEEK(bp + 9) + PEEK(bp + 8)
  53.    DEF SEG
  54.  
  55.    'we don't want to indiscriminately use SETMEM(-amount) because, when
  56.    'in the IDE, QB does not automatically reclaim the amount at each new run
  57.  
  58.    IF DOSleftK < 2 THEN         'free up 2K just in case we need it
  59.       nix& = SETMEM(-2100)      'though this particular example won't
  60.    END IF
  61.  
  62.    'set SBPRO FM & master L&R volumes to maximum and steering to none
  63.    'harmless if no SBPRO at 220h
  64.    '(see X01M for more info on SBPRO FM control)
  65.  
  66.    SBPROport = &H220            'SBPRO is currently 220h or 240h only
  67.    SFMPP.Func = SetAllFMSBP
  68.    SFMPP.IOport = SBPROport
  69.    SFMPP.MasterVol = &HF0F      'low=right ch, high=left, -1 no change
  70.    SFMPP.Steer = 0              '0=none,1=left,2=right,3=*MUTE*,-1 no change
  71.    SFMPP.FMvol = &HF0F          'low=right ch, high=left ch, cannot skip
  72.    stat2 = RUCKMIDI(SFMPP)      'currently always succeeds
  73.  
  74. END IF
  75.  
  76. LOCATE 5
  77. PRINT "X02MX.BAS - RUCKUS-MIDI OutMsgMidi example. "; Version$
  78.  
  79. IF stat = 0 THEN
  80.      
  81.    'for this demo, ladies and gents, we use the MT-32 patches
  82.    'no error checking done in this example
  83.  
  84.    SMP.Func = SetPatchMidi
  85.    SMP.PatchMapID = 1        'MT-32 map (0=General MIDI)
  86.    SMP.PatchMapPtrOff = 0    'PatchMapPtr not used unless PatchMapID=-1
  87.    SMP.PatchMapPtrSeg = 0    'so assigning these to 0 is extra-credit
  88.    stat = RUCKMIDI(SMP)
  89.  
  90.    'Mstatus is &H8x to &HFx where x is the channel number, 0-F (0-15)
  91.    '(see the documentation under OutMsgMidi for specifics)
  92.    'Mdata varies with Mstatus, but is either 1 or 2 bytes
  93.  
  94. TestAgain:
  95.  
  96.    INPUT "Program:", PC
  97.    IF PC < 0 OR PC > 127 THEN GOTO TestEnd
  98.  
  99.    OMMP.Func = OutMsgMidi
  100.    OMMP.Mstatus = &HC0          'channel 0 program change
  101.    OMMP.Mdata = PC              'set channel 0 to program desired
  102.    stat = RUCKMIDI(OMMP)
  103.  
  104.    PRINT
  105.    PRINT "------------------------------------"
  106.    PRINT "Channel 0 is using program number"; PC
  107.  
  108.    'In NoteOn Mdata is key number (0-127 MIDI, but AdLib key numbers are
  109.    '                               valid from 12 to 107 (see docs for more)
  110.    'in the low byte and key velocity (0-127) in the high byte
  111.    '--velocity is essentially the volume desired
  112.  
  113.    Mstat = &H90                 'NoteOn, channel 0
  114.    Mdat = &H7F3C                'max velocity, note number 60 (middle C),
  115.    OMMP.Func = OutMsgMidi       'note 60 = 262Hz (see docs for freq table)
  116.    OMMP.Mstatus = Mstat
  117.    OMMP.Mdata = Mdat
  118.    stat = RUCKMIDI(OMMP)
  119.  
  120.    PRINT
  121.    PRINT "Playing a note with the NoteOn command."
  122.    PRINT "Press a key to send Note Off command..."
  123.    PRINT
  124.    PRINT " (NoteOn) ";
  125.    PRINT "Note:"; (Mdat AND &H7F);
  126.    PRINT " Channel:"; (Mstat AND &HF);
  127.    PRINT " Volume:"; (Mdat \ &H100);
  128.  
  129.    a$ = INPUT$(1)
  130.  
  131.    'note that sending a NoteOn (above) with velocity=0 has the same effect
  132.    'as performing an explicit NoteOff--often in MIDI data streams NoteOn
  133.    'with a Note=0 is used rather than the specific NoteOff message--
  134.    'here the NoteOff message is used (with the NoteOn method commented out)
  135.  
  136.    PRINT "(NoteOff. Press a key...)"
  137.  
  138.    OMMP.Func = OutMsgMidi
  139.    OMMP.Mstatus = &H80          'NoteOff, channel 0
  140.    OMMP.Mdata = 0               'any data will do
  141.    stat = RUCKMIDI(OMMP)
  142.  
  143.    ''OMMP.Func = OutMsgMidi
  144.    ''OMMP.Mstatus = &H90          'NoteOn, channel 0 (but really a note off)
  145.    ''OMMP.Mdata = &H3C            '003Ch is 0 volume, note 60
  146.    ''stat = RUCKMIDI(OMMP)
  147.  
  148.    a$ = INPUT$(1)
  149.  
  150.    'do something a little more exciting than that
  151.    '(see OutMsgMidi for more on MIDI channel messages in general)
  152.    
  153.    PRINT
  154.    PRINT "Playing the same note but applying +/- pitchbend to it."
  155.    PRINT
  156.  
  157.    Mstat = &H90                 'NoteOn, channel 0
  158.    OMMP.Func = OutMsgMidi
  159.    OMMP.Mstatus = Mstat
  160.    OMMP.Mdata = Mdat            'this is the same note as first played
  161.    stat = RUCKMIDI(OMMP)
  162.  
  163.    PRINT " (NoteOn) ";
  164.    PRINT "Note:"; (Mdat AND &H7F);
  165.    PRINT " Channel:"; (Mstat AND &HF);
  166.    PRINT " Volume:"; (Mdat \ &H100)
  167.  
  168.    'using just pitchbend this alters the frequency of the note being played
  169.    'for this example where just the single note is sounded, it's best to
  170.    'use a program that remains at the sustain level until a NoteOff is sent--
  171.    'programs that have EG=1 will do so (a high SL is also desired)
  172.    '(see OutMsgMidi for more)
  173.  
  174.    OMMP.Func = OutMsgMidi
  175.    OMMP.Mstatus = &HE0          'channel 0 pitchbend (2000h is base)
  176.  
  177.    StepSize = 32                   'CPU-speed dependent effect
  178.  
  179.    FOR i = 1 TO 10
  180.       FOR pitchbend = &H2000 TO 0 STEP -StepSize
  181.          OMMP.Mdata = pitchbend
  182.          stat = RUCKMIDI(OMMP)
  183.       NEXT
  184.       IF LEN(INKEY$) THEN EXIT FOR
  185.       FOR pitchbend = 0 TO &H3FFF STEP StepSize
  186.          OMMP.Mdata = pitchbend
  187.          stat = RUCKMIDI(OMMP)
  188.       NEXT
  189.       IF LEN(INKEY$) THEN EXIT FOR
  190.       FOR pitchbend = &H3FFF TO &H2000 STEP -StepSize
  191.          OMMP.Mdata = pitchbend
  192.          stat = RUCKMIDI(OMMP)
  193.       NEXT
  194.       IF LEN(INKEY$) THEN EXIT FOR
  195.    NEXT
  196.  
  197.    OMMP.Func = OutMsgMidi
  198.    OMMP.Mstatus = &H80          'NoteOff, channel 0
  199.    OMMP.Mdata = 0               'any data will do
  200.    stat = RUCKMIDI(OMMP)        'should always have a NoteOff for each NoteOn
  201.  
  202.    IF INSTR(COMMAND$, "/X") THEN CLS : PRINT "-1 to end": GOTO TestAgain
  203.  
  204. ELSE
  205.    PRINT "InitDevice failed, stat:"; stat
  206. END IF
  207.  
  208. TestEnd:
  209. 'shut down RUCKMIDI and end program
  210.  
  211. XMP.Func = ExitMidi
  212. nix = RUCKMIDI(XMP)
  213. END
  214.  
  215.