--- title: "Fourier Analysis" id: 51425 type: "computer_media" slug: "fourier-analysis" url: "http://localhost/computer_media/fourier-analysis/" markdown_url: "http://localhost/computer_media/fourier-analysis.md" published_at: "2023-07-31T12:07:51+00:00" modified_at: "2026-04-03T07:59:19+00:00" author: "David Anderson" featured_image: url: "http://localhost/wp-content/uploads/2019/02/20230809-041332.jpg" excerpt: "Enter a waveform's data points and watch this Fourier analyzer compute harmonics, reconstruct waves, and even plot Lissajous figures—including a Mickey Mouse made of math." category: - name: "Archived Media" slug: "archived-media" taxonomy: "category" url: "http://localhost/category/archived-media/" post_tag: - name: "Downloadable" slug: "downloadable" taxonomy: "post_tag" url: "http://localhost/tag/downloadable/" - name: "TS 1000" slug: "ts1000" taxonomy: "post_tag" url: "http://localhost/tag/ts1000/" model: - name: "Timex/Sinclair 1000" slug: "ts-1000" taxonomy: "model" url: "http://localhost/model/ts-1000/" indiv: - name: "Fred Nachbaur" slug: "fred-nachbaur" taxonomy: "indiv" url: "http://localhost/indiv/fred-nachbaur/" genre: - name: "Mathematics" slug: "mathematics" taxonomy: "genre" url: "http://localhost/type/mathematics/" media_type: "Cassette" programmers: - name: "Fred Nachbaur" slug: "fred-nachbaur" taxonomy: "indiv" url: "http://localhost/indiv/fred-nachbaur/" download_url: "https://archive.org/download/timex-sinclair-software-archive/Fourier%20Analysis%20%281982%29%28Nachbaur%2C%20Fred%29%28US%29%28TS1000%29%28Program%29.zip" mediadate: "1982" media_type_tags: "Mathematics" --- # Fourier Analysis This program performs discrete Fourier analysis and synthesis on user-supplied waveforms. It accepts either time-domain data points (computing Fourier coefficients via Simpson’s rule numerical integration) or frequency-domain coefficients (reconstructing the waveform through harmonic summation), and supports up to two independent waveforms for X-versus-Y parametric plotting such as Lissajous figures. The analysis routine at line 1001 uses Simpson’s 1/3 rule (alternating coefficients of 1, 4, 1 in the integration loop) to compute sine and cosine terms, while synthesis at line 2002 rebuilds the waveform by summing harmonics. Display modes include tabular coefficient readouts with phase angle and magnitude calculations (using ATN for phase), a time-domain waveform graph, a spectral amplitude/phase plot, and an X-Y parametric plot rendered via LPRINT graphics commands to a ZX Printer. The program uses heavily tokenized string variables (G$, H$, K$, etc.) and numeric constants stored as variables (N0–N4, P0–P1, O0–O2, S0) to minimize memory usage throughout. *** ## Program Analysis ### Program Structure The program is organized into a set of functional regions separated by line number ranges, with REMs marking major sections. The top-level flow begins at line 50 (or 300 for a fresh start from the title screen), routes through a menu dispatcher around lines 200–298, and branches to either the analysis path (lines 500–577) or synthesis path (lines 800–890). Supporting subroutines handle display, data entry, and graphing. | Line Range | Purpose | | --- | --- | | 0–4 | REMs containing machine code and display data | | 5–12 | Micro-subroutines: sine/cosine term evaluation, formatted number width | | 50–60 | Initialization of run counter R | | 100–160 | Title screen (conditional on USR M2 hardware test) | | 200–298 | Main menu dispatcher | | 300–485 | Setup: data dimensions, waveform count, harmonic range | | 500–598 | Analysis entry, data input, run-analysis, view results | | 700–780 | Re-synthesis setup with selectable harmonic count | | 800–890 | Synthesis path menu, coefficient input, run-synthesis, view results | | 1001–1130 | ANA: Fourier analysis subroutine (Simpson’s rule integration) | | 1200–1240 | Time estimate and FAST-mode setup | | 1250–1270 | Progress display during computation | | 2002–2085 | SYN: Fourier synthesis subroutine | | 2900–2960 | Waveform flip/copy helpers (FF1, FF2, RF1, RF2) | | 3002–3070 | RVD: tabular display of waveform data array | | 3202–3290 | RVC: tabular display of Fourier coefficients with phase and magnitude | | 3302–3360 | Screen-pause subroutine with COPY/CONTINUE/RETURN options | | 3440–4060 | Parameter save/restore subroutines for dual-waveform mode | | 4200–4270 | GRD: graph waveform data to screen and printer | | 4402–4575 | GRC: spectral amplitude/phase dot plot | | 4602–4700 | XVY: X-versus-Y parametric plot via LPRINT | | 5005–5140 | Programmed function data fill (X-axis limits, formula evaluation) | | 5405–5470 | INP: manual data-point entry with scroll display | | 5500–5550 | Input wrapper with optional hard-copy flag | | 5602–5700 | EDC: edit Fourier coefficients interactively | | 5802–5900 | EDD: scroll-edit waveform data array | | 6005–6105 | Coefficient editor (harmonic number + sine/cosine selection) | | 7000–7998 | Stub for user-supplied programmed waveform function | | 9990–9991 | SAVE and return to main menu | ### Machine Code Usage Lines 0 and 1 contain REM statements that store machine code and display data directly in memory. The program accesses this code via `USR M2`, where `M2` is a pointer into the REM area. `USR M2` is used as a boolean flag throughout: every display, PRINT, CLS, LPRINT, and COPY statement is guarded by `IF USR M2 THEN`, suggesting the machine code routine selectively enables output depending on hardware capabilities or a mode flag (likely distinguishing printer-attached from non-printer configurations). The variable `D` appearing in LPRINT calls (e.g., `LPRINT D;X,Y`) is a control byte for the ZX Printer’s graphics mode. ### Numerical Integration: Simpson’s Rule The analysis subroutine at lines 1001–1130 computes Fourier coefficients using composite Simpson’s 1/3 rule. The inner loop (lines 1035–1100) accumulates the integral with the standard 1–4–1 weighting pattern: 1. Call subroutine `J` (either line 5 for sine or line 10 for cosine); add result with weight 1 (`A=A+E`) 2. Advance by half-step; call `J`; add with weight 4 (`A=A+N4*E`) 3. Advance by half-step; call `J`; add with weight 1 (`A=A+E`) 4. Repeat until `D=C` (all divisions covered) The final coefficient is scaled by `B/N3/PI` (where `B=2*PI/C` and `N3=3`), yielding the standard Simpson normalization of `h/3`. ### Subroutine Dispatch via Computed GO SUB The program makes extensive use of computed `GOSUB` targets. For example, line 295 uses `GOSUB RVD+VAL "200"*INT((Z-N1)/N2)+VAL "800"*(Z>N4)` to select between waveform-display, coefficient-display, or graph subroutines based on the menu key pressed. Similarly, `J` holds either 5 or 15 (line 1020: `LET J=5+5*G`) to dispatch to the sine or cosine micro-subroutine. This technique saves memory compared to explicit `IF/THEN` chains. ### Symbolic Constants for Memory Optimization Rather than embedding numeric literals throughout the code, the program defines a set of short-name numeric variables at startup. This is a classic memory-saving technique since each stored variable takes less space than a repeated literal in tokenized BASIC: - `N0`=0, `N1`=1, `N2`=2, `N3`=3, `N4`=4 - `P0`, `P1`, `P8` — screen position constants (20, 21, 48) - `O0`, `O1`, `O2`, `O6` — further display offsets - `S0` — seconds-per-minute constant used in time estimation - `Q1` — column constant for screen clearing String variables `A$`–`W$` store frequently repeated prompt fragments, menu labels, and keyword strings to avoid duplicating long literals. ### Dual-Waveform and X-Y Mode When two waveforms are requested (`V=N2`), the program allocates a two-row array `A(2, C+1)` for time-domain data and `B(2, 2*I+1)` for coefficients. Each waveform is processed in turn by setting `R1` to 1 or 2 as the row index. The subroutines at lines 3440–4060 save and restore per-waveform parameters (harmonic step `K`, sine/cosine flags `S` and `T`, and the formula string `T$`) so each waveform can have independent settings. The X-versus-Y plot at lines 4602–4700 iterates over the common sample index `A`, plotting `A(1,A)` against `A(2,A)` using LPRINT graphics commands to the ZX Printer. ### Phase and Magnitude Display In the coefficient table (lines 3202–3290), the program computes phase angle in degrees using `ATN(A/B)*180/PI` (line 3258), then applies a quadrant correction: if the cosine term `B` is negative, 180° is added (line 3259). A guard against division by zero replaces a zero cosine term with `1E-20` (line 3257). Magnitude is computed as `SQR(A*A+B*B)` (line 3256). Values are displayed rounded to four decimal places using the idiom `INT(X*1E4+.5)/1E4`. ### Spectral Plot Technique The spectral display at lines 4402–4575 plots both amplitude and phase as dots on screen using `PLOT`. Phase is mapped linearly from 0–360° onto the vertical axis (0–160 pixels), with the `ATN` result scaled by `80/PI` and shifted. Because only a limited number of harmonics fit on screen at once, the loop increments `O` (the current harmonic display offset) and re-enters the drawing loop at line 4426 to scroll the display, continuing until all harmonics up to `I1` are shown. ### Time Estimation Before beginning a computation, the subroutine at line 1200 estimates the run time by computing `M=INT(N1+C*I1/K/((S=T)+N1)/M)` — accounting for the number of data points, harmonics, step size, and whether both sine and cosine terms are needed — then displays hours and minutes. It pauses for `S0*N2` frames (approximately 2 seconds) before switching to FAST mode and clearing the screen. ### Notable Anomalies - Line 730 references `GOTO 610`, but line 610 does not exist. The nearest executable line is 607 or 630. This is a known BASIC technique (branching to a non-existent line falls through to the next higher line), and in context it causes execution to fall to line 630. - Line 285 uses `USR M2` to conditionally LPRINT a hex string for a custom printer character (“00 24 24 7E 24 7E 24 24…”), which defines a plus/hash symbol for the printer output — a machine-code-assisted printer customization. - The `VAL "number"` form used in `GO TO VAL "288"` and similar lines is a deliberate memory optimization, not obfuscation. - Line 480 sets `K=1.999` rather than 2 when odd-harmonics-only mode is selected; this ensures the `STEP K` loop in the FOR statement picks up only odd integers (1, 3, 5…) by preventing floating-point rounding from accidentally including the next even integer. ## Source Code ``` 0 REM [C]█[1][9][8][7]█[S][M][C]##▘ ""LN RUN ##[P]#Y2 GOSUB #<>5▟▝TAN PRINT # RETURN,C▌LN [*]RNDINT / LET TAN 6-RNDLN #? FASTLN LN + LPRINT TAN LN [H]RND PRINT LN [4]RND7LN [H]RND# LET #TAN 7# RETURN#C▀ RETURN;""6-RNDTAN A ##▞▌ACS 9ACS =( IF ,,▘ 4,,TAN 7LN [T]RNDLN [4]RNDLN ,,INKEY$ ##ACS ZACS ZACS Z##STR$ LN STR$ RND LET J NEW▛W#TAN Y3[)]K▌LN [*]RNDINT (Y[Z][(]SQR LN [*]RNDINT 25 6AT ZA4##<▘ COPY*Q GOSUB [K]TAN NEXT Y▞# ( CLEARLEN LIST W4 CLEAR▞"" CLEARACS ##C▝▞[K])4 5 4##INKEY$ ▌ASN #INKEY$ ;# GOSUB #### UNPLOT E£RND ###) RUN ▙;Y2 GOSUB #Y PRINT ▘▛▝ CLEARACS ##CODE [P]▝LN [>]▝LN 4▝<>5GINKEY$ #[8]▝ CLEARACS #▚/▖ CLEARACS #LEN E£RND▘9 GOSUB PIF FOR 5 █;6#INKEY$ FOR GOSUB [K]LN F?<>5GINKEY$ TAN 7LN [T]RNDLN [4]RND##LN ▞INKEY$ VAL 7LN [H]RNDAT LN STR$ RND#TAN 2 COPY/▝2 STR$ 7LN [T]RNDLN ,,INKEY$ SGN GOSUB ##ZLN LET RND##?( CLEARACS .*PI▌4▝▞▒▛( CLEAR#TAN Y COPY/▘[J]MVAL Z CLEARACS #[:]7LN [T]RNDLN ,,INKEY$ # RETURN,4"7 GOSUB ##ZLN [T]RNDLN ,,INKEY$ ## GOSUB ##ZVAL #[)]-▘K▖ GOSUB #- COPY4▝- FAST##MSQR Z LET [(]2▘K▖ GOSUB #2 COPY4▝2 ##MINT Z#[W]S▞##- /▝2 GOSUB #SGN Z6PEEK Z#[B]3#A 6STR$ ZAT VAL Y[Z][(] PRINT UVAL Z# LET CLEARACS ##4▌LN SGN INKEY$ /▀LN ##UPEEK Z#▞ USTR$ Z##,,#MSTR$ Z GOSUB #SGN ZUUSR Z# GOSUB PIS▒#MSTR$ Z GOSUB #INT ZAT #▙##▄#5CHR$ ZOUUSR Z[Y]4[N] GOSUB ##ZTAN Y COPY/▘[J]MVAL Z7LN [T]RNDLN [4]RNDVAL 7LN [H]RND#I 6INT Z#6SGN ZAT Y▘ PRINT VAL VAL EINT Z GOSUB #SGN Z▞▌VAL ACS EACS .( IF [R] GOSUB #6INT Z GOSUB #SGN ZAT ACS GACS 1( IF ;6SGN Z GOSUB #INT ZAT #ACS <[~~]##ACS +[£]#Y[Z][(]S,, PRINT UVAL Z# LET LN SGN INKEY$ AT LET W RETURNASN S[O]TAN Y▘MINT ZLN COS RNDCOS LN [H]RNDMINT ZLN TAN RNDCOS 7LN [T]RNDLN [4]RND[S]S▀#INKEY$ #LN (INKEY$ #INKEY$ LN (INKEY$ #PI GOSUB #SQR Z[)]W PRINT 7LN [T]RND[S]K▀#INKEY$ # GOSUB #ABS Z[(]W4▘XSGN # GOSUB #USR ZUPEEK Z#USGN Z#[B]LN INPUT RND6CHR$ ZUABS Z#USGN Z#[B]LN INPUT RND6**Z£TAN LN +#4*UINT Z#5 4▘ /#J#7"#[L]4 RUN +4 INPUT TAN USTR$ ZECHR$ Z GOSUB #**Z6 AND Z GOSUB #>=Z PRINT FAST GOSUB # LPRINT C#UPEEK ZLN INKEY$ STR$ VAL #3ZACS <( IF AT ACS .*( CLS#SGN 7 FAST[B] GOSUB # LPRINT C▌#J#/ NEXT UABS ZLN INKEY$ Y,,[(]#VAL ,*ZACS 1( IF AT ACS +3( CLS>▘4 E>=Z,,6>=Z FOR E AND Z,,6 AND Z LET X4[A]5INT ZP4[?]TAN UUSR Z RETURN▒4▖,J/NOT UPEEK ZLN INKEY$ VAL ,3ZACS +( IF AT ACS 1*( CLS#UABS ZJ NEW▛C$#,VAL ?ACS 0( CLSAT ACS ▖( UNPLOT #/[E]E(RND#[T]COS RETURN█4▌LN [*]RNDINT ▘VAL LN PAUSE ,,AT FOR / GOTO PRINT SCROLL FAST:RND▟#LN ##7 FAST▞▌[J]#( CLEARSGN LPRINT LET TAN LN SCROLLRND#?( CLEARLN ##K▀Y▟>LN COS RNDTAB SQR #TAN LN SCROLLRND FASTAT LN 4+ FASTLN ##AT FAST##LN PLOT ;LN [~~]+ LPRINT / STEP LN SCROLLRND#▞ / SLOW###Y[Z][(]STR$ VAL PRINT LN SGN INKEY$ LET AT SGN TAN 2 COPY/▝2 STR$ LN C#SGN USTR$ Z#UPEEK Z5SGN Z PRINT FASTLN [D]#+C▞WLN [J]#/ RUN UUSR Z# LPRINT LET F FASTLN [D]#+C▞£LN [J]#/ RUN USTR$ Z# LPRINT UABS Z PRINT FASTLN [D]#+C▞XLN [J]#/ RUN UUSR Z# LPRINT LET 7LN [D]#+COS $LN [J]#/ SAVE LN 7?2"" CLEARACS ##C▝2[K]5 4[J]PEEK CLSLN #?ABS ▐▒<= CLS*K CLS-4▞▒#<= CLS3K CLS# NEW█PEEK CLSACS )( PAUSE 7+4 FOR <= CLS3K CLSLN ##/SGN 76-RNDLN #?LN [B]:##▘▘COS CLEARACS V#""( RAND $4 PLOT .#[N]4 INPUT TAN 7# RETURN#4,,LN OR #LN RUN #/L7# RETURN,C> RETURN;CG RETURN#C# RETURNAT C# RETURNTAB C#/# GOSUB #AT Z# NEW LIST LEN ( RETURNRNDCODE [O]#ATN [J]#/STR$ #LEN ▒#[J]# GOSUB #AT ZTAN ▞ COPY7# RETURN#COS RETURN,4▖Y▖/" RETURN;4VAL ▖# RETURN▀ASN SQR #M""Z/ STOP GOSUB #AT Z/SQR 7LN [T]RND## RETURN[T]ABS =INKEY$ # RETURNRNDABS "INKEY$ GOSUB #AT Z/[?]7LN [H]RND NEWZ GOSUB #AT Z[T]#K GOTO Y▒█#/ NEW6-RNDLN #? FAST CLEARACS ▘#CODE STR$ .LN SAVE < LPRINT FAST#[L]C£,VAL STR$ LN K#SGN AT <"/ LIST LPRINT /CODE RETURN""4▖Y"/U PRINT NEW# RETURNRNDK▛ LET CLEARACS ▘LEN /G CLEARACS ▘#C~~[J] CLEARACS ▘▚LN ##/▖ CLEARACS ▘LEN LET LN #,,~~ PRINT VAL NEW#LN ##AT ▀ LET RETURN█S LET CLEARACS ▘▚[J] GOSUB #AT Z PRINT YZ[)]>=[J]#LN RUN # LET VAL M<=Z[B]*[B]**- ACS >#5 2; FASTACS TLN STR$ RNDSGN U""Z RETURN▖ASN [=]# RETURN▝C# RETURN▘CFY▒ PRINT STR$ , PRINT U""Z[B]4"U<=ZACS #C▖ LET J/▘ LET #)4 ;SGN LET =AT ▌# RETURN COPYC▒USQR Z##[U]KATN USGN Z#UPEEK Z#USTR$ Z# FASTVAL Y[Z][(]2 LN SGN INKEY$ AT ▌ LPRINT H4 LIST 5INT ZP4[6]TAN 7# RETURN0K▌LN [*]RNDINT 1 RETURNGK RUN CHR$ 0TAN LN ▝##ACS 4ACS 4ACS 4ACS 4LN ▝#█#7# RETURN"#TAN 7# RETURN"TAB SQR #7#ACS #C▝CHR$ RND) 77 FAST▞▒A # FOR ;( CLEAR FOR 5 S; FOR LPRINT 7LN =#>4▌76-RNDTAN =Z#J NEW▛WM#RND) STOPZ GOSUB #**ZY▒ PRINT #>~~VAL #U#RND RETURN▌S)JLEN ,,[B]##: C:3ACS ;( CLS/▛#[J]ACS )*( CLS[Q]#7<#>#[Q]#FLN ##=Z) STOPZ▞▒VAL ,#7<,#LN ##F#<( POKE TAN ▞4[J]##ACS [W]>#<( RUN TAN E-RND# RETURN;C# RETURN#C▌LN [*]RNDINT + LPRINT 6-RND▘ TAN E-RND# RETURN THENC▌LN [*]RNDINT ) FAST7#)""#STR$ RETURN LLIST ASN ## RETURN SCROLLASN [:]RND RETURN LOAD ASN B# RETURN LIST ASN 3# RETURN PAUSE ASN ## RETURN PRINT ASN ## RETURN PLOT ASN [Y]INKEY$ RETURN RUN ASN ▟INKEY$ RETURN SAVE ASN [~~]# RETURN RAND ASN ## RETURN CLSASN ;INKEY$ RETURN UNPLOT ASN TAB INKEY$ RETURN CLEARASN ▗INKEY$ RETURN RETURNASN [*]RND RETURN COPYASN /# RETURN LPRINT 4[9]SGN )[J]#STR$ 7# RETURNXC##7# RETURN#C[<] RETURN;4 PLOT # RETURNAASN [▒]# RETURNBASN [B]INKEY$ RETURNCASN [B]PI RETURNDASN SCROLLINKEY$ RETURNIASN ## RETURNLASN [5]# RETURNPASN ## RETURNRASN [T]# RETURNS42F#7 RETURNDASN ## RETURNEASN ▞# RETURNMASN 8# RETURNPASN [1]# RETURNSASN ##/# RETURNTASN ## RETURNUASN F# RETURNW4UF#7 RETURNDASN ## RETURNLASN "# RETURNRASN ▟# RETURNUASN LEN #/57#7# RETURN#C; RETURN;4 PLOT # RETURNCASN [F]PI RETURNDASN FOR INKEY$ RETURNRASN [X]# RETURNTASN ###SQR # 1 REM FAST##▞▛ACS 5>=?#USR RETURN#Y▀X4 CLEAR GOSUB #▌TAB LLIST #ACS 5>=?#USR RETURN#TAN <= RETURNY,X4 CLEARPEEK COPYY>X4 CLEAR#7##>#<= RETURNYDX4 CLEARPEEK COPYY4X4 CLEARF7RTAN ▘ █VAL LN STEP #AT ▌TAB B#▀ GOSUB #LN STEP #LN ##$LN STEP # CLEAR FAST LET #:[E]LN STEP #LN ###LN STEP #LN ###LN STEP # CLEAR FAST LET ##LN STEP #7.#[N]4 PLOT TAN LN SCROLL▝76-RNDLN #? FASTLN SAVE < LPRINT 7#[K]C: RETURN5K~~# RETURNSCOS RETURNVCOS RETURNPCOS INT 0LN ## PRINT ##VAL ) ▝LN ##SGN LN 8# LET E=RND RETURNS4▛5 4##/( RETURNP4▌),,RND/▖ GOSUB #(RND GOSUB # FOR LN 8##▛▝<= RETURN*S CLS: £<= RETURN*K IF #LEN SCROLLACS #AT [J] GOSUB PIAT GOSUB PISGN C,,-▝LN ## LET LPRINT / TO 5WRND,[Y]4 LIST 7<"#[L]4 PRINT LET LPRINT RETURNS4,,5 4LN <>##▛▝ RETURNV4>E(RNDLN <>#FLN [1]=SGN LPRINT LN ▛▝##▞5,,RND/ GOTO 2 REM [6][4][-][C][O][L]█[P][R][I][N][T]## LIST LIST LIST LIST LIST LIST LIST LIST WWWW LIST LIST LIST LIST #### LIST LIST LIST LIST ???? LIST LIST LIST LIST LIST LIST LIST LIST WWWWWWWWWWWW####WWWW????WWWW#[9]#[9]#[9]#[9] LIST LIST LIST LIST #[9]#[9]#[9]#[9] LIST LIST LIST LIST ##RND RNDRNDRND [4]E##[:][E] ##[▒]#▙## RND8 ▖ ##PI# # 6##CODE #PI4 ▜PIPI#PI#█ ▒▖#[8]▒ ▝▖▒▖▝ LIST ##RND#RND# #USR [Y]▜# #4I44# E# INPUT #E ▙▙##CC RND[8]RNDRND#▖▒ RND█ ▖▖▒ £# (-,,,,0(█▜[£]▜▜▜[:]█ LIST ▖~~▝▖▒: LIST [:]▙▜▙[~~]▜█ LIST >-,2>>(█[:][▒][£]▙[~~]▜ LIST (=/0,,= LIST █[:]PIPI8C/((=E8##▜█ ▖[~~] IF [A][6][8] RND[8][6] NEW[E][A] COS [C]ATN [E][E]ATN #▜[~~][▒][▒]# TAB [6][A][E][E]LEN STEP ▜ASN [:][▒] NEW LLIST ▜EXP ▜▜▜ RND[8][~~][E][A]#£ [C][C] GOTO [E][E][E] SLOWRND### SLOW #4A6[6]#▖ [C][C]ASN ATN [E][E] ▜▜▜▜▜ LLIST [4] REM INPUT [I][E][E] ""[G][E][E][E][E] RND[8][E][E][E]# ""[G][E]ASN [£][▒]▒ RND[A][E][E][A]PI7 ""[G][E]COS [C][C] #▚#86ATN SLOW####PI [4][E][E][E][E]# [4][E][E][E]## [4][E][E][E] INPUT [E] [4][E]##[E][E] [4][E]##PIPI▖ STEP IPI#[▒] INPUT FAST5[=]K; FOR LPRINT U<=Z NEW█UAT Z?▞▒VAL PRINT ,#CGS0 NEW LIST PRINT # NEW?# LET [K]#=S~~ACS BACS BACS BACS B/ATN NEW?/ REM 2 REM [*][*]█[F][O][U][R][I][E][R]█[A][N][A][L][Y][S][I][S]█[*][*] 3 REM [*][*][F][O][U][R][I][E][R][*][*]█[S][H][R][-][E][B]█[V][3][.][1] 4 REM █[G][O][T][O]█[5][0]█[T][O]█[S][T][A][R][T]█[A][N][E][W]█ 5 LET E=A(R1,D+N1)*SIN (W*F) 6 RETURN 10 LET E=A(R1,D+N1)*COS (W*F) 11 RETURN 12 LET A1=(LEN STR$ INT (ABS A))+(A"C" THEN GOTO 270 274 CLS 275 LET Z=CODE Y$-P8 277 IF Y$="C" THEN STOP 278 IF Y$<>"B" THEN GOTO VAL "288" 279 PRINT " SAVE NAME?" 280 INPUT S$ 282 SAVE S$ 285 IF USR M2 THEN LPRINT U;"▘";"00 24 24 7E 24 7E 24 24 00 00 00 00 00 00 00 FF" 287 GOTO 200 288 IF Z=O0 THEN GOTO VAL "700" 289 IF Z=N0 THEN GOTO VAL "50" 290 IF Z=9 AND R=N2 THEN GOTO 297 291 LET Z1=Z/N2-INT (Z/N2) 292 IF Z1<>N0 AND R=N2 THEN GOSUB RF1 293 IF Z1=N0 AND R=N1 THEN GOTO VAL "200" 294 IF Z1=N0 THEN GOSUB RF2 295 GOSUB RVD+VAL "200"*INT ((Z-N1)/N2)+VAL "800"*(Z>N4) 296 GOTO VAL "200" 297 GOSUB XVY 298 GOTO VAL "200" 300 CLS 302 IF USR M2 THEN RETURN 305 LET RS=N0 310 PRINT P$;A$;B$,"(MUST BE EVEN)="; 315 INPUT C 320 IF C/N2-INT (C/N2)<>N0 THEN GOTO VAL "300" 325 PRINT C 335 PRINT ,,P$;A$;C$;"="; 340 INPUT I 345 PRINT I 355 PRINT ,," ";A$;K$;"S=?",D$;"1 OR 2" 360 LET Y$=INKEY$ 363 IF Y$<>"1" AND Y$<>"2" THEN GOTO 360 365 LET V=CODE Y$-P8 370 DIM A(V,C+N1) 380 DIM B(V,N2*I+N1) 400 CLS 405 IF V=N2 THEN PRINT K$;" ";R+N1 415 PRINT ,,L$;N$;O$;D$;"1",M$;N$;O$;D$;"2",L$;" AND ";M$;N$;D$;"3" 425 LET Y$=INKEY$ 430 IF Y$<"1" OR Y$>"3" THEN GOTO 425 435 LET G=CODE Y$-P8 445 LET S=(G=N2) 450 LET T=(G>N1) 460 PRINT ,,C$;" INCREMENT="," ODD ";C$;O$;D$;"2"," ODD + EVEN ";C$;D$;"1" 465 LET Y$=INKEY$ 470 IF Y$<>"1" AND Y$<>"2" THEN GOTO 465 475 LET K=CODE Y$-P8 480 IF K=N2 THEN LET K=1.999 485 IF Z$="2" THEN GOTO VAL "800"+O0*RS 500 IF RS=N1 THEN GOTO VAL "535" 505 LET I1=I 510 PRINT ,,P$;K$;" F(X), OR ",,,,,D$(N2 TO );P$;" TO INPUT DATA.",,,P$;"0 TO USE SAME WAVE.",,,P$;"1 TO USE PROGRAMMED"," ";K$ 515 INPUT T$ 522 IF T$="0" THEN GOTO VAL "535" 525 GOSUB CFC+VAL "500"*(T$="")+VAL "2000"*(T$="1") 535 LET Z$="1" 538 LET R1=R+N1 540 CLS 542 IF V=N2 THEN PRINT K$;" ";R1 545 PRINT E$;I$;D$;"R",Q$;" ";I$;D$;"E",F$;K$;D$;"G","RUN ";G$;D$;"A" 550 LET Y$=INKEY$ 551 IF Y$="" THEN GOTO 550 552 IF Y$="R" THEN GOSUB RVD 554 IF Y$="E" THEN GOSUB EDD 556 IF Y$="A" THEN GOTO VAL "570" 558 IF Y$="G" THEN GOSUB GRD 560 GOTO 540 570 GOSUB ANA 575 LET R=R+N1 577 GOSUB VAL "2900" 578 LET R1=R 580 CLS 585 PRINT E$(N3 TO );J$;D$;"V",F$;J$;D$;"G","PROCEED";D$;"P" 587 IF R=N2 THEN PRINT F$;"X VS. Y";D$;"X" 590 LET Y$=INKEY$ 592 IF Y$="" THEN GOTO 590 594 IF Y$="V" THEN GOSUB RVC 595 IF Y$="G" THEN GOSUB GRC 596 IF Y$="P" THEN GOTO VAL "600" 597 IF Y$="X" AND R=N2 THEN GOSUB XVY 598 GOTO 580 600 IF RI THEN GOTO VAL "725" 738 LET R=N0 740 GOSUB VAL "2950" 745 GOTO VAL "810" 750 LET R=N0 760 GOSUB VAL "2950" 770 GOTO VAL "535" 780 CLS 790 STOP 799 REM [S][Y][N][T][H][E][S][I][S] 800 LET R1=R+N1 802 GOSUB INP 805 LET I1=I 810 LET Z$="2" 817 CLS 820 IF V=N2 THEN PRINT K$;" ";R+N1 822 PRINT ,,,,E$;J$;D$;"R",,,Q$;" ";J$;D$;"E",,,F$;J$;D$;"G",,,"RUN ";H$;D$;"S" 825 LET Y$=INKEY$ 826 IF Y$="" THEN GOTO 825 827 IF Y$="R" THEN GOSUB RVC 828 IF Y$="E" THEN GOSUB EDC 830 IF Y$="G" THEN GOSUB GRC 832 IF Y$="S" THEN GOTO VAL "840" 835 GOTO VAL "817" 840 GOSUB SYN 842 LET R=R+N1 843 GOSUB VAL "2900" 845 CLS 847 LET R1=R 850 IF V=N2 THEN PRINT K$;" ";R 852 PRINT ,,E$(N3 TO );I$;D$;"V",F$;I$;D$;"G" 853 IF R=N2 THEN PRINT ,,"X VS Y";D$;"X" 855 PRINT ,,"PROCEED";D$;"P" 856 LET Y$=INKEY$ 858 IF Y$="" THEN GOTO 856 862 IF Y$="V" THEN GOSUB RVD 864 IF Y$="G" THEN GOSUB GRD 866 IF Y$="X" AND R=N2 THEN GOSUB XVY 868 IF Y$="P" THEN GOTO VAL "880" 870 GOTO 845 880 IF RC+N1 THEN GOTO VAL "3060" 3048 LET A=A(R1,P) 3049 GOSUB O2 3050 IF USR M2 THEN PRINT AT N8*O+N8,N*8+5-A1;(INT (A*100))/100 3053 NEXT O 3055 NEXT N 3060 IF USR M2 THEN PRINT AT N0,N0;"DIV" 3062 GOSUB VAL "3300" 3066 IF Y$="Y" THEN RETURN 3068 NEXT M 3070 RETURN 3202 LET L=INT (I1/P0) 3205 FOR M=N0 TO L 3215 FAST 3217 IF USR M2 THEN CLS 3220 IF USR M2 THEN PRINT ;,"[H][A][R] [S][I][N][E] [T]ERMS","[C][O][S][I][N][E] [T]ERMS","[P]HASE [A]NGLE","[M]AGNITUDE",;;;;"▘";, 3225 FOR N=N0 TO VAL "19" 3230 IF P0*M+N>I1 THEN GOTO VAL "3270" 3232 LET W=(K=N1 OR N/N2-INT (N/N2)<>N0) 3235 IF W=N1 OR NOT (M+N) THEN IF USR M2 THEN PRINT AT N8*(N+N2),N0;;P0*M+N;, 3238 IF NOT (M+N) THEN GOTO VAL "3250" 3240 LET A=B(R1,N4*O0*M+N2*N) 3241 LET B=A 3242 IF NOT (M+N) THEN GOTO VAL "3250" 3245 GOSUB O2 3247 IF USR M2 THEN PRINT AT N8*(N+N2),O0-A1;(INT (A*1E4+.5))/1E4 3250 IF NOT ((T=N1 AND W=N1) OR NOT (M+N)) THEN GOTO 3275 3252 LET A=B(R1,N4*O0*M+N2*N+N1) 3253 GOSUB O2 3254 IF USR M2 THEN PRINT AT N8*(N+N2),22-A1;(INT (A*1E4+.5))/1E4 3255 IF NOT (M+N) THEN GOTO 3275 3256 LET P=SQR (A*A+B*B) 3257 IF NOT B THEN LET B=1E-20 3258 LET A=180*ATN (A/B)/PI 3259 IF BU THEN LET U=ABS A(R1,A) 4237 NEXT A 4239 LET U=80/(U+1E-20) 4240 IF USR M2 THEN PRINT AT 24,P0;;" ";AT N0,N0;"PEAK VAL=";INT (P0/U);" ";"1 HOR "".""=";C/O0;" DIV" 4242 IF USR M2 THEN LPRINT D;N0,97,240,97;D;N1,P0,N1,176 4244 FOR X=N0 TO 240.05 STEP 240/C 4245 LET Y=INT (U*A(R1,N1+X*C/240)+.5)+97 4250 IF USR M2 THEN LPRINT D;X+N1,Y 4255 NEXT X 4260 GOSUB VAL "3300" 4270 RETURN 4402 FAST 4403 LET P=N0 4404 LET U=N0 4405 FOR A=N0 TO I1+K-N1 STEP K 4406 IF A THEN LET P=B(R1,N2*INT A) 4407 LET Q=B(R1,N2*INT A+N1) 4408 LET W=(P*P+Q*Q) 4409 IF W>U THEN LET U=W 4410 NEXT A 4412 LET U=160/SQR U 4420 LET O=N0 4422 LET P=N0 4426 IF USR M2 THEN CLS 4428 FOR A=N1 TO P1 4430 IF USR M2 THEN PRINT AT N8*A,N0;,"-";TAB 52;"-" 4435 NEXT A 4440 FOR A=N3 TO VAL "47" STEP N4 4445 IF USR M2 THEN PRINT AT N8*P1,A;".";AT N8*O1,A;"-" 4450 NEXT A 4453 IF USR M2 THEN PRINT AT N0,55;" [H]ARMONIC" 4455 IF USR M2 THEN PRINT AT N8*P1,52;"0 [A]MPLITUDE";AT N8*P0,54;;;;"▝▝▝▝▝";, 4457 IF USR M2 THEN PRINT AT N8*O1,52;"0 [P]HASE";AT N8*O0,54;;"-----" 4490 FOR O=O TO VAL "25"+O+K-N1 STEP K 4495 LET W=INT O 4497 IF W>I1 THEN GOTO VAL "4566" 4500 LET X=(W/52-INT (W/52))*52 4501 IF X<26 THEN GOTO 4510 4503 LET X=X-25 4505 GOTO 4501 4510 IF (W-N1)/N4=INT ((W-1)/N4) THEN IF USR M2 THEN PRINT AT N2,N2*X;;W 4515 IF W<>N0 THEN LET P=B(R1,N2*W) 4517 LET Q=B(R1,N2*W+N1) 4520 IF NOT W THEN GOTO VAL "4545" 4525 IF NOT P THEN LET P=1E-10 4527 LET A=ATN (Q/P)*80/PI+80 4530 IF P160 THEN LET A=A-160 4534 LET A=INT (A+.5)+17 4536 FOR X=8*X TO 8*X+8 STEP 2 4540 IF USR M2 THEN PLOT X,A 4542 NEXT X 4545 LET Y=INT (U*SQR (P*P+Q*Q)+.5)+17 4550 LET X=X-O0 4552 IF USR M2 THEN PLOT X,Y 4555 IF USR M2 THEN LPRINT D;X+8,Y 4565 NEXT O 4570 GOSUB VAL "3300" 4572 IF Y$="Y" THEN RETURN 4573 IF W>=I1 THEN RETURN 4575 GOTO VAL "4426" 4602 FAST 4605 IF USR M2 THEN CLS 4610 LET O=A(N1,N1) 4615 LET P=O 4620 LET M=A(N2,N1) 4625 LET N=M 4630 FOR A=N1 TO C+N1 4635 IF A(N1,A)P THEN LET P=A(N1,A) 4650 IF A(N2,A)N THEN LET N=A(N2,A) 4660 NEXT A 4665 LET U=(P-O)/255 4670 LET W=(N-M)/181 4675 LET U=U*(U>W)+W*(W>U) 4677 IF USR M2 THEN PLOT (A(N1,N1)-O)/U,O0+(A(N2,N1)-M)/U 4678 IF USR M2 THEN CLS 4680 FOR A=N1 TO C+N1 4685 IF USR M2 THEN LPRINT D;(A(N1,A)-O)/U,O0+(A(N2,A)-M)/U 4690 NEXT A 4695 GOSUB VAL "3310" 4700 RETURN 5005 CLS 5010 PRINT "X-AXIS LIMITS:",,"LOW="; 5020 INPUT XL 5030 PRINT XL,,"HIGH="; 5040 INPUT XH 5050 PRINT XH,,,,"OK?" 5060 IF INKEY$ ="Y" THEN GOTO VAL "5080" 5070 IF INKEY$ ="N" THEN GOTO VAL "5000" 5075 GOTO 5060 5080 PRINT ,,"PLEASE WAIT..." 5085 FAST 5090 FOR A=N0 TO C 5100 LET X=(A/C)*(XH-XL)+XL 5110 LET A(R+N1,A+N1)=VAL T$ 5120 NEXT A 5130 SLOW 5140 RETURN 5405 PRINT "[D][I][V] [V][A][L][U][E]" 5410 FOR A=N0 TO C 5415 SCROLL 5417 PRINT AT P1,Q1;" ";AT P1,N0; 5418 LET Y$="Y("+STR$ A+")=" 5420 PRINT Y$ 5422 IF A=C THEN GOTO VAL "5428" 5425 INPUT A(R+N1,A+N1) 5426 GOTO 5430 5428 LET A(R+N1,C+N1)=A(R+N1,N1) 5430 LET Y$=Y$+STR$ A(R,A+N1) 5432 PRINT AT P1,N0;Y$ 5433 IF PF THEN LPRINT Y$ 5435 NEXT A 5460 CLS 5470 RETURN 5500 CLS 5502 LET PF=N0 5505 PRINT "HARD COPY?" 5506 LET Y$=INKEY$ 5507 IF Y$="N" THEN GOTO VAL "5520" 5508 IF Y$="Y" THEN GOTO VAL "5515" 5510 GOTO 5506 5515 LET PF=N1 5520 PRINT AT 17,6;"[I][N][P][U][T]█[C][Y][C][L][E]";" - "; 5525 PRINT (I$ AND Z$="1")+(J$ AND Z$="2") 5530 IF V=N2 THEN PRINT K$;" ";R+1,,,, 5540 GOSUB VAL "5400"+(VAL "200" AND Z$="2") 5545 LET T$="" 5550 RETURN 5602 LET Y$="" 5605 PRINT "[S][I][N][E]█[T][E][R][M][S]","[C][O][S]█[T][E][R][M][S]" 5615 FOR A=N0 TO I+K-N1 STEP K 5620 LET W=INT A 5625 SCROLL 5630 IF S=N0 THEN GOTO VAL "5640" 5635 GOTO VAL "5660" 5640 IF W=N0 THEN GOTO VAL "5660" 5642 LET Y$="B("+STR$ W+")=" 5645 PRINT AT P1,N0;Y$ 5650 INPUT B(R1,N2*W) 5652 LET Y$=Y$+STR$ B(R1,N2*W) 5655 PRINT AT P1,N0;Y$ 5660 IF T=N1 THEN GOTO VAL "5670" 5665 GOTO VAL "5678" 5670 LET Y$=(Y$+R$)( TO 16)+"A("+STR$ W+")=" 5672 PRINT AT P1,N0;Y$ 5675 INPUT B(R1,N2*W+N1) 5676 LET Y$=Y$+STR$ B(R1,N2*W+N1) 5677 PRINT AT P1,N0;Y$ 5678 IF PF THEN LPRINT Y$ 5680 NEXT A 5690 CLS 5700 RETURN 5802 LET P=N0 5805 FAST 5810 CLS 5812 PAUSE N1 5815 PRINT AT N0,O6;I$,,"[E][D][I][T]█[C][Y][C][L][E]" 5822 FOR A=N0 TO VAL "19" 5825 PRINT AT A+N2,N0;P;AT A+N2,N4;A(R1,P+N1) 5830 LET P=P+N1 5832 PAUSE N1 5835 IF P>C THEN GOTO VAL "5845" 5840 NEXT A 5845 PRINT AT N0,N0;"[D][I][V][.] [V][A][L][U][E]" 5850 PRINT AT O0,O6;"ALL OK";D$;"K";AT O2,O6;Q$;" ";D$;"L";AT VAL "13",O6;R$;AT VAL "14",O6;"RETURN";D$;"Y" 5855 SLOW 5858 LET Y$=INKEY$ 5860 IF Y$="L" THEN GOTO VAL "5867" 5862 IF Y$="Y" THEN RETURN 5865 IF Y$="K" THEN GOTO VAL "5895" 5866 GOTO 5858 5867 PRINT AT O0,O6;R$;AT O2,O6;Q$;"-";P$;"DIV.";AT VAL "13",O6;"TO BE ";Q$;"ED ";AT VAL "14",O6;R$ 5870 INPUT A 5875 PRINT AT O0,O6;R$;AT O2,VAL "15";P$;" NEWVALUE";AT VAL "13",O6;B$( TO 8);" NO. ";A 5880 INPUT A(R1,A+N1) 5882 LET O=P0*(A/P0-INT (A/P0))+N2 5883 PRINT AT O,N4;R$( TO VAL "12") 5885 PRINT AT O,N4;A(R1,A+N1) 5890 GOTO VAL "5845" 5895 IF P>C THEN RETURN 5900 GOTO VAL "5805" 6005 CLS 6010 PRINT AT N0,O6;"[E][D][I][T]█[C][Y][C][L][E]" 6017 PRINT ,,"RETURN";D$;P$ 6020 PRINT Q$;" ";C$( TO VAL "8");" ";A$( TO VAL "7");"="; 6025 INPUT Y$ 6030 IF Y$="" THEN RETURN 6032 LET H=VAL Y$ 6035 PRINT H 6040 PRINT ,,L$;N$( TO N4);D$;"Q",M$;N$( TO N4);D$;"W" 6055 LET Y$=INKEY$ 6060 IF Y$="Q" THEN LET G=N0 6065 IF Y$="W" THEN LET G=N1 6067 IF Y$<>"Q" AND Y$<>"W" THEN GOTO 6055 6070 PRINT 6075 PRINT "PRESENT VAL=";B(R1,N2*H+G) 6080 PRINT 6085 PRINT "OK";D$;P$,Q$;" -";P$;"NEW VALUE." 6090 INPUT Y$ 6095 IF Y$="" THEN GOTO VAL "6005" 6100 LET B(R1,N2*H+G)=VAL Y$ 6105 GOTO VAL "6005" 6999 REM 7000 REM [P][R][O][G][R][A][M][M][E][D]█[F][U][N][C][T][I][O][N][S] 7010 REM ENTER YOUR CODE TO FILL ARRAY A HERE, AND ENTER "1" IN REPLY TO "FUNCT- ION?" PROMPT. 7998 RETURN 9990 SAVE "FOURIER-W[R]" 9991 GOTO VAL "200" ```