home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB16.ZIP / XMASSONG.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1986-02-06  |  3.3 KB  |  99 lines
  1. program PlayChristmasCarol (input, output, SongFromDisk);
  2.  
  3. {       Xmassong Version 1.10       (C) 1985 Michael Glowacki
  4.                                     Available in the Public Domain
  5.  
  6.         This program will play the Christmas carol stored in SONGFILE.DAT
  7. which is necessary to run this program.  Updates will be readily available as
  8. they are created.  Enjoy this simple program and give a copy to your friends.
  9.  
  10.                                              MJG           }
  11.  
  12.  
  13. type NoteRecord = record
  14.                     C,CF,D,DF,E,F,FF,G,GF,A,AF,B: integer;
  15.                   end;
  16.      SingleNote = record
  17.                     Octave : integer;
  18.                     NoteName : integer;
  19.                     NoteLength : real;   {in whole notes}
  20.                   end; {NoteRecord}
  21.      Song = array[1..136] of SingleNote;
  22.      SongFile = file of Song;
  23.  
  24. const MillisecondsPerWholeNote = 1500;  { 1.5 seconds }
  25.       Notes: NoteRecord =
  26.                (C:1;CF:2;D:3;DF:4;E:5;F:6;FF:7;G:8;GF:9;A:10;AF:11;B:12);
  27.  
  28. var ChristmasSong : Song;
  29.     SongFromDisk : SongFile;
  30.     WhichNote : integer;
  31.     Reply : char;
  32.  
  33. function ConvertToMs (Length : real) : integer;
  34. {This function converts the Length of the note (in whole notes) to ms.}
  35.  
  36.   begin
  37.     ConvertToMs:= round(Length*MillisecondsPerWholeNote);
  38.   end;  {   ConvertToMs  }
  39.  
  40. procedure Play (Octave, Note, Duration : integer);
  41. { Play Note in Octave Duration milliseconds  }
  42. { Frequency computed by first computing C in }
  43. { Octave then increasing frequency by Note-1 }
  44. { times the twelfth root of 2. (1.059463994) }
  45. {                                            }
  46. { If Duration is zero  Note will be played   }
  47. { until you activate procedure NoSound       }
  48.  
  49. var
  50.   Frequency: real;
  51.   I: integer;
  52. begin
  53.   if (Note < 13) and (Note > 0)
  54.     then begin
  55.       Frequency:=32.625;
  56.       { Compute C in Octave }
  57.       for I:=1 to Octave do Frequency:=Frequency*2;
  58.       { Increase frequency Note-1 times }
  59.       for I:=1 to Note-1 do Frequency:=Frequency*1.059463094;
  60.       if Duration<>0 then
  61.         begin
  62.           Sound(Round(Frequency));
  63.           Delay(Duration);
  64.           NoSound;
  65.         end else Sound(Round(Frequency))
  66.      end
  67.   else Delay(Duration);
  68. end;
  69.  
  70. procedure GetSong (var XmasSong : Song; var ThisFile : SongFile);
  71.   begin
  72.     assign(ThisFile, 'SONGFILE.DAT');
  73.     reset(ThisFile);
  74.     read(ThisFile, XmasSong);
  75.     close(ThisFile);
  76.   end;   {   GetSong   }
  77.  
  78. begin  {PlayChristmasCarol}
  79.   writeln('Xmassong Version 1.10          (C) 1985 Michael Glowacki ');
  80.   writeln('                             Available in the Public Domain');
  81.   GotoXY(11,7);
  82.   writeln('This program requires that SONGFILE.DAT is on the current disk drive.');
  83.   write('Is that file on this disk drive?  ');
  84.   readln(Reply);
  85.   writeln;
  86.   if (Reply = 'y') or (Reply = 'Y')
  87.   then begin
  88.     GetSong(ChristmasSong, SongFromDisk);
  89.     WhichNote:= 1;
  90.     writeln('  God Rest Ye, Merry Gentlemen');
  91.     repeat
  92.       with ChristmasSong[WhichNote]
  93.         do begin
  94.           Play(Octave, NoteName, ConvertToMs(NoteLength));
  95.         end;
  96.       WhichNote:= WhichNote + 1;
  97.     until  (WhichNote > 137);
  98.   end;  {if Reply = 'Y'}
  99. end.               {PlayChristmasCarol}