Kids Cube/2_Music.iso/mel/music.pas

Pascal/Delphi Source File | 1992-07-27 | 11KB | 304 lines

unit Music;

{
   MUSIC.PAS allows you play music on IBM PC or compatible using the same
   set of commands that you would use with BASICA's "PLAY" command.

   The original module was written and uploaded by Gregory Arakelian
   (74017,223)  703-435-7137.   The code was unitized for Turbo Pascal
   4.0 by Ted Lassagne (70325,206).  Code was added to handle dotted
   notes.  Some error checking was added, and minor corrections and
   optimizations were made.

   Support for "<" and ">" was added by Alexei A. Efros, Jr. Octave
   numberation was also fixed.
}

{=======================================================================}

interface

uses CRT;

Procedure Play (TuneString:string);

  {Play interprets a string very similar to that used with the PLAY
   verb in BASICA.  The two major exceptions are that the "N" order
   is not interpreted and that variables cannot appear in the string.

   The string characters are interpreted as follows:

      A .. G    The musical notes A thru G.  A note may be followed
                by an accidental ('#' or '+' for sharp and '-' for
                flat.)  Additionally, a note (With optional sharp or
                flat) may also be followed by a number denoting the
                note length (1 for a whole note thru 64 for a 64th
                note.)   The note, with optional accidental and
                length, may also be followed by one or more dots
                ("."), each of which extends the note by one half
                of its existing value.  For example, two dots produce
                a length of 9/4 the original value, and three dots
                a length of 27/8 the original value.

      Ln        Specifies the default length of the notes following
                ("n" must be 1 for a whole note thru 64 for a 64th
                note.)  The initial default value is 4 (quarter note.)

      Mz        Specifies the fraction of the note length that the
                note is actually sounding.  "z" is one of the letters
                "S", "N", or "L", which have these meanings:

                   MS   Music staccato   (3/4 of note length)
                   MN   Music normal     (7/8 of note length)
                   ML   Music legato     (all of note length)

      On        Specifies the octave in which the notes following
                are to be played (0 thru 7).  The initial default
                octave is 3, which is the octave which begins at
                middle C.

      > and <   Changes the current octave up 1 or down 1.

      Pn        Specifies that no sound is to be made for an
                interval.  "n" (optional) is the note length (1
                for a whole note thru 64 for a 64th note.)  If "n"
                is omitted, the current default note length is used.
                One or more dots may follow, each of which extends
                the rest by one half of its existing value.

      Tn        Specifies the tempo in beats per minute (32 thru
                255.)  The initial default value is 120.

      Note: The playing may be interrupted at any time by pressing
      Control-Break or Control-C.  This terminates the program and
      returns control to the operating system.  If you want to
      change this, the keyboard checking code immediately follows
      the note playing code.

}

{=======================================================================}

implementation


Const
    SharpOffset = 60;

Var
    PitchArray : Array[1..120] Of Integer;
      {The first 56 entries in PitchArray are frequencies for
       the notes A..G in seven octaves.  Entries 60 thru 115
       are frequencies for the sharps of the notes in the
       first 56 entries.}
    BaseOctave : Integer;
    Octave     : Integer;
    GenNoteType: Integer;
    Tempo      : Integer;
    PlayFrac   : Byte;


{PlayInit sets default values for octave, note length, tempo, and
 note length modifier.  It sets up the array of frequencies for the
 notes.}

Procedure PlayInit;
  Const
      NextFreq    = 1.05946309436;
  Var
      RealFreq : Array[1..7] Of Real;
      BaseFreq : Real;
      J,K      : Integer;
  Begin

   {Set up default values}

    BaseOctave := 1;
    Octave := 3;         {Third octave - starts with middle C}
    GenNoteType := 4;    {Quarter note}
    Tempo := 120;        {120 beats per minute}
    PlayFrac := 7;       {Normal - note plays for 7/8 of time}

    {Set up frequency array}

    BaseFreq := 27.5;    {"A" four octaves below A-440}
    For J := 0 To 7 Do
      Begin
        RealFreq[1] := BaseFreq;
        RealFreq[2] := RealFreq[1]*NextFreq*NextFreq;
        RealFreq[3] := RealFreq[2]*NextFreq;
        RealFreq[4] := RealFreq[3]*NextFreq*NextFreq;
        RealFreq[5] := RealFreq[4]*NextFreq*NextFreq;
        RealFreq[6] := RealFreq[5]*NextFreq;
        RealFreq[7] := RealFreq[6]*NextFreq*NextFreq;
        BaseFreq := BaseFreq * 2;   {next octave}
        For K := 1 to 7 Do
          Begin
            PitchArray[J*7+K] := Round(RealFreq[K]);
            PitchArray[J*7+K+SharpOffset] := Round(RealFreq[K]*NextFreq);
          End;
      End;
  End;


{Play interprets the passed string and plays the specified notes for
 the specified time periods.   The orders in the string are interpreted
 as outlined in the interface section above.}

