Streaming audio

DOS specific questions.
Post Reply
angros47
Posts: 2321
Joined: Jun 21, 2005 19:04

Streaming audio

Post by angros47 »

This routine allow to stream sound data in mono or stereo; it's based on DMA Play for Qbasic, with some changes made by looking in the Allegro source code, to get it working in 32 bit dos.

Code: Select all

#include "dos/dpmi.bi"
#include "dos/dos.bi"
#include "dos/sys/movedata.bi"


DECLARE FUNCTION ResetDSP () as integer
DECLARE FUNCTION DSPVersion () as single
DECLARE FUNCTION DMADone () as integer
DECLARE FUNCTION InitBuffer () as integer
DECLARE SUB WriteDSP (byt as ubyte) 
DECLARE SUB DMAPlay (Offset as long, Length as long)

dim shared DosOffset(1) as integer
Dim shared dos_seg(1) As Integer, dos_sel(1) As Integer

CONST HDSBSIZE= 32768


DIM SHARED AS UINTEGER BasePort, LenPort, DMA, DMA16, DspDataAvail, SB16

Dim shared as integer firsttime, stereo, Freq


FUNCTION DMADone() as integer
	'----------------------------------------------------------------------------
	'                Use to see if a DMA transfer has been completed
	'----------------------------------------------------------------------------
	dim as integer Count, Count2, junk

	Count = INP(LenPort)
	Count2 = INP(LenPort)
	Count = CLNG(Count + 1) * CLNG(Count2 + 1)
	IF (Count - 1) >= &HFFFF THEN junk = INP(DspDataAvail): return -1
END FUNCTION



SUB DMAPlay (Offset as long, Length as long)

	Length = Length - 1
	dim as integer Page = 0
	dim as integer PgPort, AddPort, ModeReg


	SELECT CASE DMA
	CASE 0
		PgPort = &H87
		AddPort = &H0
		LenPort = &H1
		ModeReg = &H48
	CASE 1
		PgPort = &H83
		AddPort = &H2
		LenPort = &H3
		ModeReg = &H49
	CASE 2
		PgPort = &H81
		AddPort = &H4
		LenPort = &H5
		ModeReg = &H4A
	CASE 3
		PgPort = &H82
		AddPort = &H6
		LenPort = &H7
		ModeReg = &H4B
	CASE ELSE
		PRINT "DMA channels 0-3 only are supported."
		EXIT SUB
	END SELECT

	OUT &HA, &H4 + DMA
	OUT &HC, &H0
	OUT &HB, ModeReg
	OUT AddPort, Offset AND &HFF
	OUT AddPort, (Offset AND &HFF00&) \ &H100
	IF (Offset AND 65536) THEN Page = Page + 1
	IF (Offset AND 131072) THEN Page = Page + 2
	IF (Offset AND 262144) THEN Page = Page + 4
	IF (Offset AND 524288) THEN Page = Page + 8
	OUT PgPort, Page
	OUT LenPort, Length AND &HFF
	OUT LenPort, (Length AND &HFF00&) \ &H100
	OUT &HA, DMA

	IF Freq <= 22728 THEN
		WriteDSP &H40
		WriteDSP (256 - 1000000 \ Freq)
		WriteDSP &H14
		WriteDSP (Length AND &HFF)
		WriteDSP ((Length AND &HFFFF&) \ &H100)
	ELSE
		WriteDSP &H40
		WriteDSP (256 - 1000000 \ Freq)
		WriteDSP &H48
		WriteDSP (Length AND &HFF)
		WriteDSP ((Length AND &HFF00&) \ &H100)
		WriteDSP &H91
	END IF
END SUB


