'===========================================================================
' Subject: DMA PLAY 4 (WITH 32K BUFFER)      Date: 01-14-98 (19:14)       
' Author:  Toshihiro Horie                   Code: QB, QBasic, PDS        
' Origin:  horie@ocf.berkeley.edu          Packet: SOUND.ABC
'===========================================================================
'------------------------------------------------------------------
' DMA Play 4  (1998.1.14 version with 32K buffer - Internet)
' By Mike Huff (1996)  * Now plays whole file in QB45 and Qbasic *
' Added WAVE file header reader to determine length and sampling freq.
' DMAPlay16 (stereo) actually completes transfer of 40 Megabyte song
' Toshi gives special thanks to Ethan Brodsky, who helped immensely.
' It works without static now! It was just an alignment problem.
' Feel free to use, but please give credit to its authors in your code.
' Program downloaded from http://www.ocf.berkeley.edu/~horie/project.html
'-----------------------------------------------------------------
DECLARE FUNCTION DEC2HEX$ (longnum&)
DECLARE SUB WavInfo (Length&, Freq&, StereoWav%)
DECLARE FUNCTION int2ULong& (signedint%)
DECLARE FUNCTION SpeakerStatus% ()
DECLARE FUNCTION DMAStatus% ()
DECLARE FUNCTION DMADone% (DMA16%, L&)
DECLARE FUNCTION ResetDSP% ()
DECLARE SUB FMVolume (Right%, Left%, Getvol%)
DECLARE SUB VocVolume (Right%, Left%, Getvol%)
DECLARE SUB MasterVolume (Right%, Left%, Getvol%)
DECLARE SUB MicVolume (Gain%, Getvol%)
DECLARE SUB LineVolume (Right%, Left%, Getvol%)
DECLARE SUB CDVolume (Right%, Left%, Getvol%)
DECLARE SUB InputSource (InputSrc%, GetSrc%)
DECLARE SUB WriteDSP (byte%)
DECLARE SUB SetStereo (OnOff%)
DECLARE FUNCTION ReadDSP% ()
DECLARE SUB WriteDAC (byte%)
DECLARE SUB SpeakerState (OnOff%)
DECLARE SUB DMAState (StopGo%)
DECLARE FUNCTION ReadDAC% ()
DECLARE SUB DMAPlay (Segment&, Offset&, Length&, Freq&, StereoWav%)
DECLARE SUB DMAPlay16 (Segment&, Offset&, Length&, Freq&, StereoWav%)
DECLARE SUB DMARecord (Segment&, Offset&, Length&, Freq&)
DECLARE SUB GetBLASTER ()
DECLARE FUNCTION DSPVersion! ()

COMMON SHARED Baseport%, LenPort%, DMA%, DMA16%

TYPE WaveHeaderType
        RiffID           AS STRING * 4
        RiffLength       AS LONG
        WavID            AS STRING * 4
        FmtID            AS STRING * 4
        FmtLength        AS LONG
        wavformattag     AS INTEGER
        Channels         AS INTEGER
        SamplesPerSec    AS INTEGER
        BytesPerSec      AS INTEGER
        BlockAlign       AS INTEGER
        FmtSpecific      AS INTEGER
        Padding          AS STRING * 4
        DataID           AS STRING * 4
        DataLength       AS LONG
END TYPE
DIM SHARED Wave(0) AS WaveHeaderType

SCREEN 9: CLS
'WIDTH 80, 50
PRINT "DMAPlay 4"
PRINT "By Mike Huff (SB, SBPro) and Toshi Horie (SB16)"
PRINT "Modified By Martin Rampersad (To play entire file instead of first 32k)"
PRINT "Comments, etc. can be sent to MHuff@gnn.com or to Martin_Rampersad@juno.com"
GetBLASTER ' Parses BLASTER environment
PRINT STRING$(80, 196)
IF ResetDSP% THEN 'resets DSP (returns true if sucessful)
   PRINT "DSP reset sucessfully!"
ELSE
   PRINT "DSP failed to reset, try another port.": END
END IF
SpeakerState 1 'turn the speaker on
PRINT "Sound Card DSP version:"; DSPVersion!
MasterVolume Right%, Left%, -1 'this puts the mixer volumes in Right% and Left%
PRINT "Master volume is set at: Right-"; Right%; " Left-"; Left%
MasterVolume 7, 7, 0 '15,15,0 cranks the master volume all the way up.

