'===========================================================================
' Subject: SOUND BLASTER MIC OSCILLOSCOPE    Date: 11-13-95 (00:00)       
' Author:  Toshihiro Horie                   Code: QB, QBasic, PDS        
' Origin:  www.ocf.berkeley.edu/~horie/    Packet: SOUND.ABC
'===========================================================================
DEFINT A-Z
DECLARE FUNCTION DetectSB16Addr% ()
DECLARE SUB GetDSPVersion ()
DECLARE FUNCTION SB16RESET ()
DECLARE FUNCTION SB16DSPREAD% ()
DECLARE SUB SB16DSPWRITE (V%)
DECLARE SUB SBSCOPE ()
DECLARE SUB SBPLAY ()
'============================================================
'REAL SOUND BLASTER PROGRAMMING IN QBASIC v1.0
'Routines humbly converted from pascal by TOSHIHIRO HORIE
'Motto: Taking Basic to the MAX!
'ORIGINAL DSP ROUTINES (C)1995 ABACUS _PC_Underground_
'============================================================

DIM SHARED DSPADDR
DSPADDR = &H220 'can be anywhere from 210h to 280h
title$ = "TOSHI'S REAL QBASIC SOUND BLASTER PROGRAM v1.0"
CONST false = 0, TRUE = NOT false
CONST ready = &HAA
CONST SpeakerOn = &HD1
CONST SpeakerOff = &HD3
CONST record8bit = &H20 'direct
CONST output8bit = &H10 'direct
CONST VersionQuery = &HE1
'---------BEGIN MAIN PROGRAM--------------------------------
CLS
COLOR 15, 1
PRINT title$
PRINT
'...................NOTE............................
'This program worked on my SBPRO compatible, but is
'NOT guaranteed to work on all SB's and clones.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
OK = DetectSB16Addr
IF OK THEN
        PRINT "Soundblaster detected at " + HEX$(DSPADDR) + "H"
        PRINT "Connect microphone for cool oscilloscope."
        PRINT : COLOR 14, 3:
        PRINT "Press any key to when ready..."
ELSE
        PRINT "Too bad. SoundBlaster not found.": END
END IF
DO: LOOP UNTIL INKEY$ > ""
SBSCOPE
SBPLAY
'If I have time, I may add a DMA output procedure that
'gives you real sound-effects, like music, or voices.
CLS
PRINT "End of Real SoundBlaster Demonstration."
END

'--------------------------------------------------------------------
'P.S. To the hundreds of QBASIC programmers who look at this code:
'One of the purposes of the internet is to share information.  Be
'generous with your source code. For "No man is an island."   TH 96
'--------------------------------------------------------------------

FUNCTION DetectSB16Addr
'function returns TRUE if a sounblaster was initialized
'otherwise FALSE  The DSPADDR variable is set to the
'base address of the SB.

PORT = &H210
A = 0

DetectSB16Addr = false
FOR PORT = &H210 TO &H280 STEP &H10
        DSPADDR = PORT
        A = SB16RESET
        IF A = TRUE THEN
                DetectSB16Addr = TRUE
                EXIT FUNCTION
        END IF
NEXT PORT
END FUNCTION

SUB GetDSPVersion
I = 0: 'WORD = 2 BYTES = INTEGER
T = 0: 'WORD
S$ = "": 'STRING
      

        aa = SB16RESET
        SB16DSPWRITE (VersionQuery)
        SBVERSMAJ = SB16DSPREAD
        SBVERSMIN = SB16DSPREAD
        S$ = STR$(SBVERSMAJ)
        IF SBVERSMIN > 9 THEN
                SBVERSTR$ = S$ + "." + LTRIM$(STR$(SBVERSMIN))
        ELSE
                SBVERSTR$ = S$ + ".0" + LTRIM$(STR$(SBVERSMIN))
        END IF
        PRINT "SoundBlaster DSP VERSION :"; SBVERSTR$;
END SUB

FUNCTION SB16DSPREAD
'function waits until the DSP can be read
'and returns the read value

OffsetA = DSPADDR + &HA

'--- You should wait until DSP is ready------------------------
t1# = TIMER
'DO
'        D = INP(OffsetA)
         t2# = TIMER
'        IF t2# - t1# > .5 THEN PRINT "SBRead Locked up": EXIT DO
'LOOP WHILE D = &HAA
'----------------------------------------------------------------
SB16DSPREAD = INP(OffsetA)

END FUNCTION

SUB SB16DSPWRITE (V)
'waits until the DSP is ready to write and then writes the byte
'passed in "v" to the DSP.

c = DSPADDR + &HC
'I think the Do..Loop can be replaced
'with a WAIT C,128, but not sure.
DO: CREG = INP(c)
LOOP WHILE CREG >= 128
OUT c, V
END SUB

FUNCTION SB16RESET
'This function resets the Soundblaster DSP (Digital Signal Processor)
'if function is successful TRUE is returned, otherwise FALSE.

ct = 0: stat = 0: 'byte


OUT DSPADDR + &H6, 1
DO
        OUT DSPADDR + &H6, 0
        stat = INP(DSPADDR + &HE)
        stat = INP(DSPADDR + &HA)
        IF stat = ready THEN EXIT DO
        ct = ct + 1
LOOP WHILE ct < 100 'wait about 100 ms
IF stat = ready THEN SB16RESET = TRUE ELSE SB16RESET = false
END FUNCTION

SUB SBPLAY
aa = SB16RESET
SB16DSPWRITE (SpeakerOn)
CLS
PRINT "----------------------------------------------------"
PRINT "    Outputting 8 bit tone on directly to SB"
PRINT "    pitch depends on computer speed"
PRINT "    You should hear some clicking noise."
PRINT "----------------------------------------------------"
LOCATE 25, 20: PRINT "==== Press any key to exit. =====";

rate = 24
DO
        CCC = CCC + 1
        aa = SB16RESET
        SB16DSPWRITE (output8bit)
        aa = SB16RESET
        DDD = INT((SIN(CCC / rate) * 128) + 128)
        SB16DSPWRITE (DDD)
        IF CCC > 32000 THEN CCC = 0
LOOP UNTIL INKEY$ > ""
aa = SB16RESET
SB16DSPWRITE (SpeakerOff)
END SUB

SUB SBSCOPE
SCREEN 9: CLS
LOCATE 2, 50: PRINT "SB MIC OSCILLOSCOPE"
LOCATE 3, 50: PRINT "in QBASIC!! :) "
LOCATE 4, 50: PRINT "by Toshihiro Horie"
LOCATE 23, 1: PRINT "Sound Blaster settings: "; ENVIRON$("BLASTER")
GetDSPVersion
LINE (0, 0)-(321, 257), 2, B
LINE (321, 128)-(323, 128), 15

'real-time 8-bit sampling from microphone
'I DON'T KNOW HOW TO GET RID OF THE ANNOYING SOUND FROM THE
'OUPUT JACK WHILE SAMPLING.

aa = SB16RESET
SB16DSPWRITE (SpeakerOff)
DO
        aa = SB16RESET
        SB16DSPWRITE (record8bit)
        bb = SB16DSPREAD
        'PRINT bb - 128
        PSET (xx, 256 - bb)
        xx = xx + 1
        IF xx MOD 320 = 0 THEN
                LINE (0, 0)-(320, 256), 0, BF
                xx = 0
        END IF
LOOP UNTIL INKEY$ > ""

END SUB