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