News:

Welcome to RetroCoders Community

Main Menu

SOUND LIB For FreeBASIC For DOS

Started by ron77, Feb 24, 2024, 04:28 PM

Previous topic - Next topic
Print
Go Down Pages1
User actions

ron77

Feb 24, 2024, 04:28 PM
hello I would like to upload here mysoft library for playing sound in DOS/DOSBOX for freebasic

first here is the code of the library:

#include "fbgfx.bi"
#include "crt.bi"

const PitFreq = 1193182
const LptPort = &h378
const SbPort = &h220
const order = 2

'------------ needed for soundblaster ----------
#include "dos\dpmi.bi"
#include "dos\go32.bi"
dim shared as long g_SbPort=&h220,g_SbIrq=7,g_SbDma=1,g_sbFreq=11025,g_sbChan=1,g_sbBits=8
dim shared as long g_sbSelector,g_sbBuffPtr,g_sbWritePos,g_sbBuffAmount,g_sbBuffSize
dim shared as long g_sbSampleClock
dim shared as ushort g_sbDmaPrevPos
dim shared as any ptr g_pPlayingWav
static shared as ubyte g_sbLoadBuff(65535)
'-----------------------------------------------

#undef wait
sub Wait(wPort as ushort,bAndVal as ubyte,bXorVal as ubyte=0) 'reimplement wait
  asm
    mov dx,[wPort]
    0:
      in al,dx
      and al,[bAndVal]
      xor al,[bXorVal]
    jz 0b
  end asm
end sub
'------------- regular SOUND command (over pcspeaker) ------------
sub Sound( fFreq as single , fDuration as single , bKeepOn as byte = 0 )    
  out &h43, &b10110110 'cnt 2 | LSB+MSB | squarewave | binary
  dim as long iFreq = PitFreq/fFreq  
  if iFreq>65535 then iFreq=65536 else if iFreq<0 then iFreq=0
  iFreq = (iFreq+1) and 65535  
  out &H42, (iFreq and 255)
  out &H42, (iFreq shr 8)    
  out &H61, inp(&H61) or 3
  dim as long iDuration = fDuration*(60/(PitFreq/65536))  
  if fDuration=0 then iDuration=0 else if iDuration < 1 then iDuration = 1
  for iL as long = 0 to iDuration-1
    wait &h3DA,8 : wait &h3DA,8,8
  next iL
  if bKeepOn=0 then out &H61, inp(&H61) and (not 1)
end sub

'------------------- wave loading function -----------------------
type fwd_WaveFile as WaveFile
type WaveFile
  iMagic     as long
  iFile      as ubyte
  bSampleSz  as byte
  iStartOff  as ushort  
  iChan      as byte
  iBits      as byte
  bPlaying:1 as byte
  bEndPad:1  as byte
  bLoop:1    as ubyte
  iFreq      as long
  iSize      as ulong  
  iPos       as ulong
  iFreqDelta as ulong
  pConvFunc  as function (as ulong,as any ptr, as long, as fwd_WaveFile ptr) as long
