qbx 7.1 8 bit (16 bit?) wav player code

[ron77]

you need the qbx lib linked so start the ide by from dos (dosbox) "qbx /l qbx" to start qbx 7.1 for it to work

DECLARE FUNCTION SoundUpdate% ()
DECLARE SUB PlayWav (sFile AS STRING)
DECLARE SUB SoundStop ()
DECLARE SUB LoadWav (sFile AS STRING)
DECLARE SUB ReadBlock (BYVAL iFile AS INTEGER, BYVAL iBlock AS INTEGER)
DECLARE SUB ReadBlock16 (BYVAL iFile AS INTEGER, BYVAL iBlock AS INTEGER)
DECLARE SUB sbDetect ()
DECLARE SUB sbDma8AutoInit (lLength AS LONG)
DECLARE SUB sbFrequency (lFrequency AS LONG)
DECLARE SUB sbIntAck8 ()
DECLARE SUB sbMixerReset ()
DECLARE SUB sbMixerStereo (BYVAL iStereo AS INTEGER)
DECLARE SUB sbReset ()
DECLARE SUB sbSpeakerOn (BYVAL iOn AS INTEGER)
DECLARE SUB sbWait ()
DECLARE SUB SetDma (lSeg AS LONG, lPtr AS LONG, lLength AS LONG)
DECLARE SUB SetDmaNotify (pwSeg AS LONG, pwPtr AS LONG)
DECLARE SUB SoundInit ()
DECLARE FUNCTION u& (iNum AS INTEGER)

DEFSTR A-Z:  DEFDBL D:  DEFINT I:  DEFSNG F: DEFLNG L: DEFSTR S

TYPE WaveFormat
  wTag  AS INTEGER
  wCh   AS INTEGER
  lHz   AS LONG
  lSz   AS LONG
  wAg   AS INTEGER
  wBits AS INTEGER
  iFN   AS INTEGER
  iSeek AS INTEGER
  iLeft AS INTEGER
  lSec  AS LONG
  lPos  AS LONG
END TYPE

CONST SoundBufferSize = 2048 '512,1024,2048 or 4096
CONST SoundBufferSize2 = SoundBufferSize * 2
CONST SoundBufferPages = SoundBufferSize \ 256
TYPE StreamBuffer
  part0 AS STRING * SoundBufferSize
  part1 AS STRING * SoundBufferSize
  part2 AS STRING * SoundBufferSize
  part3 AS STRING * SoundBufferSize
END TYPE

DIM SHARED iSbPort AS INTEGER, iSbIrq AS INTEGER, iSbDma AS INTEGER
DIM SHARED lSndLen AS LONG, lSndFreq AS LONG
DIM SHARED Isr(5)  AS LONG, l16to8(6) AS LONG
DIM SHARED iInit AS INTEGER, iFlag AS INTEGER
DIM SHARED tBuff AS StreamBuffer
DIM SHARED iBasePart AS INTEGER, iBlock AS INTEGER, iBlksLeft  AS INTEGER
DIM SHARED lSeg AS LONG, lPtr AS LONG
DIM SHARED tWave AS WaveFormat

sEndMsg = "Emergency closing?"
KEY(1) ON: ON KEY(1) GOSUB Done

INPUT "select WAV file to be played: "; sFile  '"song3.wav" 'COMMAND$
IF sFile = "" THEN
  sFile = "M1-22-1M.WAV" '"M5-22-2M.WAV"
  PRINT "Syntax: "; "wavplay file.wav";
  'END
  CLS
END IF

SoundInit
PlayWav (sFile)


PRINT STR$(tWave.lHz \ 1000); "khz";
PRINT STR$(tWave.wBits); "bit ";
IF tWave.wCh = 2 THEN PRINT "stereo";  ELSE PRINT "mono";

