REM    MolM - molecular weight calculator
REM    Copyright (C) 2000  Emil Tchekov

REM    Port for the S80 platform
REM    Adapted and improved version, with overviewed and corrected relative atomic masses.
REM    Copyright (C) 2014  Sami Vuori


REM    This program is free software: you can redistribute it and/or modify
REM    it under the terms of the GNU General Public License as published by
REM    the Free Software Foundation, either version 3 of the License, or
REM    (at your option) any later version.

REM    This program is distributed in the hope that it will be useful,
REM    but WITHOUT ANY WARRANTY; without even the implied warranty of
REM    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
REM    GNU General Public License for more details.

REM    You should have received a copy of the GNU General Public License
REM    along with this program.  If not, see <http://www.gnu.org/licenses/>.

REM    sambonen@gmail.com
REM    emil@tchekov.net


INCLUDE "AppFrame.oxh"

 APP MolM, &2002AA25
 	ICON "C:\SYSTEM\APPS\MOLM\MOLM.MBM"
 ENDA

PROC Mol:
	
	GLOBAL am(105),an$(105,2),n%,l%,m%,pf%,bi$(50,2),bim(50),get%,quit%
 	GLOBAL t$(255),x%,s$(1),ekfl%,nkfl%,mas,pfl%,bic%(50),ch$(255)
	LOCAL kuva%, afstatus%
	quit%=0
	afstatus%=0


	setm:

	DO
		gCLS
		kuva%=gLOADBIT("C:\system\apps\molm\molm2.mbm")

		AfSetCBAButton:(1,"OK",0,0,"HandleCBA")
		AfSetCBAButton:(2,"",0,0,"HandleCBA")
		AfSetCBAButton:(3,"",0,0,"HandleCBA")
		AfSetCBAButton:(4,"Quit",0,0,"HandleCBA")
		AfSetTitle:("MolM",KAfTitleTypeMainTitle%)
	
		AfSetStatus%:(afstatus%)
		AfSetCBAVisible%:(1)
		AfSetStatusVisible%:(1)
		AfSetTitleVisible%:(0)
		AfSetCBAButtonDefault:(1)


		t$=""
		x%=23
		ekfl%=0
		nkfl%=0
		pf%=0
		pfl%=0
		gFONT 8
		gSTYLE 9


		gAT 10,30+7+1
		gPRINT "M"
		gAT 10+gTWIDTH("M"),30+4+1
		gPRINT "("

		DO
			gUSE 1
	
				REM if afstatus%=0
			gSETWIN 92,0,640-92,200

		 	gAT 0,0
		 	gCOPY kuva%,0,0,640,200,0
			REM elseif afstatus%=1
			REM 	gSETWIN 32,0,640-32,200
			REM endif
			
			IF n%=-1982
				n%=13
				BREAK
			ENDIF
			IF n%=-1979
				quit%=1
	TRAP gCLOSE kuva%
				BREAK
			ENDIF



			l%=LEN(t$)
			n%=GET
			s$=CHR$(n%)
			IF n%=8
				refr:
			ENDIF
			gSTYLE 9
			gFONT 8
			IF n%>=48 and n%<=57
				gSTYLE 0
				IF l%=0
					gIPRINT "Ei sallittu!"
				ELSE
					gAT x%+10,35+4+3
					IF ch2: or pfl%
						gAT x%+10,30+4+3+1
						gSTYLE 9
						pfl%=1
					ENDIF
					gPRINT s$
					x%=x%+gTWIDTH(s$)
					t$=t$+s$
				ENDIF
			ENDIF
			IF n%>=97 and n%<=122
				IF l%=0
					gIPRINT "Ei sallittu!"
				ELSEIF ch:
					gIPRINT "Ei sallittu!"
				ELSE
					pfl%=0
					gAT x%+10,30+4+3+1
					gPRINT s$
					x%=x%+gTWIDTH(s$)
					t$=t$+s$
				ENDIF
			ENDIF
			IF n%>=65 and n%<=90
				gAT x%+10,30+4+3+1
				gPRINT s$
				x%=x%+gTWIDTH(s$)
				t$=t$+s$
				pfl%=0
			ENDIF
			IF n%=91
				IF ekfl%=1 or nkfl%=1
					gIPRINT "Ei sallittu!"
				ELSE
					gAT x%+10,30+4+3+1
					gPRINT s$
					x%=x%+gTWIDTH(s$)
					ekfl%=1
					t$=t$+s$
					pfl%=0
				ENDIF
			ENDIF
			IF n%=93
				IF ekfl%=0 or nkfl%=1
					gIPRINT "Ei sallittu!"
				ELSE
					gAT x%+10,30+4+3+1
					gPRINT s$
					x%=x%+gTWIDTH(s$)
					ekfl%=0
					t$=t$+s$
				ENDIF
			ENDIF
			IF n%=40
				IF nkfl%=1
					gIPRINT "Ei sallittu!"
				ELSE
					gAT x%+10,30+4+3+1
					gPRINT s$
					x%=x%+gTWIDTH(s$)
					nkfl%=1
					pfl%=0
					t$=t$+s$
				ENDIF
			ENDIF
			IF n%=41
				IF nkfl%=0
					gIPRINT "Ei sallittu!"
				ELSE
					gAT x%+10,30+4+3+1
					gPRINT s$
					x%=x%+gTWIDTH(s$)
					nkfl%=0
					t$=t$+s$
				ENDIF
			ENDIF
			REM Jos painetaan pistett
			IF n%=46
				IF l%=0
					gIPRINT "Ei sallittu!"
				ELSEIF pf%
					gIPRINT "Ei sallittu!"
				ELSE
					pf%=1
					gAT x%+10,22+4+3+1
					gPRINT s$
					x%=x%+gTWIDTH(s$)
					t$=t$+s$
				ENDIF
			ENDIF
			IF n%=290
				mINIT
				mCARD "Moolimassa","Laske",%l, "Viime tulos", %r ,"Lopeta",%q
