( FFT et FFT-1 en FORTH. Version 0.10 du 15 Fevrier 2009. Ecrit par jpb.forth . ) FIND COURBE [IF] DECIMAL FORGET DEBUT_FFT : DEBUT_FFT ; 10 VARIABLE LN2(NBP) 1000 CONSTANT VC 1000 CONSTANT DUREE_us 100 CONSTANT F_PORTEUSE : SIN(F) ( no_ech,f --> sin ) DUREE_us */ 65536 LN2(NBP) @ NEGATE LSH * SIN VC * -15 ASH ; : COS(F) ( no_ech,f --> sin ) DUREE_us */ 65536 LN2(NBP) @ NEGATE LSH * COS VC * -15 ASH ; : MODU ( - --> @temp ) 4 LN2(NBP) @ LSH DUP MEMOIRE_ALLOUE ?DUP IF SWAP 0 DO I 4/ 15000 SIN(F) DUP 2/ + I 4/ 12000 SIN(F) DUP 4/ + - I 4/ 9000 SIN(F) + I 4/ 6000 SIN(F) DUP 4/ - - I 4/ 3000 SIN(F) 2/ + 16 ASH OVER I + 2! 4 +LOOP ELSE DUP XOR THEN ; : PORT ( - --> @temp ) 4 LN2(NBP) @ LSH DUP MEMOIRE_ALLOUE ?DUP IF SWAP 0 DO I 4/ 80000 SIN(F) 16 ASH OVER I + 2! 4 +LOOP ELSE DUP XOR THEN ; : MODUL ( - --> @temp ) 4 LN2(NBP) @ LSH DUP MEMOIRE_ALLOUE ?DUP IF SWAP 0 DO I 4/ 80000 SIN(F) DUP I 4/ 15000 SIN(F) DUP 2/ + I 4/ 12000 SIN(F) DUP 4/ + - I 4/ 9000 SIN(F) + I 4/ 6000 SIN(F) DUP 4/ - - I 4/ 3000 SIN(F) 2/ + VC 2* */ + 16 ASH OVER I + 2! 4 +LOOP ELSE DUP XOR THEN ; : BLU ( - --> @temp ) 4 LN2(NBP) @ LSH DUP MEMOIRE_ALLOUE ?DUP IF SWAP 0 DO I 4/ 80000 SIN(F) I 4/ 15000 SIN(F) DUP 2/ + I 4/ 12000 SIN(F) DUP 4/ + - I 4/ 9000 SIN(F) + I 4/ 6000 SIN(F) DUP 4/ - - I 4/ 3000 SIN(F) 2/ + VC 2* */ I 4/ 80000 COS(F) I 4/ 15000 COS(F) DUP 2/ + I 4/ 12000 COS(F) DUP 4/ + - I 4/ 9000 COS(F) + I 4/ 6000 COS(F) DUP 4/ - - I 4/ 3000 COS(F) 2/ + VC 2* */ - 16 ASH OVER I + 2! 4 +LOOP ELSE DUP XOR THEN ; : POSUP ( - --> @temp ) 4 LN2(NBP) @ LSH DUP MEMOIRE_ALLOUE ?DUP IF SWAP 0 DO I 4/ 80000 SIN(F) I 4/ 15000 SIN(F) DUP 2/ + I 4/ 12000 SIN(F) DUP 4/ + + I 4/ 9000 SIN(F) + I 4/ 6000 SIN(F) DUP 4/ - + I 4/ 3000 SIN(F) 2/ + VC 2* */ 16 ASH OVER I + 2! 4 +LOOP ELSE DUP XOR THEN ; : SINU ( - --> @freq ) 4 LN2(NBP) @ LSH DUP MEMOIRE_ALLOUE ?DUP IF SWAP OVER OVER 0 FILL 500 DUP 4 PICK 8+ ! DUP 4 PICK 4 PICK + 6- ! NEGATE DUP 4 PICK 4 PICK + 8- ! 3 PICK 10+ ! DROP ELSE DUP XOR THEN ; : RECT ( - --> @freq ) 4 LN2(NBP) @ LSH DUP MEMOIRE_ALLOUE ?DUP IF SWAP OVER OVER 0 FILL 500 DUP 4 PICK 8+ ! DUP 4 PICK 4 PICK + 6- ! NEGATE DUP 4 PICK 4 PICK + 8- ! 3 PICK 10+ ! 167 DUP 4 PICK 24+ ! DUP 4 PICK 4 PICK + 22- ! NEGATE DUP 4 PICK 4 PICK + 24- ! 3 PICK 26+ ! 100 DUP 4 PICK 40+ ! DUP 4 PICK 4 PICK + 38- ! NEGATE DUP 4 PICK 4 PICK + 40- ! 3 PICK 42+ ! 71 DUP 4 PICK 56+ ! DUP 4 PICK 4 PICK + 54- ! NEGATE DUP 4 PICK 4 PICK + 56- ! 3 PICK 58+ ! 56 DUP 4 PICK 72+ ! DUP 4 PICK 4 PICK + 70- ! NEGATE DUP 4 PICK 4 PICK + 72- ! 3 PICK 74+ ! DROP ELSE DUP XOR THEN ; : TRIA ( - --> @freq ) 4 LN2(NBP) @ LSH DUP MEMOIRE_ALLOUE ?DUP IF SWAP OVER OVER 0 FILL 500 DUP 4 PICK 8+ ! 3 PICK 3 PICK + 8- ! 56 DUP 4 PICK 24+ ! 3 PICK 3 PICK + 24- ! 20 DUP 4 PICK 40+ ! 3 PICK 3 PICK + 40- ! 10 DUP 4 PICK 56+ ! 3 PICK 3 PICK + 56- ! 6 DUP 4 PICK 72+ ! 3 PICK 3 PICK + 72- ! 4 DUP 4 PICK 88+ ! 3 PICK 3 PICK + 88- ! DROP ELSE DUP XOR THEN ; : ESSAI ( - --> @temp ) 4 LN2(NBP) @ LSH DUP MEMOIRE_ALLOUE ?DUP IF SWAP 0 DO I 4/ 8000 SIN(F) NPA VC 4* MOD + 16 ASH OVER I + 2! 4 +LOOP ELSE DUP XOR THEN ; : MINMAX ( @signal --> min,max ) >R 0 DUP 4 LN2(NBP) @ LSH R@ + R> DO I @ TUCK MAX >R MIN R> I 2+ @ TUCK MAX >R MIN R> 4 +LOOP ; : FFT ( @temp --> @freq ) DUP IF LN2(NBP) @ TFR THEN ; : FFT-1 ( @freq--> @temp ) DUP IF LN2(NBP) @ TFR-1 THEN ; 0 VARIABLE @TEMPOREL HERE ] 1 LN2(NBP) @ LSH 1- UFLOAT DUREE_us UFLOAT F* F* INT 4* @TEMPOREL 2@ + @ UFLOAT EXIT [ CONSTANT TEMPOREL 0 VARIABLE @FREQUENTIEL HERE ] 1 LN2(NBP) @ DUP >R LSH 1- UFLOAT 1 R> LSH UFLOAT F/ DUREE_us UFLOAT F/ F* INT 4* @FREQUENTIEL 2@ + DUP >R @ DUP * R> 2+ @ DUP * + 4* SQRT UFLOAT EXIT [ CONSTANT FREQUENTIEL " TEMPOREL" STRING S_TEMPOREL " seconde" STRING S_T " Y" STRING S_Y " FREQUENTIEL" STRING S_FREQUENTIEL " Hertz" STRING S_F : AF_TEMPOREL ( @temp --> - ) ?DUP IF DUP >R @TEMPOREL 2! S_TEMPOREL S_T S_Y 0 UFLOAT 1 UFLOAT DUREE_us UFLOAT F/ R> MINMAX >R DUP ABS 4/ - UFLOAT R> DUP 4/ ABS + UFLOAT 0 DUP 1 LN2(NBP) @ LSH TEMPOREL COURBE_CREE DROP DUP COURBE_AFFICHE DROP MEMOIRE_LIBERE DROP THEN ; : AF_FREQUENTIEL ( @freq --> - ) ?DUP IF DUP >R @FREQUENTIEL 2! S_FREQUENTIEL S_F S_Y 0 UFLOAT 1 LN2(NBP) @ 1- LSH UFLOAT DUREE_us UFLOAT F* 0 UFLOAT R> MINMAX >R ABS R> ABS MAX 2* DUP 2/ + UFLOAT 0 DUP 1 LN2(NBP) @ 1- LSH FREQUENTIEL COURBE_CREE DROP DUP COURBE_AFFICHE DROP MEMOIRE_LIBERE DROP THEN ; : AF_FFT ( @temp --> - ) BEGIN COURBE_EFFACE UNTIL DUP FFT DUP AF_FREQUENTIEL MEMOIRE_LIBERE DROP DUP AF_TEMPOREL MEMOIRE_LIBERE DROP ; : AF_FFT-1 ( @freq --> - ) BEGIN COURBE_EFFACE UNTIL DUP FFT-1 DUP AF_TEMPOREL MEMOIRE_LIBERE DROP DUP AF_FREQUENTIEL MEMOIRE_LIBERE DROP ; : TEST ." Demo TFR_FFT demo." CR CR BEGIN 1 LN2(NBP) @ LSH . ." points_dots. 0 - modifier le nombre de point modify the dots number 1 - signal modulant (3-6-9-12-15 KHz) modulating signal 2 - porteuse (80 KHz) carrying 3 - modulation d'amplitude MA double sideband DSB 4 - MA a porteuse supprimee MAPS " ." suppressed carrier DSB DSB-SC 5 - MA a bande laterale unique BLU single sideband SSB 6 - signal sinus (2 KHz) sine wave 7 - signal rectangle (2 KHz) square wave 8 - signal triangle (2 KHz) triangular wave " ." 9 - fin end Votre choix_Your choice: ?" BEGIN KEY 8 EMIT DUP EMIT 48- CASE 0 OF CR CR ." 0 - 256 1 - 512 2 - 1024 3 - 2048 4 - 4096 Votre choix_Your choice: ?" BEGIN KEY 8 EMIT DUP EMIT 48- DUP 0< OVER 5 > OR IF BELL 0 ELSE 8+ LN2(NBP) ! -1 THEN UNTIL CR -1 ENDOF 1 OF MODU AF_FFT 0 ENDOF 2 OF PORT AF_FFT 0 ENDOF 3 OF MODUL AF_FFT 0 ENDOF 4 OF POSUP AF_FFT 0 ENDOF 5 OF BLU AF_FFT 0 ENDOF 6 OF SINU AF_FFT-1 0 ENDOF 7 OF RECT AF_FFT-1 0 ENDOF 8 OF TRIA AF_FFT-1 0 ENDOF 9 OF -2 ENDOF 17 OF ESSAI DUP FFT 4 LN2(NBP) @ LSH DUP MEMOIRE_ALLOUE ?DUP IF SWAP 0 DO OVER I + @ DUP ABS 300 < IF DROP 0 THEN OVER I + ! 2 +LOOP AF_FFT-1 ELSE DROP BEGIN COURBE_EFFACE UNTIL THEN DUP AF_FREQUENTIEL MEMOIRE_LIBERE DROP DUP AF_TEMPOREL MEMOIRE_LIBERE DROP 0 ENDOF BELL 0 ENDCASE DUP 0< IF -2 = -1 THEN UNTIL CR UNTIL ; TEST [ELSE] ECHO" **** Le fichier 'courbe.txt' doit etre compile. **** The file 'courbe.txt' must be compiled. " [THEN] ( FIN )