SUB DMAPlay16 (Offset as long, Length as long)'(Segment&, offset&, L&, Freq&, StereoWav%, sixteenbit%)
	' Transfers and plays the contents of the buffer.
	' Try only on an SoundBlaster 16 !!
	' 1 page=128K in 16 bit mode
	' DMA16% (16-bit DMA channel) passed implicitly

	Length = Length - 1
	dim as integer Page = 0, Offset2
	dim as integer PgPort, AddPort, ModeReg



	SELECT CASE DMA16
	CASE 4
	   PgPort = &H0
	   AddPort = &HC0
	   LenPort = &HC2
	   ModeReg = &H48: '58h for autoinit/48h for not
	CASE 5
	   PgPort = &H8B
	   AddPort = &HC4
	   LenPort = &HC6
	   ModeReg = &H49
	CASE 6
	   PgPort = &H89
	   AddPort = &HC8
	   LenPort = &HCA
	   ModeReg = &H4A
	CASE 7
	   PgPort= &H8A 'ok
	   AddPort = &HCC 'ok
	   LenPort = &HCE 'ok
	   ModeReg = &H4B 'ok
	CASE ELSE
	   PRINT "16 bit DMA channels 4-7 only!"
	   EXIT SUB
	END SELECT

	page = (Offset \ 131072) * 2
	Offset2 = (Offset - (page * 65536)) \ 2


	OUT &HD8, 0: 'clear flip flop
	OUT &HD6, ModeReg: 'write mode reg
	OUT AddPort, (Offset2 AND &HFF):            'Buffer base offset lo
	OUT AddPort, (Offset2 AND &HFF00&) \ &H100: 'Buffer base offset hi
	OUT PgPort, page:                          'output page of phys. addr of sample block
	OUT LenPort, ((Length \ 2) AND &HFF):                     'DMA count = length of buffer
	OUT LenPort, (((Length \ 2) AND &HFF00) \ &H100):                     'DMA count high byte
	OUT &HD4, DMA16 - 4: 'write single mask (select Channel16)

	WriteDSP &H41: 'set output sampling rate
	WriteDSP (Freq AND &HFF00&) \ &H100
	WriteDSP Freq AND &HFF

	WriteDSP &HB0:  '16 bit DAC, single cycle, FIFO off

	IF Stereo THEN 'subtract 10h for unsigned
		WriteDSP &H30: '30h=Mode byte for 16 bit signed stereo
	ELSE
		WriteDSP &H10: '10h=Mode byte for 16 bit signed mono
	END IF

	WriteDSP ((Length \ 2) AND &HFF)
	WriteDSP (((Length \ 2) AND &HFF00) \ &H100)
END SUB

SUB SpeakerState (OnOff as integer)
	' Turns speaker on or off.
	IF OnOff THEN WriteDSP &HD1 ELSE WriteDSP &HD3
END SUB

SUB SetStereo (OnOff as integer)
		'only needed on SBPro
		stereo=onoff

		OUT Baseport + 4, &HE
		IF OnOff THEN
				OUT Baseport + 5, 2
		ELSE
				OUT Baseport + 5, 0
		END IF
END SUB

FUNCTION ResetDSP as integer
	' Resets the DSP
	OUT BasePort + 6, 1
	dim Junk as integer
	FOR Count as integer = 1 TO 10
		Junk  = INP(BasePort + 6)
	NEXT
	OUT BasePort + 6, 0
	FOR Count as integer = 1 TO 10
		Junk = INP(BasePort + 6)
	NEXT
	IF (INP(BasePort + 14) AND &H80 = &H80) AND (INP(BasePort + 10) = &HAA) THEN
		ResetDSP = -1
	ELSE
		ResetDSP = 0
	END IF

	firsttime=1
END FUNCTION

SUB GetBLASTER
	' This subroutine parses the BLASTER environment string and returns settings.
	IF LEN(ENVIRON$("BLASTER")) = 0 THEN PRINT "BLASTER environment variable not set.": EXIT SUB
	FOR Length as integer = 1 TO LEN(ENVIRON("BLASTER"))
	SELECT CASE MID(ENVIRON("BLASTER"), Length, 1)
	CASE "A"
		BasePort = VAL("&H" + MID(ENVIRON$("BLASTER"), Length + 1, 3))
	CASE "I"
		'IRQ = VAL(MID(ENVIRON("BLASTER"), Length + 1, 1))
	CASE "D"
		DMA = VAL(MID(ENVIRON("BLASTER"), Length + 1, 1))
	CASE "H"
		DMA16 = VAL(MID(ENVIRON("BLASTER"), Length + 1, 1))
	END SELECT
	NEXT
END SUB



FUNCTION InitBuffer as integer

	for I as integer=0 to 1
		dos_seg(i) = __dpmi_allocate_dos_memory((HDSBSIZE*2+15)shr 4, @dos_sel(i))

		If dos_seg(i) = 0 Then return -1
		DosOffset(i)=dos_seg(i) shl 4
		if (DosOffset(i) shr 16) <> ((DosOffset(i) + HDSBSIZE) shr 16) then 
			DosOffset(i) = ((DosOffset(i) + HDSBSIZE) and &Hffffff00)
		end if
	next
	return 0

