1 REM BASICODE 2 ROUTINES DOOR HENK WEVERS
2 REM NADERE INLICHTINGEN BASICODE
3 REM NOS, HOBBYSCOOP HILVERSUM  
5 PRINT CHR$(26);:WIDTH(255)
10 GOTO 1000
20 GOTO 1010
100 PRINT CHR$(26);:RETURN
110 REM
111 IF HO>51 THEN HO=51
112 IF VE>23 THEN VE=23
113 PRINT CHR$(27);"=";CHR$(VE+32);CHR$(HO+32);
115 RETURN
120 HO=PEEK(&HEF5A):VE=PEEK(&HEF5B)-&HF0
121 VE=VE*2
122 IF HO>127 THEN HO=HO-128:VE=VE+1
123 VE=VE-PEEK(&HEF62):IF VE<0 THEN VE=32+VE
124 RETURN
200 IN$=INKEY$:RETURN
210 GOSUB 200:IF IN$="" THEN 210
211 RETURN
250 PRINT CHR$(7);:RETURN
260 RV=RND(1):RETURN
270 FR=FRE(2):RETURN
300 SR$=STR$(SR)
301 Q7=LEN(SR$):IF Q7=0 THEN RETURN
302 IF RIGHT$(SR$,1)<>" " THEN 304
303 SR$=LEFT$(SR$,Q7-1):GOTO 301
304 IF LEFT$(SR$,1)<>" " THEN RETURN
305 SR$=RIGHT$(SR$,Q7-1):GOTO 301
310 Q4=SR:IF CN<>0 THEN 316
312 SR=INT(SR+.5):GOSUB 300:GOTO 330
316 Q5=SGN(SR):SR=ABS(SR):Q8=INT(SR):Q9=SR-Q8
318 FOR Q6=1 TO CN:Q9=Q9*10:NEXT Q6
320 Q9=INT(Q9+.5):SR=Q9:GOSUB 300
322 Q9$=RIGHT$("00000000000000000000"+SR$,CN)
324 IF Q8=0 AND Q9=0 THEN Q5=1
326 SR=Q8:GOSUB 300:IF Q5=-1 THEN SR$="-"+SR$
328 SR$=SR$+"."+Q9$
330 IF LEN(SR$)<=CT THEN 334
332 SR$=LEFT$("********************",CT):GOTO 340
334 SR$=RIGHT$("                    "+SR$,CT)
340 SR=Q4:RETURN
350 LPRINT SR$;:RETURN
360 LPRINT:RETURN
1000 A=100:GOTO 20:REM RESERVEER STRINGRUIMTE
1010 GOSUB 5000
1020 GOSUB 100
1030 PRINT"Gemeten exacte massa ";:INPUT X
1040 PRINT
1050 FOR I=1 TO 4
1060 PRINT:PRINT
1070 PRINT"Element: ";A$(I);"  Massa: ";B(I)
1080 D(I)=INT((X+.03)/B(I))
1090 NEXT I
1100 PRINT:PRINT:PRINT
1110 PRINT"Maximale afwijking (massa's)";:INPUT W
1120 IF W<=.03 THEN 1170
1130 PRINT"afwijking te hoog: deze kan maximaal"
1140 PRINT"0.03 massa's zijn  !"
1150 GOTO 1110
1160 :
1170 GOSUB 100
1180 PRINT
1190 PRINT"Massa:";X;", Max. afwijking:";W
1200 PRINT:PRINT"  Massa    ";
1210 FOR I=1 TO 4
1220 PRINT A$(I);"   ";
1230 NEXT I
1240 PRINT"Afwijking"
1250 PRINT
1260 :
1270 R1=0:I1=0
1280 R3=R1:I3=0
1290 R4=R3:I4=0
1300 I2=INT((X-W-R4)/B(2)):IF I2<0 THEN 1370
1310 R2=R4+I2*B(2)
1320 R=R2
1330 :IF R<X-W THEN 1360
1340 :IF R>X+W THEN 1370
1350 ::GOSUB 2000
1360 I2=I2+1:R2=R2+B(2):GOTO 1320
1370 IF I4<D(4)THEN I4=I4+1:R4=R4+B(4):GOTO 1300
1380 IF I3<D(3)THEN I3=I3+1:R3=R3+B(3):GOTO 1290
1390 IF I1<D(1)THEN I1=I1+1:R1=R1+B(1):GOTO 1280
1400 :
1410 PRINT:PRINT
1420 IF T>0 THEN 1450
1430 PRINT"Sorry, ik kan bij deze massa geen pas-"
1440 PRINT"sende brutoformule vinden!"
1450 PRINT"Wilt U nog meer massa's weten (j/n)";:INPUT X$
1460 IF X$="n"OR X$="N"THEN END
1470 T=0
1480 GOTO 1020
1490 :
2000 REM AFDRUK ROUTINE
2010 T=T+1
2020 J(1)=I1
2030 J(2)=I2
2040 J(3)=I3
2050 J(4)=I4
2060 SR=R:CT=8:CN=4:GOSUB 310:PRINT SR$;
2070 FOR K=1 TO 4
2080 CT=4:CN=0
2090 SR=J(K):GOSUB 310:PRINT SR$;
2100 NEXT K
2110 SR=R-X
2120 CT=10:CN=4:GOSUB 310
2130 PRINT SR$
2140 RETURN
2150 :
5000 DIM A$(4),K$(4),B(4),D(4),J(4)
5010 GOSUB 100:PRINT:PRINT
5020 PRINT
5030 PRINT" Bepaling van een BRUTO FORMULE"
5040 PRINT
5050 PRINT"   uit een EXACTE MASSA"
5060 PRINT:PRINT
5070 PRINT"      met de elementen KOOLSTOF,"
5080 PRINT
5090 PRINT"   WATERSTOF, STIKSTOF en ZUURSTOF."
5100 HO=0:VE=23:GOSUB 110
5110 PRINT"druk op de spatiebalk voor vervolg";
5120 GOSUB 210:IF IN$<>" "THEN 5120
5130 GOSUB 100
5140 PRINT"U vertelt mij de EXACTE massa van de"
5150 PRINT:PRINT"verbinding alsmede de maximaal toege-"
5160 PRINT:PRINT"stane afwijking (hoogstens 0.03 massa's)"
5170 PRINT:PRINT"Ik bereken dan voor U alle mogelijke"
5180 PRINT:PRINT"aantallen atomen C, H, N en O waaruit"
5190 PRINT:PRINT"Uw verbinding zou kunnen bestaan."
5200 HO=0:VE=23:GOSUB 110
5210 PRINT"druk op de spatiebalk voor vervolg";
5220 GOSUB 210:IF IN$<>" "THEN 5220
5230 A$(1)="C":A$(2)="H":A$(3)="N":A$(4)="O"
5240 K$(1)="c":K$(2)="h":K$(3)="n":K$(4)="o"
5250 B(1)=12:B(2)=1.0078:B(3)=14.0031:B(4)=15.9949
5260 RETURN
5270 :
5280 :
5290 :
10000 REM" B R U T O F O R M U L E"
10010 REM  =======================
10020 REM
10030 REM" Deze versie november 1982.
10040 REM" Enigszins veranderd en
10050 REM" aangepast voor BASICODE-2
10060 REM" door leden van de
10070 REM"          BASICODE - groep.
10080 REM
10090 REM
10100 REM
10110 REM
10120 REM" Oorspronkelijke versie uit
10130 REM" 1980, ingezonden voor de
10140 REM" HOBBYSCOOP - wedstrijd
10150 REM
10160 REM          DOOR:
10170 REM
10180 REM
10190 REM"    T. J.   S T A M
10200 REM    =================
10210 REM