rem				mCARD "Nyt","Suuri nytt",%s, "Pieni nytt", %p
				mCARD "Ohje","Tietoa",%a
				m%=MENU
				IF m%=%a
					dINIT "Molar Mass"
					dTEXT "","Freeware from Emil Tchekov",0
					dTEXT "","http://www.tchekov.net",0
					dTEXT "","Copyright (c) Emil Tchekov 2005",0			 
					dTEXT "","emil@tchekov.net"
						dTEXT "","Improved by Sami Vuori 2014"
						dTEXT "","sambonen@gmail.com"
					dBUTTONS "OK", 13
					DIALOG
				ENDIF
				IF m%=%r
					erg:
				ENDIF
rem 				IF m%=%s
rem	AfSetStatus%:(0)
rem	afstatus%=0
rem				ENDIF
rem				IF m%=%p
rem	AfSetStatus%:(1)
rem					afstatus%=1
rem				ENDIF
				IF m%=%q
					quit%=1
					BREAK
				ENDIF
			ENDIF
		UNTIL n%=13
		IF n%=13
			AfSetCBAButton:(1,"New",0,0,"HandleCBA")
			AfSetCBAButtonDefault:(1)
			IF l%=0
				gIPRINT "Anna arvo!"
			ELSE
				gAT x%+10+3,30+4+1
				gPRINT ")"
				gAT x%+gTWIDTH(")")+10+3,30+4+3+1
				gPRINT "="
				mass:
				get%=GET
				IF get%=290
					mINIT
					mCARD "Moolimassa","Laske",%l, "Viime tulos", %r ,"Lopeta",%q
					mCARD "Ohje","Tietoa",%a
					m%=MENU
					IF m%=%a
						dINIT "Molar Mass"
						dTEXT "","Freeware from Emil Tchekov",0
						dTEXT "","http://www.tchekov.net",0
						dTEXT "","Copyright (c) Emil Tchekov 2005",0			 
						dTEXT "","emil@tchekov.net"
						dTEXT "","Improved by Sami Vuori 2014"
						dTEXT "","sambonen@gmail.com"
						dBUTTONS "OK", 13
						DIALOG
					ENDIF
					IF m%=%r
						erg:
					ENDIF
					IF m%=%q
						quit%=1
						TRAP gCLOSE kuva%
						BREAK
					ENDIF
					
				elseif get%=-1979
					quit%=1
					TRAP gCLOSE kuva%
					BREAK
				ENDIF
			ENDIF
		ENDIF
		TRAP gCLOSE kuva%
	UNTIL quit%=1
	TRAP gCLOSE kuva%
