SBSOUND.BAS 1/2

 BBS: Inland Empire Archive
Date: 11-12-92 (21:53)             Number: 370
From: BRETT LEVIN                  Refer#: NONE
  To: TOM HAMMOND                   Recvd: NO  
Subj: SBSOUND.BAS           1/2      Conf: (2) Quik_Bas

     Here ya go.  Anyone else is free to use this, as long as you follow
yon stated rules.. :-)

-cUT-hERE--------------------------------------------------
' SBSOUND.BAS by Brett Levin 1992
'
'  These routines were made entirely from a pretty detailed (techie, but
' not that I mind <G>) text file on programming the FM ports on the AdLib/SB.
'  You are free to use this in any program what so ever, as long as you
' give credit where credit is due.. (stole that line from Rich!) :)

DEFINT A-Z
DECLARE FUNCTION DetectCard% ()
DECLARE SUB SBInit ()
DECLARE SUB WriteReg (Reg%, Value%)
DECLARE SUB SBPlay (note%)

CONST false = 0, true = NOT false

SCREEN 0: CLS

IF DetectCard = true THEN
  PRINT "AdLib-compatible sound card detected."
ELSE
  PRINT "Unable to find/detect sound card."
  BEEP
  SYSTEM
END IF
PRINT " Initalizing...";

SBInit

PRINT " Done."

FOR nt = 0 TO 255
SBPlay nt
NEXT nt

PRINT
PRINT "  These routines only support one channel/voice of the FM chip, but"
PRINT "eventually I may fix them so you can have a bunch o' instruments on"
PRINT "at once.  I'd also like to write a replacement for SBFMDRV.COM, but"
PRINT "that's far off, and probably not in QB anyway.  This is too fast"
PRINT "compiled, so if you are going to use it in anything, add a delay."
PRINT "                                  Enjoy!         -Brett 11/12/92"
PRINT

FOR nt = 255 TO 0 STEP -1
SBPlay nt
NEXT nt

PRINT "[Press any key to end]"
SLEEP

CALL WriteReg(&HB0, &H0)  'Makes sure no extra sound is left playing

FUNCTION DetectCard%

'  Purpose:   Detects an AdLib-compatible card.
'             Returns -1 (true) if detected and 0 (false) if not.
'  Variables: Nope

CALL WriteReg(&H4, &H60)
CALL WriteReg(&H4, &H80)
B = INP(&H388)
CALL WriteReg(&H2, &HFF)
CALL WriteReg(&H4, &H21)
  FOR x = 0 TO 130
    A = INP(&H388)
  NEXT x
C = INP(&H388)
CALL WriteReg(&H4, &H60)
CALL WriteReg(&H4, &H80)
Success = 0
IF (B AND &HE0) = &H0 THEN
  IF (C AND &HE0) = &HC0 THEN
    Success = -1
  END IF
END IF
DetectCard% = Success

END FUNCTION

SUB SBInit
'  Initialize the sound card

'(This is the "quick-and-dirty" method; what it's doing is zeroing out
'  all of the card's registers.  I haven't had any problems with this.)

FOR q = 1 TO &HF5
  CALL WriteReg(q, 0)
NEXT q

END SUB

SUB SBPlay (freq%)

'  Purpose:      Plays a note
'  Variables:    freq% - Frequency (00-FF hex)
'                duration% - Duration (n seconds) (not used)

'  I'm still working on this part, it may be ugly, but it works <g>.
'  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.
'  :-)  Have fun!  - Brett

CALL WriteReg(&H20, &H7)    ' Set modulator's multiple to F
CALL WriteReg(&H40, &HF)    ' Set modulator's level to 40 dB
CALL WriteReg(&H60, &HF0)   ' Modulator attack: quick, decay: long
CALL WriteReg(&H80, &HF0)   ' Modulator sustain: medium, release: medium
CALL WriteReg(&HA0, freq%)


CALL WriteReg(&H23, &HF)   ' Set carrier's multiple to 0
CALL WriteReg(&H43, &H0)   ' Set carrier's level to 0 dB
CALL WriteReg(&H63, &HF0)  ' Carrier attack: quick, decay: long
CALL WriteReg(&H83, &HFF)  ' Carrier sustain: quick, release: quick
CALL WriteReg(&HB0, &H20)  ' Octave

CALL WriteReg(&HE0, &H00)  ' Waveform argument for Tom..
                           ' &H00 is the default, but I felt like
                           ' dropping it in for you.. :)

' I originally had an extra argument, duration!, but for some reason
' I wanted to do the timing outside of this sub..  You can change it back
' if needs require..

'TimeUp! = TIMER + duation!
'WHILE TimeUp! > TIMER: WEND  ' Worst you can be off is .182 of a second

END SUB

SUB WriteReg (Reg%, Value%)

'  Purpose:   Writes to any of the SB/AdLib's registers
'  Variables: Reg%: Register number,
'             Value%: Value to insert in register
'              (Note: The registers are from 00-F5 (hex))
>>> Continued to next message

 * SLMR 2.1a * In /dev/null, no one can hear you scream.


--- WM v2.04/91-0049
 * Origin: Reservation Only! Las Vegas,Nv~702-898-8630~ (1:209/721)