Page 2 of 3 FirstFirst 123 LastLast
Results 11 to 20 of 24

Thread: tone generation in .WAV format using Pascal

  1. #11

    tone generation in .WAV format using Pascal

    I have updated the cNotes array as I am now using the A note in octave 4 as the origin for my calculations and now the values are exactly the same as in the original table I had.

    [pascal]
    cNote_C = 0;
    cNote_Cs = 1; cNote_Db = 1;
    cNote_D = 2;
    cNote_Ds = 3; cNote_Eb = 3;
    cNote_E = 4;
    cNote_F = 5;
    cNote_Fs = 6; cNote_Gb = 6;
    cNote_G = 7;
    cNote_Gs = 8; cNote_Ab = 8;
    cNote_A = 9;
    cNote_Es = 10; cNote_Bb = 10;
    cNote_B = 11;
    cNotes : Array[0..11,0..8] Of Single =
    (
    //Octave
    //Note 0 1 2 3 4 5 6 7 8
    {C} (16.3515978312874, 32.7031956625748, 65.4063913251497, 130.812782650299, 261.625565300599, 523.251130601197, 1046.50226120239, 2093.00452240479, 4186.0090448095,
    {C#/Db} (17.3239144360545, 34.647828872109 , 69.295657744218 , 138.591315488436, 277.182630976872, 554.365261953744, 1108.73052390749, 2217.46104781498, 4434.92209562995),
    {D} (18.354047994838 , 36.7080959896759, 73.4161919793519, 146.832383958704, 293.664767917408, 587.329535834815, 1174.65907166963, 2349.31814333926, 4698.63628667852),
    {D#/Eb} (19.4454364826301, 38.8908729652601, 77.7817459305202, 155.56349186104 , 311.126983722081, 622.253967444162, 1244.50793488832, 2489.01586977665, 4978.03173955329),
    {E} (20.6017223070544, 41.2034446141088, 82.4068892282175, 164.813778456435, 329.62755691287 , 659.25511382574 , 1318.51022765148, 2637.02045530296, 5274.04091060592),
    {F} (21.8267644645628, 43.6535289291255, 87.307057858251 , 174.614115716502, 349.228231433004, 698.456462866008, 1396.91292573202, 2793.82585146403, 5587.65170292806),
    {F#/Gb} (23.1246514194772, 46.2493028389543, 92.4986056779086, 184.997211355817, 369.994422711634, 739.988845423269, 1479.97769084654, 2959.95538169308, 5919.91076338615),
    {G} (24.4997147488593, 48.9994294977187, 97.9988589954373, 195.997717990875, 391.995435981749, 783.990871963499, 1567.981743927 , 3135.96348785399, 6271.92697570799),
    {G#/Ab} (25.9565435987466, 51.9130871974931, 103.826174394986, 207.652348789973, 415.304697579945, 830.60939515989 , 1661.21879031978, 3322.43758063956, 6644.87516127912),
    {A} (27.5 , 55 , 110 , 220 , 440 , 880 , 1760 , 3520 , 7040 ),
    {A#/Bb} (29.1352350948806, 58.2704701897613, 116.540940379522, 233.081880759045, 466.16376151809 , 932.32752303618 , 1864.65504607236, 3729.31009214472, 7458.62018428944),
    {B} (30.8677063285078, 61.7354126570155, 123.470825314031, 246.941650628062, 493.883301256124, 987.766602512248, 1975.5332050245 , 3951.06641004899, 7902.13282009799)
    );

    [/pascal]

    cheers,
    Paul

  2. #12

    tone generation in .WAV format using Pascal

    thanks, i will study the sample of codeproject and try something later.
    From brazil (:

    Pascal pownz!

  3. #13

    tone generation in .WAV format using Pascal

    I did notice that I had a typo:

    cNote_Es = 10

    in the constants should be

    cNote_As = 10

    cheers,
    Paul

  4. #14

    tone generation in .WAV format using Pascal

    paul, the source of codeproject don't include the main stuff part =( (synth)

    did you know other place to get a sample?
    From brazil (:

    Pascal pownz!

  5. #15

    tone generation in .WAV format using Pascal

    Not sure if it helps, but you can find at least one of the dependencies (MIDI Toolkit) here http://www.codeproject.com/KB/audio-...DIToolkit.aspx

    cheers,
    Paul

  6. #16

    tone generation in .WAV format using Pascal

    I hope these links may be helpful:

    My softsynth page with links to more information about synth programming: http://www.emix8.org/static.php?page=SoftSynth

    And my open source project ZGameEditor features a synth with source code.
    ZGameEditor - Develop 64kb games for Windows.
    Thrust for Vectrex - ROM-file and 6809 source code.

  7. #17

    tone generation in .WAV format using Pascal

    Quote Originally Posted by paul_nicholls
    Not sure if it helps, but you can find at least one of the dependencies (MIDI Toolkit) here http://www.codeproject.com/KB/audio-...DIToolkit.aspx

    cheers,
    Paul
    same as the another, the code that "matters" is not included


    Quote Originally Posted by VilleK
    I hope these ]http://www.emix8.org/static.php?page=SoftSynth[/url]

    And my open source project ZGameEditor features a synth with source code.
    i liked what i heard from the demo, i will look at the source latter,
    and some awesome links!!!

    thanks for the help guys
    From brazil (:

    Pascal pownz!

  8. #18

    tone generation in .WAV format using Pascal

    Using information off the net about Direct Digital Synthesis (http://www.analog.com/library/analog...38-08/dds.html) as an example, I have created a Direct Digital Synthesizer class TDDS which can currently output square and sine waves (will upgrade to do triangle and sawtooth as well later).

    It can also be used to point to a custom lookup table so you can produce your own arbitrary waveform at the desired frequency and sample rate on top of the 4 built in wave types.

    You would do this using a custom TPhaseToAmplitude function to generate your own custom output.

    I hope you guys find it useful

    [pascal]
    Unit direct_digital_synthensizer;
    {$IFDEF fpc}
    {$MODE DELPHI} {$H+}
    {$ENDIF}
    Interface

    Type
    {................................................. .............................}
    TDDS = Class;
    TPhaseToAmplitude = Function(Const ADDS : TDDS) : Single;
    TNumberOfBits = 2..31;
    TWaveType = (wtSawtooth,wtSquare,wtTriangle,wtSine,wtCustom);
    TDefinedWaveType = Low(TWaveType)..Pred(High(TWaveType));
    TDDS = Class
    Private
    FOnPhaseToAmplitude : TPhaseToAmplitude;
    FPhaseRegResolution : TNumberOfBits;
    FPhaseRegMaxPlus1 : LongWord;
    FPhaseRegMax : LongWord;
    FPhaseRegHalfMax : LongWord;
    FPhaseRegQuaterMax : LongWord;
    FWaveType : TWaveType;
    FSampleRate : LongWord;
    FFrequency : Single;
    FPhase : LongWord;
    FPhaseReg : LongWord;
    FPhaseRegIncrement : LongWord;
    FAmplitude : Single;
    Procedure FSetOnPhaseToAmplitude(Const AValue : TPhaseToAmplitude);
    Procedure SetPhaseRegIncrement;
    Public
    Constructor Create(Const APhaseRegResolution : TNumberOfBits);
    Procedure SetWaveType (Const AValue : TDefinedWaveType);
    Procedure SetSampleRate(Const AValue : LongWord);
    Procedure SetFrequency (Const AValue : Single);
    Procedure Reset;
    Procedure Synthesize;
    Property PhaseRegResolution : TNumberOfBits Read FPhaseRegResolution;
    Property PhaseRegMaxPlus1 : LongWord Read FPhaseRegMaxPlus1;
    Property PhaseRegMax : LongWord Read FPhaseRegMax;
    Property PhaseRegHalfMax : LongWord Read FPhaseRegHalfMax;
    Property PhaseRegQuaterMax : LongWord Read FPhaseRegQuaterMax;
    Property WaveType : TWaveType Read FWaveType;
    Property SampeRate : LongWord Read FSampleRate;
    Property Frequency : Single Read FFrequency;
    Property Phase : LongWord Read FPhase;
    Property Amplitude : Single Read FAmplitude;
    Property OnPhaseToAmplitude : TPhaseToAmplitude Read FOnPhaseToAmplitude
    Write FSetOnPhaseToAmplitude;
    End;
    {................................................. .............................}

    Implementation

    {................................................. .............................}

    {................................................. .............................}
    Function PhaseToAmplitude_Sawtooth(Const ADDS : TDDS) : Single;
    Begin
    Result := 0;
    End;
    {................................................. .............................}

    {................................................. .............................}
    Function PhaseToAmplitude_Square(Const ADDS : TDDS) : Single;
    Begin
    If ADDS.Phase <= ADDS.PhaseRegHalfMax Then
    Result := -1
    Else
    Result := +1;
    End;
    {................................................. .............................}

    {................................................. .............................}
    Function PhaseToAmplitude_Triangle(Const ADDS : TDDS) : Single;
    Begin
    Result := 0;
    End;
    {................................................. .............................}

    {................................................. .............................}
    Function PhaseToAmplitude_Sine(Const ADDS : TDDS) : Single;
    Begin
    Result := Sin(2 * PI * ADDS.Phase/ADDS.PhaseRegMaxPlus1);
    End;
    {................................................. .............................}

    {................................................. .............................}
    Constructor TDDS.Create(Const APhaseRegResolution : TNumberOfBits);
    Begin
    Inherited Create;
    FOnPhaseToAmplitude := Nil;
    FPhaseRegResolution := APhaseRegResolution;
    FPhaseRegMaxPlus1 := LongWord((1 Shl FPhaseRegResolution));
    FPhaseRegMax := LongWord((1 Shl FPhaseRegResolution) - 1);
    FPhaseRegHalfMax := LongWord(FPhaseRegMaxPlus1 Shr 1);
    FPhaseRegQuaterMax := LongWord(FPhaseRegMaxPlus1 Shr 2);
    FSampleRate := 44100;
    FFrequency := 100;
    SetPhaseRegIncrement;
    SetWaveType(wtSine);
    Reset;
    End;
    {................................................. .............................}

    {................................................. .............................}
    Procedure TDDS.FSetOnPhaseToAmplitude(Const AValue : TPhaseToAmplitude);
    Begin
    If Not Assigned(AValue) Then Exit;
    FOnPhaseToAmplitude := AValue;
    FWaveType := wtCustom;
    End;
    {................................................. .............................}

    {................................................. .............................}
    Procedure TDDS.SetWaveType(Const AValue : TDefinedWaveType);
    Begin
    FWaveType := AValue;
    Case FWaveType Of
    wtSawtooth : FOnPhaseToAmplitude := PhaseToAmplitude_Sawtooth;
    wtSquare : FOnPhaseToAmplitude := PhaseToAmplitude_Square;
    wtTriangle : FOnPhaseToAmplitude := PhaseToAmplitude_Triangle;
    wtSine : FOnPhaseToAmplitude := PhaseToAmplitude_Sine;
    End;
    End;
    {................................................. .............................}

    {................................................. .............................}
    Procedure TDDS.SetPhaseRegIncrement;
    Begin
    FPhaseRegIncrement := LongWord(Trunc(FPhaseRegMax * FFrequency / FSampleRate)) And FPhaseRegMax;
    End;
    {................................................. .............................}

    {................................................. .............................}
    Procedure TDDS.SetSampleRate(Const AValue : LongWord);
    Begin
    FSampleRate := AValue;
    SetPhaseRegIncrement;
    End;
    {................................................. .............................}

    {................................................. .............................}
    Procedure TDDS.SetFrequency(Const AValue : Single);
    Begin
    FFrequency := AValue;
    SetPhaseRegIncrement;
    End;
    {................................................. .............................}

    {................................................. .............................}
    Procedure TDDS.Reset;
    Begin
    FPhase := 0;
    FPhaseReg := 0;
    End;
    {................................................. .............................}

    {................................................. .............................}
    Procedure TDDS.Synthesize;
    Begin
    FPhase := FPhaseReg;
    FAmplitude := FOnPhaseToAmplitude(Self);
    {$R-}
    FPhaseReg := LongWord(FPhaseReg + FPhaseRegIncrement) And FPhaseRegMax;
    {$R+}
    End;
    {................................................. .............................}

    {................................................. .............................}
    End.
    [/pascal]

    You set up the desired parameters in the class, call the Reset method once, and each time you need a sample, just call the Synthesize method to generate a value you can then read using the Amplitude or Phase properties.

    cheers,
    Paul

  9. #19

    tone generation in .WAV format using Pascal

    If it helps anyone, I have made a wav_buffer unit which allows you to create WAV format output to a stream like so:

    Code:
    Program WAV_buffer_test;
    Uses
        Classes,
        wav_buffer;
    
    Const
        cDuration_mSec    = 1000;
        cNumberOfChannels = 1;
        cSampleRate       = 44100;
        cBitsPerSample    = 16;
    Var
        fs     &#58; TFileStream;
        Buffer &#58; TWAVBuffer;
        i      &#58; LongWord;
        Sample &#58; Single;
    Begin
        fs &#58;= TFileStream.Create&#40;'c&#58;\test.wav',fmCreate&#41;;
        Try
            Buffer &#58;= TWAVBuffer.Create&#40;fs,cDuration_mSec,cNumberOfChannels,cBitsPerSample,cSampleRate&#41;;
            For i &#58;= 0 To Buffer.NumberOfSamples - 1 Do
            Begin
                // 1 complete sinewave cycle over the entire duration
                Sample &#58;= Sin&#40;2 * PI * i / Buffer.NumberOfSamples&#41;;
                Buffer.WriteSamples&#40;&#91;Sample&#93;&#41;;
            End;
        Finally
            fs.Free;
        End;
    End.
    for 2 channels (stereo) just add another sample to the Buffer.WriteSamples line like so:

    Code:
    Buffer.WriteSamples&#40;&#91;SampleL,SampleR&#93;&#41;;
    See unit below:

    Code:
    Unit wav_buffer;
    &#123;$IFDEF fpc&#125;
    &#123;$MODE DELPHI&#125; &#123;$H+&#125;
    &#123;$ENDIF&#125;
    Interface
    
    Uses
        Classes;
        
    Type
    &#123;..............................................................................&#125;
        TWAVBuffer = Class
        Private
            FStream           &#58; TStream;
            FDuration_mSec    &#58; LongWord;
            FNumberOfChannels &#58; Byte;
            FBitsPerSample    &#58; Byte;
            FSampleRate       &#58; LongWord;
            FNumberOfSamples  &#58; LongWord;
            FDataSize         &#58; LongWord;
            Procedure WriteWAVHeader;
        Public
            Constructor Create&#40;Const AStream            &#58; TStream;
                               Const ADuration_mSec     &#58; LongWord;
                               Const ANumberOfChannels  &#58; Byte;
                               Const ABitsPerSample     &#58; Byte;
                               Const ASampleRate        &#58; LongWord&#41;;
            Procedure Reset;
            Procedure WriteSamples&#40;Const ASamples &#58; Array Of Single&#41;;
            Property NumberOfSamples &#58; LongWord Read FNumberOfSamples;
        End;
    &#123;..............................................................................&#125;
    
    Implementation
    
    &#123;..............................................................................&#125;
    
    &#123;..............................................................................&#125;
    Constructor TWAVBuffer.Create&#40;Const AStream            &#58; TStream;
                                  Const ADuration_mSec     &#58; LongWord;
                                  Const ANumberOfChannels  &#58; Byte;
                                  Const ABitsPerSample     &#58; Byte;
                                  Const ASampleRate        &#58; LongWord&#41;;
    Begin
        FStream           &#58;= AStream;
        FDuration_mSec    &#58;= ADuration_mSec;
        FNumberOfChannels &#58;= ANumberOfChannels;
        FBitsPerSample    &#58;= ABitsPerSample;
        FSampleRate       &#58;= ASampleRate;
        If Not &#40;FNumberOfChannels In&#91;1,2&#93;&#41;  Then FNumberOfChannels &#58;= 1;
        If Not &#40;FBitsPerSample    In&#91;8,16&#93;&#41; Then FBitsPerSample    &#58;= 8;
        FNumberOfSamples  &#58;= &#40;FDuration_mSec * FSampleRate&#41; Div 1000;
        FDataSize         &#58;= &#40;FBitsPerSample Shr 3&#41; * FNumberOfChannels * FNumberOfSamples;
        WriteWAVHeader;
    End;
    &#123;..............................................................................&#125;
    
    &#123;..............................................................................&#125;
    Procedure TWAVBuffer.WriteWAVHeader;
    Const
        WAVE_FORMAT_PCM     = 1;
        RiffId &#58; AnsiString = 'RIFF';
        WaveId &#58; AnsiString = 'WAVE';
        FmtId  &#58; AnsiString = 'fmt ';
        DataId &#58; AnsiString = 'data';
    
    Type
        TWaveHeader = Packed Record
            wFormatTag      &#58; Word;     &#123; format type &#125;
            nChannels       &#58; Word;     &#123; number of channels &#40;i.e. mono, stereo, etc.&#41; &#125;
            nSamplesPerSec  &#58; LongWord; &#123; sample rate &#125;
            nAvgBytesPerSec &#58; LongWord; &#123; for buffer estimation &#125;
            nBlockAlign     &#58; Word;     &#123; block size of data &#125;
            wBitsPerSample  &#58; Word;     &#123; number of bits per sample of mono data &#125;
            cbSize          &#58; Word;     &#123; the count in bytes of the size of &#125;
        End;
    Var
        WaveHeader       &#58; TWaveHeader;
        RiffCount        &#58; Integer;
        TempInt          &#58; LongWord;
    Begin
        With WaveHeader Do
        Begin
            wFormatTag      &#58;= WAVE_FORMAT_PCM;
            nChannels       &#58;= FNumberOfChannels;
            nSamplesPerSec  &#58;= FSampleRate;
            wBitsPerSample  &#58;= FBitsPerSample;
            nBlockAlign     &#58;= nChannels * wBitsPerSample Shr 3;
            nAvgBytesPerSec &#58;= nSamplesPerSec * nBlockAlign;
            cbSize          &#58;= 0;
        End;
        &#123;Calculate length of sound data and of file data&#125;
        RiffCount &#58;= Length&#40;WaveId&#41; + Length&#40;FmtId&#41; + SizeOf&#40;LongWord&#41; +
                     SizeOf&#40;TWaveHeader&#41; + Length&#40;DataId&#41; + SizeOf&#40;LongWord&#41; + FDataSize; // file data
        &#123;write out the wave header&#125;
        FStream.Write&#40;RiffId&#91;1&#93; , 4&#41;;                // 'RIFF'
        FStream.Write&#40;RiffCount , SizeOf&#40;LongWord&#41;&#41;; // file data size
        FStream.Write&#40;WaveId&#91;1&#93; , Length&#40;WaveId&#41;&#41;;   // 'WAVE'
        FStream.Write&#40;FmtId&#91;1&#93;  , Length&#40;FmtId&#41;&#41;;    // 'fmt '
        TempInt &#58;= SizeOf&#40;TWaveHeader&#41;;
        FStream.Write&#40;TempInt    , SizeOf&#40;LongWord&#41;&#41;;   // TWaveFormat data size
        FStream.Write&#40;WaveHeader , SizeOf&#40;WaveHeader&#41;&#41;; // WaveFormatEx record
        FStream.Write&#40;DataId&#91;1&#93;  , Length&#40;DataId&#41;&#41;;     // 'data'
        FStream.Write&#40;FDataSize  , SizeOf&#40;LongWord&#41;&#41;;   // sound data size
    End;
    &#123;..............................................................................&#125;
    
    &#123;..............................................................................&#125;
    Procedure TWAVBuffer.Reset;
    Begin
        FStream.Seek&#40;0,soFromBeginning&#41;;
        WriteWAVHeader;
    End;
    &#123;..............................................................................&#125;
    
    &#123;..............................................................................&#125;
    Procedure TWAVBuffer.WriteSamples&#40;Const ASamples &#58; Array Of Single&#41;;
    Var
        Sample_8Bit  &#58; Byte;
        Sample_16Bit &#58; SmallInt;
        Sample       &#58; Single;
        i            &#58; Integer;
    Begin
        For i &#58;= 0 To High&#40;ASamples&#41; Do
        Begin
            Sample &#58;= ASamples&#91;i&#93;;
            // clip sample to between &#91;-1,+1&#93;
            If      Sample <1> +1.0 Then Sample &#58;= +1.0;
            // write sample to stream
            If FBitsPerSample = 8 Then
            Begin
                Sample_8Bit &#58;= 127 + Trunc&#40;127 * Sample&#41;;
                FStream.Write&#40;Sample_8Bit,SizeOf&#40;Sample_8Bit&#41;&#41;;
            End
            Else
            If FBitsPerSample = 16 Then
            Begin
                Sample_16Bit &#58;= Trunc&#40;32767 * Sample&#41;;
                FStream.Write&#40;Sample_16Bit,SizeOf&#40;Sample_16Bit&#41;&#41;;
            End;
        End;
    End;
    &#123;..............................................................................&#125;
    
    &#123;..............................................................................&#125;
    End.
    I hope someone finds this useful :-)
    cheers,
    Paul

  10. #20

    tone generation in .WAV format using Pascal

    As far as i can tell, you do not need an array to store the tone frequencies. They can be calculated using some formula (You have to search wikipedia, I'm sure it will be there somewhere )
    Coders rule nr 1: Face ur bugz.. dont cage them with code, kill'em with ur cursor.

Page 2 of 3 FirstFirst 123 LastLast

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •