Remstart
Segan's Calculator
 
Features:
 
-All the normal arithmatic functions (+, -, *, /, ^, sqrt)
-Additional built-in functions 
	sin, cos, tan, arcsin, arccos, arctan
	sqrt, abs, roundup(ceil), rounddown(floor), wrap, factorial
-You can use variables (all capital letters are assumed to be variables).
	assign variables using "store" function.
-Enter will repeat last equation.
-Use "ans" when you want to use the last answer.
 
-Error catching: Catches most typo style errors
-Assumes "*" correctly
-Differenciates between when "-" is used as substraction or as a negative sign
-Automatically closes all pairs of brackets not already closed.
 
-POWERFUL CONSTANT SYSTEM
	It works exactly like #constant in DBPro. Search for it in the code for more info. 
	Constants supported: pi, e, m_earth, g
	Shortcuts supported: asin for arcsin, floor for rounddown, wrapvalue for wrap etc. 
	AND IT'S EASY AS 3.14 TO ADD MORE!!!!!
Remend
 
 
 
Gosub Init_Constants
Gosub Init_Globals
 
While 1
	GblError = 0
	Input "Equation: ", Eq$
	Print "          ", Evaluate(Eq$)
	If GblError = 1 Then cls
Endwhile
 
End
 
 
 