END FUNCTION


SUB WriteDSP (byt as ubyte)
	' Writes a byte to the DSP
	DO
	LOOP WHILE INP(BasePort + 12) AND &H80
	OUT BasePort + 12, byt
END SUB

FUNCTION ReadDSP as ubyte
	' Reads a byte from the DSP
	DO
	LOOP UNTIL INP(BasePort + 14) AND &H80
	return INP(BasePort + 10)
END FUNCTION

FUNCTION DSPVersion as single
	' Gets the DSP version.
	WriteDSP &HE1
	dim as ubyte byte1, byte2
	byte1=readdsp
	byte2=readdsp

	return VAL(STR(byte1) + "." + STR(byte2))
END FUNCTION




sub playbuffer (soundBuffer as any ptr, buffersize as integer)

	static i as integer

	if BufferSize>HDSBSIZE then playbuffer (soundBuffer, BufferSize-HDSBSIZE):SoundBuffer+=BufferSize-HDSBSIZE: BufferSize=HDSBSIZE


	dosmemput(soundbuffer, buffersize, DosOffset(i))
	do: loop until firsttime orelse dmadone() 
	firsttime=0

	if SB16=0 then
		DMAPlay DosOffset(i) , buffersize
	else
		DMAPlay16 DosOffset(i) , buffersize
	end if

	i=1-i

end sub

sub SoundSet(frequency as integer, channels as integer, bits as integer)
	GetBlaster
	InitBuffer

	DspDataAvail=Baseport + &HE	'8 bit
	DspDataAvail=Baseport + &HF	'16 bit

	IF ResetDSP = 0  THEN 'resets DSP (returns true if successful)
		PRINT "DSP failed to reset, try another port."
		exit sub
	END IF

	if bits=16 then
		if DSPVersion<4 then 
			PRINT "16 bit mode not supported"
			exit sub
		end if
		SB16=1
	else
		sb16=0
	end if

	

	IF DSPVersion <= 2 AND frequency>22728 THEN 
		PRINT "Unsupported rate"
		exit sub
	END IF

	Freq=Frequency

	if channels=2 then 
		SetStereo 1
	else
		SetStereo 0
	end if

	WriteDSP &HD1  'turn the speaker on

	OUT BasePort + 4, &H22    ' set volume
	OUT BasePort + 5, &HDD    ' Left = HI Nibble, Right = LO nibble (0FF is max)
end sub
It can be used like the Windows version:
http://freebasic.net/forum/viewtopic.php?f=6&t=23099

and the linux version
http://freebasic.net/forum/viewtopic.php?f=5&t=23122

One note: it can be used under Windows dos, but Windows will emulate only 8 bit mode, so if you want to use 16 bit mode use DosBox.
angros47
Posts: 2321
Joined: Jun 21, 2005 19:04

Re: Streaming audio

Post by angros47 »

This new version uses interrupts, instead of constant polling, to check when more data can be loaded in the double buffer. As result, it doesn't stop program execution.

Code: Select all

#Include once "crt/string.bi"
#include "dos/dpmi.bi"
#include "dos/dos.bi"
#include "dos/sys/movedata.bi"

'' from djgpp/include/crt0.h
#define _CRT0_FLAG_LOCK_MEMORY &h1000

'' linker "magic"
extern _crt0_startup_flags alias "_crt0_startup_flags" as integer
dim shared _crt0_startup_flags as integer = _
  _CRT0_FLAG_LOCK_MEMORY


type FnIntHandler as function cdecl( byval as uinteger) as integer

declare function fb_isr_set cdecl alias "fb_isr_set"( _
	byval irq_number as uinteger, _
    byval pfnIntHandler as FnIntHandler, _
    byval size as uinteger, _
    byval stack_size as uinteger = 0) as integer

declare function fb_isr_reset cdecl alias "fb_isr_reset"( _
	byval irq_number as uinteger ) as integer

declare function fb_isr_get cdecl alias "fb_isr_get"( _
	byval irq_number as uinteger ) as FnIntHandler



DECLARE FUNCTION ResetDSP () as integer
DECLARE FUNCTION DSPVersion () as single
DECLARE FUNCTION DMADone () as integer
DECLARE FUNCTION InitBuffer () as integer
DECLARE SUB WriteDSP (byt as ubyte) 
DECLARE SUB DMAPlay (Offset as long, Length as long)

