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

    {
    This is for all the people who wanted a program to play wavs or so over
    the internal beeper. (This was taken from a German computer magazine; it
    has not been tested by me)
    }
    Program Speaker;
    {
     Frei nach DOS-International 11/94 (SPEAKER.PAS)
    }
    uses dos,crt;

    const OldInt : Word = 103;
          max = 50000;

    var oldV : Pointer;
        buf : array[0..max] of byte;
        f   : file;
        Rate,I,res,Leng : Word;
        dir : searchrec;
        indos : ^byte;

      procedure New; Interrupt;
        begin
          if I <= Leng then
            if buf[I] > $80 then
              Sound(rate) else NoSound;
          port[$20] := $20;
          Inc(I);
        end;

      procedure getindos;
        var r : registers;
        begin
          r.AH := $34;
          MsDos(r);
          indos := ptr(r.es,r.bx);
        end;

      procedure NewTimer(Freq:Word);
        var w : word;
        begin
          inline($FA); {CLI}
          w := 1193180 DIV Freq;
          Port[$43] := $36;
          Port[$40] := Lo(w);
          Port[$40] := Hi(w);

          GetIntVec(8,OldV);
          SetIntVec(8,@New);

          inline($FB); {STI}
        end;

      procedure OldTimer;
        begin
          inline($FA); {CLI}
          Port[$43] := $36;
          Port[$40] := 0;
          Port[$40] := 0;
          SetIntVec(8,OldV);
          inline($FB); {STI}
        end;

    var b : byte;

    begin
      getindos;
      if Paramcount = 2 then begin
        Assign(f,Paramstr(1)); reset(f,1);
        leng := filesize(f);
        if leng > max then leng := max;
        Blockread(f,buf,leng,res);
        I := 0;
        Val(ParamStr(2),Rate,res);
        NewTimer(Rate);
        Writeln('Playing ',paramstr(1));
        repeat
          b := buf[i];
          TextColor(10);
          if (b and 1 <> 0) then Write('þ');
          if (b and 2 <> 0) then Write('þ');
          if (b and 4 <> 0) then Write('þ');
          if (b and 8 <> 0) then Write('þ');
          if (b and 16 <> 0) then Write('þ');
          if (b and 32 <> 0) then Write('þ');
          TextColor(12);
          if (b and 64 <> 0) then Write('þ');
          if (b and 128 <> 0) then Write('þ');
          Write('        '#13);
          delay(40);
          if not (I <= Leng) then
            if (indos^ <= 1) then begin
              inline($FA); {CLI}
              i := 0;
              Blockread(f,buf,max,res);
              leng := res;
              inline($FB); {STI}
              end;
        until (I > Leng) or (port[$60] < $80);
        OldTimer; nosound;
        Close(f);
        end else begin
          Writeln('SPEAKER.PAS (c) by ?');
          Writeln;
          Writeln('Usage: SPEAKER <samplename> <samplingrate>');
          Writeln('Samplingrate sollte zwischen 8000 und 22000 liegen.');
          end;
    end.

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