'===========================================================================
' Subject: PB BACKGROUND WAV-PLAYER          Date: 08-19-00 (14:48)       
' Author:  Dieter Folger                     Code: PB                     
' Origin:  dfolger@ngi.de                  Packet: SOUND.ABC
'===========================================================================
'=============================================================================
' PBWAV.BAS - Plays Wave files (any length) in background with PowerBasic
' Based on DMAPLAY6.BAS (QBASIC) by Mike Huff (v1), Martin Rampersad (v2), 
' & Toshi Horie (v3-6)
' DMAPLAY6 is available at http://www.ocf.berkeley.edu/~horie/project.html
' The file selection menu was created by Alexander Podkolzin
'=============================================================================
TYPE WaveHeaderType
     RiffID           AS STRING * 4 'should be 'RIFF'
     RiffLength       AS LONG   'rept. chunk id and size then chunk data
     WavID            AS STRING * 4 'should be 'WAVE'
     FmtID            AS STRING * 4 'should be 'fmt '
     FmtLength        AS LONG
     wavFormatTag     AS WORD   ' format category: 0x0001=PCM
     Channels         AS WORD   ' number of Channels 1=mono 2=stereo
     SamplesPerSec    AS DWORD  ' sampling rate e.g. 44100Hz
     avgBytesPerSec   AS DWORD  ' to estimate buffer size
     BlockAlign       AS WORD   ' buffer size must be int. multiple of this
     FmtSpecific      AS WORD
     DataID           AS STRING * 4 'should be 'data'
     DataLength       AS LONG
END TYPE
TYPE wSoundType
     Stereo AS INTEGER
     Freq AS LONG
     StartPos AS LONG
     Length AS LONG
     Playtime AS DOUBLE
     SixteenBit AS INTEGER
END TYPE

DIM wSound AS wSoundType
'create 32K buffer
%BlockLen = 32760
DIM WavBuffer AS STRING * %BlockLen

' global variables
SHARED Baseport%, LenPort%, DMA%, DMA16%, CardVersion%
SHARED DSPVersion!, wSound, WavBuffer
Playerversion$ = " PBWAV "

' necessary for file select
DECLARE _
  FUNCTION ChFile(mask$,wt%,xb%,yb%,xe%,ye%,ct%,cb%,ctn%,cbn%) AS STRING
DECLARE _
  FUNCTION GetTextLine(txt$(),wt%,xb%,yb%,xe%,ye%,ct%,cb%,ctn%,cbn%,init%) _
  AS INTEGER
DECLARE SUB Numerer(nlines%,lpage%,begy%,endy%)
DECLARE SUB PutAttribute(x%,y%,t%,b%)
DECLARE SUB PutString(x%,y%,st$)
DECLARE SUB RestoreScreen(w$,xb%,yb%)
DECLARE SUB SaveScreen(w$,xb%,yb%,xe%,ye%,shadow%)
DECLARE SUB Win(t%,xb%,yb%,xe%,ye%,ct%,cb%)

'=== main program ===========================================================
CLS
COLOR 15,0
PRINT STRING$(80, 196);
PRINT Playerversion$; "for PowerBasic plays *.WAV files in background"
PRINT " Based on DMAPlay by Mike Huff, Martin Rampersad and Toshi Horie"
PRINT " Original QBASIC program can be downloaded from www.ocf.berkeley.edu/~horie"
Baseport% = &H220: IRQ% = 5: DMA% = 1: 'default
GetBLASTER ' Parses BLASTER environment
PRINT STRING$(80, 196)

SpeakerState 1
MasterVolume 12, 12, 0
VocVolume 12, 12, 0

DO
  F$ = ChFile("*.WAV",1,40,15,55,23,15,1,15,3) 'File selection menu
  COLOR 15,0
  IF LEN(F$) THEN
     LOCATE 22,1 : PRINT SPACE$(25);
     PlayWave F$
  END IF
  IF F$="" THEN EXIT LOOP
LOOP

DMAState 0: 'stop sound
Quit% = ResetDSP%
END Quit%
'=== end of main program =======================================================

'----------------
FUNCTION DMADone%
'----------------
CountLo% = INP(LenPort%)
CountHi% = INP(LenPort%)
IF CountHi% = 255 AND CountLo% = 255 THEN
   IF DMA16% THEN
      ack16% = INP(Baseport% + &HF) 'ack to SB
   ELSE
      ack% = INP(Baseport% + &HE)
   END IF
   DMADone% = -1
END IF
END FUNCTION
'-------------------------------------------------------
SUB DMAPlay (Segment&, Offset&, Length&, Freq&, Stereo%)
'-------------------------------------------------------
' 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
LengthLo% = Length& AND &HFF
LengthHi% = (Length& AND &HFF00&) \ &H100
IF Stereo% AND CardVersion% = 3 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 &HFF00&) \ &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%, LengthLo%: 'size of block to DMA controller -Low
OUT LenPort%, LengthHi%: 'high Byte
OUT &HA, DMA%: 'release DMA channel

