'===========================================================================
' Subject: Wave Player                        Date: 06-16-02 (  :  )       
'  Author: /\/\ | |< 3                        Code: Qbasic,QB, PDS         
'  Origin: mstechcae@webcity.ca             Packet: SOUND.ABC
'===========================================================================
'=======================================================================
'  Subject/Title: WAVE PLAYER                  Date: 05-27-02
'         Author: /\/\ | |< 3                  Code: Text, QBasic, QB
'  Email address: mstechcae@webcity.ca	     Packet: Sound.abc
'=======================================================================
'==============================  Read this FIRST  
'Please note: This code shall NOT be related to money in any way. This 
'means
'borrowing code for a fee, buying it, selling it, and so on. This code 
'is for
'free. This code can be found at www.allbasiccode.com.
'Thank you for your understanding.
'=======================================================================
'==============================  Declarations  
'  These are added when the file is saved.                              
'=======================================================================
DECLARE SUB app ()
DECLARE SUB apphdr ()
DECLARE FUNCTION wavefile$ ()
DECLARE SUB main ()
DECLARE SUB unloadmus ()
DECLARE FUNCTION playmus% (f%)
DECLARE FUNCTION getsbinfo% ()
DECLARE FUNCTION loadmus% (flname$)

'==============================  Mainline  
' Reserved for statements that cant go anywhere else or that are 
'required
'                         everywhere in the program.
'=======================================================================
TYPE soundb             'Sound Block
port AS INTEGER         'Sound card Port.
sps AS LONG             'Samples Per Second.
dma AS INTEGER          'DMA channel (from 0 to 3)
END TYPE
DIM SHARED sb AS soundb 'needed to use the variables.

'-----------------------------------------------------------------------
'change the number to the memory you want to reserve for sound.
'in this case, 11050 bytes (about 11KB) are reserved. The higher the
'number, the faster the application. The lower the number, the more 
'memory
'there is available. Dont go under 4096 or you may get unpredictable 
'results.
DIM SHARED d AS STRING * 11050
'-----------------------------------------------------------------------

CALL main
END

SUB app
'=======================================================================
'sample application with sound
'=======================================================================
STATIC p%, np%
k$ = INKEY$
COLOR 7, 0: IF k$ = CHR$(27) THEN RESET: END
IF p% <= 1 THEN p% = 1
IF np% <= 1 THEN np% = 1
p% = SEEK(1) / LOF(1) * 79 + 1
IF p% <> np% THEN
COLOR 14, 0: LOCATE 12, np%: PRINT CHR$(SCREEN(12, np%))
COLOR 1, 7: LOCATE 12, p%: PRINT CHR$(SCREEN(12, p%))
COLOR 7, 0
np% = p%
END IF
END SUB

SUB apphdr
'=======================================================================
'part of the sound sample application. This isnt necessary for your 
programs.
'=======================================================================
CLS
COLOR 14
LOCATE 12, 1: PRINT "Ã" + STRING$(78, "Ä") + "´"
FOR ct% = 21 TO 79 STEP 20
LOCATE 12, ct%: PRINT "Å"
NEXT ct%
END SUB

FUNCTION getsbinfo%
'=======================================================================
'If the BLASTER variable is not set, then getsbinfo% returns -1.
'otherwise, it configures the sound block (in the mainline section)
'to the information provided in the BLASTER variable.
'=======================================================================
bs$ = ENVIRON$("BLASTER")
IF LEN(bs$) > 0 THEN
  FOR x% = 1 TO LEN(bs$)
    SELECT CASE UCASE$(MID$(bs$, x%, 1))
      CASE "A": sb.port = VAL("&H" + MID$(bs$, x% + 1, 3))
      CASE "D": sb.dma = VAL("&H" + MID$(bs$, x% + 1, 1))
    END SELECT
  NEXT x%
ELSE
  getsbinfo% = -1
END IF
RESET 'Lets try to close all the files other programmers leave open :P
END FUNCTION