DO

  IF SoundUpdate <> 1 THEN
    lWavSec = (tWave.lSz + (tWave.lSec - 1) - tWave.lPos) \ tWave.lSec
    LOCATE , 42
    PRINT RIGHT$("0" + MID$(STR$(lWavSec \ 3600), 2), 2); ":";
    PRINT RIGHT$("0" + MID$(STR$((lWavSec \ 60) MOD 60), 2), 2); ":";
    PRINT RIGHT$("0" + MID$(STR$(lWavSec MOD 60), 2), 2);
    PRINT STR$((tWave.lPos * 100&) \ tWave.lSz); "%";
    IF SoundUpdate = 0 THEN sEndMsg = "Done...": EXIT DO
  END IF

  WAIT &H3DA, 8:  WAIT &H3DA, 8, 8
  IF INKEY$ = CHR$(27) THEN
    sEndMsg = "Cancelled!": EXIT DO
  END IF
LOOP

Done:
KEY(1) OFF
SoundStop
IF POS(0) > 1 THEN PRINT
COLOR 7: PRINT sEndMsg;
LOCATE , 1: COLOR 7: PRINT sEndMsg;
sbReset
END

SUB PlayWav (sFile AS STRING)
  iFN = FREEFILE: iSuccess = 0
  ON LOCAL ERROR GOTO failed
  OPEN sFile FOR INPUT AS #iFN
  CLOSE #iFN: iSuccess = 1
failed:
  IF iSuccess = 0 THEN PRINT "Failed to open "; sFile: SLEEP: END
  ON ERROR GOTO 0

  OPEN sFile FOR BINARY ACCESS READ AS #iFN
  sHeader = INPUT$(512, iFN): sHDR = UCASE$(sHeader)
  iPos = 0
  IF LEFT$(sHDR, 4) = "RIFF" THEN
    iPos = INSTR(sHDR, "FMT ")
    IF iPos THEN
      GET #iFN, iPos + 8, tWave
      IF tWave.wCh < 1 OR tWave.wCh > 2 THEN iPos = 0
      IF tWave.lHz < 2000 OR tWave.lHz > 44100 THEN iPos = 0
      IF tWave.wAg <> ((tWave.wCh * tWave.wBits) \ 8) THEN iPos = 0
      IF tWave.lSz <> (tWave.wAg * tWave.lHz) THEN iPos = 0
      IF tWave.wBits < 8 OR tWave.wBits > 16 THEN iPos = 0
    END IF
    IF iPos THEN
      iPos = INSTR(sHDR, "DATA")
      IF iPos THEN iPos = iPos + 8
    END IF

  END IF
  sHeader = "": sHDR = ""
  IF iPos = 0 THEN
    COLOR 12: PRINT "Bad WAV file..."
    COLOR 7: RESET: END
  END IF

  lSndFreq = tWave.lHz * tWave.wCh
  lSndLen = (LOF(iFN) - iPos) \ (tWave.wBits \ 8)
  iSndBlks = (lSndLen + (SoundBufferSize - 1)) \ SoundBufferSize
  tWave.lSz = lSndLen:  tWave.lSec = lSndFreq * (tWave.wBits \ 8)
  tWave.lPos = 0:  tWave.iFN = iFN:  tWave.iLeft = iSndBlks
  tWave.iSeek = iPos

  SEEK #iFN, iPos

  iBlock = 0: iBlksLeft = tWave.iLeft
  IF tWave.wBits = 8 THEN ReadBlock tWave.iFN, iBlock ELSE ReadBlock16 iFN, iBlock
  iBlock = iBlock XOR 1: iBlksLeft = iBlksLeft - 1
  IF iBlksLeft THEN
    IF tWave.wBits = 8 THEN ReadBlock tWave.iFN, iBlock ELSE ReadBlock16 iFN, iBlock
    iBlock = iBlock XOR 1: iBlksLeft = iBlksLeft - 1
  END IF

  IF tWave.wCh = 2 THEN
    sbMixerReset
    sbMixerStereo 1
  END IF
  sbSpeakerOn 1

  iFlag = 0
  SetDmaNotify u(VARSEG(iFlag)), u(VARPTR(iFlag))
  sbFrequency lSndFreq

  sbDma8AutoInit SoundBufferSize
  'lSndLen \ 2

  'iCurBlk = INP(iSbDma + iSbDma + 1) 'we dont care for the low byte
  'iCurBlk = (INP(iSbDma + iSbDma + 1) \ SoundBufferPages)


