Unit GWBleep; { Bleeper / BleepInt / GWBleep Version 5.2 }


{ This unit is BETA code - it works OK for me, but it hasn't been used much yet }


{ Copyright 1999 Andy Preston - Apollo Developments, Swindon U.K. andy@anorak.org.uk

  HACKERS OF THE WORLD UNITE!    HACKERS OF THE WORLD UNITE!    HACKERS OF THE WORLD UNITE!    HACKERS OF THE WORLD UNITE!

  Play tunes on the PC speaker using a syntax like GWBasic's Play statement, using the bleeper unit, see bleepint.htm for details

  This unit is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public
  License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version.

  This unit is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public License for more details.

  You should have received a copy of the GNU Library General Public License along with this unit; if not, write to the
  Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
}

Interface

Procedure PlayBleep (Str : String);

Implementation

Uses
  SysUtils, Bleeper;

Type
  TOctave=1..7;
  TNoteLength=1..64;
  TNote= (NoteC, NoteCs, NoteD, NoteDs, NoteE, NoteF, NoteFs, NoteG, NoteGs, NoteA, NoteAs, NoteB, NoteBad);
  TPlayable=NoteC..NoteB;

  { Approximate frequencies based on table in 'Electronic Music And Musique Concreté' }
  { By F. C. Judd A.Inst.E. Neville Spearman, London, 1961                            }

Const
  Freq : Array [TPlayable, TOctave]Of Word= (
     ({16,} 33, 65, 131, 262, 523, 1047, 2093 {, 4168, 8372} ),
     ({17,} 35, 69, 139, 277, 554, 1109, 2217 {, 4435, 8870} ),
     ({18,} 37, 73, 147, 294, 587, 1174, 2344 {, 4699, 9397} ),
     ({19,} 39, 78, 156, 311, 622, 1245, 2489 {, 4978, 9956} ),
     ({21,} 41, 82, 165, 330, 659, 1319, 2637 {, 5274, 10548} ),
     ({22,} 44, 87, 175, 349, 698, 1397, 2794 {, 5588, 11175} ),
     ({23,} 46, 92, 185, 370, 740, 1480, 2960 {, 5920, 11840} ),
     ({24,} 49, 98, 196, 392, 784, 1568, 3136 {, 6271, 12542} ),
     ({26,} 52, 104, 208, 415, 831, 1661, 3322 {, 6645, 13290} ),
     ({28,} 55, 110, 220, 440, 880, 1760, 3520 {, 7040, 14080} ),
     ({29,} 59, 117, 233, 466, 932, 1865, 3729 {, 7459, 14917} ),
     ({31,} 62, 123, 247, 494, 988, 1976, 3951 {, 7902, 15804} )
    );

  Natural : Array ['A'..'G']Of TNote= (NoteA, NoteB, NoteC, NoteD, NoteE, NoteF, NoteG);
  Sharp : Array ['A'..'G']Of TNote= (NoteAs, NoteBad, NoteCs, NoteDs, NoteBad, NoteFs, NoteGs);
  Flat : Array ['A'..'G']Of TNote= (NoteGs, NoteAs, NoteBad, NoteCs, NoteDs, NoteBad, NoteFs);

  WholeNoteDur : Integer=1024; // Makes it easy if it's a multiple of 64

Var
  ResetOctave, Octave : TOctave;
  ResetNoteLength, NoteLength : TNoteLength;
  Duration : LongInt;

Function GetANumber (Str : String; Var Position : Integer) : Integer;
Var
  P : Integer;
Begin
  P:=Position+1;
  While (P<=Length (Str))And (Str [P]In ['0'..'9'])Do Inc (P);
  If Not (Str [P]In ['0'..'9'])Then Dec (P);
  If P<=Position Then Result:=-1
  Else Begin
    Result:=StrToInt (Copy (Str, Position+1, (P-Position)));
    Position:=P;
  End;
End;

Procedure SetNoteLength (NewLen : TNoteLength);
Begin
  NoteLength:=NewLen;
  Duration:=WholeNoteDur Div NoteLength;
End;

Procedure PlayBleep (Str : String);
Var
  ANumber, C : Integer;
  Note : TPlayable;
  Command : Char;

  Procedure TryNoteLength;
  Var
    ANumber : Integer;
  Begin
    ANumber:=GetANumber (Str, C);
    If ANumber>-1 Then SetNoteLength (TNoteLength (ANumber));
  End;

Begin
  C:=1;
  While C<=Length (Str)Do Begin
    Command:=Str [C];
    Case Command Of
      '>' : If Octave<High (TOctave)Then Begin
          ResetOctave:=Octave;
          Octave:=Succ (Octave);
        End;
      '<' : If Octave>Low (TOctave)Then Begin
          ResetOctave:=Octave;
          Octave:=Pred (Octave);
        End;
      'A'..'G' : Begin
          If C=Length (Str)Then Note:=Natural [Command]
          Else Begin
            If Str [C+1]In ['#', '+']Then Begin
              Note:=Sharp [Command];
              C:=C+1;
            End
            Else If Str [C+1]='-' Then Begin
              Note:=Flat [Command];
              C:=C+1;
            End
            Else Note:=Natural [Command];
          End;
          TryNoteLength;
          If Note=NoteBad Then Raise Exception.Create ('Illegal note');
          DoBleep (Freq [Note, Octave], Duration);
          Octave:=ResetOctave;
          SetNoteLength (ResetNoteLength);
        End;
      'L' : Begin
          TryNoteLength;
          ResetNoteLength:=NoteLength;
        End;
      'O' : Begin
          ANumber:=GetANumber (Str, C);
          If ANumber>-1 Then Begin
            Octave:=TOctave (ANumber);
            ResetOctave:=Octave;
          End;
        End;
      'P' : Begin
          TryNoteLength;
          BleepPause (Duration);
          SetNoteLength (ResetNoteLength);
        End;
    End;
    C:=C+1;
  End;
End;

Initialization
  SetNoteLength (1);
  ResetNoteLength:=NoteLength;
  Octave:=4;
  ResetOctave:=Octave;

End.