TimeConst% = 256 - 1000000 \ Freq&

IF Freq& < 22728 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 CardVersion% > 2 THEN
      'high speed 8 bit output up to 44kHz mono or 22Khz stereo
      WriteDSP &H40:  'output sampling rate const
      WriteDSP TimeConst%
      WriteDSP &H48
      WriteDSP LengthLo%
      WriteDSP LengthHi%
      WriteDSP &H91
   ELSE
      PRINT "Current Frequency="; Freq&
      PRINT "You need a Sound Blaster Pro to play at 8 bit high speed.": END
   END IF
END IF
END SUB
'-----------------------------------------------------------------
SUB DMAPlay16 (Segment&, Offset&, L&, Freq&, Stereo%, sixteenbit%)
'-----------------------------------------------------------------
' Transfers and plays the contents of the buffer.
' Try only on a SoundBlaster 16 !!
' 1 Page=128K in 16 bit mode
' DMA16% (16-bit DMA channel) passed implicitly

IF CardVersion% < 4 THEN PRINT "You need an SB16 for this mode!": END
L& = L& - 1: Page% = 0
Addr& = Segment& * 16 + Offset&
IF SixteenBit% THEN
   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  : AddPort% = &HCC
               LenPort% = &HCE : ModeReg% = &H4B
          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 &HFF00&) \ &H100)

   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 &HFF00&) \ &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)
ELSE
   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
   LengthLo% = L& AND &HFF
   LengthHi% = (L& AND &HFF00&) \ &H100
   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 &HFF00&) \ &H100: 'high Byte
   Page% = (Addr& \ 65536) '64K Pages for 8bit output
   OUT PgPort%, Page%: 'output Page of phys. addr of sample block
   OUT LenPort%, LengthLo%: 'size of block to DMA controller -Low
   OUT LenPort%, LengthHi%: 'high Byte
   OUT &HA, DMA%: 'release DMA channel
END IF
FreqHi% = (Freq& AND &HFF00&) \ &H100
FreqLo% = Freq& AND &HFF
WriteDSP &H41: 'set output sampling rate
WriteDSP FreqHi%
WriteDSP FreqLo%
IF SixteenBit% THEN
   WriteDSP &HB0  '16 bit DAC, single cycle, FIFO off
ELSE
   WriteDSP &HC0  ' 8 bit DAC, single cycle, FIFO off
END IF
IF SixteenBit% THEN
   IF Stereo% 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
ELSE
   IF Stereo% THEN 'subtract 10h for unsigned
      WriteDSP &H20: '20h=Mode Byte for 8 bit unsigned stereo
   ELSE
      WriteDSP &H0:  '0h=Mode Byte for 8 bit unsigned mono
   END IF
END IF
WriteDSP LengthLo%
WriteDSP LengthHi%
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
Temp1% = ReadDSP%
Temp2% = ReadDSP%
Temp1$ = RTRIM$(LTRIM$(STR$(Temp1%)))
Temp2$ = RTRIM$(LTRIM$(STR$(Temp2%)))
IF LEN(Temp2$)=1 THEN Temp2$="0"+Temp2$
V$ = Temp1$+"."+Temp2$
DSPVersion! = VAL(V$)
 ' MODEL        VERSION
 ' SB 1.0       1.??  (1.05???, err=2.00)
 ' SB 1.5       1.??  (1.05???)
 ' SB 2.0       2.xx  (2.01)
 ' SB Pro       3.00  (???)
 ' SB Pro 2     3.01+ (3.01, 3.02)
 ' SB 16        4.0x  (4.04, 4.05)
 ' SB 16 SCSI-2 4.11  (4.11)
 ' SB AWE 32    4.12+ (4.12)
END FUNCTION
'-------------
SUB GetBLASTER
'-------------
' This subroutine parses the BLASTER environment string
' and returns the sound card settings
' implicitly using SHARED variables Baseport%, DMA%, DMA16%
Blaster$ = ENVIRON$("BLASTER")
IF LEN(Blaster$) = 0 THEN
   PRINT "BLASTER environment variable not set."
   INPUT "Would you like to try the defaults? <y/n>"; ck$
   IF ck$ = "Y" OR ck$ = "y" THEN
      Blaster$ = "A220 I5 D1 H5"
   ELSE
      PRINT "Goodbye."
      END
   END IF
ELSE
   FOR Index% = 1 TO LEN(Blaster$)
       SELECT CASE MID$(UCASE$(Blaster$), Index%, 1)
   	      CASE "A"
	          Baseport% = VAL("&H" + MID$(Blaster$, Index% + 1, 3))
	      CASE "I"
	          IRQ% = VAL(MID$(Blaster$, Index% + 1, 1))
     	      CASE "D"
	          DMA% = VAL(MID$(Blaster$, Index% + 1, 1))
	      CASE "H"
	          DMA16% = VAL(MID$(Blaster$, Index% + 1, 1))
       END SELECT
   NEXT
