'===========================================================================
' Subject: SAVE FX (SOUND EFFECTS) DATA      Date: 02-27-99 (20:08)       
' Author:  Darryl R. Waltz                   Code: QB, QBasic, PDS        
' Origin:  drw@telusplanet.net             Packet: SOUND.ABC
'===========================================================================
'Create FX file to play sound effects in your programs
'Use mouse and mouse left button to draw sound waves
'Press right button to play your creation and to save to FX.dat file
'Use FXload.bas to play your sound file

DECLARE SUB mousehide ()
DECLARE SUB MouseDriver (AX%, bx%, CX%, DX%)
DECLARE FUNCTION MouseInit% ()
DECLARE SUB mouseshow ()
DECLARE SUB mousestatus (lb%, RB%, xmouse%, ymouse%)
DECLARE SUB SBPlay (freq%, duration%, octave%, waveform%)
DECLARE SUB WriteReg (reg%, value%)

DIM SHARED mouse$

RESTORE
mouse$ = SPACE$(57)
FOR i% = 1 TO 57
  READ A$
  H$ = CHR$(VAL("&H" + A$))
  MID$(mouse$, i%, 1) = H$
NEXT i%
DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B
DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53
DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F
DATA 8B,5E,06,89,17,5D,CA,08,00
CLS

MS% = MouseInit%
x% = 0
mouseshow

DIM p%(1000)
SCREEN 8
RANDOMIZE TIMER

PRINT "Use mouse and mouse left button to draw sound waves"
DO
     mousestatus lb%, RB%, xmouse%, ymouse%
     mouseshow
     IF lb% = -1 THEN mousehide: LINE (xmouse%, 199)-(xmouse%, 0), 0: LINE (xmouse%, 199)-(xmouse%, ymouse%), 3: p%(xmouse%) = 199 - ymouse%: n% = 199 - ymouse%: bn = xmouse%: IF bn > nb THEN nb = xmouse%: 'ELSE cx = xc
     IF RB% = -1 THEN GOTO 14
     A$ = INKEY$: IF A$ = CHR$(32) THEN STOP
LOOP

14 : PRINT "Playing sound file"

FOR xi = 1 TO nb
'                                 ** set delay
  IF p%(xi) = 0 THEN FOR i = 1 TO 50: NEXT i   '***
'                                 ** set delay  *** This code for
  IF p%(xi) > 36 THEN                          '*** speaker only.
    SOUND p%(xi), .025                         '***
                                               '***
    '            ** set delay                  '***
    FOR i = 1 TO 50: NEXT i                    '***
    '            ** set delay                  '***
                                               '***
  END IF                                       '***
 
  SBPlay p%(xi), 0, &H24, &H2: CALL WriteReg(&HB0, &H0) '** Play Sound Blaster

NEXT xi


PRINT "Saving to FX.dat file"
OPEN "FX.dat" FOR OUTPUT AS #1   '
  WRITE #1, nb                   '
  FOR xi = 1 TO nb               ' save FX data to FX.dat
    WRITE #1, p%(xi)             '
  NEXT xi                        '
CLOSE #1                         '

SUB MouseDriver (AX%, bx%, CX%, DX%)
  DEF SEG = VARSEG(mouse$)
  mouse% = SADD(mouse$)
  CALL Absolute(AX%, bx%, CX%, DX%, mouse%)
END SUB

SUB mousehide
 AX% = 2
 MouseDriver AX%, 0, 0, 0
END SUB

FUNCTION MouseInit%
  AX% = 0
  MouseDriver AX%, 0, 0, 0
  MouseInit% = AX%

END FUNCTION

SUB mouseshow
  AX% = 1
  MouseDriver AX%, 0, 0, 0
END SUB

SUB mousestatus (lb%, RB%, xmouse%, ymouse%)
  AX% = 3
  MouseDriver AX%, bx%, CX%, DX%
  lb% = ((bx% AND 1) <> 0)
  RB% = ((bx% AND 2) <> 0)
  xmouse% = CX%
  ymouse% = DX%
END SUB

DEFINT A-Z
SUB SBPlay (freq%, duration%, octave%, waveform%)
'  Purpose:      Plays a note
'  Variables:    freq%     - Frequency (00-FF hex)
'                duration% - Duration (n seconds)
'                octave%   - Octive (00-FF hex)
'                waveform% - Wave (00-FF hex)
'  The first group of WriteRegs is the modulator, the second is the
'  carrier.
'  If you just want to know how to create your own instrument, play around
'  with the second values in the first four calls to WriteReg in each group.
CALL WriteReg(&H20, &HF4)        ' Set modulator's multiple to F
CALL WriteReg(&H40, &HF)        ' Set modulator's level to 40 dB
CALL WriteReg(&H60, &HF2)       ' Modulator attack: quick, decay: long
CALL WriteReg(&H80, &HF1)       ' Modulator sustain: medium, release: medium
CALL WriteReg(&HA0, freq%)
CALL WriteReg(&H23, &H3)        ' Set carrier's multiple to 0
CALL WriteReg(&H43, &H0)        ' Set carrier's level to 0 dB
CALL WriteReg(&H63, &HF9)       ' Carrier attack: quick, decay: long
CALL WriteReg(&H83, &HFF)       ' Carrier sustain: quick, release: quick
CALL WriteReg(&HB0, octave%)    ' Octave
CALL WriteReg(&HE0, waveform%)  ' Waveform argument
Timeup! = TIMER + duration% / 64'Timer goes by 1 second.  We divide it by 64 to allow up to 64th notes.
 WHILE Timeup! > TIMER: WEND     ' Worst you can be off is .182 of a second

END SUB

SUB WriteReg (reg%, value%)
OUT &H388, reg     '388h = address/status port, 389h = dataport
  FOR x = 0 TO 5   ' This tells the SB what register we want to write to

    A = INP(&H388) ' After we write to the address port we must wait 3.3ms
  NEXT x
                                                          
OUT &H389, value   ' Send the value for the register to 389h
  FOR x = 0 TO 34  ' Here we must also wait, this time 23ms
    A = INP(&H388)
  NEXT x

'
END SUB