home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
QBAS
/
RUKQ10.ZIP
/
X01M71.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-02-15
|
10KB
|
294 lines
REM $INCLUDE: 'RUCKMIDI.BI'
'---------------------------------------
'SEE X01M.BAS FOR QUICKBASIC 4.5 EXAMPLE
'---------------------------------------
'X01M71.BAS - load and play MIDI data file into DOS memory
'
'31-Jan-93 -chh
'C>bc X01M71 /o;
'C>link X01M71,X01M71.EXE,nul,RUCKMIDI.LIB;
Version$ = " [930131]"
DEFINT A-Z
DIM SMIP AS SysInfoMidiPackTYPE
DIM MIMP AS mInitMidiPackTYPE 'can't use IMP (as var) in BASIC
DIM LMP(1 TO 32) AS LoadMidiPackTYPE '1 for each concurrent MIDI load
DIM SMP AS SetMidiPackTYPE
DIM PBMP AS PlaybackMidiPackTYPE
DIM DMP AS DeallocMidiPackTYPE
DIM XMP AS XitMidiPackTYPE
DIM SFMPP AS SetFMProPackTYPE
DIM filename$(1 TO 32)
DIM bm&(0 TO 15)
bm&(0) = 1: bm&(1) = 2: bm&(2) = 4: bm&(3) = 8
bm&(4) = 16: bm&(5) = 32: bm&(6) = 64: bm&(7) = 128
bm&(8) = 256: bm&(9) = 512: bm&(10) = 1024: bm&(11) = 2048
bm&(12) = 4096: bm&(13) = 8192: bm&(14) = 16384: bm&(15) = 32768
CLS
InIDE = -1 'since the IDE needs more than 2K available, use this to
'flag if operating in QB's ennvironment
'RUCKMIDI uses memory from the operating system pool
'since BASIC starts up claiming all memory, instruct it to return excess
'memory back to OS pool
nix& = SETMEM(700000) 'return to QB environment any previous release
nix& = SETMEM(0) 'see how much is available
nix& = nix& - 2100 'release all but 2K to operating system
'though we only need enough to store the MIDI
'data itself (64K limit per file, 32 files max)
IF InIDE THEN
nix& = nix& - 66000 'leave 64K more for IDE
XMP.Func = ExitMidi 'and shut down any loose ends
nix = RUCKMIDI(XMP)
END IF
nix& = SETMEM(-nix&) 'this call does the actual release
'initialize device and register ExitMidi via AtExitMidi
'Be aware that, depending on devID, the channel mask (MIMP.ChMask)
'turns off selected channels. Unless you have need, MIMP.ChMask should
'be all enabled for all ROL-converted files and also most (std) CMF files.
'In this program, setting devID=0 sets the ChMask so all AdLib voices are on.
devID = 1 '1=AdLib in percussive mode (0=non-percussive)
'ROL-converted files reset this as needed, MT-32
'and GM MIDI files should use devID = 1
'CMF files vary without a clue as to which to use but
'by trial-and-error (most CMFs seem to be melodic,
'i.e., devID=0).
IF INSTR(UCASE$(COMMAND$), "/D0") THEN devID = 0
MIMP.Func = InitMidi
MIMP.DeviceID = devID 'devID=0 has 9 melodic voices
MIMP.IOport = &H388 'devID=1 (percussive) has 6 melodic and 5 perc voices
'AdLib percussive channel number and channel mask
IF devID = 1 THEN 'FEDC BA98 7654 3210 <-channel number
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
ELSE
MIMP.ChMask = &H1FF '0000 0001 1111 1111 <-channel mask(1=play,0=ignore)
MIMP.PercCh = 0 'setting PercCh=0 disables percussive mapping
END IF '(devID=0 has no real percussive voices available)
MIMP.Flags = 0
stat = RUCKMIDI(MIMP)
IF stat = 0 THEN
'register ExitMidi and notify if failure occured, non-fatal and unlikely
XMP.Func = AtExitMidi
stat2 = RUCKMIDI(XMP)
IF stat2 THEN INPUT "AtExitMidi failed, press ENTER to continue", a$
'Note: There is no SBPRO detection procedure built into RUCKUS-MIDI since
'it would be of little use currently (not until OPL-3 support is added).
'For Sound Blaster PRO detection use the SysInfoDac routine in RUCKUS-DAC.
'In any case, it's very unlikely that anything bad would come out of using
'the SetAllFMSBP routine even with no SB PRO at port 220h. We set it here
'because the default is half-volume, which really is too low for most uses.
'set SBPRO FM & master L&R volumes to maximum and steering to none
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 "X01M71.BAS - RUCKUS-MIDI play of MIDI file example."; Version$
IF INSTR(UCASE$(COMMAND$), "/GM") THEN
PRINT "Using General MIDI patch map."
ELSE
PRINT "Using MT-32 patch map."
PRINT "--Use /GM switch if playing General MIDI files."
END IF
PRINT "Device ID is ";
IF INSTR(UCASE$(COMMAND$), "/D0") THEN
PRINT "0 (AdLib non-percussive, MIDI channels 0-8)."
ELSE
PRINT "1 (AdLib percussive, MIDI channels 0-5 &"; MIMP.PercCh; "(5-voice percussive))."
PRINT "--Use /D0 switch to select 9-voice AdLib melodic mode."
END IF
IF stat = 0 THEN
'The following load and play example source is coded inline here
'to simplify readability -- but it's so easy to add things I just
'kept adding stuff, so take it slow if you don't follow at first
'load file(s) into memory and display stat of each MIDI file load
PRINT
INPUT "Number of files to load and play (1-32) ", fcnt
FOR i = 1 TO fcnt
PRINT "File"; i; ": ";
INPUT ; "", filename$(i)
filename$(i) = filename$(i) + CHR$(0) 'DOS requires ASCIIZ name
LMP(i).Func = LoadMidi
'LMP(i).FilenamePtrOff = SADD(filename$(i)) 'QB format
'LMP(i).FilenamePtrSeg = VARSEG(filename$(i))
LMP(i).FilenamePtrOff = SADD(filename$(i)) 'BASIC7 format
LMP(i).FilenamePtrSeg = SSEG(filename$(i))
LMP(i).StartPos = 0& 'start load at byte 0 of filename$
LMP(i).LoadSize = 0& 'load entire file
PRINT " - loaded at ";
stat = RUCKMIDI(LMP(i))
IF stat = 0 THEN
PRINT RIGHT$("000" + HEX$(LMP(i).LoadPtrSeg), 4) + ":" + RIGHT$("000" + HEX$(LMP(i).LoadPtrOff), 4);
DEF SEG = MIMP.InfoPtrSeg
bp = MIMP.InfoPtrOff
usedK = 256 * PEEK(bp + 11) + PEEK(bp + 10)
PRINT " for"; usedK; "KB"
DEF SEG
loadcnt = loadcnt + 1
ELSE
PRINT "*LOAD FAILED* error"; stat
filename$(i) = "" 'clear filename$ to know not to play it latter
END IF
NEXT
'if at least 1 file loaded okay...
IF loadcnt THEN
'display memory stats
PRINT
DEF SEG = MIMP.InfoPtrSeg
bp = MIMP.InfoPtrOff
DOSleftK = 256 * PEEK(bp + 9) + PEEK(bp + 8)
DEF SEG
PRINT DOSleftK; "KB available (not including"; FRE(-1) \ 1024; "KB available to BASIC)"
PRINT " ChMask: FEDCBA9876543210 <- MIDI channels (|=enabled, P=mapped percussive)"
PRINT " ";
FOR i = 15 TO 0 STEP -1
IF (MIMP.ChMask AND bm&(i)) THEN
IF MIMP.PercCh = i AND (i <> 0) THEN PRINT "P"; ELSE PRINT "|";
ELSE
PRINT " ";
END IF
NEXT
PRINT " <- channel mask as set in InitMIDI."
PRINT
'use MT-32 map unless /GM on command line
IF INSTR(UCASE$(COMMAND$), "/GM") THEN
SMP.PatchMapID = 0 'GM L1 map
ELSE
SMP.PatchMapID = 1 'MT-32 map
END IF
SMP.Func = SetPatchMidi
SMP.PatchMapPtrOff = 0 'PatchMapPtr not used unless PatchMapID=-1
SMP.PatchMapPtrSeg = 0 'so assigning these to 0 is extra-credit
stat = RUCKMIDI(SMP)
'MIDI data is loaded into DOS memory ready for play
'...if filename$ not null, play each in order of load
FOR i = 1 TO fcnt
IF LEN(filename$(i)) THEN
PBMP.Func = PlayMidi
PBMP.Mode = 1
PBMP.LoadPtrOff = LMP(i).LoadPtrOff
PBMP.LoadPtrSeg = LMP(i).LoadPtrSeg
stat = RUCKMIDI(PBMP)
'if play started okay then...
IF stat = 0 THEN
PRINT "Playing "; filename$(i);
'playing in the background, wait until done or key pressed.
'To check if data done playing, read directly into MIDI data
'segment and check to word at offset +10. Checking just the
'byte will do.
DEF SEG = MIMP.InfoPtrSeg
bp = MIMP.InfoPtrOff
PRINT " Current tick: ";
CurrRow = CSRLIN
CurrCol = POS(0)
DO
MidiIsDone = PEEK(bp + 6)
'do something to demonstate playback is a background operation
'here we just get the current tick count
b0 = PEEK(bp + 22)
b1 = PEEK(bp + 23)
b2 = PEEK(bp + 24)
b3 = PEEK(bp + 25)
tc& = (16777216 * b3) + (65536 * b2) + (256& * b1) + b0
LOCATE CurrRow, CurrCol
PRINT RIGHT$("000000" + HEX$(tc&), 7)
LOOP UNTIL (MidiIsDone <> 0) OR LEN(INKEY$)
DEF SEG
'end play of this MIDI file
XMP.Func = EndMidi
stat = RUCKMIDI(XMP)
ELSE
PRINT filename$(i); " failed to play, stat:"; stat
END IF
END IF
NEXT
ELSE
PRINT "Nothing to play"
END IF
ELSE
PRINT "InitDevice failed, stat:"; stat
END IF
'release memory used by Loads
'ExitMidi would do that automatically but here we do it manually
FOR i = 1 TO fcnt
IF LEN(filename$(i)) THEN
DMP.Func = DeallocMidi
DMP.HandSeg = LMP(i).LoadPtrSeg
DMP.TypeFlag = 0
stat = RUCKMIDI(DMP)
END IF
NEXT
'shut down RUCKMIDI and end program
XMP.Func = ExitMidi
nix = RUCKMIDI(XMP)
PRINT
PRINT "Done, stat:"; stat
nix& = SETMEM(700000) 'return to QB environment any previous release
END