END SUB

DEFSNG A-E, G-H, J-R, T-Z
SUB ReadBlock (BYVAL iFile AS INTEGER, BYVAL iBlock AS INTEGER)
  SELECT CASE iBasePart + (iBlock AND 1)
  CASE 0
    IF (SEEK(iFile) + SoundBufferSize) > LOF(iFile) THEN tBuff.part0 = STRING$(SoundBufferSize, 128)
    GET #iFile, , tBuff.part0
  CASE 1
    IF (SEEK(iFile) + SoundBufferSize) > LOF(iFile) THEN tBuff.part1 = STRING$(SoundBufferSize, 128)
    GET #iFile, , tBuff.part1
  CASE 2
    IF (SEEK(iFile) + SoundBufferSize) > LOF(iFile) THEN tBuff.part2 = STRING$(SoundBufferSize, 128)
    GET #iFile, , tBuff.part2
  CASE 3
    IF (SEEK(iFile) + SoundBufferSize) >= LOF(iFile) THEN tBuff.part3 = STRING$(SoundBufferSize, 128)
    GET #iFile, , tBuff.part3
  END SELECT
END SUB

DEFLNG L
SUB ReadBlock16 (BYVAL iFile AS INTEGER, BYVAL iBlock AS INTEGER)
  STATIC sBlock AS STRING * SoundBufferSize2
  IF LEN(sBlock) = 0 OR (SEEK(iFile) + SoundBufferSize2) > LOF(iFile) THEN
    sBlock = STRING$(SoundBufferSize2, 0)
  END IF
  GET #iFile, , sBlock

  DEF SEG = VARSEG(sBlock): lpBlk = VARPTR(sBlock)
  FOR iC = 0 TO 2047
    POKE lpBlk + iC, (PEEK(lpBlk + iC + iC + 1) + 128) AND 255
  NEXT iC
  SELECT CASE iBasePart + (iBlock AND 1)
  CASE 0: tBuff.part0 = sBlock
  CASE 1: tBuff.part1 = sBlock
  CASE 2: tBuff.part2 = sBlock
  CASE 3: tBuff.part3 = sBlock
  END SELECT

  'SELECT CASE iBasePart + (iBlock AND 1)
  'CASE 0: CALL absolute(sBlock, tBuff.Part0, VARPTR(l16to8(0)))
  'CASE 1: CALL absolute(sBlock, tBuff.Part1, VARPTR(l16to8(0)))
  'CASE 2: CALL absolute(sBlock, tBuff.Part2, VARPTR(l16to8(0)))
  'CASE 3: CALL absolute(sBlock, tBuff.Part3, VARPTR(l16to8(0)))
  'END SELECT



END SUB

