Re: Help requested to make a train of symmetric pulse

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

 



Source code in Fotran (Standard F90) to generate a wav file


On 25/07/2017 14:36, Bengt Nilsson wrote:
Dear all,

sox man pages are i bit overwhelming for a newbie like me, not surprising for such an extensive and powerful toolbox.
So I need some hints to get started.

I need to create a sequence of symmetric pulses, first 2ms positive, then 2ms negative, then 0 for 996ms, repeated for 100 seconds. 
 




I realise I probably need synth, delay or pad for this but I have a difficulty figuring out what the parameter are and how to put it all together.
Also, I assume there are both smart and stupid ways to do it.

Any constructive suggestions are appreciated.
While waiting, I will continue to RTFM.



Bengt Nilsson
Ansåsvägen 8
43853 Hindås
Sweden








------------------------------------------------------------------------------
Check out the vibrant tech community on one of the world's most
engaging tech sites, Slashdot.org! http://sdm.link/slashdot


_______________________________________________
Sox-users mailing list
Sox-users@xxxxxxxxxxxxxxxxxxxxx
https://lists.sourceforge.net/lists/listinfo/sox-users


Libre de virus. www.avast.com
! I need to create a sequence of symmetric pulses, first 2ms positive, then 2ms negative,
! then 0 for 996ms, repeated for 100 seconds.

    IMPLICIT NONE
    INTEGER(4) I
    INTEGER(4),PARAMETER :: N=44100
    INTEGER(4),PARAMETER :: SECONDS=100
    INTEGER(2) :: SEQ(N*SECONDS)
    INTEGER(4) :: K
    INTEGER(4) :: J
    REAL(4) :: T
    REAL(4) :: INTERV
    REAL(4) :: T1
    REAL(4) :: T2
    INTEGER(2) :: PULSE_MAG
    CHARACTER(LEN=256) :: FICHERO
    INTEGER(2) :: NUMCHANNELS=1


    INTERV=1000./REAL(N)
    T1=2.
    T2=4.
    PULSE_MAG=20000
    K=1
    DO J=1,SECONDS
      WRITE(*,*)'SEC',J
      T=0.
      DO I=1,N
        IF(T <= T1)THEN
          SEQ(K)=PULSE_MAG
        ELSE IF(T > T1 .AND. T <= T2)THEN
          SEQ(K)=-PULSE_MAG
        ELSE
        SEQ(K)=0_2
        ENDIF
        T=T+INTERV
        K=K+1
      ENDDO
    ENDDO
    FICHERO='PP.WAV'
    WRITE(*,*)'START CREATING WAV FILE....(WAIT)'
    CALL FICHERO_WAV_MONO(FICHERO,SEQ,NUMCHANNELS,N*SECONDS)
    WRITE(*,*)'END CREATING WAV FILE'
    END

    SUBROUTINE FICHERO_WAV_MONO(FICHERO,DATOS_I2,NumChannels,NumSamples)
    IMPLICIT NONE

    CHARACTER(LEN=256) :: FICHERO
    INTEGER(4) :: NUMSAMPLES
    CHARACTER(LEN=4) :: CHUNKID
    INTEGER(4) :: CHUNKSIZE
    CHARACTER(LEN=4) :: FORMATT
    CHARACTER(LEN=4) :: SUBCHUNK1ID
    CHARACTER(LEN=4) :: SUBCHUNK2ID
    INTEGER(4) :: SUBCHUNK1SIZE
    INTEGER(4) :: SUBCHUNK2SIZE
    INTEGER(2) :: AUDIOFORMAT
    INTEGER(2) :: NUMCHANNELS
    INTEGER(4) :: SAMPLERATE
    INTEGER(4) :: BYTERATE
    INTEGER(2) :: BLOCKALIGN
    INTEGER(2) :: BITSPERSAMPLE
    INTEGER(4) :: I

    INTEGER(2) :: DATOS_I2(NUMSAMPLES*NUMCHANNELS)

    OPEN(UNIT=517,FILE=TRIM(FICHERO),ACCESS='STREAM')


    CHUNKID='RIFF'
    BITSPERSAMPLE=16
    SUBCHUNK2SIZE = NUMSAMPLES * NUMCHANNELS
    SUBCHUNK1SIZE=16
    CHUNKSIZE=4 + (8 + SUBCHUNK1SIZE) + (8 + SUBCHUNK2SIZE)
    FORMATT='WAVE'
    SUBCHUNK1ID='fmt '
    AUDIOFORMAT=1

    SAMPLERATE=44100
    BYTERATE=SAMPLERATE*NUMCHANNELS*BITSPERSAMPLE/8
    BLOCKALIGN=NUMCHANNELS*BITSPERSAMPLE/8_2
    SUBCHUNK2ID='data'

