[Back to SOUND SWAG index] [Back to Main SWAG index] [Original]

    {===========================================================================
    Date: 08-31-93 (22:24)
    From: WIM VAN.VOLLENHOVEN
    Subj: Sound Module
    ---------------------------------------------------------------------------
    Well.. here is the source code i've found in a pascal toolbox (ECO)
    which emulates the play function of qbasic :-)

    {
      call: play(string)

            music_string --- the string containing the encoded music to be
                             played.  the format is the same as that of the
                             microsoft basic play statement.  the string
                             must be <= 254 characters in length.

      calls:  sound
              getint  (internal)

      remarks:  the characters accepted by this routine are:

                a - g       musical notes
                # or +      following a - g note, indicates sharp
                -           following a - g note, indicates flat
                <           move down one octave
                >           move up one octave
                .           dot previous note (extend note duration by 3/2)
                mn          normal duration (7/8 of interval between notes)
                ms          staccato duration
                ml          legato duration
                ln          length of note (n=1-64; 1=whole note,4=quarter note)
                pn          pause length (same n values as ln above)
                tn          tempo,n=notes/minute (n=32-255,default n=120)
                on          octave number (n=0-6,default n=4)
                nn          play note number n (n=0-84)

                the following two commands are ignored by play:

                mf          complete note before continuing
                mb          another process may begin before speaker is
                            finished playing note

      important --- setdefaultnotes must have been called at least once before
                    this routine is called.
    }

    unit u_play;
    interface

    uses
      crt

      ;

    const
      note_octave   : integer = 4;     { current octave for note            }
      note_fraction : real    = 0.875; { fraction of duration given to note }
      note_duration : integer = 0;     { duration of note     ^^semi-legato }
      note_length   : real    = 0.25;  { length of note }
      note_quarter  : real    = 500.0; { moderato pace (principal beat)     }

      procedure quitsound;
      procedure startsound;
      procedure errorbeep;
      procedure warningbeep;
      procedure smallbeep;
      procedure setdefaultnotes;
      procedure play(s: string);
      procedure beep(h, l: word);

    implementation

      procedure quitsound;
      var i: word;
      begin
        for i := 100 downto 1 do begin sound(i*10); delay(2) end;
        for i := 1 to 800 do begin sound(i*10); delay(2) end;
        nosound;
      end;

      procedure startsound;
      var i: word;
      begin
        for i := 100 downto 1 do begin sound(i*15); delay(2) end;
        for i := 1 to 100 do begin sound(i*15); delay(2) end; nosound;
        delay(100); for i := 100 downto 1 do begin sound(i*10); delay(2) end;
        nosound;
      end;

      procedure errorbeep;
      begin
        sound(2000); delay(75); sound(1000); delay(75); nosound;
      end;

      procedure warningbeep;
      begin
        sound(500); delay(500); nosound;
      end;

      procedure smallbeep;
      begin
        sound(300); delay(50); nosound;
      end;

    procedure setdefaultnotes;
    begin
       note_octave   := 4;             { default octave                      }
       note_fraction := 0.875;         { default sustain is semi-legato      }
       note_length   := 0.25;          { note is quarter note by default     }
       note_quarter  := 500.0;         { moderato pace by default            }
    end;

    procedure play(s: string);
    const
                                          { offsets in octave of natural notes }
     note_offset   : array[ 'A'..'G' ] of integer = (9,11,0,2,4,5,7);

                                          { frequencies for 7 octaves          }
       note_freqs: array[ 0 .. 84 ] of integer =
    {
          c    c#     d    d#     e     f    f#     g    g#     a    a#     b
    }
    (    0,
         65,  69,  73,  78,  82,  87,  92,  98, 104, 110, 116, 123,
        131, 139, 147, 156, 165, 175, 185, 196, 208, 220, 233, 247,
        262, 278, 294, 312, 330, 350, 370, 392, 416, 440, 466, 494,
        524, 556, 588, 624, 660, 700, 740, 784, 832, 880, 932, 988,
       1048,1112,1176,1248,1320,1400,1480,1568,1664,1760,1864,1976,
       2096,2224,2352,2496,2640,2800,2960,3136,3328,3520,3728,3952,
       4192,4448,4704,4992,5280,5600,5920,6272,6656,7040,7456,7904 );

       quarter_note = 0.25;            { length of a quarter note }

       digits : set of '0'..'9' = ['0'..'9'];

    var

       play_freq     : integer;        { frequency of note to be played }
       play_duration : integer;        { duration to sound note }
       rest_duration : integer;        { duration of rest after a note }
       i             : integer;        { offset in music string }
       c             : char;           { current character in music string }
                                       { note frequencies }
       freq          : array[0..6,0..11] of integer absolute note_freqs;
       n             : integer;
       xn            : real;
       k             : integer;

      function getint : integer;
      var n: integer;

      begin { getint }
        n := 0;
        while(s[i] in digits) do begin n := n*10+ord(s[i])-ord('0'); inc(i) end;
        dec(i); getint := n;
      end   { getint };

    begin
      s := s + ' ';                   { append blank to end of music string }
      i := 1;                           { point to first character in music }
      while(i < length(s)) do begin      { begin loop over music string }
        c := upcase(s[i]);        { get next character in music string }
        case c of                 { interpret it                       }
           'A'..'G' : begin { a note }
              n         := note_offset[ c ];
              play_freq := freq[ note_octave ,n ];
              xn := note_quarter * (note_length / quarter_note);
              play_duration := trunc(xn * note_fraction);
              rest_duration := trunc(xn * (1.0 - note_fraction));
                                          { check for sharp/flat }
              if s[i+1] in ['#','+','-' ] then
                 begin
                    inc(i);
                    case s[i] of
                       '#',
                       '+' : play_freq :=
                                freq[ note_octave ,succ(n) ];
                       '-' : play_freq :=
                                freq[ note_octave ,pred(n) ];
                       else  ;
                    end { case };

                 end;

                       { check for note length }

              if (s[i+1] in digits) then
                 begin

                    inc(i);
                    n  := getint;
                    xn := (1.0 / n) / quarter_note;

                    play_duration :=
                        trunc(note_fraction * note_quarter * xn);

                    rest_duration :=
                       trunc((1.0 - note_fraction) *
                              xn * note_quarter);

                 end;
                       { check for dotting }

                 if s[i+1] = '.' then
                    begin

                       xn := 1.0;

                       while(s[i+1] = '.') do
                          begin
                             xn := xn * 1.5;
                             inc(i);
                          end;

                       play_duration :=
                           trunc(play_duration * xn);

                    end;

                           { play the note }

              sound(play_freq);
              delay(play_duration);
              nosound;
              delay(rest_duration);
            end   { a note };

           'M' : begin { 'M' commands }
             inc(i);
             c := s[i];
             case c of
               'F' : ;
               'B' : ;
               'N' : note_fraction := 0.875;
               'L' : note_fraction := 1.000;
               'S' : note_fraction := 0.750;
               else ;
             end { case };
           end   { 'M' commands };

           'O' : begin { set octave }
             inc(i);
             n := ord(s[i]) - ord('0');
             if (n < 0) or (n > 6) then n := 4;
             note_octave := n;
           end   { set octave };

           '<' : begin { drop an octave }
             if note_octave > 0 then dec(note_octave);
           end   { drop an octave };

           '>' : begin { ascend an octave }
             if note_octave < 6 then inc(note_octave);
           end   { ascend an octave };

           'N' : begin { play note n }
             inc(i); n := getint;
             if (n > 0) and (n <= 84) then begin
               play_freq     := note_freqs[ n ];
               xn            := note_quarter * (note_length / quarter_note);
               play_duration := trunc(xn * note_fraction);
               rest_duration := trunc(xn * (1.0 - note_fraction));
             end else if (n = 0) then begin
               play_freq     := 0; play_duration := 0;
               rest_duration := trunc(note_fraction * note_quarter *
                                     (note_length / quarter_note));
             end;
             sound(play_freq); delay(play_duration); nosound;
             delay(rest_duration);
           end   { play note n };
           'L' : begin { set length of notes }
             inc(i); n := getint;
             if n > 0 then note_length := 1.0 / n;
           end   { set length of notes };

           'T' : begin { # of quarter notes in a minute }
             inc(i); n := getint;
             note_quarter := (1092.0 / 18.2 / n) * 1000.0;
           end   { # of quarter notes in a minute };

           'P' : begin { pause }
             inc(i); n := getint;
             if (n <  1) then n := 1 else if (n > 64) then n := 64;
             play_freq := 0; play_duration := 0;
             rest_duration := trunc(((1.0 / n) / quarter_note) * note_quarter);
             sound(play_freq); delay(play_duration); nosound;
             delay(rest_duration);
           end   { pause };

           else  { ignore other stuff };
        end { case };
        inc(i);
      end  { interpret music };
      nosound;                         { make sure sound turned off when through }
    end;

    procedure beep(h, l: word);
    begin
      sound(h); delay(l); nosound;
    end;

    end. { of unit }

[Back to SOUND SWAG index] [Back to Main SWAG index] [Original]