dim shared DosOffset(1) as integer
Dim shared dos_seg(1) As Integer, dos_sel(1) As Integer

CONST HDSBSIZE= 32768


DIM SHARED AS UINTEGER BasePort, LenPort, IRQ, DMA, DMA16, DspDataAvail, SB16

Dim shared as integer UsedBuffer, stereo, Freq

type QueueWAVEHDR
	_wavehdr as any ptr
	_size as integer
	_next as QueueWAVEHDR ptr
end type

dim shared as QueueWAVEHDR ptr QueueWaveHdrs, PlayWaveHdrs
dim shared waitingBytes as integer

FUNCTION DMADone() as integer
	'----------------------------------------------------------------------------
	'                Use to see if a DMA transfer has been completed
	'----------------------------------------------------------------------------
	dim as integer Count, Count2, junk

	Count = INP(LenPort)
	Count2 = INP(LenPort)
	Count = CLNG(Count + 1) * CLNG(Count2 + 1)
	IF (Count - 1) >= &HFFFF THEN junk = INP(DspDataAvail): return -1
END FUNCTION



SUB DMAPlay (Offset as long, Length as long)

	Length = Length - 1
	dim as integer Page = 0
	dim as integer PgPort, AddPort, ModeReg


	SELECT CASE DMA
	CASE 0
		PgPort = &H87
		AddPort = &H0
		LenPort = &H1
		ModeReg = &H48
	CASE 1
		PgPort = &H83
		AddPort = &H2
		LenPort = &H3
		ModeReg = &H49
	CASE 2
		PgPort = &H81
		AddPort = &H4
		LenPort = &H5
		ModeReg = &H4A
	CASE 3
		PgPort = &H82
		AddPort = &H6
		LenPort = &H7
		ModeReg = &H4B
	CASE ELSE
		PRINT "DMA channels 0-3 only are supported."
		EXIT SUB
	END SELECT

	OUT &HA, &H4 + DMA
	OUT &HC, &H0
	OUT &HB, ModeReg
	OUT AddPort, Offset AND &HFF
	OUT AddPort, (Offset AND &HFF00&) \ &H100
	IF (Offset AND 65536) THEN Page = Page + 1
	IF (Offset AND 131072) THEN Page = Page + 2
	IF (Offset AND 262144) THEN Page = Page + 4
	IF (Offset AND 524288) THEN Page = Page + 8
	OUT PgPort, Page
	OUT LenPort, Length AND &HFF
	OUT LenPort, (Length AND &HFF00&) \ &H100
	OUT &HA, DMA

	IF Freq <= 22728 THEN
		WriteDSP &H40
		WriteDSP (256 - 1000000 \ Freq)
		WriteDSP &H14
		WriteDSP (Length AND &HFF)
		WriteDSP ((Length AND &HFFFF&) \ &H100)
	ELSE
		WriteDSP &H40
		WriteDSP (256 - 1000000 \ Freq)
		WriteDSP &H48
		WriteDSP (Length AND &HFF)
		WriteDSP ((Length AND &HFF00&) \ &H100)
		WriteDSP &H91
	END IF
END SUB