end type
function LoadWav( sFile as string , bStream as byte=0 ) as WaveFile ptr
  var f = freefile(), iOff=4  
  if open(sFile for binary access read as #f) then return 0
  dim as ubyte uHeader(255)
  get #f,,uheader()
  #define u4(_off) *cptr( ulong ptr , @uHeader(_off))
  #define u2(_off) *cptr( ushort ptr , @uHeader(_off))
  #macro LocateChunk( _C4 )
  for iOff = iOff to 255 
    if u4(iOff) = cvl(_C4) then exit for 
  next iOff
  #endmacro
  if u4(0) <> cvl("RIFF") then print "Not a .wav file": close #f: return 0
  LocateChunk("WAVE")  
  if iOff >= 255 then print "Not a .wav file": close #f:return 0
  LocateChunk("fmt ")  
  if iOff >= 255 orelse u2(iOff+8)<>1 then print "Not a PCM .wav file": close #f:return 0
  var iChan = u2(iOff+10) , iFreq = u4(iOff+12) , iBits = u2(iOff+22)
  if iChan<>1 and iChan<>2 then print "Unsupported channel amount": close #f:return 0
  if iFreq<3500 or iFreq>48000 then print "Unsupported frequency": close #f:return 0
  if iBits<>8 and iBits<>16 then print "Unsupported bits per sample": close #f:return 0
  LocateChunk("data")
  if iOff >= 255 then print "no playable data": close #f:return 0
  var iSize = u4(iOff+4)   
  dim as WaveFile ptr pWave = callocate(sizeof(WaveFile)+iif(bStream,16,iSize+16))
  with *pWave
    .iMagic = cvl("pWAV")
    .iChan = iChan : .iBits = iBits
    .iFreq = iFreq : .iSize = iSize
    .iFile = iif(bStream,f,0)
    .bSampleSz = (iChan*iBits)\8
  end with
  if bStream then
    pWave->iStartOff = iOff+9
    seek #pWave->iFile,pWave->iStartOff
  else
    get #f,iOff+9,*cptr(ubyte ptr,pWave+1),iSize  
    close #f
  end if
  return pWave
end function  
sub FreeWav( pWav as WaveFile ptr )
  if pWav=0 then exit sub
  if pWav->iMagic <> cvl("pWAV") then exit sub
  if pWav->iFile then close #pWav->iFile
  deallocate(pWav)
end sub

'-------------------------- soundblaster DMA play ----------------------------
'------------ background play that must be updated periodically --------------
function SbReset() as long 'reset DSP
  dim as integer iTimeout
  out g_SbPort+&h6,1  
  sleep 1,1
  out g_SbPort+&h6,0
  while inp(g_SbPort+&hA)<>&hAA 
    sleep 1,1    
    iTimeout += 1 : if iTimeout>60 then return 0
  wend
  g_sbBuffAmount = 0
  return 1
end function
sub SbCleanup() destructor
  SbReset()
  if g_sbSelector then __dpmi_free_dos_memory(g_sbSelector)
  g_sbSelector = 0
end sub  
function SbInit(iFrequency as long = 11025, iBufferMS as ulong = 50 ) as long
  var sConf = environ("BLASTER"), pConf = cptr(zstring ptr,strptr(sConf))  
  if len(sConf)=0 then print "Warning: BLASTER environment variable not found!"
  do
    select case (*pConf)[0] and (not 32)    
    case asc("A"),asc("I"),asc("D"),asc("H"),asc("M"),asc("P")
      var iValue = valint("&h"+pConf[1])
      select case (*pConf)[0]
      case asc("A"): g_SbPort = iValue
      case asc("I"): g_SbIrq  = 7 'iValue
      case asc("D"): g_SbDma  = iValue
      end select
      do : pConf += 1 : loop while ((*pConf)[0] and (not 32))<>0
      continue do
    case else: if *pConf=0 then exit do
    end select
    pConf += 1
  loop
  g_sbFreq = iFrequency : g_sbBuffSize = (iFrequency*iBufferMS)\1000
  if g_sbBuffSize > 32767 then g_sbBuffSize = 32767
  g_sbBuffPtr = __dpmi_allocate_dos_memory(128*64,@g_sbSelector)      
  if g_sbSelector<=0 then print "failed to allocate sound buffer": return 0  
  g_sbBuffPtr = ((g_sbBuffPtr*16)+65535) and (not 65535) 'align to 64kb

  return SbReset()<>0  
end function
function SbGetBufferedSamples() as long
  inp(g_SbPort+&hE)
  if g_sbBuffAmount then
    dim as ushort uNewPos = any, uHigh
    for N as long = 0 to 1
      out &h0C,-1           'reset flip-flop
      uNewPos = inp(g_SbDma*2)
      uHigh = inp(g_SbDma*2)      
      if uHigh = (g_sbDmaPrevPos shr 8) then exit for
    next N
    uNewPos += uHigh*256
    var uDiff = cushort(uNewPos-g_sbDmaPrevPos)
    g_sbSampleClock += uDiff : g_sbBuffAmount -= uDiff
    g_sbDmaPrevPos = uNewPos
    if g_sbBuffAmount<0 then g_sbBuffAmount=0
  end if
  return g_sbBuffAmount
end function
function Write8_NoConversion( pOut as ulong , pIn as any ptr , iSamples as long , pWav as WaveFile ptr )  as long
  asm
    mov edi,[pOut]  
    mov esi,[pIn]    
    push es  
    push gs
    pop es  
    mov ecx,[iSamples]
    rep movsb      
    pop es  
  end asm
  return iSamples
end function
function Write8_Bits16To8( pOut as ulong , pIn as any ptr , iSamples as long , pWav as WaveFile ptr )  as long
  asm
    mov edi,[pOut]  
    mov esi,[pIn]    
    push es  
    push gs
    pop es  
    mov ecx,[iSamples]
    0:
      mov al,[esi+1]
      add esi, 2      
      add al, 0x80      
      dec ecx
      stosb
    jnz 0b
    pop es
  end asm
  return iSamples
end function
function Write8_StereoToMono( pOut as ulong , pIn as any ptr , iSamples as long , pWav as WaveFile ptr )  as long
  asm
    mov edi,[pOut]  
    mov esi,[pIn]    
    push es  
    push gs
    pop es  
    mov ecx,[iSamples]
    0:
      lodsw
      add al,ah
      rcr al, 1
      dec ecx      
      stosb
    jnz 0b
    pop es  
  end asm
  return iSamples
end function
function Write8_Stereo16ToMono8( pOut as ulong , pIn as any ptr , iSamples as long , pWav as WaveFile ptr )  as long
  asm
    mov edi,[pOut]  
    mov esi,[pIn]    
    push es  
    push gs
    pop es  
    mov ecx,[iSamples]
    0:      
      mov al,[esi+1]
      mov ah,[esi+3]
      add esi, 4
      xor eax,0x8080
      add al,ah
      rcr al,1      
      dec ecx      
      stosb
    jnz 0b
    pop es  
  end asm
  return iSamples
end function
function Write8_FreqConv( pOut as ulong , pIn as any ptr , iSamples as long , pWav as WaveFile ptr )  as long  
  const Wav_iFreqDelta = offsetof(WaveFile,iFreqDelta)
  const Wav_iFreq      = offsetof(WaveFile,iFreq)
  asm
    mov ebx,[pWav]    
    mov edx,[ebx+Wav_iFreqDelta]    
    mov ebx,[ebx+Wav_iFreq]
    mov edi,[pOut]  
    mov esi,[pIn]     
    push es  
    push gs
    pop es  
    mov ecx,[iSamples]
    push ebp
    mov ebp,[g_sbFreq]
    1:
    dec ecx
    js 2f
      mov al, [esi]
      stosb
      add edx,ebx
      0:      
        cmp edx,ebp
        jb 1b
        sub edx,ebp
        inc esi
      jmp 0b
    2:
    pop ebp    
    mov ebx,[pWav]
    mov [ebx+Wav_iFreqDelta], edx        
    pop es
    sub esi,[pIn]
    mov [function],esi    
    'shr esi,0
  end asm
end function
function Write8_Freq_16To8( pOut as ulong , pIn as any ptr , iSamples as long , pWav as WaveFile ptr )  as long
  const Wav_iFreqDelta = offsetof(WaveFile,iFreqDelta)
  const Wav_iFreq      = offsetof(WaveFile,iFreq)
  asm    
    mov ebx,[pWav]    
    mov edx,[ebx+Wav_iFreqDelta]    
    mov ebx,[ebx+Wav_iFreq]
    mov edi,[pOut]  
    mov esi,[pIn]     
    push es  
    push gs
    pop es  
    mov ecx,[iSamples]
    push ebp
    mov ebp,[g_sbFreq]
    1:
    dec ecx
    js 2f
      mov al,[esi+1]      
      xor al, 0x80
      stosb
      add edx,ebx
      0:      
        cmp edx,ebp
        jb 1b
        sub edx,ebp
        add esi,2
      jmp 0b
    2:
    pop ebp    
    mov ebx,[pWav]
    mov [ebx+Wav_iFreqDelta], edx        
    pop es
    sub esi,[pIn]
    shr esi,1
    mov [function],esi
  end asm
end function
function Write8_Freq_StereoToMono( pOut as ulong , pIn as any ptr , iSamples as long , pWav as WaveFile ptr )  as long
  const Wav_iFreqDelta = offsetof(WaveFile,iFreqDelta)
  const Wav_iFreq      = offsetof(WaveFile,iFreq)
  asm    
    mov ebx,[pWav]    
    mov edx,[ebx+Wav_iFreqDelta]    
    mov ebx,[ebx+Wav_iFreq]
    mov edi,[pOut]  
    mov esi,[pIn]     
    push es  
    push gs
    pop es  
    mov ecx,[iSamples]
    push ebp
    mov ebp,[g_sbFreq]
    1:
    dec ecx
    js 2f
      mov ax, [esi]      
      add al,ah
      rcr al, 1
      stosb
      add edx,ebx
      0:      
        cmp edx,ebp
        jb 1b
        sub edx,ebp
        add esi,2
      jmp 0b
    2:
    pop ebp    
    mov ebx,[pWav]
    mov [ebx+Wav_iFreqDelta], edx        
    pop es
    sub esi,[pIn]
    shr esi,1
    mov [function],esi
  end asm
end function
function Write8_Freq_Stereo16ToMono8( pOut as ulong , pIn as any ptr , iSamples as long , pWav as WaveFile ptr )  as long
  const Wav_iFreqDelta = offsetof(WaveFile,iFreqDelta)
  const Wav_iFreq      = offsetof(WaveFile,iFreq)
  asm    
    mov ebx,[pWav]    
    mov edx,[ebx+Wav_iFreqDelta]    
    mov ebx,[ebx+Wav_iFreq]
    mov edi,[pOut]  
    mov esi,[pIn]     
    push es  
    push gs
    pop es  
    mov ecx,[iSamples]
    push ebp
    mov ebp,[g_sbFreq]
    1:
    dec ecx
    js 2f
      mov al,[esi+1]
      mov ah,[esi+3]      
      xor eax,0x8080
      add al,ah
      rcr al,1
      stosb
      add edx,ebx
      0:      
        cmp edx,ebp
        jb 1b
        sub edx,ebp
        add esi,4
      jmp 0b
    2:
    pop ebp    
    mov ebx,[pWav]
    mov [ebx+Wav_iFreqDelta], edx        
    pop es
    sub esi,[pIn]
    shr esi,2
    mov [function],esi    
    
  end asm
end function
function SbWriteSilence( iSamples as long , iDummy as byte = 0 ) as long
  var sbBuffAmount = g_sbBuffAmount, sbWritePos = g_sbWritePos
  do
    if iSamples<=0 then return sbBuffAmount
    if sbBuffAmount=0 then sbWritePos=0
    var iMaxData = 65536-sbBuffAmount
    if iMaxData=0 then continue do
    var iBlock = 65536-sbWritePos
    if iBlock < iMaxData then iMaxData = iBlock
    if iMaxData > iSamples then iMaxData = iSamples
    
    asm
      mov edi,[g_sbBuffPtr]
      add edi,[g_sbWritePos]
      mov ecx,[iMaxData]
      mov al, 0x80
      push es
      push gs
      pop es
      rep stosb
      pop es
    end asm
    
    sbBuffAmount += iMaxData : iSamples -= iMaxData  
    sbWritePos = (sbWritePos+iMaxData) and 65535
    
  loop 
  if iDummy=0 then g_sbBuffAmount = sbBuffAmount : g_sbWritePos = sbWritePos
  return iSamples
end function

function SbWrite( pData as any ptr , iSamples as long , pWav as WaveFile ptr ) as long
  do
    if iSamples<=0 then return g_sbBuffAmount
    if g_sbBuffAmount=0 then g_sbWritePos=0
    var iMaxData = 65536-g_sbBuffAmount         
    if iMaxData=0 then print ".";: SbGetBufferedSamples(): continue do
    var iBlock = 65536-g_sbWritePos
    if iBlock < iMaxData then iMaxData = iBlock    
    var iMaxSamples = ((clngint(iSamples)*g_sbFreq)+(pWav->iFreq-1))\pWav->iFreq    
    'print iSamples,iMaxSamples,iMaxData
    if iMaxSamples > iMaxData then iMaxSamples = iMaxData        
    if iMaxSamples = 0 then iMaxSamples=1    
    var iSrcSamples = pWav->pConvFunc( g_sbBuffPtr+g_sbWritePos , pData , iMaxSamples , pWav )        
    'print iSrcSamples
    if g_sbBuffAmount=0 then
      'setup dma
      static as ushort DmaToPage(3) = {&h87,&h83,&h81,&h82}
      'asm cli
        out &h0A,g_SbDma or 4 'mask DMA
        out &h0C,-1           'reset flip-flop
        out g_SbDma*2, 0      'address is 0 (64kb aligned)
        out g_SbDma*2, 0
        out &h0C,-1           'reset flip-flop
        out g_SbDma*2+1, 255  'size is 65536 (&hFFFF+1)
        out g_SbDma*2+1, 255  '  
        out DmaToPage(g_SbDma), (g_sbBuffPtr shr 16) '64k page number
        out &h0B,g_SbDma or (2 shl 2) or (1 shl 4) or (2 shl 6) 'mode 2 (read) + auto + mode 2 (single DMA?)
        out &h0A,g_SbDma      'unmask DMA
      'asm sti
      
      #define WaitWrite() while inp(g_SbPort+&hC) and 128: wend
      
      'setup sound blaster
      var bTimeConstant = ((65536-(256000000\(1*g_sbFreq))) shr 8) and 255
      WaitWrite()
      Out g_SbPort+&hC,&hD1  'speaker ON
      WaitWrite()
      out g_SbPort+&hC,&h40  'frequency (time constant)
      WaitWrite()
      out g_SbPort+&hC,bTimeConstant
      WaitWrite()
      out g_SbPort+&hC,&h48  'Set DMA size 32767 for 32767
      WaitWrite()
      out g_SbPort+&hC,&hFF  'lo
      WaitWrite()
      out g_SbPort+&hC,&h7F  'hi
      WaitWrite()
      out g_SbPort+&hC,&h1C  '8bit Auto-init DMA mode output
    end if
    
    g_sbBuffAmount += iMaxSamples : iSamples -= iSrcSamples 
    pData += iSrcSamples*pWav->bSampleSz
    g_sbWritePos = (g_sbWritePos+iMaxSamples) and 65535
    
  loop
end function
function SbUpdate() as long
  #define pWav cptr(WaveFile ptr,g_pPlayingWav)
  
  if g_pPlayingWav=0 then return 0
  with *pWav
  
    var iSamSz = .bSampleSz, iLeft=(.iSize\iSamSz)-.iPos
    var iBuffered = SbGetBufferedSamples()
    if iLeft > 0 then
      
      var pSample = cptr(ubyte ptr,pWav+1)+.iPos*iSamSz
      if .iFile then pSample = @g_sbLoadBuff(0)
      
      var iMax = (g_sbBuffSize-iBuffered)
      if iMax>16384 then iMax=16384    
      iMax = (iMax*.iFreq)\g_sbFreq     
      if iMax>16384 then iMax=16384
      if iMax>iLeft then iMax=iLeft        
    
      if .iFile then 
        get #.iFile,,*pSample,iMax*iSamSz        
        *cptr(ulong ptr,pSample+iMax*iSamSz) = *cptr(ulong ptr,pSample+(iMax-1)*iSamSz)
      end if    
      iBuffered = SbWrite( pSample , iMax , pWav ) : .iPos += iMax
      iLeft=(.iSize\iSamSz)-.iPos
      if .bLoop andalso ((.iSize\iSamSz)-.iPos)=0 then
        .iPos = 0 : if .iFile then seek #.iFile , .iStartOff
        return SbUpdate()
      end if
    else    
      'var iSilenceAmount=g_sbFreq\30
      if .bEndPad=0 andalso iBuffered < g_sbBuffSize then 
        var iSilenceSz = g_sbBuffSize
        if (iBuffered+iSilenceSz) > 65535 then iSilenceSz = 65535-g_sbBuffSize
        SbWriteSilence(g_sbBuffSize,0): .bEndPad=1
      end if
      if iBuffered=0 then 
        .bPlaying=0 : g_pPlayingWav=0
        'g_sbWritePos = 0 : g_sbBuffAmount = 0
        SbReset()
      end if
    end if    
    return iBuffered
    
  end with
  
end function

function SbPlayWav(pWav as WaveFile ptr) as long
  if pWav=0 then return 0
  
  if pWav->iFreq = g_sbFreq then
    if pWav->iChan = g_sbChan then
      pWav->pConvFunc = iif(pWav->iBits = g_sbBits,@Write8_NoConversion,@Write8_Bits16To8)
    else
      pWav->pConvFunc = iif(pWav->iBits = g_sbBits,@Write8_StereoToMono,@Write8_Stereo16ToMono8)
    end if
  elseif pWav->iChan = g_sbChan then
      pWav->pConvFunc = iif(pWav->iBits = g_sbBits,@Write8_FreqConv,@Write8_Freq_16To8)
  else
    pWav->pConvFunc = iif(pWav->iBits = g_sbBits,@Write8_Freq_StereoToMono,@Write8_Freq_Stereo16ToMono8)
  end if
  
  pWav->iPos = 0   : pWav->iFreqDelta = 0
  pWav->bPlaying=1 : pWav->bEndPad = 0
  if pWav->iFile then seek #pWav->iFile,pWav->iStartOff
  g_pPlayingWav = pWav 
  
  if g_sbBuffAmount=0 then
    g_sbWritePos=0 : g_sbDmaPrevPos = 0
  end if
  
  
  
  return 1
end function

'---------- playing wave synchronously over different cards ------
'------------------ no interrupt being used at all ---------------
sub DssPlayWav( pWav as WaveFile ptr )
  if pWav=0 then exit sub
  var pSample = cptr(ubyte ptr,pWav+1)
  dim as integer iPos,iDelta,iNextChan,iNextSam=1,iAdd=0,iOutSam
  dim as integer iTimeout
  
  with *pWav
    if .iBits = 16 then iNextSam = 2 : iAdd = 128 : iPos += 1
    iNextChan = iNextSam : iNextSam *= .iChan
  
    'turn on
    out LptPort+2,inp(LptPort+2) and (not 8)
    
    'emit samples
    do
      iOutSam += 1 
      if iOutSam=350 then iOutSam=0:if multikey(1) then exit do      
      iTimeout=0
      while (inp(LptPort+1) and &h40): 
        iTimeout += 1: if iTimeout > 65535 then print "DSS timed out..": exit do
        wend    
      'wait LptPort+1,&h40,&h40 'wait for next sample
      if .iChan>1 then
        out LptPort, (cubyte((pSample[iPos]+iAdd))+cubyte((pSample[iPos+iNextChan]+iAdd))) shr 1
      else
        out LptPort, cubyte(pSample[iPos]+iAdd)
      end if      
      out LptPort+2,inp(LptPort+2) or 8
      out LptPort+2,inp(LptPort+2) and (not 8)
      iDelta += .iFreq
      while iDelta>7000 : iDelta -= 7000 : iPos += iNextSam : wend
    loop until iPos >= .iSize
    
    'turn off
    out LptPort+2,inp(LptPort+2) or 8
  end with
  
end sub
sub CovoxPlayWav( pWav as WaveFile ptr )
  if pWav=0 then exit sub
  var pSample = cptr(ubyte ptr,pWav+1)
  dim as integer iPos,iDelta,iNextChan,iNextSam=1,iAdd=0,iOutSam
  dim as ubyte bOld,bNew
  
  with *pWav
    if .iBits = 16 then iNextSam = 2 : iAdd = 128 : iPos += 1
    iNextChan = iNextSam : iNextSam *= .iChan
    
    'emit samples
    bOld = inp(&h40): inp(&h40)
    do      
      bNew = inp(&h40): inp(&h40)
      iDelta = iDelta+cubyte(bOld-bNew)*.iFreq
      bOld = bNew
      if iDelta >= (PitFreq*2) then        
        iOutSam += 1 : if iOutSam=512 then iOutSam=0:if multikey(1) then exit do      
        if .iChan>1 then
          out LptPort, (cubyte((pSample[iPos]+iAdd))+cubyte((pSample[iPos+iNextChan]+iAdd))) shr 1
        else
          out LptPort, cubyte(pSample[iPos]+iAdd)
        end if            
        do
          iDelta -= (PitFreq*2)
          iPos += iNextSam : if iPos >= .iSize then exit do,do
        loop while iDelta >= (PitFreq*2)
      end if
    loop
    
  end with
  
end sub
sub SbDacPlayWav( pWav as WaveFile ptr )
  if pWav=0 then exit sub
  var pSample = cptr(ubyte ptr,pWav+1)
  dim as integer iPos,iDelta,iNextChan,iNextSam=1,iAdd=0,iOutSam
  dim as integer iTimeout
  dim as ubyte bOld,bNew
  
  with *pWav
    if .iBits = 16 then iNextSam = 2 : iAdd = 128 : iPos += 1
    iNextChan = iNextSam : iNextSam *= .iChan
    
    'reset DSP
    out SbPort+&h6,1
    bOld = inp(&h40): inp(&h40)    
    bOld = inp(&h40): inp(&h40)    
    out SbPort+&h6,0
    while inp(SbPort+&hA)<>&hAA 
      bOld = inp(&h40): inp(&h40)    
      iOutSam += 1 : if iOutSam>4095 then print "Reset failed....": exit sub      
    wend
    
    'emit samples
    iTimeout=0
    while (inp(SbPort+&hC) and 128)
      iTimeout += 1: if iTimeout>65535 then print "Sound blaster timed out...": exit sub
    wend
    Out SbPort+&hC,&hD1 'speaker ON
    
    do      
      bNew = inp(&h40): inp(&h40)
      iDelta = iDelta+cubyte(bOld-bNew)*.iFreq
      bOld = bNew
      if iDelta >= (PitFreq*2) then        
        inp(SbPort+&hC) 'while inp(SbPort+&hC) and 128: wend
        Out SbPort+&hC,&h10 'immediate 8bit DAC
        inp(SbPort+&hC) 'while inp(SbPort+&hC) and 128: wend
        iOutSam += 1 : if iOutSam>=512 then iOutSam=0:if multikey(1) then exit do      
        if .iChan>1 then
          out SbPort+&hC, (cubyte((pSample[iPos]+iAdd))+cubyte((pSample[iPos+iNextChan]+iAdd))) shr 1
        else
          out SbPort+&hC, cubyte(pSample[iPos]+iAdd)
        end if                    
        do
          iDelta -= (PitFreq*2)
          iPos += iNextSam : if iPos >= .iSize then exit do,do
        loop while iDelta >= (PitFreq*2)
      end if
    loop
    iTimeout=0
    while (inp(SbPort+&hC) and 128)
      iTimeout += 1: if iTimeout>65535 then exit while
    wend
    Out SbPort+&hC,&hD3 'speaker OFF
  end with
  
end sub
sub SpeakerPWMPlayWav( pWav as WaveFile ptr )
  
  const PwmMult = 1, AudioFreq = 18643 'best frequency
  const SpkFreq = AudioFreq*PwmMult
  const PitFreqSpk = ((PitFreq+(SpkFreq\2))\SpkFreq)

  if pWav=0 then exit sub
  var pSample = cptr(ubyte ptr,pWav+1)
  dim as integer iPos,iNextChan,iNextSam=1,iAdd=0,iOutSam
  dim as integer iDelta,iDeltaTmr
  dim as ubyte bOld=any,bNew=any
  
  out &h61,inp(&h61) and 12 'disable speaker
  'reset counters...
  out &h43,160 '// 16bit counter, mode 0, MSB only, timer 2
	out &h42,0
	out &h43,144 '// 16bit counter, mode 0, LSB only, timer 2
	out &h42,0  
  out &h61, (inp(&h61) and 12) or 3 'enable speaker
  
  with *pWav
    if .iBits = 16 then iNextSam = 2 : iAdd = 128 : iPos += 1
    iNextChan = iNextSam : iNextSam *= .iChan
  
    'emit samples
    bOld = inp(&h40): inp(&h40) 
    const Pit2 = PitFreq*2
    do
      bNew = inp(&h40): inp(&h40)
      iDeltaTmr += cubyte(bOld-bNew)*AudioFreq : bOld = bNew
      if iDeltaTmr >= (Pit2) then
        iOutSam += 1 : if iOutSam=1024 then iOutSam=0:if multikey(1) then exit do                  
        dim as ubyte uSample = any
        if .iChan>1 then
          uSample = (cubyte((pSample[iPos]+iAdd))+cubyte((pSample[iPos+iNextChan]+iAdd))) shr 1
        else
          uSample = cubyte(pSample[iPos]+iAdd)
        end if        
        if uSample < 4 then uSample = 4 'prevent overflow
        'uSample = (128+uSample*7)\8
        var rate = (((cuint(uSample))*cuint(PitFreqSpk)) shr 8)' and 255
        out &h42,rate
        
        while iDeltaTmr >= (Pit2) : iDeltaTmr -= (Pit2)
          iDelta += .iFreq
          while iDelta >= AudioFreq : iDelta -= AudioFreq : iPos += iNextSam : wend
        wend
      end if
    loop until iPos >= .iSize
    
    'turn off
    out LptPort+2,inp(LptPort+2) or 8
  end with
  
end sub

'-----------------------------------------------------------------------------

You use is like so (example of usage)

#include "sound.bas"

'use 22khz 500ms buffering (maximum will be 32kb (which for 22khz is slight less than 1500ms)
'can pass -1 as buffering to get maximum buffer possible
if SbInit(22050,-1)=0 then color 12: print "Failed to Init soundblaster.": color 7: print " ";: end  

'can load a wav before the SbInit... to make it init with the same frequency as the .wav using pWav->iFreq
var pWav = LoadWav("roach1.wav",1) 'the ,1 part is to load as a background stream
print pWav->iFreq;"hz"

'maker it start to play
SbPlayWav(pWav) 'start playing it

'SbUpdate() must be called periodically
'otherwise buffer will get empty
while SbUpdate()
  print ".";
  sleep 100,1
  ' sleep 100
wend

print !"\ndone!";
FreeWav( pWav )

Now we turned it into a Library (libsound.a) with a header...

Here is the header code (sound.bi)

#ifndef __sound_bi__
#define __sound_bi__


#inclib "sound"

type fwd_WaveFile as WaveFile
type WaveFile
  iMagic     as long
  iFile      as ubyte
  bSampleSz  as byte
  iStartOff  as ushort  
  iChan      as byte
  iBits      as byte
  bPlaying:1 as byte
  bEndPad:1  as byte
  bLoop:1    as ubyte
  iFreq      as long
  iSize      as ulong  
  iPos       as ulong
  iFreqDelta as ulong
  pConvFunc  as function (as ulong,as any ptr, as long, as fwd_WaveFile ptr) as long
end type

declare sub PortWait alias "Wait" (wPort as ushort,bAndVal as ubyte,bXorVal as ubyte=0) 'reimplement wait
declare sub Sound( fFreq as single , fDuration as single , bKeepOn as byte = 0 )    

declare function LoadWav( sFile as string , bStream as byte=0 ) as WaveFile ptr
declare sub FreeWav( pWav as WaveFile ptr )

declare function SbInit(iFrequency as long = 11025, iBufferMS as ulong = 50 ) as long
declare function SbReset() as long
declare function SbGetBufferedSamples() as long
declare function SbWrite( pData as any ptr , iSamples as long , pWav as WaveFile ptr ) as long
declare function SbUpdate() as long
declare function SbPlayWav(pWav as WaveFile ptr) as long

declare sub DssPlayWav( pWav as WaveFile ptr )
declare sub CovoxPlayWav( pWav as WaveFile ptr )
declare sub SbDacPlayWav( pWav as WaveFile ptr , bNoReset as byte=0 )
declare sub SpeakerPWMPlayWav( pWav as WaveFile ptr )

#endif

Now you can add a LIBSOUND.A to freebasic\lib\dos and sound.bi to freebasic\inc, and now you can use it in all your projects and code with freebasic for DOS...

You cannot view this attachment.
Print
Go Up Pages1
User actions