remstart
Maths parser!  (,), *, /, +, -, p[i], e, s[in], c[os], t[an], sq[r]t, a[b]s
by qwe
remend

REM types
type equations
v as float
o as string
endtype

REM arrays
dim e(256) as equations

REM global variables
global error_msg$ = ""
global answer# = 0.0
global option_display_steps = 1
global x_value# = 0.0

REM cut straight to plotter
`gosub graphing

gosub clear
REM MAIN DO LOOP
do
   ink rgb(0,255,128),0
   previous_equation$ = equation$
   input "Enter equation:    ", equation$
   if equation$ = "" then equation$ = previous_equation$

   if equation$ = "help" then gosub help          : equation$ = "no solve"
   if equation$ = "plot" then use_same_stats = 0 : gosub graphing : equation$ = "no solve"
   if equation$ = "clear" then gosub clear       :  equation$ = "no solve"
   if equation$ <> "no solve"
      error_msg$ = ""
      answer# = get_answer("("+equation$+")", 0)
      ink rgb(0,255,255),0
      print "The answer is :    " + str$(answer#)
      ink rgb(255,0,0),0
      if error_msg$ <> "" then print error_msg$
      print
   endif
loop
end

clear:
CLS
REM instructions
ink rgb(255,64,64),0
print "Maths parser by qwe"
print "Handles (, ), *, /, +, -, !, [p]i, [e], [s]in, [c]os, [t]an, sq[r]t, a[b]s, [E]"
ink rgb(255,255,128),0
print "Type 'help' for help"
print "Type 'plot' for graphing"
print "Type 'clear' to clean screen"
print "Type in an equation to solve it.  Use '`' for negative symbol"
print
return

help:
   ink rgb(255,128,255),0
   print "Type in an equation and press enter to see the answer"
   print "Valid characters are: (, ), +, -, *, /, ^, !"
   print "'p' is treated as pi, 'e' is treated as e, '`' is the negative symbol"
   print "'s' 'c' 't' and 'r' are treated as sine, cosine, tangent, and square root"
   print " - They can be entered as r(#), r(equation), or r# ( e.g. r(4), r(3+1), r4 )"
   print "'a' is treated as the previous answer, 'b' as absolute value, 'E' as sci. not."
   print
   print "'help' brings up this menu. 'plot' brings up the graphing utility"
   print
return

function get_answer(e$, option_replace_x)
   REM set variables
   length = len(e$)
   array_count = 0
   REM clear array
   for i = 0 to 255
      e(i).o = ""
      e(i).v = 0.0
   next i
   REM translate string equation into array
   for i = 1 to length
      s$ = mid$(e$, i)

      if s$="(" or s$=")" or s$="+" or s$="-" or s$="*" or s$="/" or s$="^" or s$="p" or s$ = "e" or s$ = "s" or s$ = "c" or s$ = "t" or s$ = "r" or s$ = "a" or s$ = "b" or s$ = "x" or s$ = "!" or s$ = "E"
         if add_value$ = ""
         else
            e(array_count).v = val(add_value$)
            add_value$ = ""
            inc array_count
         endif

         e(array_count).o = s$
         inc array_count
      else
         if s$ = "`" then s$ = "-"
         add_value$ = add_value$ + s$
         if mid$(e$, i+1) = "(" and add_value$ = "-" then add_value$ = "-1"
      endif
   next i
   REM special features
   add_implicit_multiplications()
   set_pi_and_e_values()
   if option_replace_x = 1 then set_x_value()
   add_implicit_a()
   uh_oh = check_for_brackets_error()

   if uh_oh = 1 then exitfunction 0.0

   REM find out how many bracketed sections there are
   for i = 0 to 255
      if e(i).o = "(" then total_brackets = total_brackets + 1
   next i
   REM solve each level of brackets
   if total_brackets > 0
      for lvl = total_brackets to 1 step -1
         display_equation_array()
         length = solve_level(lvl)
      next lvl
   endif
   REM give answer, store answer in global variable
   localanswer#=e(0).v
   answer#=e(0).v
endfunction localanswer#