DEFSNG I, L, S
SUB sbDetect

  DIM sBlast AS STRING
  DIM iPosi AS INTEGER
  DIM iChar AS INTEGER

  sBlast = ENVIRON$("BLASTER")

  IF LEN(sBlast) = 0 THEN
    PRINT "BLASTER environment variable not set..."
    PRINT "Assuming A220 I7 D1 T0"
    iSbPort = &H220: iSbIrq = 7: iSbDma = 1
    EXIT SUB
  END IF
  
  DO
    iPosi = INSTR(sBlast, "A")
    IF iPosi = 0 OR iPosi > LEN(sBlast) - 3 THEN iPosi = 0: EXIT DO
    iChar = ASC(MID$(sBlast, iPosi + 1))
    IF iChar < ASC("1") OR iChar > ASC("9") THEN iPosi = 0: EXIT DO
    IF ASC(MID$(sBlast, iPosi + 3)) <> ASC("0") THEN iPosi = 0: EXIT DO
    iSbPort = VAL("&h" + MID$(sBlast, iPosi + 1, 3))

    iPosi = INSTR(sBlast, "I")
    IF iPosi = 0 OR iPosi > LEN(sBlast) - 1 THEN iPosi = 0: EXIT DO
    iChar = ASC(MID$(sBlast, iPosi + 1))
    IF iChar < ASC("1") OR iChar > ASC("9") THEN iPosi = 0: EXIT DO
    iSbIrq = VAL(MID$(sBlast, iPosi + 1, 2))

    iPosi = INSTR(sBlast, "D")
    IF iPosi = 0 OR iPosi > LEN(sBlast) - 1 THEN iPosi = 0: EXIT DO
    iChar = ASC(MID$(sBlast, iPosi + 1))
    IF iChar < ASC("0") OR iChar > ASC("9") THEN iPosi = 0: EXIT DO
    iSbDma = VAL(MID$(sBlast, iPosi + 1, 2))

    EXIT DO
  LOOP

  IF iPosi = 0 THEN
    PRINT "BLASTER environment is INVALID..."
    PRINT "Assuming A220 I7 D1 T0"
    iSbPort = &H220: iSbIrq = 7: iSbDma = 1
    EXIT SUB
  END IF

  PRINT "PORT=" + HEX$(iSbPort) + " IRQ=" + LTRIM$(STR$(iSbIrq)) + " DMA=" + LTRIM$(STR$(iSbDma));

END SUB

SUB sbDma8AutoInit (lLength AS LONG)
  lLen = (lLength - 1)
  sbWait
  OUT iSbPort + &HC, &H48
  sbWait
  OUT iSbPort + &HC, (lLen AND 255)
  sbWait
  OUT iSbPort + &HC, ((lLen \ 256) AND 255)
  sbWait
  OUT iSbPort + &HC, &H1C
END SUB

SUB sbFrequency (lFrequency AS LONG)
 
  lFreq = 65536 - (256000000 \ (1 * lFrequency))
  sbWait
  OUT iSbPort + &HC, &H40
  OUT iSbPort + &HC, (lFreq \ 256) AND 255

END SUB

SUB sbIntAck8
  DIM iResu AS INTEGER
  iResu = INP(iSbPort + &HE)
END SUB

DEFLNG U
SUB sbMixerReset
  sbWait
  OUT iSbPort + &H4, &H0
  sbWait
  OUT iSbPort + &H5, &HFF
END SUB

SUB sbMixerStereo (BYVAL iStereo AS INTEGER)
  : sbWait: OUT iSbPort + &H4, &HE
  IF iStereo THEN
    : sbWait: OUT iSbPort + &H5, &H22
  ELSE
    : sbWait: OUT iSbPort + &H5, &H20
  END IF
END SUB

DEFSNG U
SUB sbOut (BYVAL iSample AS INTEGER)

  OUT iSbPort + &HC, &H10
  OUT iSbPort + &HC, iSample

END SUB

SUB sbReset

 OUT iSbPort + &H6, 1
 WAIT &H3DA, 8
 OUT iSbPort + &H6, 0
 
 DIM sTimeout AS SINGLE
 sTimeout = TIMER
 DO
   IF INP(iSbPort + &HE) THEN
     IF INP(iSbPort + &HA) = &HAA THEN
       iInit = 1: EXIT DO
     END IF
   END IF
   IF ABS(TIMER - sTimeout) > .5 THEN
     iInit = 0: EXIT DO
   END IF
 LOOP

END SUB

SUB sbSpeakerOn (BYVAL iOn AS INTEGER)

  sbWait
  IF iOn THEN
    OUT iSbPort + &HC, &HD1
  ELSE
    OUT iSbPort + &HC, &HD3
  END IF

END SUB

SUB sbWait

  WAIT iSbPort + &HC, 128, 128

END SUB