END IF
IF ResetDSP% = 0 THEN 'resets DSP (returns true if sucessful)
   PRINT "Sound card NOT found at " + HEX$(Baseport%) + "H."
   PRINT "Either your card is not SB-compatible or it is set up wrong."
   END
END IF
PRINT " Sound Card DSP version:";DSPVersion!
CardVersion% = INT(DSPVersion!)
END SUB
'--------------------------------
FUNCTION GetWaveInfo% (Filename$)
'--------------------------------
'PRE: Filename$ of sound file to parse
'POST: wSound fields set, file handle returned
'NOTE: only one valid sound block can be put in wSound.
'VARS: BlockAlign, chan

DIM Wave AS WaveHeaderType
Filename$=UCASE$(Filename$)
IF DIR$(Filename$) = "" THEN
   PRINT "Error: "; Filename$; " not found"
   END
END IF
ff = FREEFILE
OPEn Filename$ FOR BInARY as #ff
GET #ff,, Wave:
wSound.StartPos = 44
IF UCASE$(Wave.WavID) <> "WAVE" THEN PRINT "Not a Microsoft WAVE file.": END
IF Wave.wavFormatTag <> 1 THEN PRINT "Not in PCM (uncompressed) format.": END
wSound.Freq = Wave.SamplesPerSec
chan = Wave.Channels
SELECT CASE Wave.Channels
       CASE 2
	     wSound.Stereo% = 1
       CASE 1
	     wSound.Stereo% = 0
       CASE ELSE
	     wSound.Stereo = 0
END SELECT
  'assume no weird sampling rate like 9bit/sec
IF %BlockLen MOD Wave.BlockAlign THEN PRINT "Internal error: make %BlockLen=32752": END
IF Wave.FmtSpecific = 16 THEN wSound.SixteenBit = 1 ELSE wSound.SixteenBit = 0
IF UCASE$(Wave.DataID) <> "DATA" THEN
   PRINT Wave.DataID; " is not a Data chunk."
   INPUT "Would you like to play the file anyway (Y/N)?", yorn$
   IF INSTR(UCASE$(yorn$), "Y") THEN
      wSound.StartPos = SEEK(ff)
      wSound.Length = LOF(ff) - wSound.StartPos
      wSound.Freq = 22050
      'guess that big files are in 16-bit
      IF wSound.Length > 300000 THEN
         wSound.SixteenBit = 1
      ELSE
         wSound.SixteenBit = 0
      END IF
      wSound.Stereo = 0
      Chan = 1
      BlockAlign = (2 ^ wSound.SixteenBit) * chan
      wSound.playtime = wSound.Length / wSound.Freq / (wSound.SixteenBit + 1)
   ELSE
      PRINT "Goodbye"
      END
   END IF
ELSE 'we have a valid data block
   wSound.Length = Wave.DataLength
   wSound.playtime = wSound.Length / wSound.Freq / Wave.BlockAlign
   BlockAlign = Wave.BlockAlign
END IF

PRINT "Samples/sec:"; wSound.Freq
PRINT "Channels:"; Chan;
IF wSound.Stereo% = 1 THEN
   PRINT "(Stereo)"
ELSE
   PRINT "(mono)  "
END IF
PRINT "Block Align:"; BlockAlign
PRINT "Resolution:";
IF wSound.SixteenBit THEN PRINT " 16 ";  ELSE PRINT " 8 ";
PRINT "bits/sample "
PRINT "Data Length:";wSound.Length; "Bytes"
pmin = INT(wSound.playtime / 60)
psec = INT(wSound.playtime) MOD 60
IF pmin > 0 THEN
   PRINT USING "Play Length: ##:"; pmin;
   PRINT USING "##"; psec
ELSE
   PRINT USING "Play Length: ##.##s"; wSound.playtime
END IF

GetWaveInfo = ff
END FUNCTION
'-----------------------------------
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 MasterVolume (RightCh%, LeftCh%, Getvol%)
'--------------------------------------------
OUT Baseport% + 4, &H22
IF Getvol% THEN
   LeftCh% = INP(Baseport% + 5) \ 16
   RightCh% = INP(Baseport% + 5) AND &HF
   EXIT SUB
ELSE
   OUT Baseport% + 5, (RightCh% + LeftCh% * 16) AND &HFF
END IF
END SUB
'-----------------------
SUB PlayWave (Filename$)
'-----------------------
FileName$ = UCASE$(FileName$)
LOCATE 7, 54: PRINT "         "
LOCATE 7, 58: PRINT "cycles free"
LOCATE 9, 1: PRINT "Playing " + Filename$ + "           "

Freq& = 22000: 'default playback frequency
ff = GetWaveInfo(Filename$)