ENDP

PROC ch:
	LOCAL na%
	na%=ASC(MID$(t$,l%,1))
	IF na%>=65 and na%<=90
		RETURN 0
	ENDIF
	RETURN 1
ENDP

PROC ch2:
	LOCAL na%
	na%=ASC(MID$(t$,l%,1))
	IF na%<>46
		RETURN 0
	ENDIF
	RETURN 1
ENDP

PROC mass:
	LOCAL f%,ekf%,nkf%,nfl%,kbfl%
	LOCAL a,b,c,s,num%,sa$(2),d,g%
 	LOCAL m(50), fa%(50),el$(50,2),gf%(50)
rem 	LOCAL kokonaisluvut%,desimaalit,desimaalit%,kokonaisluvut$(20),desimaalit$(20),tuloste$(20)
		gSTYLE 0
	b=LEN(t$)
	a=0
	DO
		a=a+1
		bi$(a)=""
		bim(a)=0
		bic%(a)=0
	UNTIL a=50
	a=0
	mas=0
	d=0
	f%=1
	ekf%=1
	nkf%=1
	kbfl%=0
	nfl%=-1
	num%=0
	IF b=0
		RETURN 0
	ENDIF
	b=b+1
	DO
		b=b-1
		n%=ASC(MID$(t$,b,1))
		IF n%>=97 and n%<=122
			kbfl%=n%
			nfl%=-1
			f%=num%
			num%=0
			IF f%=0
				f%=1
			ENDIF
		ENDIF
		IF n%>=48 and n%<=57
			nfl%=nfl%+1
			num%=num%+(n%-48)*(10**nfl%)
		ENDIF
		IF n%=93
			nfl%=-1
			ekf%=num%
			num%=0
			IF ekf%=0
				ekf%=1
			ENDIF
		ENDIF
		IF n%=91
			ekf%=1
		ENDIF
		IF n%=41
			nfl%=-1
			nkf%=num%
			num%=0
			IF nkf%=0
				nkf%=1
			ENDIF
		ENDIF
		IF n%=46
			nfl%=-1
			g%=num%
			num%=0
			d=d+1
			el$(d)="::"
		ENDIF
		IF n%=40
			nkf%=1
		ENDIF
		IF n%>=65 and n%<=90
			IF kbfl%=0
				sa$=CHR$(n%)
				nfl%=-1
				f%=num%
				num%=0
				IF f%=0
					f%=1
				ENDIF
			ELSE
				sa$=CHR$(n%)+CHR$(kbfl%)
				kbfl%=0
			ENDIF
			a=0
			c=0
			DO
				a=a+1
				IF an$(a)=sa$
					c=am(a)
				ENDIF
			UNTIL a=105
			IF c=0
				gSTYLE 0
				gPRINT " "+sa$+"?,"
			ENDIF
			IF c<>0
				d=d+1
				el$(d)=sa$
				m(d)=c
				IF g%=0
					g%=1
				ENDIF
				gf%(d)=g%
				fa%(d)=f%*ekf%*nkf%
				f%=1
			ENDIF
		ENDIF
	UNTIL b=1
	IF d=0
		f%=ALERT(t$+" ei sisll","tunnettuja alkuaineita!","Jatka")
		RETURN 0
	ENDIF
	ch$=t$
	a=0
	AT 1,10
	b=0
	DO
		a=a+1
		IF el$(a)="::"
			pf%=1
			pfl%=gf%(a+1)
			DO
				b=b+1
				gf%(b)=pfl%
			UNTIL b=a-1
			b=a
		ENDIF
		IF pf%
			gf%(a)=1
		ENDIF
	UNTIL a=d
	IF b<>0
		a=b
		DO
			el$(a)=el$(a+1)
			fa%(a)=fa%(a+1)
			gf%(a)=gf%(a+1)
			m(a)=m(a+1)
			a=a+1
		UNTIL a=d
		d=d-1
	ENDIF
	a=0
	DO
		a=a+1
		sa$=el$(a)
		f%=fa%(a)*gf%(a)
		b=a
		DO
			b=b+1
			IF b<=d and el$(b)=sa$
				f%=f%+fa%(b)*gf%(b)
				m(b)=0
				el$(b)=""
				gf%(b)=0
				fa%(b)=0
			ENDIF
		UNTIL b>=d
		fa%(a)=f%
		gf%(a)=1
	UNTIL a=d
	a=0
	b=0
	DO
		a=a+1
		IF el$(a)<>""
			b=b+1
			bi$(b)=el$(a)
			bim(b)=m(a)
			bic%(b)=fa%(a)
		ENDIF
	UNTIL a=d
	a=0
	x%=10
	gAT x%+10,77
	gPRINT "="
	x%=25
	DO
		a=a+1
		t$=FIX$(bic%(a),0,3)+"xM("+bi$(a)+")"
		IF a<>b
			t$=t$+"+"
		ENDIF
		gAT x%+10,77
		gPRINT t$
		x%=x%+gTWIDTH(t$)
	UNTIL a=b
	a=0
	gAT x%+10+3,77
	gPRINT "="
	x%=10
	gAT x%+10,107
	gPRINT "="
	x%=25
	DO
		a=a+1
		t$=FIX$(bic%(a),0,3)+"xM("+FIX$(bim(a),3,7)+")"
		IF a<>b
			t$=t$+"+"
		ENDIF
		gAT x%+10,107
		gPRINT t$
		x%=x%+gTWIDTH(t$)
	UNTIL a=b
	a=0
	gAT x%+10+3,107
	gPRINT "="
	x%=10
	gAT x%+10,137
	gPRINT "="
	x%=25
	DO
		a=a+1
		t$=FIX$(bic%(a)*bim(a),3,7)
		IF a<>b
			t$=t$+"+"
		ENDIF
		gAT x%+10,137
		gPRINT t$
		x%=x%+gTWIDTH(t$)
		mas=mas+bim(a)*bic%(a)
	UNTIL a=b
	gAT x%+10+3,137
	gPRINT "="
	x%=10
	gAT x%+10,183
	gSTYLE 9
	gPRINT "="
	x%=25	
	gAT x%+10,183
