Fourier Analysis

Developer(s): Fred Nachbaur
Date: 1982
Type: Cassette
Platform(s): TS 1000

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 RangePurpose
0–4REMs containing machine code and display data
5–12Micro-subroutines: sine/cosine term evaluation, formatted number width
50–60Initialization of run counter R
100–160Title screen (conditional on USR M2 hardware test)
200–298Main menu dispatcher
300–485Setup: data dimensions, waveform count, harmonic range
500–598Analysis entry, data input, run-analysis, view results
700–780Re-synthesis setup with selectable harmonic count
800–890Synthesis path menu, coefficient input, run-synthesis, view results
1001–1130ANA: Fourier analysis subroutine (Simpson’s rule integration)
1200–1240Time estimate and FAST-mode setup
1250–1270Progress display during computation
2002–2085SYN: Fourier synthesis subroutine
2900–2960Waveform flip/copy helpers (FF1, FF2, RF1, RF2)
3002–3070RVD: tabular display of waveform data array
3202–3290RVC: tabular display of Fourier coefficients with phase and magnitude
3302–3360Screen-pause subroutine with COPY/CONTINUE/RETURN options
3440–4060Parameter save/restore subroutines for dual-waveform mode
4200–4270GRD: graph waveform data to screen and printer
4402–4575GRC: spectral amplitude/phase dot plot
4602–4700XVY: X-versus-Y parametric plot via LPRINT
5005–5140Programmed function data fill (X-axis limits, formula evaluation)
5405–5470INP: manual data-point entry with scroll display
5500–5550Input wrapper with optional hard-copy flag
5602–5700EDC: edit Fourier coefficients interactively
5802–5900EDD: scroll-edit waveform data array
6005–6105Coefficient editor (harmonic number + sine/cosine selection)
7000–7998Stub for user-supplied programmed waveform function
9990–9991SAVE 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.

Content

Appears On

Related Products

Related Articles

Related Content

