Gury's Atari 8-bit Forever Portal - Site dedicated to Atari 8-bit home computers by Bostjan Gorisek (Gury)

Listing 1
0 GRAPHICS 0:EXEC OFF
1 SETCOLOR 2,12,0:SETCOLOR 1,12,15:POKE 82,1:POKE 83,38:POKE 752,1
2 FOR I=1536 TO 1633:READ A:POKE I,A:NEXT I
3 POKE 1542,PEEK(88):POKE 1543,PEEK(89):POKE 560,0:POKE 561,6
4 DATA 112,66,38,6,112,66,0,0,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,112,71,78,6,65,0,6
5 DATA 0,0,33,46,47,50,39,33,46,41,35,43,33,0,35,40,37,45,41,37,0,8,99,9,17,25,24,25,0,42,14,35,105,98,117,108
6 DATA 107,97,0,0
7 DATA 0,161,180,161,178,169,0,171,172,181,162,0,0,180,178,165,162,169,163,0
8 ------------------------------
9 REM DEKLARACE
10 DIM N$(50),V$(30),W$(30),P$(80),O$(20),U(10),X(5),Y(10),Z(5)
11 REM P-POZ;D-LEN;S-STATUS;A,B,C-POM; I-PAR;
12 Z(1)=10000:Z(2)=11000:Z(3)=12000:Z(4)=13000:Z(5)=14000
18 ------------------------------
19 REM ZAKL.MENU
20 EXEC OFF:CLS:?:?:?:?:? "     tm "
21 ? "      "
22 ? "     "
23 ? "      "
24 ? "    "
25 ? "    ";
26 ? " ";
27 ? " Zakladni nabidka : kouseni  revody  ";
28 ? "nformace  onec  ";
29 ? "":EXEC ON
34 GET K:WHILE K>96:K=K-32:WEND:IF NOT (K=73 OR K=75 OR K=80 OR K=90) THEN 34
35 IF K=90 THEN EXEC ZK
36 IF K=80 THEN EXEC PR
37 IF K=73 THEN EXEC IN
38 IF K=75:POKE 84,20:? " Myslis to vazne ?! A/N":GET K:IF K=65:POKE 580,0:POKE 16,192:POKE 53774,192
42 GRAPHICS 0:NEW:ELSE:POKE 84,20:? "":GOTO 34
43 ENDIF:ENDIF
44 GOTO 20
45 STOP
49 ------------------------------
99 ------------------------------
100 REM HLAVNI PROCEDURY
101 REM 500 IN INFORMACE
102 REM 1000 ZK ZKOUSENI
103 REM 2000 PR PREVODY
104 ------------------------------
499 ------------------------------
500 PROC IN
501 EXEC OFF
502 CLS:?:?:? "Program umoznuje zkouseni z nazvoslovi anorganicke chemie - kyslikate i bezkyslikate";
503 ? " kyseliny, jejich soli, hydroxidy, prvky, koncovky i predpony. A take prevody podle zadani z nazvu "
504 ? " na vzorec, nebo opacne."
505 ?:? " Zadavate-li nazev kyseliny, nemusite vypisovat "kyselina", ale staci "K.""
506 ? " a podobne u hydroxidu staci "H." ."
508 ?:? " Veskere dotazy a pripominky zodpovi autor:":?:? " Jan CIBULKA"
509 ? " J.Svermy 926":? " Trebic 67401":?
510 EXEC ON:EXEC PK:ENDPROC
511 ------------------------------
999 ------------------------------
1000 PROC ZK
1001 EXEC OFF:CLS:?:? " ";
1002 ? " Zkouseni druh N-V V-N   ";
1003 ? "  Kyseliny A B  ^ Hydroxidy C D ";
1004 ? " || Soli E F  | Prvky G H ";
1005 ? "    Koncovky I   Predpony J ";
1006 ? " Ruzne K ";
1007 ? "  Navrat M ";
1009 ? " "
1010 ? " ";
1011 ? " Dostanes vzdy 10 prikladu podle  zadani a po zodpovezeni budes ";
1012 ? " ohodnocen znamkou z rozsahu 1-5  ";
1013 ? "":EXEC ON
1020 GET K:WHILE K>32:K=K-32:WEND:IF NOT (K>0 AND K<12 OR K=13) THEN 1020
1021 L=K:IF K=13 THEN 1998
1100 CLS:V=0
1101 FOR Q=1 TO 10
1102 ?:? " Priklad cislo ";Q
1104 FOR I=1 TO 10:Y(I)=0:NEXT I
1105 REM GENEROVANI
1106 IF L=11 THEN K=INT(RND(0)*10)+1
1107 IF K=1 OR K=2 OR K=5 OR K=6
1108 O$="K":EXEC P9:Y(1)=A:Y(3)=B:Y(2)=1:Y(7)=INT(RND(0)*2)+1:Y(8)=(Y(2)*Y(3)+Y(7))/2
1109 IF Y(8)<>INT(Y(8)) THEN Y(7)=Y(7)+1:Y(8)=(Y(2)*Y(3)+Y(7))/2
1110 ENDIF
1111 IF K=3 OR K=4 OR K=5 OR K=6
1112 O$="H":EXEC P9:IF B>3:GOTO 1112:ENDIF:Y(4)=A:Y(6)=B:Y(5)=1
1113 ENDIF
1114 IF K=5 OR K=6
1115 X=INT(RND(0)*Y(7)):Y(5)=Y(7)-X:Y(7)=X:Y(10)=Y(6)
1116 A=Y(5):B=Y(10):WHILE A<>B:IF A>B:A=A-B:ELSE:B=B-A:ENDIF:WEND:Y(5)=Y(5)/A:Y(10)=Y(10)/A
1117 ENDIF
1120 FOR I=1 TO 10:U(I)=Y(I):NEXT I
1121 IF K=1 THEN EXEC T4:EXEC P7:EXEC Z2:GOTO 1170
1122 IF K=2 THEN EXEC T1:EXEC P6:EXEC Z1:GOTO 1170
1123 IF K=3 THEN EXEC T5:EXEC P7:EXEC Z4:GOTO 1170
1124 IF K=4 THEN EXEC T2:EXEC P6:EXEC Z3:GOTO 1170
1125 IF K=5 THEN EXEC T6:EXEC P7:EXEC Z6:GOTO 1170
1126 IF K=6 THEN EXEC T3:EXEC P6:EXEC Z5:GOTO 1170
1127 REM OSTATNI
1128 IF K=7 THEN I=INT(RND(0)*105)+1:RESTORE Z(1)+I:READ P$,X,O$:? P$:INPUT P$
1129 IF K=8 THEN I=INT(RND(0)*105)+1:RESTORE Z(1)+I:READ O$,X,P$:? P$:INPUT P$
1130 IF (K=7 OR K=8) AND P$<>O$ THEN ? " Nespravne":? " Spravna odpoved je ";O$:V=V+5:GOTO 1198
1131 IF (K=7 OR K=8) AND P$=O$ THEN ? " Spravne":V=V+1:GOTO 1198
1132 IF K=9 THEN RESTORE Z(RND(0)*2+2):I=INT(RND(0)*9):POKE 182,I:I=9-I:IF I>5:I=I-1:ENDIF:READ P$:? P$
1133 IF K=9:INPUT O$:IF O$=STR$(I):? " Spravne":V=V+1:ELSE:? " Nespravne":V=V+5
1134 ? " Spravna odpoved je ";I:ENDIF:GOTO 1198:ENDIF
1135 IF K=10 THEN RESTORE Z(5):I=INT(RND(0)*12)+1:POKE 182,I-1:READ P$:? P$:INPUT O$
1136 IF K=10:IF O$=STR$(I):? " Spravne":V=V+1:GOTO 1198:ELSE:? " Nespravne"
1137 ? " Spravna odpoved je ";I:V=V+5:GOTO 1198:ENDIF:ENDIF
1169 ------------------------------
1170 REM VYHODNOCENI
1171 IF S>15:EXEC T7:GOTO 1182:ENDIF
1172 A=S&14:J=(((A=2)+(A=4))*((K<>1)*(K<>2)))+((A=6)*((K<>3)*(K<>4)))+(((A=8)+(A=10))*((K<>5)*(K<>6)))
1174 IF J:? " Spletl jsi si druh slouceniny.":GOTO 1182:ENDIF
1175 IF Y(1)<>U(1) OR Y(4)<>U(4) THEN ? " Pouzil jsi jiny prvek.":GOTO 1182
1176 IF K=5 OR K=6:A=Y(5):B=Y(10):WHILE A<>B:IF A>B:A=A-B:ELSE:B=B-A:ENDIF:WEND:Y(5)=Y(5)/A:Y(10)=Y(10)/A:ENDIF
1177 IF K=1 OR K=2 OR K=5 OR K=6 THEN A=Y(1):B=Y(3):EXEC P8
1178 IF K=3 OR K=4 OR K=5 OR K=6 THEN A=Y(4):B=Y(6):EXEC P8
1179 EXEC T7:IF S>15 OR S<=0 THEN 1182
1180 IF Y(1)=U(1) AND Y(3)=U(3) AND Y(4)=U(4) AND Y(6)=U(6) THEN V=V+1:? " Spravne":GOTO 1198
1181 ? " Nespravne"
1182 V=V+5:? "Spravna odpoved je ";
1183 FOR I=1 TO 10:Y(I)=U(I):NEXT I
1184 IF K=1 THEN EXEC T1:GOTO 1198
1185 IF K=2 THEN EXEC T4:GOTO 1198
1186 IF K=3 THEN EXEC T2:GOTO 1198
1187 IF K=4 THEN EXEC T5:GOTO 1198
1188 IF K=5 THEN EXEC T3:GOTO 1198
1189 IF K=6 THEN EXEC T6:GOTO 1198
1198 ? " Dosavadni znamka je ";INT(V/Q+0.5):EXEC PK:CLS
1199 NEXT Q
1200 ?:? " Vysledna znamka je ";INT(V/10+0.5)
1201 X=((V/10)-INT(V/10+0.5))
1202 IF X>0.3 THEN ? " ( ale jen tak - tak )":GOTO 1210
1203 IF X<-0.3 THEN ? " ( skoro to byla ";INT(V/10-0.5);" )":GOTO 1210
1204 X=INT(V/10+0.5)
1205 IF X=2 THEN ? " Mohl bys jeste pridat!?"
1206 IF X=3 THEN ? " Neslo by to lepe?"
1207 IF X=4 THEN ? " Jestli to tak pujde dal, ..."
1208 IF X=5 THEN ? " Ale fuj !!!!"
1209 IF X=1 THEN ? " Bez pripominek"
1210 REM
1900 EXEC PK:GOTO 1001
1998 ENDPROC
1999 ------------------------------
2000 PROC PR
2001 EXEC OFF:CLS:?:? "  ";
2002 ? " Jde o prevod V nazev - vzorec  nebo N vzorec - nazev ";
2003 ? "  Navrat zpet do enu ";
2004 ? " ":EXEC ON
2005 GET K:WHILE K>97:K=K-32:WEND:IF K<>86 AND K<>78 AND K<>77 THEN 2005
2006 IF K=77 THEN 2998
2048 POSITION 1,10:FOR I=1 TO 15:? "";:NEXT I
2049 IF K=78:EXEC P6:ELSE:EXEC P7:ENDIF
2051 IF S>15 THEN EXEC T7:GOTO 2900
2053 IF S=3 OR S=5:EXEC Z1:EXEC T7:IF S<16:EXEC T1:ENDIF:GOTO 2900:ENDIF
2054 IF S=7:EXEC Z3:EXEC T7:IF S<16:EXEC T2:ENDIF:GOTO 2900:ENDIF
2055 IF S=9 OR S=11:EXEC Z5:EXEC T7:IF S<16:EXEC T3:ENDIF:GOTO 2900:ENDIF
2056 IF S=13:EXEC Z7:GOTO 2900:ENDIF
2057 IF S=2 OR S=4:EXEC Z2:EXEC T7:IF S<16:EXEC T4:ENDIF:GOTO 2900:ENDIF
2058 IF S=6:EXEC Z4:EXEC T7:IF S<16:EXEC T5:ENDIF:GOTO 2900:ENDIF
2059 IF S=8 OR S=10:EXEC Z6:EXEC T7:IF S<16:EXEC T6:ENDIF:GOTO 2900:ENDIF
2060 IF S=12:EXEC Z7:GOTO 2900:ENDIF
2099 EXEC T7
2900 ?:?:GOTO 2005
2998 ENDPROC
2999 ------------------------------
3000 REM ZAKLADNI PROCEDURY
3001 REM 3100 Z1 KYSELINA NV
3002 REM 3200 Z2 KYSELINA VN
3003 REM 3300 Z3 HYDROXID NV
3004 REM 3400 Z4 HYDROXID VN
3005 REM 3500 Z5 SUL NV
3006 REM 3600 Z6 SUL VN
3007 REM 3700 Z7 PRVEK
3099 ------------------------------
3100 PROC Z1
3101 IF S<=0 OR S>15:GOTO 3198:ENDIF:A=S&14:FOR I=1 TO 10:Y(I)=0:NEXT I
3102 IF A=4 THEN 3111
3103 EXEC P3:IF D>20:IF N$(P,P+7)="HYDROGEN":P=P+8:Y(7)=I:EXEC P3:ENDIF:ENDIF
3104 Y(2)=I:EXEC P1:IF S>15:GOTO 3198:ENDIF:Y(1)=I:A=2:EXEC P4:IF S>15:GOTO 3198:ENDIF:Y(3)=I
3105 IF Y(7)>0
3106 Y(8)=(Y(7)+Y(2)*Y(3))/2:IF Y(8)<>INT(Y(8)) THEN S=256:GOTO 3198
3107 ELSE
3108 Y(7)=Y(7)+1:Y(8)=(Y(7)+Y(2)*Y(3))/2:IF Y(8)<>INT(Y(8)) THEN 3108
3109 ENDIF
3110 GOTO 3198
3111 D=INSTR(N$,"OVODIKOVA"):D=D+INSTR(N$,"AN"):EXEC P1:IF S>15:GOTO 3198:ENDIF:Y(1)=I
3112 IF X=1 THEN Y(3)=B:GOTO 3115
3113 RESTORE Z(1)+I:POKE 182,4:READ X,C:IF X>0:FOR C=1 TO X:READ J:IF J<0:EXIT
3114 ENDIF:NEXT C:IF C>X:J=0:S=S!64:GOTO 3198:ENDIF:ENDIF:Y(3)=J
3115 Y(7)=ABS(Y(3))
3198 ENDPROC
3199 ------------------------------
3200 PROC Z2
3201 IF S>15:GOTO 3298:ENDIF:A=S&14:FOR I=1 TO 10:Y(I)=0:NEXT I
3203 P=2:EXEC P5:Y(7)=I:EXEC P2:IF S>15 THEN 3298
3204 Y(1)=I:EXEC P5:Y(2)=I:IF P>D THEN Y(3)=-Y(7):GOTO 3298
3205 IF V$(P,P)="O":IF P=D:Y(8)=1:ELSE:P=P+1:EXEC P5:Y(8)=I:ENDIF:Y(3)=(2*Y(8)-Y(7))/Y(2):ENDIF
3298 ENDPROC
3299 ------------------------------
3300 PROC Z3
3301 IF S>15:GOTO 3398:ENDIF:FOR I=1 TO 10:Y(I)=0:NEXT I:EXEC P1:IF S<16:Y(4)=I:ELSE:GOTO 3398:ENDIF
3302 A=1:EXEC P4:IF S<16:Y(6)=I:ENDIF
3398 ENDPROC
3399 ------------------------------
3400 PROC Z4
3401 IF S>15:GOTO 3498:ENDIF:FOR I=1 TO 10:Y(I)=0:NEXT I:P=1:EXEC P2:IF S<15:Y(4)=I:ELSE:GOTO 3498:ENDIF
3402 IF W$(P,P)="3":P=P+4:EXEC P5:IF S<16:Y(6)=I:ELSE:GOTO 3498:ENDIF:ELSE:Y(6)=1:ENDIF
3498 ENDPROC
3499 ------------------------------
3500 PROC Z5
3501 IF S>15:GOTO 3598:ENDIF:FOR I=1 TO 10:Y(I)=0:NEXT I:P=1:EXEC P3
3502 E=D-P+1:IF E>5:IF N$(P,P+5)="HYDRAT":Y(9)=I:P=P+6:EXEC P3:ENDIF:ENDIF
3503 E=D-P+1:IF E>7:IF N$(P,P+7)="HYDROGEN":Y(7)=I:P=P+8:EXEC P3:ENDIF:ENDIF
3504 Y(2)=I:EXEC P1:IF S>15:GOTO 3598:ELSE:Y(1)=I:ENDIF
3505 IF N$(P,P+1)="ID"
3506 IF X=1:Y(3)=B:ELSE
3507 RESTORE Z(1)+I:POKE 182,4:READ A,B:IF A>0:FOR I=1 TO A:READ X:IF X<0:EXIT:ENDIF:NEXT I
3508 IF I>A:S=32:GOTO 3598:ELSE:Y(3)=X:ENDIF:ELSE:S=32:GOTO 3598:ENDIF
3509 ENDIF
3510 P=P+2:GOTO 3513
3511 ENDIF
3512 A=3:EXEC P4:IF S>15:GOTO 3598:ELSE:Y(3)=I:ENDIF
3513 IF Y(9)>0:P=P+1:ENDIF:EXEC P3:Y(5)=I
3514 EXEC P1:IF S>15:GOTO 3598:ELSE:Y(4)=I:ENDIF
3515 IF Y(9)>0:N$(D-2,D-2)="Y":ENDIF:A=1:EXEC P4:IF S>15:GOTO 3598:ELSE:Y(6)=I:ENDIF
3516 X=Y(7)
3517 X=X+1:A=(Y(2)*Y(3)+X)/2:IF A<>INT(A):GOTO 3517:ENDIF:IF Y(3)<0 THEN A=0
3518 Y(8)=A:Y(10)=(Y(8)*2-Y(2)*Y(3)-Y(7)):Y(5)=Y(10)
3598 ENDPROC
3599 ------------------------------
3600 PROC Z6
3601 IF S>15:GOTO 3698:ENDIF:P=1:A=S&14:FOR I=1 TO 10:Y(I)=0:NEXT I:Y(10)=1
3602 IF A=8 OR A=10
3603 EXEC P2:IF S<16:Y(4)=I:ELSE:GOTO 3698:ENDIF
3604 EXEC P5:Y(5)=I:IF W$(P,P)="3" THEN P=P+1
3605 EXEC P2:IF S>15:GOTO 3698:ENDIF:IF I=1:EXEC P5:Y(7)=I:IF P>D:GOTO 3609:ENDIF:EXEC P2:IF S>15:GOTO 3698
3606 ENDIF:ENDIF:Y(1)=I:IF P>D:Y(2)=1:ELSE:EXEC P5:Y(2)=I:ENDIF
3607 IF Y(1)=8:GOTO 3609:ENDIF
3608 IF A=8:IF V$(P,P)="O" AND W$(P+1,P+1)<>"2":P=P+1:IF P>D:Y(8)=1:ELSE:EXEC P5:Y(8)=I:ENDIF:ENDIF:ENDIF
3609 IF Y(1)=0 AND Y(7)>0:Y(1)=1:Y(2)=Y(7):Y(7)=0:Y(3)=-1:Y(6)=Y(2):GOTO 3698:ENDIF
3610 IF P>D:GOTO 3614:ENDIF:IF W$(P,P)="3":P=P+1:EXEC P5:Y(10)=I:ELSE:Y(10)=1:ENDIF
3611 IF P>D:GOTO 3614:ENDIF:IF W$(P,P)="4":P=P+1:EXEC P5:Y(9)=I:ENDIF
3613 ENDIF:------------------------------ ============================Z1
3614 IF Y(1)=0 OR Y(2)=0:IF Y(7)>0 AND Y(8)=0:Y(1)=1:Y(2)=Y(7):Y(7)=0:Y(3)=-Y(4):Y(6)=Y(2):GOTO 3698:ENDIF
3615 IF Y(8)>0 AND Y(7)=0:Y(1)=8:Y(2)=Y(8):Y(8)=0:ENDIF
3616 IF Y(1)=0 OR Y(2)=0:GOTO 3698:ENDIF:ENDIF
3617 RESTORE Z(1)+Y(4):POKE 182,3:READ O$:IF O$="M" OR O$="N" THEN 3698
3618 RESTORE Z(1)+Y(1):POKE 182,3:READ O$:IF O$="M" OR O$="N" THEN 3698
3619 READ A,B:D=A+B:IF D<1 THEN 3698
3620 FOR I=1 TO D:IF I>A:READ O$,X:ELSE:READ X:ENDIF:X(I)=X:NEXT I
3621 RESTORE Z(1)+Y(4):POKE 182,4:READ A,B:IF A+B<1 THEN 3698
3622 FOR I=1 TO A+B
3623 IF I>A:READ O$,X:ELSE:READ X:ENDIF
3624 J=D+1:IF X/Y(10)=INT(X/Y(10))
3626 IF Y(8)=0 AND X>0:C=(Y(7)-Y(5)*X/Y(10))/Y(2):ENDIF
3630 IF Y(8)>0 AND X>0:C=(Y(8)*2-Y(7)-X*Y(5)/Y(10))/Y(2):ENDIF
3631 FOR J=1 TO D:IF C=X(J) AND NOT (Y(8)>0 AND C<0):EXIT:ENDIF:NEXT J
3632 ENDIF
3633 IF J<=D THEN EXIT
3634 NEXT I
3635 IF J>D THEN 3698
3636 Y(3)=X(J):Y(6)=ABS(X)
3698 ENDPROC
3699 ------------------------------
3700 PROC Z7
3701 IF S=12 OR S=13
3702 RESTORE Z(1)+I:READ P$,X,O$
3703 ? "Prvek ma nazev ";P$;" a znacku ";O$
3704 ? "Ma protonove cislo ";I
3705 READ P$:IF P$="A" THEN ? "Tvori kyseliny i zasady":GOTO 3798
3706 IF P$="K" THEN ? "Tvori kyseliny":GOTO 3798
3707 IF P$="H" THEN ? "Tvori hydroxidy":GOTO 3798
3708 IF P$="N" THEN ? "Je to netecny prvek":GOTO 3798
3709 IF P$="M" THEN ? "Vlastnosti tohoto prvku nejsou znamy.":GOTO 3798
3710 ENDIF
3798 ENDPROC
3799 ------------------------------
3999 ------------------------------
4000 REM POMOCNE PROCEDURY
4001 REM 4100 P1 PRVEK Z NAZVU
4002 REM 4200 P2 PRVEK ZE VZORCE
4003 REM 4300 P3 PREDPONA Z NAZVU
4004 REM 4400 P4 KONCOVKA Z NAZVU
4005 REM 4700 P5 POCET ZE VZORCE
4006 REM 4500 P6 VST. A UPR. NAZVU
4007 REM 4600 P7 VST. A UPR. VZORCE
4008 REM 4800 P8 TEST OX.CISLA
4009 REM 4900 P9 PRVEK DLE POVAHY
4010 ------------------------------
4100 PROC P1
4101 IF S>15:GOTO 4198:ENDIF:C=0:X=0:E=D-P+1:IF E<=2 THEN S=16:GOTO 4198
4102 FOR I=1 TO 105
4103 RESTORE Z(1)+I:READ P$,F:IF F>E THEN 4105
4104 IF P$(1,F)=N$(P,P+F-1) THEN EXIT
4105 NEXT I
4106 IF I<106 THEN 4117
4107 FOR I=1 TO 105:RESTORE Z(1)+I:POKE 182,3:READ O$:IF O$="M" OR O$="N" THEN 4115
4108 READ A,B:IF B=0 THEN 4114
4109 POKE 182,6+A:FOR J=1 TO B
4110 READ P$,B:F=LEN(P$):IF F>E THEN 4113
4111 IF B=5 THEN F=F-1
4112 X=0:IF N$(P,P+F-1)=P$(1,F) THEN X=1:EXIT
4113 NEXT J
4114 IF X=1 THEN EXIT
4115 NEXT I
4116 IF I=106 THEN S=16
4117 IF N$(P+F-1,P+F)="NY" OR N$(P+F-1,P+F)="NA" THEN F=F-1
4196 GOTO 4198
4198 P=P+F:ENDPROC
4199 ------------------------------
4200 PROC P2
4201 E=D-P+1:IF E<1 THEN S=16:GOTO 4298
4202 IF W$(P,P)<>"1" THEN S=16:GOTO 4298
4203 IF E=1:O$=V$(P,P):P=P+1:ELSE:IF W$(P+1,P+1)<>"2":O$=V$(P,P):P=P+1:ELSE:O$=V$(P,P+1):P=P+2:ENDIF:ENDIF
4204 FOR I=1 TO 105
4205 RESTORE Z(1)+I:POKE 182,PEEK(182)+2:READ P$:IF O$=P$ THEN EXIT
4206 NEXT I
4207 IF I=106 THEN S=16
4298 ENDPROC
4299 ------------------------------
4300 PROC P3
4301 E=D-P+1:IF E<2 THEN 4398
4302 RESTORE Z(5)
4303 FOR I=1 TO 12
4304 READ P$:A=LEN(P$):IF A<=E:IF N$(P,P+A-1)=P$:P=P+A:EXIT:ENDIF:ENDIF
4305 NEXT I
4306 IF I=13 THEN I=1
4398 ENDPROC
4399 ------------------------------
4400 PROC P4
4401 E=D-P+1:IF E<2 THEN 4498
4402 RESTORE Z(A+1)
4403 FOR I=9 TO 1 STEP -1
4404 READ P$:B=LEN(P$):IF B<=E:IF P$=N$(P,P+B-1):P=P+B:EXIT:ENDIF:ENDIF
4405 NEXT I
4406 IF I>5 THEN I=I-1
4498 ENDPROC
4499 ------------------------------
4500 PROC P5:I=1
4501 E=D-P+1:IF E<=0 THEN I=1:GOTO 4598
4502 IF W$(P,P)<>"0" THEN I=1:GOTO 4598
4503 IF E=1 THEN I=VAL(V$(P,P)):P=P+1:GOTO 4598
4504 IF W$(P+1,P+1)<>"0" THEN I=VAL(V$(P,P)):P=P+1:GOTO 4598
4505 I=VAL(V$(P,P+1)):P=P+2
4598 ENDPROC
4599 ------------------------------
4600 PROC P6
4601 S=0:POKE 752,0:S=0:P$="":N$="":? "Zadej nazev slouceniny":INPUT P$:A=LEN(P$):B=1:POKE 752,1
4602 IF A=0:S=1024:GOTO 4698:ENDIF:FOR I=1 TO A
4603 C=ASC(P$(I,I))
4604 IF C>127 THEN C=C-128
4605 IF C>64 AND C<91 OR C=46 THEN N$(B,B)=CHR$(C):B=B+1
4606 IF C>96 AND C<123 THEN N$(B,B)=CHR$(C-32):B=B+1
4607 NEXT I
4608 D=B-1
4609 X=INSTR(N$,"KYSELINA"):Y=INSTR(N$,"K."):IF X+Y>1 THEN S=128:GOTO 4697
4610 IF X+Y=1:P=X*9+Y*3:IF INSTR(N$,"VODIKOVA")>X:S=4:ELSE:S=2:ENDIF:GOTO 4697:ENDIF
4611 X=INSTR(N$,"HYDROXID"):Y=INSTR(N$,"H."):IF X+Y>1 THEN S=128:GOTO 4697
4612 IF X+Y=1 THEN P=X*9+Y*3:S=6:GOTO 4697
4613 X=INSTR(N$,"AN"):Y=INSTR(N$,"AN",X):IF X+2>=D THEN P=1:S=4:GOTO 4697
4614 IF X>3 OR Y>0 THEN S=8:GOTO 4697
4615 X=INSTR(N$,"ID"):IF X>2 THEN S=10:GOTO 4697
4616 FOR I=1 TO 105:RESTORE Z(1)+I:READ P$:F=LEN(P$):IF F=D:IF P$=N$(1,F):EXIT:ENDIF:ENDIF:NEXT I
4617 IF I<106 THEN S=12:GOTO 4697
4697 S=S!1:FOR J=D+1 TO 50:N$(J,J)=" ":NEXT J
4698 ENDPROC
4699 ------------------------------
4700 PROC P7
4701 S=0:POKE 752,0:S=0:P$="":V$="":W$="":? "Zadej vzorec slouceniny":INPUT P$:A=LEN(P$):B=1
4702 IF A=0:S=1024:GOTO 4798:ENDIF:FOR I=1 TO A
4703 C=ASC(P$(I,I))
4704 IF C>127 THEN C=C-128
4705 IF C>47 AND C<58 THEN V$(B,B)=CHR$(C):W$(B,B)="0":B=B+1
4706 IF C>64 AND C<91 THEN V$(B,B)=CHR$(C):W$(B,B)="1":B=B+1
4707 IF C>96 AND C<123 THEN V$(B,B)=CHR$(C):W$(B,B)="2":B=B+1
4708 IF C=40 OR C=41 THEN V$(B,B)=CHR$(C):W$(B,B)="3":B=B+1
4709 IF C=46 THEN V$(B,B)=".":W$(B,B)="4":B=B+1
4710 NEXT I
4711 M=INSTR(V$,"AN"):N=INSTR(V$,"NA"):O=INSTR(V$,"ID")
4712 FOR J=1 TO 105:RESTORE Z(1)+J:READ P$:IF P$=V$:EXIT:ENDIF:NEXT J
4713 IF M>0 OR N>0 OR O>0 OR J<106 THEN S=0:? " Vstup neodpovida zadani":GOTO 4797
4715 IF V$="H2O2":? "PEROXID VODIKU":S=2048:GOTO 4798:ENDIF:D=B-1:P=1:EXEC P2
4716 IF I=1:X=INSTR(V$,"O"):IF X>1:IF D>X:IF W$(X+1,X+1)<>"2":S=2:ENDIF:ELSE:S=2:ENDIF:ELSE:S=4:ENDIF
4717 ENDIF:IF S>0 THEN 4797
4718 X=INSTR(V$,"OH"):IF X>1 THEN S=6:GOTO 4797
4719 IF D<3:IF D=1:S=12:GOTO 4798:ENDIF:IF D=2 AND W$(2,2)="2":S=12:GOTO 4797:ENDIF:ENDIF
4720 IF INSTR(V$,"O")>1:S=8:ELSE:S=10:ENDIF
4797 S=S&DEC("FFFE"):FOR J=D+1 TO 30:V$(J,J)=" ":W$(J,J)=" ":NEXT J
4798 POKE 752,1:ENDPROC
4799 ------------------------------
4800 PROC P8
4801 IF A=0:S=16:GOTO 4898:ENDIF:RESTORE Z(1)+A:POKE 182,3:A=106:READ P$:IF P$="N" OR P$="M" THEN 4804
4802 READ C,D:IF C>0 THEN FOR I=1 TO C:READ X:IF X=B:EXIT:ENDIF:NEXT I:IF I<=C THEN 4898
4803 IF D>0 THEN FOR I=1 TO D:READ P$,X:IF X=B:EXIT:ENDIF:NEXT I:IF I<=D THEN 4898
4804 S=32
4898 ENDPROC
4899 ------------------------------
4900 PROC P9
4901 A=INT(RND(0)*105)+1:P=0
4902 RESTORE Z(1)+A:POKE 182,3:READ P$:IF O$<>P$ THEN 4901
4903 READ X,Y:IF X+Y<1 THEN 4901
4904 RESTORE Z(1)+A:POKE 182,6:Z=INT(RND(0)*(X+Y)+1):FOR I=1 TO Z:IF I>X:READ P$,B:ELSE:READ B:ENDIF:NEXT I
4905 IF B<0 THEN P=P+1:IF P>3:GOTO 4901:ELSE:GOTO 4904:ENDIF
4998 ENDPROC
4999 ------------------------------
5000 REM TISKOVE PROCEDURY
5001 REM 5100 T1 VZOREC KYSELINY
5002 REM 5200 T2 VZOREC HYDROXIDU
5003 REM 5300 T3 VZOREC SOLI
5004 REM 5400 T4 NAZEV KYSELINY
5005 REM 5500 T5 NAZEV HYDROXIDU
5006 REM 5600 T6 NAZEV SOLI
5007 REM 5700 T7 CHYBOVE HLASENI
5008 REM 5800 T8 CISELNY PARAMETR
5009 REM 5850 T9 PREDPONA
5010 REM 5900 T10 ZNACKA
5011 REM 5950 T11 NAZEV+KONCOVKA
5099 ------------------------------
5100 PROC T1
5101 ? "H";:I=Y(7):EXEC T8:I=Y(1):EXEC T10:I=Y(2):EXEC T8:IF Y(8)>0 THEN ? "O";:I=Y(8):EXEC T8:?
5198 ENDPROC
5199 ------------------------------
5200 PROC T2
5201 I=Y(4):EXEC T10:IF Y(6)>1:? "(OH)";:I=Y(6):EXEC T8:ELSE:? "OH":ENDIF:? " "
5298 ENDPROC
5299 ------------------------------
5300 PROC T3
5301 I=Y(4):EXEC T10:A=ABS(Y(5)):B=ABS(Y(6)):WHILE A<>B:IF A>B:A=A-B:ELSE:B=B-A:ENDIF:WEND
5302 Y(5)=Y(5)/A:Y(6)=Y(6)/A:I=Y(5):EXEC T8
5303 IF Y(6)>1 AND NOT (Y(7)=0 AND Y(8)=0) THEN ? "(";
5304 IF Y(7)>0 THEN ? "H";:I=Y(7):EXEC T8
5305 I=Y(1):EXEC T10
5306 I=Y(2):EXEC T8
5307 IF Y(8)>0 THEN ? "O";:I=Y(8):EXEC T8
5308 IF Y(6)>1 AND NOT (Y(7)=0 AND Y(8)=0) THEN ? ")";
5309 IF Y(6)>1 THEN I=Y(6):EXEC T8
5310 IF Y(9)>0 THEN ? ".";:I=Y(9):EXEC T8:? "H2O"
5398 ? " ":ENDPROC
5399 ------------------------------
5400 PROC T4
5401 IF Y(3)<0 AND (Y(1)=6 OR Y(1)=7 OR Y(1)=14 OR Y(1)=15 OR Y(1)=16) THEN 5410
5402 IF Y(3)<0 AND (Y(1)=1 OR Y(1)=8) THEN 5420
5405 ? "KYSELINA ";:IF Y(3)>0:IF Y(7)>1:I=Y(7):EXEC T9:? "HYDROGEN ";:ENDIF:I=Y(2):EXEC T9:ENDIF
5406 A=Y(1):B=Y(3):C=2:EXEC T11:IF Y(3)<0 THEN ? "OVODIKOVA"
5407 ? "":GOTO 5498
5410 IF Y(1)=6 THEN ? "KARBAN":GOTO 5498
5411 IF Y(1)=7 THEN ? "NITRAN":GOTO 5498
5412 IF Y(1)=14 THEN ? "SILAN":GOTO 5498
5413 IF Y(1)=15 THEN ? "FOSFAN":GOTO 5498
5414 IF Y(1)=16 THEN ? "SULFAN":GOTO 5498
5420 IF Y(1)=1 THEN ? "VODIK , MOLEKULARNI":GOTO 5498
5421 IF Y(1)=8 THEN ? "DESTILOVANA VODA":GOTO 5498
5498 ENDPROC
5499 ------------------------------
5500 PROC T5
5501 ? "HYDROXID ";
5502 A=Y(4):B=Y(6):C=1:EXEC T11:? " "
5598 ENDPROC
5599 ------------------------------
5600 PROC T6
5601 IF Y(7)>0 THEN I=Y(7):EXEC T9:? "HYDROGEN ";
5602 IF Y(8)>0:I=Y(2):EXEC T9:ENDIF:A=Y(1):B=Y(3):C=3:EXEC T11:IF B<0:? "ID";:ENDIF:? " ";
5603 IF Y(8)>0:I=Y(5):EXEC T9:ENDIF:A=Y(4):B=Y(6):C=1:EXEC T11:? " ";
5604 IF Y(9)>0:? ", ";:I=Y(9):EXEC T9:? "HYDRAT":ELSE:? " ":ENDIF
5698 ENDPROC
5699 ------------------------------
5700 PROC T7
5701 A=S&14:IF A=2 OR A=4 OR A=8 OR A=10 THEN A=Y(1):B=Y(3):EXEC P8
5702 IF A=6 OR A=8 OR A=10 THEN A=Y(4):B=Y(6):EXEC P8
5703 A=S&65520
5704 IF A=16 THEN ? " Pouzil jsi neznamy prvek.":GOTO 5798
5705 IF A=32 THEN ? "Pouzity prvek nema pouzite ox. cislo.":GOTO 5798
5706 IF A=64 THEN ? " Pouzil jsi neexistujici koncovku.":GOTO 5798
5707 IF A=128 THEN ? " Oznaceni druhu slouceniny se umistuje na zacatek.":GOTO 5798
5708 IF A=256 THEN ? " Pouzil jsi spatny pocet vodiku.":GOTO 5798
5709 IF Y(1)>0 AND Y(3)<>0:RESTORE Z(1)+Y(1):POKE 182,3:READ O$:IF O$<>"A" AND O$<>"K"
5710 ? " Prvek nevytvari kyselinu":S=512:GOTO 5798:ENDIF:ENDIF
5711 IF Y(4)>0 AND Y(6)<>0 AND Y(1)<>8:RESTORE Z(1)+Y(4):POKE 182,3:READ O$:IF O$<>"A" AND O$<>"H"
5712 ? " Prvek nevytvari hydroxidy":S=512:GOTO 5798:ENDIF:ENDIF
5713 IF A=1024 THEN ? " Zadal jsi prazdny retezec.":GOTO 5798
5798 ENDPROC
5799 ------------------------------
5800 PROC T8
5801 IF I>1 THEN ? I;
5848 ENDPROC
5849 ------------------------------
5850 PROC T9
5851 IF I>1 AND I<13 THEN RESTORE Z(5):POKE 182,I-1:READ P$:? P$;
5852 IF I>12 AND I<20 THEN RESTORE Z(5):POKE 182,I-11:READ P$:? P$;"DEKA";
5853 IF I>20 THEN ? I;" ";
5898 ENDPROC
5899 ------------------------------
5900 PROC T10
5901 RESTORE Z(1)+I:POKE 182,2:READ P$:? P$;
5948 ENDPROC
5949 ------------------------------
5950 PROC T11
5951 RESTORE Z(1)+A:READ P$,F,O$,O$,D,E
5952 IF D>0:FOR I=1 TO D:READ X:IF X=B:EXIT:ENDIF:NEXT I:IF I<=D:? P$(1,F);:GOTO 5954:ENDIF:ENDIF
5953 IF E>0:FOR I=1 TO E:READ P$,X:IF X=B:EXIT:ENDIF:NEXT I:F=LEN(P$):? P$;:ENDIF
5954 IF B<0 THEN 5998
5955 RESTORE Z(C+1)
5956 IF B=5:? "CN";:IF C=1:? "Y";:ENDIF:IF C=2:? "A";:ENDIF:IF C=3:? "AN";:ENDIF
5957 ELSE:X=8-B:IF X>3:X=X+1:ENDIF:POKE 182,X:READ O$
5958 IF P$(F,F)="N" AND O$(1,1)="N":? O$(2,LEN(O$));:ELSE:? O$;:ENDIF
5959 ENDIF
5998 ENDPROC
5999 ------------------------------
6000 PROC PK:?:? " ":GET KEY:ENDPROC
6099 ------------------------------
6100 PROC TISK
6101 ? Y(1),Y(2),Y(3):? Y(4),Y(5),Y(6):? Y(7),Y(8),Y(9),Y(10)
6102 ENDPROC
6103 ------------------------------
6200 PROC OFF
6201 POKE 559,0:SETCOLOR 4,12,0
6202 ENDPROC
6203 ------------------------------
6300 PROC ON
6301 SETCOLOR 4,12,7:POKE 559,34
6302 ENDPROC
9997 ------------------------------
9998 ------------------------------
9999 ------------------------------
10000 REM PRVKY N$,D,Z$,P,pO,pnO,OC(1-p);nOC,N$(1-p)
10001 DATA VODIK,3,H,A,1,1,1,HYDR,-1
10002 DATA HELIUM,3,He,N
10003 DATA LITHIUM,4,Li,H,1,0,1
10004 DATA BERYLIUM,5,Be,H,1,0,2
10005 DATA BOR,3,B,K,2,0,-3,3
10006 DATA UHLIK,3,C,K,1,2,4,UHEL,2,CARB,-4
10007 DATA DUSIK,3,N,K,3,2,2,3,4,NITR,-3,DUSI,5
10008 DATA KYSLIK,4,O,A,0,2,OX,-2,PEROX,-1
10009 DATA FLUOR,5,F,K,1,0,-1
10010 DATA NEON,4,Ne,N
10011 DATA SODIK,3,Na,H,1,0,1
10012 DATA HORCIK,3,Mg,H,0,1,HOREC,2
10013 DATA HLINIK,4,Al,A,1,0,3
10014 DATA KREMIK,4,Si,A,1,2,4,SILIC,-4,SIL,-4
10015 DATA FOSFOR,6,P,K,2,2,1,3,FOSF,-3,FOSFORE,5
10016 DATA SIRA,3,S,K,3,2,4,6,-2,SULF,-2,PERSULF,-1
10017 DATA CHLOR,5,Cl,K,3,1,-1,1,7,CHLORE,5
10018 DATA ARGON,5,Ar,N
10019 DATA DRASLIK,5,K,H,0,1,DRASEL,1
10020 DATA VAPNIK,4,Ca,H,0,1,VAPE,2
10021 DATA SKANDIUM,5,Sc,A,1,0,3
10022 DATA TITAN,5,Ti,A,2,0,3,4
10023 DATA VANAD,5,V,A,2,1,3,4,VANADI,5
10024 DATA CHROM,5,Cr,H,3,0,2,3,6
10025 DATA MANGAN,6,Mn,H,3,0,2,4,7
10026 DATA ZELEZO,5,Fe,H,2,0,2,3
10027 DATA KOBALT,6,Co,A,2,0,2,3
10028 DATA NIKL,4,Ni,H,0,2,NIKEL,2,NIKEL,3
10029 DATA MED,3,Cu,H,2,0,1,2
10030 DATA ZINEK,5,Zn,H,0,1,ZINEC,2
10031 DATA GALLIUM,3,Ga,A,1,0,3
10032 DATA GERMANIUM,6,Ge,A,2,0,2,4
10033 DATA ARSEN,5,As,A,2,1,-3,3,ARSENI,5
10034 DATA SELEN,5,Se,A,3,0,-2,4,6
10035 DATA BROM,4,Br,K,2,1,-1,1,BROME,5
10036 DATA KRYPTON,7,Kr,N
10037 DATA RUBIDIUM,5,Rb,A,1,0,1
10038 DATA STRONCIUM,9,Sr,H,0,1,STRONT,2
10039 DATA YTTRIUM,4,Y,A,1,0,3
10040 DATA ZIRKON,6,Zr,A,1,0,4
10041 DATA NIOB,4,Nb,A,1,1,3,NIOBE,5
10042 DATA MOLYBDEN,8,Mo,A,2,0,4,6
10043 DATA TECHNECIUM,7,Tc,A,2,0,4,6
10044 DATA RUTHENIUM,6,Ru,A,3,0,3,4,8
10045 DATA RHODIUM,4,Rh,A,2,0,3,4
10046 DATA PALLADIUM,6,Pd,A,1,0,2
10047 DATA STRIBRO,6,Ag,H,1,0,1
10048 DATA KADMIUM,7,Cd,H,0,1,KADEM,2
10049 DATA INDIUM,3,In,A,1,0,3
10050 DATA CIN,3,Sn,H,2,0,2,4
10051 DATA ANTIMON,7,Sb,A,1,1,3,ANTIMONI,5
10052 DATA TELLUR,6,Te,A,3,0,-2,4,6
10053 DATA JOD,3,I,K,3,1,-1,1,7,JODI,5
10054 DATA XENON,5,Xe,N
10055 DATA CESIUM,3,Cs,A,1,0,1
10056 DATA BARYUM,3,Ba,H,1,0,2
10057 DATA LANTHAN,7,La,A,1,0,3
10058 DATA CERIUM,3,Ce,A,2,0,3,4
10059 DATA PRASEODYM,9,Pr,A,2,1,3,4,PRASEODYME,5
10060 DATA NEODYM,6,Nd,A,1,0,3
10061 DATA PROMETHIUM,7,Pm,A,1,0,3
10062 DATA SAMARIUM,5,Sm,A,2,0,2,3
10063 DATA EUROPIUM,5,Eu,A,2,0,2,3
10064 DATA GADOLINIUM,5,Gd,A,1,0,3
10065 DATA TERBIUM,4,Tb,A,2,0,3,4
10066 DATA DYSPROSIUM,7,Dy,A,1,0,3
10067 DATA HOLMIUM,4,Ho,M
10068 DATA ERBIUM,3,Er,A,1,0,3
10069 DATA THULIUM,4,Tm,A,1,0,3
10070 DATA YTTERBIUM,6,Yb,A,2,0,2,3
10071 DATA LUTECIUM,5,Lu,A,1,0,3
10072 DATA HAFNIUM,4,Hf,A,1,0,4
10073 DATA TANTAL,6,Ta,A,0,1,TANTALE,5
10074 DATA WOLFRAM,7,W,A,1,0,6
10075 DATA RHENIUM,4,Re,A,1,0,7
10076 DATA OSMIUM,3,Os,A,3,0,3,4,8
10077 DATA IRIDIUM,4,Ir,A,3,0,3,4,6
10078 DATA PLATINA,6,Pt,A,2,0,2,4
10079 DATA ZLATO,4,Au,A,1,0,3
10080 DATA RTUT,4,Hg,H,2,0,1,2
10081 DATA THALLIUM,4,Tl,A,2,0,1,3
10082 DATA OLOVO,4,Pb,H,2,0,2,4
10083 DATA BISMUT,6,Bi,H,1,0,3
10084 DATA POLONIUM,5,Po,N
10085 DATA ASTAT,5,At,N
10086 DATA RADON,5,Rn,N
10087 DATA FRANCIUM,5,Fr,A,1,0,1
10088 DATA RADIUM,3,Ra,A,1,0,2
10089 DATA AKTINIUM,5,Ac,M
10090 DATA THORIUM,4,Th,A,2,0,3,4
10091 DATA PROTACTINIUM,7,Pa,A,2,1,3,4,PROTAKTI,5
10092 DATA URAN,4,U,H,4,1,2,3,4,6,URANI,5
10093 DATA NEPTUNIUM,6,Np,A,4,1,2,3,4,6,NEPTUNI,5
10094 DATA PLUTONIUM,6,Pu,A,4,1,2,3,4,6,PLUTONI,5
10095 DATA AMERICIUM,6,Am,M
10096 DATA CURIUM,3,Cm,A,1,0,3
10097 DATA BERKELIUM,6,Bk,M
10098 DATA CALIFORNIUM,7,Cf,A,1,0,3
10099 DATA EINSTEINIUM,8,Es,M
10100 DATA FERMIUM,4,Fm,M
10101 DATA MENDELEVIUM,8,Md,M
10102 DATA NOBELIUM,5,No,M
10103 DATA LAVRENCIUM,7,Lr,M
10104 DATA KURCATOVIUM,8,Ku,M
10105 DATA HAHNIUM,4,Ha,M
10999 ------------------------------
11000 DATA ICELY,ISTY,OVY,ECNY,ICNY,ICITY,ITY,NATY,NY
11999 ------------------------------
12000 DATA ICELA,ISTA,OVA,ECNA,ICNA,ICITA,ITA,NATA,NA
12999 ------------------------------
13000 DATA ICELAN,ISTAN,AN,ECNAN,ICNAN,ICITAN,ITAN,NATAN,NAN
13999 ------------------------------
14000 DATA MONO,DI,TRI,TETRA,PENTA,HEXA,HEPTA,OKTA,NONA,DEKA,UNDEKA,DUODEKA
19999 ------------------------------
20000 ? "":IF ERR=136:? " Tak tohle na mne neplati !!!":ELSE:? " Vloudila se chybicka":ENDIF
20001 PAUSE (100):RUN
References
http://flop.atariportal.cz/dir1_27.htm
Listing downloads
Download link 1
Atari 8-bit Source code
