home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols200 / vol235 / massa.bas < prev    next >
Encoding:
BASIC Source File  |  1994-07-13  |  4.5 KB  |  166 lines
  1. 1 REM BASICODE 2 ROUTINES DOOR HENK WEVERS
  2. 2 REM NADERE INLICHTINGEN BASICODE
  3. 3 REM NOS, HOBBYSCOOP HILVERSUM  
  4. 5 PRINT CHR$(26);:WIDTH(255)
  5. 10 GOTO 1000
  6. 20 GOTO 1010
  7. 100 PRINT CHR$(26);:RETURN
  8. 110 REM
  9. 111 IF HO>51 THEN HO=51
  10. 112 IF VE>23 THEN VE=23
  11. 113 PRINT CHR$(27);"=";CHR$(VE+32);CHR$(HO+32);
  12. 115 RETURN
  13. 120 HO=PEEK(&HEF5A):VE=PEEK(&HEF5B)-&HF0
  14. 121 VE=VE*2
  15. 122 IF HO>127 THEN HO=HO-128:VE=VE+1
  16. 123 VE=VE-PEEK(&HEF62):IF VE<0 THEN VE=32+VE
  17. 124 RETURN
  18. 200 IN$=INKEY$:RETURN
  19. 210 GOSUB 200:IF IN$="" THEN 210
  20. 211 RETURN
  21. 250 PRINT CHR$(7);:RETURN
  22. 260 RV=RND(1):RETURN
  23. 270 FR=FRE(2):RETURN
  24. 300 SR$=STR$(SR)
  25. 301 Q7=LEN(SR$):IF Q7=0 THEN RETURN
  26. 302 IF RIGHT$(SR$,1)<>" " THEN 304
  27. 303 SR$=LEFT$(SR$,Q7-1):GOTO 301
  28. 304 IF LEFT$(SR$,1)<>" " THEN RETURN
  29. 305 SR$=RIGHT$(SR$,Q7-1):GOTO 301
  30. 310 Q4=SR:IF CN<>0 THEN 316
  31. 312 SR=INT(SR+.5):GOSUB 300:GOTO 330
  32. 316 Q5=SGN(SR):SR=ABS(SR):Q8=INT(SR):Q9=SR-Q8
  33. 318 FOR Q6=1 TO CN:Q9=Q9*10:NEXT Q6
  34. 320 Q9=INT(Q9+.5):SR=Q9:GOSUB 300
  35. 322 Q9$=RIGHT$("00000000000000000000"+SR$,CN)
  36. 324 IF Q8=0 AND Q9=0 THEN Q5=1
  37. 326 SR=Q8:GOSUB 300:IF Q5=-1 THEN SR$="-"+SR$
  38. 328 SR$=SR$+"."+Q9$
  39. 330 IF LEN(SR$)<=CT THEN 334
  40. 332 SR$=LEFT$("********************",CT):GOTO 340
  41. 334 SR$=RIGHT$("                    "+SR$,CT)
  42. 340 SR=Q4:RETURN
  43. 350 LPRINT SR$;:RETURN
  44. 360 LPRINT:RETURN
  45. 1000 A=100:GOTO 20:REM RESERVEER STRINGRUIMTE
  46. 1010 GOSUB 5000
  47. 1020 GOSUB 100
  48. 1030 PRINT"Gemeten exacte massa ";:INPUT X
  49. 1040 PRINT
  50. 1050 FOR I=1 TO 4
  51. 1060 PRINT:PRINT
  52. 1070 PRINT"Element: ";A$(I);"  Massa: ";B(I)
  53. 1080 D(I)=INT((X+.03)/B(I))
  54. 1090 NEXT I
  55. 1100 PRINT:PRINT:PRINT
  56. 1110 PRINT"Maximale afwijking (massa's)";:INPUT W
  57. 1120 IF W<=.03 THEN 1170
  58. 1130 PRINT"afwijking te hoog: deze kan maximaal"
  59. 1140 PRINT"0.03 massa's zijn  !"
  60. 1150 GOTO 1110
  61. 1160 :
  62. 1170 GOSUB 100
  63. 1180 PRINT
  64. 1190 PRINT"Massa:";X;", Max. afwijking:";W
  65. 1200 PRINT:PRINT"  Massa    ";
  66. 1210 FOR I=1 TO 4
  67. 1220 PRINT A$(I);"   ";
  68. 1230 NEXT I
  69. 1240 PRINT"Afwijking"
  70. 1250 PRINT
  71. 1260 :
  72. 1270 R1=0:I1=0
  73. 1280 R3=R1:I3=0
  74. 1290 R4=R3:I4=0
  75. 1300 I2=INT((X-W-R4)/B(2)):IF I2<0 THEN 1370
  76. 1310 R2=R4+I2*B(2)
  77. 1320 R=R2
  78. 1330 :IF R<X-W THEN 1360
  79. 1340 :IF R>X+W THEN 1370
  80. 1350 ::GOSUB 2000
  81. 1360 I2=I2+1:R2=R2+B(2):GOTO 1320
  82. 1370 IF I4<D(4)THEN I4=I4+1:R4=R4+B(4):GOTO 1300
  83. 1380 IF I3<D(3)THEN I3=I3+1:R3=R3+B(3):GOTO 1290
  84. 1390 IF I1<D(1)THEN I1=I1+1:R1=R1+B(1):GOTO 1280
  85. 1400 :
  86. 1410 PRINT:PRINT
  87. 1420 IF T>0 THEN 1450
  88. 1430 PRINT"Sorry, ik kan bij deze massa geen pas-"
  89. 1440 PRINT"sende brutoformule vinden!"
  90. 1450 PRINT"Wilt U nog meer massa's weten (j/n)";:INPUT X$
  91. 1460 IF X$="n"OR X$="N"THEN END
  92. 1470 T=0
  93. 1480 GOTO 1020
  94. 1490 :
  95. 2000 REM AFDRUK ROUTINE
  96. 2010 T=T+1
  97. 2020 J(1)=I1
  98. 2030 J(2)=I2
  99. 2040 J(3)=I3
  100. 2050 J(4)=I4
  101. 2060 SR=R:CT=8:CN=4:GOSUB 310:PRINT SR$;
  102. 2070 FOR K=1 TO 4
  103. 2080 CT=4:CN=0
  104. 2090 SR=J(K):GOSUB 310:PRINT SR$;
  105. 2100 NEXT K
  106. 2110 SR=R-X
  107. 2120 CT=10:CN=4:GOSUB 310
  108. 2130 PRINT SR$
  109. 2140 RETURN
  110. 2150 :
  111. 5000 DIM A$(4),K$(4),B(4),D(4),J(4)
  112. 5010 GOSUB 100:PRINT:PRINT
  113. 5020 PRINT
  114. 5030 PRINT" Bepaling van een BRUTO FORMULE"
  115. 5040 PRINT
  116. 5050 PRINT"   uit een EXACTE MASSA"
  117. 5060 PRINT:PRINT
  118. 5070 PRINT"      met de elementen KOOLSTOF,"
  119. 5080 PRINT
  120. 5090 PRINT"   WATERSTOF, STIKSTOF en ZUURSTOF."
  121. 5100 HO=0:VE=23:GOSUB 110
  122. 5110 PRINT"druk op de spatiebalk voor vervolg";
  123. 5120 GOSUB 210:IF IN$<>" "THEN 5120
  124. 5130 GOSUB 100
  125. 5140 PRINT"U vertelt mij de EXACTE massa van de"
  126. 5150 PRINT:PRINT"verbinding alsmede de maximaal toege-"
  127. 5160 PRINT:PRINT"stane afwijking (hoogstens 0.03 massa's)"
  128. 5170 PRINT:PRINT"Ik bereken dan voor U alle mogelijke"
  129. 5180 PRINT:PRINT"aantallen atomen C, H, N en O waaruit"
  130. 5190 PRINT:PRINT"Uw verbinding zou kunnen bestaan."
  131. 5200 HO=0:VE=23:GOSUB 110
  132. 5210 PRINT"druk op de spatiebalk voor vervolg";
  133. 5220 GOSUB 210:IF IN$<>" "THEN 5220
  134. 5230 A$(1)="C":A$(2)="H":A$(3)="N":A$(4)="O"
  135. 5240 K$(1)="c":K$(2)="h":K$(3)="n":K$(4)="o"
  136. 5250 B(1)=12:B(2)=1.0078:B(3)=14.0031:B(4)=15.9949
  137. 5260 RETURN
  138. 5270 :
  139. 5280 :
  140. 5290 :
  141. 10000 REM" B R U T O F O R M U L E"
  142. 10010 REM  =======================
  143. 10020 REM
  144. 10030 REM" Deze versie november 1982.
  145. 10040 REM" Enigszins veranderd en
  146. 10050 REM" aangepast voor BASICODE-2
  147. 10060 REM" door leden van de
  148. 10070 REM"          BASICODE - groep.
  149. 10080 REM
  150. 10090 REM
  151. 10100 REM
  152. 10110 REM
  153. 10120 REM" Oorspronkelijke versie uit
  154. 10130 REM" 1980, ingezonden voor de
  155. 10140 REM" HOBBYSCOOP - wedstrijd
  156. 10150 REM
  157. 10160 REM          DOOR:
  158. 10170 REM
  159. 10180 REM
  160. 10190 REM"    T. J.   S T A M
  161. 10200 REM    =================
  162. 10210 REM
  163. REM
  164. 10160 REM          DOOR:
  165. 10170 REM
  166. 10180 REM