'===========================================================================
' Subject: INFIX TO POSTFIX/RPN CONVERTER     Date: 06-23-99 (12:55)       
'  Author: The ABC Programmer                 Code: BEC, QB, QBasic        
'  Origin: voxel@edmc.net                   Packet: BASEC.ABC
'===========================================================================
' INFIX TO POSTFIX (RPN) CONVERTER/EVALUATOR by William Yu
' Compiled with BEC [DOS/UNIX], should work with QBasic as well
' For a better example, see ALGOR.ABC for my other RPN CONVERTER.
' This example is probably too confusing, since I can't use subroutines
' in BASEC.

CONST Max = 100
CONST TRUE = 1
CONST FALSE = 0

DIM Stack(1 TO Max) AS STRING * 1
DIM Expression AS STRING
DIM Operator AS STRING * 1
DIM CurOp AS STRING * 1
DIM Signs AS STRING
DIM StackTop AS INTEGER, Priority AS INTEGER, CurPriority AS INTEGER
DIM I AS INTEGER, J AS INTEGER, Valid AS INTEGER, ErrorCode AS INTEGER
DIM DonePopping AS INTEGER

StackTop = 0
Signs = " ()+-*/^"
ErrorCode = FALSE

PRINT "INFIX to POSTFIX (RPN) CONVERTER by William Yu"
PRINT
PRINT "An example of an INFIX expression: (4 - 6) * (80 / 5) ^ 2 + 100"
PRINT
PRINT "Please enter an INFIX Expression: ";
INPUT Expression

PRINT "POSTFIX (RPN) Expression is: ";
FOR I = 1 TO LEN(Expression)
  Valid = FALSE
  Operator = MID$(Expression, I, 1)
  FOR J = 1 TO LEN(Signs)
    IF Operator = MID$(Signs, J, 1) THEN Valid = TRUE
  NEXT J
  IF Valid THEN
    IF Operator = " " THEN
      '-- Do nothing
    ELSEIF Operator = "(" THEN
      GOSUB PushStack
    ELSEIF Operator = ")" THEN
      GOSUB ProcessRightParen
    ELSE
      PRINT " ";
      GOSUB ProcessOperator
    END IF
  ELSE
    PRINT Operator;        ' This is not really an operator.
  END IF

  IF ErrorCode = TRUE THEN
    PRINT "<<< Error in INFIX Expression >>>"
    END
  END IF
NEXT I

WHILE StackTop <> 0
  GOSUB PopStack
  IF Operator <> "(" THEN
    PRINT " "; Operator;
  ELSE
    PRINT "<<< Error in INFIX Expression, unresolved left parenthesis >>>"
    END
  END IF
WEND

END


PopStack:
  IF StackTop = 0 THEN
    PRINT " *** Attempt to pop from an empty stack ***"
  ELSE
    Operator = Stack(StackTop)
    StackTop = StackTop - 1
  END IF
RETURN

PushStack:
  StackTop = StackTop + 1
  IF StackTop > Max THEN
    PRINT " *** Attempt to push on a full stack ***"
  ELSE
    Stack(StackTop) = Operator
  END IF
RETURN


ProcessOperator:
  GOSUB GetPriority
  CurPriority = Priority        ' Save this
  CurOp = Operator              ' and this
  DonePopping = FALSE
  DO
    IF StackTop = 0 THEN
      DonePopping = TRUE
    ELSE
      GOSUB PopStack
      GOSUB GetPriority
      IF CurPriority <= Priority THEN
        PRINT " "; Operator; " ";
      ELSE
        GOSUB PushStack
        DonePopping = TRUE
      END IF
    END IF
  LOOP UNTIL DonePopping
  Operator = CurOp
  GOSUB PushStack
RETURN

ProcessRightParen:
  DO
    IF StackTop = 0 THEN
      ErrorCode = TRUE
      RETURN
    END IF
    GOSUB PopStack
    IF Operator <> "(" THEN PRINT " "; Operator;
  LOOP UNTIL Operator = "("
RETURN

GetPriority:
  IF Operator = "(" THEN
    Priority = 0
  ELSEIF Operator = "+" OR Operator = "-" THEN
    Priority = 1
  ELSEIF Operator = "*" OR Operator = "/" THEN
    Priority = 2
  ELSEIF Operator = "^" THEN
    Priority = 3
  END IF
RETURN