home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-386-Vol-2of3.iso / c / ctkit11.zip / CTSOUNDU.PAS < prev    next >
Pascal/Delphi Source File  |  1991-11-19  |  3KB  |  155 lines
  1. unit CTSoundU;
  2.  
  3. interface
  4.  
  5. uses
  6.   crt, dos, ctu;
  7.  
  8. {
  9.             using:... SOUND DEMONSTRATION PROGRAM  Version 1.00A
  10.  
  11.  This program demonstrates TURBO PASCAL's standard procedures Sound,
  12.  Delay and NoSound on the IBM PC and true compatibles.
  13. }
  14.  
  15. type
  16.    NoteRecord = record
  17.                   C,CF,D,DF,E,F,FF,G,GF,A,AF,B: integer;
  18.                end;
  19.    Songs = record
  20.       l: Array[1..50] of byte;
  21.       n: array[1..50] of byte;
  22.       o: array[1..50] of byte;
  23.       end;
  24.  
  25. Var
  26.    Song: array[1..15] of songs;
  27.    SongFile: File;
  28.    ch: char;
  29.    saveold: pointer;
  30.    CurNote, CurSong: byte;
  31.    EndTime: longint;
  32.    Regs: registers;
  33.  
  34. const
  35.    Notes: NoteRecord =
  36.           (C:1;CF:2;D:3;DF:4;E:5;F:6;FF:7;G:8;GF:9;A:10;AF:11;B:12);
  37.  
  38. procedure Play(Octave,Note,Duration: integer);
  39.  
  40. procedure PlaySong (WhichOne: integer);
  41.  
  42. implementation
  43.  
  44. procedure Play(Octave,Note,Duration: integer);
  45.  
  46. { Play Note in Octave Duration milliseconds
  47.   Frequency computed by first computing C in
  48.   Octave then increasing frequency by Note-1
  49.   times the twelfth root of 2. (1.059463994)
  50.  
  51.   If Duration is zero  Note will be played
  52.   until you activate procedure NoSound       }
  53.  
  54. var
  55.   Frequency : real;
  56.   I         : integer;
  57. begin
  58.   if quiet then
  59.      exit;
  60.   if Note = 13 then
  61.      begin
  62.      Delay (Duration);
  63.      exit;
  64.      end;
  65.   Frequency := 32.625;
  66.   for I := 1 to Octave do                { Compute C in Octave             }
  67.     Frequency := Frequency * 2;
  68.   for I := 1 to Note - 1 do              { Increase frequency Note-1 times }
  69.     Frequency := Frequency * 1.059463094;
  70.   if Duration <> 0 then
  71.   begin
  72.     Sound(Round(Frequency));
  73.     Delay(Duration);
  74.     NoSound;
  75.   end
  76.   else Sound(Round(Frequency));
  77. end;
  78.  
  79.  
  80. procedure PlayBG(Octave,Note: integer);
  81.  
  82. { Play Note in Octave Duration milliseconds
  83.   Frequency computed by first computing C in
  84.   Octave then increasing frequency by Note-1
  85.   times the twelfth root of 2. (1.059463994)
  86.  
  87.   Note will be played until you activate procedure NoSound       }
  88.  
  89. var
  90.   Frequency : real;
  91.   I         : integer;
  92. begin
  93.   if note = 13 then
  94.      exit;
  95.   Frequency := 32.625;
  96.   for I := 1 to Octave do                { Compute C in Octave             }
  97.     Frequency := Frequency * 2;
  98.   for I := 1 to Note - 1 do              { Increase frequency Note-1 times }
  99.     Frequency := Frequency * 1.059463094;
  100.   Sound(Round(Frequency));
  101. { Delay(Duration);
  102.   NoSound;  }
  103. end;
  104.  
  105. Procedure DoSound; Interrupt;
  106.  
  107. begin
  108. if CurSong = 0 then
  109.    exit;
  110. regs.ah := 0;
  111. intr($1a,regs);
  112. if regs.dx >= endtime then
  113.    begin
  114.    NoSound;
  115.    inc(CurNote);
  116.    if (CurNote = 51) or (Song[CurSong].n[CurNote] = 0) then
  117.       begin
  118.       while (CurNote < 51) and (Song[CurSong].N[CurNote] = 0) do
  119.          inc(CurNote);
  120.       if CurNote = 51 then
  121.          begin
  122.          CurSong := 0;
  123.          SetIntVec($1c,saveold);
  124.          exit;
  125.          end;
  126.       end;
  127.    EndTime := Regs.dx+(Song[CurSong].L[CurNote]) div 2+1;
  128.    PlayBG(Song[CurSong].O[CurNote],Song[CurSong].N[CurNote]);
  129.    end;
  130. end;
  131.  
  132. Procedure PlaySong (WhichOne: integer);
  133.  
  134. var t1: byte;
  135.  
  136. begin
  137. if Quiet then
  138.    exit;
  139. if Whichone = 0 then
  140.    begin
  141.    SetIntVec($1c,SaveOld);
  142.    CurSong := 0;
  143.    exit;
  144.    end;
  145. SetIntVec($1c,@DoSound);
  146. CurSong := WhichOne;
  147. CurNote := 0;
  148. EndTime := 0;
  149. end;
  150.  
  151. begin
  152. CurSong := 0;
  153. FillChar (Song, SizeOf(Song), 0);
  154. GetIntVec($1c,SaveOld);
  155. end.