home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Best Objectech Shareware Selections
/
UNTITLED.iso
/
boss
/
musi
/
misc
/
017
/
x02mx.bas
< prev
next >
Wrap
BASIC Source File
|
1993-02-14
|
7KB
|
215 lines
REM $INCLUDE: 'RUCKMIDI.BI'
'----------------------------------------
'THIS EXAMPLE WORKS FOR QB, BASIC7, VBDOS
'----------------------------------------
'X02MX.BAS - OutMsg any particular sound via MIDI channel messages
'no string$ passing to RUCKUS-MIDI used so this will work with all BASICs
'
'31-Jan-93 -chh
'C>bc X02MX /o;
'C>link X02MX,X02MX.EXE,nul,RUCKMIDI.LIB;
Version$ = " [930131]"
DEFINT A-Z
DIM SMIP AS SysInfoMidiPackTYPE
DIM MIMP AS mInitMidiPackTYPE
DIM SMP AS SetMidiPackTYPE
DIM SFMPP AS SetFMProPackTYPE
DIM XMP AS XitMidiPackTYPE
DIM OMMP AS OutMsgMidiPackTYPE
CLS
'initialize device and register ExitMidi via AtExitMidi
'see X01M for more setup info
MIMP.Func = InitMidi
MIMP.DeviceID = 1 'AdLib in percussive mode (for drums mapped to ch9)
MIMP.IOport = &H388
MIMP.ChMask = &H23F '0000 0010 0011 1111 <-channel mask(1=play,0=ignore)
MIMP.PercCh = 9 'MIDI ch9 (0-based) is mapped to the 5 AdLib percs
MIMP.Flags = 0
stat = RUCKMIDI(MIMP)
IF stat = 0 THEN
'register ExitMidi and notify if failure occured, non-fatal and unlikely
'note that you only want to call AtExitMidi *once* in your program
XMP.Func = AtExitMidi
stat2 = RUCKMIDI(XMP)
IF stat2 THEN INPUT "AtExitMidi failed, press ENTER to continue", a$
'see if we have enough RAM in the OS pool to work with
DEF SEG = MIMP.InfoPtrSeg
bp = MIMP.InfoPtrOff
DOSleftK = 256 * PEEK(bp + 9) + PEEK(bp + 8)
DEF SEG
'we don't want to indiscriminately use SETMEM(-amount) because, when
'in the IDE, QB does not automatically reclaim the amount at each new run
IF DOSleftK < 2 THEN 'free up 2K just in case we need it
nix& = SETMEM(-2100) 'though this particular example won't
END IF
'set SBPRO FM & master L&R volumes to maximum and steering to none
'harmless if no SBPRO at 220h
'(see X01M for more info on SBPRO FM control)
SBPROport = &H220 'SBPRO is currently 220h or 240h only
SFMPP.Func = SetAllFMSBP
SFMPP.IOport = SBPROport
SFMPP.MasterVol = &HF0F 'low=right ch, high=left, -1 no change
SFMPP.Steer = 0 '0=none,1=left,2=right,3=*MUTE*,-1 no change
SFMPP.FMvol = &HF0F 'low=right ch, high=left ch, cannot skip
stat2 = RUCKMIDI(SFMPP) 'currently always succeeds
END IF
LOCATE 5
PRINT "X02MX.BAS - RUCKUS-MIDI OutMsgMidi example. "; Version$
IF stat = 0 THEN
'for this demo, ladies and gents, we use the MT-32 patches
'no error checking done in this example
SMP.Func = SetPatchMidi
SMP.PatchMapID = 1 'MT-32 map (0=General MIDI)
SMP.PatchMapPtrOff = 0 'PatchMapPtr not used unless PatchMapID=-1
SMP.PatchMapPtrSeg = 0 'so assigning these to 0 is extra-credit
stat = RUCKMIDI(SMP)
'Mstatus is &H8x to &HFx where x is the channel number, 0-F (0-15)
'(see the documentation under OutMsgMidi for specifics)
'Mdata varies with Mstatus, but is either 1 or 2 bytes
TestAgain:
INPUT "Program:", PC
IF PC < 0 OR PC > 127 THEN GOTO TestEnd
OMMP.Func = OutMsgMidi
OMMP.Mstatus = &HC0 'channel 0 program change
OMMP.Mdata = PC 'set channel 0 to program desired
stat = RUCKMIDI(OMMP)
PRINT
PRINT "------------------------------------"
PRINT "Channel 0 is using program number"; PC
'In NoteOn Mdata is key number (0-127 MIDI, but AdLib key numbers are
' valid from 12 to 107 (see docs for more)
'in the low byte and key velocity (0-127) in the high byte
'--velocity is essentially the volume desired
Mstat = &H90 'NoteOn, channel 0
Mdat = &H7F3C 'max velocity, note number 60 (middle C),
OMMP.Func = OutMsgMidi 'note 60 = 262Hz (see docs for freq table)
OMMP.Mstatus = Mstat
OMMP.Mdata = Mdat
stat = RUCKMIDI(OMMP)
PRINT
PRINT "Playing a note with the NoteOn command."
PRINT "Press a key to send Note Off command..."
PRINT
PRINT " (NoteOn) ";
PRINT "Note:"; (Mdat AND &H7F);
PRINT " Channel:"; (Mstat AND &HF);
PRINT " Volume:"; (Mdat \ &H100);
a$ = INPUT$(1)
'note that sending a NoteOn (above) with velocity=0 has the same effect
'as performing an explicit NoteOff--often in MIDI data streams NoteOn
'with a Note=0 is used rather than the specific NoteOff message--
'here the NoteOff message is used (with the NoteOn method commented out)
PRINT "(NoteOff. Press a key...)"
OMMP.Func = OutMsgMidi
OMMP.Mstatus = &H80 'NoteOff, channel 0
OMMP.Mdata = 0 'any data will do
stat = RUCKMIDI(OMMP)
''OMMP.Func = OutMsgMidi
''OMMP.Mstatus = &H90 'NoteOn, channel 0 (but really a note off)
''OMMP.Mdata = &H3C '003Ch is 0 volume, note 60
''stat = RUCKMIDI(OMMP)
a$ = INPUT$(1)
'do something a little more exciting than that
'(see OutMsgMidi for more on MIDI channel messages in general)
PRINT
PRINT "Playing the same note but applying +/- pitchbend to it."
PRINT
Mstat = &H90 'NoteOn, channel 0
OMMP.Func = OutMsgMidi
OMMP.Mstatus = Mstat
OMMP.Mdata = Mdat 'this is the same note as first played
stat = RUCKMIDI(OMMP)
PRINT " (NoteOn) ";
PRINT "Note:"; (Mdat AND &H7F);
PRINT " Channel:"; (Mstat AND &HF);
PRINT " Volume:"; (Mdat \ &H100)
'using just pitchbend this alters the frequency of the note being played
'for this example where just the single note is sounded, it's best to
'use a program that remains at the sustain level until a NoteOff is sent--
'programs that have EG=1 will do so (a high SL is also desired)
'(see OutMsgMidi for more)
OMMP.Func = OutMsgMidi
OMMP.Mstatus = &HE0 'channel 0 pitchbend (2000h is base)
StepSize = 32 'CPU-speed dependent effect
FOR i = 1 TO 10
FOR pitchbend = &H2000 TO 0 STEP -StepSize
OMMP.Mdata = pitchbend
stat = RUCKMIDI(OMMP)
NEXT
IF LEN(INKEY$) THEN EXIT FOR
FOR pitchbend = 0 TO &H3FFF STEP StepSize
OMMP.Mdata = pitchbend
stat = RUCKMIDI(OMMP)
NEXT
IF LEN(INKEY$) THEN EXIT FOR
FOR pitchbend = &H3FFF TO &H2000 STEP -StepSize
OMMP.Mdata = pitchbend
stat = RUCKMIDI(OMMP)
NEXT
IF LEN(INKEY$) THEN EXIT FOR
NEXT
OMMP.Func = OutMsgMidi
OMMP.Mstatus = &H80 'NoteOff, channel 0
OMMP.Mdata = 0 'any data will do
stat = RUCKMIDI(OMMP) 'should always have a NoteOff for each NoteOn
IF INSTR(COMMAND$, "/X") THEN CLS : PRINT "-1 to end": GOTO TestAgain
ELSE
PRINT "InitDevice failed, stat:"; stat
END IF
TestEnd:
'shut down RUCKMIDI and end program
XMP.Func = ExitMidi
nix = RUCKMIDI(XMP)
END