10 REM RESISTOR CODES 20 *KEY10"OLD|M" 30 ONERRORPROCerror 40 REPEAT 50 REM MODE7 52 CLS 60 PROCinit 70 FOR I%=0 TO 24 80 PRINTcol1$ 90 NEXT 92 PRINTTAB(0,7) 100 PRINTcol2$" RESISTOR CODES" 110 PRINTcol2$" **************" 120 PRINTcol2$ 130 PRINTcol2$" 1...NUMERICAL-->COL OURS" 140 PRINTcol2$ 150 PRINTcol2$" 2...COLOURS-->NUMER ICAL" 160 PRINTcol2$ 170 PRINTcol2$" X...EXIT" 180 run%=GET 200 210 IF run%=ASC("1") PROCnum`col 220 IF run%=ASC("2") PROCcol`num 230 UNTIL run%=ASC("X") OR run%=ASC("x ") 240 VDU23,1,1;0;0;0; 250 CLS 260 END 270 280 DEFPROCerror:ENDPROC 290 300 DEFPROCcol`num 310 REPEAT 320 PROCdraw 330 PROCprefvals 340 PROCpcode 350 PROCbands 360 PRINT'col1$"Another one?" 370 go=GET 380 UNTIL go=ASC("N") OR go=ASC("n") 390 ENDPROC 400 410 DEFPROCinit 420 VDU23,1,0;0;0;0; 430 col1$=CHR$(132)+CHR$(157)+CHR$(129 ) 440 col2$=CHR$(132)+CHR$(157)+CHR$(131 ) 450 ENDPROC 460 470 DEFPROCdraw 480 PROCcls 490 PRINTTAB(33,6)CHR$(151)CHR$(255) 500 PRINTTAB(33,7)CHR$(151)CHR$(255) 510 520 FOR n=8 TO 20 530 PRINTTAB(30,n); 540 PROCcolcod(12) 550 NEXT 560 570 PRINTTAB(33,21)CHR$(151)CHR$(255) 580 PRINTTAB(33,22)CHR$(151)CHR$(255) 590 ENDPROC 600 610 DEFPROCprefvals 620 VDU26 630 PRINTcol1$" Standard Values 5% (10 %) [20%]" 640 PRINTcol2$ 650 PRINTcol2$" [10] 11 (12) 13 [15] 1 6 (18) 20" 660 PRINTcol2$" [22] 24 (27) 30 [33] 3 6 (39) 43" 670 PRINTcol2$" [47] 51 (56) 62 [68] 7 5 (82) 91" 680 PRINTcol2$ 690 ENDPROC 700 710 DEFPROCcolcod(a) 720 IF a = 0 THEN PRINT" BLACK " 730 IF a = 1 THEN PRINT" BROWN " 740 IF a = 2 THEN PRINT" RED " 750 IF a = 3 THEN PRINT" ORANGE " 760 IF a = 4 THEN PRINT" YELLOW " 770 IF a = 5 THEN PRINT" GREEN " 780 IF a = 6 THEN PRINT" BLUE " 790 IF a = 7 THEN PRINT" VIOLET " 800 IF a = 8 THEN PRINT" GREY " 810 IF a = 9 THEN PRINT" WHITE " 820 IF a = 10 THEN PRINT" GOLD " 830 IF a = 11 THEN PRINT" SILVER " 840 IF a = 12 THEN VDU149,255,255,255, 255,255,255,255 850 ENDPROC 860 870 DEFPROCpcode 880 PRINTcol2$ 890 PRINTcol1$"Band colours" 900 PRINTcol2$ 910 FOR n=0 TO 12 920 c=n+48-(n>9)*7 930 PRINTcol2$CHR$(c)":"; 940 PROCcolcod(n) 950 NEXT 960 PRINT 970 PRINTcol2$ 980 PRINTcol2$ 990 ENDPROC 1000 1010 DEFFNindata 1020 c=GET 1030 IF c>58 THEN c=c AND &5F 1040 IF c=32 OR c=13 THEN c=67 1050 =c-48+(c>58)*7 1060 1070 DEFFNgetband(tb,tx,ty,nmin,nmax) 1080 tn=13 1090 REPEAT 1100 PRINTTAB(tx,ty); 1110 PRINT"Band";STR$(tb);" ? ";CHR$(8) 1120 tn=FNindata 1130 UNTIL tn >= nmin AND tn <= nmax 1140 =tn 1150 1160 DEFPROCbands 1170 b1=FNgetband(1,25,9,1,9) 1180 PRINT TAB(30,9); 1190 PROCcolcod(b1) 1200 b2=FNgetband(2,25,11,0,9) 1210 PRINT TAB(30,11); 1220 PROCcolcod(b2) 1230 b3=FNgetband(3,25,13,0,11) 1240 PRINT TAB(30,13); 1250 PROCcolcod(b3) 1260 b4=FNgetband(4,25,15,1,12) 1270 IF b4>2 AND b4<10 THEN b4=12 1280 PRINT TAB(30,15); 1290 PROCcolcod(b4) 1300 PROCptol 1310 PROCans 1320 ENDPROC 1330 1340 DEFPROCptol 1350 PROCcls 1360 PRINTTAB(0,6) 1370 PRINTcol1$"Tolerence codes " 1380 PRINTcol2$ 1390 PRINTcol2$" F == 1%" 1400 PRINTcol2$" G == 2%" 1410 PRINTcol2$" J == 5%" 1420 PRINTcol2$" K == 10%" 1430 PRINTcol2$" M == 20%" 1440 ENDPROC 1450 1460 DEFPROCcls 1470 FOR n=6 TO 23 1480 PRINTTAB(0,n)col2$;STRING$(27," ") 1490 NEXT 1500 ENDPROC 1510 1520 DEFPROCans 1530 PRINT''col1$"RESISTOR IS =="col2$; 1540 e=(b3+5) DIV 3:emod=(b3+5) MOD 3 1550 IF e=5 THEN e=1:emod=emod EOR 1 1560 IF emod=0 THEN PROCpmult(e) 1570 PRINT STR$(b1); 1580 IF emod=1 THEN PROCpmult(e) 1590 PRINT STR$(b2); 1600 IF emod=2 THEN PROCpmult(e) 1610 PRINT" "; 1620 PROCptolcod(b4) 1630 ENDPROC 1640 1650 DEFPROCpmult(e) 1660 IF e = 1 THEN PRINT"#"; 1670 IF e = 2 THEN PRINT"K"; 1680 IF e = 3 THEN PRINT"M"; 1690 IF e = 4 THEN PRINT"G"; 1700 ENDPROC 1710 1720 DEFPROCptolcod(b4) 1730 IF b4 = 1 THEN PRINT"F"; 1740 IF b4 = 2 THEN PRINT"G"; 1750 IF b4 = 10 THEN PRINT"J"; 1760 IF b4 = 11 THEN PRINT"K"; 1770 IF b4 = 12 THEN PRINT"M"; 1780 ENDPROC 1790 1800REM ****************************** 1810 1820 DEFPROCnum`col 1830 REPEAT 1840 exp=0 1850 REPEAT 1860 PROCdraw 1870 PROCprefvals 1880 PROCptol 1890 PROCinput 1900 UNTIL exp :REM NNN not allowed 1910 PROCcolans 1920 go=GET 1930 UNTIL go=ASC("N") OR go=ASC("n") 1940 ENDPROC 1950 1960 DEFPROCinput 1970 PRINTcol2$ 1971 PRINTcol2$ 1974 PRINTcol1$"Enter 3 chr$ code" 1976 PRINTcol1$"use # for ohmega." 1978 PRINTcol2$; 1980 C$="":codeptr=1 1990 valid$="123456789#KMG" 2000 REPEAT:PROCchkin(valid$):UNTIL ok 2010 C$=C$+Q$ 2020 valid$="0123456789#KMG" 2030 IF exp valid$="0123456789" 2040 REPEAT:PROCchkin(valid$):UNTIL ok 2050 C$=C$+Q$ 2051 valid$="#KMG" 2052 IF exp valid$="0123456789" 2054 REPEAT:PROCchkin(valid$):UNTIL ok 2056 C$=C$+Q$ 2060 PRINTcol2$ 2061 PRINTcol2$ 2062 PRINTcol1$"Enter tolerence code" 2064 PRINTcol1$"if known else space bar " 2066 PRINTcol2$; 2068 valid$=" FGJKM" 2070 REPEAT:PROCchkin(valid$):UNTIL ok 2080 IFQ$=" " THEN Q$="M":VDUASC(Q$) 2092 T$=Q$ 2094 PRINT 2100 PRINTcol1$"Another one?" 2110 ENDPROC 2120 2130 DEFPROCchkin(test$) 2140 ok=0 2150 Q%=GET:VDUQ% 2160 IF Q%>58 THEN Q%=Q% AND &5F 2170 Q$=CHR$(Q%) 2180 IF INSTR(test$,Q$) ok=1 2190 IF INSTR("#KMG",Q$) exp=1 2200 IF ok VDU8,Q% ELSE VDU8,32,8 2210 ENDPROC 2220 2230 DEFPROCcolans 2240 mult=0 2250 pos=1:PRINTTAB(30,9); 2260 IF INSTR("123456789",MID$(C$,pos,1 )) PROCgetcol ELSE PROCgetmult 2270 IF pos=2 PRINTTAB(30,11); ELSE pos =2 2280 IF INSTR("0123456789",MID$(C$,pos, 1)) PROCgetcol ELSE PROCgetmult 2290 PRINTTAB(30,11); 2300 IF mult=0 PROCgetmult 2310 IF pos=3 PROCgetcol 2320 IF pos=2 pos=3:PROCgetcol 2330 IF dp=1 PROCcase(mult,11,1,4,7) 2340 IF dp=2 PROCcase(mult,10,2,5,8) 2350 IF dp=3 PROCcase(mult,0,3,6,9) 2360 IF T$="F" THEN b4=1 2370 IF T$="G" THEN b4=2 2380 IF T$="J" THEN b4=10 2390 IF T$="K" THEN b4=11 2400 IF T$="M" THEN b4=12 2410 PRINTTAB(30,15); 2420 PROCcolcod(b4) 2430 ENDPROC 2440 2450 DEFPROCgetcol 2460 ok=ASC(MID$(C$,pos,1))-48 2470 PROCcolcod(ok) 2480 pos=pos+1 2490 ENDPROC 2500 2510 DEFPROCgetmult 2520 dp=pos 2530 mult=INSTR("#KMG",MID$(C$,pos,1)) 2540 ENDPROC 2550 2560 DEFPROCcase(mult,n1,n2,n3,n4) 2570 PRINTTAB(30,13); 2590 IF mult=1 PROCcolcod(n1) 2600 IF mult=2 PROCcolcod(n2) 2610 IF mult=3 PROCcolcod(n3) 2620 IF mult=4 PROCcolcod(n4) 2630 ENDPROC