Procedure Play (TuneString:string);
  Var PlayTime,IdleTime,DotTime,NoteTime  : Integer;
      NoteType,PitchIndex,Position,Number : Integer;
      Code,TuneStrLen                     : Integer;
      Character                           : Char;

  Procedure NVal(Pos:integer; var v, code: integer);
  {Extracts a numeric value "v" from the tune string starting at
   the index Pos.  The returned value in "code" is the number of
   digits scanned plus one.}
     var  posn:integer;
     begin
        v := 0;
        posn := Pos;
        while (posn <= TuneStrLen) and
        (TuneString[posn] in ['0'..'9']) do begin
           v := v*10 + ord(TuneString[posn]) - ord ('0');
           posn := posn + 1;
        end;
        code := posn - Pos + 1;
     end {NVal};

  Procedure CheckDots;
  {Checks for dots after note or pause.  Each dot increases note
   or rest length by half.}
    begin
       while (Position <= TuneStrLen) and
       (TuneString[Position] = '.') do begin
          DotTime := DotTime + DotTime div 2;
          inc(Position)
       end;
    end {CheckDots};

  Begin {Play subroutine}
    CheckBreak := false;
    TuneStrLen := length(TuneString);
    Position := 1;

    Repeat
      NoteType := GenNoteType;
      DotTime := 1000;

      Character := upcase(TuneString[Position]);
      Case Character Of
        'A'..'G' : Begin
                     PitchIndex := (ord(Character)-64)+Octave*7;
                     If (Character='A') or (Character='B') Then
                       PitchIndex := PitchIndex + 7;  {next octave}
                     inc(Position);

                     {Check for sharp or flat}
                     if Position <= TuneStrLen then
                        case TuneString[Position] of
                          '#','+': begin
                            PitchIndex := PitchIndex+SharpOffset;
                            inc(Position);
                           end;
                          '-': begin
                            PitchIndex := PitchIndex+SharpOffset - 1;
                            inc(Position);
                           end;
                        End;

                     {Check for length following note}
                     if (Position <= TuneStrLen) and
                     (TuneString[Position] in ['0'..'9']) then begin
                        NVal(Position,NoteType,Code);
                        inc(Position, Code - 1)
                     end;

                     {Check for dots after note}
                     CheckDots;

                     {Play the note}
                     NoteTime := Round(DotTime/Tempo/NoteType*240);
                     PlayTime := Round(NoteTime*PlayFrac/8);
                     IdleTime := NoteTime-PlayTime;
                     Sound(PitchArray[PitchIndex]);
                     Delay(PlayTime);
                     if IdleTime <> 0 then begin
                        NoSound;
                        Delay(IdleTime)
                     end;

                     {Check for Ctl-Break pressed}
                     if keypressed and (ReadKey = ^C) then begin
                        NoSound;
                        halt
                     end;

                   End;
             'L' :  {Note length (1 thru 64).  "1" signifies a
                     whole note and "64" a 64th note.}
                   Begin
                     NVal (Position+1,GenNoteType,Code);
                     if (GenNoteType < 1) or (GenNoteType > 64) then
                        GenNoteType := 4;
                     inc(Position, Code);
                   End;
             'M' :  {Note length modifier - "S" for staccato,
                     "L" for legato, or "N" for normal.}
                   Begin
                     if Position < TuneStrLen then begin
                        Case upcase(TuneString[Position+1]) Of
                          'S' : PlayFrac := 6;
                          'N' : PlayFrac := 7;
                          'L' : PlayFrac := 8;
                        End;
                        inc(Position, 2);
                     end;
                   End;
             '<' : begin
                     Dec(octave);
                     inc(Position);
                   end;
             '>' : begin
                     Inc(octave);
                     inc(position);
                   end;
             'O' :  {Octave specification (0 thru 7)}
                   Begin
                     NVal (Position+1,Octave,Code);
                     Octave := Octave+BaseOctave;
                     if Octave > 7 then Octave := 3;
                     inc(Position, Code);
                   End;
             'P' :  {Pause (rest) followed by optional value of
                     1 thru 64, with "1" signifying a whole rest
                     and "64" a 64th rest.}
                   Begin
                     NoSound;
                     NVal (Position+1,NoteType,Code);
                     if (NoteType < 1) or (NoteType > 64) then
                        NoteType := GenNoteType;
                     inc(Position, Code);
                     CheckDots;
                     IdleTime := DotTime Div Tempo * (240 Div NoteType);
                     Delay (IdleTime);
                   End;
             'T' :  {Tempo - number of beats per minute (32 - 255)}
                   Begin
                     NVal (Position+1,Tempo,Code);
                     if (Tempo < 32) or (Tempo > 255) then
                        Tempo := 120;
                     inc(Position, Code);
                   End;
            Else inc(Position);   {Ignore spurious characters}
      End;
    Until Position > TuneStrLen;
    NoSound;
  End {Play};

Begin    {Initialization}

  PlayInit;

End.