10 REM ****** REAKTIONSLIKHETER ****** 11 REM * * 12 REM * MICHAEL WIDENIUS 24-10-1981 * 13 REM * * 14 REM ******************************* 15 REM OMR]DE : KEMI 16 REM 17 COMMON Meny$=16%,Qwerty$=16%,Highcolour%,Rambuffer%,Qwerty1%,Qwerty2%,Qwerty3% 18 M%=13% : M1%=19% : M2%=15% : REM MAX 19 DIM A$=210%,In$=160%,B$=29%,C$=20%,D$=2% 20 DIM A$(M1%)=M2%,B$(M1%)=2%,S$=M2% 21 DIM A(M1%,M%),B(M%,M%),X$(M%)=25% 22 DEF FNA%(X$)=(ASCII(X$) AND 223%)=78% 23 REM 24 ON ERROR GOTO 319 25 ; CHR$(12%) TAB(10%) DBLE RED "REAKTIONSLIKHETER" 26 ; : ; : ; 27 ; "Kemilektionen kan b|rja:" 28 ; 29 INPUT "Vill du ha instruktioner (J) ?"A$ 30 IF FNA%(A$) THEN 59 31 ; CUR(3%,0%) "Nu {r jag beredd p} att balanserar" 32 ; "alla de reaktionslikheter som du kan" 33 ; "st|ta p} under dina kemiska studier." 34 ; "( I varje fall n{stan alla. ) " 35 ; 36 ; "Du skall mata in reaktonslikheten" 37 ; "precis som den st}r och g}r. Ex:" 38 ; 39 ; TAB(10%) YEL "N2O5+H20->HNO3" 40 ; 41 ; "- [mnena f}r dock ej inneh}lla tv} eller"; 42 ; "flera parenteser innanf|r varandra." 43 ; YEL "Ca3(PO4)2" WHT "{r dock helt lovligt." 44 ; 45 ; "- Som intelligent person f|rst}r du nog" 46 ; "att alla reaktionslikheter inte kan" 47 ; "balanseras. Undvik d{rf|r att belasta" 48 ; "min dyrbara tid med s}dana vidrigheter." 49 ; 50 ; "Tryck p}" RED "RETURN" WHT "n{r du l{st f{rdigt !"; 51 INPUT ""A$ 52 ; CHR$(12%) "Kom ih}g att jag s|ker efter l|sningen" 53 ; "till en" MAG "(1)" WHT "reaktionslikhet ! Om rea-" 54 ; "tionslikheten best}r av flera samman-" 55 ; "fogade likheter kan jag inte balansera" 56 ; "den !" 57 ; 58 ; "L}tom oss nu s{tta ig}ng med problemen !" 59 ; 60 ; CYA "Skriv nu ner reaktionslikheten !" : ; 61 REM 62 REM *** INMATNINGEN *** 63 REM 64 INPUT LINE In$ 65 In$=LEFT$(In$,LEN(In$)-2%) : A$=In$ 66 IF LEN(In$)<4% ; CHR$(13%) " " CHR$(13%); : GOTO 64 67 IF In$="SLUT" THEN 95 68 ; : GOSUB 105 : IF F% THEN 155 69 REM 70 REM *** ARBETET B\RJAR *** 71 REM 72 ; CHR$(12%) GRN "JAG TAR EN KORT TANKEPAUS......" 73 GOSUB 129 : IF F% THEN 157 74 GOSUB 185 : IF F% THEN 157 75 GOSUB 262 76 GOSUB 217 : D=INT(ABS(S)+.5) 77 IF D=0% THEN F%=3% ELSE IF D>99999 THEN F%=4% 78 IF F% THEN 157 79 GOSUB 235 80 GOSUB 268 : IF F% THEN 157 81 GOSUB 279 : GOSUB 292 82 IF F% THEN 157 83 REM * F[RDIG * 84 ; CHR$(12%) GRN "Den balanserade reaktionslikheten {r:" 85 FOR S%=1% TO 700% : Skr%=INP(5%) : NEXT S% 86 ; : ; 87 GOSUB 308 88 ; : ; 89 ; CYA "Skriv nu ner n{sta reaktionslikhet:" 90 ; 91 GOTO 64 92 REM 93 REM *** SLUT *** 94 REM 95 ; : ; 96 ; "Tack f|r idag och v{lkommen om du n}gon" 97 ; "annan g}ng har problem med n}gon enkel" 98 ; "reaktionslikhet" RED "!" 99 ON ERROR GOTO 101 100 CHAIN Meny$ 101 END 102 REM 103 REM *** SEPARERAR [MNENA *** 104 REM 105 A%=-1% : R%=-1% : F%=0% : S%=1% : A$=A$+"+" 106 S%=INSTR(S%,A$," ") : IF S%=0% THEN 109 107 A$=LEFT$(A$,S%-1%)+RIGHT$(A$,S%+1%) 108 GOTO 106 109 IF A$="" THEN 124 110 R%=R%+1% : IF R%>M1% F%=1% : RETURN 111 S%=INSTR(1%,A$,"+") 112 F1%=0% : IF A%<>-1% THEN 116 113 REM * REAKTIONSPRODUKTERNA ? * 114 S1%=INSTR(1%,LEFT$(A$,S%-1%),"->") 115 IF S1%<>0% S%=S1% : F1%=1% : A%=R% 116 IF S%>M2%+1% OR S%=1% F%=1% : RETURN 117 B$=LEFT$(A$,S%-1%) 118 A$=RIGHT$(A$,S%+1%+F1%) 119 RESTORE 123 : FOR I1%=1% TO 7% 120 READ C$ : IF C$=B$ THEN B$=B$+"2" 121 NEXT I1% 122 A$(R%)=B$ : GOTO 109 123 DATA F,Cl,Br,I,N,H,O 124 IF A%=-1% OR R%=A% THEN F%=1% 125 RETURN 126 REM 127 REM *** SEPARERAR GRUND[MNENA *** 128 REM 129 R1%=-1% : F1%=1% 130 FOR I%=0% TO R% : A$=A$(I%) 131 IF I%>A% THEN F1%=-1% 132 F2%=1% : F3%=0% 133 GOSUB 205 : IF F% RETURN 134 ON INSTR(1%,"()",B$)+1% GOTO 142,135,140 135 IF F3%<>0% OR B%<>1% F%=1% : RETURN 136 F3%=INSTR(1%,A$,")") : IF F3%<3% THEN F%=1% : RETURN 137 IF F3%<3% OR B%<>1% F%=1% : RETURN 138 S$=A$ : A$=RIGHT$(A$,F3%) : GOSUB 205 139 IF F% RETURN ELSE F2%=B% : A$=S$ : GOTO 133 140 IF F3%=0% THEN F%=1% : RETURN 141 F3%=0% : F2%=1% : GOTO 150 142 C$=LEFT$(B$,1%) : IF C$<"A" OR C$>"Z" THEN F%=1% : RETURN 143 FOR I1%=0% TO R1% 144 IF B$(I1%)=B$ THEN 149 145 NEXT I1% : R1%=I1% : IF R1%>M1% THEN F%=2% : RETURN 146 B$(I1%)=B$ : FOR I2%=0% TO R% 147 A(R1%,I2%)=0% 148 NEXT I2% 149 A(I1%,I%)=B%*F1%*F2%+A(I1%,I%) 150 IF LEFT$(A$,1%)<>" " THEN 133 151 NEXT I% : RETURN 152 REM 153 REM *** ERROR *** 154 REM 155 ; : ; CHR$(7%) RED "Det d{r f|rstod jag inte." 156 GOTO 59 157 ; CHR$(12%) 'Den givna "reaktionslikheten":' 158 ; 159 ; In$ 160 ; 161 ON F% GOTO 166,162,170,173,173 162 ; CHR$(7%) RED "Jag kan tyv{rr inte r{kna med s} m}nga" 163 ; RED "olika {mnen !" 164 ; 165 GOTO 88 166 ; CHR$(7%) "Jag f|rst}r tyv{rr inte vad du menar" 167 ; "med detta :" : ; : ; 168 ; TAB(18%-LEN(A$(I%))/2%) RED NWBG YEL A$(I%) " " BLBG 169 GOTO 88 170 ; CHR$(7%) "Jag kan tyv{rr inte l|sa reaktions-" 171 ; "likheten emedan den inte {r" MAG "entydig!" 172 GOTO 88 173 ; CHR$(7%) RED "Din reaktionslikhet har ingen l|sning !" 174 ; 175 ; " Du har kanske gjort n}got fel n{r du" 176 ; "gav den }t mig ?" 177 GOTO 88 178 ; CHR$(7%) "Tyv{rr {r detta problem f| sv}rt f|r" 179 ; "mig. Min " RED "ber{kningsnogrannhet" WHT "r{cker" 180 ; "inte till. - Jag beklagar !" 181 GOTO 88 182 REM 183 REM *** IDENTISKA EKVATIONER ? *** 184 REM 185 IF R1%=R%-1% OR R%=1% RETURN 186 R%=R%-1% : R2%=1% 187 IF R1%=R% R%=R%+1% : RETURN 197 R2%=R2%+1% : GOTO 188 198 FOR I%=0% TO R%+1% 199 A(R2%,I%)=A(R1%,I%) : NEXT I% 200 R1%=R1%-1% : IF R1%<>R% THEN 188 201 R%=R%+1% : RETURN 202 REM 203 REM *** AVSKILJER ETT [MNE *** 204 REM 205 B$="" : D$="" 206 B$=B$+LEFT$(A$,1%) 207 IF LEN(B$)=3% THEN F%=1% : RETURN 208 A$=RIGHT$(A$+" ",2%) : C$=LEFT$(A$,1%) 209 IF D$="" IF C$>="a" THEN 206 210 IF C$<"0" OR C$>"9" THEN 212 211 IF LEN(D$)<2% D$=D$+C$ : GOTO 208 ELSE F%=1% : RETURN 212 IF D$="" THEN B%=1% ELSE B%=VAL(D$) 213 RETURN 214 REM 215 REM *** DETERMINANTEN A(-,-) *** 216 REM 217 FOR I%=0% TO R% : FOR I1%=0% TO R% 218 B(I%,I1%)=A(I%,I1%) 219 NEXT I1% : NEXT I% 220 S=1% : FOR I%=R% TO 1% STEP -1% 221 S1=B(I%,I%) : IF S1<>0% THEN 227 222 FOR I1%=0% TO I%-1% 223 S1=B(I1%,I%) : IF S1=0% NEXT I1% : S=0% : RETURN 224 FOR I2%=0% TO I% 225 B(I%,I2%)=B(I%,I2%)+B(I1%,I2%) 226 NEXT I2% 227 S=S*S1 : FOR I1%=0% TO I%-1% 228 S2=B(I1%,I%)/S1 : FOR I2%=0% TO I%-1% 229 B(I1%,I2%)=B(I1%,I2%)-S2*B(I%,I2%) 230 NEXT I2% : NEXT I1% : NEXT I% 231 S=S*B(I%,I%) : RETURN 232 REM 233 REM *** INVERTERAR A(-,-) *** 234 REM 235 FOR I%=0% TO R% : FOR I1%=0% TO R% 236 B(I%,I1%)=0% : NEXT I1% 237 B(I%,I%)=1% : NEXT I% 238 FOR I%=0% TO R% 239 FOR I1%=I% TO R% 240 IF A(I1%,I%)<>0% THEN 243 241 NEXT I1% 242 F%=3% : RETURN 243 FOR I2%=0% TO R% 244 S=A(I%,I2%) : A(I%,I2%)=A(I1%,I2%) 245 A(I1%,I2%)=S : S=B(I%,I2%) 246 B(I%,I2%)=B(I1%,I2%) 247 B(I1%,I2%)=S : NEXT I2% 248 S=A(I%,I%) : FOR I1%=0% TO R% 249 A(I%,I1%)=A(I%,I1%)/S 250 B(I%,I1%)=B(I%,I1%)/S 251 NEXT I1% 252 FOR I1%=0% TO R% 253 IF I1%=I% THEN 258 254 S=A(I1%,I%) : FOR I2%=0% TO R% 255 A(I1%,I2%)=A(I1%,I2%)-S*A(I%,I2%) 256 B(I1%,I2%)=B(I1%,I2%)-S*B(I%,I2%) 257 NEXT I2% 258 NEXT I1% : NEXT I% : RETURN 259 REM 260 REM *** KONSTANTEN BORTAGES *** 261 REM 262 FOR I%=0% TO R1% 263 A(I%,R%)=-A(I%,R%) : NEXT I% 264 R%=R%-1% : RETURN 265 REM 266 REM *** L\SER R\TTERNA *** 267 REM 268 FOR I%=0% TO R% : B$="0" 269 FOR I1%=0% TO R% 270 B$=ADD$(B$,MUL$(NUM$(B(I%,I1%)),NUM$(A(I1%,R%+1%)),5%),5%) 271 NEXT I1% 272 X$(I%)=B$ : NEXT I% 273 FOR I%=0% TO R% 274 IF COMP%("0.00000",X$(I%))<>-1% F%=4% 275 NEXT I% : RETURN 276 REM 277 REM *** R\TTERNA TILL HELTAL *** 278 REM 279 FOR I%=0% TO R% 280 X$(I%)=MUL$(X$(I%),NUM$(D),0%) 281 NEXT I% : X$(I%)=NUM$(D) : R%=R%+1% 282 A$=X$(0%) 283 FOR I%=1% TO R% : B$=X$(I%) 284 GOSUB 300 : NEXT I% 285 IF A$="1" RETURN 286 FOR I%=0% TO R% 287 X$(I%)=DIV$(X$(I%),A$,0%) : NEXT I% 288 RETURN 289 REM 290 REM *** SISTA KONTROLLEN *** 291 REM 292 IF R1%=R%-1% RETURN 293 FOR I%=R% TO R1% : A$="0" : FOR I1%=0% TO R%-1% 294 A$=ADD$(A$,MUL$(NUM$(A(I%,I1%)),X$(I1%),5%),5) : NEXT I1% 295 IF SUB$(A$,MUL$(X$(I1%),NUM$(A(I%,I1%)),0%),0%)<>"0" F%=5% : RETURN 296 NEXT I% : RETURN 297 REM 298 REM *** S.G.D *** 299 REM 300 C$=DIV$(B$,A$,7%) 301 IF INSTR(1%,C$,"0000000") RETURN 302 B$=A$ : A$=MUL$(RIGHT$(C$,LEN(C$)-7%),A$,0%) 303 IF A$<>"1" THEN 300 304 RETURN 305 REM 306 REM *** REAKTIONSLIKHETEN *** 307 REM 308 A$="" : B$="" 309 FOR I%=0% TO R% : B$="" 310 IF X$(I%)<>"1" B$=X$(I%)+" " 311 B$=B$+A$(I%) 312 IF I%=A% THEN B$=B$+RED+"->"+CYA ELSE IF I%<>R% THEN B$=B$+" + " 313 IF LEN(A$+B$)>38% THEN ; CYA A$ : A$="" 314 A$=A$+B$ : NEXT I% : ; CYA A$ 315 RETURN 316 REM 317 REM *** ERRORHANTERINGEN *** 318 REM 319 IF ERRCODE<>53% THEN 324 320 Skr%=SYS(6%) : GET A$ 321 IF ASCII(A$)=231% THEN RESUME 99 322 ; CHR$(13%,7%); 323 RESUME 324 ON ERROR GOTO