Freq& = wSound.Freq
Freq2& = Freq& * 2
Stereo% = wSound.Stereo
SixteenBit% = wSound.SixteenBit
StartPos% = wSound.StartPos

css28 = CardVersion% = 2 AND NOT SixteenBit% AND Stereo%  'on SB 2.0 8s->8mono
css2 = CardVersion% = 2 AND SixteenBit% AND Stereo%       'on SB 2.0 16s->8mono
css = CardVersion% = 3 AND SixteenBit% AND Stereo%        '16s->8stereo on SBPro
cmm = CardVersion% = 3 AND SixteenBit% AND NOT Stereo%    '16mono->8mono
cskip = CardVersion% <= 3 AND NOT SixteenBit% AND Stereo% 'skip one
Bseg% = VARSEG(WavBuffer): Boff% = VARPTR(WavBuffer)
Bseg& = int2ULong&(Bseg%): Boff& = int2ULong&(Boff%)
RLength& = wSound.Length&: 'RLength& is number of remaining Bytes
IF RLength& > (LOF(ff) - StartPos% + 1) THEN
   RLength& = LOF(ff) - StartPos% + 1
   LOCATE 20, 1:  PRINT "Warning: Truncated .WAV detected."
END IF

' fill buffer for the first time
GET #ff, StartPos%, WavBuffer 'fill first buffer
IF RLength& > %BlockLen THEN
   L& = %BlockLen
   L% = %BlockLen
ELSE
   L& = RLength&
   L% = CINT(RLength&)
