____    _    ____      ____  _____
' |  _ \  / \  / ___) __ | ___)(_   _)
' | |_)  / _ \ \____\/  \|  _)   | |
' |____//_/ \_\(____/\__/|_|     |_|
'    Reply to: d83@ath.forthnet.gr
'     www.basicguru.com/schullian
'

$if 0
  fSBplay%( FileSpec$, FileNo% )

  PARAMS:  FileSpec$  DRIVE:\PATH\FILENAME.WAV" of the file to play
                      NOTE: the file is opened and closed locally
           FileNo%    if > 0 then it is assumed that the file has
                      already been opened and positioned to the start
                      of the WAVE header.
                      NOTE: If FileNo% > 0 then FileSpec$ is ignored
                      and the file is left open upon exiting
  RETURN: -1 if entire file was played

  To test the routine you'll need to set the variable F$ to a file
  name. %Testing is currently set to -1 so that play can be interrupted
  at any time from the keyboard.

  The code for these routines was ported to PowerBASIC v3.5 from
  DMAPLAY5.BAS which was a project of Toshi Horie who, in turn, worked
  on others' code, etc. etc. I found the QB version in an ABC packet
  and have stripped it down to play only 8bit mono .WAV files. I did
  this for a number of reasons; most of what's gone I couldn't get to
  work correctly, I only need 8bit mono for my purposes, less code,
  and a few others.

  As I found the QB code in the ABC packets I release this PB version
  back to the same distribution point.
$endif

%Testing      = -1          ' set to 0 to make play unstoppable from keybrd
%DMAstateON   = &h00D4      ' not used
%DMAstateOFF  = &h00D0
%SpeakerOn    = &h00D1
%SpeakerOff   = &h00D3
%VersionCmd   = &h00E1
%MasterVolume = &h0022
%FMvolume     = &h0026      ' not used
%CDvolume     = &h0028      ' not used
%VOCvolume    = &h0004      ' not used
%MICvolume    = &h000A      ' not used
%LINEvolume   = &h002E      ' not used

'PUBLIC ROUTINES
  DECLARE FUNCTION fSBplay%      (BYVAL FileSpec$, BYVAL FileNo%)
  DECLARE FUNCTION fGetBLASTER%  ()
  DECLARE FUNCTION fGetSBvolume? (BYVAL Which%)
  DECLARE      SUB  SetSBvolume  (BYVAL Which%,BYVAL Volume?)

'PRIVATE STUFF
  DECLARE FUNCTION fReadDSP?     ()
  DECLARE FUNCTION fResetDSP%    ()
  DECLARE FUNCTION fDMADone%     (BYVAL Chunk%)
  DECLARE      SUB  WriteDSP     (BYVAL Cmd?)

TYPE WaveHeaderType
  RiffID         AS STRING * 4   ' should be 'RIFF'
  RiffLength     AS LONG         '
  WavID          AS STRING * 4   ' should be 'WAVE'
  FmtID          AS STRING * 4   '
  FmtLength      AS LONG         ' FMT chunk - common fields
  FormatTag      AS WORD         ' format category e.g. 0x0001=PCM
  Stereo         AS WORD         ' number of Channels 1=mono 2=stereo
  Freq           AS LONG         ' dword - sampling rate e.g. 44100Hz
  BytesPerSec    AS DWORD        ' dword - to estimate buffer size
  Blockalign     AS WORD         ' buffer size must be int. multiple of this
  BitsPer        AS INTEGER      ' either 8 (FALSE) or 16 (TRUE)
  DataID         AS STRING * 4   ' should be 'DATA'
  DataLength     AS DWORD        '
END TYPE

DIM sBasePort   AS SHARED INTEGER
DIM sWritePort  AS SHARED INTEGER
DIM sWaitPort   AS SHARED INTEGER
DIM sReadPort   AS SHARED INTEGER
DIM sResetPort  AS SHARED INTEGER
DIM sLenPort    AS SHARED INTEGER
DIM sPagePort   AS SHARED INTEGER
DIM sAddPort    AS SHARED INTEGER
DIM sVolumePort AS SHARED INTEGER
DIM sVolumeData AS SHARED INTEGER
DIM sModeReg    AS SHARED INTEGER
DIM sDRQ        AS SHARED INTEGER
DIM sSBversion  AS SHARED INTEGER
DIM sDMA        AS SHARED INTEGER

'-------------------------------------------------------------------------
'----------------------- test code ---------------------------------------|
'-------------------------------------------------------------------------|
DIM F AS STRING                       ' just using these 2 for the test   |
DIM X AS INTEGER                      '                                   |
                                      '                                   |
CLS                                   '                                   |
IF fGetBLASTER% = 0 THEN              ' this is called once to set        |
  PRINT "something went wrong!"       ' shared parameters, etc.           |
  BEEP                                '                                   |
  END                                 '                                   |
END IF                                '                                   |
PRINT "Smack a key to quit."          '                                   |
                                      '                                   |
