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

    {
    I've gotten tired of writing these routines and have gone on to other
    projects so I don't have time to work on them now.  I figured others may get
    some use out of them though.  They're not totally done yet, but what is there
    does work (as far as I can tell).  They support playing digitized Sound
    (signed or unsigned) at sample rates from 18hz to 44.1khz (at least on my
    386sx/25), on the PC Speaker (polled), LPT DACs (1-4) or Adlib FM channels. I
    was planning on adding Sound Blaster DAC, Gravis UltraSound, and PC Speaker
    (pulse width modulated) support.  I also planned on adding VOC support.  I
    may add those at a later date, but no promises.  I'll release any new updates
    (if there are any) through the PDN since these routines are a little long
    (this will be the ONLY post of these routines in this echo).  I haven't
    tested the LPT DAC routines, so could someone who has an LPT DAC please test
    them and let me know if they work?  (They SHOULD work, but you never know.)
    These routines work For me under Turbo Pascal V6.0 on my 386sx/25.
    }

    Unit Digital;
    (*************************************************************************)
    (*                                                                       *)
    (*  Programmed by David Dahl                                             *)
    (*  This Unit and all routines are PUBLIC DOMAIN.                        *)
    (*                                                                       *)
    (*  Special thanks to Emil Gilliam For information (and code!) on Adlib  *)
    (*  digital output.                                                      *)
    (*                                                                       *)
    (*  if you use any of these routines in your own Programs, I would       *)
    (*  appreciate an acknowledgement in the docs and/or Program... and I'm  *)
    (*  sure Mr. Gilliam wouldn't Object to having his name mentioned, too.  *)
    (*                                                                       *)
    (*************************************************************************)
    Interface

    Const
      BufSize       = 2048;

    Type
      BufferType = Array[1 .. BufSize] of Byte;
      BufPointer = ^BufferType;

      DeviceType = (LPT1, LPT2, LPT3, LPT4, PcSpeaker, PCSpeakPW, Adlib,
                    SoundBlaster, UltraSound);

    Var
      DonePlaying : Boolean;

    Procedure SetOutPutDevice(DeviceName : DeviceType; SignedSamples : Boolean);
    Procedure SetPlaySpeed(Speed : LongInt);

    Procedure PlayRAWSoundFile(FileName : String; SampleRate : Word);
    Function  LoadBuffer(Var F : File; Var BufP : BufPointer) : Word;
    Procedure PlayBuffer(BufPtr : BufPointer; Size : Word);

    Procedure HaltPlaying;
    Procedure CleanUp;

    Implementation

    Uses
      Crt;

    Const
      C8253ModeControl   = $43;
      C8253Channel       : Array [0..2] of Byte = ($40, $41, $42);
      C8253OperatingFreq = 1193180;
      C8259Command       = $20;

      TimerInterrupt     = $08;
      AdlibIndex         = $388;
      AdlibReg           = $389;

    Type
      ZeroAndOne = 0..1;

    Var
      DataLength  : Word;
      Buffer      : BufPointer;

      LPTAddress  : Word;
      LPTPort     : Array [1 .. 4] of Word Absolute $0040 : $0008;

      OldTimerInterrupt : Pointer;
      InterruptVector   : Array [0..255] of Pointer Absolute $0000 : $0000;

    {=[ Misc Procedures ]=====================================================}

    {-[ Clear Interrupt Flag (Disable Maskable Interrupts) ]------------------}
    Procedure CLI;
    Inline($FA);

    {-[ Set Interrupt Flag ]--------------------------------------------------}
    Procedure STI;
    Inline($FB);

    {=[ Initialize Sound Devices ]============================================}

    {-[ Initialize Adlib FM For Digital Output ]------------------------------}
    Procedure InitializeAdlib;
    Var
      TempInt : Pointer;

      Procedure Adlib(Reg, Data : Byte); Assembler;
      Asm
        mov  dx, AdlibIndex            { Adlib index port }
        mov  al, Reg

        out  dx,al                     { Set the index }

        { Wait For hardware to respond }
        in al, dx; in al, dx; in al, dx
        in al, dx; in al, dx; in al, dx

        inc  dx                        { Adlib register port }
        mov  al, Data
        out  dx, al                    { Set the register value }

        dec  dx                        { Adlib index port }

        { Wait For hardware to respond }
        in al, dx; in al, dx; in al, dx; in al, dx; in al, dx
        in al, dx; in al, dx; in al, dx; in al, dx; in al, dx
        in al, dx; in al, dx; in al, dx; in al, dx; in al, dx
        in al, dx; in al, dx; in al, dx; in al, dx; in al, dx
        in al, dx; in al, dx; in al, dx; in al, dx; in al, dx
        in al, dx; in al, dx; in al, dx; in al, dx; in al, dx
        in al, dx; in al, dx; in al, dx; in al, dx; in al, dx

      end;

    begin
      Adlib($00, $00);    { Set Adlib test Register }
      Adlib($20, $21);    { Operator 0: MULTI=1, AM=VIB=KSR=0, EG=1 }
      Adlib($60, $F0);    { Attack = 15, Decay = 0 }
      Adlib($80, $F0);    { Sustain = 15, Release = 0 }
      Adlib($C0, $01);    { Feedback = 0, Additive Synthesis = 1 }
      Adlib($E0, $00);    { Waveform = Sine Wave }
      Adlib($43, $3F);    { Operator 4: Total Level = 63, Attenuation = 0 }
      Adlib($B0, $01);    { Fnumber = 399 }
      Adlib($A0, $8F);
      Adlib($B0, $2E);    { FNumber = 143, Key-On }

      { Wait For the operator's sine wave to get to top and then stop it there
        That way, we have an operator who's wave is stuck at the top, and we can
        play digitized Sound by changing it's total level (volume) register. }

      Asm
        mov  al, 0                    { Get timer 0 value into DX }
        out  43h, al
        jmp  @Delay1

       @Delay1:
        in   al, 40h
        mov  dl, al
        jmp  @Delay2

       @Delay2:
        in   al, 40h

        mov  dh, al
        sub  dx, 952h                 { Target value }

       @wait_loop:
        mov  al, 0                    { Get timer 0 value into BX }
        out  43h, al
        jmp  @Delay3

       @Delay3:
        in   al, 40h
        mov  bl, al
        jmp  @Delay4

       @Delay4:
        in   al, 40h
        mov  bh, al
        cmp  bx, dx                   { Have we waited that much time yet? }
        ja   @wait_loop               { if no, then go back }

      end;

     { Now that the sine wave is at the top, change its frequency to 0 to keep
       it from moving  }

      Adlib($B0, $20);  { F-Number = 0 }
      Adlib($A0, $00);  { Frequency = 0 }

      Port[AdlibIndex] := $40;
    end;

    {=[ Sound Device Handlers ]===============================================}
    Procedure PlayPCSpeaker; Interrupt;
    Const
      Counter : Word = 1;
    begin
      if Not(DonePlaying) Then
      begin
        if Counter <= DataLength Then
        begin
          Port[$61] := (Port[$61] and 253) OR ((Buffer^[Counter] and 128) SHR 6);
          Inc(Counter);
        end
        else
        begin
          DonePlaying := True;
          Counter     := 1;
        end;
      end;

      Port[C8259Command] := $20; { Enable Interrupts }
    end;

    Procedure PlayPCSpeakerSigned; Interrupt;
    Const
      Counter : Word = 1;
    begin
      if Not(DonePlaying) Then
      begin
        if Counter <= DataLength Then
        begin
          Port[$61] := (Port[$61] and 253) OR
                       ((Byte(shortint(Buffer^[Counter]) + 128) AND 128) SHR 6);
          Inc(Counter);
        end
        else
        begin
          DonePlaying := True;
          Counter     := 1;
        end;
      end;

      Port[C8259Command] := $20; { Enable Interrupts }
    end;

    Procedure PlayLPT; Interrupt;
    Const
      Counter : Word = 1;
    begin
      if Not(DonePlaying) Then
      begin
        if Counter <= DataLength Then
        begin
          Port[LPTAddress] := Buffer^[Counter];
          Inc(Counter);
        end
        else
        begin
          DonePlaying := True;
          Counter     := 1;
        end;
      end;

      Port[C8259Command] := $20; { Enable Interupts }
    end;

    Procedure PlayLPTSigned; Interrupt;
    Const
      Counter : Word = 1;
    begin
      if Not(DonePlaying) Then
      begin
        if Counter <= DataLength Then
        begin
          Port[LPTAddress] := Byte(shortint(Buffer^[Counter]) + 128);
          Inc(Counter);
        end
        else
        begin
          DonePlaying := True;
          Counter     := 1;
        end;
      end;

      Port[C8259Command] := $20; { Enable Interupts }
    end;

    Procedure PlayAdlib; Interrupt;
    Const
      Counter : Word = 1;
    begin
      if Not(DonePlaying) Then
      begin
        if Counter <= DataLength Then
        begin
          Port[AdlibReg] := (Buffer^[Counter] SHR 2);
          Inc(Counter);
        end
        else
        begin
          DonePlaying := True;
          Counter     := 1;
        end;
      end;

      Port[C8259Command] := $20; { Enable Interupts }
    end;

    Procedure PlayAdlibSigned; Interrupt;
    Const
      Counter : Word = 1;
    begin
      if Not(DonePlaying) Then
      begin
        if Counter <= DataLength Then
        begin
          Port[AdlibReg] := Byte(shortint(Buffer^[Counter]) + 128) SHR 2;
          Inc(Counter);
        end
        else
        begin
          DonePlaying := True;
          Counter     := 1;
        end;
      end;

      Port[C8259Command] := $20; { Enable Interupts }
    end;

    {=[ 8253 Timer Programming Routines ]=====================================}
    Procedure Set8253Channel(ChannelNumber : Byte; ProgramValue : Word);
    begin
      Port[C8253ModeControl] := 54 or (ChannelNumber SHL 6); { XX110110 }
      Port[C8253Channel[ChannelNumber]] := Lo(ProgramValue);
      Port[C8253Channel[ChannelNumber]] := Hi(ProgramValue);
    end;

    {-[ Set Clock Channel 0 (INT 8, IRQ 0) To Input Speed ]-------------------}
    Procedure SetPlaySpeed(Speed : LongInt);
    Var
      ProgramValue : Word;
    begin
      ProgramValue := C8253OperatingFreq div Speed;
      Set8253Channel(0, ProgramValue);
    end;

    {-[ Set Clock Channel 0 Back To 18.2 Default Value ]----------------------}
    Procedure SetDefaultTimerSpeed;
    begin
      Set8253Channel (0, 0);
    end;

    {=[ File Handling ]=======================================================}

    {-[ Load Buffer With Data From Raw File ]---------------------------------}
    Function LoadBuffer(Var F : File; Var BufP : BufPointer) : Word;
    Var
      NumRead : Word;
    begin
      BlockRead(F, BufP^, BufSize, NumRead);
      LoadBuffer := NumRead;
    end;

    {=[ Sound Playing / Setup Routines ]======================================}

    {-[ Output Sound Data In Buffer ]-----------------------------------------}
    Procedure PlayBuffer(BufPtr : BufPointer; Size : Word);
    begin
      Buffer      := BufPtr;
      DataLength  := Size;
      DonePlaying := False;
    end;

    {-[ Halt Playing ]--------------------------------------------------------}
    Procedure HaltPlaying;
    begin
      DonePlaying := True;
    end;

    {=[ Initialize Data ]=====================================================}
    Procedure InitializeData;
    Const
      CalledOnce : Boolean = False;
    begin
      if Not(CalledOnce) Then
      begin
        DonePlaying       := True;
        OldTimerInterrupt := InterruptVector[TimerInterrupt];
        CalledOnce        := True;
      end;
    end;

    {=[ Set Interrupt Vectors ]===============================================}

    {-[ Set Timer Interrupt Vector To Our Device ]----------------------------}
    Procedure SetOutPutDevice(DeviceName : DeviceType; SignedSamples : Boolean);
    begin
      CLI;

      Case DeviceName of

        LPT1..LPT4 :
          begin
            LPTAddress := LPTPort[Ord(DeviceName)];
            if SignedSamples Then
              InterruptVector[TimerInterrupt] := @PlayLPTSigned
            else
              InterruptVector[TimerInterrupt] := @PlayLPT;
          end;

        PCSpeaker :
          if SignedSamples Then
            InterruptVector[TimerInterrupt] := @PlayPCSpeakerSigned
          else
            InterruptVector[TimerInterrupt] := @PlayPCSpeaker;

        Adlib :
          begin
            InitializeAdlib;
            if SignedSamples Then
              InterruptVector[TimerInterrupt] := @PlayAdlibSigned
            else
              InterruptVector[TimerInterrupt] := @PlayAdlib;
          end;

        else
          begin
            STI;

            Writeln;
            Writeln ('That Sound Device Is Not Supported In This Version.');
            Writeln ('Using PC Speaker In Polled Mode Instead.');

            CLI;
            if SignedSamples Then
              InterruptVector[TimerInterrupt] := @PlayPCSpeakerSigned
            else
              InterruptVector[TimerInterrupt] := @PlayPCSpeaker;
          end;
      end;
      STI;
    end;

    {-[ Set Timer Interupt Vector To Default Handler ]------------------------}
    Procedure SetTimerInterruptVectorDefault;
    begin
      CLI;
      InterruptVector[TimerInterrupt] := OldTimerInterrupt;
      STI;
    end;

    Procedure PlayRAWSoundFile(FileName : String; SampleRate : Word);
    Var
      RawDataFile : File;
      SoundBuffer : Array [ZeroAndOne] of BufPointer;
      BufNum      : ZeroAndOne;
      Size        : Word;
    begin
      New(SoundBuffer[0]);
      New(SoundBuffer[1]);

      SetPlaySpeed(SampleRate);

      Assign(RawDataFile, FileName);
      Reset(RawDataFile, 1);

      BufNum := 0;
      Size := LoadBuffer(RawDataFile, SoundBuffer[BufNum]);

      PlayBuffer(SoundBuffer[BufNum], Size);

      While Not(Eof(RawDataFile)) do
      begin
        BufNum := (BufNum + 1) and 1;
        Size   := LoadBuffer(RawDataFile, SoundBuffer[BufNum]);

        Repeat Until DonePlaying;

        PlayBuffer(SoundBuffer[BufNum], Size);
      end;

      Close (RawDataFile);

      Repeat Until DonePlaying;

      SetDefaultTimerSpeed;

      Dispose(SoundBuffer[1]);
      Dispose(SoundBuffer[0]);
    end;

    {=[ MUST CALL BEFORE ExitING Program!!! ]=================================}
    Procedure CleanUp;
    begin
      SetDefaultTimerSpeed;
      SetTimerInterruptVectorDefault;
    end;

    {=[ Set Up ]==============================================================}
    begin
      InitializeData;
      NoSound;
    end.

    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.

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