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"