rem 	kokonaisluvut%=INT(mas)
rem	desimaalit=mas-kokonaisluvut%
rem	desimaalit%=desimaalit*1000
rem	kokonaisluvut$=GEN$(kokonaisluvut%,4)
rem	IF desimaalit%<1000
rem		IF desimaalit%<100
rem			IF desimaalit%<10
rem				IF desimaalit%=0
rem					desimaalit$="000"
rem				ELSE
rem					desimaalit$="00"+GEN$(desimaalit%,4)
rem				ENDIF
rem			ELSE
rem				desimaalit$="0"+GEN$(desimaalit%,4)
rem			ENDIF
rem		ELSE
rem			desimaalit$=GEN$(desimaalit%,4)
rem		ENDIF
rem	ENDIF
rem	tuloste$=kokonaisluvut$+","+desimaalit$
	gPRINT mas," g/mol" REM mas,"g/mol"
	gIPRINT "Paina jotain nappia..."
ENDP

PROC refr:
	LOCAL b%,na%,sx$(1)
	gCLS
	gAT 10,30+4+3+1
	gFONT 8
	gSTYLE 9
		gAT 10,30+7+1
		gPRINT "M"
		gAT 10+gTWIDTH("M"),30+4+1
		gPRINT "("
	x%=23
	b%=0
	IF LEN(t$)<2
		t$=""
		nkfl%=0
		ekfl%=0
		pf%=0
		pfl%=0
	ELSEIF LEN(t$)=2
		gAT x%+10,30+4+3+1
		t$=LEFT$(t$,1)
		na%=ASC(t$)
	REM Sulku auki
		IF na%=40
			nkfl%=1
		ENDIF
		IF na%=91
			ekfl%=1
		ENDIF
	REM Piste
		IF na%=46
			pf%=1
			pfl%=1
		ENDIF
		gSTYLE 9
	REM Jos vasemmanpuoleinen merkki on numero
		IF na%>=48 and na%<=57 and pf%<>1
			gSTYLE 0
		ENDIF
		gPRINT t$
		x%=x%+gTWIDTH(t$)
	ELSE
		sx$=RIGHT$(t$,1)
		t$=LEFT$(t$,LEN(t$)-1)
		na%=ASC(sx$)
	REM Sulku kiinni
		IF na%=41
			nkfl%=1
		ENDIF
		IF na%=93
			ekfl%=1
		ENDIF
		IF na%=40
			nkfl%=0
		ENDIF
		IF na%=91
			ekfl%=0
		ENDIF
	REM Piste
		IF na%=46
			pf%=0
			pfl%=0
		ENDIF
		DO
			b%=b%+1
			gAT x%+10,30+4+3+1
			sx$=MID$(t$,b%,1)
			na%=ASC(sx$)
			IF na%=46
				gAT x%+10,22+4+3+1
				pfl%=1
				pf%=1
			ENDIF
			IF (na%>=65 and na%<=97) or na%=40 or na%=91
				pfl%=0
			ENDIF
			gSTYLE 9
			IF na%>=48 and na%<=57 and pfl%<>1
				gAT x%+10,35+4+3
				gSTYLE 0
			ENDIF
			gPRINT sx$
			x%=x%+gTWIDTH(sx$)
		UNTIL  b%=LEN(t$)
	ENDIF
