/* Program: calc-eq.p
  * Purpose: Solve an equation entered as a text
  * Parameters: Input Equation, output result, shared var, list of
 *             variables, corresponding values as an array
  * Developed by: Jacob George
 */
 
  define input parameter mp-eq as ch no-undo.
  define output parameter mp-ret-value as dec no-undo.
  define shared var ms-var as ch no-undo.
  define shared var ms-val as dec extent 500 no-undo.
  define var ms-temp-var as ch no-undo.
  define var ms-temp-val as dec extent 500 no-undo.
  define var ms-op-br as int no-undo.
  define var ms-op-br-pos as int no-undo.
  define var ms-cl-br as int no-undo.
  define var ms-cl-br-pos as int no-undo.
  define var ms-eq as ch no-undo.
  define var ms-temp-ch as ch no-undo.
  define var i as int no-undo.
  define var ms-pos as int no-undo.
  define var ms-pos2 as int no-undo.
  Define var ms-cnfm as log no-undo.
  define var ms-sign-pos as int no-undo.
  define var ms-sign-nos as int no-undo.
 
  mp-eq = trim(mp-eq) + '.'.
 
  Do ms-pos2 = 1 to length(mp-eq) on error undo,return.
    if substring(mp-eq,ms-pos2,1) = '.' and not
       (asc(substring(mp-eq,ms-pos2 + 1,1)) GE 47 and
        asc(substring(mp-eq,ms-pos2 + 1,1)) LE 57) then do:
      if ms-eq NE '' then run cal-pr1.
      ms-eq = ''.
    End.
    else if substring(mp-eq,ms-pos2,1) NE ' ' then
      ms-eq = ms-eq + substring(mp-eq,ms-pos2,1).
  End.
 
  Procedure Cal-pr1.
 
  ms-cnfm = false.
  do i = 1 to length(ms-eq).
    If substring(ms-eq,i,1) = '=' then do:
      If ms-cnfm then do:
        message 'Too many equal (=) signs in one line.'
              view-as alert-box error buttons ok.
         return error.
      end.
      else ms-cnfm = true.
    End.
  End.
 
  ms-sign-pos = length(ms-eq).
  do i = 1 to ms-sign-pos.
    If lookup(substring(ms-eq,i,1),'*,/,-,+,=') GT 0 then do:
      ms-pos = ms-pos + 1.
      If ms-pos GT 2 or (ms-pos = 2 and substring(ms-eq,i,1) NE '-') hen
 do:
         message 'Too many operators signs in one line.'
              view-as alert-box error buttons ok.
         return error.
      End.
      if ms-pos = 2 and substring(ms-eq,i,1) EQ '-' then
        ms-eq = substring(ms-eq,1,i - 1) + chr(153) + substring(ms-eq,i 
 1).
    End.
    Else ms-pos = 0.
  End.
 
  If substring(ms-eq,1,1) = '-'  then
    ms-eq = chr(153) + substring(ms-eq,2).
 
  Main1:
  do while true.
 
    assign
    ms-op-br = 0
    ms-op-br-pos = 0
    ms-cl-br = 0
    ms-cl-br-pos = 0.
 
    do i = 1 to length(ms-eq).
      if substring(ms-eq,i,1) = '(' then assign
        ms-op-br = ms-op-br + 1
        ms-op-br-pos = i.
 
      if substring(ms-eq,i,1) = ')' then assign
        ms-cl-br = ms-cl-br + 1
        ms-cl-br-pos = i.
 
    end.
 
    if ms-op-br NE ms-cl-br then do:
      message 'Incorrect bracketing' view-as alert-box error.
      return error.
    end.
 
    if ms-cl-br GT 0 then do:
      run cal-pr-main(substring(ms-eq,ms-op-br-pos + 1,
      ms-cl-br-pos - 1 - ms-op-br-pos)).
      ms-eq = substring(ms-eq,1,ms-op-br-pos - 1) + trim(ms-temp-ch) +
 substring(ms-eq,ms-cl-br-pos + 1).
    End.
    Else do:
      run cal-pr-main(ms-eq).
      ms-eq = ms-temp-ch.
      leave Main1.
    End.
  End.
  If substring(ms-eq,1,1) = chr(153) then
     ms-eq = '-' +  substring(ms-eq,2).
  mp-ret-value = decimal(ms-eq).
 
  End Procedure.
 
  Procedure cal-pr-main.
 
  define input parameter mp-eq2 as ch.
  define var ms-st as int.
  define var ms-en as int.
 
  If lookup(substring(mp-eq2,1,1),'*,/,-,+') GT 0 then
    mp-eq2 = chr(153) + substring(mp-eq2,2).
 
  Main2:
  do while true.
 
    assign
    ms-st = 1
    ms-en = length(mp-eq2)
    ms-sign-pos = 0.
 
    do i = 1 to length(mp-eq2).
      if lookup(substring(mp-eq2,i,1),'*,/,') GT 0 then do:
        assign
        ms-sign-pos = i.
        leave.
      End.
    end.
 
    if ms-sign-pos GT 0 then do i = ms-sign-pos + 1 to length(mp-eq2).
      if lookup(substring(mp-eq2,i,1),'*,/,+,-,=') GT 0 then do:
        ms-en = i - 1.
        leave.
      end.
    end.
 
    if ms-sign-pos GT 0 then do i = ms-sign-pos - 1 to 1 by -1.
      if lookup(substring(mp-eq2,i,1),'*,/,+,-,=') GT 0 then do:
        ms-st = i + 1.
        leave.
      end.
    end.
 
    If ms-sign-pos GT 0 then do:
      if ms-st GT 1 or ms-en LT length(mp-eq2) then do:
        run cal-pr-sub(substring(mp-eq2,ms-st,ms-en - ms-st + 1)).
        mp-eq2 = trim(substring(mp-eq2,1,ms-st - 1) + trim(ms-temp-ch) +
 substring(mp-eq2,ms-en + 1)).
      End.
      Else do:
        run cal-pr-sub(mp-eq2).
        mp-eq2 = ms-temp-ch.
        leave main2.
      End.
    End.
    Else leave main2.
  End.
 
  Main3:
  do while true.
 
    assign
    ms-st = 1
    ms-en = length(mp-eq2)
    ms-sign-pos = 0.
 
    do i = 1 to length(mp-eq2).
      if lookup(substring(mp-eq2,i,1),'+,-,') GT 0 then do:
        assign ms-sign-pos = i.
        leave.
      End.
    End.
 
    do i = ms-sign-pos + 1 to length(mp-eq2).
      if lookup(substring(mp-eq2,i,1),'*,/,+,-,=') GT 0 then do:
        ms-en = i - 1.
        leave.
      end.
    end.
 
    do i = ms-sign-pos - 1 to 1 by -1.
      if lookup(substring(mp-eq2,i,1),'*,/,+,-,=') GT 0 then do:
        ms-st = i + 1.
        leave.
      end.
    end.
 
    if ms-sign-pos NE 0 then do:
      if ms-st GT 1 or ms-en LT length(mp-eq2) then do:
        run cal-pr-sub(substring(mp-eq2,ms-st,ms-en - ms-st + 1)).
        mp-eq2 = trim(substring(mp-eq2,1,ms-st - 1) + trim(ms-temp-ch) +
                 substring(mp-eq2,ms-en + 1)).
      End.
      Else do:
        run cal-pr-sub(mp-eq2).
        mp-eq2 = ms-temp-ch.
        leave main3.
      End.
    End.
    Else leave main3.
  End.
 
  do i = 1 to length(mp-eq2).
    if substring(mp-eq2,i,1) = '=' then do:
      run cal-pr-assign(mp-eq2).
      mp-eq2 = ms-temp-ch.
    End.
  End.
 
  End Procedure.
 
  Procedure cal-pr-sub.
 
  define input parameter mp-eq3 as ch.
  define var ms-var1 as ch.
  define var ms-var2 as ch.
  define var ms-val1 as dec.
  define var ms-val2 as dec.
  define var ms-dec as log.
  define var ms-neg1 as log.
  define var ms-neg2 as log.
 
  do i = 1 to length(mp-eq3).
    if lookup(substring(mp-eq3,i,1),'+,-,*,/') GT 0 then do:
      ms-sign-pos = i.
      leave.
    end.
  end.
 
  if ms-sign-pos GT 1 then assign
    ms-var1 = trim(substring(mp-eq3,1,ms-sign-pos - 1))
    ms-var2 = trim(substring(mp-eq3,ms-sign-pos + 1)).
  else assign
    ms-var1 = trim(mp-eq3)
    ms-var2 = ''.
 
  if substring(ms-var1,1,1) = chr(153) then assign
    ms-var1 = substring(ms-var1,2)
    ms-neg1 = true.
 
  if substring(ms-var2,1,1) = chr(153) then assign
    ms-var2 = substring(ms-var2,2)
    ms-neg2 = true.
 
  ms-dec = true.
  do i = 1 to length(ms-var1).
    if (asc(substring(ms-var1,i,1)) LT 48 or asc(substring(ms-var1,i,1))
 GT 57)
      and asc(substring(ms-var1,i,1)) NE 153 and substring(ms-var1,i,1)
 NE '.' then do:
      ms-dec = false.
      leave.
    End.
  End.
 
  if not ms-dec then do:
    if lookup(ms-var1,ms-var) GT 0 then
      ms-val1 = ms-val[lookup(ms-var1,ms-var)].
    Else if lookup(ms-var1,ms-temp-var) GT 0 then
      ms-val1 = ms-temp-val[lookup(ms-var1,ms-temp-var)].
    else ms-val1 = 0.
  End.
 
  Else ms-val1 = decimal(ms-var1).
 
  if ms-neg1 then ms-val1 = ms-val1 * -1.
 
  If ms-var2 NE '' then do:
    ms-dec = true.
    do i = 1 to length(ms-var2).
      if (asc(substring(ms-var2,i,1)) LT 48 or
 asc(substring(ms-var2,i,1)) GT 57)
        and asc(substring(ms-var2,i,1)) NE 153 and
substring(ms-var2,i,1)
 NE '.' then do:
        ms-dec = false.
        leave.
      End.
    End.
 
    if not ms-dec then do:
      if lookup(ms-var2,ms-var) GT 0 then
        ms-val2 = ms-val[lookup(ms-var2,ms-var)].
      Else if lookup(ms-var2,ms-temp-var) GT 0 then
        ms-val2 = ms-temp-val[lookup(ms-var2,ms-temp-var)].
      else ms-val2 = 0.
    End.
    Else ms-val2 = decimal(ms-var2).
 
    if ms-neg2 then ms-val2 = ms-val2 * -1.
 
    Case substring(mp-eq3,ms-sign-pos,1):
      When '+' then ms-temp-ch = string(ms-val1 + ms-val2).
      When '-' then ms-temp-ch = string(ms-val1 - ms-val2).
      When '*' then ms-temp-ch = string(ms-val1 * ms-val2).
      When '/' then