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

    program player;
    uses dos;

    VAR
      Param:string[63];
      BytesRead,BlockSize,BlockRest:Word;
      dataptr,pp:pointer;
      f:file;
      I:Integer;
      SampRateDiv,times:byte;
      reverse,wavinfo:boolean;
      fmt: record
        wFormatTag:word;
        nChannels:word;
        nSamplesPerSec:longint;
        nAvgBytesPerSec:longint;
        nBlockAlign:word;
        wBitsPerSample:word;
    end;

      PROCEDURE PlaySound(bufptr:pointer;bufctr:longint;ratediv,times:word)
    ;{assember;}
      var
        old_int8 : pointer;
        timesleft :word;
        savemask:byte;
      begin;
      ASM
            jmp     @PlayMain

      @int8_out_spk:
            xor     al,al
            out     42h,al
            mov     al,cl
            out     42h,al
            mov     ax,dx
            or      ax,si
            jz      @ready
            dec     bl
            jnz     @skip
            mov     bl,bh
            mov     al,es:[di]
            shr     al,1
            shr     al,1
            inc     al
            mov     cl,al
            inc     di
            jnz     @noseg
            mov     ax,es
            add     ax,1000h
            mov     es,ax
      @noseg:
            sub     si,+01
            sbb     dx,+00
      @skip:
            mov     al,20h
            out     20h,al
            iret
      @ready:
            mov     ch,0ffh
            jmp     @skip

      @PlayMain:
            cli
            mov     ax,3508h
            int     21h                    { get int vector 08 in es:bx }
            mov     word ptr old_int8,bx
            mov     word ptr old_int8+2,es
            in      al,21h                 { interruptmask }
            mov     savemask,al
            mov     al,0ffh                { disable all interrupts }
            out     21h,al
            sti
            push    ds
            mov     ax,cs
            mov     ds,ax
            mov     dx,offset @int8_out_spk
            mov     ax,2508h
            int     21h                    { set int vector 08 to ds:dx }
            pop     ds
            mov     al,34h
            out     43h,al                 { timer 0 mode }
            mov     al,36h                 { 22khz }
            out     40h,al
            xor     al,al
            out     40h,al
            mov     al,90h
            out     43h,al                 { timer 2 mode }
            in      al,61h                 { enable speaker }
            or      al,3
            out     61h,al
            mov     cx,times
            mov     timesleft,cx
            mov     cl,20h
            mov     bx,ratediv
            mov     bh,bl
            les     si,bufctr
            mov     dx,es
            les     di,bufptr
      @nexttime:
            push    di                     { bufptrlo }
            push    es                     { bufptrhi }
            push    si                     { bufctrlo }
            push    dx                     { bufctrhi }
            push    bx                     { ratediv  }
            xor     ch,ch                  { readyflag = false }
            mov     al,0feh                { enable timerinterrupt }
            out     21h,al
      @notready:
            or      ch,ch
            jz      @notready
            cli
            mov     al,0ffh                { disable all interrupts }
            out     21h,al
            sti
            pop     bx                     { ratediv }
            pop     dx                     { bufctrhi }
            pop     si                     { bufctrlo }
            pop     es                     { bufptrhi }
            pop     di                     { bufptrlo }
            dec     word ptr timesleft     { more times ? }
            jnz     @nexttime
            in      al,61h                 { disable speaker }
            and     al,0fch
            out     61h,al
            mov     al,34h
            out     43h,al                 { timer 0 mode }
            mov     al,0
            out     40h,al                 { timer 0 clock }
            out     40h,al                 { timer 0 clock }
            mov     al,0b6h
            out     43h,al                 { timer mode }
            mov     ax,533h
            out     42h,al                 { timer 2 spkr }
            mov     al,ah
            out     42h,al                 { timer 2 spkr }
            push    ds
            lds     dx,dword ptr old_int8
            mov     ax,2508h
            int     21h                    { set intrpt vector al to ds:dx }
            pop     ds
            mov     al,savemask            { enable timer and keyboard }
            out     21h,al
      END;
      end;

      { The following procedure is also used to half the samplerate }
      PROCEDURE Stereo2Mono(bufptr:pointer;bufctr:longint); assembler;
      ASM
            les     si,bufctr
            mov     dx,es
            les     di,bufptr
            push    ds
            mov     ax,es
            mov     ds,ax
            mov     bx,di
      @s2mNext:
            mov     ax,dx
            or      ax,si
            jz      @s2mRdy
            xor     ah,ah
            mov     al,es:[di]
            mov     cx,ax
            mov     al,es:[di+1]
            add     ax,cx
            shr     ax,1
            mov     ds:[bx],al
            inc     di
            jnz     @noseg1
            mov     ax,es
            add     ax,1000h
            mov     es,ax
      @noseg1:
            inc     di
            jnz     @noseg2
            mov     ax,es
            add     ax,1000h
            mov     es,ax
      @noseg2:
            inc     bx
            jnz     @noseg3
            mov     ax,ds
            add     ax,1000h
            mov     ds,ax
      @noseg3:
            sub     si,+01
            sbb     dx,+00
            jmp     @s2mNext
      @s2mRdy:
            pop     ds
      END;

      PROCEDURE ReverseData(bufptr:pointer;bufctr:longint); assembler;
      ASM
            push    ds
            les     bx,bufctr
            mov     dx,es
            les     di,bufptr
            mov     si,di
            add     si,bx                  { offset=offset+bufctrlo }
            mov     ax,dx
            adc     ax,0                   { bufctrhi=bufctrhi+carry }
            mov     cl,12
            shl     ax,cl
            mov     cx,ax
            mov     ax,es
            add     ax,cx
            mov     ds,ax                  {ds = segment of end of buffer}
            shr     dx,1
            rcr     bx,1                   { Bufctr = Bufctr / 2 }
      @RevNext:
            mov     ax,bx
            or      ax,dx
            jz      @RevRdy
            sub     si,+01
            jnc     @Rnoseg1
            mov     ax,ds
            sub     ax,1000h
            mov     ds,ax
      @Rnoseg1:
            mov     al,es:[di]             { swap bytes }
            xchg    al,ds:[si]
            mov     es:[di],al
            inc     di
            jnz     @Rnoseg2
            mov     ax,es
            add     ax,1000h
            mov     es,ax
      @Rnoseg2:
            sub     bx,+01
            sbb     dx,+00
            jmp     @RevNext
      @RevRdy:
            pop     ds
      END;

      PROCEDURE ReadFormat(var f:file);
      var
        str:string[4];
        chunksize:longint;
      BEGIN
        blockread(f,str[1],4);
        str[0]:=#4;
        if str='fmt ' then begin
          blockread(f,chunksize,4);
          if wavinfo then writeln('  ''fmt '' size=',chunksize);
          if chunksize=16 then begin
            blockread(f,fmt,sizeof(fmt));
            if wavinfo then with fmt do begin
              writeln('    wFormatTag=',wFormatTag);
              writeln('    nChannels=',nChannels);
              writeln('    nSamplesPerSec=',nSamplesPerSec);
              writeln('    nAvgBytesPerSec=',nAvgBytesPerSec);
              writeln('    nBlockAlign=',nBlockAlign);
              writeln('    wBitsPerSample=',wBitsPerSample);
            end;
            if fmt.wFormatTag<>1 then begin
              writeln('Unknown Format (',fmt.wFormatTag,')!');
              halt;
            end;
            case word(fmt.nSamplesPerSec) of
              33075..65535:sampratediv:=0;
              16538..33074:sampratediv:=1;
              9188..16537:sampratediv:=2;
              6432..9187:sampratediv:=3;
              4962..6431:sampratediv:=4;
              4043..4961:sampratediv:=5;
              3413..4042:sampratediv:=6;
              else halt;
            end;
          end
          else writeln('''fmt '' chunksize error (',chunksize,')!');
        end
        else writeln('''fmt'' chunk not found!');
      END;

     PROCEDURE PlayWAVE(var f:file;sampratediv,times:byte);
      var
        str:string[4];
        DataSize,l1:longint;
        p1,p2:pointer;
        s,o:word;
      BEGIN
        blockread(f,str[1],4);
        str[0]:=#4;
        if str='data' then begin
          blockread(f,DataSize,4);
          if wavinfo then writeln('  ''data'' size=',Datasize);
          If MaxAvail>DataSize THEN BEGIN
            if DataSize<$FFF0 then Blocksize:=DataSize else Blocksize:=$8000;
            GetMem(pp,BlockSize);
            DataPtr:=pp;
            blockread(f,pp^,BlockSize,bytesread);
            if BlockSize<DataSize then begin
              For I:=1 to pred(DataSize div BlockSize) do begin
                GetMem(pp,BlockSize);
                blockread(f,pp^,Blocksize,bytesread);
              end;
              BlockRest:=DataSize mod BlockSize;
              if BlockRest<>0 then begin
                GetMem(pp,BlockRest);
                blockread(f,pp^,BlockRest,bytesread);
              end;
            end;
            if fmt.nChannels=2 then begin
              if wavinfo then Write('Converting to mono..');
              Stereo2Mono(DataPtr,DataSize);
              DataSize:=DataSize shr 1;
              if wavinfo then writeln;
            end;
            if sampratediv=0 then begin
              sampratediv:=1;
              if wavinfo then Write('Dividing to half samplerate..');
              Stereo2Mono(DataPtr,DataSize);
              DataSize:=DataSize shr 1;
              if wavinfo then writeln;
            end;
            if reverse then ReverseData(DataPtr,DataSize);
            PlaySound(DataPtr,DataSize,SampRateDiv,Times);
          end
          else Writeln('Not enough memory!');
        end
        else writeln('''data'' chunk not found!');
      END;

      PROCEDURE ReadRIFF(var f:file);
      var
        str:string[4];
        RIFFsize,Chunksize:longint;
      BEGIN
        blockread(f,str[1],4);
        str[0]:=#4;
        if str='RIFF' then begin
          blockread(f,RIFFsize,4);
          if wavinfo then writeln('''RIFF'' size=',RIFFsize);
          REPEAT
            blockread(f,str[1],4);
            if str='WAVE' then begin
              ReadFormat(f);
              PlayWAVE(f,sampratediv,times);
            end
            else begin
              blockread(f,Chunksize,4);
              seek(f,filepos(f)+Chunksize);
            end;
          until filepos(f)>=RIFFsize+8;
        end
        else Writeln('No RIFF header found!');
      END;

      PROCEDURE ShowHelp;
      BEGIN
        Writeln('PLAYWAV  Bengt Holgersson 1991');
        Writeln('Use: PLAYWAV filename [/N:times] [/R] [/I]');
        Writeln('  /N:4   Play WAV 4 times');
        Writeln('  /R     Play WAV backwards');
        Writeln('  /I     Show info about WAV');
      END;

      procedure Getoption(s:string);
      var
        ch:char;
        W:word;
      begin
        if length(s)<2 then exit;
        ch:=s[2];
        case upcase(ch) of
          'R':reverse:=true;
          'N':begin
                if s[3]<>':' then exit;
                val(copy(s,4,255),times,w);
                if (w>0) or (times<1) then begin
                  writeln('times should be in the range 1-65535');
                end;
              end;
          'I':wavinfo:=true;
          '?':showhelp;
        end;
      end;

    BEGIN
      IF paramcount <1 then begin
        showhelp;
        halt;
      end;
      wavinfo:=false;
      reverse:=false;
      Times:=1;
      if paramcount >1 then begin
        for i:=2 to paramcount do getoption(paramstr(i));
      end;
      filemode:=0;
      Param:=paramstr(1);
      if Param[1]='/' then begin
        getoption(Param);
        halt;
      end;
      if pos('.',Param)=0 then Param:=Param+'.WAV';
      assign(f,Param);
      reset(f,1);
      IF Ioresult=0 then ReadRIFF(f)
      else writeln('File not found!');
    END.

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