'=========================================================================== ' Subject: WAV PLAYER FOR PB35 Date: 08-09-98 (03:58) ' Author: Don Schullian Code: PB ' Origin: d83@ath.forthnet.gr Packet: SOUND.ABC '=========================================================================== $if 0 旼컴컴컴컴컴컴컴컴컴컴컴컴캠 PowerBASIC v3.50 旼캑 DASoft 픔컴컴컴컴컴컴컴컴컴컴컫컴컴컴컴컴컴컴컴컴� � 쳐컴컴컴컴컴컴컴컴컴컴컴컴캘 Don Schullian � DATE: 1998-01-31 픔� � � FILE NAME WAVPLAYR.BAS � www.DASoftVSS.com 突袴袴袴袴袴袴袴羔 � � � � � � � � 突袴袴袴袴袴袴袴袴袴袴袴袴暠 � � 突佶袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴� � 突袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴� Somewhere around here there should be a list of credits but as I've had to go through several non-functional .WAV players to get enough information to make this thing work I've lost track of all the names. Anyhow, suffice it say that I'm not the originator of this code I'm just the guy that got it all together in one place at one time. The code works for 8 bit mono .WAV files of any length and (seemingly) of any Hz. It has been tested and proved on a Sound Blaster Pro, a Sound Blaster 16, an AWE Gold, and at least one clone. fSBsetup% () This function is called once to get all the variables ready. RETURNS: -1 if all went well 0 if no BLASTER info was found in the ENVIRONMENT and the 'default' setup was used -2 if the whole thing went bust fSBplay% (BYVAL FileSpec$, BYVAL FileNo%) FileSpec$ is the name of the file to be played. if the incoming value is NULL then it is assumed that the file is already opened and the pointer is correctly positioned else the file is opened and closed locally FileNo% is the PB file number to be used. if the incoming value is ZERO then the next unused file number will be assigned. RETURNS: -1 if file was played to completion 0 if the file was NOT a valid .WAV file +n DOS error fSBvolumeGet? (BYVAL Which%) SBvolumeSet (BYVAL Which%,BYVAL Volume?) Which% SEE the list of constants for volume controls Volume% The right and left speaker volume is controlled by the high and low nibble. Lft? = ( Volume? \ &h10 ) Rgt? = ( Volume? AND &h0F ) NOTE: only the master volume is used by this code. $endif '.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.�.� ' � � � � � � � � � � � � � � � � � � � � � � � � � � � � � � � � � � � � � � %Testing = -1 ' set to 0 to make play unstoppable from keybrd %SpeakerOn = &hD1 ' %SpeakerOff = &hD3 ' %VersionCmd = &hE1 ' not used %MstrVolume = &h22 ' %FMvolume = &h26 ' not used %CDvolume = &h28 ' not used %VOCvolume = &h04 ' not used %MICvolume = &h0A ' not used %LINEvolume = &h2E ' not used 'PUBLIC ROUTINES DECLARE FUNCTION fSBplay% (BYVAL FileSpec$, BYVAL FileNo%) DECLARE FUNCTION fSBsetup% () DECLARE FUNCTION fSBvolumeGet? (BYVAL Which%) DECLARE SUB SBvolumeSet (BYVAL Which%,BYVAL Volume?) 'PRIVATE STUFF DECLARE FUNCTION fSBread? () DECLARE FUNCTION fSBdone% (BYVAL Chunk%) DECLARE SUB SBwrite (BYVAL Cmd?) DECLARE SUB SBreset () TYPE WaveHeaderType RiffID AS STRING * 4 ' should be 'RIFF' RiffLength AS LONG ' WaveID AS STRING * 4 ' should be 'WAVE' FmtID AS STRING * 4 ' FmtLength AS LONG ' FMT chunk - common fields FormatTag AS WORD ' format category e.g. 0x0001=PCM Stereo AS WORD ' number of Channels 1=mono 2=stereo Freq AS LONG ' dword - sampling rate e.g. 44100Hz BytesPerSec AS DWORD ' dword - to estimate buffer size Blockalign AS WORD ' buffer size must be int. multiple of this BitsPer AS INTEGER ' either 8 (FALSE) or 16 (TRUE) DataID AS STRING * 4 ' should be 'DATA' DataLen AS DWORD ' END TYPE DIM sWritePort AS SHARED INTEGER DIM sWaitPort AS SHARED INTEGER DIM sReadPort AS SHARED INTEGER DIM sResetPort AS SHARED INTEGER DIM sLenPort AS SHARED INTEGER DIM sPagePort AS SHARED INTEGER DIM sAddrPort AS SHARED INTEGER DIM sVolumePort AS SHARED INTEGER DIM sVolumeData AS SHARED INTEGER DIM sModeReg AS SHARED INTEGER DIM sDRQ AS SHARED INTEGER DIM sDMA AS SHARED INTEGER DIM sDMAmask AS SHARED INTEGER DIM sDMAmode AS SHARED INTEGER DIM sDMAclear AS SHARED INTEGER DIM sDMAstatus AS SHARED INTEGER DIM sDMAterminal AS SHARED INTEGER $if %Testing '------------------------------------------------------------------------- '----------------------- test code --------------------------------------- '------------------------------------------------------------------------- DIM F AS STRING ' just using these 2 for the test DIM X AS INTEGER ' ' CLS ' IF %Testing THEN ' F$ = "\SBPLAY\FANFARE2.WAV" ' ELSE ' F$ = COMMAND$ ' END IF ' ' IF LEN(DIR$(F$)) = 0 THEN ' PRINT "GOTTA GIVE ME A FILE NAME." ' END ' END IF ' ' X% = fSBsetup% ' IF X% = -2 THEN ' this is called once to set PRINT "something went wrong!" ' shared parameters, etc. BEEP ' END ' ELSEif X% = 0 THEN ' no BLASTER in environment PRINT "default setup used" ' END IF ' PRINT "Smack a key to quit." ' ' fSBplay F$, 0 ' fSBplay F$, 0 ' ' END ' end of program '------------------------------------------------------------------------- '----------------------- end of test ------------------------------------- '------------------------------------------------------------------------- $endif FUNCTION fSBsetup () LOCAL PUBLIC AS INTEGER DIM BasePort AS LOCAL INTEGER DIM Blaster AS LOCAL STRING DIM I AS LOCAL INTEGER DIM Ok AS LOCAL INTEGER DIM P AS LOCAL INTEGER BasePort% = &h220 ' default sDMA% = &h001 ' setup Blaster$ = ENVIRON$("BLASTER") IF LEN(Blaster$) > 0 THEN P% = INSTR( Blaster$, "A" ) IF P% > 0 THEN BasePort% = VAL("&h" + MID$(Blaster$, P%+1, 3)) P% = INSTR( Blaster$, "D" ) IF P% > 0 THEN sDMA% = ASC( Blaster$, P%+1 ) - 48 Ok% = 1 END IF SELECT CASE sDMA% CASE 0 : sPagePort% = &h87 sAddrPort% = &h0 sLenPort% = &h1 CASE 1 : sPagePort% = &h83 sAddrPort% = &h2 sLenPort% = &h3 CASE 2 : sPagePort% = &h81 sAddrPort% = &h4 sLenPort% = &h5 CASE 3 : sPagePort% = &h82 sAddrPort% = &h6 sLenPort% = &h7 CASE 4 : sPagePort% = &h8F sAddrPort% = &hC0 sLenPort% = &hC2 CASE 5 : sPagePort% = &h8B sAddrPort% = &hC4 sLenPort% = &hC6 CASE 6 : sPagePort% = &h89 sAddrPort% = &hC8 sLenPort% = &hCA CASE ELSE : FUNCTION = -2 EXIT FUNCTION END SELECT SELECT CASE sDMA% CASE 0 TO 3 : sDMAmask% = &H0A sDMAmode% = &H0B sDMAclear% = &H0C sDMAstatus% = &H08 CASE 4 TO 7 : sDMAmask% = &HD4 sDMAmode% = &HD6 sDMAclear% = &HD8 sDMAstatus% = &HD0 END SELECT SELECT CASE sDMA% CASE 0, 4 : sDMAterminal% = 1 'bit 0 of status register (&H08 or &HD0) CASE 1, 5 : sDMAterminal% = 2 'bit 1 CASE 2, 6 : sDMAterminal% = 4 'bit 2 CASE 3, 7 : sDMAterminal% = 8 'bit 3 END SELECT sDRQ% = sDMA% + &h04 sModeReg% = sDMA% + &h48 sVolumePort% = BasePort% + &h04 sVolumeData% = BasePort% + &h05 sResetPort% = BasePort% + &h06 sReadPort% = BasePort% + &h0A sWritePort% = BasePort% + &h0C sWaitPort% = BasePort% + &h0E SBreset IF fSBvolumeGet?( %MstrVolume ) = 0 THEN SBvolumeSet %MstrVolume, &hCC FUNCTION = Ok% END FUNCTION '------------------------------------------------------------------------- FUNCTION fSBplay (BYVAL FileSpec AS STRING, _ BYVAL FileNo AS INTEGER ) LOCAL PUBLIC AS INTEGER DIM Address AS LOCAL LONG DIM Addr(1,2) AS LOCAL BYTE DIM B AS LOCAL INTEGER DIM Buf(1,15999) AS LOCAL INTEGER DIM B_ptr(1) AS LOCAL STRING PTR * 32000 DIM C AS LOCAL INTEGER DIM Chunk AS LOCAL INTEGER DIM ChunkHi AS LOCAL BYTE DIM ChunkLo AS LOCAL BYTE DIM LocalOpen AS LOCAL INTEGER DIM tW AS LOCAL WaveHeaderTYPE ON LOCAL ERROR GOTO SBplayOOPS IF LEN(FileSpec$) > 0 THEN 'if a file name is given IF LEN(DIR$(FileSpec$)) = 0 THEN ERROR 53 ' check for existence IF FileNo% = 0 THEN FileNo% = FREEFILE 'no file number given LocalOpen% = -1 ' set local open flag OPEN "B", #FileNo%, FileSpec$ ' open the file END IF ' GET #FileNo%, ,tW IF UCASE$(tW.RiffID) <> "RIFF" THEN GOTO SBplayEXIT IF UCASE$(tW.WaveID) <> "WAVE" THEN GOTO SBplayEXIT IF UCASE$(tW.DataID) <> "DATA" THEN GOTO SBplayEXIT IF tW.FormatTag <> 1 THEN GOTO SBplayEXIT IF tW.BitsPer <> 8 THEN GOTO SBplayEXIT IF tW.DataLen = 0 THEN GOTO SBplayEXIT FOR B% = 0 TO 1 ' B_ptr(B%) = VARPTR32(Buf%(B%,0)) ' Address& = (VARSEG(Buf%(B%,0)) * 16) + _ ' VARPTR(Buf%(B%,0)) ' FOR C% = 0 TO 2 ' Addr?(B%,C%) = ( Address& AND &h00FF ) ' SHIFT RIGHT Address&, 8 ' NEXT ' NEXT ' ' C% = (1000000 \ ( tW.Freq * tW.Stereo) ) ' B% = 256 - C% ' SBwrite &h40 ' SBwrite B% ' B% = 0 ' Chunk% = UBOUND( Buf%(2) ) * 2 ' IF tW.Stereo = 2 THEN ' OUT sVolumePort%, &h0E ' OUT sVolumeData%, &h21 ' END IF ' IF tW.Freq > 22000 THEN ' tW.Freq = &h48 ' ELSE ' tW.Freq = &h14 ' END IF ' GOSUB SBloadBuffer ' SBwrite %SpeakerON ' ' DO ' OUT sDMAmask% , sDRQ% 'mask the dma channel OUT sDMAclear%, 0 '(clear internal DMA flip/flop) OUT sDMAmode% , sModeReg% ' OUT sAddrPort%, Addr?(B%,0) 'bits 00-07 of the 20bit address OUT sAddrPort%, Addr?(B%,1) 'bits 08-15 of the 20bit address OUT sPagePort%, Addr?(B%,2) 'bits 16-19 of the 20bit address OUT sLenPort% , ChunkLo? 'bits 00-07 of size% OUT sLenPort% , ChunkHi? 'bits 08-15 of size% OUT sDMAmask% , sDMA% 'enable channel SBwrite tW.Freq ' SBwrite ChunkLo? ' SBwrite ChunkHi? ' IF tW.Freq = &h48 THEN SBwrite &h91 ' ' C% = INP(sDMAstatus%) 'Read status byte once to make sure DMA is going IF Chunk% > 0 THEN GOSUB SBloadBuffer ' WAIT sDMAstatus%, sDMAterminal% 'Loop until terminal count bit set in DMA status register C% = INP(sWaitPort%) 'DSP Available address $if %Testing ' IF INSTAT THEN EXIT LOOP ' $endif ' LOOP UNTIL Chunk% = 0 ' ' FUNCTION = -1 ' RETURN '------------------------------------------' ' SBplayExit: ' SBwrite %SpeakerOFF ' IF LocalOpen% AND _ ' FILEATTR(FileNo%,0) THEN ' CLOSE #FileNo% ' END IF ' EXIT FUNCTION ' ' SBloadBuffer: ' BIT TOGGLE B%, 0 ' IF tW.DataLen < Chunk% THEN ' Chunk% = tW.DataLen ' IF Chunk% = 0 THEN RETURN ' END IF ' GET #FileNo%, , @B_ptr(B%) ' DECR tW.DataLen, Chunk% ' ChunkLo? = MAX%(0,(Chunk% AND &hFF) - 1) ' ChunkHi? = (Chunk% \ &h100) ' RETURN ' ' SBplayOOPS: ' RESUME SBplayExit ' ' END FUNCTION ' ' ' -------------------------------------------------------------------------- SUB SBvolumeSet (BYVAL Which AS INTEGER, _ BYVAL Volume AS BYTE ) LOCAL PUBLIC OUT sVolumePort%, Which% OUT sVolumeData%, Volume? END SUB ' -------------------------------------------------------------------------- FUNCTION fSBvolumeGet (BYVAL Which AS INTEGER) LOCAL PUBLIC AS BYTE OUT sVolumePort%, Which% FUNCTION = INP(sVolumeData%) END FUNCTION '--------------------------------------------------------------------------- '-------------- private routines ------------------------------------------- '--------------------------------------------------------------------------- SUB SBwrite (BYVAL Cmd AS BYTE) LOCAL PRIVATE WAIT sWritePort%, &h80, &h80 OUT sWritePort%, Cmd? END SUB ' -------------------------------------------------------------------------- FUNCTION fSBread () LOCAL PRIVATE AS BYTE DIM ByteIn AS LOCAL BYTE WAIT sWaitPort%, &h80 'wait for bit 7 on pollport DO ByteIn? = INP(sReadPort%) LOOP UNTIL ByteIn? <> &hAA FUNCTION = ByteIn? END FUNCTION ' -------------------------------------------------------------------------- SUB SBreset () LOCAL PRIVATE OUT sResetPort%, 1 DELAY .1 OUT sResetPort%, 0 IF INP(sReadPort%) <> &hAA THEN WAIT sWaitPort%, &h80 END SUB