'WavBuffer size MUST be divisible by 4 for stereo files
DIM WavBuffer(0) AS STRING * 32764 'to make a ~32k buffer for file
blocklen = 32764 'make this the same as the number above in STRING*____

' 16-bit WAV files are OK if you have an SB16.
'Filename$ = "D:\SOUND\AOIUSAGI.WAV"
Filename$ = "C:\WINDOWS\MEDIA\THEMIC~1.WAV"
'Filename$ = "C:\PROGRA~1\ICQ\SOUNDS\CHAT.WAV"

'Filename$ = "mock.wav"
'Filename$ = "ellens13.wav"
'Filename$ = "mono13.wav"
'Filename$ = "ellens13.raw"

OPEN Filename$ FOR BINARY AS #1
HeaderSize = 45                'assume .WAV file (use 45)
                               'I think it's 32 for VOC, 0 for RAW files
Length& = LOF(1) - HeaderSize:
PRINT : PRINT "Playing " + Filename$
GET #1, 1, Wave(0)
Freq& = 22000: 'default playback frequency
WavInfo Length&, Freq&, StereoWav%
SEEK #1, HeaderSize

Buffseg% = VARSEG(WavBuffer(0))
Buffoff% = VARPTR(WavBuffer(0))
Bseg& = int2ULong&(Buffseg%)
BOff& = int2ULong&(Buffoff%): 'should always be 0 in BASIC
DO
        'Get 32k from file (skip header on WAV)
        IF Length& >= blocklen THEN
                L& = blocklen
        ELSE
                L& = Length&
        END IF
        GET #1, , WavBuffer(0)
        CurrentBlk& = CurrentBlk& + 1
        Length& = Length& - blocklen
        '............play block in the background.......................
        IF DMA16% AND StereoWav% THEN
                DMAPlay16 Bseg&, BOff&, L&, Freq&, StereoWav%
                'PRINT "SB16 mode"
        ELSE
                DMAPlay Bseg&, BOff&, L&, Freq&, StereoWav%
                'PRINT "SB mode"
        END IF
        '..............................................................
        DO UNTIL DMADone%(DMA16%, L&)
               'CPU is free to do graphics, etc.
                'LOCATE 12, 1
                'PRINT USING "Seconds elapsed: ###.###s"; (TIMER - t1#)
                LINE (RND * 640, RND * 290 + 60)-(RND * 640, RND * 290 + 60), FIX(RND * 16)
                LINE (RND * 640, RND * 290 + 60)-(RND * 640, RND * 290 + 60), FIX(RND * 16)
                IF INKEY$ > "" THEN stopflag = 1
        LOOP
        IF stopflag THEN EXIT DO: 'stop here so it doesn't freeze the computer
LOOP UNTIL EOF(1)

'Use DMARecord to record in the background.
'and use DMAPlay to playback the same buffer you recorded to or you could
'even write the buffer to a file.
'DMARecord VARSEG(WavBuffer(0)), VARPTR(WavBuffer(0)), Length&, Freq&

'Notes: 16 bit mono files are incorrectly played in DMAPLAY instead of
'DMAPLAY16.  This will be fixed as soon as I get more info on the
'wave file header.

PRINT "DMA transfer completed!"
DMAState 0: 'stop sound
SpeakerState 0: 'turn the speaker off
quit% = ResetDSP%
END

SUB CDVolume (Right%, Left%, Getvol%)
OUT Baseport% + 4, &H28
IF Getvol% THEN
   Left% = INP(Baseport% + 5) \ 16
   Right% = INP(Baseport% + 5) AND &HF
   EXIT SUB
ELSE
   OUT Baseport% + 5, (Right% + Left% * 16) AND &HFF
END IF
END SUB

FUNCTION DEC2HEX$ (longnum&)
DEC2HEX$ = HEX$(longnum&)
END FUNCTION

FUNCTION DMADone% (DMA16%, L&)
countlo% = INP(LenPort%)
counthi% = INP(LenPort%)
count& = CLNG(counthi% * 256&) + CLNG(countlo%)
'LOCATE 13, 1: PRINT count&
'if you have problems with L&-8, then use L&-1
IF count& > L& - 8 THEN
        IF DMA16% THEN
                ack16% = INP(Baseport% + &HF) 'ack to SB
                OUT &HA0, &H20 'acknowledge SB interrupt 8-15
                OUT &H20, &H20 'acknowledge SB interrupt 1-15
        ELSE
                ack% = INP(Baseport% + &HE)
                OUT &H20, &H20 'acknowledge SB interrupt 1-15
        END IF
        DMADone% = -1
        'SOUND 300, .4
