🚀 go-pugleaf

DECLARE SUB working ()
DECLARE SUB test (x#(), N%)
DECLARE SUB printout (x#(), N%)
DECLARE SUB fftsetup (x#(), N%)
DECLARE SUB XFFT (x#(), NN%)
DEFDBL A-H, O-Z
DEFINT I-N
'$DYNAMIC
DIM x(1 TO 8192)
CONST filenotfound = 53
CONST badfilename = 64
CONST pi = 3.1415926535898#

ON ERROR GOTO ErrorHandler
CALL fftsetup(x(), N)

LOCATE 10, 1: PRINT "Calculating FFT.";
CALL XFFT(x(), N)

CALL printout(x(), N)

END

ErrorHandler:
   IF ERR = filenotfound THEN
      CLS
      ' get another file name
      LOCATE 5, 5: PRINT "File "; UCASE$(file$); " not found."
      LOCATE 6, 5: INPUT "Enter Data Filename:  ", file$
      RESUME
   ELSEIF ERR = badfilename THEN
      CLS
      ' get another file name
      LOCATE 5, 5: PRINT "File "; UCASE$(file$); " is a bad filename."
      LOCATE 6, 5: INPUT "Enter Data Filename:  ", file$
      RESUME
    ELSE
      PRINT "FFT Choked:  Error Code"; ERR
END
END IF



REM $STATIC
SUB fftsetup (x(), N)

CLS
10 :
LOCATE 5, 10: PRINT "     Power   Number"
LOCATE 6, 10: PRINT "    ------- --------"
LOCATE 7, 10: PRINT "       0       1  "
LOCATE 8, 10: PRINT "       1       2  "
LOCATE 9, 10: PRINT "       2       4 "
LOCATE 10, 10: PRINT "       3       8  "
LOCATE 11, 10: PRINT "       4      16  "
LOCATE 12, 10: PRINT "       5      32  "
LOCATE 13, 10: PRINT "       6      64  "
LOCATE 14, 10: PRINT "       7     128  "
LOCATE 15, 10: PRINT "       8     256  "
LOCATE 16, 10: PRINT "       9     512  "
LOCATE 17, 10: PRINT "      10    1024  "
LOCATE 18, 10: PRINT "      11    2048  "
LOCATE 19, 10: PRINT "      12    4096  "

LOCATE 21, 5: INPUT "Enter Power of Record Length:  ", ans$
M = INT(VAL(ans$))
IF M > 12 THEN
        CLS
        LOCATE 22, 5: PRINT "*** Power Must be Lower than 13 ***"
        GOTO 10
ELSEIF M <= 0 THEN
        CLS
        LOCATE 22, 5: PRINT "*** Power Must be Greater than 0 ***"
        GOTO 10
END IF
        LOCATE 22, 5: PRINT "                                      "

LOCATE 22, 5: INPUT "Enter Data Filename:  ", file$
OPEN file$ FOR INPUT AS #1
k = 1
N = 2 ^ M
CLS

LOCATE 9, 1: PRINT "Reading data."
DO WHILE NOT EOF(1) AND k <= 2 * N - 1
                working
                INPUT #1, x(k)
                x(k + 1) = 0  'imaginary component
                k = k + 2
LOOP

DO UNTIL k > 2 * N - 1
                x(k) = 0          'Real Data Component
                x(k + 1) = 0      'Imaginary Data Component
                k = k + 2
LOOP
CLOSE #1

END SUB

SUB printout (x(), N)
LOCATE 11, 1: PRINT "Writing to FFT.PRN."
OPEN "c:\fft.prn" FOR OUTPUT AS #1

wcount = 0
FOR i = 1 TO 2 * N - 1 STEP 2
        working
        PRINT #1, USING "#####  +.####^^^^^ +.####^^^^^ i"; (i - 1) / 2; CSNG(x(i)); CSNG(x(i + 1))
NEXT i
CLOSE #1
LOCATE 5, 1: PRINT "                                     "
LOCATE 9, 1: PRINT "                                     "
LOCATE 10, 1: PRINT "                                     "
LOCATE 11, 1: PRINT "                                     "

LOCATE 12, 1: PRINT "Program Finished."
END SUB

DEFSNG A-Z
SUB working STATIC
IF iter = 0 THEN wcount = 15
IF wcount = 15 THEN
        iter = iter + 1
        IF iter = 5 THEN iter = 1
        COLOR 7
        LOCATE 5, 1: PRINT "Working ..."
        COLOR 3
        SELECT CASE iter

        CASE 1
                LOCATE 5, 13: PRINT "-";
        CASE 2
                LOCATE 5, 13: PRINT "\";
        CASE 3
                LOCATE 5, 13: PRINT "|";
        CASE 4
                LOCATE 5, 13: PRINT "/";
        END SELECT

        COLOR 7
        wcount = 0
END IF
wcount = wcount + 1


workingend:
END SUB

DEFINT I-N
DEFDBL A-H, O-Z
SUB XFFT (x(), NN)
N = 2 * NN
j = 1
FOR i = 1 TO N STEP 2                           'Bit Reversal
        IF j > i THEN
                Tempr = x(j)
                Tempi = x(j + 1)
                x(j) = x(i)
                x(j + 1) = x(i + 1)
                x(i) = Tempr
                x(i + 1) = Tempi
        END IF
        M = N / 2
1 :    
        IF M >= 2 AND j > M THEN
                j = j - M
                M = M / 2
                GOTO 1
        END IF
        j = j + M
NEXT i
Mmax = 2
2 :
        IF N > Mmax THEN
        Istep = 2 * Mmax
        Theta = 2 * pi / (Mmax)
        Wpr = -2! * SIN(.5 * Theta) ^ 2
        Wpi = -SIN(Theta)
        Wr = 1
        Wi = 0
        FOR M = 1 TO Mmax STEP 2

                                working

                FOR i = M TO N STEP Istep
                        j = i + Mmax
                        Tempr = Wr * x(j) - Wi * x(j + 1)
                        Tempi = Wr * x(j + 1) + Wi * x(j)
                        x(j) = x(i) - Tempr
                        x(j + 1) = x(i + 1) - Tempi
                        x(i) = x(i) + Tempr
                        x(i + 1) = x(i + 1) + Tempi
                NEXT i
                Wtemp = Wr
                Wr = Wr * Wpr - Wi * Wpi + Wr
                Wi = Wi * Wpr + Wtemp * Wpi + Wi
        NEXT M
        Mmax = Istep
        GOTO 2
END IF
END SUB