'===========================================================================
' Subject: CLAP DETECTOR                     Date: 09-13-97 (13:20)       
' Author:  Sami Kyostila                     Code: QB, QBasic, PDS        
' Origin:  hiteck@mail.freenet.hut.fi      Packet: SOUND.ABC
'===========================================================================
'----------------------------------------------------------------------------
'           Clap detector for QBasic by Sami Ky”stil„ 1997
'----------------------------------------------------------------------------
' I once saw a program, which detected claps via the Sound Blaster microfone
' and started programs etc. when it heard a clap. I thought: "How about
' making a similar program of my own?", and here it is! It's a very simple
' program, but it works. Note that also other loud noises can trigger it,
' but hey, nothing is perfect ;) Make sure that you enter the correct
' SB Base port below.
'----------------------------------------------------------------------------
' You can use this program freely, as long as I receive some credit
'----------------------------------------------------------------------------

DECLARE FUNCTION samplebyte% (bp%)
DECLARE SUB writedsp (byte%, bp%)
DECLARE SUB sbreset (bp%)

'----------------------------------------------------------------------------
' If the trigger level seems to be too low (ie when almost every sound
' all detected as a clap) or vice versa, modify the trigger level variable
' below. The higher it is, the more sensitive the program is, and vice versa.
' NOTE: Don't make it higher than 119.
'----------------------------------------------------------------------------
CONST TrigLevel = 110

'----------------------------------------------------------------------------
bp% = &H220   'Soundblaster Base Port, change to &h240 or whatever
              'for different hardware configuration
'----------------------------------------------------------------------------

CALL sbreset(bp%)     'Reset SB

SCREEN 13: CLS        '320x200x256


x& = 0                'Reset framecounter
Frame& = 10


VIEW SCREEN (0, 10)-(319, 199) 'Set viewport, so text won't be erased
PSET (0, 110), 12     'Reset graphics pointer

'----------------------------------------------------------------------------
' Set gradient palette
'----------------------------------------------------------------------------
FOR i& = 0 TO 63
  OUT &H3C8, i& + 16
  OUT &H3C9, 0
  OUT &H3C9, 0
  OUT &H3C9, i&
NEXT

DO
'----------------------------------------------------------------------------
' Sample one byte and draw waveform analyzer
'----------------------------------------------------------------------------
        i% = samplebyte(bp%)   'Sample one byte

        LINE -(x&, i%), 12                   'Draw waveform analyzer
        LINE (x& + 3, 0)-(x&, 199), x& \ 5 + 16, BF
        PSET (x&, i%), 12
        x& = x& + 4

'----------------------------------------------------------------------------
' Detect start of clap
'----------------------------------------------------------------------------
        IF i% < TrigLevel AND Start& < Frame& AND Frame& > Clap& + 20 THEN
          Start& = Frame&
        END IF

'----------------------------------------------------------------------------
' ...and the end of it
'----------------------------------------------------------------------------
        IF (i% >= 120 AND i% <= 130) AND Start& + 10 > Frame& THEN
          LOCATE 1, 1: PRINT " Clap detected at"; Frame& 'Print message
          Start& = 0
          Clap& = Frame&
        END IF

'----------------------------------------------------------------------------
' Keep X in bounds
'----------------------------------------------------------------------------
        IF x& > 319 THEN
          x& = 0
          PSET (0, 128), 12
        END IF

        Frame& = Frame& + 1
LOOP UNTIL INKEY$ <> ""

FUNCTION samplebyte% (bp%)

'----------------------------------------------------------------------------
'Samples a byte from the SB's ADC, and returns
'the resultant byte.  Call with BP% = SB base port
'(normally &h220)
'----------------------------------------------------------------------------


CALL writedsp(&H20, bp%) 'Command to sample one byte
datavail% = bp% + 14
dly:
        IF INP(datavail%) AND &H80 = 0 THEN GOTO dly
datread% = bp% + 10
bt% = INP(datread%)
samplebyte% = bt%

END FUNCTION

SUB sbreset (bp%)

'----------------------------------------------------------------------------
'Resets the Soundblaster chip -
'call with bp% = Base Port (normally &h220)
'----------------------------------------------------------------------------

dspreset% = bp% + 6
OUT dspreset%, 1
FOR t% = 1 TO 10
        a% = INP(dspreset%)  'Delay loop, give SB time to reset
NEXT t%
OUT dspreset%, 0
dspread% = bp% + 10
FOR t% = 1 TO 10
        a% = INP(dspread%)
NEXT t%

END SUB

SUB writedsp (byte%, bp%)

'----------------------------------------------------------------------------
'Writes to the Soundblaster's DSP Command Channel -
'call with bp% = SB base port (normally &h220)
'byte% = byte to write to DSP
'----------------------------------------------------------------------------

dspcmd% = bp% + 12
FOR t% = 1 TO 8
        q% = INP(dspcmd%) 'Delay to give SB time to process code
NEXT t%
OUT dspcmd%, byte%

END SUB