Function Evaluate(Equation$)
	Remstart
	This function will evaluate math equations entered as strings.
 
	Features:
 
	Remend
 
	`I need to add brackets so that the entire question will be solved.
	If Equation$ = "" Then Equation$ = GblLastEq
	GblLastEq = Equation$
 
	Equation$ = "("+Equation$+")"
 
	`Step 1: Parse the Equation
	SignNeeded = 0
 
	For x = 1 To Len(Equation$)
		a$ = Mid$(Equation$, x)
 
 
		`Case: Open Brackets
		If a$ = "(" 
			If SignNeeded = 1 Then Save_Element("*",Sign)
			Save_Element("(", oBkt)
			SignNeeded = 0
			inc numopen, 1
		Endif
 
 
		`Case: Close brackets
		If a$ = ")" 
			If SignNeeded = 0 And Endbracketok = 0 Then Error_Message("Error in equation.")
			Save_Element(")", cBkt)
			SignNeeded = 1
			Endbracketok = 0
			inc numclosed, 1
		Endif
 
 
		`Case: Basic Sign
		If a$ = "+" Or a$ = "*" Or a$ = "/" Or a$ = "^" Or (SignNeeded = 1 And a$ = "-")
			If SignNeeded = 0 Then Error_Message("Illegal use of sign")
			Save_Element(a$, Sign)
			SignNeeded = 0
			a$ = "done!" `This line is necessary so that two negative signs are not added together.
		endif
 
		`Case: Number
		If a$ = "." or a$ = "0" or a$ = "1" or a$ = "2" or a$ = "3" or a$ = "4" or a$ = "5" or a$ = "6" or a$ = "7" or a$ = "8" or a$ = "9" or (SignNeeded = 0 And a$ = "-")
			If SignNeeded = 1 Then Save_Element("*", Sign)
			tx = x
			numdone = 0
			`Continue reading string until entire number read
			Repeat
				inc tx,1
				ta$ = Mid$(Equation$, tx)
				If ta$ = "." or ta$ = "0" or ta$ = "1" or ta$ = "2" or ta$ = "3" or ta$ = "4" or ta$ = "5" or ta$ = "6" or ta$ = "7" or ta$ = "8" or ta$ = "9" or ta$ = " "
					If ta$ <> " " Then a$ = a$ + ta$
				Else
					x = tx-1
					numdone = 1
				Endif
			Until numdone = 1
 
			If a$ = "-" Then a$ = "-1"
			Save_Element(a$, Num)
			SignNeeded = 1
		endif
 
		`Case: lower-case string (either function, constant or command)
		If lowercase(a$) = 1
			If SignNeeded = 1 Then Save_Element("*",Sign)
 
			tx = x
			numdone = 0
			`Continue reading string until entire command read
			Repeat
				inc tx,1
				ta$ = Mid$(Equation$, tx)
				If lowercase(ta$) = 1 
					a$ = a$ + ta$
				Else
					numdone = 1
				Endif
			Until numdone = 1
 
			NoError = 0
			`Case: Function used
			For c = 1 To Array Count(Complex(0))
				If a$ = Complex(c).Sign					
					x = tx-1
					Save_Element(a$, Cpx)
					NoError = 1
				Endif
			Next C 
			`Case: Constant used
			For c = 1 To Array Count(Constants(0))
				If a$ = Constants(c).Name
					Equation$ = DeleteItems$(Equation$, x, tx-1)
					Equation$ = InsertString$(Equation$, x, Constants(c).Value)
					Dec x, 1
					NoError = 1
				endif										
			Next c 
			SignNeeded = 0
 
			`Case: Command used
			For c = 1 To Array Count(Command(0))
				If a$ = Command(c).Sign
					x = tx-1
					If a$ = "ans" Then Save_Element(str$(GblLastAns), Num): SignNeeded = 1
					If a$ = "store"
						Delete_Element(Array Count(Element(0)))
						Repeat 
							inc x, 1: If x > Len(Equation$) Then Error_Message("Error: Illegal use of store function.")
							a$ = Mid$(Equation$, x)
						Until a$ <> " "
						If Uppercase(a$) <> 1 Then Error_Message("Error: Illegal use of store function.")
						Save_Element(a$, Var)
 
						SignNeeded = 0: Endbracketok = 1
						a$ = "done"
					endif
					NoError = 1
				endif
			next c
 
			If NoError = 0 Then Error_Message("Error: TYPO!!!")
		endif
 
		`Case: Variable
		If Uppercase(a$) = 1 
			If SignNeeded = 1 Then Save_Element("*", Sign)
			ascval = asc(a$) -64
			Save_Element(str$(Variables(ascval).Value), Num)
			SignNeeded = 1						
		endif
 
		If GblError = 1 Then Goto Exit_Evaluate_Function
 
	next x
 
	`Append on any extra brackets that weren't done manually
	For x = 1 To (numopen-numclosed)
		Save_Element(")", cBkt)
 
	next x
 
	`Step 2: Check for brackets and solve each individual part seperately
	StartBrackets = 1
 
	While StartBrackets <> 0
		StartBrackets = Find_e_Type(oBkt, 1)
 
		If StartBrackets <> 0
 
			Repeat
				EndBrackets = Find_e_Type(cBkt, StartBrackets)
				If EndBrackets = 0 Then Error_Message("Error: No End Brackets"): Goto Exit_Evaluate_Function
 
				Check = Find_e_Type(oBkt,StartBrackets+1)
				If Check < EndBrackets And Check <> 0 Then StartBrackets = Check
 
			Until Check <> StartBrackets
 
			`Print StartBrackets
			`Print EndBrackets
 
			Solve(StartBrackets+1, EndBrackets-1)
			`Debug_Array()
			Delete_Element(StartBrackets)
			Delete_Element(StartBrackets+1)
			`Debug_Array()
		endif
 
	EndWhile
 
	If Array COunt(Element(0)) > 1 Then Error_Message("Too Many items in array!")
 
 
	ReturnVal# = val(Element(1).e)
	Delete_Element(1)
 
	`If there was an error, exit the function kindly
	Exit_Evaluate_Function:
	If GblError = 1
		While Array Count(Element(0)) > 0
			Delete_Element(1)
		endwhile
		ExitFunction 0.0
	Endif
 
	GblLastAns = ReturnVal#
endfunction ReturnVal#
 
 
Function Solve(Startpos, EndPos)
	`Do 6 Pases of the equation, checking for each set in the "order of operations."
 
	`Pass 1: Check for all complex:
	ComplexFound = 1
	While ComplexFound <> 0
		ComplexFound = 0
		For pos = Startpos To EndPos
			If Element(pos).ttype = Cpx 
				e$ = Element(pos).e
				SolveSimple(pos)
				ComplexFound = 1
				Dec EndPos, 1
			Endif	
		next pos
	endwhile
 
	`Pass 2-4: Check for all the other types of stuff
	For order = 1 To 3
		Signfound = 1
		While Signfound <> 0
			Signfound = 0
 
			For pos = Startpos To EndPos
				If Element(pos).ttype = Sign 
					e$ = Element(pos).e
					If (e$= "^" And order = 1) OR (e$ = "*" And order = 2) OR (e$ = "/" And order = 2) OR (e$ = "+" And order = 3) OR (e$ = "-" And order = 3)
						SolveSimple(pos)
						Signfound = 1
						Dec EndPos, 2			
					endif							
				Endif
			Next x	
		Endwhile
	Next Order
 
	`Pass 5: Check for "store" command
	For pos = Startpos To EndPos
		If Element(pos).ttype = Var
			ascval = asc(Element(pos).e)-64
			Variables(ascval).value = val(Element(pos-1).e)
			Delete_Element(pos)
			Dec EndPos, 1
		endif
 
	next pos
 
endfunction
 
Function SolveSimple(pos)
	Local e As String
	e = Element(pos).e
	`If Element(pos).ttype <> cpx Then 
	prevnum# = val(Element(pos-1).e)
	nextnum# = val(Element(pos+1).e)
 
	`Step 1: evaluate
	`i) The basic stuff:
	If e = "+" Then nextnum# = prevnum# + nextnum#
	If e = "-" Then nextnum# = prevnum# - nextnum#
	If e = "*" Then nextnum# = prevnum# * nextnum#
	If e = "/" Then nextnum# = prevnum# / nextnum#
	If e = "^" Then nextnum# = prevnum# ^ nextnum#
 
	`ii) Trig stuff
	If e = "sin" Then nextnum# = sin(nextnum#)
	If e = "cos" Then nextnum# = cos(nextnum#)
	If e = "tan" Then nextnum# = tan(nextnum#)
	If e = "arcsin" Then nextnum# = asin(nextnum#)
	If e = "arccos" Then nextnum# = acos(nextnum#)
	If e = "arctan" Then nextnum# = atan(nextnum#)
 
	`iii) Miscellaneous
	If e = "sqrt" Then Nextnum# = sqrt(nextnum#)
	If e = "abs" Then Nextnum# = abs(nextnum#)
	If e = "roundup" Then Nextnum# = ceil(nextnum#)
	If e = "rounddown" Then Nextnum# = floor(nextnum#)
	If e = "wrap" Then Nextnum# = wrapvalue(nextnum#)
	If e = "factorial" Then Nextnum# = factorial(nextnum#)
 
	`Step 2: Replace and delete
	If Element(pos).ttype = sign 
		Element(pos+1).e = str$(nextnum#)
		Delete_Element(pos)
		Delete_Element(pos-1)
	endif
 
	If Element(pos).ttype = cpx 
		Element(pos+1).e = str$(nextnum#)
		Delete_Element(pos)		
	endif
 
 
endfunction
 
Function Delete_Element(E_num)
	Array Delete Element Element(0), E_num	
endfunction
 
Function Save_Element(element$, e_type)
	Add to queue Element(0)
	E_num = Array Count(Element(0))
 
	Element(E_num).e = element$
	Element(E_num).ttype = e_type	
endfunction
 
Function Find_e_Type(etype,start)
	For x = start To Array Count(Element(0))
		If Element(x).ttype = etype Then Exitfunction x
	next x	
endfunction 0
 
Function lowercase(astr$)
	If Len(astr$) = 1
		If asc(astr$) > 96 And asc(astr$) < 123 Then Exitfunction 1
		If astr$ = "_" Then ExitFunction 1	
	Endif
endfunction 0
 
Function uppercase(astr$)
	If Len(astr$) = 1
		If asc(astr$) > 64 AND asc(astr$) < 91 Then Exitfunction 1
	endif	
endfunction 0
 
Function ExpandMid$(astr$, start, number)
	Remstart
	For those who don't have this command already in a DLL (such as IanM's great
	DLL), or those in the coding competitition, this works!
	Remend
	For x = 0 To Number-1
		returnvar$ = returnvar$ + Mid$(astr$,start+x)		
	next x
endfunction returnvar$
 
Function DeleteItems$(astr$, d_start, d_end)
	Remstart
	Deletes all the items in a string from "start" to "end"
	Remend
	newstr$ = ExpandMid$(astr$, 1, d_start-1)+ExpandMid$(astr$, d_end+1, Len(astr$))
endfunction newstr$
 
Function InsertString$(astr$, start, insert$)
	newstr$ = ExpandMid$(astr$, 1, start-1)+insert$+ExpandMid$(astr$,start, Len(astr$))	
endfunction newstr$
 
 
Function Error_Message(txt$)
	If GblError = 0
		cls
		center text Screen Width()/2, Screen Height()/2, txt$
		Sync: Sync
		Wait Key
		cls
	Endif
	GblError = 1
	`Debug_Array()