ENDP

PROC erg:
	LOCAL e$(255)
	e$=FIX$(mas,6,20)
	dINIT "Moolimassa"
	dEDIT e$,"M g/mol= ",20
	dBUTTONS "OK", 13
	DIALOG
ENDP

PROC setm:

	am(1)=1.008
	am(2)=4.003
	am(3)=6.941
	am(4)=9.012
	am(5)=10.81
	am(6)=12.011
	am(7)=14.007
	am(8)=15.999
	am(9)=18.998
	am(10)=20.180
	am(11)=22.990
	am(12)=24.305
	am(13)=26.982
	am(14)=28.085
	am(15)=30.974
	am(16)=32.06
	am(17)=35.453
	am(18)=39.948
	am(19)=39.098
	am(20)=40.078
	am(21)=44.956
	am(22)=47.867
	am(23)=50.942
	am(24)=51.996
	am(25)=54.938 REM thn asti
	am(26)=55.85
	am(27)=58.93
	am(28)=58.70
	am(29)=63.55
	am(30)=65.38
	am(31)=69.72
	am(32)=72.59
	am(33)=74.92
	am(34)=78.96
	am(35)=79.9
	am(36)=83.8
	am(37)=85.47
	am(38)=87.62
	am(39)=88.91
	am(40)=91.22
	am(41)=92.91
	am(42)=95.94
	am(43)=97
	am(44)=101.07
	am(45)=102.91
	am(46)=106.4
	am(47)=107.87
	am(48)=112.41
	am(49)=114.82
	am(50)=118.69
	am(51)=121.75
	am(52)=127.6
	am(53)=126.9
	am(54)=131.3
	am(55)=132.91
	am(56)=137.33
	am(57)=138.91
	am(58)=140.12
	am(59)=140.91
	am(60)=144.24
	am(61)=145
	am(62)=150.4
	am(63)=151.96
	am(64)=157.25
	am(65)=158.93
	am(66)=162.5
	am(67)=164.93
	am(68)=167.26
	am(69)=168.93
	am(70)=173.04
	am(71)=147.97
	am(72)=178.49
	am(73)=180.95
	am(74)=183.85
	am(75)=186.2
	am(76)=190.2
	am(77)=192.2
	am(78)=195.1
	am(79)=196.97
	am(80)=200.59
	am(81)=204.37
	am(82)=207.2
	am(83)=208.98
	am(84)=209
	am(85)=210
	am(86)=222
	am(87)=223
	am(88)=226.05
	am(89)=227.028
	am(90)=232.038
	am(91)=231.036
	am(92)=238.029
	am(93)=237.048
	am(94)=244
	am(95)=243
	am(96)=247
	am(97)=247
	am(98)=251
	am(99)=254
	am(100)=257
	am(101)=258
	am(102)=259
	am(103)=260
	am(104)=261
	am(105)=262
	an$(1)="H"
	an$(2)="He"
	an$(3)="Li"
	an$(4)="Be"
	an$(5)="B"
	an$(6)="C"
	an$(7)="N"
	an$(8)="O"
	an$(9)="F"
	an$(10)="Ne"
	an$(11)="Na"
	an$(12)="Mg"
	an$(13)="Al"
	an$(14)="Si"
	an$(15)="P"
	an$(16)="S"
	an$(17)="Cl"
	an$(18)="Ar"
	an$(19)="K"
	an$(20)="Ca"
	an$(21)="Sc"
	an$(22)="Ti"
	an$(23)="V"
	an$(24)="Cr"
	an$(25)="Mn"
	an$(26)="Fe"
	an$(27)="Co"
	an$(28)="Ni"
	an$(29)="Cu"
	an$(30)="Zn"
	an$(31)="Ga"
	an$(32)="Ge"
	an$(33)="As"
	an$(34)="Se"
	an$(35)="Br"
	an$(36)="Kr"
	an$(37)="Rb"
	an$(38)="Sr"
	an$(39)="Y"
	an$(40)="Zr"
	an$(41)="Nb"
	an$(42)="Mo"
	an$(43)="Tc"
	an$(44)="Ru"
	an$(45)="Ro"
	an$(46)="Pd"
	an$(47)="Ag"
	an$(48)="Cd"
	an$(49)="In"
	an$(50)="Sn"
	an$(51)="Sb"
	an$(52)="Te"
	an$(53)="I"
	an$(54)="Xe"
	an$(55)="Cs"
	an$(56)="Ba"
	an$(57)="La"
	an$(58)="Ce"
	an$(59)="Pr"
	an$(60)="Nd"
	an$(61)="Pm"
	an$(62)="Sm"
	an$(63)="Eu"
	an$(64)="Gd"
	an$(65)="Tb"
	an$(66)="Dy"
	an$(67)="Ho"
	an$(68)="Er"
	an$(69)="Tm"
	an$(70)="Yb"
	an$(71)="Lu"
	an$(72)="Hf"
	an$(73)="Ta"
	an$(74)="W"
	an$(75)="Re"
	an$(76)="Os"
	an$(77)="Ir"
	an$(78)="Pt"
	an$(79)="Au"
	an$(80)="Hg"
	an$(81)="Tl"
	an$(82)="Pb"
	an$(83)="Bi"
	an$(84)="Po"
	an$(85)="At"
	an$(86)="Rn"
	an$(87)="Fr"
	an$(88)="Ra"
	an$(89)="Ac"
	an$(90)="Th"
	an$(91)="Pa"
	an$(92)="U"
	an$(93)="Np"
	an$(94)="Pu"
	an$(95)="Am"
	an$(96)="Cm"
	an$(97)="Bk"
	an$(98)="Cf"
	an$(99)="Es"
	an$(100)="Fm"
	an$(101)="Md"
	an$(102)="No"
	an$(103)="Lr"
	an$(104)="Rf"
	an$(105)="Db"

ENDP
