REM Empirical Formulae
      REM By R.G.Weston Revised 2002/02/21
      MODE7
      OFF
      PROCintro
      MODE8
      PROCinit:PROCelements
      DIM X$(7),X(7),RAM(7),char$(30),temp$(30),check$(10)
      SF=9.3
      VDU5
      number=0
      REPEAT
        PROCelements
        number=number+1
        PROCgetdata
        CLS
        PROCmassratio
        GCOL0,1
        MOVE0,550:PRINT;STRING$(40," .")
        G=GET
        PROCmoleratio
        PROCfindsmallest
        G=GET
        PROCmarksteps
        G=GET
        MOVE200,1000:GCOL0,2
        PRINT;"Empirical Formula is ";FNreadchem(F$)
        G=GET:CLS:MOVE 300,500:PRINT"One moment, please......."
      UNTIL F$="FIN"
      VDU4
      END
      :
      DEF PROCgetdata
      RESTORE 2000
      FOR N%=1 TO number
        READ F$
      NEXT N%
      IF F$="FIN" THEN END
      PROCformulatopercent(F$)
      FOR j=no_of_el+1 TO 7
        X$(j)="":X(j)=0:RAM(j)=.01:NEXT
      ENDPROC
      :
      DEF PROCmassratio
      @%=&20109
      GCOL0,1:MOVE 450,30:PRINT;"MASS RATIO"
      FOR N=1 TO 5
        GCOL0,1+(N MOD 3)
        IF X(N)<>0 THEN MOVE 0,N*100:DRAW X(N)*SF,N*100:MOVE0,(N*100)-20:PRINT;INT((X(N))*10)/10;"% ";X$(N):MOVE 900,(N*100)-20:PRINT;"(";X$(N);"=";RAM(N);")"
      NEXT N
      ENDPROC
      :
      DEF PROCmoleratio
      @%=&20309
      GCOL0,1:MOVE 450,570:PRINT;"MOLE RATIO"
      FOR N=1 TO 5
        GCOL0,1+(N MOD 3)
        IF X(N)<>0 THEN MOVE 0,(N+5)*100:DRAW X(N)/RAM(N)*SF*10,(N+5)*100 :MOVE 0,((N+5)*100)-20:PRINT;X(N)/RAM(N);"mol ";X$(N)
      NEXT
      ENDPROC
      :
      DEF PROCfindsmallest
      smallest=1000
      FOR N= 1 TO 5
        IF X(N)<>0 THEN IF X(N)/RAM(N) <smallest THEN smallest=X(N)/RAM(N)
      NEXT N
      ENDPROC
      :
      DEF PROCmarksteps
      FOR N= 1 TO 5
        GCOL0,1+(N MOD 3)
        IF X(N)=0 THEN GCOL0,0
        steps=INT(((X(N)/RAM(N))/smallest) +.5)
        y=(N+5)*100
        FOR J=0 TO steps
          MOVE J*SF*10*smallest,y-5
          PLOT1,0,10
        NEXT J
      NEXT N
      ENDPROC
      :
      DEF PROCintro
      col=133
      PRINTTAB(3,5)CHR$141;CHR$col;"EMPIRICAL FORMULAE MADE EASY..."
      PRINTTAB(3,6)CHR$141;CHR$col;"EMPIRICAL FORMULAE MADE EASY..."
      PRINT'''TAB(3)"Just keep pressing the space bar"
      G=GET
      ENDPROC
      :
      DEF PROCformulatopercent(F$)
      FOR pos=1 TO LEN(F$)
        char$(pos)=MID$(F$,pos,1)
      NEXT pos
      :
      FOR pos=1 TO LEN(F$)
        IF char$(pos)="(" AND char$(pos-1)<>"" THEN char$(pos)="+"+char$(pos)
        :
        IF ASC(char$(pos))>64 AND ASC(char$(pos))<91 AND char$(pos-1)<>"" AND RIGHT$(char$(pos-1),1)<>"(" THEN char$(pos)="+"+char$(pos):REM Capital Letter.
        :
        IF ASC(char$(pos))>47 AND ASC(char$(pos))<58 AND ( ASC(RIGHT$(char$(pos-1),1))<48 OR ASC(RIGHT$(char$(pos-1),1))>57 )THEN char$(pos)="*"+char$(pos):REM a number without one on its left.
      NEXT pos
      FOR pos=1 TO LEN(F$)
        IF ASC(char$(pos))>96 AND ASC(char$(pos))<123 THEN  char$(pos-1)=char$(pos-1)+char$(pos):char$(pos)=""
      NEXT pos
      new$=""
      FOR pos=1 TO LEN(F$)
        new$=new$+char$(pos)
      NEXT pos
      MM=EVAL(new$)
      PROCpercent
      ENDPROC
      :
      DEFPROCinit
      VDU19,1,2,0,0,0
      VDU19,2,5,0,0,0
      VDU23,230,&0,&0,&0,&3C,&24,&24,&24,&3C
      VDU23,231,&00,&00,&00,&08,&08,&08,&08,&08
      VDU23,232,&00,&00,&00,&7C,&44,&18,&30,&7C
      VDU23,233,&00,&00,&00,&7C,&04,&3C,&04,&7C
      VDU23,234,&00,&00,&00,&18,&28,&48,&FC,&08
      VDU23,235,&00,&00,&00,&3C,&20,&3C,&04,&3C
      VDU23,236,&00,&00,&00,&3E,&20,&3E,&22,&3E
      VDU23,237,&00,&00,&00,&3E,&22,&04,&08,&10
      VDU23,238,&00,&00,&00,&3C,&24,&3C,&24,&3C
      VDU23,239,&00,&00,&00,&3C,&24,&3C,&04,&04
      VDU23,240,&18,&18,&7E,&7E,&18,&18,&0,&0
      VDU23,241,&0,&7E,&0,&0,&0,&0,&0,&0
      ENDPROC
      :
      DEF FNreadchem(F$)
      f$=""
      FOR pos%=1 TO LEN(F$)
        char$=MID$(F$,pos%,1)
        a%=ASC(char$)
        IF a%>47 AND a%<57 THEN a%=a%+182:REM  small numbers
        char$=CHR$(a%)
        f$=f$+char$
      NEXT
      =f$
      :
      DEF PROCelements
      Al=27:Ar=40:As=75:Ba=137:B=10.81
      Br=80:Cs=133:Ca=40:C=12:Cl=35.5
      Cr=52:F=19:Au=197:He=4:H=1:I=127
      Fe=56:Pb=207:Li=7:Mg=24:Mn=55
      Hg=201:Ne=20:Ni=59:N=14:O=16
      P=31:Pt=195:K=39:Rb=85:Si=28
      Ag=108:Na=23:S=32:Sn=119:U=238
      Zn=65:Cu=63.5
      ENDPROC
      :
 1610 DATA Al,Ar,As,Ba,B,Br,Cs,Ca,C,Cl,Cr,F,Au,He,H,I,Fe,Pb,Li,Mg,Mn,Hg,Ne,Ni,N,O,P,Pt,K,Rb,Si,Ag,Na,S,Sn,U,Zn,Cu,*
      :
      DEF PROCpercent
      @%=&20309
      flag=0:no_of_el=0
      FOR J=1 TO LEN(F$)
        RESTORE 1610
        REPEAT
          READ el$
          IF el$=RIGHT$(char$(J),1) OR el$= RIGHT$(char$(J),2) THEN flag=flag+1:check$(flag)=el$:PROCprintpc
        UNTIL el$="*"
      NEXT J
      ENDPROC
      :
      DEF PROCprintpc
      COLOUR3:@%=&20309
      alreadyfound=FALSE
      FOR x=0 TO flag-1
        IF check$(x)=check$(flag) THEN alreadyfound=TRUE
      NEXT x
      IF alreadyfound THEN ENDPROC
      no_of_el=no_of_el+1
      FOR L=0 TO LEN(F$)
        temp$(L)=char$(L)
      NEXT L
      FOR X=1 TO LEN(F$)
        IF el$=RIGHT$(char$(X),1)THEN temp$(X)=temp$(X)+"*0"
        IF el$= RIGHT$(char$(X),2) THEN     temp$(X)=temp$(X)+"*0"
      NEXT X
      new2$=""
      FOR L=0 TO LEN(F$)
        new2$=new2$+temp$(L)
      NEXT L
      mass_of_el=EVAL(new2$)
      X(no_of_el)=100-(mass_of_el*100/MM)
      X$(no_of_el)=el$
      RAM(no_of_el)=EVAL(el$)
      ENDPROC
      :
 2000 DATA K4Fe(CN)6,SF6,CH4O,Na3AlF6,P2O5,Pb(NO3)2,Fe(NO3)3,SiO2,PCl5,IF7,H3PO4,FIN