endfunction
 
Function Debug_Array()
cls
For x = 1 TO Array Count(Element(0))
	Print Element(x).ttype, "      ", Element(x).e
next x
Wait Key
Endfunction
 
Function factorial(value#)
	returnval# = 1
	For x = 1 To value#
		returnval# = returnval#*x
	next x
endfunction returnval#
 
 
`---------------------------------------------------------
Init_Constants:
`---------------------------------------------------------
`CONSTANTS
`These act just like the #constant command in DBPro.
`DBPro: 				#Constant pi 3.14
`Equation Solver: Data "pi", "3.14"
 
`Notes:
`-All constants should be lower-case letters and underscores.  
` (All capitals will be interperated as variables.)
`-DO NOT use the same word as 2 constants or as a constant and a complex.
`-however, "avar" and "var" can both be used. 
 
Data "StartConstants"
 
Data "pi", "3.141592654"				`pi
Data "m_earth", "(5.98*10.0^24.0)" 	`The mass of the earth
Data "g", "9.81"							`gravitational feild strength on the surface of the earth
Data "e", "2.71828182" 
 
 
Data "asin", "arcsin"
Data "acos", "arccos"
Data "atan", "arctan"
Data "floor", "rounddown"
Data "ceil", "roundup"
Data "wrapvalue", "wrap"
Data "fact", "factorial"
 
Data "a", "ans"
Data "s", "store"
 
Data "EndConstants"
 
 
 
Type Constant
	Name As String
	Value As String
endtype
 
Dim Constants(0) As Constant
 
 
 
Read TheData$
If TheData$ <> "StartConstants" Then Error_Message("Error: Data is not correct."): End
 
Repeat
	Read TheData$
 
	If TheData$ <> "EndConstants" 
		Add To Queue Constants(0)
		C_Num = Array Count(Constants(0))
 
		Constants(C_Num).Name = TheData$
		Read TheData$
		Constants(C_Num).Value = TheData$
 
	endif
 
 
until TheData$ = "EndConstants"
 
Type Variable
	Name As String
	Value As Float	
endtype
 
 
Dim Variables(26) As Variable
 
 
For x = 1 To 26
	ascval = x + 64
	Variables(x).Name = str$(ascval)
	Variables(x).Value = 0.0
next x
 
 
Return
 
 
Init_Globals:
 
Global GblError As Boolean: GblError = 0
 
Global GblLasteq As String
Global GblLastAns As Float
 
Type EqElement
	e As String
	ttype As Integer
endtype
 
Dim Element(0) As EqElement
 
`ttypes of elements
Global Num = 1 `1: Num  Number
Global Sign = 2`2: Sign Sign (Basic sign: +, -, *, /, ^)
Global Cpx = 3`3: Cpx  Complex (sin, cos, sqrt, log...)
Global Var = 4`4: Var  Variable (A, B, C, D...)
Global oBkt = 5
Global cBkt = 6`5/6: cBkt/oBkt Parenthisis
Global Cmd = 7 `7: Cmd  Commands (:)
 
 
Type Operator
	Sign As String
endtype
 
Dim Complex(0) As Operator
 
Read Thedata$
If thedata$ <> "BeginComplex" Then Error_Message("Error: Data is not correct."): End
 
Repeat
	Read TheData$
 
	If TheData$ <> "EndComplex" 
		Add To Queue Complex(0)
		C_Num = Array Count(Complex(0))		
		Complex(C_Num).Sign = TheData$
	endif
 
until TheData$ = "EndComplex"
 
Data "BeginComplex"
 
Data "sin"
Data "cos"
Data "tan"
Data "arcsin"
Data "arccos"
Data "arctan"
 
Data "sqrt"
Data "abs"
Data "roundup"
Data "rounddown"
Data "wrap"
Data "factorial"
 
Data "EndComplex"
 
 
 
Dim Command(0) As Operator
 
Read Thedata$
If Thedata$ <> "BeginCommand" Then Error_Message("Error: Data is not correct."): End
 
Repeat
	Read TheData$
 
	If TheData$ <> "EndCommand"
		Add To Queue Command(0)
		C_Num = Array COunt(Command(0))
		Command(C_Num).SIgn = TheData$
	endif
 
until THeData$ = "EndCommand"
 
Return
 
Data "BeginCommand"
 
Data "ans"
Data "store"
 
Data "EndCommand"