!The canonical WAVE format starts with the RIFF header:

!0         4   ChunkID          Contains the letters "RIFF" in ASCII form   (0x52494646 big-endian form).
!4         4   ChunkSize        36 + SubChunk2Size, or more precisely:
!                               4 + (8 + SubChunk1Size) + (8 + SubChunk2Size)
!                               This is the size of the rest of the chunk
!                               following this number.  This is the size of the
!                               entire file in bytes minus 8 bytes for the
!                               two fields not included in this count:
!                               ChunkID and ChunkSize.
!8         4   Format           Contains the letters "WAVE"
!                               (0x57415645 big-endian form).

!The "WAVE" format consists of two subchunks: "fmt " and "data":
!The "fmt " subchunk describes the sound data's format:

!12        4   Subchunk1ID      Contains the letters "fmt "
!                               (0x666d7420 big-endian form).
!16        4   Subchunk1Size    16 for PCM.  This is the size of the rest of the Subchunk which follows this number.
!20        2   AudioFormat      PCM = 1 (i.e. Linear quantization) Values other than 1 indicate some form of compression.
!22        2   NumChannels      Mono = 1, Stereo = 2, etc.
!24        4   SampleRate       8000, 44100, etc.
!28        4   ByteRate         == SampleRate * NumChannels * BitsPerSample/8
!32        2   BlockAlign       == NumChannels * BitsPerSample/8
!                               The number of bytes for one sample including
!                               all channels. I wonder what happens when
!                               this number isn't an integer?
!34        2   BitsPerSample    8 bits = 8, 16 bits = 16, etc.
!          2   ExtraParamSize   if PCM, then doesn't exist
!          X   ExtraParams      space for extra parameters

!The "data" subchunk contains the size of the data and the actual sound:

!36        4   Subchunk2ID      Contains the letters "data" (0x64617461 big-endian form).
!40        4   Subchunk2Size    == NumSamples * NumChannels * BitsPerSample/8
!                               This is the number of bytes in the data.
!                               You can also think of this as the size
!                               of the read of the subchunk following this
!                               number.
!44        *   Data             The actual sound data.

    WRITE(517)CHUNKID
    WRITE(517)CHUNKSIZE
    WRITE(517)FORMATT
    WRITE(517)SUBCHUNK1ID
    WRITE(517)SUBCHUNK1SIZE
    WRITE(517)AUDIOFORMAT
    WRITE(517)NUMCHANNELS
    WRITE(517)SAMPLERATE
    WRITE(517)BYTERATE
    WRITE(517)BLOCKALIGN
    WRITE(517)BITSPERSAMPLE
    WRITE(517)SUBCHUNK2ID
    WRITE(517)SUBCHUNK2SIZE
    DO I=1,SUBCHUNK2SIZE
      WRITE(517)DATOS_I2(I)
    ENDDO
    CLOSE(UNIT=517)
    RETURN

    END
------------------------------------------------------------------------------
Check out the vibrant tech community on one of the world's most
engaging tech sites, Slashdot.org! http://sdm.link/slashdot
_______________________________________________
Sox-users mailing list
Sox-users@xxxxxxxxxxxxxxxxxxxxx
https://lists.sourceforge.net/lists/listinfo/sox-users

[Index of Archives]     [Linux Sound]     [ALSA Users]     [ALSA Devel]     [Linux Audio Users]     [Linux Media]     [Kernel]     [Photo Sharing]     [Gimp]     [Yosemite News]     [Linux Media]

  Powered by Linux