SUB DMAPlay16 (Offset as long, Length as long)'(Segment&, offset&, L&, Freq&, StereoWav%, sixteenbit%)
	' Transfers and plays the contents of the buffer.
	' Try only on an SoundBlaster 16 !!
	' 1 page=128K in 16 bit mode
	' DMA16% (16-bit DMA channel) passed implicitly

	Length = Length - 1
	dim as integer Page = 0, Offset2
	dim as integer PgPort, AddPort, ModeReg



	SELECT CASE DMA16
	CASE 4
	   PgPort = &H0
	   AddPort = &HC0
	   LenPort = &HC2
	   ModeReg = &H48: '58h for autoinit/48h for not
	CASE 5
	   PgPort = &H8B
	   AddPort = &HC4
	   LenPort = &HC6
	   ModeReg = &H49
	CASE 6
	   PgPort = &H89
	   AddPort = &HC8
	   LenPort = &HCA
	   ModeReg = &H4A
	CASE 7
	   PgPort= &H8A 'ok
	   AddPort = &HCC 'ok
	   LenPort = &HCE 'ok
	   ModeReg = &H4B 'ok
	CASE ELSE
	   PRINT "16 bit DMA channels 4-7 only!"
	   EXIT SUB
	END SELECT

	page = (Offset \ 131072) * 2
	Offset2 = (Offset - (page * 65536)) \ 2


	OUT &HD8, 0: 'clear flip flop
	OUT &HD6, ModeReg: 'write mode reg
	OUT AddPort, (Offset2 AND &HFF):            'Buffer base offset lo
	OUT AddPort, (Offset2 AND &HFF00&) \ &H100: 'Buffer base offset hi
	OUT PgPort, page:                          'output page of phys. addr of sample block
	OUT LenPort, ((Length \ 2) AND &HFF):                     'DMA count = length of buffer
	OUT LenPort, (((Length \ 2) AND &HFF00) \ &H100):                     'DMA count high byte
	OUT &HD4, DMA16 - 4: 'write single mask (select Channel16)

	WriteDSP &H41: 'set output sampling rate
	WriteDSP (Freq AND &HFF00&) \ &H100
	WriteDSP Freq AND &HFF

	WriteDSP &HB0:  '16 bit DAC, single cycle, FIFO off

	IF Stereo THEN 'subtract 10h for unsigned
		WriteDSP &H30: '30h=Mode byte for 16 bit signed stereo
	ELSE
		WriteDSP &H10: '10h=Mode byte for 16 bit signed mono
	END IF

	WriteDSP ((Length \ 2) AND &HFF)
	WriteDSP (((Length \ 2) AND &HFF00) \ &H100)
END SUB

SUB SpeakerState (OnOff as integer)
	' Turns speaker on or off.
	IF OnOff THEN WriteDSP &HD1 ELSE WriteDSP &HD3
END SUB

SUB SetStereo (OnOff as integer)
		'only needed on SBPro
		stereo=onoff

		OUT Baseport + 4, &HE
		IF OnOff THEN
				OUT Baseport + 5, 2
		ELSE
				OUT Baseport + 5, 0
		END IF
END SUB

FUNCTION ResetDSP as integer
	' Resets the DSP
	OUT BasePort + 6, 1
	dim Junk as integer
	FOR Count as integer = 1 TO 10
		Junk  = INP(BasePort + 6)
	NEXT
	OUT BasePort + 6, 0
	FOR Count as integer = 1 TO 10
		Junk = INP(BasePort + 6)
	NEXT
	IF (INP(BasePort + 14) AND &H80 = &H80) AND (INP(BasePort + 10) = &HAA) THEN
		ResetDSP = -1
	ELSE
		ResetDSP = 0
	END IF

END FUNCTION

SUB GetBLASTER
	' This subroutine parses the BLASTER environment string and returns settings.
	IF LEN(ENVIRON$("BLASTER")) = 0 THEN PRINT "BLASTER environment variable not set.": EXIT SUB
	FOR Length as integer = 1 TO LEN(ENVIRON("BLASTER"))
	SELECT CASE MID(ENVIRON("BLASTER"), Length, 1)
	CASE "A"
		BasePort = VAL("&H" + MID(ENVIRON$("BLASTER"), Length + 1, 3))
	CASE "I"
		IRQ = VAL(MID(ENVIRON("BLASTER"), Length + 1, 1))
	CASE "D"
		DMA = VAL(MID(ENVIRON("BLASTER"), Length + 1, 1))
	CASE "H"
		DMA16 = VAL(MID(ENVIRON("BLASTER"), Length + 1, 1))
	END SELECT
	NEXT
END SUB



FUNCTION InitBuffer as integer

	for I as integer=0 to 1
		dos_seg(i) = __dpmi_allocate_dos_memory((HDSBSIZE*2+15)shr 4, @dos_sel(i))

		If dos_seg(i) = 0 Then return -1
		DosOffset(i)=dos_seg(i) shl 4
		if (DosOffset(i) shr 16) <> ((DosOffset(i) + HDSBSIZE) shr 16) then 
			DosOffset(i) = ((DosOffset(i) + HDSBSIZE) and &Hffffff00)
		end if
	next
	return 0

END FUNCTION


SUB WriteDSP (byt as ubyte)
	' Writes a byte to the DSP
	DO
	LOOP WHILE INP(BasePort + 12) AND &H80
	OUT BasePort + 12, byt
END SUB

FUNCTION ReadDSP as ubyte
	' Reads a byte from the DSP
	DO
	LOOP UNTIL INP(BasePort + 14) AND &H80
	return INP(BasePort + 10)