END IF
END FUNCTION

SUB DMAPlay (Segment&, Offset&, Length&, Freq&, StereoWav%)
' Transfers and plays the contents of the buffer.
Length& = Length& - 1
page% = 0
addr& = Segment& * 16 + Offset&
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 "8-bit DMA channels 0-3 only!": END
       EXIT SUB
END SELECT
IF StereoWav% THEN SetStereo 1
OUT &HA, &H4 + DMA%: 'DMA channel to use (DRQ#)
OUT &HC, &H0
OUT &HB, ModeReg%
OUT AddPort%, addr& AND &HFF:  'buffer address of sound data low byte
OUT AddPort%, (addr& AND &HFFFF&) \ &H100: 'high byte
IF (addr& AND 65536) THEN page% = page% + 1: '64K pages for 8-bit DMA
IF (addr& AND 131072) THEN page% = page% + 2
IF (addr& AND 262144) THEN page% = page% + 4
IF (addr& AND 524288) THEN page% = page% + 8
OUT PgPort%, page%: 'output page of phys. addr of sample block
OUT LenPort%, Length& AND &HFF: 'size of block to DMA controller -Low
OUT LenPort%, (Length& AND &HFFFF&) \ &H100: 'high byte
OUT &HA, DMA%: 'release DMA channel

LOCATE 21, 1: PRINT "seg:"; DEC2HEX$(Segment&),
PRINT "offset:"; DEC2HEX$(Offset&), "addr:"; DEC2HEX$(addr&)


TimeConst% = 256 - 1000000 \ Freq&

IF Freq& < 23000 THEN
   WriteDSP &H40
   WriteDSP TimeConst%
   WriteDSP &H14:                      '8 bit output over DMA
   WriteDSP (Length& AND &HFF)
   WriteDSP ((Length& AND &HFFFF&) \ &H100)
ELSE 'SBPro (DSP version 3.x) can play 8-bit mono/stereo wave files
   IF INT(DSPVersion!) = 3 THEN
      'high speed 8 bit output up to 44kHz mono or 22Khz stereo
      WriteDSP &H40:  'output sampling rate const
      WriteDSP TimeConst%
      WriteDSP &H48
      WriteDSP (Length& AND &HFF)
      WriteDSP ((Length& AND &HFFFF&) \ &H100)
      WriteDSP &H91
   ELSE
      PRINT "You need a Sound Blaster Pro to play at 8 bit high speed."
      EXIT SUB
   END IF
END IF
END SUB

SUB DMAPlay16 (Segment&, Offset&, L&, Freq&, StereoWav%)
' Transfers and plays the contents of the buffer.
' Try only on an SoundBlaster 16 !!
' Don't see any more mistakes in code and it sounds almost perfect,
' other than some inherent pops and clicks due to the limitations of
' single-cycle DMA
' 1 page=128K in 16 bit mode
' DMA16% (16-bit DMA channel) passed implicitly

IF DSPVersion! < 4 THEN PRINT "You need an SB16 for this mode!": END
'LOCATE 16, 1: PRINT "using SB16 DMA."
L& = L& - 1: page% = 0
addr& = Segment& * 16 + Offset&

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% = (addr& \ 131072) * 2
Offset2& = (addr& - (page% * 65536)) \ 2
Lengthlo% = ((L& \ 2) AND &HFF): 'number of words-1
Lengthhi% = (((L& \ 2) AND &HFFFF&) \ &H100) 'this may be wrong sometimes

'LOCATE 21, 1: PRINT "seg:"; dec2hex$(Segment&),
'PRINT "offset:"; dec2hex$(Offset&), "addr:"; dec2hex$(addr&)
'PRINT "off2:"; dec2hex$(Offset&), "page=addr\64K:"; dec2hex$(page%),


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 &HFFFF&) \ &H100: 'Buffer base offset hi
OUT PgPort%, page%:                          'output page of phys. addr of sample block
OUT LenPort%, Lengthlo%:                     'DMA count = length of buffer
OUT LenPort%, Lengthhi%:                     'DMA count high byte
OUT &HD4, DMA16% - 4'write single mask (select Channel16)

