dim as long iMoveAmount(5) = {8,5,9,6,5,7}
dim as long uCat(...) = { _
  &h00000000,&h00000000,&h000003FA,&h001FFC06,&h00E00001,&h01000139,&h06000126,&h7C03FFB0,&h887C007C,&h0F80000A,&h18000005,&h28000000,&h0C000000, _
  &h00000000,&h00000000,&h00000000,&h003F87C4,&h00C0783C,&h01000002,&h06000171,&hFA07FFCE,&h06380370,&h1DC0011C,&h08000103,&h30000180,&h000000C0, _
  &h00000000,&h0007C000,&h00183008,&h00600FBC,&h00C00042,&h01208011,&h0221602E,&h7C421F40,&h005C0540,&h002018E0,&h00101030,&h00201008,&h00000804, _
  &h00000000,&h0003C000,&h00083000,&h03F00C08,&h04100218,&h181201E4,&hE0091002,&h0005A03C,&h00036FC0,&h00035800,&h0001D800,&h00008800,&h00000C00, _
  &h00000000,&h00000000,&h3F0F8000,&h40F06020,&h401018E0,&h00200710,&h00200008,&h002020F0,&h0017FB00,&h00181400,&h00142800,&h00344000,&h001B0000, _
  &h70000000,&h0F000000,&h00E3C004,&h001C301E,&h00200EE1,&h00400101,&h0040001E,&h00438020,&h00847FD0,&h01380070,&h01400000,&h00A00000,&h00780000 _
}
 
const Scale = 3
dim as long iCatX = -50*Scale,iCatY=rnd*((100-13)*Scale)
screenres 160*Scale,100*Scale,8
 
do
  for I as long = 0 to ubound(uCat) step 13
   
    line(iCatX-10*Scale,iCatY+-1*Scale)-step(43*Scale,Scale),0,bf
    for N as long = 0 to 12
      line(iCatX-10*Scale,iCatY+N*Scale)-step(43*Scale,Scale),0,bf
      for K as long = 0 to 31
        if ((uCat(I+N) shr (31-K)) and 1) then circle(iCatX+K*Scale,iCatY+N*Scale),(Scale\2)+1,K+32,,,,f
      next K
    next N    
   
    sleep 80,1
   
    iCatX += iMoveAmount(I\13)*Scale
    if iCatX >= ((160+30)*Scale) then
      iCatX=-50*Scale : iCatY=rnd*(100-13*Scale)
    end if
     
   
  next I
loop
 
sleep
 

#include "fbgfx.bi"
 
dim as long iMoveAmount(5) = {8,5,9,6,5,7}
dim as ulong uCat(...) = { _
  &h00000000,&h00000000,&h000003FA,&h001FFC06,&h00E00001,&h01000139,&h06000126,&h7C03FFB0,&h887C007C,&h0F80000A,&h18000005,&h28000000,&h0C000000, _
  &h00000000,&h00000000,&h00000000,&h003F87C4,&h00C0783C,&h01000002,&h06000171,&hFA07FFCE,&h06380370,&h1DC0011C,&h08000103,&h30000180,&h000000C0, _
  &h00000000,&h0007C000,&h00183008,&h00600FBC,&h00C00042,&h01208011,&h0221602E,&h7C421F40,&h005C0540,&h002018E0,&h00101030,&h00201008,&h00000804, _
  &h00000000,&h0003C000,&h00083000,&h03F00C08,&h04100218,&h181201E4,&hE0091002,&h0005A03C,&h00036FC0,&h00035800,&h0001D800,&h00008800,&h00000C00, _
  &h00000000,&h00000000,&h3F0F8000,&h40F06020,&h401018E0,&h00200710,&h00200008,&h002020F0,&h0017FB00,&h00181400,&h00142800,&h00344000,&h001B0000, _
  &h70000000,&h0F000000,&h00E3C004,&h001C301E,&h00200EE1,&h00400101,&h0040001E,&h00438020,&h00847FD0,&h01380070,&h01400000,&h00A00000,&h00780000 _
}
 
dim as long iCatX = -50
 
'~ screen 13
screencontrol(fb.SET_GL_2D_MODE,fb.OGL_2D_MANUAL_SYNC)
screencontrol(fb.SET_GL_SCALE,3)
screenres 320,200,8,,fb.GFX_OPENGL

do
  for I as long = 0 to ubound(uCat) step 13
   
    for N as long = 0 to 12
      line(iCatX-10,N)-step(40,0),0
      line(iCatX+ 0,N)-step(15,0),15,,uCat(I+N) shr 16
      line(iCatX+16,N)-step(15,0),15,,uCat(I+N)  
    next N
   
    flip:sleep 80,1
    iCatX += iMoveAmount(I\13)
    if iCatX >= (320+30) then iCatX=-50
   
  next I
loop
 
sleep
 

#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

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

#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 )

#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