'=======================================================================
'An error occurs if one of the following is true:
' * The file is NOT a WAVE file
' * The file size is 0
' * No file is specified
'=======================================================================
FUNCTION loadmus% (flname$)
IF LTRIM$(RTRIM$(flname$)) <> "" THEN
  CLOSE #1
  OPEN flname$ FOR BINARY AS #1
  IF LOF(1) < 55 THEN bad% = -1
  a$ = "    "
  IF bad% <> -1 THEN GET #1, 1, a$: IF a$ <> "RIFF" THEN bad% = -1
  IF bad% <> -1 THEN GET #1, 9, a$: IF a$ <> "WAVE" THEN bad% = -1
  IF bad% <> -1 THEN GET #1, 25, a$: sb.sps = CVL(a$)
  IF bad% <> -1 THEN SEEK #1, 44
  IF bad% <> -1 THEN dx = playmus%(1) ELSE CLOSE #1
  loadmus% = bad%
ELSE
  loadmus% = -1
END IF
END FUNCTION

SUB main
'=======================================================================
'This is where the action is in short form!
'=======================================================================
  CLS
  IF getsbinfo% <> -1 THEN
    IF loadmus%(wavefile$) <> -1 THEN
      '-----------------------------------------------------
      'Put your initialization stuff here that uses no sound
      '-----------------------------------------------------
      CALL apphdr
      
      DO
      '---------------------------------------------------------
      'Put the sections of your program that require sound here.
      '---------------------------------------------------------
      CALL app
     
      LOOP UNTIL playmus%(0) = 2
    ELSE
      'Put your music error here
      PRINT "Error loading music."
    END IF
    CALL unloadmus 'close file
  ELSE
    PRINT "BLASTER variable not set."
  END IF
END SUB

'=======================================================================
' This is DEFINITELY required for fast music!
' f% = Force sound from beginning. make it equal 1 ONLY if starting 
sound
'      or having problems.
' If playmus% = 2, then the music is done.
'=======================================================================FUNCTION playmus% (f%)
countlo% = INP(2 * sb.dma + 1): counthi% = INP(2 * sb.dma + 1)
IF CLNG(counthi% * 256&) + CLNG(countlo%) >= 11050 OR f% = 1 THEN
IF SEEK(1) < LOF(1) THEN
REDIM Pp%(3): Pp%(0) = &H87: Pp%(1) = &H83: Pp%(2) = &H82: Pp%(3) = 
&H81
GET #1, , d: lc& = LEN(d): addr& = VARSEG(d) * 16& + VARPTR(d): page% = 
0
IF (addr& AND 65536) THEN page% = page% + 1
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 &HA, &H4 + sb.dma
OUT &HC, &H0
OUT &HB, 72 + sb.dma
OUT 2 * sb.dma, addr& AND &HFF
OUT 2 * sb.dma, (addr& AND &HFF00&) \ &H100
OUT Pp%(sb.dma), page%
OUT 2 * sb.dma + 1, lc& AND &HFF
OUT 2 * sb.dma + 1, (lc& AND &HFF00&) \ &H100
OUT &HA, sb.dma
OUT sb.port + &HC, &H40: DO: LOOP WHILE INP(sb.port + &HC) AND &H80
OUT sb.port + &HC, 256 - 1000000 \ sb.sps: DO: LOOP WHILE INP(sb.port + 
&HC) AND &H80
OUT sb.port + &HC, &H14: DO: LOOP WHILE INP(sb.port + &HC) AND &H80
OUT sb.port + &HC, (lc& AND &HFF): DO: LOOP WHILE INP(sb.port + &HC) 
AND &H80
OUT sb.port + &HC, ((lc& AND &HFFFF&) \ &H100): DO: LOOP WHILE 
INP(sb.port + &HC) AND &H80
ELSE
playmus% = 2
END IF
END IF
END FUNCTION

SUB unloadmus
CLOSE #1
END SUB

FUNCTION wavefile$
INPUT "Enter WAVE filename. >", wav$
IF INSTR(wav$, ".") = 0 THEN wav$ = wav$ + ".WAV"
wavefile$ = wav$
END FUNCTION