Metropoli BBS
VIEWER: x01m71.bas MODE: TEXT (ASCII)
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

[ RETURN TO DIRECTORY ]