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

    {
    RYNHARDT HAARHOFF

    > Help!!! Does anyone have and source code for sampling through the
    > Sound Blaster??? Its to do with my 'A' Level Project!!!!

    the following is a small program using "realtime" sampling. If you would
    rather use the CT-VOICE driver then please tell me so.

    PLEASE NOTE: this was written for a VGA screen, and it uses direct video
    memory access in 320x200 mode. If you have any problems with the screen, then
    revert back to the BGI, and replace PutDot with PutPixel. It will be slightly
    slower then :-(
    I have an SB PRO, so I can't guarantee it will work on any other SB, or
    on any other system. Use at own risk :-)
    }

    Program VoiceScope;

    uses
      Crt;

    const
      ResetPort    = $226;
      CommandPort  = $22C;
      ReadPort     = $22A;
      PollPort     = $22E;
      MaxOldDots   = 50000;  {max size of the array}
      MixerRegPort = $224;   {Volume : Hi nibble = left, Lo Nibble = right}
      MixerDatPort = $225;
      Master       = 35;
      Line         = 46;
      VOC          = 21;
      FM           = 23;     {Hi nibble = FM channel; Lo nibble = volume}
      CD           = 25;
      Mic          = 27;
      ADCChannel   = 29;
      StereoSell   = 31;     {0,1 = mono; 2,3 = stereo}

    var
      Scr       : array [0..199, 0..319] of byte absolute $A000:0000;
      Ch        : char;
      XInt,
      XWidth,
      XMax,
      YMax,
      XMid,
      YMid,
      MaxHeight,
      XStart,
      Color,
      ColorBack : integer;
      OldDots   : array [0..MaxOldDots] of byte;     {to store old dots}

    Procedure InitVideo(Mode : byte; Clr : boolean);
    begin
      if NOT Clr then
        Mode := Mode + 128;
      ASM
        mov AH, 00
        mov AL, Mode
        int 10h
      end;
    end;

    Procedure PutDot(x, y : word; Color : byte);
    begin
      Scr[y, x] := Color;
    end;

    Procedure SquareFill(x1, y1, x2, y2 : word; Color : byte);
    var
      y : word;
    begin
      for y := y1 to y2 do
        FillChar(Scr[y, x1], x2-x1, Color);
    end;

    Procedure SetMixer(PortNum, Vol : byte);  {Set mixer ports}
    begin
      asm
        MOV DX, MixerRegPort       {Select register port}
        MOV AL, PortNum            {Select which channel}
        OUT DX, AL
        MOV DX, MixerDatPort       {Select data port}
        MOV AL, Vol                {Write volume/data}
        OUT DX, AL
      end;
    end;

    Function ResetSB : boolean;      {resets the SB}
    begin
      Port[ResetPort] := 1;
      Delay(1);
      Port[ResetPort] := 0;
      Delay(1);
      if Port[PollPort] and 128 = 128 then
        ResetSB := True
      else
        ResetSB := False;
    end;

    Procedure ShowDots(D : integer);   {show the voice data}
    var
      x, y : word;
      NewX : word;
    begin
      for x := 1 to XWidth * d do
      begin
        port[CommandPort] := $20;                     { these three lines }
        repeat until (port[PollPort] and 128 = 128);  { gets the actual   }
        y := port[ReadPort];                          { data from the SB  }

        if y > 128 + MaxHeight then
          y := 128 + MaxHeight;
        if y < 128 - MaxHeight then
          y := 128 - MaxHeight;

        NewX := x div d;
        PutDot(NewX + XStart, OldDots[x] + YMid - 128, ColorBack);
        PutDot(NewX + XStart, y + YMid - 128, y div 2);
        OldDots[x] := y;
      end;
      if keypressed then
      begin    {pause}
        Ch := ReadKey;
        if Ch = #32 then
          repeat until keypressed;
      end;
    end;

    Procedure Init;    {initialize all the variables}
    var
      N : longint;
    begin
      InitVideo($13, TRUE);
      Ch        := #0;
      XMax      := 319;
      XMid      := XMax div 2;
      YMax      := 199;
      YMid      := YMax div 2;
      XInt      := 10;
      XWidth    := 280;
      XStart    := XMid - XWidth div 2;
      MaxHeight := 60;
      Color     := 9;
      ColorBack := 0;
      SquareFill(XStart-10, YMid-MaxHeight-1-10, XStart+XWidth+1+10, YMid+MaxHeight+1+10, 10);
      SquareFill(XStart, YMid-MaxHeight-1, XStart+XWidth+1, YMid+MaxHeight+1, ColorBack);
      for N := 0 to MaxOldDots do
        OldDots[N] := 128;
      if ResetSb then;
    end;

    BEGIN
      Init;
      SetMixer(ADCChannel, 1);   {Sets the ADC channel to MIC}

      {NOTE: I don't know if the mixer routines will work on any other
             SB. If something stalls, then exclude the mixer statements
             If you want to use the LINE-IN, then SetMixer(ADCChannel, 6);}

      While Ch <> #27 do ShowDots(1);    {This value is a time constant}
    END.

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