Discrete Fourier Transform
The maximum sampling rate of ADC converter in ADuC7020 chip on
FORTHstamp is 1 MSPS, which is more than adequate to sample audio
signals. A condenser microphone powered by 3.3V power supply through a
2k resister can be connected directly to the input of one ADC channel and
you get a perfect Audio Spectrum Analyzer. The FORTH source code can
be downloaded to eForth system on FORTHstamp through HyperTerminal
and the ADCC command shows a continuing audio spectrum.
The maximum sampling rate of ADC converter in ADuC7020 chip on
FORTHstamp is 1 MSPS, which is more than adequate to sample audio
signals. A condenser microphone powered by 3.3V power supply through a
2k resister can be connected directly to the input of one ADC channel and
you get a perfect Audio Spectrum Analyzer. The FORTH source code can
be downloaded to eForth system on FORTHstamp through HyperTerminal
and the ADCC command shows a continuing audio spectrum.
( DFT128.F, 23feb06cht)
( DFT.F, 23feb06cht)
DECIMAL
: 2DROP DROP DROP ;
: BREAK CR .S KEY $1B = ABORT" DONE" ;
VARIABLE XS ( square of scaled angle )
VARIABLE INDEX
VARIABLE SUM
: CIRCLE 128 ;
: SINE_TABLE $10000 ;
: COSINE_TABLE $10080 ;
: TRANSFORM_INPUT $10400 ;
: TRANSFORM_OUTPUT $10600 ;
: KN ( n1 n2 -- n3, n3=10000-n1*x*x/n2 where x is the angle )
XS @ SWAP / ( x*x/n2 )
NEGATE 10000 */ ( -n1*x*x/n2 )
10000 + ( 10000-n1*x*x/n2 )
;
: (SIN) ( x -- sine*10K, x in radian*10K )
DUP DUP 10000 */ ( x*x scaled by 10K )
XS ! ( save it in XS )
10000 72 KN ( last term )
42 KN 20 KN 6 KN ( terms 3, 2, and 1 )
10000 */ ( times x )
;
: (COS) ( x -- cosine*10K, x in radian*10K )
DUP 10000 */ XS ! ( compute and save x*x )
10000 56 KN 30 KN 12 KN 2 KN ( serial expansion )
;
: SIN ( degree -- sine*10K )
31415 64 */ ( convert to radian )
(SIN) 2047 10000 */ ( compute sine )
;
: COS ( degree -- cosine*10K )
31415 64 */
(COS) 2047 10000 */
;
: FILL_SINE_TABLE
0 SINE_TABLE
32 FOR
OVER SIN
OVER 2DUP !
2DUP SINE_TABLE - SINE_TABLE CIRCLE 2* + SWAP - !
SWAP NEGATE SWAP
2DUP SINE_TABLE - SINE_TABLE CIRCLE 2* + + !
SINE_TABLE - SINE_TABLE CIRCLE 4 * + SWAP - !
CELL+ SWAP 1+ SWAP
NEXT
2DROP
SINE_TABLE DUP CIRCLE 4 * + 256 CMOVE ;
FILL_SINE_TABLE
: SHOW_TABLE ( a n -- )
FOR AFT R@ 1+ 7 AND IF ELSE CR DUP 8 U.R THEN
DUP @ 9 .R
CELL+
THEN NEXT
DROP ;
: SINE_SUM ( INDEX -- )
>R TRANSFORM_INPUT 0 R>
0 SUM !
127 FOR >R
OVER @ OVER SINE_TABLE + @ * SUM +!
4 R@ D+ $1FF AND
R>
NEXT
2DROP DROP ;
: COSINE_SUM ( INDEX -- )
>R TRANSFORM_INPUT 0 R>
0 SUM !
127 FOR >R
OVER @ OVER COSINE_TABLE + @ * SUM +!
4 R@ D+ $1FF AND
R>
NEXT
2DROP DROP ;
: SINE_TRANSFORM
0 TRANSFORM_OUTPUT
64 FOR
OVER SINE_SUM
SUM @ 32768 / DUP *
OVER !
4 4 D+
NEXT
2DROP ;
: COSINE_TRANSFORM
0 TRANSFORM_OUTPUT
32 FOR
OVER COSINE_SUM
SUM @ 32768 / DUP *
OVER +!
4 4 D+
NEXT
2DROP ;
VARIABLE THRESHOLD
VARIABLE AVERAGE
: SHOW_TRANSFORM
$1B EMIT ." [0;0H" ( home )
$800000 THRESHOLD !
23 FOR TRANSFORM_OUTPUT
CR 64 FOR
DUP @ THRESHOLD @ U<
IF $20 ELSE $2A THEN EMIT
CELL+
NEXT
DROP
THRESHOLD @ 1 RSHIFT THRESHOLD !
NEXT
CR ." 0--------10--------20--------30--------40--------50---------60---"
;
: READ_ADC ( -- n )
0 AVERAGE @ FOR AFT
$E3 ADCCON !
BEGIN ADCCON @ 3 AND WHILE REPEAT
ADCDAT @ +
THEN NEXT
AVERAGE @ / 16RSHIFT ;
: ADC_INPUT TRANSFORM_INPUT
127 FOR READ_ADC OVER ! CELL+ WAIT
NEXT DROP ;
: DFT SINE_TRANSFORM COSINE_TRANSFORM SHOW_TRANSFORM ;
: ADCC BEGIN ADC_INPUT DFT ?KEY UNTIL ;
8 AVREAGE !
4 ADCCP !
( DFT.F, 23feb06cht)
DECIMAL
: 2DROP DROP DROP ;
: BREAK CR .S KEY $1B = ABORT" DONE" ;
VARIABLE XS ( square of scaled angle )
VARIABLE INDEX
VARIABLE SUM
: CIRCLE 128 ;
: SINE_TABLE $10000 ;
: COSINE_TABLE $10080 ;
: TRANSFORM_INPUT $10400 ;
: TRANSFORM_OUTPUT $10600 ;
: KN ( n1 n2 -- n3, n3=10000-n1*x*x/n2 where x is the angle )
XS @ SWAP / ( x*x/n2 )
NEGATE 10000 */ ( -n1*x*x/n2 )
10000 + ( 10000-n1*x*x/n2 )
;
: (SIN) ( x -- sine*10K, x in radian*10K )
DUP DUP 10000 */ ( x*x scaled by 10K )
XS ! ( save it in XS )
10000 72 KN ( last term )
42 KN 20 KN 6 KN ( terms 3, 2, and 1 )
10000 */ ( times x )
;
: (COS) ( x -- cosine*10K, x in radian*10K )
DUP 10000 */ XS ! ( compute and save x*x )
10000 56 KN 30 KN 12 KN 2 KN ( serial expansion )
;
: SIN ( degree -- sine*10K )
31415 64 */ ( convert to radian )
(SIN) 2047 10000 */ ( compute sine )
;
: COS ( degree -- cosine*10K )
31415 64 */
(COS) 2047 10000 */
;
: FILL_SINE_TABLE
0 SINE_TABLE
32 FOR
OVER SIN
OVER 2DUP !
2DUP SINE_TABLE - SINE_TABLE CIRCLE 2* + SWAP - !
SWAP NEGATE SWAP
2DUP SINE_TABLE - SINE_TABLE CIRCLE 2* + + !
SINE_TABLE - SINE_TABLE CIRCLE 4 * + SWAP - !
CELL+ SWAP 1+ SWAP
NEXT
2DROP
SINE_TABLE DUP CIRCLE 4 * + 256 CMOVE ;
FILL_SINE_TABLE
: SHOW_TABLE ( a n -- )
FOR AFT R@ 1+ 7 AND IF ELSE CR DUP 8 U.R THEN
DUP @ 9 .R
CELL+
THEN NEXT
DROP ;
: SINE_SUM ( INDEX -- )
>R TRANSFORM_INPUT 0 R>
0 SUM !
127 FOR >R
OVER @ OVER SINE_TABLE + @ * SUM +!
4 R@ D+ $1FF AND
R>
NEXT
2DROP DROP ;
: COSINE_SUM ( INDEX -- )
>R TRANSFORM_INPUT 0 R>
0 SUM !
127 FOR >R
OVER @ OVER COSINE_TABLE + @ * SUM +!
4 R@ D+ $1FF AND
R>
NEXT
2DROP DROP ;
: SINE_TRANSFORM
0 TRANSFORM_OUTPUT
64 FOR
OVER SINE_SUM
SUM @ 32768 / DUP *
OVER !
4 4 D+
NEXT
2DROP ;
: COSINE_TRANSFORM
0 TRANSFORM_OUTPUT
32 FOR
OVER COSINE_SUM
SUM @ 32768 / DUP *
OVER +!
4 4 D+
NEXT
2DROP ;
VARIABLE THRESHOLD
VARIABLE AVERAGE
: SHOW_TRANSFORM
$1B EMIT ." [0;0H" ( home )
$800000 THRESHOLD !
23 FOR TRANSFORM_OUTPUT
CR 64 FOR
DUP @ THRESHOLD @ U<
IF $20 ELSE $2A THEN EMIT
CELL+
NEXT
DROP
THRESHOLD @ 1 RSHIFT THRESHOLD !
NEXT
CR ." 0--------10--------20--------30--------40--------50---------60---"
;
: READ_ADC ( -- n )
0 AVERAGE @ FOR AFT
$E3 ADCCON !
BEGIN ADCCON @ 3 AND WHILE REPEAT
ADCDAT @ +
THEN NEXT
AVERAGE @ / 16RSHIFT ;
: ADC_INPUT TRANSFORM_INPUT
127 FOR READ_ADC OVER ! CELL+ WAIT
NEXT DROP ;
: DFT SINE_TRANSFORM COSINE_TRANSFORM SHOW_TRANSFORM ;
: ADCC BEGIN ADC_INPUT DFT ?KEY UNTIL ;
8 AVREAGE !
4 ADCCP !
Discrete Fourier Transform of Audio Signals
 |
 |
 |
 |
 |
 |
 |
 |
 |
 |
 |