DEFLNG L
SUB SetDma (lSeg AS LONG, lPtr AS LONG, lLength AS LONG)

  DEF SEG = lSeg
  IF PEEK(lPtr) <> ASC("*") THEN
    PRINT "Wrong buffer location"
  END IF

  lAddr = lSeg * 16& + lPtr
  lPage = lAddr \ 65536
  lAddr = lAddr AND &HFFFF&
  
  lLent = (lLength) - 1

  iSbDma2 = iSbDma + iSbDma
  OUT &HA, 4 + iSbDma
  OUT &HC, 0
  OUT &HB, &H58 + iSbDma
  
  OUT &HC, &H0
  OUT iSbDma2, (lAddr AND 255)
  OUT iSbDma2, ((lAddr \ 256) AND 255)
 
  OUT &HC, &H0
  OUT iSbDma2 + 1, (lLent AND 255)
  OUT iSbDma2 + 1, ((lLent \ 256) AND 255)

  SELECT CASE iSbDma
  CASE 0: OUT &H87, lPage
  CASE 1: OUT &H83, lPage
  CASE 2: OUT &H81, lPage
  CASE 3: OUT &H82, lPage
  END SELECT

  OUT &HA, iSbDma

END SUB

DEFINT I
DEFDBL D
SUB SetDmaNotify (pwSeg AS LONG, pwPtr AS LONG) STATIC
  
  DIM lOldSegPtr AS LONG, lNewIsr AS LONG
  DIM set(9) AS LONG, rst(5) AS LONG
  IntNum = 8 + iSbIrq
  IntMask = CINT(2 ^ (iSbIrq AND 7))
 
  IF pwSeg = 0 AND pwPtr = 0 THEN
    ' *** Restoring Old ISR ***
    IF rst(0) = 0 THEN
      rst(0) = &HEC8B60FA               'cli / pusha / mov bp,sp
      rst(1) = &H145E8B1E               'push ds / mov bx,[bp+14]
      rst(2) = &H25B417C5               'lds dx,[bx] / mov ah,25h
      rst(3) = &H21CD08B0 + iSbIrq * 256 'mov al,0Fh / int 21h
      rst(4) = &H90FB611F               'pop ds / popa
      rst(5) = &H2CA                    'retf 0002h
    END IF

    OUT &H21, INP(&H21) OR IntMask
    IF lOldSegPtr THEN
      DEF SEG = VARSEG(rst(0))
      CALL absolute(lOldSegPtr, VARPTR(rst(0)))
      lOldSegPtr = 0
    END IF

  ELSE

    OUT &H21, INP(&H21) OR IntMask
    IF lOldSegPtr THEN EXIT SUB

    ' *** Create ISR code ***
    Isr(0) = &H681E60FA          'cli / pusha / push ds / ...
    Isr(1) = pwSeg + &H681F0000  'push 0000h / pop ds / ...
    Isr(2) = pwPtr + &HFE5B0000  'push 0000h / pop bx / ...
    Isr(3) = &H1F20B007          'inc [bx] / mov al,20h / pop ds
    Isr(4) = &HFB6120E6          'out 20,al / popa / sti
    Isr(5) = &HCF                'iret
   
    ' *** Set New ISR ***
    IF set(0) = 0 THEN
      set(0) = &H60EC8B55                 'push bp / mov bp,sp / pusha
      set(1) = &H3508B806 + iSbIrq * 65536 'push es / mov ax,350Fh
      set(2) = &HC28C21CD                 'int 21h / mov dx,es
      set(3) = &H8768B07                  'pop es / mov si,[bp+08]
      set(4) = &H1E025489                 'mov [si+02],dx / push ds
      set(5) = &H25B41C89                 'mov [si],bx / mov ah,25
      set(6) = &HFA065E8B                 'mov bx,[bp+06] / cli
      set(7) = &H21CD17C5                 'lds dx,[bx] / int 21h
      set(8) = &H905D611F                 'pop ds / popa / pop bp
      set(9) = &H2CAFB                    'sti / retf 0002h
    END IF
   
    lN = VARSEG(Isr(0)): DEF SEG = VARSEG(set(0))
    IF lN = &H8000 THEN lN = -2147483647 ELSE lN = (lN * 65536) + 1
    lNewIsr = lN + u(VARPTR(Isr(0))) - 1
    CALL absolute(lOldSegPtr, lNewIsr, VARPTR(set(0)))
    OUT &H21, INP(&H21) AND ((NOT IntMask) AND 255)
   
  END IF

