home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / IMB9007.ZIP / TONES.BAS < prev   
BASIC Source File  |  1990-06-28  |  3KB  |  179 lines
  1. DECLARE SUB Chirp (F1%, F2%, Cycles%)
  2. DECLARE SUB Tone (CycleLen%, NbrCycles%)
  3. DECLARE SUB Noise (D AS LONG)
  4. DECLARE SUB Sound2 (F AS LONG)
  5. DECLARE SUB Delay (Interval!)
  6. DECLARE SUB Nosound ()
  7. DEFINT A-Z
  8.  
  9. ' TONES - a set of functions that provide some
  10. ' interesting sonic effects.  Useful for games
  11. ' or alerts.
  12.  
  13.  
  14. ' ToneTest - test the sound routines
  15.  
  16. ' Make some sounds
  17.  
  18.    PRINT "Siren"
  19.     FOR I = 1 TO 5
  20.       CALL Chirp(200, 500, 3)
  21.       CALL Chirp(500, 200, 3)
  22.     NEXT I
  23.  
  24.     PRINT "Chirp - Glide down"
  25.     CALL Chirp(220, 440, 10)
  26.  
  27.     PRINT "Single Tone"
  28.     CALL Tone(330, 1000)
  29.  
  30.     PRINT "Noise"
  31.     CALL Noise(1000000)
  32.  
  33.     PRINT "Single Tone"
  34.     CALL Tone(110, 1000)
  35.  
  36.     PRINT "Chirp - Glide up"
  37.     CALL Chirp(1000, 1, 3)
  38.  
  39.     PRINT "Phasor"
  40.     FOR I = 1 TO 15
  41.         CALL Chirp(1, 150, 2)
  42.     NEXT I
  43.  
  44.     PRINT "Chirp"
  45.     CALL Chirp(1, 300, 2)
  46.  
  47.     'Make a 'concert A' for 1.5 seconds
  48.     
  49.     PRINT "Sound2 @ 440 Hz"
  50.     CALL Sound2(440)
  51.     CALL Delay(1500)
  52.  
  53.     ' Make same sounds, with TIMER tone
  54.     ' superimposed, for MULTISOUND effect
  55.  
  56.    PRINT "Siren"
  57.     FOR I = 1 TO 5
  58.       CALL Chirp(200, 500, 3)
  59.       CALL Chirp(500, 200, 3)
  60.     NEXT I
  61.  
  62.     PRINT "Chirp - Glide down with multisound"
  63.     CALL Chirp(220, 440, 10)
  64.  
  65.     PRINT "Single Tone with multisound"
  66.     CALL Tone(330, 1000)
  67.  
  68.     PRINT "Noise with multisound"
  69.     CALL Noise(1000000)
  70.  
  71.     PRINT "Single Tone with multisound"
  72.     CALL Tone(110, 1000)
  73.  
  74.     PRINT "Chirp - Glide up with multisound"
  75.     CALL Chirp(1000, 1, 3)
  76.  
  77.     PRINT "Phasor with multisound"
  78.     FOR I = 1 TO 15
  79.         CALL Chirp(1, 150, 2)
  80.     NEXT I
  81.  
  82.     PRINT "Chirp with multisound"
  83.     CALL Chirp(1, 300, 2)
  84.  
  85.     CALL Nosound           ' Turn off timer
  86.  
  87. SUB Chirp (F1, F2, Cycles)
  88.  
  89.  
  90. ' Chirp - create a 'bird chirp' type noise
  91.  
  92. ' INP:F1 - # of counts for the starting freq.
  93. '     F2 - # of counts for the ending freq.
  94. ' Cycles - # of cycles of each frequency
  95.  
  96.     L = INP(&H61)
  97.     Cycles = Cycles * 2
  98.     I = F1
  99.     WHILE I <> F2
  100.         FOR J = 1 TO Cycles
  101.             L = L XOR 2
  102.             OUT &H61, L
  103.             FOR K = 1 TO I: NEXT K
  104.         NEXT J
  105.         IF F1 > F2 THEN
  106.             I = I - 1
  107.         ELSE
  108.             I = I + 1
  109.         END IF
  110.     WEND
  111. END SUB
  112.  
  113. SUB Delay (Interval!)
  114. Begin! = TIMER
  115. WHILE Begin! + (Interval! / 1000) < TIMER
  116. WEND
  117. END SUB
  118.  
  119. SUB Noise (D AS LONG)
  120.  
  121. ' Noise - Make noise for a certain amount of
  122. ' counts.
  123.  
  124. ' INP:
  125. '       D - The number of kilocounts of noise
  126.  
  127.     T = INP(&H61)
  128.     Count& = 0
  129.     WHILE Count& < D
  130.         J = (INT((32768 + 1) * RND) MOD 128) * 8
  131.         FOR I = 1 TO J: NEXT I
  132.         T = T XOR 2
  133.         OUT &H61, T
  134.         Count& = Count& + J
  135.     WEND
  136. END SUB
  137.  
  138. SUB Nosound
  139.  
  140. ' NoSound2 - turn off the continuous tone
  141.  
  142.     C = INP(&H61)             'Mask off speaker
  143.     OUT &H61, (C AND &HFC)    'output from timer
  144. END SUB
  145.  
  146. SUB Sound2 (F AS LONG)
  147.  
  148. ' Sound2 - Generate a continuous tone using the
  149. ' internal timer.
  150.  
  151. ' INP:   F - the desired frequeny
  152.  
  153.     IF F < 19 THEN F = 19    'Prevent overflow
  154.     C& = 1193180 \ F
  155.     OUT &H43, &HB6           'Program new divisor
  156.     OUT &H42, (C& MOD 256)   'Rate into the timer
  157.     OUT &H42, (C& \ 256)
  158.     C& = INP(&H61)           'Enable speaker output
  159.     OUT &H61, (C& OR 3)      'from the timer
  160.  
  161. END SUB
  162.  
  163. SUB Tone (CycleLen, NbrCycles)
  164.  
  165. ' Tone - output a tone
  166.  
  167. '  INP:  CycleLen  - Length (counts) for 1/2 cycle
  168. '        NbrCycles - Number of cycles to make
  169.  
  170.     NbrCycles = NbrCycles * 2        '# half cycles
  171.     T = INP(&H61)                    'Port contents
  172.     FOR I = 1 TO NbrCycles
  173.         T = T XOR 2
  174.         OUT &H61, T
  175.         FOR J = 1 TO CycleLen: NEXT J
  176.     NEXT I
  177. END SUB
  178.  
  179.