function display_equation_array()
   ink rgb(192,192,192),0
   done=0
   pos = 0

   repeat
      `see what brakcet level computer is at
      if e(pos).o = "(" then inc bracket_level
      if e(pos).o = ")" then dec bracket_level

      `once reaches last bracket, no more no more
      if bracket_level = 0 then done = 1

      `add each array element to string
      if e(pos).o = ""
         display$ = display$ + str$(e(pos).v)
      else
         display$ = display$ + e(pos).o
      endif

      inc pos
   until done=1

   `take off first and last brackets
   length = len(display$)
   display$ = left$(display$, length-1)
   display$ = right$(display$, length-2)
   `display string
   if option_display_steps = 1
      print display$
   endif
endfunction

function solve_level(lvl)
   for i = 0 to 255
      if e(i).o = "(" then inc count_brackets
      `when computer comes to specified level
      if count_brackets = lvl
         `do operations
         solve_factorial(i)
         solve_sci_not(i)

         solve_special(i, "s")
         solve_special(i, "c")
         solve_special(i, "t")
         solve_special(i, "r")
         solve_special(i, "b")

         solve_segment(i, "^", "{")
         solve_segment(i, "*", "/")
         solve_segment(i, "-", "+")
         `now the segment is simplified to one value
         `now we can eliminate brackets around this value
         e(i).v = e(i+1).v
         e(i).o = ""
         eliminate_slot(i+1)
         eliminate_slot(i+1)

         dec count_brackets
      endif
   next i
endfunction length

function solve_sci_not(i)
   pos = i
   repeat
      `increase position along array and get its operator value
      inc pos
      s$ = e(pos).o
      `if operator is what we want, perform operation and pull out previous and next slots
      if e(pos).o = "E"
         e(pos).v = e(pos-1).v * (10.0 ^ e(pos+1).v)
         e(pos).o = ""
         eliminate_slot(pos+1)
         eliminate_slot(pos-1)
         dec pos
      endif
   until s$ = ")"
endfunction

function solve_factorial(i)
   pos = i
   repeat
      `increase position along array and get its operator value
      inc pos
      s$ = e(pos).o
      `if operator is what we want, perform operation and pull out previous and next slots
      if e(pos).o = "!"
         e(pos).v = factorial(e(pos-1).v)
         e(pos).o = ""
         eliminate_slot(pos-1)
         dec pos
      endif
   until s$ = ")"
endfunction

function factorial(num#)
   ans# = 1.0
   for i = 1 to num#
      ans# = ans# * i
   next i
endfunction ans#

function solve_special(i, o$)
   pos = i
   repeat
      `increase position along array and get its operator value
      inc pos
      s$ = e(pos).o
      `if operator is what we want, perform operation and pull out previous and next slots
      if e(pos).o = o$
         if o$ = "s" then e(pos).v = sin(e(pos+1).v)
         if o$ = "c" then e(pos).v = cos(e(pos+1).v)
         if o$ = "t" then e(pos).v = tan(e(pos+1).v)
         if o$ = "r" then e(pos).v = sqrt(e(pos+1).v)
         if o$ = "b" then e(pos).v = abs(e(pos+1).v)

         eliminate_slot(pos+1)
         e(pos).o = ""
      endif
   until s$ = ")"
endfunction

function solve_segment(i, oa$, ob$)
   pos = i
   repeat
      `increase position along array and get its operator value
      inc pos
      s$ = e(pos).o
      `if operator is what we want, perform operation and pull out previous and next slots
      if e(pos).o = oa$ or e(pos).o = ob$
         if e(pos).o = "^" then e(pos).v = e(pos-1).v ^ e(pos+1).v
         if e(pos).o = "*" then e(pos).v = e(pos-1).v * e(pos+1).v
         if e(pos).o = "/" then e(pos).v = e(pos-1).v / e(pos+1).v
         if e(pos).o = "+" then e(pos).v = e(pos-1).v + e(pos+1).v
         if e(pos).o = "-" then e(pos).v = e(pos-1).v - e(pos+1).v

         if e(pos).o = "/" and e(pos+1).v = 0 then error_msg$ = "Error: Divide by zero"

         e(pos).o = ""
         eliminate_slot(pos+1)
         eliminate_slot(pos-1)
         dec pos `position along array is dec'd because previous position was just pulled out
      endif
   until s$ = ")"
endfunction

function add_slot(pos_add, add$)
   for pos = 255 to pos_add step -1
      e(pos).o = e(pos-1).o
      e(pos).v = e(pos-1).v
   next pos
   e(pos_add).o = add$
   e(pos_add).v = 0.0
endfunction

function eliminate_slot(pos_remove)
   for pos = pos_remove to 254
      e(pos).o = e(pos+1).o
      e(pos).v = e(pos+1).v
   next pos
endfunction

