Category : Files from Magazines
Archive   : IMB9007.ZIP
Filename : TONES.BAS

DECLARE SUB Chirp (F1%, F2%, Cycles%)
DECLARE SUB Tone (CycleLen%, NbrCycles%)
DECLARE SUB Noise (D AS LONG)
DECLARE SUB Sound2 (F AS LONG)
DECLARE SUB Delay (Interval!)
DECLARE SUB Nosound ()
DEFINT A-Z

' TONES - a set of functions that provide some
' interesting sonic effects. Useful for games
' or alerts.


' ToneTest - test the sound routines

' Make some sounds

PRINT "Siren"
FOR I = 1 TO 5
CALL Chirp(200, 500, 3)
CALL Chirp(500, 200, 3)
NEXT I

PRINT "Chirp - Glide down"
CALL Chirp(220, 440, 10)

PRINT "Single Tone"
CALL Tone(330, 1000)

PRINT "Noise"
CALL Noise(1000000)

PRINT "Single Tone"
CALL Tone(110, 1000)

PRINT "Chirp - Glide up"
CALL Chirp(1000, 1, 3)

PRINT "Phasor"
FOR I = 1 TO 15
CALL Chirp(1, 150, 2)
NEXT I

PRINT "Chirp"
CALL Chirp(1, 300, 2)

'Make a 'concert A' for 1.5 seconds

PRINT "Sound2 @ 440 Hz"
CALL Sound2(440)
CALL Delay(1500)

' Make same sounds, with TIMER tone
' superimposed, for MULTISOUND effect

PRINT "Siren"
FOR I = 1 TO 5
CALL Chirp(200, 500, 3)
CALL Chirp(500, 200, 3)
NEXT I

PRINT "Chirp - Glide down with multisound"
CALL Chirp(220, 440, 10)

PRINT "Single Tone with multisound"
CALL Tone(330, 1000)

PRINT "Noise with multisound"
CALL Noise(1000000)

PRINT "Single Tone with multisound"
CALL Tone(110, 1000)

PRINT "Chirp - Glide up with multisound"
CALL Chirp(1000, 1, 3)

PRINT "Phasor with multisound"
FOR I = 1 TO 15
CALL Chirp(1, 150, 2)
NEXT I

PRINT "Chirp with multisound"
CALL Chirp(1, 300, 2)

CALL Nosound ' Turn off timer

SUB Chirp (F1, F2, Cycles)


' Chirp - create a 'bird chirp' type noise

' INP:F1 - # of counts for the starting freq.
' F2 - # of counts for the ending freq.
' Cycles - # of cycles of each frequency

L = INP(&H61)
Cycles = Cycles * 2
I = F1
WHILE I <> F2
FOR J = 1 TO Cycles
L = L XOR 2
OUT &H61, L
FOR K = 1 TO I: NEXT K
NEXT J
IF F1 > F2 THEN
I = I - 1
ELSE
I = I + 1
END IF
WEND
END SUB

SUB Delay (Interval!)
Begin! = TIMER
WHILE Begin! + (Interval! / 1000) < TIMER
WEND
END SUB

SUB Noise (D AS LONG)

' Noise - Make noise for a certain amount of
' counts.

' INP:
' D - The number of kilocounts of noise

T = INP(&H61)
Count& = 0
WHILE Count& < D
J = (INT((32768 + 1) * RND) MOD 128) * 8
FOR I = 1 TO J: NEXT I
T = T XOR 2
OUT &H61, T
Count& = Count& + J
WEND
END SUB

SUB Nosound

' NoSound2 - turn off the continuous tone

C = INP(&H61) 'Mask off speaker
OUT &H61, (C AND &HFC) 'output from timer
END SUB

SUB Sound2 (F AS LONG)

' Sound2 - Generate a continuous tone using the
' internal timer.

' INP: F - the desired frequeny

IF F < 19 THEN F = 19 'Prevent overflow
C& = 1193180 \ F
OUT &H43, &HB6 'Program new divisor
OUT &H42, (C& MOD 256) 'Rate into the timer
OUT &H42, (C& \ 256)
C& = INP(&H61) 'Enable speaker output
OUT &H61, (C& OR 3) 'from the timer

END SUB

SUB Tone (CycleLen, NbrCycles)

' Tone - output a tone

' INP: CycleLen - Length (counts) for 1/2 cycle
' NbrCycles - Number of cycles to make

NbrCycles = NbrCycles * 2 '# half cycles
T = INP(&H61) 'Port contents
FOR I = 1 TO NbrCycles
T = T XOR 2
OUT &H61, T
FOR J = 1 TO CycleLen: NEXT J
NEXT I
END SUB