FreqHi% = (Freq& AND &HFFFF&) \ &H100
FreqLo% = Freq& AND &HFF
WriteDSP &H41: 'set output sampling rate
WriteDSP FreqHi%
WriteDSP FreqLo%
WriteDSP &HB0:  '16 bit DAC, single cycle, FIFO off (ok)
IF StereoWav% 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 ((L& \ 2) AND &HFF)
WriteDSP (((L& \ 2) AND &HFFFF&) \ &H100)
END SUB

SUB DMARecord (Segment&, Offset&, Length&, Freq&)
Length& = Length& - 1
memloc& = Segment& * 16 + Offset&
page% = 0
SELECT CASE DMA%
    CASE 0
       PgPort% = &H87
       AddPort% = &H0
       LenPort% = &H1
       ModeReg% = &H44
    CASE 1
       PgPort% = &H83
       AddPort% = &H2
       LenPort% = &H3
       ModeReg% = &H45
    CASE 2
       PgPort% = &H81
       AddPort% = &H4
       LenPort% = &H5
       ModeReg% = &H46
    CASE 3
       PgPort% = &H82
       AddPort% = &H6
       LenPort% = &H7
       ModeReg% = &H47
    CASE ELSE
       EXIT SUB
END SELECT

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

IF Freq& <= 23000 THEN
   TimeConst% = 256 - 1000000 \ Freq&
   WriteDSP &H40
   WriteDSP TimeConst%
   WriteDSP &H24
   WriteDSP (Length& AND &HFF)
   WriteDSP ((Length& AND &HFFFF&) \ &H100)
ELSE
   IF DSPVersion! >= 3 THEN
      TimeConst% = ((65536 - 256000000 / Freq&) AND &HFFFF&) \ &H100
      WriteDSP &H40
      WriteDSP TimeConst%
      WriteDSP (Length& AND &HFF)
      WriteDSP ((Length& AND &HFFFF&) \ &H100)
      WriteDSP &H99
   ELSE
      PRINT "You need a Sound Blaster with a DSP 3.x+ to record at high speed."
      EXIT SUB
   END IF
END IF

END SUB

SUB DMAState (StopGo%)
' Stops or continues DMA play.
IF StopGo% THEN WriteDSP &HD4 ELSE WriteDSP &HD0
END SUB

FUNCTION DSPVersion!
' Gets the DSP version.
WriteDSP &HE1
Temp% = ReadDSP%
Temp2% = ReadDSP%
DSPVersion! = VAL(STR$(Temp%) + "." + STR$(Temp2%))
END FUNCTION

SUB FMVolume (Right%, Left%, Getvol%)
OUT Baseport% + 4, &H26
IF Getvol% THEN
   Left% = INP(Baseport% + 5) \ 16
   Right% = INP(Baseport% + 5) AND &HF
   EXIT SUB
ELSE
   OUT Baseport% + 5, (Right% + Left% * 16) AND &HFF
END IF
END SUB

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

END SUB

SUB InputSource (InputSrc%, GetSrc%)
OUT Baseport% + 4, &HC
IF GetSrc% THEN
   InputSrc% = INP(Baseport% + 5) AND 2 + INP(Baseport% + 5) AND 4
ELSE
   OUT Baseport% + 5, InputSrc% AND 7
END IF
END SUB

FUNCTION int2ULong& (signedint%)
IF signedint% < 0 THEN
        int2ULong& = CLNG(signedint% + 65536)
ELSE
        int2ULong& = CLNG(signedint%)
END IF
END FUNCTION

SUB LineVolume (Right%, Left%, Getvol%)
OUT Baseport% + 4, &H2E
IF Getvol% THEN
   Left% = INP(Baseport% + 5) \ 16
   Right% = INP(Baseport% + 5) AND &HF
   EXIT SUB
ELSE
   OUT Baseport% + 5, (Right% + Left% * 16) AND &HFF
END IF
END SUB

SUB MasterVolume (Right%, Left%, Getvol%)
OUT Baseport% + 4, &H22
'PRINT BasePort%
IF Getvol% THEN
   Left% = INP(Baseport% + 5) \ 16
   Right% = INP(Baseport% + 5) AND &HF
   EXIT SUB