END FUNCTION

FUNCTION DSPVersion as single
	' Gets the DSP version.
	WriteDSP &HE1
	dim as ubyte byte1, byte2
	byte1=readdsp
	byte2=readdsp

	return VAL(STR(byte1) + "." + STR(byte2))
END FUNCTION


private function isr_dsp_callback cdecl( byval irq_number as uinteger) as integer
	dim p as QueueWAVEHDR ptr=PlayWaveHdrs

	OUT &H20,&H20

	if PlayWaveHdrs->_next<>0 then 
		UsedBuffer=1-UsedBuffer
		dosmemput(PlayWaveHdrs->_next->_wavehdr, PlayWaveHdrs->_next->_size, DosOffset(UsedBuffer))
	end if


	PlayWaveHdrs=PlayWaveHdrs->_next
	if PlayWaveHdrs<>0 then 
		if SB16=0 then
			DMAPlay DosOffset(UsedBuffer) , PlayWaveHdrs->_size
		else
			DMAPlay16 DosOffset(UsedBuffer) , PlayWaveHdrs->_size
		end if
	end if

	deallocate(p->_wavehdr)

	if p=QueueWaveHdrs then QueueWaveHdrs=0

	delete p


	return 0
end function
private sub isr_dsp_end cdecl()
end sub




sub playbuffer (soundBuffer as any ptr, buffersize as integer)


	if BufferSize>HDSBSIZE then playbuffer (soundBuffer, BufferSize-HDSBSIZE):SoundBuffer+=BufferSize-HDSBSIZE: BufferSize=HDSBSIZE

	dim p as QueueWAVEHDR ptr=new QueueWAVEHDR
	p->_wavehdr=allocate(buffersize)
	p->_size=buffersize
	p->_next=0

	memcpy(p->_wavehdr, SoundBuffer, buffersize)

	if QueueWaveHdrs<>0 then 
		if PlayWaveHdrs->_next=0 then 
			UsedBuffer=1-UsedBuffer
			dosmemput(p->_wavehdr, p->_size, DosOffset(UsedBuffer))
		end if
		QueueWaveHdrs->_next=p
	else
		UsedBuffer=1-UsedBuffer
		dosmemput(soundbuffer, buffersize, DosOffset(UsedBuffer))

		if SB16=0 then
			DMAPlay DosOffset(UsedBuffer) , buffersize
		else
			DMAPlay16 DosOffset(UsedBuffer) , buffersize
		end if

		PlayWaveHdrs=p
	end if

	QueueWaveHdrs=p



end sub

sub SoundSet(frequency as integer, channels as integer, bits as integer)
	GetBlaster
	InitBuffer

	IF ResetDSP = 0  THEN 'resets DSP (returns true if successful)
		PRINT "DSP failed to reset, try another port."
		exit sub
	END IF

	if bits=16 then
		if DSPVersion<4 then 
			PRINT "16 bit mode not supported"
			exit sub
		end if
		SB16=1
		DspDataAvail=Baseport + &HF	'16 bit
	else
		sb16=0
		DspDataAvail=Baseport + &HE	'8 bit
	end if

	

	IF DSPVersion <= 2 AND frequency>22728 THEN 
		PRINT "Unsupported rate"
		exit sub
	END IF

	dim mask as ubyte	'Unmasks the interrupt, to enable it
	if IRQ<8 then
		mask=INP(&H21)
		mask=mask and not (1 shl IRQ)
		OUT &H21,mask
	else
		mask=INP(&HA1)
		mask=mask and not (1 shl (IRQ-8))
		OUT &HA1,mask
	end if

	dim as byte ptr ptr_end = cast( byte ptr, @isr_dsp_end )
	dim as byte ptr ptr_start = cast( byte ptr, @isr_dsp_callback)
	if 0 = fb_isr_set( IRQ, @isr_dsp_callback, ptr_end - ptr_start, 16384 ) then
	    print "Failed to lock ISR"
	    end 1
	end if

	Freq=Frequency

	if channels=2 then 
		SetStereo 1
	else
		SetStereo 0
	end if

	WriteDSP &HD1  'turn the speaker on

	OUT BasePort + 4, &H22    ' set volume
	OUT BasePort + 5, &HDD    ' Left = HI Nibble, Right = LO nibble (0FF is max)
end sub

Post Reply