home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / msdos / basic / rukq10 / x01m.bas < prev    next >
Encoding:
BASIC Source File  |  1993-02-15  |  10.0 KB  |  294 lines
  1.  
  2. REM $INCLUDE: 'RUCKMIDI.BI'
  3.  
  4. '---------------------------------------
  5. 'SEE X01M71.BAS FOR BASIC7/VBDOS EXAMPLE
  6. '---------------------------------------
  7.  
  8. 'X01M.BAS - load and play MIDI data file into DOS memory
  9. '
  10. '31-Jan-93 -chh
  11. 'C>bc X01M /o;
  12. 'C>link X01M,X01M.EXE,nul,RUCKMIDI.LIB;
  13. Version$ = " [930131]"
  14.  
  15. DEFINT A-Z
  16.  
  17. DIM SMIP AS SysInfoMidiPackTYPE
  18. DIM MIMP AS mInitMidiPackTYPE           'can't use IMP (as var) in BASIC
  19. DIM LMP(1 TO 32) AS LoadMidiPackTYPE    '1 for each concurrent MIDI load
  20. DIM SMP AS SetMidiPackTYPE
  21. DIM PBMP AS PlaybackMidiPackTYPE
  22. DIM DMP AS DeallocMidiPackTYPE
  23. DIM XMP AS XitMidiPackTYPE
  24. DIM SFMPP AS SetFMProPackTYPE
  25.  
  26. DIM filename$(1 TO 32)
  27.  
  28. DIM bm&(0 TO 15)
  29. bm&(0) = 1: bm&(1) = 2: bm&(2) = 4: bm&(3) = 8
  30. bm&(4) = 16: bm&(5) = 32: bm&(6) = 64: bm&(7) = 128
  31. bm&(8) = 256: bm&(9) = 512: bm&(10) = 1024: bm&(11) = 2048
  32. bm&(12) = 4096: bm&(13) = 8192: bm&(14) = 16384: bm&(15) = 32768
  33.  
  34. CLS
  35.  
  36. InIDE = -1     'since the IDE needs more than 2K available, use this to
  37.                'flag if operating in QB's ennvironment
  38.  
  39. 'RUCKMIDI uses memory from the operating system pool
  40. 'since BASIC starts up claiming all memory, instruct it to return excess
  41. 'memory back to OS pool
  42.  
  43. nix& = SETMEM(700000)    'return to QB environment any previous release
  44. nix& = SETMEM(0)         'see how much is available
  45. nix& = nix& - 2100       'release all but 2K to operating system
  46.                          'though we only need enough to store the MIDI
  47.                          'data itself (64K limit per file, 32 files max)
  48. IF InIDE THEN
  49.    nix& = nix& - 66000          'leave 64K more for IDE
  50.    XMP.Func = ExitMidi          'and shut down any loose ends
  51.    nix = RUCKMIDI(XMP)
  52. END IF
  53.  
  54. nix& = SETMEM(-nix&)            'this call does the actual release
  55.  
  56. 'initialize device and register ExitMidi via AtExitMidi
  57. 'Be aware that, depending on devID, the channel mask (MIMP.ChMask)
  58. 'turns off selected channels. Unless you have need, MIMP.ChMask should
  59. 'be all enabled for all ROL-converted files and also most (std) CMF files.
  60. 'In this program, setting devID=0 sets the ChMask so all AdLib voices are on.
  61.  
  62. devID = 1               '1=AdLib in percussive mode (0=non-percussive)
  63.                         'ROL-converted files reset this as needed, MT-32
  64.                         'and GM MIDI files should use devID = 1
  65.                         'CMF files vary without a clue as to which to use but
  66.                         'by trial-and-error (most CMFs seem to be melodic,
  67.                         'i.e., devID=0).
  68. IF INSTR(UCASE$(COMMAND$), "/D0") THEN devID = 0
  69.  
  70. MIMP.Func = InitMidi
  71. MIMP.DeviceID = devID    'devID=0 has 9 melodic voices
  72. MIMP.IOport = &H388      'devID=1 (percussive) has 6 melodic and 5 perc voices
  73.  
  74.                          'AdLib percussive channel number and channel mask
  75. IF devID = 1 THEN        'FEDC BA98 7654 3210 <-channel number
  76.    MIMP.ChMask = &H23F   '0000 0010 0011 1111 <-channel mask(1=play,0=ignore)
  77.    MIMP.PercCh = 9       'MIDI ch9 (0-based) is mapped to the 5 AdLib percs
  78. ELSE
  79.    MIMP.ChMask = &H1FF   '0000 0001 1111 1111 <-channel mask(1=play,0=ignore)
  80.    MIMP.PercCh = 0       'setting PercCh=0 disables percussive mapping
  81. END IF                   '(devID=0 has no real percussive voices available)
  82.  
  83. MIMP.Flags = 0
  84. stat = RUCKMIDI(MIMP)
  85.  
  86. IF stat = 0 THEN
  87.  
  88.    'register ExitMidi and notify if failure occured, non-fatal and unlikely
  89.  
  90.    XMP.Func = AtExitMidi
  91.    stat2 = RUCKMIDI(XMP)
  92.    IF stat2 THEN INPUT "AtExitMidi failed, press ENTER to continue", a$
  93.  
  94. 'Note: There is no SBPRO detection procedure built into RUCKUS-MIDI since
  95. 'it would be of little use currently (not until OPL-3 support is added).
  96. 'For Sound Blaster PRO detection use the SysInfoDac routine in RUCKUS-DAC.
  97. 'In any case, it's very unlikely that anything bad would come out of using
  98. 'the SetAllFMSBP routine even with no SB PRO at port 220h. We set it here
  99. 'because the default is half-volume, which really is too low for most uses.
  100.  
  101.    'set SBPRO FM & master L&R volumes to maximum and steering to none
  102.  
  103.    SBPROport = &H220            'SBPRO is currently 220h or 240h only
  104.    SFMPP.Func = SetAllFMSBP
  105.    SFMPP.IOport = SBPROport
  106.    SFMPP.MasterVol = &HF0F      'low=right ch, high=left, -1 no change
  107.    SFMPP.Steer = 0              '0=none,1=left,2=right,3=*MUTE*,-1 no change
  108.    SFMPP.FMvol = &HF0F          'low=right ch, high=left ch, cannot skip
  109.    stat2 = RUCKMIDI(SFMPP)      'currently always succeeds
  110.  
  111. END IF
  112.  
  113. LOCATE 5
  114. PRINT "X01M.BAS - RUCKUS-MIDI play of MIDI file example."; Version$
  115.  
  116. IF INSTR(UCASE$(COMMAND$), "/MT") THEN
  117.    PRINT "Using MT-32 patch map."
  118. ELSE
  119.    PRINT "Using General MIDI patch map."
  120.    PRINT "--Use /MT switch if playing MT-32 sequenced files."
  121. END IF
  122.  
  123. PRINT "Device ID is ";
  124. IF INSTR(UCASE$(COMMAND$), "/D0") THEN
  125.    PRINT "0 (AdLib non-percussive, MIDI channels 0-8)."
  126. ELSE
  127.    PRINT "1 (AdLib percussive, MIDI channels 0-5 &"; MIMP.PercCh; "(5-voice percussive))."
  128.    PRINT "--Use /D0 switch to select 9-voice AdLib melodic mode."
  129. END IF
  130.  
  131. IF stat = 0 THEN
  132.    
  133.    'The following load and play example source is coded inline here
  134.    'to simplify readability -- but it's so easy to add things I just
  135.    'kept adding stuff, so take it slow if you don't follow at first
  136.  
  137.    'load file(s) into memory and display stat of each MIDI file load
  138.  
  139.    PRINT
  140.    INPUT "Number of files to load and play (1-32) ", fcnt
  141.    FOR i = 1 TO fcnt
  142.       PRINT "File"; i; ": ";
  143.       INPUT ; "", filename$(i)
  144.       filename$(i) = filename$(i) + CHR$(0)   'DOS requires ASCIIZ name
  145.       LMP(i).Func = LoadMidi
  146.  
  147.       LMP(i).FilenamePtrOff = SADD(filename$(i))   'QB format
  148.       LMP(i).FilenamePtrSeg = VARSEG(filename$(i))
  149.       'LMP(i).FilenamePtrOff = SADD(filename$(i))    'BASIC7 format
  150.       'LMP(i).FilenamePtrSeg = SSEG(filename$(i))
  151.  
  152.       LMP(i).StartPos = 0&     'start load at byte 0 of filename$
  153.       LMP(i).LoadSize = 0&     'load entire file
  154.       PRINT " - loaded at ";
  155.       stat = RUCKMIDI(LMP(i))
  156.       IF stat = 0 THEN
  157.          PRINT RIGHT$("000" + HEX$(LMP(i).LoadPtrSeg), 4) + ":" + RIGHT$("000" + HEX$(LMP(i).LoadPtrOff), 4);
  158.          DEF SEG = MIMP.InfoPtrSeg
  159.          bp = MIMP.InfoPtrOff
  160.          usedK = 256 * PEEK(bp + 11) + PEEK(bp + 10)
  161.          PRINT " for"; usedK; "KB"
  162.          DEF SEG
  163.          loadcnt = loadcnt + 1
  164.       ELSE
  165.          PRINT "*LOAD FAILED* error"; stat
  166.          filename$(i) = ""      'clear filename$ to know not to play it latter
  167.       END IF
  168.    NEXT
  169.  
  170.    'if at least 1 file loaded okay...
  171.  
  172.    IF loadcnt THEN
  173.    
  174.       'display memory stats
  175.  
  176.       PRINT
  177.       DEF SEG = MIMP.InfoPtrSeg
  178.       bp = MIMP.InfoPtrOff
  179.       DOSleftK = 256 * PEEK(bp + 9) + PEEK(bp + 8)
  180.       DEF SEG
  181.       PRINT DOSleftK; "KB available (not including"; FRE(-1) \ 1024; "KB available to BASIC)"
  182.       PRINT " ChMask: FEDCBA9876543210 <- MIDI channels (|=enabled, P=mapped percussive)"
  183.       PRINT "         ";
  184.       FOR i = 15 TO 0 STEP -1
  185.          IF (MIMP.ChMask AND bm&(i)) THEN
  186.             IF MIMP.PercCh = i AND (i <> 0) THEN PRINT "P";  ELSE PRINT "|";
  187.          ELSE
  188.             PRINT " ";
  189.          END IF
  190.       NEXT
  191.       PRINT " <- channel mask as set in InitMIDI."
  192.       PRINT
  193.  
  194.       'use GM map unless /MT on command line
  195.  
  196.       IF INSTR(UCASE$(COMMAND$), "/MT") THEN
  197.          SMP.PatchMapID = 1     'MT-32 map
  198.       ELSE
  199.          SMP.PatchMapID = 0     'GM L1 map
  200.       END IF
  201.  
  202.       SMP.Func = SetPatchMidi
  203.       SMP.PatchMapPtrOff = 0    'PatchMapPtr not used unless PatchMapID=-1
  204.       SMP.PatchMapPtrSeg = 0    'so assigning these to 0 is extra-credit
  205.       stat = RUCKMIDI(SMP)
  206.  
  207.       'MIDI data is loaded into DOS memory ready for play
  208.       '...if filename$ not null, play each in order of load
  209.  
  210.       FOR i = 1 TO fcnt
  211.          IF LEN(filename$(i)) THEN
  212.  
  213.             PBMP.Func = PlayMidi
  214.             PBMP.Mode = 1
  215.             PBMP.LoadPtrOff = LMP(i).LoadPtrOff
  216.             PBMP.LoadPtrSeg = LMP(i).LoadPtrSeg
  217.             stat = RUCKMIDI(PBMP)
  218.  
  219.             'if play started okay then...
  220.  
  221.             IF stat = 0 THEN
  222.  
  223.                PRINT "Playing "; filename$(i);
  224.  
  225.                'playing in the background, wait until done or key pressed.
  226.                'To check if data done playing, read directly into MIDI data
  227.                'segment and check to word at offset +10. Checking just the
  228.                'byte will do.
  229.  
  230.                DEF SEG = MIMP.InfoPtrSeg
  231.                bp = MIMP.InfoPtrOff
  232.  
  233.                PRINT "  Current tick: ";
  234.                CurrRow = CSRLIN
  235.                CurrCol = POS(0)
  236.  
  237.                DO
  238.                   MidiIsDone = PEEK(bp + 6)
  239.  
  240.                   'do something to demonstate playback is a background operation
  241.                   'here we just get the current tick count
  242.  
  243.                   b0 = PEEK(bp + 22)
  244.                   b1 = PEEK(bp + 23)
  245.                   b2 = PEEK(bp + 24)
  246.                   b3 = PEEK(bp + 25)
  247.                   tc& = (16777216 * b3) + (65536 * b2) + (256& * b1) + b0
  248.  
  249.                   LOCATE CurrRow, CurrCol
  250.  
  251.                   PRINT RIGHT$("000000" + HEX$(tc&), 7)
  252.  
  253.                LOOP UNTIL (MidiIsDone <> 0) OR LEN(INKEY$)
  254.                DEF SEG
  255.  
  256.                'end play of this MIDI file
  257.  
  258.                XMP.Func = EndMidi
  259.                stat = RUCKMIDI(XMP)
  260.             ELSE
  261.                PRINT filename$(i); " failed to play, stat:"; stat
  262.             END IF
  263.          END IF
  264.       NEXT
  265.  
  266.    ELSE
  267.       PRINT "Nothing to play"
  268.    END IF
  269. ELSE
  270.    PRINT "InitDevice failed, stat:"; stat
  271. END IF
  272.  
  273. 'release memory used by Loads
  274. 'ExitMidi would do that automatically but here we do it manually
  275.  
  276. FOR i = 1 TO fcnt
  277.    IF LEN(filename$(i)) THEN
  278.       DMP.Func = DeallocMidi
  279.       DMP.HandSeg = LMP(i).LoadPtrSeg
  280.       DMP.TypeFlag = 0
  281.       stat = RUCKMIDI(DMP)
  282.    END IF
  283. NEXT
  284.  
  285. 'shut down RUCKMIDI and end program
  286.  
  287. XMP.Func = ExitMidi
  288. nix = RUCKMIDI(XMP)
  289. PRINT
  290. PRINT "Done, stat:"; stat
  291. nix& = SETMEM(700000)   'return to QB environment any previous release
  292. END
  293.  
  294.