function set_pi_and_e_values()
   for i = 0 to 255
      if e(i).o = "p" then e(i).o = "": e(i).v = 3.1415927
      if e(i).o = "e" then e(i).o = "": e(i).v = 2.7182818
      if e(i).o = "a" then e(i).o = "": e(i).v = answer#
   next i
endfunction

function set_x_value()
   for i = 0 to 255
      if e(i).o = "x" then e(i).o = "": e(i).v = x_value#
   next i
endfunction

function add_implicit_a()
   if e(1).o = "+" or e(1).o = "-" or e(1).o = "*" or e(1).o = "/" or e(1).o = "^"
      add_slot(1, "a")
   endif
   set_pi_and_e_values()
endfunction

function add_implicit_multiplications()
   for i = 1 to 255
      if e(i).o = "(" or e(i).o = "s" or e(i).o = "c" or e(i).o = "t" or e(i).o = "r" or e(i).o = "p" or e(i).o = "b" or e(i).o = "a" or e(i).o = "e" or e(i).o = "x"
         if e(i-1).o = "" or e(i-1).o = ")" or e(i-1).o = "!" or e(i-1).o = "p" or e(i-1).o = "e" or e(i-1).o = "a" or e(i-1).o = "x"
            add_slot(i, "*")
         endif
      endif
      if e(i).o = ")" or e(i).o = "!"
         if e(i+1).o = "" or e(i).o = "s" or e(i).o = "c" or e(i).o = "t" or e(i).o = "r" or e(i).o = "p" or e(i).o = "b" or e(i).o = "a" or e(i).o = "e" or e(i).o = "x"
            add_slot(i+1, "*")
         endif
      endif
      if e(i).o = ""
         if e(i-1).o = "p" or e(i-1).o = "e" or e(i-1).o = "a" or e(i-1).o = ")" or e(i-1).o = "x"
            add_slot(i, "*")
         endif
      endif
   next i
endfunction

function check_for_brackets_error()
   for i = 0 to 255
      if e(i).o = "(" and e(i+1).o = ")"  then error_msg$ = "Error: empty brackets" : uh_oh = 1
   next i

   for i = 0 to 255
      if e(i).o = "(" then inc count_start_brackets
      if e(i).o = ")" then inc count_end_brackets
   next i
   if count_start_brackets <> count_end_brackets then error_msg$ = "Error: Start brackets don't match end brackets" : uh_oh = 1
endfunction uh_oh

function emptybox(xa,ya,xb,yb)
   line xa,ya,xa,yb
   line xa,yb,xb,yb
   line xb,yb,xb,ya
   line xb,ya,xa,ya
endfunction