END SUB

DEFSTR A-C, E, G-H, J-K, M-Z
SUB SoundInit
  tBuff.part0 = "*": tBuff.part1 = "*": tBuff.part2 = "*": tBuff.part3 = "*"

  'code to convert 16bit samples to 8bit
  l16to8(0) = &HDC8B071E 'push ds | pop es | mov bx,sp
  l16to8(1) = &H8B06778B 'mov si,[bx+06]
  l16to8(2) = &H748B047F 'mov di,[bx+04] | mov si,[si+02]
  l16to8(3) = &H27D8B02  'mov di,[di+02]
  l16to8(4) = &H460000B9 'mov cx,0?00 | inc si | lodsw
  l16to8(5) = &HAA8004AD 'add al,80 | stosb
  l16to8(6) = &H4CAFAE2  'loop #-3 | retf 4
  l16to8(4) = l16to8(4) + (SoundBufferPages * 65536)

  lSeg = u((VARSEG(tBuff.part0)))
  lPtr = u((VARPTR(tBuff.part0)))
  lChk = lSeg * 16 + lPtr
  iBasePart = ((lChk AND &HFFFF) > (65535 - 4096)) AND 2
  IF iBasePart THEN lSeg = lSeg + (SoundBufferSize \ 8)

  sbDetect
  sbReset
  IF iInit = 0 THEN
    PRINT "Failed to init Sound Blaster": END
  END IF
  SetDma lSeg, lPtr, (SoundBufferSize2)

END SUB

SUB SoundStop
  IF tWave.iFN THEN CLOSE #tWave.iFN: tWave.iFN = 0
  IF iInit THEN
    IF iFlag THEN iFlag = 0: sbIntAck8
    SetDmaNotify 0, 0
    sbSpeakerOn 0
    : sbReset: iInit = 0
  END IF
END SUB

FUNCTION SoundUpdate%
  'get playing block
  SoundUpdate% = 0
  IF iInit = 0 THEN EXIT FUNCTION
  'iCurBlk = INP(iSbDma + iSbDma + 1) 'we dont care for the low byte
  'iCurBlk = (INP(iSbDma + iSbDma + 1) \ SoundBufferPages)
  IF iFlag = 0 THEN SoundUpdate% = 1: EXIT FUNCTION
  WHILE iFlag > 0
    iFlag = iFlag - 1: sbIntAck8
    tWave.lPos = tWave.lPos + SoundBufferSize
    IF iBlksLeft < 0 THEN SoundStop: EXIT FUNCTION
    IF tWave.wBits = 8 THEN ReadBlock tWave.iFN, iBlock ELSE ReadBlock16 tWave.iFN, iBlock
    iBlock = iBlock XOR 1: iBlksLeft = iBlksLeft - 1
  WEND
  SoundUpdate% = 2
  
END FUNCTION

DEFLNG U
DEFSNG A-E, G-T, V-Z
FUNCTION u (iNum AS INTEGER)
  uu = CLNG(iNum) AND &HFFFF&
  u = uu
END FUNCTION

here is an explanation how to convert sound/music files to 8 bit wav with ffmpeg: https://techienotes.blog/2010/08/19/convert-cd-quality-wav-to-8bit-mono-wav-using-ffmpeg/

or to simply this command with ffmpeg

ffmpeg -i input.wav -ar 8000 -ac 1 -acodec pcm_u8 output.wav