home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / ITPJUL90.ZIP / TONES.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-06-28  |  2.3 KB  |  117 lines
  1. UNIT Tones;
  2.  
  3. { TONES - a set of functions that provide some
  4.   interesting sonic effects.  Useful for games
  5.   or alerts.                                    }
  6.  
  7. INTERFACE
  8.  
  9. PROCEDURE Tone(CycleLen,NbrCycles: Integer);
  10. PROCEDURE Noise(D: Longint);
  11. PROCEDURE Chirp(F1,F2,Cycles: Integer);
  12. PROCEDURE Sound2(F: Longint);
  13. PROCEDURE NoSound2;
  14.  
  15. IMPLEMENTATION
  16.  
  17. { Tone - output a tone
  18.  
  19.   INP:    cyclen - Length (counts) for 1/2 cycle
  20.          numcyc - number of cycles to make  }
  21.  
  22. PROCEDURE Tone(CycleLen,NbrCycles: Integer);
  23.  
  24. VAR
  25.     T,I,J : Integer;
  26.  
  27. BEGIN
  28.    NbrCycles := NbrCycles SHL 1;  {# half Cycles}
  29.     T := Port[$61];                {Port contents}
  30.     FOR I := 1 TO NbrCycles DO
  31.         BEGIN
  32.           T := T XOR 2;
  33.           Port[$61] := T;
  34.         FOR J :=1 TO CycleLen DO
  35.       END
  36. END;
  37.  
  38.  
  39. { Noise - make noise for a certain amount of
  40.   counts.
  41.  
  42.   INP:   D - the number of kilocounts of Noise}
  43.  
  44. PROCEDURE Noise(D: Longint);
  45. VAR
  46.     Count : Longint;
  47.     T,J,I : Integer;
  48. BEGIN
  49.     T := Port[$61];
  50.     Count := 0;
  51.     WHILE Count < D DO
  52.       BEGIN
  53.          J := (Random(32768) MOD 128) SHL 4;
  54.          FOR I := 1 TO J DO;
  55.          T := T XOR 2;
  56.            Port[$61] := T;
  57.             Inc(Count,J)
  58.       END
  59. END;
  60.  
  61. { Chirp - create a 'bird Chirp' TYPE Noise
  62.  
  63.   INP:F1 - # OF counts FOR the starting freq.
  64.          F2 - # OF counts FOR the ending freq.
  65.   Cycles - # OF Cycles OF each frequency }
  66.  
  67. PROCEDURE Chirp(F1,F2,Cycles: Integer);
  68. VAR
  69.     I,J,K,L : Integer;
  70. BEGIN
  71.     L := Port[$61];
  72.     Cycles := Cycles * 2;
  73.     I := F1;
  74.     WHILE I <> F2 DO
  75.         BEGIN
  76.             FOR J := 1 TO Cycles DO
  77.                 BEGIN
  78.                     L := L XOR 2;
  79.                     Port[$61] := L;
  80.                     FOR K := 1 TO I DO
  81.                 END;
  82.             IF F1 > F2 THEN Dec(I)
  83.             ELSE Inc(I)
  84.         END
  85. END;
  86.  
  87. { Sound2 - Generate a continuous tone using the
  88.   internal timer.
  89.  
  90.   INP:    F - the desired frequeny }
  91.  
  92. PROCEDURE Sound2(F: Longint);
  93. VAR
  94.     C : Longint;
  95. BEGIN
  96.     IF F < 19 THEN F := 19;         {Prevent overflow}
  97.     C := 1193180 DIV F;
  98.     Port[$43] := $B6;         {Program new divisor}
  99.     Port[$42] := C MOD 256;   {Rate into the timer}
  100.     Port[$42] := C DIV 256;
  101.     C := Port[$61];         {Enable speaker output}
  102.     Port[$61] := C OR 3     {from the timer       }
  103. END;
  104.  
  105.  
  106. { NoSound2 - turn off the continuous tone           }
  107.  
  108. PROCEDURE NoSound2;
  109. VAR
  110.     C : Integer;
  111. BEGIN
  112.     C := Port[$61];             {Mask off speaker}
  113.     Port[$61] := C AND $FC      {output from timer}
  114. END;
  115.  
  116. END.
  117.