QMIDI module
A premade module for QMIDI
This module has been made by TurboFX(?) for QMIDI so you can just include the module, put the nessecary code at the start of your program, then you can play midi music.

The following code is a qmidi4.1 module with basic functions ripped from the basfile that comes with it.. You can add other functions to it as well
I created a initmidi sub wich does the initialising on some module internal variables.. (it's a bit OOP like)


So you load the sbmidi drivers

you put this module to your basfile

You init your blaster with initmidi

You load a midi file

You play it... And you have midi playing

It's very easy to use.

To load the module, create a batch file, in it put these lines

sbmidi /e/3
c:\(your path to qbasic)\qb /L (any libraries you have) [/ah]
sbmidi /u


Heres the module
'$INCLUDE: 'tdmidi.bi'



SUB DetectSettings(?) (BasePort%, IRQ%, LoDMA(?)%, HiDMA(?)%, CardType(?)%, MPU401%)

'Reset all of the variables
BasePort(?)% = 0
IRQ% = 0
LoDMA(?)% = 0
HiDMA(?)% = 0
CardType(?)% = 0
MPU401% = 0

'Read the BLASTER environment variable
Settings$ = ENVIRON$("BLASTER")

'Attempt to extract the base port, High DMA, Low DMA, IRQ, and card type
'from the BLASTER enironment variable.
FOR I% = 1 TO LEN(Settings$) - 1
'If the type of sound card was found, get it and exit the loop.
SELECT CASE UCASE$(MID$(Settings$, I%, 1))
'If the card type was found...
CASE "T"
CardType(?)% = VAL(MID$(Settings$, I% + 1, 1))
'If the base port address was found...
CASE "A"
BasePort(?)% = VAL("&H" + LTRIM$(STR$(VAL(MID$(Settings$, I% + 1, 3)))))
'If the IRQ was found...
CASE "I"
IRQ% = VAL(MID$(Settings$, I% + 1, 2))
'If the low DMA channel was found...
CASE "D"
LoDMA(?)% = VAL(MID$(Settings$, I% + 1, 1))
'If the high DMA channel was found...
CASE "H"
HiDMA(?)% = VAL(MID$(Settings$, I% + 1, 1))
'If the MPU401 port was found...
CASE "P"
MPU401% = VAL("&H" + LTRIM$(STR$(VAL(MID$(Settings$, I% + 1, 3)))))
END SELECT
NEXT I%

'If the card type wasn't found in the BLASTER variable, try to figure
'out the type using another method.

IF CardType(?)% = 0 THEN
'Examine the card's DMA channel.
SELECT CASE LoDMA(?)%
'If the DMA is 210h or 230h, the card is an SB1.0/1.5.
CASE &H210, &H230
CardType(?)% = 1
'If the DMA is 250h or 260h, the card is either an SB2CD or a
'Sound Blaster 16. It could also be a Sound Blaster 1.0/1.5,
'but it probably isn't. Actually, it's also unlikely that the card
'is an SB16, but I check for it anyway, because there's an easy way
'to tell if it is - the High DMA channel will be greater than
'0.
'
'On the other hand, there's no way that I know of to
'distinguish an SB 1.0 from an SB 2.0, except by looking at the
'BLASTER environment variable. And since this code is executing
'that method obviously failed.
CASE &H250, &H260
'Examining the High DMA channel will narrow it down.
'If the High DMA is greater than 0, the card is an SB16.
IF HiDMA(?)% THEN
CardType(?)% = 6
'Otherwise, define the card as a Sound Blaster 2.0.
ELSE
CardType(?)% = 3
END IF
'If the DMA channel is any other value....
CASE ELSE
'Check the High DMA channel. If it's a non-zero value,
'we've got an SB16.
IF HiDMA(?)% THEN
CardType(?)% = 6
'Otherwise....
ELSE
'If sensitive error checking is on, define the card as
'a Sound Blaster 1.0/1.5.
IF SENSITIVE THEN
CardType(?)% = 1
'Otherwise, assume it's a Sound Blaster Pro.
ELSE
CardType(?)% = 4
END IF
END IF
END SELECT
END IF

'Determine the sound card's mixer chip
SELECT CASE CardType(?)%
'If the card could not be detected....
CASE 0
MIDI.ERROR = 7
'If sensitive error checking is on, disable mixer operations
IF SENSITIVE THEN
MIXER.CHIP = 0
'Otherwise, assume the default mixer chip.
ELSE
MIXER.CHIP = 2
END IF
'If the card is a Sound Blaster 1.0/1.5 or equivalent....
CASE 1
'Return an error.
MIDI.ERROR = 6
'If sensitive error checking is on, disable mixer operations and
'exit.
IF SENSITIVE THEN
MIXER.CHIP = 0
EXIT SUB
'Otherwise, set the earliest mixer chip and continue.
ELSE
MIXER.CHIP = 1
END IF
'If the card is a Sound Blaster 2.0/2.5 or equivalent....
CASE 3
'There are two different kinds of SB 2.0 cards: the regular SB2,
'and the SB2CD. The SB2CD has a mixer chip (the CT1335), whereas
'the SB 2.0 does not. The way to tell them apart is that the
'Sound Blaster 2.0 uses Base Ports 220h and 240h, and the SB2CD
'uses ports 250h and 260h.
'
'Assume the sound card is an SB2CD for now...
MIXER.CHIP = 1
'If the card is defined as an SB 2.0, not an SB 2.0 CD, and
'sensitive error checking is on, disable mixer operations.
IF (BasePort% = &H220 OR BasePort(?)% = &H240) AND SENSITIVE <> 0 THEN
MIXER.CHIP = 0
END IF
MIDI.ERROR = 0
'If the card is a Sound Blaster Pro, assume chip CT1345
CASE 2, 4, 5
MIXER.CHIP = 2
MIDI.ERROR = 0
'If the card is a Sound Blaster 16 or later, assume chip CT1745
CASE IS >= 6
MIXER.CHIP = 3
MIDI.ERROR = 0
END SELECT


END SUB

REM $DYNAMIC
'DriversLoaded - Attempt to detect if sound drivers are loaded
'Open the data file.
SUB DriversLoaded(?) (SBMIDI%, SBSIM%)
FF% = FREEFILE
OPEN "DRIVERS.DAT" FOR BINARY AS #FF%
FileSize(?)& = LOF(FF%)
NoExist(?)% = 0
'If the file is empty, return an error.
IF FileSize(?)& = 0 THEN
CLOSE FF%
KILL "DRIVERS.DAT"
MIDI.ERROR = 1
NoExist(?)% = 1
'If the file is not exactly 1,024 bytes in size, return an error.
ELSEIF FileSize(?)& <> 1024 THEN
CLOSE FF%
MIDI.ERROR = 9
NoExist(?)% = 1
END IF

'If DRIVERS.DAT exists, and is 1 kilobyte in size, read the driver
'data from it.
IF NoExist(?)% = 0 THEN
REDIM DRIVERDATA$(1 TO 5)
FOR I% = 1 TO 4
DRIVERDATA$(I%) = INPUT$(256, #FF%)
NEXT I%
END IF

'Close the data file.
CLOSE #FF%

'Check the interrupt handlers for int 80h-FFh, to see if they are occupied
'by either SBMIDI or SBSIM.
SBMIDI% = 0
SBSIM% = 0
FOR I% = &H80 TO &HFF
'Get the address of the interrupt handler.
InternalGetIntVector(?) I%, Segment&, Offset&
'If the segment returned is 0, that means that the current interrupt
'is not in use.
IF Segment& = 0 THEN GOTO Skip:

'The following code checks for the drivers by looking for the text
'"SBMIDI" and "SBSIM" at certain locations in the driver code.
'If it doesn't work, a different method is used.
IF SBMIDI% = 0 THEN
DEF SEG = Segment& - 17
TEMP$ = ""
FOR J% = 1 TO 6
TEMP$ = TEMP$ + CHR$(PEEK(271 + J%))
NEXT
IF TEMP$ = "SBMIDI" THEN SBMIDI% = I%
END IF
IF SBSIM% = 0 AND Segment& <> 0 THEN
DEF SEG = Segment& - 1
TEMP$ = ""
FOR J% = 1 TO 5
TEMP$ = TEMP$ + CHR$(PEEK(274 + J%))
NEXT
IF TEMP$ = "SBSIM" THEN SBSIM% = I%
END IF

'This is the second detection method. It's more complex than the first
'method, but not really any more accurate.
IF NoExist(?)% = 0 THEN
'Point to the segment of the interrupt handler.
DEF SEG = Segment&
'Read 256 bytes of code from the interrupt handler.
DRIVERDATA$(5) = ""
FOR J% = 0 TO 255
Byte% = PEEK(Offset& + J%)
DRIVERDATA$(5) = DRIVERDATA$(5) + CHR$(Byte%)
NEXT J%
'Check to see if the code matches any of the data from DRIVERS.DAT.
FOR J% = 1 TO 4
MATCH% = 1
FOR k% = 0 TO 255
IF MID$(DRIVERDATA$(J%), k% + 1, 1) <> MID$(DRIVERDATA$(5), k% + 1, 1) THEN
SELECT CASE k%
CASE IS = 14, 15, 113, 114, 235, 236
CASE ELSE
MATCH% = 0
EXIT FOR
END SELECT
END IF
NEXT k%
'If there was a match, find out which driver is using the interrupt.
IF MATCH% THEN
IF J% = 1 THEN SBSIM% = I%
IF J% <> 1 THEN SBMIDI% = I%
END IF
'If both SBMIDI and SBSIM have been found, exit the loop.
IF SBSIM% <> 0 AND SBMIDI% <> 0 THEN EXIT FOR
NEXT J%

'If both SBMIDI and SBSIM have been found, exit the loop.
IF SBSIM% <> 0 AND SBMIDI% <> 0 THEN EXIT FOR
END IF
Skip:
NEXT I%
IF NoExist(?)% = 0 THEN MIDI.ERROR = 0


END SUB

REM $STATIC
SUB initmidi

DriversLoaded(?) SBMIDI.INTERRUPT, SBSIM.INTERRUPT
IF SBMIDI.INTERRUPT = 0 THEN
PRINT "No Music, Driver not loaded.": msc = 0
ELSE
PRINT "Midi driver loaded succesfully": msc = 1
END IF
IF msc > 0 THEN
DetectSettings(?) SB.BASEPORT, SB.IRQ, SB.LODMA, SB.HIDMA, SB.CARDTYPE, SB.MPU401
sc$ = SoundCard(?)$(SB.CARDTYPE)
END IF
PRINT sc$

END SUB

REM $DYNAMIC
SUB InternalGetIntVector(?) (IntNum%, Segment&, Offset&)
QMIDIRegs.AX = IntNum(?)% + 13568
CALL IntX(&H21, QMIDIRegs)
Segment& = QMIDIRegs.ES
Offset& = QMIDIRegs.BX

END SUB

SUB IntX (IntNum AS INTEGER, Regs AS Registers) STATIC
STATIC filenum AS INTEGER, IntOffset(?) AS INTEGER, Loaded AS INTEGER

' use fixed-length string to fix its position in memory
' and so we don't mess up string pool before routine
' gets its pointers from caller

DIM IntCode(?) AS STRING * 200
IF NOT Loaded THEN ' loaded will be 0 first time
RESTORE IntXCodeData(?):

FOR k% = 1 TO 145
READ h%
MID$(IntCode, k%, 1) = CHR$(h%)
NEXT

' determine address of interrupt no. offset in IntCode(?)

IntOffset(?)% = INSTR(IntCode$, CHR$(&HCD) + CHR$(&H21)) + 1
Loaded% = -1
END IF

SELECT CASE IntNum(?)

CASE &H25, &H26, IS > 255 ' ignore these interrupts

CASE ELSE
DEF SEG = VARSEG(IntCode) ' poke interrupt number into
POKE VARPTR(IntCode) * 1& + IntOffset(?) - 1, IntNum(?) ' code block
CALL ABSOLUTE(Regs, VARPTR(IntCode$)) ' call routine
END SELECT


END SUB

FUNCTION LoadMIDI(?)% (Filename$)
LoadMIDI(?)% = -1
'See if an extension was supplied, and if not, add one.
IF INSTR(Filename$, ".") = 0 THEN Filename$ = Filename$ + ".MID"
'Open the file
FF% = FREEFILE
OPEN Filename$ FOR BINARY AS #FF%
FileLen(?)& = LOF(FF%)
CLOSE #FF%
'If the file is empty, delete it and exit now.
IF FileLen(?)& = 0 THEN KILL Filename$: MIDI.ERROR = 1: EXIT FUNCTION
'Make the filename an ASCIIZ string.
Filename$ = Filename$ + CHR$(0)

'Find an empty MIDI handle
NewHandle(?)% = -1
FOR I% = 0 TO 255
IF MEM.SEGMENT(I%) = 0 THEN NewHandle(?)% = I%: EXIT FOR
NEXT I%
'If there are no empty handles, return an error.
IF NewHandle(?)% = -1 THEN MIDI.ERROR = 12: EXIT FUNCTION
'Attempt to allocate a block of conventional memory.
QMIDIRegs.AX = &H4800
QMIDIRegs.BX = (FileLen& \ 16) + 1
CALL IntX(&H21, QMIDIRegs)
'If the block couldn't be allocated, it means there's not enough free
'memory. To fix this, we need to ask BASIC to release some of the memory
'it's using:
IF QMIDIRegs.AX = 7 OR QMIDIRegs.AX = 8 THEN
'Find out how much memory is available, in kilobytes.
LargestBlock(?)& = QMIDIRegs.BX
LargestBlock(?)& = LargestBlock(?)& * 16
'Calculate the amount of memory that BASIC needs to release for us.
MEM.ALLOCATED(NewHandle%) = (FileLen& + 2048) - LargestBlock(?)&
'Attempt to release the memory.
A& = SETMEM(-MEM.ALLOCATED(NewHandle%))
'Try again to allocate a block of memory
QMIDIRegs.AX = &H4800
QMIDIRegs.BX = (FileLen& \ 16) + 1
CALL IntX(&H21, QMIDIRegs)
'If the second attempt was unsuccessful, then there just isn't
'enough memory, and an error needs to be returned.
IF QMIDIRegs.AX = 7 OR QMIDIRegs.AX = 8 THEN
'Give any memory we took back to BASIC.
A& = SETMEM(650000)
'Return an error.
MIDI.ERROR = 2
MEM.SEGMENT(NewHandle%) = 0
'Abort.
EXIT FUNCTION
END IF
END IF
'If the memory was allocated successfully, store the segment
'of the memory block.
MEM.SEGMENT(NewHandle%) = QMIDIRegs.AX
MIDISegment& = QMIDIRegs.AX

'Open the MIDI file using a DOS interrupt.
QMIDIRegs.AX = &H3D00
QMIDIRegs.DX = SADD(Filename$)
QMIDIRegs.DS = VARSEG(Filename$)
CALL IntX(&H21, QMIDIRegs)
'Store the file handle.
Handle% = QMIDIRegs.AX
'Read the data from the file in 16 kilobyte increments.
FOR I& = 1 TO FileLen(?)& STEP 16384
QMIDIRegs.AX = &H3F00
QMIDIRegs.CX = 16384
QMIDIRegs.DX = 0
QMIDIRegs.DS = VAL("&H" + HEX$(MIDISegment&))
QMIDIRegs.BX = Handle%
CALL IntX(&H21, QMIDIRegs)
MIDISegment& = MIDISegment& + 1024
NEXT I&

'Close the file
QMIDIRegs.AX = &H3E00
QMIDIRegs.BX = Handle%
CALL IntX(&H21, QMIDIRegs)

MIDI.ERROR = 0
LoadMIDI(?)% = NewHandle(?)%

END FUNCTION

SUB loopmidi
IF SBMIDI.INTERRUPT < &H80 AND SENSITIVE <> 0 THEN MIDI.ERROR = 4: EXIT SUB
QMIDIRegs.BX = 11
CALL IntX(SBMIDI.INTERRUPT, QMIDIRegs)
IF QMIDIRegs.AX = 0 THEN PlayMIDI(?) CURRENTHANDLE
END SUB

SUB PlayMIDI(?) (Handle%)
IF Handle% < 0 OR Handle% > 255 THEN MIDI.ERROR = 13: EXIT SUB
IF SBMIDI.INTERRUPT < &H80 AND SENSITIVE <> 0 THEN MIDI.ERROR = 4: EXIT SUB
'If sound is not disabled....
IF SOUND.DISABLED = 0 THEN
'Call the SBMIDI driver to begin playing the MIDI file.
QMIDIRegs.BX = 4
QMIDIRegs.DX = MEM.SEGMENT(Handle%)
QMIDIRegs.AX = 0
CALL IntX(SBMIDI.INTERRUPT, QMIDIRegs)
QMIDIRegs.BX = 5
CALL IntX(SBMIDI.INTERRUPT, QMIDIRegs)
'If the music could not be started, return an error.
IF QMIDIRegs.AX <> 0 THEN MIDI.ERROR = 11: EXIT SUB
'Start the MIDI timer.
MIDI.PLAYTIME = TIMER
'Set the current handle.
CURRENTHANDLE = Handle%
END IF
MIDI.ERROR = 0

END SUB

FUNCTION SoundCard(?)$ (CardType%)
SELECT CASE CardType(?)%
CASE 1: SoundCard(?)$ = "Sound Blaster 1.0/1.5"
CASE 2: SoundCard(?)$ = "Sound Blaster Pro"
CASE 3: SoundCard(?)$ = "Sound Blaster 2.0"
CASE 4, 5: SoundCard(?)$ = "Sound Blaster Pro 2"
CASE 6: SoundCard(?)$ = "Sound Blaster 16/32/AWE32/AWE64"
CASE ELSE: SoundCard(?)$ = "Unknown"
END SELECT


END FUNCTION

SUB stopmidi
IF SBMIDI.INTERRUPT < &H80 AND SENSITIVE <> 0 THEN MIDI.ERROR = 4: EXIT SUB
'Call the SBMIDI driver to stop the music.
IF MIDI.PLAYTIME THEN
QMIDIRegs.BX = 4
QMIDIRegs.DX = MEM.SEGMENT(CURRENTHANDLE)
QMIDIRegs.AX = 0
CALL IntX(SBMIDI.INTERRUPT, QMIDIRegs)
MIDI.ERROR = 0
ELSE
MIDI.ERROR = 3
END IF
MIDI.PLAYTIME = 0

END SUB

SUB UnloadMidi(?) (Handle%)
IF Handle% < 0 OR Handle% > 255 THEN MIDI.ERROR = 13: EXIT SUB
'If a block of memory was allocated to hold the MIDI file....
IF MEM.SEGMENT(Handle%) THEN
'Release the block of memory.
QMIDIRegs.ES = MEM.SEGMENT(Handle%)
QMIDIRegs.AX = &H4900
CALL IntX(&H21, QMIDIRegs)
'Give back all the memory we took from BASIC.
A& = SETMEM(650000)
END IF
MEM.SEGMENT(Handle%) = 0
MEM.ALLOCATED(Handle%) = 0
MIDI.ERROR = 0

END SUB



And here's the bi file


DECLARE SUB UnloadMidi(?) (Handle%)
DECLARE SUB stopmidi ()
DECLARE SUB loopmidi ()
DECLARE SUB PlayMIDI(?) (Handle%)
DECLARE FUNCTION LoadMIDI(?)% (Filename$)
DECLARE SUB IntX (IntNum AS INTEGER, Regs AS ANY)
DECLARE FUNCTION SoundCard(?)$ (CardType%)
DECLARE SUB InternalGetIntVector(?) (IntNum%, Segment&, Offset&)
DECLARE SUB DetectSettings(?) (BasePort%, IRQ%, LoDMA(?)%, HiDMA(?)%, CardType(?)%, MPU401%)
DECLARE SUB DriversLoaded(?) (SBMIDI%, SBSIM%)
DECLARE SUB initmidi ()
TYPE Registers
AX AS INTEGER
BX AS INTEGER
CX AS INTEGER
DX AS INTEGER
BP AS INTEGER
SI AS INTEGER
DI AS INTEGER
FLAGS AS INTEGER
DS AS INTEGER
ES AS INTEGER
END TYPE
DIM SHARED QMIDIRegs AS Registers, MEM.SEGMENT(0 TO 255) AS INTEGER
DIM SHARED MIDI.PLAYTIME AS SINGLE, MIDI.ERROR AS INTEGER, PAUSED AS SINGLE
DIM SHARED SBMIDI.INTERRUPT AS INTEGER, MEM.ALLOCATED(0 TO 255) AS LONG
DIM SHARED SBSIM.INTERRUPT AS INTEGER, MIXER.CHIP AS INTEGER
DIM SHARED SB.BASEPORT AS INTEGER, SB.IRQ AS INTEGER
DIM SHARED SB.LODMA AS INTEGER, SB.HIDMA AS INTEGER, SB.CARDTYPE AS INTEGER
DIM SHARED SB.MPU401 AS INTEGER, BIT.STORAGE(0 TO 7) AS INTEGER
DIM SHARED SENSITIVE AS INTEGER, REVERSE.STEREO AS INTEGER
DIM SHARED SOUND.DISABLED AS INTEGER, CURRENTHANDLE AS INTEGER

IntXCodeData(?):
DATA &H55, &H8B, &HEC, &H83, &HEC, &H08, &H56, &H57, &H1E, &H55, &H8B, &H5E
DATA &H06, &H8B, &H47, &H10, &H3D, &HFF, &HFF, &H75, &H04, &H1E, &H8F, &H47
DATA &H10, &H8B, &H47, &H12, &H3D, &HFF, &HFF, &H75, &H04, &H1E, &H8F, &H47
DATA &H12, &H8B, &H47, &H08, &H89, &H46, &HF8, &H8B, &H07, &H8B, &H4F, &H04
DATA &H8B, &H57, &H06, &H8B, &H77, &H0A, &H8B, &H7F, &H0C, &HFF, &H77, &H12
DATA &H07, &HFF, &H77, &H02, &H1E, &H8F, &H46, &HFA, &HFF, &H77, &H10, &H1F
DATA &H8B, &H6E, &HF8, &H5B, &HCD, &H21, &H55, &H8B, &HEC, &H8B, &H6E, &H02
DATA &H89, &H5E, &HFC, &H8B, &H5E, &H06, &H1E, &H8F, &H46, &HFE, &HFF, &H76
DATA &HFA, &H1F, &H89, &H07, &H8B, &H46, &HFC, &H89, &H47, &H02, &H89, &H4F
DATA &H04, &H89, &H57, &H06, &H58, &H89, &H47, &H08, &H89, &H77, &H0A, &H89
DATA &H7F, &H0C, &H9C, &H8F, &H47, &H0E, &H06, &H8F, &H47, &H12, &H8B, &H46
DATA &HFE, &H89, &H47, &H10, &H5A, &H1F, &H5F, &H5E, &H8B, &HE5, &H5D, &HCA
DATA &H02, &H00


For help with this module you can register at the [url=http://qbnz.com/pages/forum]QBNZ forum[/url] to get access to "the wall", and post your questions in the QMIDI module thread.

oracle and TurboFX(?)


QmidiModule - page last edited 2003-11-21 14:16:40 by 203.109.254.49 (home) (edit)
Blast WIKI - by RoboticBoy - edited and tweaked for our evil purposes by Hexadecimal Disaster