home *** CD-ROM | disk | FTP | other *** search
/ Fatal Distractions! / fataldistractions.bin / appndxa / masters / agtsound.pas < prev    next >
Pascal/Delphi Source File  |  1992-10-04  |  9KB  |  259 lines
  1. PROGRAM AGTsound;
  2.  
  3.   (* Adapted by Dave Malmberg -- but, based on ... *)
  4.  
  5.   {****************************************************************************}
  6.   {*                               SOUND TOOLS                                *}
  7.   {*                       Version 1.0, October 26, 1988                      *}
  8.   {*                                                                          *}
  9.   {*    Written by:                   Turbo Pascal sound generation tools.    *}
  10.   {*    Nels Anderson                                                         *}
  11.   {*    92 Bishop Drive               Released to the public domain.          *}
  12.   {*    Framingham, MA 01701                                                  *}
  13.   {*                                                                          *}
  14.   {****************************************************************************}
  15.  
  16.   { Sound effects demo }
  17.  
  18. USES
  19.   Crt;
  20.  
  21.   { Sound Effects }
  22.  
  23. CONST Maxtones = 10000;
  24.  
  25. TYPE
  26.   AGT_tone = RECORD
  27.                Frequency,         {Frequency in Hertz}
  28.                Duration,          {Length of tone in milleseconds}
  29.                Pause              {Length of pause between tones in milleseconds}
  30.                : Word;
  31.              END;
  32.  
  33. VAR
  34.   AGT_tones : Word;               (* AGT sound array size *)
  35.  
  36.   AGT_sound : ARRAY[0..Maxtones] OF AGT_tone;
  37.  
  38.  
  39.   PROCEDURE Play_AGT_sound;       (* Routine to play AGT sound/music array *)
  40.  
  41.   VAR K : Word;
  42.  
  43.   BEGIN
  44.     K := 0;
  45.     AGT_tones := AGT_sound[K].Frequency;
  46.     REPEAT
  47.       Inc(K);
  48.       IF AGT_sound[K].Frequency = 0
  49.       THEN NoSound
  50.       ELSE Sound(AGT_sound[K].Frequency); (* Frequency *)
  51.       Delay(AGT_sound[K].Duration); (* Length of tone *)
  52.       NoSound;
  53.       Delay(AGT_sound[K].Pause);  (* Length of "pause' between tones *)
  54.     UNTIL K >= AGT_tones;
  55.     NoSound;
  56.   END;
  57.  
  58.   PROCEDURE PlayATone(Play_Freq, Play_Duration, Rest_Duration : Word);
  59.   BEGIN
  60.     IF Play_Freq > 0
  61.     THEN Sound(Play_Freq)         (* Hertz *)
  62.     ELSE NoSound;
  63.     Delay(Play_Duration);         (* Milliseconds *)
  64.     NoSound;
  65.     Delay(Rest_Duration);         (* Milliseconds *)
  66.     IF AGT_tones < Maxtones
  67.     THEN BEGIN
  68.       Inc(AGT_tones);
  69.       IF Play_Freq > 0
  70.       THEN AGT_sound[AGT_tones].Frequency := Play_Freq
  71.       ELSE AGT_sound[AGT_tones].Frequency := 0;
  72.       AGT_sound[AGT_tones].Duration := Play_Duration;
  73.       AGT_sound[AGT_tones].Pause := Rest_Duration;
  74.     END;
  75.   END;                            (* PlayAtone *)
  76.  
  77.  
  78. CONST
  79.   Cuckoo : ARRAY[1..5] OF Integer = (247, -62, 150, 2, 0);
  80.   UhOh : ARRAY[1..13] OF Integer = (33, 7, 20, 13, -1, 0, 20, 1, 62, -3, 20, 13, 0);
  81.   Bat : ARRAY[1..5] OF Integer = (12000, -100, 6, 106, 0);
  82.   BirdCall : ARRAY[1..13] OF Integer = (3500, 0, 50, 1, 3000, 0, 50, 1, 4000, 0, 50, 1, 0);
  83.   ClockTick : ARRAY[1..9] OF Integer = (12500, 0, 19, 1, -1, 0, 1000, 1, 0); {uses frequency of -1 for silence}
  84.   Conveyor : ARRAY[1..5] OF Integer = (37, 1, 3, 64, 0);
  85.   Crickets : ARRAY[1..13] OF Integer = (1800, 0, 3, 10, 2000, 0, 1, 1, -1, 0, 100, 1, 0);
  86.   DoorBuzzer : ARRAY[1..5] OF Integer = (5700, 1500, 1, 7, 0);
  87.   Explosion : ARRAY[1..5] OF Integer = (300, 150, 6, 10, 0);
  88.   PhoneRing : ARRAY[1..9] OF Integer = (523, 0, 28, 1, 659, 0, 28, 1, 0);
  89.   FlyingSaucer : ARRAY[1..5] OF Integer = (500, 200, 28, 5, 0);
  90.   Siren : ARRAY[1..9] OF Integer = (200, 1, 2, 800, 1000, -1, 2, 800, 0);
  91.   Drip : ARRAY[1..9] OF Integer = (1000, 100, 8, 3, -1, 0, 600, 1, 0);
  92.   Train : ARRAY[1..5] OF Integer = (1700, -4, 1, 416, 0);
  93.   Whoop : ARRAY[1..5] OF Integer = (900, 1, 5, 100, 0);
  94.   Phaser : ARRAY[1..5] OF Integer = (300, 100, 6, 15, 0);
  95.  
  96. TYPE
  97.   IntArray = ARRAY[1..2] OF Integer;
  98.  
  99.   PROCEDURE SndEff(Info : Pointer);
  100. { Generate sounds according to the Info table.  Each table entry contains the
  101.   following:
  102.  
  103.       Starting Tone in Hz
  104.       Freq. change in Hz per repetition
  105.       Milliseconds between changes
  106.       Number of repetitions
  107.  
  108.   The table can repeat these parameters as many times as necessary.  To end
  109.   the table a single 0 is required.
  110. }
  111.   VAR
  112.     Table : ^IntArray;
  113.     i, tone,
  114.     offset : Integer;
  115.   BEGIN
  116.     offset := 0;                  {init. offset into table}
  117.     Table := Info;                {set pointer}
  118.     REPEAT
  119.       tone := Table^[offset+1];   {get initial tone}
  120.       FOR i := 1 TO Table^[offset+4] DO BEGIN {for each repetition...}
  121.         PlayATone(tone, Table^[offset+3], 0);
  122.         tone := tone+Table^[offset+2]; {change tone}
  123.       END;                        {for i}
  124.       offset := offset+4;         {increment offset into table}
  125.     UNTIL Table^[offset+1] = 0;   {until end of table}
  126.     NoSound;
  127.   END;                            {SoundEff procedure}
  128.  
  129.  
  130.   PROCEDURE CustomSound;          (* Put your own custom sound in this routine *)
  131.     { The example below has the sound made when a spell is cast }
  132.   VAR
  133.     z : Real;
  134.   BEGIN
  135.     { This example has a sound made when a spell is cast }
  136.     z := 1;
  137.     REPEAT
  138.       PlayATone(Round((Sin(z)+40)*50), 11, 0);
  139.       z := z+0.4
  140.     UNTIL z >= 30;
  141.     NoSound;
  142.   END;                            {CustomSound procedure}
  143.  
  144. VAR
  145.   K : Word;
  146.   AGT_Tone_File : FILE OF AGT_tone;
  147.   c : Char;
  148.   soundnum : Integer;
  149.   Filename : String;
  150.  
  151.   PROCEDURE WriteAGTsoundFile;
  152.   BEGIN
  153.     AGT_sound[0].Frequency := AGT_tones;
  154.  
  155.     Filename := 'TEMP.MUC';       (* You must rename the file in order to save it *)
  156.     Assign(AGT_Tone_File, Filename);
  157.     Rewrite(AGT_Tone_File);
  158.     FOR K := 0 TO AGT_tones DO Write(AGT_Tone_File, AGT_sound[K]);
  159.     Close(AGT_Tone_File);
  160.   END;
  161.  
  162. BEGIN                             {Main routine}
  163.  
  164.   AGT_tones := 0;                 (* AGT sound array size *)
  165.  
  166.   FOR K := 0 TO Maxtones DO       (* "Zero" out AGT sound array *)
  167.     BEGIN
  168.       AGT_sound[K].Frequency := 0;
  169.       AGT_sound[K].Duration := 0;
  170.       AGT_sound[K].Pause := 0;
  171.     END;
  172.  
  173.   REPEAT
  174.     WriteLn('Select by Number:');
  175.     WriteLn('1) Bat');
  176.     WriteLn('2) Bird Call');
  177.     WriteLn('3) Clock Tick');
  178.     WriteLn('4) Conveyor');
  179.     WriteLn('5) Crickets');
  180.     WriteLn('6) Door Buzzer');
  181.     WriteLn('7) Explosion');
  182.     WriteLn('8) Phone Ringing');
  183.     WriteLn('9) Flying Saucer');
  184.     WriteLn('10) Siren');
  185.     WriteLn('11) Drip');
  186.     WriteLn('12) Train');
  187.     WriteLn('13) Whoop');
  188.     WriteLn('14) Phaser');
  189.     WriteLn('15) Cuckoo');
  190.     WriteLn('16) Uh oh');
  191.     WriteLn('17) Your Own Custom Sound');
  192.     Write('Select sound, 0 to quit: ');
  193.     ReadLn(soundnum);
  194.     IF soundnum > 0 THEN BEGIN
  195.       WriteLn('Hit a key to stop...');
  196.       AGT_tones := 0;               (* "Zero" out AGT sound array *)
  197.       REPEAT
  198.         CASE soundnum OF
  199.           1 : SndEff(@Bat);
  200.           2 : SndEff(@BirdCall);
  201.           3 : SndEff(@ClockTick);
  202.           4 : SndEff(@Conveyor);
  203.           5 : SndEff(@Crickets);
  204.           6 : SndEff(@DoorBuzzer);
  205.           7 : SndEff(@Explosion);
  206.           8 : SndEff(@PhoneRing);
  207.           9 : SndEff(@FlyingSaucer);
  208.           10 : SndEff(@Siren);
  209.           11 : SndEff(@Drip);
  210.           12 : SndEff(@Train);
  211.           13 : SndEff(@Whoop);
  212.           14 : SndEff(@Phaser);
  213.           15 : BEGIN SndEff(@Cuckoo); soundnum := 999; END;
  214.           16 : BEGIN SndEff(@UhOh); soundnum := 999; END;
  215.           17 : CustomSound;
  216.         END;                      {case}
  217.       UNTIL KeyPressed;
  218.       c := ReadKey;
  219.     END;                          {if soundnum > 0}
  220.   UNTIL soundnum = 0;
  221.  
  222.   NoSound;
  223.  
  224.   WriteLn;
  225.   Write('Would you like to save that last sound as an AGT .MUC file?  (Y/N) ');
  226.   c := ReadKey;
  227.   IF (c = 'Y') OR(c = 'y') THEN
  228.     BEGIN
  229.       WriteAGTsoundFile;
  230.       WriteLn;
  231.       WriteLn;
  232.       WriteLn('The AGT sound file is ', Filename, ' -- with ', AGT_tones, ' total tones');
  233.  
  234.       WriteLn;
  235.       WriteLn('Here is what it sounds like....');
  236.  
  237.       AGT_tones := 0;             (* AGT sound array size *)
  238.  
  239.       FOR K := 0 TO Maxtones DO
  240.         BEGIN
  241.           AGT_sound[K].Frequency := 0;
  242.           AGT_sound[K].Duration := 0;
  243.           AGT_sound[K].Pause := 0;
  244.         END;
  245.  
  246.       Assign(AGT_Tone_File, Filename);
  247.       Reset(AGT_Tone_File);
  248.       Read(AGT_Tone_File, AGT_sound[0]);
  249.       AGT_tones := AGT_sound[0].Frequency;
  250.       FOR K := 1 TO AGT_tones DO Read(AGT_Tone_File, AGT_sound[K]);
  251.       Close(AGT_Tone_File);
  252.  
  253.       Play_AGT_sound;
  254.  
  255.       NoSound;
  256.     END;                          (* Record AGT .MUC sound file and played it back *)
  257.  
  258. END.
  259.