100 ' ZMATH.BAS     Dan Maguire  AC6LA
110 '
120 ' Math functions on impedance numbers.
130 '
140 '
150 DEFDBL A-Z
160 '
170 ON ERROR GOTO 5730  'But some cannot be trapped under BASICA
180 DZO.ERR% = 0
190 A = 1 / 0
200 IF DZO.ERR% = 0 THEN CANT.TRAP% = 1 ELSE CANT.TRAP% = 0
210 '
220 COLOR 7,1
230 CLS
240 PRINT "--- ZMATH ---";
250   PRINT "   Math functions on impedance numbers"
260 '
270 KEY  1,"["+CHR$(13)  'F1  = Clear entry / Clear display
280 KEY  5,"{"           'F5  = Store to memory (not from data entry)
290 KEY  8,"}"+CHR$(13)  'F8  = Recall from memory (and process)
300 KEY 10,"]"+CHR$(13)  'F10 = Format swap
310 '
320 KEY 2,"" : KEY 3,"" : KEY 4,""  'To avoid confusion if
330 KEY 6,"" : KEY 7,"" : KEY 9,""  'pressed by mistake
340 '
350 PI = 4 * ATN(1#) : TWOPI = 2 * PI : RAD = 180 / PI
360 MEG = 1000000#
370 VZ = .0000000001#  'virtual zero
380 R1 = 0 : X1 = 0 : FQ = 0
390 R1.MEM = 0 : X1.MEM = 0 : R1.PREV2 = 0 : X1.PREV2 = 0
400 FIRSTI% = 1 : FIRSTA% = 1 : AK$ = "" : DOTS$ = ""
410 '
420 DIM FORM$(5) , AROW%(5) , ACOL%(5) , FLAG$(5)
430 FORM$(1) = "R,"+CHR$(241)+"X"
440 FORM$(2) = "Z,"+CHR$(241)+CHR$(237)
450 FORM$(3) = "Rp,"+CHR$(241)+"Xp"
460 FORM$(4) = "C(pF),F(MHz)"
470 FORM$(5) = "L(uH),F(MHz)"
480 AROW%(1)=3 : AROW%(2)=3 : AROW%(3)=7 : AROW%(4)=11 : AROW%(5)=11
490 ACOL%(1)=1 : ACOL%(2)=42: ACOL%(3)=42: ACOL%(4)=42 : ACOL%(5)=42
500 FLAG$(1)="RX" : FLAG$(2)="Z"+CHR$(237) : FLAG$(3)="pp"
510 FLAG$(4)="pF" : FLAG$(5)="uH"
520 FO% = 1
530 '
540 ' Build display windows.
550 '
560 COLOR 0,7
570 '
580 LOCATE 3,3 : PRINT CHR$(201); CHR$(205); "  R  "; STRING$(11,205);
590                PRINT "  X  "; STRING$(11,205); CHR$(187)
600 LOCATE  ,3 : PRINT CHR$(186); SPC(33); CHR$(186)
610 LOCATE  ,3 : PRINT CHR$(186); SPC(33); CHR$(186)
620 LOCATE  ,3 : PRINT CHR$(186); SPC(33); CHR$(186)
630 LOCATE  ,3 : PRINT CHR$(186); SPC(33); CHR$(186)
640 LOCATE  ,3 : PRINT CHR$(186); SPC(33); CHR$(186)
650 LOCATE  ,3 : PRINT CHR$(200); STRING$(33,205); CHR$(188)
660 '
670 LOCATE 11,3 : PRINT CHR$(201); CHR$(205); " SWR(50) "; STRING$(5,205); CHR$(187)
680 LOCATE   ,3 : PRINT CHR$(186); SPC(15); CHR$(186)
690 LOCATE   ,3 : PRINT CHR$(200); STRING$(15,205); CHR$(188)
700 '
710 LOCATE 11,21: PRINT CHR$(201); CHR$(205); " Q "; STRING$(11,205); CHR$(187)
720 LOCATE   ,21: PRINT CHR$(186); SPC(15); CHR$(186)
730 LOCATE   ,21: PRINT CHR$(200); STRING$(15,205); CHR$(188)
740 '
750 LOCATE 3,44 : PRINT CHR$(201); CHR$(205); "  Z  "; STRING$(11,205);
760                 PRINT "  " ; CHR$(237); "  "; STRING$(11,205); CHR$(187)
770 LOCATE  ,44 : PRINT CHR$(186); SPC(33); CHR$(186)
780 LOCATE  ,44 : PRINT CHR$(200); STRING$(33,205); CHR$(188)
790 '
800 LOCATE 7,44 : PRINT CHR$(201); CHR$(205); "  Rp  "; STRING$(10,205);
810                 PRINT "  Xp  "; STRING$(10,205); CHR$(187)
820 LOCATE  ,44 : PRINT CHR$(186); SPC(33); CHR$(186)
830 LOCATE  ,44 : PRINT CHR$(200); STRING$(33,205); CHR$(188)
840 '
850 LOCATE 11,44 : PRINT CHR$(201); CHR$(205); "  pF or uH  "; STRING$(4,205);
860                  PRINT "  F (MHz)  "; STRING$(5,205); CHR$(187)
870 LOCATE   ,44 : PRINT CHR$(186); SPC(33); CHR$(186)
880 LOCATE   ,44 : PRINT CHR$(200); STRING$(33,205); CHR$(188)
890 '
900 COLOR 7,1
910 '
920 ' Action key legend.
930 '
940 KEY OFF
950 LOCATE 21,1
960 PRINT STRING$(80,196);
970 PRINT "  Action Keys:  + (add)          c (parallel combine)   F1 (Clear entry/Clear)"
980 PRINT "    u (undo)    - (subtract)     r (parallel remove)    F5 (Store to memory)  "
990 PRINT "    \ (";CHR$(241);"180";CHR$(248);")";
1000              PRINT "   * (multiply)     f (change frequency)   F8 (Recall from memory)";
1010 LOCATE 25,1
1020 PRINT "    q (quit)    / (divide)    PgUp (square)           PgDn (square root)";
1030 '
1040 ' Prompt for first entry.
1050 '
1060 LOCATE 17,3 : PRINT "Use F10 to choose entry format, then enter 2 numbers separated by a comma."
1070 LOCATE 18,3 : PRINT "Enter a single 'q' at any time to quit."
1080 KEY 5,""  'F5 temp off
1090 COLOR 14 : LOCATE AROW%(FO%),ACOL%(FO%) : PRINT FLAG$(FO%) : COLOR 7
1100 LOCATE 20,3
1110 PRINT "F10 toggles:  ";
1120 FOR I% = 1 TO 5
1130   IF FO% = I% THEN COLOR 14 ELSE COLOR 7
1140   PRINT FORM$(I%);
1150   IF I% < 5 THEN COLOR 7 : PRINT "  ";CHR$(26);"  ";
1160 NEXT I%
1170 LOCATE 16,3 : COLOR 7
1180 PRINT "Enter impedance in the form ";
1190 COLOR 14 : PRINT FORM$(FO%); : COLOR 7 : PRINT ": ";
1200 LINE INPUT ""; IMPED$
1210 IF IMPED$ = "" THEN GOTO 1170  'Ignore null input
1220 IF RIGHT$(IMPED$,1) = "q" THEN GOTO 5210
1230 IF FIRSTI% THEN LOCATE 17,3 : PRINT STRING$(77,32); : LOCATE 18,3 : PRINT STRING$(77,32); : FIRSTI% = 0
1240 IF RIGHT$(IMPED$,1) = "}" THEN R1 = R1.MEM : X1 = X1.MEM : GOTO 1470
1250 IF RIGHT$(IMPED$,1) <> "[" AND RIGHT$(IMPED$,1) <> "]" THEN GOTO 1310
1260   LOCATE 16,3 : PRINT STRING$(77,32);
1270   IF RIGHT$(IMPED$,1) = "[" THEN GOTO 1170
1280   LOCATE AROW%(FO%),ACOL%(FO%) : PRINT "  "
1290   FO% = FO% + 1 : IF FO% = 6 THEN FO% = 1
1300   GOTO 1090
1310 COMMA% = INSTR(1,IMPED$,",")
1320 IF COMMA% > 0 THEN GOTO 1380
1330 IF FO% >= 4 AND FQ <> 0 THEN COMMA% = LEN(IMPED$)+1 : GOTO 1380
1340   BEEP : COLOR 14 : LOCATE 18,3
1350   PRINT "Enter two numbers separated by a comma."; STRING$(38,32);
1360   COLOR 7 : LOCATE 16,3 : PRINT STRING$(77,32);
1370   GOTO 1170
1380 GOSUB 5270  'Does input conversion and sets DZO.ERR%
1390 IF DZO.ERR% = 0 THEN GOTO 1440
1400   BEEP : COLOR 14 : LOCATE 18,3
1410   PRINT "Error on format conversion."; STRING$(50,32);
1420   COLOR 7 : LOCATE 16,3 : PRINT STRING$(77,32);
1430   GOTO 1170
1440 R1 = R2
1450 X1 = X2
1460 '
1470 KEY 5,"{"  'F5 back on
1480 LOCATE AROW%(FO%),ACOL%(FO%) : PRINT "  "
1490 LOCATE 16,3 : PRINT STRING$(77,32);
1500 LOCATE 18,3 : PRINT STRING$(77,32);
1510 LOCATE 20,3 : PRINT STRING$(77,32);
1520 '
1530 ' Logic returns here after most actions.
1540 ' Clear display window and show current result in R,X format.
1550 '
1560 COLOR 0,7
1570 LOCATE 4,6 : PRINT STRING$(29,32);
1580 LOCATE 5,6 : PRINT STRING$(29,32);
1590 LOCATE 6,6 : PRINT STRING$(29,32);
1600 LOCATE 8,6 : PRINT STRING$(29,32);
1610 '
1620 DZO.ERR% = 0
1630 NA! = R1 : NB! = X1  'Possible overflow under QBasic
1640 '
1650 IF DZO.ERR% THEN LOCATE 6,6 : PRINT " -- (Overflow)  --" : GOTO 1790
1660 IF AK$ = "root" THEN LOCATE 4,6 ELSE LOCATE 6,6
1670 PRINT NA!; TAB(20); ", "; NB!;
1680 IF NB! >= 0 THEN LOCATE ,22 : PRINT "+"
1690 IF AK$ <> "root" THEN GOTO 1790
1700   IF NA! > 0 THEN LOCATE 4,6 : PRINT "+"  'Emphasize pos/neg roots
1710   LOCATE 5,6 : PRINT "or"
1720   NA! = -R1 : NB! = -X1
1730   LOCATE 6,6 : PRINT NA!; TAB(20); ", "; NB!;
1740   IF NB! >= 0 THEN LOCATE 6,22 : PRINT "+"
1750   LOCATE 8,6 : PRINT "(Use '\' to select alternate)"
1760 '
1770 ' SWR(50) and Q of current R,X
1780 '
1790 DZO.ERR% = 0 : IF CANT.TRAP% THEN LOCATE 1,1 : SCREEN ,,1,0
1800 RHO = SQR(((R1-50)^2 + X1^2) / ((R1+50)^2 + X1^2))
1810 IF RHO <> 1 THEN SWR = (1 + RHO) / (1 - RHO) ELSE SWR = 1.7D+38
1820 NA! = SWR
1830 IF CANT.TRAP% THEN SCREEN ,,0,0 : IF CSRLIN > 1 THEN DZO.ERR% = 1
1840 '
1850 LOCATE 12,5 : PRINT STRING$(13,32);
1860 '
1870 LOCATE 12,5
1880 IF DZO.ERR% THEN PRINT "(Overflow)" ELSE PRINT NA!
1890 '
1900 DZO.ERR% = 0 : IF CANT.TRAP% THEN LOCATE 1,1 : SCREEN ,,1,0
1910 IF R1 = 0 THEN Q = 1.7D+38 ELSE Q = ABS(X1) / R1
1920 NA! = Q
1930 IF CANT.TRAP% THEN SCREEN ,,0,0 : IF CSRLIN > 1 THEN DZO.ERR% = 1
1940 '
1950 LOCATE 12,23 : PRINT STRING$(13,32);
1960 '
1970 LOCATE 12,23
1980 IF DZO.ERR% THEN PRINT "(Overflow)" ELSE PRINT NA!
1990 '
2000 ' Current result in Z,A format.
2010 ' Make sure conversion can be done, avoiding overflow if possible.
2020 '
2030 DZO.ERR% = 0 : IF CANT.TRAP% THEN LOCATE 1,1 : SCREEN ,,1,0
2040 ON SGN(R1)+2 GOTO 2050, 2090, 2130
2050   ON SGN(X1)+2 GOTO 2060, 2070, 2080
2060     A1 = ATN(X1/R1) * RAD - 180 : Z1 = SQR(R1*R1 + X1*X1) : GOTO 2170
2070     A1 = 180                    : Z1 = -R1                : GOTO 2170
2080     A1 = 180 + ATN(X1/R1) * RAD : Z1 = SQR(R1*R1 + X1*X1) : GOTO 2170
2090   ON SGN(X1)+2 GOTO 2100, 2110, 2120
2100     A1 = -90                    : Z1 = -X1                : GOTO 2170
2110     A1 = 0                      : Z1 = 0                  : GOTO 2170
2120     A1 = 90                     : Z1 = X1                 : GOTO 2170
2130   ON SGN(X1)+2 GOTO 2140, 2150, 2160
2140     A1 = ATN(X1/R1) * RAD       : Z1 = SQR(R1*R1 + X1*X1) : GOTO 2170
2150     A1 = 0                      : Z1 = R1                 : GOTO 2170
2160     A1 = ATN(X1/R1) * RAD       : Z1 = SQR(R1*R1 + X1*X1)
2170 NA! = Z1 : NB! = A1
2180 IF CANT.TRAP% THEN SCREEN ,,0,0 : IF CSRLIN > 1 THEN DZO.ERR% = 1
2190 '
2200 LOCATE 4,47 : PRINT STRING$(31,32);
2210 '
2220 LOCATE 4,47
2230 IF DZO.ERR% THEN PRINT " -- (Overflow)  --" : GOTO 2290
2240 PRINT NA!; TAB(61); ", "; NB!; CHR$(248);
2250 IF NB! >= 0 THEN LOCATE 4,63 : PRINT "+"
2260 '
2270 ' Current result in Rp,Xp format.
2280 '
2290 DZO.ERR% = 0 : IF CANT.TRAP% THEN LOCATE 1,1 : SCREEN ,,1,0
2300 IF R1 = 1.7D+38 OR X1 = 1.7D+38 THEN R1P = 1.7D+38 : X1P = 1.7D+38 : GOTO 2340
2310 IF ABS(R1) < VZ AND ABS(X1) < VZ THEN R1P = 0 : X1P = 0 : GOTO 2340
2320 IF ABS(R1) < VZ THEN R1P = 1.7D+38 ELSE R1P = (R1*R1 + X1*X1) / R1
2330 IF ABS(X1) < VZ THEN X1P = 1.7D+38 ELSE X1P = (R1*R1 + X1*X1) / X1
2340 NA! = R1P : NB! = X1P
2350 IF CANT.TRAP% THEN SCREEN ,,0,0 : IF CSRLIN > 1 THEN DZO.ERR% = 1
2360 '
2370 LOCATE 8,47 : PRINT STRING$(29,32);
2380 '
2390 LOCATE 8,47
2400 IF DZO.ERR% THEN PRINT " -- (Overflow)  --" : GOTO 2460
2410 PRINT NA!; TAB(61); ", "; NB!;
2420 IF NB! >= 0 THEN LOCATE 8,63 : PRINT "+"
2430 '
2440 ' Current result in pF or uH format.
2450 '
2460 IF FQ = 0 THEN LOCATE 12,47 : PRINT " --  (Frequency not set)  --" : GOTO 2710
2470 '
2480 DZO.ERR% = 0 : IF CANT.TRAP% THEN LOCATE 1,1 : SCREEN ,,1,0
2490 ON SGN(X1)+2 GOTO 2500, 2530, 2560
2500   NA! = -MEG / (TWOPI * FQ * X1)
2510   PFUH$ = " pF  "+STRING$(6,205)
2520     GOTO 2580
2530   NA! = 0
2540   PFUH$ = " pF or uH  "
2550     GOTO 2580
2560   NA! = X1 / (TWOPI * FQ)
2570   PFUH$ = " uH  "+STRING$(6,205)
2580 NB! = FQ
2590 IF CANT.TRAP% THEN SCREEN ,,0,0 : IF CSRLIN > 1 THEN DZO.ERR% = 1
2600 '
2610 LOCATE 12,47 : PRINT STRING$(29,32);
2620 '
2630 LOCATE 12,47
2640 IF DZO.ERR% THEN PRINT " -- (Overflow)  --" : GOTO 2710
2650 IF NA! >= .001 AND NA! < 1 THEN PRINT USING ".#######"; NA!; ELSE PRINT NA!;
2660   PRINT TAB(61); ", "; NB!;
2670 LOCATE 11,47 : PRINT PFUH$
2680 '
2690 ' Get ready for next action.
2700 '
2710 COLOR 7,1
2720 IF FIRSTA% THEN LOCATE 16,3 : PRINT "For +, -, *, /, c, and r you will be prompted to enter a second impedance."
2730 IF AK$ = "f" THEN GOTO 2810
2740   R1.PREV2 = R1.PREV
2750   X1.PREV2 = X1.PREV
2760   R1.PREV = R1
2770   X1.PREV = X1
2780 '
2790 ' Unfrenetic blinking prompt for a hot (action) key.
2800 '
2810 LOCATE 15,3 : PRINT "Press an action key "
2820 IF DOTS$ = "..." THEN DOTS$ = "   " : AA$ = "  " ELSE DOTS$ = "..." : AA$ = "**"
2830 COLOR 14 : LOCATE 15,23 : PRINT DOTS$
2840 LOCATE 22,1 : PRINT AA$ : COLOR 7
2850 BLINK.TIME! = TIMER
2860 AK$ = INKEY$
2870 IF AK$ <> "" THEN GOTO 2920
2880 IF TIMER - BLINK.TIME! < .5 THEN GOTO 2860 ELSE GOTO 2820
2890 '
2900 ' Action key processing.
2910 '
2920 LOCATE 22,1 : PRINT "  "
2930 LOCATE 18,3 : PRINT STRING$(77,32);
2940 IF FIRSTA% THEN LOCATE 16,3 : PRINT STRING$(77,32); : FIRSTA% = 0
2950 '
2960 IF AK$ = "q" THEN GOTO 5210
2970 '
2980 IF AK$ = "+" OR AK$ = "-" OR AK$ = "*" OR AK$ = "/" THEN GOTO 3950
2990 IF AK$ = "c" OR AK$ = "r" THEN GOTO 3950
3000 '
3010 IF LEN(AK$) <> 2 OR ASC(RIGHT$(AK$,1)) <> 73 THEN GOTO 3090    'PgUp
3020   DZO.ERR% = 0 : IF CANT.TRAP% THEN LOCATE 1,1 : SCREEN ,,1,0  'Square
3030   A = R1*R1 - X1*X1
3040   B = R1*X1 + X1*R1
3050   R1 = A
3060   X1 = B
3070   GOTO 5100
3080 '
3090 IF LEN(AK$) <> 2 OR ASC(RIGHT$(AK$,1)) <> 81 THEN GOTO 3260    'PgDn
3100   DZO.ERR% = 0 : IF CANT.TRAP% THEN LOCATE 1,1 : SCREEN ,,1,0  'Root
3110   ZM = SQR(SQR(R1*R1 + X1*X1))
3120   IF R1 <> 0 THEN ZA = ATN(X1 / R1) / 2 : GOTO 3180
3130     ON SGN(X1)+2 GOTO 3140, 3150, 3160
3140       ZA = -PI/4  : GOTO 3180
3150       ZA =  0     : GOTO 3180
3160       ZA =  PI/4
3170   '
3180   A = ZM * COS(ZA)
3190   B = ZM * SIN(ZA)
3200   IF R1 < 0 THEN SWAP A,B:  B = -B
3210   ' Always show positive R as first root.
3220   IF A < 0 THEN R1 = -A : X1 = -B ELSE R1 = A : X1 = B
3230   AK$ = "root"
3240   GOTO 5100
3250 '
3260 IF AK$ <> "\" THEN GOTO 3310  'Rotate (change signs)
3270   R1 = -R1
3280   X1 = -X1
3290   GOTO 1560
3300 '
3310 IF AK$ <> "[" THEN GOTO 3490  'Clear (F1)
3320   COLOR 0,7
3330   LOCATE  4, 6 : PRINT STRING$(29,32);
3340   LOCATE  5, 6 : PRINT STRING$(29,32);
3350   LOCATE  6, 6 : PRINT STRING$(29,32);
3360   LOCATE  8, 6 : PRINT STRING$(29,32);
3370   LOCATE 12, 5 : PRINT STRING$(13,32);
3380   LOCATE 12,23 : PRINT STRING$(13,32);
3390   LOCATE  4,47 : PRINT STRING$(31,32);
3400   LOCATE  8,47 : PRINT STRING$(29,32);
3410   LOCATE 11,47 : PRINT " pF or uH  ";
3420   LOCATE 12,47 : IF FQ = 0 THEN PRINT STRING$(29,32); ELSE PRINT STRING$(16,32);
3430   COLOR 7,1
3440   '
3450   DUM$ = INKEY$  'Remove trailing CR from keyboard buffer
3460   LOCATE 15,3 : PRINT STRING$(77,32);
3470   GOTO 1080
3480 '
3490 IF AK$ <> "{" THEN GOTO 3560  'Store (F5)
3500   R1.MEM = R1
3510   X1.MEM = X1
3520   LOCATE 18,3
3530   PRINT "Current impedance stored in memory."
3540   GOTO 2810
3550 '
3560 IF AK$ <> "}" THEN GOTO 3620  'Recall (F8)
3570   R1 = R1.MEM
3580   X1 = X1.MEM
3590   DUM$ = INKEY$  'Remove trailing CR from keyboard buffer
3600   GOTO 1560
3610 '
3620 IF AK$ <> "f" THEN GOTO 3830  'Change frequency
3630   LOCATE 15,3
3640   PRINT "Action pending:  "; AK$; STRING$(21,32);
3650   KEY 5,""   '
3660   KEY 8,""   'only F1 active
3670   KEY 10,""  '
3680   LOCATE 16,3
3690   PRINT "Enter frequency (MHz): ";
3700   LINE INPUT ""; FREQ$
3710   IF RIGHT$(FREQ$,1) = "q" THEN GOTO 5210
3720   IF RIGHT$(FREQ$,1) <> "[" THEN FQ = VAL(FREQ$)
3730   KEY  5,"{"           '
3740   KEY  8,"}"+CHR$(13)  'F5, 8, 10 back on
3750   KEY 10,"]"+CHR$(13)  '
3760   LOCATE 15,3 : PRINT STRING$(77,32);
3770   LOCATE 16,3 : PRINT STRING$(77,32);
3780   IF RIGHT$(FREQ$,1) = "[" THEN GOTO 2810   'Cancel action
3790   IF FQ = 0 THEN FORM$(4) = "C(pF),F(MHz)" : FORM$(5) = "L(uH),F(MHz)" : GOTO 1560
3800     FORM$(4) = "C(pF)[,F(MHz)]" : FORM$(5) = "L(uH)[,F(MHz)]"
3810   GOTO 1560
3820 '
3830 IF AK$ <> "u" THEN GOTO 3900  'Undo
3840   R1 = R1.PREV2
3850   X1 = X1.PREV2
3860   GOTO 1560
3870 '
3880 ' Invalid key press, ignore.
3890 '
3900 GOTO 2810
3910 '
3920 ' Add, subtract, multiply, divide.
3930 ' Get second input, then perform action.
3940 '
3950 LOCATE 15,3
3960 PRINT "Action pending:  "; AK$; STRING$(21,32);
3970 KEY 5,""  'F5 temp off
3980 COLOR 14 : LOCATE AROW%(FO%),ACOL%(FO%) : PRINT FLAG$(FO%) : COLOR 7
3990 LOCATE 20,3
4000 PRINT "F10 toggles:  ";
4010 FOR I% = 1 TO 5
4020   IF FO% = I% THEN COLOR 14 ELSE COLOR 7
4030   PRINT FORM$(I%);
4040   IF I% < 5 THEN COLOR 7 : PRINT "  ";CHR$(26);"  ";
4050 NEXT I%
4060 LOCATE 16,3 : COLOR 7
4070 PRINT "Enter second impedance in the form ";
4080 COLOR 14 : PRINT FORM$(FO%); : COLOR 7 : PRINT ": ";
4090 LINE INPUT ""; IMPED$
4100 IF IMPED$ = "" THEN GOTO 4060  'Ignore null input
4110 IF RIGHT$(IMPED$,1) = "q" THEN GOTO 5210
4120 IF RIGHT$(IMPED$,1) = "}" THEN R2 = R1.MEM : X2 = X1.MEM : GOTO 4330
4130 IF RIGHT$(IMPED$,1) = "[" THEN GOTO 4330  'Clear entry, cancel action
4140 IF RIGHT$(IMPED$,1) <> "]" THEN GOTO 4190
4150   LOCATE 16,3 : PRINT STRING$(77,32);
4160   LOCATE AROW%(FO%),ACOL%(FO%) : PRINT "  "
4170   FO% = FO% + 1 : IF FO% = 6 THEN FO% = 1
4180   GOTO 3980
4190 COMMA% = INSTR(1,IMPED$,",")
4200 IF COMMA% > 0 THEN GOTO 4260
4210 IF FO% >= 4 AND FQ <> 0 THEN COMMA% = LEN(IMPED$)+1 : GOTO 4260
4220   BEEP : COLOR 14 : LOCATE 18,3
4230   PRINT "Enter two numbers separated by a comma.                    ";
4240   COLOR 7 : LOCATE 16,3 : PRINT STRING$(77,32);
4250   GOTO 4060
4260 GOSUB 5270  'Does input conversion and sets DZO.ERR%
4270 IF DZO.ERR% = 0 THEN GOTO 4330
4280   BEEP : COLOR 14 : LOCATE 18,3
4290   PRINT "Error on format conversion.";
4300   COLOR 7 : LOCATE 16,3 : PRINT STRING$(77,32);
4310   GOTO 4060
4320 '
4330 KEY 5,"{"  'F5 back on
4340 LOCATE AROW%(FO%),ACOL%(FO%) : PRINT "  "
4350 LOCATE 15,3 : PRINT STRING$(77,32);
4360 LOCATE 16,3 : PRINT STRING$(77,32);
4370 LOCATE 18,3 : PRINT STRING$(77,32);
4380 LOCATE 20,3 : PRINT STRING$(77,32);
4390 IF RIGHT$(IMPED$,1) = "[" THEN GOTO 2810  'Cancel action
4400 '
4410 DZO.ERR% = 0 : IF CANT.TRAP% THEN LOCATE 1,1 : SCREEN ,,1,0
4420 '
4430 IF AK$ <> "+" THEN GOTO 4480  'Add
4440   R1 = R1 + R2
4450   X1 = X1 + X2
4460   GOTO 5100
4470 '
4480 IF AK$ <> "-" THEN GOTO 4530  'Subtract
4490   R1 = R1 - R2
4500   X1 = X1 - X2
4510   GOTO 5100
4520 '
4530 IF AK$ <> "*" THEN GOTO 4600  'Multiply
4540   A = R1*R2 - X1*X2
4550   B = R1*X2 + X1*R2
4560   R1 = A
4570   X1 = B
4580   GOTO 5100
4590 '
4600 IF AK$ <> "/" THEN GOTO 4690  'Divide
4610   A = (R1*R2 + X1*X2) / (R2*R2 + X2*X2)
4620   B = (X1*R2 - R1*X2) / (R2*R2 + X2*X2)
4630   R1 = A
4640   X1 = B
4650   GOTO 5100
4660 '
4670 '  AK$ = "c" or "r"           'Parallel combine/remove
4680   '
4690   IF AK$ = "r" THEN R2 = -R2 : X2 = -X2
4700   '
4710   IF R1 = 1.7D+38 OR X1 = 1.7D+38 THEN R1P = 1.7D+38 : X1P = 1.7D+38 : GOTO 4760
4720   IF ABS(R1) < VZ AND ABS(X1) < VZ THEN R1P = 0 : X1P = 0 : GOTO 4760
4730   IF ABS(R1) < VZ THEN R1P = 1.7D+38 ELSE R1P = (R1*R1 + X1*X1) / R1
4740   IF ABS(X1) < VZ THEN X1P = 1.7D+38 ELSE X1P = (R1*R1 + X1*X1) / X1
4750   '
4760   IF R2 = 1.7D+38 OR X2 = 1.7D+38 THEN R2P = 1.7D+38 : X2P = 1.7D+38 : GOTO 4810
4770   IF ABS(R2) < VZ AND ABS(X2) < VZ THEN R2P = 0 : X2P = 0 : GOTO 4810
4780   IF ABS(R2) < VZ THEN R2P = 1.7D+38 ELSE R2P = (R2*R2 + X2*X2) / R2
4790   IF ABS(X2) < VZ THEN X2P = 1.7D+38 ELSE X2P = (R2*R2 + X2*X2) / X2
4800   '
4810   IF R1P = 1.7D+38 AND R2P = 1.7D+38 THEN RTP = 1.7D+38 : GOTO 4880
4820   IF R1P = 1.7D+38 THEN RTP = R2P : GOTO 4880
4830   IF R2P = 1.7D+38 THEN RTP = R1P : GOTO 4880
4840   IF ABS(R1P) < VZ AND ABS(R2P) < VZ THEN RTP = 0 : GOTO 4880
4850   IF ABS(R1P + R2P) < VZ THEN RTP = 1.7D+38 : GOTO 4880
4860   RTP = (R1P * R2P) / (R1P + R2P)
4870   '
4880   IF X1P = 1.7D+38 AND X2P = 1.7D+38 THEN XTP = 1.7D+38 : GOTO 4950
4890   IF X1P = 1.7D+38 THEN XTP = X2P : GOTO 4950
4900   IF X2P = 1.7D+38 THEN XTP = X1P : GOTO 4950
4910   IF ABS(X1P) < VZ AND ABS(X2P) < VZ THEN XTP = 0 : GOTO 4950
4920   IF ABS(X1P + X2P) < VZ THEN XTP = 1.7D+38 : GOTO 4950
4930   XTP = (X1P * X2P) / (X1P + X2P)
4940   '
4950   IF RTP <> 1.7D+38 OR XTP <> 1.7D+38 THEN GOTO 4990
4960     IF R1P <> 1.7D+38 OR R2P <> 1.7D+38 THEN RTS = 0 : XTS = 1.7D+38 : GOTO 5050
4970     IF X1P <> 1.7D+38 OR X2P <> 1.7D+38 THEN RTS = 1.7D+38 : XTS = 0 : GOTO 5050
4980     RTS = 1.7D+38 : XTS = 1.7D+38 : GOTO 5050
4990   IF RTP = 1.7D+38 THEN RTS = 0 : XTS = XTP : GOTO 5050
5000   IF XTP = 1.7D+38 THEN RTS = RTP : XTS = 0 : GOTO 5050
5010   IF ABS(RTP) < VZ AND ABS(XTP) < VZ THEN RTS = 0 : XTS = 0 : GOTO 5050
5020   RTS = (RTP * XTP*XTP) / (RTP*RTP + XTP*XTP)
5030   XTS = (RTP*RTP * XTP) / (RTP*RTP + XTP*XTP)
5040   '
5050   R1 = RTS
5060   X1 = XTS
5070 '
5080 ' Check if any Divide by zero or Overflow on processing.
5090 '
5100 IF CANT.TRAP% THEN SCREEN ,,0,0 : IF CSRLIN > 1 THEN DZO.ERR% = 1
5110 IF DZO.ERR% = 0 THEN GOTO 1560
5120   R1 = R1.PREV
5130   X1 = X1.PREV
5140   BEEP : COLOR 14 : LOCATE 18,3
5150   PRINT "Division by zero and/or Overflow, action ignored.";
5160   COLOR 7
5170   GOTO 2810
5180 '
5190 ' To here on quit request.
5200 '
5210 COLOR 7,0
5220 CLS
5230 SYSTEM
5240 '
5250 ' Subroutine to convert various forms of input.
5260 '
5270 DZO.ERR% = 0 : IF CANT.TRAP% THEN LOCATE 1,1 : SCREEN ,,1,0
5280 '
5290 ON FO% GOTO 5300, 5330, 5420, 5510, 5590
5300   R2 = VAL(LEFT$(IMPED$,COMMA%-1))
5310   X2 = VAL(MID$(IMPED$,COMMA%+1))
5320     GOTO 5680
5330   ZM = VAL(LEFT$(IMPED$,COMMA%-1))
5340   ZA = VAL(MID$(IMPED$,COMMA%+1))
5350   ' Avoid round off errors
5360   IF ZA = 0        THEN R2 = ZM  : X2 = 0            : GOTO 5680
5370   IF ABS(ZA) = 90  THEN R2 = 0   : X2 = ZM * SGN(ZA) : GOTO 5680
5380   IF ABS(ZA) = 180 THEN R2 = -ZM : X2 = 0            : GOTO 5680
5390   R2 = ZM * COS(ZA/RAD)
5400   X2 = ZM * SIN(ZA/RAD)
5410     GOTO 5680
5420   RP = VAL(LEFT$(IMPED$,COMMA%-1))
5430   XP = VAL(MID$(IMPED$,COMMA%+1))
5440   IF RP = 1.7D+38 AND XP = 1.7D+38 THEN R2 = 1.7D+38 : X2 = 1.7D+38 : GOTO 5680
5450   IF RP = 1.7D+38 THEN R2 = 0 : X2 = XP : GOTO 5680
5460   IF XP = 1.7D+38 THEN R2 = RP : X2 = 0 : GOTO 5680
5470   IF RP = 0 AND XP = 0 THEN R2 = 0 : X2 = 0 : GOTO 5680
5480   R2 = (RP * XP*XP) / (RP*RP + XP*XP)
5490   X2 = (RP*RP * XP) / (RP*RP + XP*XP)
5500     GOTO 5680
5510   PF = VAL(LEFT$(IMPED$,COMMA%-1))
5520   SAVE.FQ = FQ
5530   FQ = VAL(MID$(IMPED$,COMMA%+1))
5540   IF FQ = 0 THEN FQ = SAVE.FQ
5550   IF FQ <> 0 THEN FORM$(4) = "C(pF)[,F(MHz)]" : FORM$(5) = "L(uH)[,F(MHz)]"
5560   R2 = 0
5570   X2 = -MEG / (TWOPI * FQ * PF)
5580     GOTO 5680
5590   UH = VAL(LEFT$(IMPED$,COMMA%-1))
5600   SAVE.FQ = FQ
5610   FQ = VAL(MID$(IMPED$,COMMA%+1))
5620   IF FQ = 0 THEN FQ = SAVE.FQ
5630   IF FQ <> 0 THEN FORM$(4) = "C(pF)[,F(MHz)]" : FORM$(5) = "L(uH)[,F(MHz)]"
5640   R2 = 0
5650   X2 = TWOPI * FQ * UH
5660   IF FQ = 0 THEN DZO.ERR% = 1  'Simulate error
5670 '
5680 IF CANT.TRAP% THEN SCREEN ,,0,0 : IF CSRLIN > 1 THEN DZO.ERR% = 1
5690 RETURN
5700 '
5710 ' Error trap (except under BASICA).
5720 '
5730 IF ERR <> 6 AND ERR <> 11 THEN ON ERROR GOTO 0
5740 DZO.ERR% = 1
5750 RESUME NEXT