calculator and graphs

DEFINT A-Z

DECLARE SUB graph (expression AS STRING)
DECLARE SUB mouse (ax, mb, mx, my)
DECLARE SUB push (item AS STRING)
DECLARE FUNCTION pop$ ()
DECLARE FUNCTION makerpn$ (expression AS STRING)
DECLARE FUNCTION evalrpn$ (rpn AS STRING, a AS DOUBLE, x AS DOUBLE)
DECLARE FUNCTION trim$ (s$)

DIM SHARED m(7) AS LONG
m(0) = &H8BE58955
m(1) = &H48B0C76
m(2) = &H768B33CD
m(3) = &H8B1C890A
m(4) = &HC890876
m(5) = &H8906768B
m(6) = &H8CA5D14
DIM SHARED mb, mx, my

DIM SHARED stack(1000) AS STRING
DIM SHARED stackindex AS INTEGER
stackindex = 0

DIM s(1000) AS STRING

SCREEN 0
VIEW PRINT 1 TO 25
CLS

s(0) = "examples of things to type here (a is variable holds previous answer):"
s(1) = "=ln(2.7^20)"
s(2) = "=2^2*2 + a + a"
s(3) = "=81^(1/2)"
s(4) = "=-cos3.14159"
s(5) = "x is variable in graph y to x"
s(6) = "graph x*x"
s(7) = "graph tanx"

FOR i = 0 TO 6
LOCATE i + 1, 1
PRINT s(i);
NEXT

c = 8
x = 1
y = 8

LOCATE y, x
COLOR 0, 7
PRINT CHR$(SCREEN(c + 1, x));
COLOR 7, 0

DIM SHARED a AS DOUBLE
a = 0

DO
key$ = INKEY$
IF key$ <> "" THEN

SELECT CASE key$
CASE CHR$(32) TO CHR$(128)
IF x < 80 AND LEN(s(c)) < 79 THEN
s(c) = LEFT$(s(c), x - 1) + key$ + MID$(s(c), x, LEN(s(c)) - x + 1)
LOCATE y, 1
PRINT s(c);
x = x + 1
END IF

CASE CHR$(0) + "K"'left
IF x > 1 THEN
x = x - 1
LOCATE y, 1
PRINT s(c) + " ";
END IF

CASE CHR$(0) + "M"'right
IF x <= LEN(s(c)) THEN
x = x + 1
LOCATE y, 1
PRINT s(c) + " ";
END IF

CASE CHR$(0) + "H"'up
s(c) = temp$
LOCATE y, 1
PRINT s(c) + SPACE$(80 - LEN(s(c)));
x = LEN(s(c)) + 1

CASE CHR$(0) + "P"'down
s(c) = ""
LOCATE y, 1
PRINT SPACE$(80)
x = 1

CASE CHR$(8) 'backspace
IF x > 1 THEN
s(c) = LEFT$(s(c), x - 2) + MID$(s(c), x, LEN(s(c)) - x + 1)
LOCATE y, 1
PRINT s(c) + SPACE$(80 - LEN(s(c)));
x = x - 1
END IF

CASE CHR$(13) 'enter

IF LEFT$(trim$(s(c)), 1) = "=" THEN
ans$ = trim$(evalrpn$(makerpn$(s(c) + " ") + " ", a, 0))
a = VAL(ans$)
temp$ = s(c)
s(c) = ans$

ELSEIF LEFT$(trim$(s(c)), 5) = "graph" THEN
graph RIGHT$(s(c), LEN(s(c)) - 5)

END IF

c = c + 1
x = 1

IF y = 25 THEN
CLS
FOR i = 1 TO 24
LOCATE i, 1
PRINT s(c - 25 + i);
NEXT
ELSE
LOCATE y, x
PRINT s(c - 1) + SPACE$(80 - LEN(s(c)));
y = y + 1
END IF
END SELECT

LOCATE y, x
COLOR 0, 7
PRINT CHR$(SCREEN(y, x));
COLOR 7, 0
END IF

LOOP UNTIL key$ = CHR$(27)
SYSTEM

mouse 0, mb, mx, my
mouse 1, mb, mx, my
DO
mouse 3, mb, mx, my

LOCATE 1, 1
PRINT mb, mx, my
LOOP UNTIL INP(&H60) = 1
SYSTEM

FUNCTION evalrpn$ (rpn AS STRING, a AS DOUBLE, x AS DOUBLE)

rpn = rpn + " "
DIM first AS STRING
DIM num AS STRING

DIM c AS INTEGER
DIM cc AS STRING * 1

FOR i = 1 TO LEN(rpn) - 1
cc = MID$(rpn, i, 1)
c = ASC(cc)

SELECT CASE c
CASE 46, 48 TO 57 '. and 0 to 9
num = num + CHR$(c)

CASE ELSE
IF num <> "" THEN
push num
num = ""
END IF