ELSE
   OUT Baseport% + 5, (Right% + Left% * 16) AND &HFF
END IF
END SUB

SUB MicVolume (Volume%, Getvol%)
OUT Baseport% + 4, &HA
IF Getvol% THEN
   Volume% = INP(Baseport% + 5) AND &HF
   EXIT SUB
ELSE
   OUT Baseport% + 5, Volume% AND &HF
END IF
END SUB

FUNCTION ReadDAC%
' Reads a byte from the DAC.
WriteDSP &H20
ReadDAC% = ReadDSP%
END FUNCTION

FUNCTION ReadDSP%
WAIT (Baseport% + &HE), &H80: 'wait for bit 7 on pollport
'DO: DSPIn% = INP(Baseport% + 10): LOOP UNTIL DSPIn% <> &HAA
ReadDSP% = DSPIn%
END FUNCTION

FUNCTION ResetDSP%
ct = 0: stat = 0: ready = &HAA
OUT Baseport% + &H6, 1
DO
        OUT Baseport% + &H6, 0
        stat = INP(Baseport% + &HE)
        stat = INP(Baseport% + &HA)
        IF stat = ready THEN EXIT DO
        ct = ct + 1
LOOP WHILE ct < 100 'wait about 100 ms
IF stat = ready THEN ResetDSP% = 1 ELSE ResetDSP% = 0
END FUNCTION

SUB SetStereo (OnOff%)
'only needed on SBPro
MixerReg% = Baseport% + 4
MixerData% = Baseport% + 5
        OUT MixerReg%, &HE
        IF OnOff% THEN
                OUT MixerData%, 2
        ELSE
                OUT MixerData%, 0
        END IF
END SUB

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

FUNCTION SpeakerStatus%
OUT Baseport% + 4, &HD8
IF INP(Baseport% + 5) = &HFF THEN SpeakerStatus% = -1 ELSE SpeakerStatus% = 0
END FUNCTION

SUB VocVolume (Right%, Left%, Getvol%)
OUT Baseport% + 4, &H4
IF Getvol% THEN
   Left% = INP(Baseport% + 5) \ 16
   Right% = INP(Baseport% + 5) AND &HF
   EXIT SUB
ELSE
   OUT Baseport% + 5, (Right% + Left% * 16) AND &HFF
END IF
END SUB

SUB WavInfo (Length&, Freq&, StereoWav%)
'PRE: Wave(0) array filled from WAV file header
'POST: Length&, Freq& set
PRINT "RiffID:"; Wave(0).RiffID
IF Wave(0).RiffID <> "RIFF" THEN PRINT "NOT A WAV FILE": END
'PRINT "RiffLength:"; Wave(0).RiffLength
'PRINT "WavID:"; Wave(0).WavID
'PRINT "FmtID:"; Wave(0).FmtID
'PRINT "FmtLength:"; Wave(0).FmtLength
'PRINT "wavformattag:"; Wave(0).wavformattag
PRINT "Channels:"; Wave(0).Channels
Freq& = int2ULong&(Wave(0).SamplesPerSec)
IF Wave(0).Channels = 2 THEN
        StereoWav% = 1
END IF
PRINT "SamplesPerSec:"; Freq&
'PRINT "BytesPerSec:"; Wave(0).BytesPerSec
'PRINT "BlockAlign:"; Wave(0).BlockAlign
'PRINT "FmtSpecific:"; Wave(0).FmtSpecific
'PRINT "Padding:"; Wave(0).Padding
'PRINT "DataID:"; Wave(0).DataID
PRINT "DataLength:"; Wave(0).DataLength
IF UCASE$(Wave(0).DataID) = "DATA" THEN
        Length& = Wave(0).DataLength
END IF
PRINT USING "Play Length ####.##s"; Length& / Freq&
END SUB

SUB WriteDAC (byte%)
' Writes a byte to the DAC.
WriteDSP &H10
WriteDSP byte%
END SUB

SUB WriteDSP (byte%)
' Writes a byte to the DSP
DO: LOOP WHILE INP(Baseport% + 12) AND &H80
OUT Baseport% + 12, byte%
END SUB

SUB WriteMixer (cmd%, value%)
MixerReg% = Baseport% + 4
MixerData% = Baseport% + 5
OUT MixerReg%, cmd%
OUT MixerData%, value%
END SUB