home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TM40.ZIP / MUSIC.INC < prev    next >
Encoding:
Text File  |  1985-07-20  |  6.1 KB  |  202 lines
  1. (****************************************************************************)
  2. (*                       INITIALIZE MUSIC VARIABLES                         *)
  3. (****************************************************************************)
  4.    procedure
  5.       initialize_music;
  6.    var
  7.       j,k    : integer;
  8.    begin
  9.  
  10.       { Frequencies for Octave 4. }
  11.       scale[  0 ]  := 1661.220;  { A }
  12.       scale[  1 ]  := 1760.000;
  13.       scale[  2 ]  := 1864.640;
  14.       scale[  3 ]  := 1864.640;  { B }
  15.       scale[  4 ]  := 1975.540;
  16.       scale[  5 ]  := 1975.540;
  17.       scale[  6 ]  :=  987.770;  { C }
  18.       scale[  7 ]  := 1046.500;
  19.       scale[  8 ]  := 1108.740;
  20.       scale[  9 ]  := 1108.740;  { D }
  21.       scale[ 10 ]  := 1174.700;
  22.       scale[ 11 ]  := 1244.500;
  23.       scale[ 12 ]  := 1244.500;  { E }
  24.       scale[ 13 ]  := 1318.500;
  25.       scale[ 14 ]  := 1318.500;
  26.       scale[ 15 ]  := 1318.500;  { F }
  27.       scale[ 16 ]  := 1396.900;
  28.       scale[ 17 ]  := 1479.980;
  29.       scale[ 18 ]  := 1479.980;  { G }
  30.       scale[ 19 ]  := 1568.000;
  31.       scale[ 20 ]  := 1661.224;
  32.  
  33.       factor[ 0 ] := 0.0625;
  34.       factor[ 1 ] := 0.1250;
  35.       factor[ 2 ] := 0.2500;
  36.       factor[ 3 ] := 0.5000;
  37.       factor[ 4 ] := 1.0000;
  38.       factor[ 5 ] := 2.0000;
  39.       factor[ 6 ] := 4.0000;
  40.  
  41.       notes[ 49 ] := 1047;
  42.       notes[ 50 ] := 1109;
  43.       notes[ 51 ] := 1175;
  44.       notes[ 52 ] := 1245;
  45.       notes[ 53 ] := 1319;
  46.       notes[ 54 ] := 1397;
  47.       notes[ 55 ] := 1480;
  48.       notes[ 56 ] := 1568;
  49.       notes[ 57 ] := 1661;
  50.       notes[ 58 ] := 1760;
  51.       notes[ 59 ] := 1865;
  52.       notes[ 60 ] := 1976;
  53.       k := 48;
  54.       while k > 0 do begin
  55.          notes[ k ] := notes[ k+12 ] div 2;
  56.          k := pred(k);
  57.       end;
  58.       k := 61;
  59.       while k < 85 do begin
  60.          notes[ k ] := notes[ k-12 ] * 2;
  61.          k := succ(k);
  62.       end;
  63.  
  64.       dnote[ 0 ]  := 1.0;
  65.       dnote[ 1 ]  := 1.5;
  66.       dnote[ 2 ]  := 1.75;
  67.       dnote[ 3 ]  := 1.875;
  68.       dnote[ 4 ]  := 1.9375;
  69.       dnote[ 5 ]  := 1.96875;
  70.       dnote[ 6 ]  := 1.984375;
  71.  
  72.       tempo        := 120.0;
  73.       music_mode   := 0.875;
  74.       rest_mode    := 0.125;
  75.       octave       := 4;
  76.       note_length  := 4;
  77.    end;
  78.  
  79.    procedure
  80.       play_note( note,length,dcnt : integer );
  81.    var
  82.       dur                : real;
  83.    begin
  84.       dur  := 240.0 / tempo * a_second / length * dnote[dcnt] - 3.0;
  85.       if note > 100 then
  86.          sound( notes[ note - 100 ] )
  87.       else
  88.          if note <= 20 then
  89.             sound( round( scale[ note ] * factor[ octave ] ) )
  90.          else
  91.             nosound;
  92.       delay( round(dur * music_mode) );
  93.       if rest_mode > 0.09 then begin
  94.          nosound;
  95.          delay( round(dur * rest_mode) );
  96.       end;
  97.    end;
  98.  
  99.    function
  100.       mval( s : strtype; var i : integer ) : integer;
  101.    var
  102.       v  : integer;
  103.    begin
  104.       v:=0;
  105.       i:=succ(i);
  106.       while s[i] in [ '0'..'9' ] do begin
  107.          v:= ( v * 10 ) + ord(s[i]) - ord('0');
  108.          i:=succ(i);
  109.       end;
  110.       mval:=v;
  111.    end;
  112.  
  113.    procedure
  114.       play( ms : strtype );
  115.    var
  116.       i   : integer;
  117.       l   : integer;
  118.       n   : integer;
  119.    begin
  120.       if silent_mode then exit;
  121.       i := 1;
  122.       while i < length( ms ) do begin
  123.          if ms[i] in [ 'A'..'G','P' ] then begin
  124.             n := ( ( ord(ms[i]) - ord('A') ) * 3 ) + 1;
  125.             case ms[succ(i)] of
  126.                '#','+' : begin
  127.                             i:=succ(i);
  128.                             n:=succ(n);
  129.                          end;
  130.                '-'     : begin
  131.                             i:=succ(i);
  132.                             n:=pred(n);
  133.                          end;
  134.             end;
  135.             l:=mval( ms,i );
  136.             if l=0 then l:=note_length;
  137.             dots:=0;
  138.             while ms[i]='.' do begin
  139.                i:=succ(i);
  140.                dots:=succ(dots);
  141.             end;
  142.             play_note(n,l,dots);
  143.          end
  144.          else begin
  145.             case ms[i] of
  146.                'T' : begin
  147.                         tempo:=mval( ms,i );
  148.                         if tempo<32  then tempo:=32;
  149.                         if tempo>255 then tempo:=255;
  150.                      end;
  151.                'O' : begin
  152.                         octave:=mval( ms,i );
  153.                         if octave>6 then octave:=6;
  154.                      end;
  155.                '>' : begin
  156.                         if octave < 6 then octave := succ(octave);
  157.                         i:=succ(i);
  158.                      end;
  159.                '<' : begin
  160.                         if octave > 0 then octave := pred(octave);
  161.                         i:=succ(i);
  162.                      end;
  163.                'L' : begin
  164.                         note_length:=mval( ms,i );
  165.                         if note_length=0 then note_length:=4;
  166.                      end;
  167.                'N' : begin
  168.                         n:=mval( ms,i )+100;
  169.                         if n>184 then n:=184;
  170.                         dots:=0;
  171.                         while ms[i]='.' do begin
  172.                            i:=succ(i);
  173.                            dots:=succ(dots);
  174.                         end;
  175.                         play_note(n,note_length,dots);
  176.                      end;
  177.                'M' : begin
  178.                         i:=succ(i);
  179.                         case ms[i] of
  180.                            'N' : begin
  181.                                     music_mode := 0.875;
  182.                                     rest_mode  := 0.125;
  183.                                  end;
  184.                            'L' : begin
  185.                                     music_mode := 1.0;
  186.                                     rest_mode  := 0.0;
  187.                                  end;
  188.                            'S' : begin
  189.                                     music_mode := 0.75;
  190.                                     rest_mode  := 0.25;
  191.                                  end;
  192.                         end;
  193.                         i:=succ(i);
  194.                      end;
  195.             else
  196.                i:=succ(i);
  197.             end;
  198.          end;
  199.       end;
  200.       nosound;
  201.    end;
  202.