SELECT CASE c
CASE 97
push STR$(a)
CASE 120
push STR$(x)
CASE 95 '_
push STR$(-VAL(pop$))
CASE 43 '+
push STR$(VAL(pop$) + VAL(pop$))
CASE 45 '-
first = pop$
push STR$(VAL(pop$) - VAL(first))
CASE 42 '*
push STR$(VAL(pop$) * VAL(pop$))
CASE 47 '/
first = pop$
push STR$(VAL(pop$) / VAL(first))
CASE 94 '^
first = pop$
push STR$(VAL(pop$) ^ VAL(first))
CASE 115 's
push STR$(SIN(VAL(pop$)))
CASE 99 'c
push STR$(COS(VAL(pop$)))
CASE 116 't
push STR$(TAN(VAL(pop$)))
CASE 108 'l
push STR$(LOG(VAL(pop$)))
END SELECT
END SELECT
NEXT

evalrpn = pop$
END FUNCTION

SUB graph (expression AS STRING)

rpn$ = makerpn$(expression + " ")

SCREEN 12

LINE (0, 240)-(640, 240), 15
LINE (320, 0)-(320, 480), 15

FOR i = 0 TO 640 STEP 40
LINE (i, 235)-STEP(0, 10), 15
NEXT
FOR i = 0 TO 480 STEP 40
LINE (315, i)-STEP(10, 0), 15
NEXT

DIM x AS DOUBLE, y AS DOUBLE
y = VAL(evalrpn$(rpn$, a, -8))
PSET (-8 * 40 + 320, y * 40 + 240), 12
FOR x = -8 TO 8 STEP .1
y = VAL(evalrpn$(rpn$, a, x))
LINE -(x * 40 + 320, 480 - (y * 40 + 240)), 12
NEXT

mouse 0, mb, mx, my
mouse 1, mb, mx, my

LOCATE 1, 1
PRINT "y = " + expression
DO
key$ = INKEY$
mouse 3, mb, mx, my
LOCATE 2, 1
mm# = (mx - 1) / 40 - 8
PRINT "(" + trim$(STR$(mm#)) + "," + evalrpn$(rpn$, a, mm#) + ")"
LOOP UNTIL key$ = CHR$(27)

SCREEN 0
END SUB

FUNCTION makerpn$ (expression AS STRING)
DIM rpn AS STRING
DIM last AS INTEGER
last = -1
DIM temp AS STRING

DIM c AS INTEGER
DIM cc AS STRING * 1

FOR i = 1 TO LEN(expression) - 1
cc = MID$(expression, i, 1)
c = ASC(cc)

SELECT CASE c
CASE 97, 120, 46, 48 TO 57 'a, x, . and 0 to 9
rpn = rpn + CHR$(c)
last = 0
CASE 43, 45 '+, -
rpn = rpn + " "

IF last THEN
IF c = 45 THEN push "_"
ELSE
IF stack(stackindex) = "_" OR stack(stackindex) = "^" OR stack(stackindex) = "+" OR stack(stackindex) = "-" OR stack(stackindex) = "*" OR stack(stackindex) = "/" OR stack(stackindex) = "s" OR stack(stackindex) = "c" OR stack(stackindex) = "t" OR stack(stackindex) = "l" THEN
rpn = rpn + pop$
END IF

push CHR$(c)
last = -1
END IF
CASE 42, 47 '*, /
rpn = rpn + " "

IF stack(stackindex) = "_" OR stack(stackindex) = "^" OR stack(stackindex) = "*" OR stack(stackindex) = "/" OR stack(stackindex) = "s" OR stack(stackindex) = "c" OR stack(stackindex) = "t" OR stack(stackindex) = "l" THEN
rpn = rpn + pop$
END IF

push CHR$(c)
last = -1
CASE 94 '^
rpn = rpn + " "
IF stack(stackindex) = "_" OR stack(stackindex) = "s" OR stack(stackindex) = "c" OR stack(stackindex) = "t" OR stack(stackindex) = "l" THEN
rpn = rpn + pop$
END IF

push CHR$(c)
last = -1

CASE 115 's
i = i + 2
rpn = rpn + " "
push CHR$(c)
CASE 99 'c
i = i + 2
rpn = rpn + " "
push CHR$(c)
CASE 116 't
i = i + 2
rpn = rpn + " "
push CHR$(c)
CASE 108 'l
i = i + 1
rpn = rpn + " "
push CHR$(c)
CASE 40 '(
push "("
CASE 41 ')
DO WHILE stackindex > 0
temp = pop$
IF temp = "(" THEN EXIT DO
rpn = rpn + temp
LOOP
END SELECT
NEXT

FOR i = 1 TO stackindex
rpn = rpn + pop$
NEXT

makerpn$ = rpn
END FUNCTION

SUB mouse (ax, mb, mx, my)
DEF SEG = VARSEG(m(0))
CALL absolute(ax, mb, mx, my, VARPTR(m(0)))
END SUB

FUNCTION pop$
IF stackindex = 0 THEN
pop$ = "0"
ELSE
stackindex = stackindex - 1
pop$ = stack(stackindex + 1)
END IF
END FUNCTION

SUB push (item AS STRING)
stackindex = stackindex + 1
stack(stackindex) = item
END SUB

FUNCTION trim$ (s$)
trim$ = LTRIM$(RTRIM$(s$))
END FUNCTION