Image Gallery

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 <X4 TO AT ££ GOSUB #AT ZTAN U<=Z RETURNASEXP  RETURN[A]KASN  FAST5 2; FOR  LPRINT /AT U<=Z▛ FAST5 0S LET A,/ GOSUB  CLEARACS ##Y[S]C▝Y[C][S]SQR ## NEW▛▙#VAL ) 45 5ACS SACS SACS S# GOSUB [K]F#( UNPLOT AT TAN LN COS RNDY*C▀LN [H]RND)  WEAT Z FAST GOSUB #AT Z GOSUB #£RND< PRINT ▞4,VAL STR$ LN ##SGN AT <( PRINT  LET X4 GOSUB  LPRINT 6AT ZTAN LN COS RNDCATN LN [H]RNDW PRINT #Y""CHR$ ▒( UNPLOT ## LET /LEN 7LN [T]RNDLN ,,INKEY$ LN [4]RNDTAN Y COPY/▘[J]MVAL Z CLEARACS #[:]LN ## GOSUB #NOT ZE-RNDLN ## GOSUB # OR ZE-RND7LN [T]RNDLN ,,INKEY$  GOSUB #<=ZE#Z FAST GOSUB ##ZE OR Z FASTLN £PI LPRINT 6#ZENOT Z FASTLN £PI LPRINT 6#ZE<=ZLN £PI LPRINT 6#ZTAN LN +#4.UINT Z5 4##▘4 ,,▘ STEP * GOSUB [K]▞4F#( UNPLOT X4 DIM TAN USGN Z RETURN C##UPEEK Z#VAL Y[Z][(]VAL  PRINT WVAL LN  LET RNDSGN Y▒[S]4*UABS Z[<] RETURN▒S?#▘4  GOSUB PI# LET AT #LEN ▒#/ OR #?( CLEAR2 COPYS▘0 LET AT VAL LN SGN INKEY$ AT #▞ UABS Z##▀[B] GOSUB PIPIK[U]AT ▌USQR Z[S]4[L]USQR Z#EPEEK ZY COPY[W]4▘8# FASTVAL Y[Z][(]2 LN SGN INKEY$ AT £ LPRINT 94 LIST 5INT ZP4▟TAN LN +#40UINT Z5 COPYR##▘4  GOSUB PI▘ STEP * GOSUB [S]▞47#( UNPLOT X4 CONT TAN USQR Z RETURN[Z]C##UPEEK Z#VAL Y[Z][(]VAL  PRINT XVAL LN  LET RNDSGN Y▒[S]4-UABS Z[<] RETURN▒S:#▘4 ,,# LET AT #LEN ▒#/ AND #?( CLEAR2 COPYS▘0 LET AT VAL LN SGN INKEY$ AT #▞ UABS Z##▀[B] GOSUB PIPIK[V]AT ▖USGN Z RETURN C▀[S]4[I]USGN Z#EPEEK ZY COPY[W]4▘8# FASTVAL Y[Z][(]2 LN SGN INKEY$ AT £ LPRINT 94 LIST 5INT ZPTAB ▗#TAN LN +#4*UINT Z#5 COPYR▞4#[B]ACS -F( CLS[8]4 POKE 14 INPUT TAN USGN Z#UPEEK Z#VAL Y[Z][(]VAL  PRINT £LN  LET RND#?( CLEAR2 COPYS▘0 LET AT VAL LN SGN INKEY$ AT UABS Z£[T]4 STEP AT ▌# RETURN COPYC▒USQR Z##[U]KSQR  GOSUB #SGN Z#INKEY$ #USTR$ Z# FASTVAL Y[Z][(]2 LN SGN INKEY$ AT ▌ LPRINT H4 LIST 5INT ZP4[B]TAN LN +#41UINT Z#5 4[B]▞4ACS 27( CLS▘ S[B] FAST GOSUB PI LPRINT 4 INPUT 14 CONT TAN USGN Z#UABS Z#VAL Y[Z][(]VAL  PRINT $LN  LET RNDY,,[(]##▛( CLEAR2 COPYS▘0 LET AT VAL LN SGN INKEY$ AT UPEEK Z$[T]4>=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 </ PAUSE 7LN [H]RND RETURN4) ▞SSTR$ LN [*]RNDINT .▘4 ,,# RETURNS**CHR$ /#TAN 7LN [H]RND RETURN4K SCROLLLN [4]RND[B]***- #5 Y;6**Z SCROLLLN [T]RND GOSUB # AND ZTAN LN ##Y[Z][(]K▝CHR$ RND##ACS WACS 1ACS WACS 1ACS WACS 1ACS  GOTO 6>=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 ##<AT ▀ LET XTAB ACS #TAN LN COS RNDTAB SQR #E>=Z) STOPZ▞▒VAL ,#7<,#LN ##F<AT ( LET TAN  CLEARACS #EXP LN ##E-RND# RETURN,4$7 GOSUB ##Z FASTLN [4]# LPRINT LN [T]RND#~~PIVAL 5ORND##[S]C UNPLOT  CLEAR[-]#M#RNDLN £#AT LN [4]#U#RND CLEAR[Y]O4 CLSTAN LN COS RNDY C▀LN [H]RNDM#RNDTAN 1""AT Y▖PEEK  CLS0LN ###["]INKEY$  GOSUB ##INKEY$ <<7# RETURN#C*STR$ LN [H]RND#LN ▞INKEY$ ▖SGN ##ACS [W],LEN █>#<( 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 <TAN 2 ▞▒LN ""#( CLSTAN - =PEEK  COPY# RETURNRNDK)2 LN ""#LN #?ABS [A]▀#[B]4 SCROLL/ SCROLL2 PEEK  COPYLN ""##[B]C PRINT LN PEEK #04CHR$ LN PEEK ## RETURN[E]4EXP LN PEEK ##LN PEEK #STR$ PEEK  COPYLN PEEK ##SGN 7.#[N]4 PAUSE TAN  FASTLN ## PRINT STR$ VAL 5WRND FASTLN <>#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]#<STR$ )4 ;SGN  LET AT ( STOPAT £ GOSUB #AT ZTAN ACS ZACS ZACS ZACS Z PRINT # NEW LIST />=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<N0)-(ABS A<.1)+NOT A
  13 RETURN
  50 LET R=N0
  60 LET RS=R
 100 IF USR M2 THEN RUN 
 101 IF USR M2 THEN CLS
 102 IF USR M2 THEN RAND 
 103 IF USR M2 THEN RAND VAL "31"
 104 IF USR M2 THEN PRINT AT O0,VAL "24";;"[F][O][U][R][I][E][R]";AT P8,O0;G$;" AND ";H$
 120 IF USR M2 THEN PRINT AT VAL "64",VAL "18";,"  BY";;" F. NACHBAUR";AT VAL "80",P0;"(C)1982,1987"
 125 IF USR M2 THEN PRINT AT VAL "160",N0;;G$;" ";D$;"1"
 130 IF USR M2 THEN PRINT H$;D$;"2"
 140 LET Z$=INKEY$ 
 150 IF Z$="1" OR Z$="2" THEN GOTO 300
 160 GOTO 140
 200 CLS
 201 SLOW
 202 LET I1=I
 205 PRINT E$;I$,"  ";K$;" 1";D$;"1"
 210 IF R=N2 THEN PRINT "  ";K$;" 2";D$;"2"
 215 PRINT ,,E$;J$,"  ";K$;" 1";D$;"3"
 220 IF R=N2 THEN PRINT "  ";K$;" 2";D$;"4"
 225 PRINT ,,F$;I$,,"  ";K$;" 1";D$;"5"
 230 IF R=N2 THEN PRINT "  ";K$;" 2";D$;"6"
 235 PRINT ,,F$;J$,"  ";K$;" 1";D$;"7"
 240 IF R=N2 THEN PRINT "  ";K$;" 2";D$;"8"
 245 IF R=N2 THEN PRINT ,,F$;"X VS. Y ";D$;"9"
 250 PRINT ,," NEW";G$;"/";H$;D$;"0"
 255 PRINT "RE-";H$;D$;"A","SAVE";D$;"B","EXIT";D$;"C"
 270 LET Y$=INKEY$ 
 271 IF Y$<"0" OR Y$>"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 R<V AND NOT RS THEN GOTO VAL "400"
 607 IF R<V THEN GOTO VAL "760"
 630 CLS
 635 PRINT "RE-";
 640 IF Z$="1" THEN PRINT H$;" OF ";I$,D$;"S"
 645 IF Z$="2" THEN PRINT G$;" OF ";I$,,,D$;"R"
 650 PRINT ,,"NEW ";G$;"/";H$;D$;"N",,E$;D$;"V",,,"END";D$;"E"
 655 LET Y$=INKEY$ 
 660 IF Y$="S" AND Z$="1" THEN GOTO VAL "700"
 665 IF Y$="R" AND Z$="2" THEN GOTO VAL "750"
 670 IF Y$="N" THEN GOTO 50
 675 IF Y$="V" THEN GOTO VAL "200"
 680 IF Y$="E" THEN GOTO VAL "780"
 685 GOTO 655
 700 LET RS=N1
 710 CLS
 715 PRINT "USE ? ";C$;" (MAX=";I;")"
 717 PRINT 
 720 PRINT " RETURN OR  SAVE ";P$;"9999"
 725 INPUT I1
 730 IF I1=VAL "9999" THEN GOTO 610
 735 IF I1>I 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 R<V AND RS=N1 THEN GOTO VAL "740"
 885 IF NOT RS THEN GOTO VAL "600"
 890 GOTO VAL "700"
 1001 CLS
 1002 LET M=VAL "175"
 1003 PRINT G$;
 1005 GOSUB VAL "1200"
 1010 LET B=N2*PI/C
 1015 FOR G=S TO T
 1020 LET J=5+5*G
 1025 FOR H=N0 TO I+K-N1 STEP K
 1027 LET W=INT H
 1028 GOSUB VAL "1250"
 1030 IF NOT (G+W) THEN GOTO 1115
 1035 LET A=N0
 1040 LET F=N0
 1045 LET D=N0
 1050 GOSUB J
 1055 LET A=A+E
 1060 LET F=F+B
 1065 LET D=D+N1
 1070 GOSUB J
 1075 LET A=A+N4*E
 1080 LET F=F+B
 1085 LET D=D+N1
 1090 GOSUB J
 1095 LET A=A+E
 1100 IF D<C THEN GOTO 1055
 1105 LET B(R1,N2*W+G)=A*B/N3/PI
 1115 NEXT H
 1120 NEXT G
 1125 SLOW
 1130 RETURN
 1200 LET M=INT (N1+C*I1/K/((S=T)+N1)/M)
 1205 PRINT " WILL TAKE:",INT (M/S0);" HRS. ";INT (M-S0*INT (M/S0));" MIN"
 1210 PAUSE S0*N2
 1220 FAST
 1230 CLS
 1240 RETURN
 1250 PRINT AT N4,N0;"WORKING ON: ";("COS " AND G);("SIN " AND NOT G);"NO. ";W;"   "
 1260 PAUSE VAL "99"
 1270 RETURN
 2002 CLS
 2005 LET M=VAL "230"
 2010 PRINT H$;
 2015 GOSUB VAL "1200"
 2030 LET B=N2*PI/C
 2031 FOR A=N1 TO C+N1
 2032 LET A(R1,A)=B(R1,N1)/N2
 2033 NEXT A
 2035 FOR G=S TO T
 2040 FOR H=N0 TO I1+K-N1 STEP K
 2042 LET W=INT H
 2043 GOSUB VAL "1250"
 2045 IF NOT W THEN NEXT H
 2050 FOR D=N0 TO C
 2055 IF NOT G THEN LET A(R1,D+N1)=A(R1,D+N1)+B(R1,N2*W)*SIN (W*B*D)
 2060 IF G THEN LET A(R1,D+N1)=A(R1,D+N1)+B(R1,N2*W+N1)*COS (W*B*D)
 2065 NEXT D
 2070 NEXT H
 2075 NEXT G
 2080 SLOW
 2085 RETURN
 2900 IF R=N1 AND V=N2 THEN GOSUB FF1
 2905 IF R=N2 THEN GOSUB FF2
 2910 RETURN
 2950 IF NOT R AND V=N2 THEN GOSUB RF1
 2955 IF R=N1 AND V=N2 THEN GOSUB RF2
 2960 RETURN
 3002 LET L=INT (C/160)
 3005 FOR M=N0 TO L
 3010 FAST
 3015 IF USR M2 THEN CLS
 3020 FOR A=N0 TO VAL "9"
 3022 IF USR M2 THEN PRINT AT N8*A+N8,N0;," ";CHR$ (A+28)
 3025 NEXT A
 3026 FOR A=N0 TO VAL "9"
 3028 IF USR M2 THEN PRINT AT N8*(A+O1),N0;"1";CHR$ (A+28)
 3030 NEXT A
 3035 FOR N=N0 TO 7
 3040 IF USR M2 THEN PRINT AT N0,N*8+N3;" ";M*160+N*P0;" "
 3044 FOR O=N0 TO VAL "19"
 3046 LET P=N1+M*160+N*P0+O
 3047 IF P>C+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 B<N0 THEN LET A=A+180
 3261 GOSUB O2
 3263 IF USR M2 THEN PRINT AT N8*(N+N2),30;"▌";TAB 38-A1;,(INT (A*1E4+.5))/1E4
 3265 LET A=P
 3267 GOSUB O2
 3268 IF USR M2 THEN PRINT AT N8*(N+N2),52-A1;(INT (A*1E4+.5))/1E4
 3275 NEXT N
 3280 GOSUB VAL "3300"
 3282 IF Y$="Y" THEN RETURN
 3285 NEXT M
 3290 RETURN
 3302 IF USR M2 THEN PRINT AT VAL "176",N0;T$
 3315 IF USR M2 THEN PRINT AT VAL "184",N1;;"[Z][=][C][O][P][Y]█[:]███[C][=][C][O][N][T]█[:]███[Y][=][R][E][T][U][R][N]██"
 3320 IF USR M2 THEN RUN 
 3330 LET Y$=INKEY$ 
 3340 IF Y$="C" OR Y$="Y" THEN IF NOT USR M2 THEN RETURN
 3350 IF Y$="Z" THEN IF USR M2 THEN COPY
 3355 IF Y$="Z" THEN LPRINT 
 3360 GOTO 3330
 3440 DIM E(N2)
 3475 LET E(N1)=K
 3480 LET E(N2)=O0*S+T
 3482 LET U$=T$
 3485 RETURN
 3640 DIM H(N2)
 3675 LET H(N1)=K
 3680 LET H(N2)=O0*S+T
 3681 LET V$=T$
 3685 RETURN
 3810 LET R1=N1
 3845 LET K=E(N1)
 3850 LET S=INT (E(N2)/O0)
 3855 LET T=E(N2)-O0*S
 3856 LET T$=U$
 3860 RETURN
 4010 LET R1=N2
 4045 LET K=H(N1)
 4050 LET S=INT (H(N2)/O0)
 4055 LET T=H(N2)-O0*S
 4056 LET T$=V$
 4060 RETURN
 4200 FAST
 4203 IF USR M2 THEN CLS
 4204 IF USR M2 THEN PRINT AT N8,VAL "60";,".";AT N8*P1,VAL "60";".";AT N8,N0;"+1";AT N8*P1,N0;"-1"
 4205 FOR A=VAL "9" TO N0 STEP -N1
 4207 IF USR M2 THEN PRINT AT N8*(O1-A),0;".";TAB 60;". ";A
 4208 NEXT A
 4210 FOR A=N1 TO VAL "9"
 4212 IF USR M2 THEN PRINT AT N8*(O1+A),N0;".";TAB 60;". ";A
 4215 NEXT A
 4217 IF USR M2 THEN PRINT AT N8,62;;"+";AT N8*P1,62;;"-"
 4220 FOR A=N0 TO VAL "60" STEP VAL "6"
 4225 IF USR M2 THEN PRINT AT N8*O1,A;"."
 4230 NEXT A
 4232 LET U=N0
 4235 FOR A=N1 TO C+N1
 4236 IF ABS A(R1,A)>U 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 P<N0 THEN LET A=A+80
 4532 IF A>160 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)<O THEN LET O=A(N1,A)
 4640 IF A(N1,A)>P THEN LET P=A(N1,A)
 4650 IF A(N2,A)<M THEN LET M=A(N2,A)
 4655 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"
 

Note: Type-in program listings on this website use ZMAKEBAS notation for graphics characters.

Scroll to Top