END IF
IF css THEN Convert2 Bseg%, Boff&, L%
IF cskip OR cskip2 THEN Convert5 Bseg%, Boff%, L%
IF css2 THEN Convert6 Bseg%, Boff&, L%
IF css28 THEN Convert7 Bseg%, Boff&, L%
IF cmm THEN Convert4 Bseg%, Boff%, L%
t1# = TIMER
DO
   RLength& = RLength& - L& 'update remaining length
   '=========== play block in the background ======================
   LOCATE 7, 1 : COLOR 15,0
   IF SixteenBit% THEN
      SELECT CASE CardVersion%
	 CASE 4 'SB16, AWE32, AWE64?
	   PRINT "SB16 16bit mode"
           DMAPlay16 Bseg&, Boff&, L&, Freq&, Stereo%, SixteenBit%
	 CASE 3 'SBPro
	   IF Stereo% THEN
	      PRINT "SBPro Realtime stereo"
	      DMAPlay Bseg&, Boff&, L& \ 4, Freq&, Stereo%
	   ELSE 'mono 16 to 8 bit conversion
	      PRINT "SBPro Realtime mono"
	      DMAPlay Bseg&, Boff&, L& \ 2, Freq&, Stereo%
	   END IF
	 CASE 2 'SB 2.0
	   IF Stereo% THEN
	      PRINT "SB2.0 RT Stereo16"
	      DMAPlay Bseg&, Boff&, L& \ 16, Freq& \ 4, 0
	   ELSE
	      LOCATE 22, 1
	      PRINT "sb 2.0 44Khz 16bit stereo to 8bit mono not done."
	      END
	   END IF
	 CASE ELSE 'SB
	   PRINT "SB Realtime conversions from stereo to mono not supported.": END
      END SELECT
   ELSE   '8 bit
      IF Stereo% THEN
	 SELECT CASE CardVersion%
	   CASE 4
             LOCATE 7, 1: PRINT "SB16 8bit stereo"; Freq&; "Hz "
             DMAPlay16 Bseg&, Boff&, L&, Freq&, Stereo%, SixteenBit%
	   CASE 3
	     IF cskip THEN
		DMAPlay Bseg&, Boff&, L& \ 2, Freq&, Stereo%
	     ELSE
		DMAPlay Bseg&, Boff&, L&, Freq2&, Stereo%
	     END IF
	   CASE ELSE    'convert to sb2.0 8bit mono
	     PRINT "SBPro RT stereo8"
	     DMAPlay Bseg&, Boff&, L& \ 2, Freq& \ 2, 0
	 END SELECT
      ELSE 'mono 8-bit (no error checking)
	 SELECT CASE CardVersion%
	   CASE 4
             LOCATE 7, 1: PRINT "SB16 8bit mono"; Freq&; "Hz"
             DMAPlay16 Bseg&, Boff&, L&, Freq&, Stereo%, SixteenBit%
	   CASE IS <= 2
             LOCATE 7, 1: PRINT "SB mode"; Freq&; "Hz"
	     DMAPlay Bseg&, Boff&, L& \ 2, Freq& \ 2, Stereo%
	   CASE ELSE
	     DMAPlay Bseg&, Boff&, L&, Freq&, Stereo%
	 END SELECT
      END IF
   END IF
   'IF RLength& = 0 THEN EXIT DO

   '=== fill buffer ===============================================
   IF RLength& > %BlockLen THEN
      L& = %BlockLen
      L% = %BlockLen
   ELSE
      L& = RLength&
      L% = %BlockLen
   END IF
   GET #1, , WavBuffer
   'should be convertstereo!!
   IF css THEN Convert2 Bseg%, Boff&, L%
   IF cmm THEN Convert4 Bseg%, Boff%, L%
   IF css2 THEN Convert6 Bseg%, Boff&, L%
   IF css28 THEN Convert7 Bseg%, Boff&, L%
   IF (cskip OR cskip2) THEN Convert5 Bseg%, Boff%, L%
   '=== done filling buffer =======================================
   COLOR 15,0 : LOCATE 7, 39
   PRINT USING$("###", 100 - INT(RLength& / wSound.Length& * 100));:PRINT  " % done  "; Cycles%
   Cycles% = 0
   DO UNTIL DMADone%

   '====================================================
     ' now CPU is free to do graphics, etc.
     '
     INCR Count
     IF Count MOD 5000 = 0 THEN
        Count = 0
        INCR Col : IF Col = 16 THEN Col = 0
        COLOR Col,7 : LOCATE 9,35
        PRINT " Wave file playing in background ":
     END IF
     '
     '
   '====================================================

     IF Cycles% < 32767 THEN INCR Cycles%
     'Polling the Status/DMADone port too fast causes
     'jumpy sound - the print statement adds a delay :)
     LOCATE 7, 30 : COLOR 15,0
     PRINT USING "###.##s"; (TIMER - t1#)
     IF INKEY$ > "" THEN StopFlag = 1
   LOOP
   IF StopFlag THEN EXIT DO:  'stop here so it doesn't freeze the computer
LOOP UNTIL RLength& = 0
CLOSE #ff

COLOR 7, 0
LOCATE 22, 1: PRINT "DMA transfer completed!"
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
  INCR ct
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 0=off, 1=on.
IF OnOff% THEN WriteDSP &HD1 ELSE WriteDSP &HD3
END SUB
'-----------------------------------------
SUB VocVolume (RightCh%, LeftCh%, Getvol%)
'-----------------------------------------
OUT Baseport% + 4, &H4
IF Getvol% THEN
   LeftCh% = INP(Baseport% + 5) \ 16
   RightCh% = INP(Baseport% + 5) AND &HF
   EXIT SUB
ELSE
   OUT Baseport% + 5, (RightCh% + LeftCh% * 16) AND &HFF
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 Convert2 (Bseg%, Boff&, L%)
'------------------------------
locate 20,1: print "Convert2"
'converts 44kHz stereo to 22kHz stereo
DEF SEG = Bseg%
FOR i = 0 TO L% - 1 STEP 8
       'LEFT CHANNEL
    Addr& = i + Boff&
    HiByte% = PEEK(Addr& + 1)    'i+1
    POKE Boff% + i \ 4, HiByte% XOR &H80
       'RIGHT CHANNEL
    HiByte% = PEEK(Addr& + 3)    'i+4
    POKE Boff& + i \ 4 + 1, HiByte% XOR &H80
NEXT
END SUB
'------------------------------
SUB Convert3 (Bseg&, Boff&, L&)
'------------------------------
locate 20,1: print "Convert3"
'convert 16-bit 44kHz stereo to 8-bit 44 kHz mono for SBPro
FOR i = 0 TO L& - 1 STEP 4
    Addr& = i + Boff&
      'LeftCh=LeftCh>>2
    LeftLo% = PEEK(Addr&) \ 2
    LeftHi% = PEEK(Addr& + 1) \ 2
      'RightCh=RightCh>>2
    RightLo% = PEEK(Addr& + 2) \ 2
    RightHi% = PEEK(Addr& + 3) \ 2
    Mix& = LeftHi% * 256 + LeftLo%
    Mix& = Mix& + RightHi% * 256 + RightLo%
    Mixhi% = (Mix& AND &HFF00) \ &H100
    Mixlo% = (Mix& AND &HFF)
    POKE Boff& + i \ 4, MixLo%
    POKE Boff& + i \ 4 + 1, MixHi%
NEXT i
END SUB
'------------------------------
SUB Convert4 (Bseg%, Boff%, L%)
'------------------------------
locate 20,1: print "Convert4"
'convert 16-bit mono to 8-bit mono
DEF SEG = Bseg%
FOR i = 0 TO L% - 1 STEP 2
    Addr& = i + Boff%
    HiByte% = PEEK(Addr& + 1)    'i+1
    POKE Boff& + i \ 2, HiByte% + &H80
NEXT
END SUB
'------------------------------
SUB Convert5 (Bseg%, Boff%, L%)
'------------------------------
locate 20,1: print "Convert5"
'takes 0L 0R 1L 1R 2L 2R 3L 3R 4L 4R...
'   to 0L 0R 2L 2R 4L 4R...
DEF SEG = Bseg%
FOR i = 4 TO L% - 1 STEP 4
    vLeft = PEEK(i)
    vRight = PEEK(i + 1)
    POKE i \ 2, vLeft
    POKE i \ 2 + 1, vRight
NEXT i
END SUB
'------------------------------
SUB Convert6 (Bseg%, Boff&, L%)
'------------------------------
locate 20,1: print "Convert6"
'convert 16-bit 44khz stereo to 8-bit 11 kHz mono for SB2.0/1.0
DEF SEG = Bseg%
FOR i = 0 TO L% - 1 STEP 16
     'LEFT CHANNEL
    Addr& = i + Boff&
    HiByteL% = PEEK(Addr& + 1)    'i+1
    HiByteR% = PEEK(Addr& + 3)    'i+4
    v = ((HiByteR% XOR &H80) + (HiByteL% XOR &H80)) \ 2
    POKE Boff% + i \ 16, v
NEXT
END SUB
'------------------------------
SUB Convert7 (Bseg%, Boff&, L%)
'------------------------------
locate 20,1: print "Convert7"
'convert 8-bit 44khz stereo to 8-bit 11 kHz mono for SB2.0/1.0
DEF SEG = Bseg%
FOR i = 0 TO L% - 1 STEP 16
    Addr& = i + Boff&
    ByteL% = PEEK(Addr&)
    ByteR% = PEEK(Addr& + 1)
    v = (ByteR% + ByteL%) \ 2
    POKE Boff% + i \ 16, v
NEXT
END SUB
'------------------------------------------
SUB ConvertStereo (Freq&, Bseg%, Boff%, L%)
'------------------------------------------
locate 20,1: print "Convert stereo"
IF Freq& > 22050 THEN
   Convert2 Bseg%, Boff&, L%
ELSE
   'shouldn't need it unless using sb1.x-2.x
   'Convert2 Bseg%, Boff&, L%
END IF
END SUB
'----------
SUB Waitkey
'----------
 DO : K$ = INKEY$ : LOOP UNTIL LEN(K$)
 IF K$ = CHR$(27) THEN END
END SUB

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  FUNCTION ChFile(mask$, _
                  wint%, _            ' win type,
                  xb%,yb%,xe%,ye%, _  ' win's coordinates,
                  ct%,cb%, _          ' win's colors,
                  ctn%,cbn%) _        ' cursor bar colors.
           PUBLIC AS STRING
'
     DIM Names(512) AS STRING
'
     Curd$ = CURDIR$
     CALL SaveScreen(wsh$,xb%,yb%,xe%,ye%,1)
     k%=1
     DO
        Current% = 1
        IF LEN(CURDIR$)>3 THEN
           Names(1)=".."+" ]"
           INCR k%
        END IF
'
        f$=DIR$("*.*",55)         ' Looking for DIRs
        IF f$<>"" THEN
           IF (ATTRIB(f$)AND 16)=16 THEN
              Names(k%)=UCASE$(f$)+" ]"
              INCR k%
           END IF
           DO
              f$=DIR$
              IF f$="" THEN EXIT LOOP
              IF (ATTRIB(f$)AND 16)=16 THEN
                 Names(k%)=UCASE$(f$)+" ]"
                 INCR k%
              END IF
           LOOP
        END IF
        FOR i%=1 TO k%-1
           f$=Names(i%)
           l%=LEN(f$)
           IF l%<16 THEN
              REPLACE "]" WITH STRING$(14-l%," ")+"<DIR>" IN Names(i%)
           END IF
        NEXT i%
'
        nd% = k% - 1
'
        ARRAY SORT Names() FOR nd%
'
        m% = LEN(CURDIR$)
        IF m% = 3 THEN m% = 2
        n% = LEN(OldDir$) - m%
        IF INSTR(OldDir$,CURDIR$) <> 0 AND n% > 0 THEN
           s$ = RIGHT$(OldDir$,n% - 1)
           FOR i%=1 TO nd%
              IF s$ = RTRIM$(LEFT$(Names(i%),12)) THEN
                 Current% = i%
                 EXIT FOR
              END IF
           NEXT
        END IF
'
        f$=DIR$(mask$,7)            ' Looking for files
        IF f$<> "" THEN
           Names(k%)=LCASE$(f$)
           INCR k%
           DO
              f$=DIR$
              IF f$="" THEN EXIT LOOP
              Names(k%)=LCASE$(f$)
              INCR k%
           LOOP
        END IF
'
        ARRAY SORT Names(nd% + 1) FOR k% - nd% - 1
'
        k% = GetTextLine( Names(),wint%,xb%,yb%,xe%,ye%, _
                          ct%,cb%,ctn%,cbn%,Current% )
'
        IF k% < 0 THEN
           chfile$ = ""
           EXIT LOOP
        END IF
'
        IF k%=1 AND LEN(CURDIR$) > 3 THEN
           OldDir$ = CURDIR$
           CHDIR ".."
           REDIM Names(512) AS STRING
           k%=1
        ELSEIF INSTR(Names(k%),"<DIR>") THEN
           CHDIR REMOVE$(Names(k%),"<DIR>")
           REDIM Names(512) AS STRING
           k%=1
        ELSE
           c$ = CURDIR$
           IF LEN(c$)=3 THEN c$=LEFT$(c$,2)
           s$ = c$ + "\" + Names(k%)
           ChFile$ = s$
           EXIT LOOP
        END IF
'
     LOOP
'
     CALL RestoreScreen(wsh$,xb%,yb%)
     CHDIR Curd$
  END FUNCTION
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  FUNCTION GetTextLine%( txt$(), _' text array,
     twin%, _                     ' win's type,
     xb%, yb%, xe%, ye0%, _       ' win's coordinates,
     ct%,cb%, _                   ' win's colors,
     ctn%,cbn%, _                 ' cursor bar colors
     init% _                      ' initial position of cursor bar.
     ) _
     PUBLIC
'
     OldX% = POS(0)               ' Saving parameters
     OldY% = CSRLIN               '
     COLOR ct%,cb%                '
'
     Enter$=CHR$(13)              ' Only for beauty of our code,
     Esc$ = CHR$(27)              ' as it's rather difficult to
     Home$ = CHR$(0,71)           ' understand such lines as:
     PgUp$ = CHR$(0,73)           ' IF RIGHT$(s$,1) = "G" THEN ...
     EndKey$ = CHR$(0,79)         ' then:
     PgDn$ = CHR$(0,81)           ' IF s$ = Home$ THEN ...
     Up$ = CHR$(0,72)             '
     Down$ = CHR$(0,80)           '
'
     FOR i%=1 TO UBOUND(txt$())   ' max lines in text array
        IF LEN(txt$(i%))=0 THEN EXIT FOR
     NEXT i%
     nlines%=i%-1
     IF nlines%<ye0%-yb%-1 THEN
        ye%=yb%+nlines%+1
     ELSE
        ye%=ye0%
     END IF
     lpage%=ye%-yb%-1
     CALL win(twin%,xb%,yb%,xe%,ye%,ct%,cb%)
     begy%=init%
     Cur%=init% - begy% + 1
     endy%=MIN(lpage%,nlines%)
     DO                           ' begy% - first line to show,
        GOSUB ShowText            ' endy% - last line to show (array)
        GOSUB ShowCursorBar
        IF nlines%<1 THEN EXIT LOOP
        WHILE NOT INSTAT: WEND
        k$=INKEY$
        SELECT CASE k$
           CASE Esc$
              cur% = 0
              begy%= 0
              EXIT LOOP
           CASE Enter$
              EXIT LOOP
           CASE Home$
              GOSUB HideCursorBar
              Cur% =1
              begy%=1
           CASE EndKey$
              GOSUB HideCursorBar
              cur%=ye%-yb%-1
              begy%=Nlines%-ye%+yb%+2
           CASE Up$
              IF cur%>1 THEN
                 GOSUB HideCursorBar
                 DECR cur%
              ELSE
                 begy%=begy%-1
              END IF
           CASE Down$
              IF cur%<lpage% THEN
                 GOSUB HideCursorBar
                 INCR cur%
              ELSE
                 begy%=begy%+1
              END IF
           CASE PgUp$
              begy%=begy%-lpage%
           CASE PgDn$
              begy%=begy%+lpage%
           CASE ELSE
              k$=""
        END SELECT
     LOOP
     Gt%=begy%+cur%-1
     GetTextLine% = Gt%
     LOCATE oldy%,oldx%
     EXIT FUNCTION
'
'

ShowText:
     CALL Numerer(nlines%,lpage%,begy%,endy%)
     GOSUB MakeRuler
     FOR i%=begy% TO endy%
        PutString xb%+2,yb%+i%-begy%+1,_
        LEFT$(txt$(i%)+SPACE$(xe%-xb%+1),xe%-xb%-3)
     NEXT i%
     RETURN
'
'

ShowCursorBar:
     FOR i%=xb%+1 TO xe%-1
        PutAttribute i%,yb%+cur%,ctn%,cbn%
     NEXT
     RETURN
'
'

HideCursorBar:
     FOR i%=xb%+1 TO xe%-1
        PutAttribute i%,yb%+cur%,ct%,cb%
     NEXT
     RETURN
'
'

MakeRuler:
     FOR i%=yb%+1 TO ye%-1
        PutAttribute xe%,i%,ct%,cb%
        PutString xe%,i%,CHR$(177)
     NEXT
     k%=((begy%+cur%-1)/nlines%)*(ye%-yb%-1)
     IF k%=0 THEN k%=1
     PutString xe%,yb%+k%,CHR$(8)
     RETURN
  END FUNCTION
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Numerer "normalizes" begy% and endy%        <-  very usefull function!
'
  SUB Numerer(nlines%,lpage%,begy%,endy%)
     IF nlines%<=lpage% THEN
        begy%=1
        endy%=nlines%
        EXIT SUB
     END IF
     IF begy%<1 THEN
        begy%=1
        endy%=begy%+lpage%-1
        EXIT SUB
     END IF
     IF begy%+lpage%-1>=nlines% THEN
        endy%=nlines%
        begy%=nlines%-lpage%+1
        EXIT SUB
     END IF
     endy%=begy%+lpage%-1
  END SUB
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  SUB Win(t%,xb%,yb%,xe%,ye%,ct%,cb%)
'
     OldColor% = PBVSCRNTXTATTR   ' Internal PB variable
     SELECT CASE t%               ' Window types
'                                 ' (you can make as much types,
'                                 ' as you want).
        CASE 1
           a%=218:b%=196:c%=191   ' Single frame,
           h%=179:      :d%=179   '
           g%=192:f%=196:e%=217   '
        CASE 2
           a%=201:b%=205:c%=187   ' double frame,
           h%=186:      :d%=186   '
           g%=200:f%=205:e%=188   '
        CASE ELSE
           a%=032:b%= a%:c%= a%   '
           h%= a%:      :d%= a%   ' blanks only.
           g%= a%:f%= a%:e%= a%   '
     END SELECT
     COLOR ct%,cb%
     LOCATE yb%,xb% : PRINT CHR$(a%)+REPEAT$(xe%-xb%-1,CHR$(b%))+CHR$(c%)
     FOR i%=yb%+1 TO ye%-1
        LOCATE i%,xb% : PRINT CHR$(h%)+ SPACE$(xe%-xb%-1) +CHR$(d%)
     NEXT
     LOCATE ye%,xb% : PRINT CHR$(g%)+REPEAT$(xe%-xb%-1,CHR$(f%))+CHR$(e%)
     FOR i%=yb%+1 TO ye%+1
        PutAttribute xe%+1,i%,8,0 ' Making
     NEXT                         ' shadows
     FOR i%=xb%+1 TO xe%+1        '
        PutAttribute i%,ye%+1,8,0
     NEXT
     ct%=OldColor% AND 15         ' restore colors
     cb%=OldColor%\16
     COLOR ct%,cb%
     LOCATE yb%,xb% + 1 : PRINT " Select file ";
     LOCATE ye%,xb% + 3 : PRINT " Esc = End ";
  END SUB
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  SUB PutAttribute(x%,y%,t%,b%)   ' Puts attribute byte to video memory
     DIM Cell AS BYTE PTR
     Cell = PBVSCRNBUFF + (y% - 1)*160 + (x% - 1)*2 + 1
     @Cell = b%*16 + t%
  END SUB
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  SUB PutString(x%,y%,st$)        ' Puts string to video memory
     DIM Cell AS BYTE PTR
     DIM TextPtr AS BYTE PTR
'
     TextPtr = STRPTR32( st$ )
     Cell = PBVSCRNBUFF + ( y% - 1 ) * 160 + ( x% - 1 ) * 2
     FOR i% = 1 TO LEN( st$ )
        @Cell = @TextPtr
        INCR TextPtr
        INCR Cell, 2
     NEXT
  END SUB
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  SUB SaveScreen(w$,xb%,yb%,xe%,ye%,sh%)
     DIM temp AS BYTE PTR
     DIM WinPtr AS BYTE PTR
     DIM TextPtr AS BYTE PTR
     lx% = (xe% - xb% + 1) * 2
     ly% = ye% - yb% + 1
     IF sh% THEN
        INCR lx%,2
        INCR ly%
     END IF
     l$ = RIGHT$(" " + STR$(lx%), 3 )
     w$ = l$ + SPACE$( lx% * ly% )
     WinPtr = PBVSCRNBUFF + (yb%-1)*160 + (xb%-1)*2
     TextPtr = STRPTR32(w$) + 3
     FOR i%=1 TO ly%
        temp = WinPtr
        FOR k%=1 TO lx%
           @TextPtr = @temp
           INCR TextPtr
           INCR temp
        NEXT
        INCR WinPtr,160
     NEXT
  END SUB
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  SUB RestoreScreen(w$,xb%,yb%)
     DIM temp AS BYTE PTR
     DIM WinPtr AS BYTE PTR
     DIM TextPtr AS BYTE PTR
     l$ = LEFT$(w$,3)
     w$ = LTRIM$(w$,l$)
     lx% = VAL(l$)
     ly% = LEN(w$) \ lx%
     TextPtr = STRPTR32(w$)
     WinPtr = PBVSCRNBUFF + (yb%-1)*160 + (xb%-1)*2
     FOR i%=1 TO ly%
        temp = WinPtr
        FOR k%=1 TO lx%
           @temp = @TextPtr
           INCR TextPtr
           INCR temp
        NEXT
        INCR WinPtr,160
     NEXT
'   w$ = ""
  END SUB
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'