F$ = "PBWAV.WAV"                      ' here we open the file and pass    |
OPEN "B", #1, F$                      ' only the file number              |
FOR X% = 0 TO 1                       ' we'll loop through the file twice |
  IF NOT fSBplay%( "", 1 ) THEN END   '  resetting the pointer to the     |
  DELAY .5                            '  beginning                        |
  SEEK #1, 0                          '                                   |
NEXT                                  '                                   |
CLOSE #1                              ' all done with this test           |
                                      '                                   |
F$ = "PBWAV.WAV"                      ' here we send only the file spec   |
IF NOT fSBplay%( F$, 0 ) THEN END     ' and let the routine open/close    |
DELAY .5                              ' the file                          |
                                      '                                   |
F$ = "FANFARE2.WAV"                   ' just another test file            |
fSBplay F$, 0                         '                                   |
                                      '                                   |
END                                   ' end of program                    |
'-------------------------------------------------------------------------|
'----------------------- end of test -------------------------------------|
'-------------------------------------------------------------------------

FUNCTION fSBplay (BYVAL FileSpec AS STRING, _
                  BYVAL FileNo   AS INTEGER ) LOCAL PUBLIC AS INTEGER

  DIM  Address    AS LOCAL LONG
  DIM  Addr(2)    AS LOCAL BYTE
  DIM  Chunk      AS LOCAL INTEGER
  DIM  ChunkHi    AS LOCAL BYTE
  DIM  ChunkLo    AS LOCAL BYTE
  DIM  LocalOpen  AS LOCAL INTEGER
  DIM  Timeing    AS LOCAL BYTE
  DIM  Volume     AS LOCAL BYTE
  DIM tWave       AS LOCAL WaveHeaderTYPE
  DIM  Buf(32763) AS LOCAL BYTE
  DIM  B_ptr      AS LOCAL STRING PTR * 32764

  ON LOCAL ERROR GOTO SBplayOOPS

  IF FileNo% = 0 THEN
    IF LEN(DIR$(FileSpec$)) = 0 THEN EXIT FUNCTION
    FileNo% = FREEFILE
    OPEN "B", #FileNo%, FileSpec$
    LocalOpen% = -1
  END IF
  GET #FileNo%, ,tWave

  IF UCASE$(tWave.RiffID)         <> "RIFF" THEN EXIT FUNCTION
  IF UCASE$(tWave.WavID )         <> "WAVE" THEN EXIT FUNCTION
  IF UCASE$(tWave.DataID)         <> "DATA" THEN EXIT FUNCTION
  IF tWave.FormatTag              <> 1      THEN EXIT FUNCTION
  IF tWave.Stereo                 <> 1      THEN EXIT FUNCTION
  IF tWave.BitsPer                <> 8      THEN EXIT FUNCTION
  IF tWave.DataLength              = 0      THEN EXIT FUNCTION
  IF (32764 MOD tWave.blockalign) <> 0      THEN EXIT FUNCTION

  B_ptr    = VARPTR32(Buf?(0))
  Address& = ( VARSEG(Buf?(0)) * 16 ) + VARPTR(Buf?(0))

  FOR Chunk% = 0 TO 2
    Addr?(Chunk%) = ( Address& AND &h00FF )
    SHIFT RIGHT Address&, 8
  NEXT

  Timeing? = 256 - ( 1000000 \ tWave.Freq )
  Chunk%   = 32764
  ChunkLo? = ( Chunk% AND &hFF ) - 1
  ChunkHi? = ( Chunk%  \  256  )

  WriteDSP %SpeakerOn
  DO
    IF tWave.DataLength < Chunk% THEN
      Chunk%   = tWave.DataLength
      ChunkLo? = ( Chunk% AND &hFF ) -1
      ChunkHi? = ( Chunk%  \  256  )
    END IF
    GET #FileNo%, , @B_ptr
    DECR tWave.DataLength, Chunk%
    OUT &h0A      , sDRQ%
    OUT &h0C      , &h00
    OUT &h0B      , sModeReg%
    OUT sAddPort% , Addr?(0)           'buffer address of sound data low byte
    OUT sAddPort% , Addr?(1)           'high byte
    OUT sPagePort%, Addr?(2)           'output page of phys. addr of sample block
    OUT sLenPort% , ChunkLo?           'size of block to DMA controller -Low
    OUT sLenPort% , ChunkHi?           'high byte
    OUT &h0A      , sDMA%              'release DMA channel
    WriteDSP &h40
    WriteDSP Timeing?
    IF tWave.Freq < 22728 THEN
        WriteDSP &h14                                 '8 bit output over DMA
        WriteDSP ChunkLo?
        WriteDSP ChunkHi?
      ELSEif sSBversion% = 3 THEN                     'high speed 8 bit up to 44kHz mono
        WriteDSP &h48
        WriteDSP ChunkLo?
        WriteDSP ChunkHi?
        WriteDSP &h91
    END IF
    WHILE NOT fDMADone%(Chunk%)
      $if %Testing
        IF INSTAT THEN
          WriteDSP %DMAstateOFF
          EXIT, EXIT
        END IF
      $endif
    WEND
  LOOP UNTIL tWave.DataLength = 0

  WriteDSP %SpeakerOFF
  fResetDSP
  FUNCTION = -1

  SBplayExit:
    IF LocalOpen% AND FILEATTR(FileNo%,0) THEN CLOSE #FileNo%
    EXIT FUNCTION

  SBplayOOPS:
    RESUME SBplayExit