graphing:
   CLS
   REM Get window stats
   if use_same_stats = 0
      ink rgb(128,255,128),0
      print "Press enter 7 times to leave default and just enter equation"
      print
      ink rgb(255,255,128),0
      print "Default window size is 400 pixels"
      print
      ink rgb(192,192,128),0
      input "Enter window x size (pixels): ", x_pixel_size : if x_pixel_size = 0 then x_pixel_size = 400
      input "Enter window y size (pixels): ", y_pixel_size : if y_pixel_size = 0 then y_pixel_size = 400
      print
      ink rgb(255,255,128),0
      print "Default value for window x/y unit size is 20 (-10 to 10) on each axis"
      print
      ink rgb(192,192,128),0
      input "Enter window X size in units: ", x_max# : x_max# = x_max# / 2.0 : if x_max# = 0 then x_max# = 10
      input "Enter window Y size in units: ", y_max# : y_max# = y_max# / 2.0 : if y_max# = 0 then y_max# = 10
      print
      input "Enter x grid value (enter for none): ", grid_x#
      input "Enter y grid value (enter for none): ", grid_y#
      print
      input "Connect dots of grid? (0 or 1): ", option_connect
      print
   endif
   ink rgb(128,255,128),0
   input "Enter equation: ", equation$
   CLS

   sync on

   REM get some variables
   x_min# = -1 * x_max#
   y_min# = -1 * y_max#
   total_x_unit_size# = abs(x_min#) + x_max#
   total_y_unit_size# = abs(y_min#) + y_max#
   option_display_steps = 0
   winxpos = 320 - x_pixel_size/2
   winypos = 240 - y_pixel_size/2

   REM draw window
   if grid_x# > 0.001
      `draw x grid
      ink rgb(64,64,64),0
      x_ratio# = grid_x# / total_x_unit_size#
      x_interval# = x_ratio# * (x_pixel_size + 0.0)
      current_x# = 0.0
      repeat
         line int(current_x#) + winxpos, 0 + winypos, int(current_x#) + winxpos, y_pixel_size + winypos
         inc current_x#, x_interval#
      until int(current_x#) > x_pixel_size
   endif
   if grid_y# > 0.001
      `draw y grid
      ink rgb(64,64,64),0
      y_ratio# = grid_y# / total_y_unit_size#
      y_interval# = y_ratio# * (y_pixel_size + 0.0)
      current_y# = 0.0
      repeat
         line 0 + winxpos, int(current_y#) + winypos, x_pixel_size + winxpos, int(current_y#) + winypos
         inc current_y#, y_interval#
      until int(current_y#) > y_pixel_size
   endif
   `draw border
   ink rgb(255,255,255),0
   emptybox(0 + winxpos,0 + winypos,x_pixel_size + winxpos,y_pixel_size + winypos)
   `draw x and y axis
   ink rgb(192,192,192),0
   line 0 + winxpos, y_pixel_size/2 + winypos, x_pixel_size + winxpos, y_pixel_size/2 + winypos
   line x_pixel_size/2 + winxpos, 0 + winypos, x_pixel_size/2 + winxpos, y_pixel_size + winypos
   `get plot stats to display
   length_msg$ = str$(x_min#) + " <-> " + str$(x_max#)
   height_msg$ = str$(y_min#) + " <-> " + str$(y_max#)

   error_msg$ = ""
   previous_x = 0
   previous_y = 0
   REM Draw each x,y coordinate
   for x_pixel = 1 to x_pixel_size
      `find which x value in units we're to solve for
      x_unit# = (x_pixel + 0.0) / (x_pixel_size + 0.0)
      x_unit# = x_unit# * (total_x_unit_size# + 0.0)
      x_unit# = x_unit# + (x_min# + 0.0)

      `find y value in units
      x_value# = x_unit#
      y_unit# = get_answer("("+equation$+")", 1)

      `find y value in pixels
      y_pixel# = y_unit# * -1.0
      y_pixel# = y_pixel# / (total_y_unit_size#)
      y_pixel# = y_pixel# * (y_pixel_size + 0.0)
      y_pixel# = y_pixel# + ((y_pixel_size + 0.0) / 2.0)

      y_pixel = y_pixel#
      `draw point
      if x_pixel = 1 then previous_x = x_pixel: previous_y = y_pixel
      if y_pixel < y_pixel_size
         if option_connect
            ink rgb(255,255,128),0
            line x_pixel + winxpos, y_pixel + winypos, previous_x + winxpos, previous_y + winypos
         else
            dot x_pixel + winxpos, y_pixel + winypos, rgb(255,255,128)
         endif
      endif

      previous_x = x_pixel
      previous_y = y_pixel
   next x
   ` cover up line if it went outside of graph
   ink rgb(32,32,32),0
   box 0, y_pixel_size + winypos + 1, 640, 480
   box 0, 0, 640, winypos
   box 0, 0, winxpos, 480
   box winxpos + x_pixel_size + 1, 0, 640, 480
   ` show graph stats
   ink rgb(128,255,128),0
   center text x_pixel_size/2 + winxpos, y_pixel_size + winypos, length_msg$
   center text x_pixel_size + 50 + winxpos, y_pixel_size/2 + winypos, height_msg$
   ink rgb(255,255,255),0
   center text x_pixel_size/2 + winxpos, y_pixel_size + 50 + winypos, equation$

   ink rgb(255,64,64),0
   if error_msg$ <> "" then center text x_pixel_size/2 + winxpos, y_pixel_size + 100 + winypos, error_msg$

   ink rgb(0,255,255),0
   center text x_pixel_size/2 + winxpos, winypos - 40, "[RShift] returns to equation solver"
   center text x_pixel_size/2 + winxpos, winypos - 28, "[\] runs grapher again"
   center text x_pixel_size/2 + winxpos, winypos - 16, "[Backspace] runs grapher keeping same window stats"

   sync
   sync off

   done=0
   redo_grapher=0
   use_same_stats=0
   repeat
      if keystate(54) then done=1
      if keystate(43) then done=1: redo_grapher=1
      if keystate(14) then done=1: redo_grapher=1: use_same_stats=1
   until done=1
   if redo_grapher then gosub graphing
   if redo_grapher_same_stats then gosub graphing
   option_display_steps = 1
   gosub clear
return