DP Tool Club 8/CDASC08.ISO/NEWS/554/JUIN/DIGITEST.PAS

Pascal/Delphi Source File | 1993-10-07 | 7KB | 241 lines

Program RAWDigitalOutput;

(*************************************************************************)
(*                                                                       *)
(*  Programmed by David Dahl                                             *)
(*  This program and all routines are PUBLIC DOMAIN.                     *)
(*                                                                       *)
(*  If you use any of these routines in your own programs, I would       *)
(*  appreciate an acknowledgement in the docs and/or program.            *)
(*                                                                       *)
(*************************************************************************)

Uses  CRT,
      Digital;

Type  String4  = String[4];
      String35 = String[35];

Const MaxDevices = 9;

      DeviceCommand  : Array [1..MaxDevices] of String4 =
                        ('-L1',  '-L2',  '-L3',  '-L4',
                         '-P' ,  '-PM',
                         '-A' ,  '-SB',  '-GUS' );

      DeviceName     : Array [1..MaxDevices] of String35 =
                        ('LPT DAC on LPT1',
                         'LPT DAC on LPT2',
                         'LPT DAC on LPT3',
                         'LPT DAC on LPT4',
                         'PC Speaker (Polled Mode)',
                         'PC Speaker (Pulse Width Modulated)',
                         'Adlib / SoundBlaster FM',
                         'SoundBlaster DAC',
                         'Gravis UltraSound');

      SignedUnsigned  : Array [False .. True] of String35 =
                         ('Unsigned Sample',
                          'Signed Sample');


{-[ Return An All Capaitalized String ]-----------------------------------}
Function UpString (StringIn : String) : String;
Var TempString : String;
    Counter    : Byte;
Begin
     TempString := '';

     For Counter := 1 to Length (StringIn) do
         TempString := TempString + UpCase(StringIn[Counter]);

     UpString := TempString;
End;
{-[ Check If File Exists ]------------------------------------------------}
Function FileExists (FileName : String) : Boolean;
Var F : File;
Begin
     {$I-}
     Assign (F, FileName);
     Reset(F);
     Close(F);
     {$I+}
     FileExists := (IOResult = 0) And (FileName <> '');
End;
{=[ Comand Line Parameter Decode ]========================================}
Function FindOutPutDevice : DeviceType;
Var Counter       : Byte;
    DeviceCounter : Byte;
    Found         : Boolean;
    Device        : DeviceType;
Begin
     Counter := 1;
     Found   := False;
     Device  := PcSpeaker;

     While (Counter <= ParamCount) AND Not(Found) do
     Begin
          For DeviceCounter := 1 To MaxDevices do
              If UpString(ParamStr(Counter)) =
                 DeviceCommand[DeviceCounter] Then
              Begin
                   Device := DeviceType(DeviceCounter - 1);
                   Found  := True;
              End;

          Inc(Counter);
     End;

     FindOutPutDevice := Device;
End;
Function FindRawFileName : String;
Var FileNameFound : String;
    TempName      : String;
    Found         : Boolean;
    Counter       : Byte;
Begin
     FileNameFound   := '';

     Counter := 1;
     Found   := False;

     While (Counter <= ParamCount) AND Not(Found) do
     Begin
          TempName := UpString(ParamStr(Counter));

          If TempName[1] <> '-' Then
          Begin
               FileNameFound := TempName;
               Found         := True;
          End;

          Inc (Counter);
     End;

     FindRawFileName := FileNameFound;
End;
Function FindPlayBackRate : Word;
Var RateString : String;
    Rate       : Word;
    Found      : Boolean;
    Counter    : Byte;
    ErrorCode  : Integer;
Begin
     Rate := 22000;

     Counter := 1;
     Found   := False;

     While (Counter <= ParamCount) AND Not(Found) do
     Begin
          RateString := UpString(ParamStr(Counter));

          If Copy(RateString,1,2) = '-F' Then
          Begin
               RateString := Copy(RateString,3,Length(RateString)-2);

               Val (RateString, Rate, ErrorCode);

               If ErrorCode <> 0 Then
               Begin
                    Rate := 22000;
                    Writeln ('Error In Frequency. Using Default');
               End;

               Found := True;
          End;

          Inc (Counter);
     End;

     If Rate < 18
     Then
         Rate := 18
     Else
         If Rate > 44100 Then
            Rate := 44100;

     FindPlayBackRate := Rate;
End;

Function SignedSample : Boolean;
Var Found   : Boolean;
    Counter : Word;
Begin
     SignedSample := False;

     Found   := False;
     Counter := 1;

     While (Counter <= ParamCount) AND Not(Found) do
     Begin
          If UpString(ParamStr(Counter)) = '-S' Then
          Begin
               SignedSample := True;
               Found        := True;
          End;

          Inc(Counter);
     End;
End;
{=[ Main Program ]========================================================}
Var SampleName : String;
    SampleRate : Word;
    OutDevice  : DeviceType;
Begin
     Writeln;
     Writeln ('RAW Sound File Player V0.07');
     Writeln ('Programmed By David Dahl');
     Writeln ('Thanks to Emil Gilliam for Adlib digital output information');
     Writeln ('This Program is PUBLIC DOMAIN');

     If ParamCount <> 0 Then
     Begin
          SampleRate := FindPlayBackRate;
          SampleName := FindRawFileName;
          OutDevice  := FindOutPutDevice;

          Writeln;

          If SampleName <> '' Then
          Begin
               Writeln ('Raw File   : ',SampleName);
               Writeln ('Format     : ',SignedUnsigned[SignedSample]);
               Writeln ('Sample Rate: ',SampleRate);
               Writeln ('Device     : ',DeviceName[Ord(OutDevice)+1]);

               If FileExists (SampleName) Then
               Begin
                    SetOutputDevice  (OutDevice, SignedSample);

                    PlayRAWSoundFile (SampleName, SampleRate);
               End
               Else
                   Writeln ('Sound File Not Found.');
          End
          Else
              Writeln ('Filename Not Specified.');
     End
     Else
     Begin
          Writeln;
          Writeln ('USAGE:');
          Writeln (ParamStr(0),' [SWITCHES] <RAW DATA FILE>');
          Writeln;
          Writeln ('SWITCHES:');
          Writeln (' -P      PC Speaker, Polled (Default)');
          Writeln (' -L1     LPT DAC on LPT 1');
          Writeln (' -L2     LPT DAC on LPT 2');
          Writeln (' -L3     LPT DAC on LPT 3');
          Writeln (' -L4     LPT DAC on LPT 4');
          Writeln (' -A      Adlib/Sound Blaster FM');
          Writeln;
          Writeln (' -S      Signed Sample (Unsigned Default)');
          Writeln;
          Writeln (' -FXXXXX Frequency Of Sample. XXXXX can be any integer ',
                   'between 18 to 44100');
          Writeln ('         (22000 Default)');
     End;

     CleanUp;
End.