'===========================================================================
' Subject: BETTER BUFFERED DMA PLAYER 4.1     Date: 04-18-98 (14:32)       
'  Author: Mark                               Code: QB, QBasic, PDS        
'  Origin: loutre@xs4all.nl                 Packet: SOUND.ABC
'===========================================================================
'--------My message-----------------------------------------------
' DMA Play 4.1
' I tried to use DMAPLAY4 but the buffering was not good.
' So i've improved this program a little bit.
' It now even runs smoothly on the slowest storage drive i've ever know:
' my 1.44m disk drive.
' That's it for tday.
' please visit: http://www.xs4all.nl/~loutre/faqs/
' mail me: mark.basicmaster@mailexcite.com
' Have fun --> press shift-f5!
'--------My message-----------------------------------------------
'{}
'--------Message from original file-------------------------------
' 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
'--------Message from original file-------------------------------
DECLARE FUNCTION DSPVersion! ()
DECLARE FUNCTION ReadDAC% ()
DECLARE FUNCTION ReadDSP% ()
DECLARE FUNCTION int2ULong& (signedint%)
DECLARE FUNCTION SpeakerStatus% ()
DECLARE FUNCTION DMAStatus% ()
DECLARE FUNCTION DMADone% (DMA16%, L&)
DECLARE FUNCTION ResetDSP% ()
DECLARE FUNCTION DEC2HEX$ (longnum&)
DECLARE SUB InitBlaster ()
DECLARE SUB PlayWave (Fil$)
DECLARE SUB WavInfo (Length&, Freq&, StereoWav%)
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 SUB WriteDAC (byte%)
DECLARE SUB SpeakerState (OnOff%)
DECLARE SUB DMAState (StopGo%)
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 ()

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

'$DYNAMIC '''Need this for compiling...
DIM SHARED Wave(0) AS WaveHeaderType
DIM SHARED WavBuffer(0) AS STRING * 32764

SCREEN 13

InitBlaster
PlayWave "C:\WINDOWS\MEDIA\THEMIC~1.WAV"

SCREEN 0, , 0, 0
WIDTH 80, 25
CLS
PRINT "Done..."
END

REM $STATIC
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

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
L& = L& - 1: page% = 0
addr& = Segment& * 16 + Offset&

SELECT CASE DMA16%
    CASE 4
       PgPort% = &H0
       AddPort% = &HC0
       LenPort% = &HC2
       ModeReg% = &H48
    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)

OUT &HD8, 0
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

DEFINT A-Z
SUB GetBLASTER
IF LEN(ENVIRON$("BLASTER")) = 0 THEN
    BasePort% = &H220
    IRQ% = 7
    DMA% = 1
    DMA16% = 0
    EXIT SUB
END IF
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

DEFSNG A-Z
SUB InitBlaster
GetBLASTER
IF ResetDSP% THEN
   PRINT "DSP reset sucessfully!"
ELSE
   PRINT "DSP failed to reset, try another port."
   END
END IF
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

DEFINT A-Z
SUB PlayWave (Fil$)
FileName$ = Fil$
IF ResetDSP% THEN
ELSE
    EXIT SUB
END IF
SpeakerState 1 'turn the speaker on
MasterVolume 15, 15, 0
blocklen = 32764

WaveFile = FREEFILE

OPEN FileName$ FOR BINARY AS #WaveFile
HeaderSize = 45
Length& = LOF(1) - HeaderSize:
GET #WaveFile, 1, Wave(0)
Freq& = 22000
WavInfo Length&, Freq&, StereoWav%
SEEK #WaveFile, HeaderSize
BuffSeg% = VARSEG(WavBuffer(0))
BuffOff% = VARPTR(WavBuffer(0))
BSeg& = int2ULong&(BuffSeg%)
BOff& = int2ULong&(BuffOff%)

IF Length& >= blocklen THEN
    L& = blocklen
ELSE
    L& = Length&
END IF
GET #WaveFile, , WavBuffer(0)
CurrentBlk& = CurrentBlk& + 1
Length& = Length& - blocklen

DO
    IF DMA16% AND StereoWav% THEN
        DMAPlay16 BSeg&, BOff&, L&, Freq&, StereoWav%
    ELSE
        DMAPlay BSeg&, BOff&, L&, Freq&, StereoWav%
    END IF
  
    QuitMe = 0
    IF Length& <= 0 THEN QuitMe = 1
    
        IF Length& >= blocklen THEN
            Li& = blocklen
        ELSE
            Li& = Length&
        END IF
        GET #WaveFile, , WavBuffer(0)
        Length& = Length& - blocklen
        CurrentBlk& = CurrentBlk& + 1
  
    DO UNTIL DMADone%(DMA16%, L&)
        Y1 = INT(RND * 200)
        Y2 = INT(RND * 200)
        X1 = INT(RND * 320)
        X2 = INT(RND * 320)
        C = INT(RND * 16)
        LINE (X1, Y1)-(X2, Y2), C

    LOOP
      
    L& = Li&

LOOP UNTIL QuitMe = 1

DMAState 0
SpeakerState 0
quit% = ResetDSP%
END SUB

DEFSNG A-Z
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%)
IF Wave(0).RiffID <> "RIFF" THEN PRINT "NOT A WAV FILE": END
Freq& = int2ULong&(Wave(0).SamplesPerSec)
IF Wave(0).Channels = 2 THEN
    StereoWav% = 1
END IF
IF UCASE$(Wave(0).DataID) = "DATA" THEN
    Length& = Wave(0).DataLength
END IF
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