END FUNCTION

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

FUNCTION fGetBLASTER () LOCAL PUBLIC AS INTEGER

  DIM Blaster AS LOCAL STRING
  DIM I       AS LOCAL INTEGER
  DIM Item    AS LOCAL STRING
  DIM P       AS LOCAL INTEGER

  Blaster$ = ENVIRON$("BLASTER")
  IF LEN(Blaster$) = 0 THEN EXIT FUNCTION

  Item$ = "AD"

  FOR I% = 1 TO 2
    P% = INSTR( Blaster$, MID$(Item$,I%,1) ) + 1
    IF P% = 1 THEN ITERATE
    SELECT CASE I%
      CASE 1 : sBasePort% = VAL("&h" + MID$(Blaster$, P%, 3))
      CASE 2 : sDMA%      = ASC( Blaster$, P% ) - 48
    END SELECT
  NEXT
  SELECT CASE sDMA%
    CASE 1    : sPagePort% = &h83
                sAddPort%  = &h2
                sLenPort%  = &h3
                sModeReg%  = &h49
    CASE 2    : sPagePort% = &h81
                sAddPort%  = &h4
                sLenPort%  = &h5
                sModeReg%  = &h4A
    CASE 3    : sPagePort% = &h82
                sAddPort%  = &h6
                sLenPort%  = &h7
                sModeReg%  = &h4B
    CASE ELSE : EXIT FUNCTION
  END SELECT

  sDRQ%        = sDMA%      + &h04
  sVolumePort% = sBasePort% + &h04
  sVolumeData% = sBasePort% + &h05
  sResetPort%  = sBasePort% + &h06
  sReadPort%   = sBasePort% + &h0A
  sWritePort%  = sBasePort% + &h0C
  sWaitPort%   = sBasePort% + &h0E

  IF fResetDSP% = 0 THEN EXIT FUNCTION

  WriteDSP %VersionCmd
  sSBversion% = fReadDSP?

  WriteDSP %SpeakerOff
  IF fGetSBvolume?( %MasterVolume ) = 0 THEN
    SetSBvolume %MasterVolume, &hCC
  END IF

  FUNCTION = -1

END FUNCTION

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

SUB WriteDSP (BYVAL Cmd AS BYTE) LOCAL PRIVATE

  DIM ByteIn AS LOCAL BYTE

  DO
    ByteIn? = INP(sWritePort%)
  LOOP WHILE ( ByteIn? AND &h80 )
  OUT sWritePort%, Cmd?

END SUB

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

FUNCTION fReadDSP () LOCAL PRIVATE AS BYTE

  DIM ByteIn AS LOCAL BYTE

  WAIT sWaitPort%, &h80                 'wait for bit 7 on pollport
  DO
    ByteIn? = INP(sReadPort%)
  LOOP UNTIL ByteIn? <> &hAA

  FUNCTION = ByteIn?

END FUNCTION

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

FUNCTION fResetDSP () LOCAL PRIVATE AS INTEGER

  DIM Count  AS LOCAL INTEGER
  DIM ByteIn AS LOCAL BYTE

  OUT sResetPort%, 1

  FOR Count% = 100 TO 1 STEP -1
    OUT sResetPort%, 0
    ByteIn? = INP(sWaitPort%)
    ByteIn? = INP(sReadPort%)
    IF ByteIn? = &hAA THEN EXIT FOR
  NEXT

  FUNCTION = Count%

END FUNCTION

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

FUNCTION fDMADone (BYVAL Chunk AS INTEGER) LOCAL PRIVATE AS INTEGER

  DIM Count AS LOCAL WORD
  DIM Hi    AS LOCAL INTEGER
  DIM Lo    AS LOCAL INTEGER

  lo% = INP(sLenPort%)
  hi% = INP(sLenPort%)
  count?? = (hi% * 256) + lo%

  FUNCTION = ( count?? => Chunk% )

END FUNCTION

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

SUB SetSBvolume (BYVAL Which  AS INTEGER, _
                 BYVAL Volume AS BYTE     ) LOCAL PUBLIC

  OUT sVolumePort%, Which%
  OUT sVolumeData%, Volume?

END SUB

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

FUNCTION fGetSBvolume (BYVAL Which AS INTEGER) LOCAL PUBLIC AS BYTE

  OUT sVolumePort%, %MasterVolume

  FUNCTION = INP(sVolumeData%)

  ' Lft?    = ( Volume?  \  &h10 )
  ' Rgt?    = ( Volume? AND &h0F )

END FUNCTION