home *** CD-ROM | disk | FTP | other *** search
- /**********************************/
- /* A tiny calculator written in E */
- /* By EA van Breemen */
- /**********************************/
-
- CONST DIV_BY_ZERO=1
- CONST NOT_IMPLEMENTED=2
- CONST RIGHT_MISSING=3
- CONST UNKOWN_FUNCTION=4
- CONST OVER_FLOW=5
-
-
- DEF stoppen,err
- DEF buffer[256]:STRING
- DEF line:PTR TO CHAR
- DEF answer,result
- DEF x_value
-
- PROC main()
- WriteF('E Calculator v1.0\nCopyright by Van Breemen Software \c1993\n',169)
- WriteF('Written by EA van Breemen.\n')
- stoppen:=FALSE
- answer:=0
- x_value:=0
- WHILE (stoppen=FALSE)
- err:=FALSE
- getline()
- process()
- ENDWHILE
- WriteF('\nBy your command\n')
- ENDPROC
-
- PROC error(no)
- DEF i
- IF err=TRUE THEN RETURN
- WriteF('=>')
- FOR i:=0 TO (line-buffer-1) DO WriteF(' ')
- WriteF('^\n')
- err:=TRUE
- WriteF('=>Error \d:',no)
- SELECT no
- CASE DIV_BY_ZERO
- WriteF('Division by zero')
- CASE RIGHT_MISSING
- WriteF('Right ) missing')
- CASE UNKOWN_FUNCTION
- WriteF('Unkown function')
- CASE OVER_FLOW
- WriteF('Number too large or overflow')
- CASE NOT_IMPLEMENTED
- WriteF('Not implimented')
- ENDSELECT
- WriteF('\n')
- ENDPROC
-
- PROC getline()
- DEF ok
- WriteF('=>')
- ok:=ReadStr(stdout,buffer)
- LowerStr(buffer) /* make everything lowercase */
- line:=TrimStr(buffer)
- ENDPROC
-
- PROC process()
- DEF a
- a:=getchar()
- SELECT a
- CASE 10
- RETURN
- CASE "q"
- stoppen:=TRUE
- RETURN
- CASE "h"
- help()
- RETURN
- CASE "x"
- IF get_x() THEN err:=TRUE ELSE answer:=readexpression()
- DEFAULT
- answer:=readexpression()
- ENDSELECT
- IF err=FALSE
- result:=answer
- WriteF('=>\d\n',answer)
- ENDIF
- ENDPROC
-
- PROC getchar()
- DEF ch
- ch:=line[0]
- WHILE ((ch=" ") AND (StrLen(line)>0))
- line++
- ch:=line[0]
- ENDWHILE
- RETURN IF (ch<>" ") AND (StrLen(line)>0) THEN ch ELSE 10
- ENDPROC
-
- PROC help()
- WriteF('=>Help on the E calculator\n')
- WriteF('=>By EA van Breemen\n')
- WriteF('=>\n=>Enter an algebraic expression and press ENTER\n')
- WriteF('=>The following functions are available:\n')
- WriteF('=> + - * / ^\n')
- WriteF('=> abs()\n')
- WriteF('=>\n=>variable x may be used in the equations.\n')
- WriteF('=>The last computation result is stored in ans.\n')
- WriteF('=>Use q to quit.\n')
- WriteF('=>Note: * / and ^ have the same computation priority.\n')
- ENDPROC
-
-
- PROC readexpression()
- DEF exprvalue,nextterm,operator,ch
- exprvalue:=readterm()
- ch:=getchar()
- WHILE (ch="+") OR (ch="-")
- operator:=IF (ch="+") THEN 1 ELSE -1
- line++
- nextterm:=readterm()
- exprvalue:=IF operator=1 THEN exprvalue+nextterm ELSE exprvalue-nextterm
- ch:=getchar()
- ENDWHILE
- ENDPROC exprvalue
-
-
- PROC readterm()
- DEF termvalue,nextvalue,mult,i
- DEF ch,operator
- termvalue:=readfactor()
- ch:=getchar()
- WHILE (ch="/") OR (ch="*") OR (ch="^")
- operator:=ch
- line++
- nextvalue:=readfactor()
- SELECT operator
- CASE "*"
- termvalue:=Mul(termvalue,nextvalue)
- CASE "/"
- IF (nextvalue<>0)
- termvalue:=Div(termvalue,nextvalue)
- ELSE
- error(DIV_BY_ZERO)
- ENDIF
- CASE "^"
- IF nextvalue=0
- termvalue:=1
- ELSE
- mult:=termvalue
- IF nextvalue<0
- error(NOT_IMPLEMENTED)
- termvalue:=1
- ENDIF
- FOR i:=1 TO nextvalue-1 DO termvalue:=Mul(termvalue,mult)
- ENDIF
- ENDSELECT
- ch:=getchar()
- ENDWHILE
- ENDPROC termvalue
-
- PROC readfactor()
- DEF factorvalue,ch
- ch:=getchar()
- IF (ch="-")
- line++
- RETURN Mul(-1,readfactor()) /* read - recursivly */
- ENDIF
- IF (ch="+")
- line++
- RETURN readfactor()
- ENDIF
- IF ((ch>="0") AND (ch<="9")) OR (ch="x") OR (ch=".")
- factorvalue:=readnumber()
- ELSE
- IF (ch="(")
- line++
- factorvalue:=readexpression()
- ch:=getchar()
- IF (ch=")")
- line++
- ch:=getchar()
- ELSE
- error(RIGHT_MISSING)
- ENDIF
- ELSE
- factorvalue:=try_functions()
- ENDIF
- ENDIF
- ENDPROC factorvalue
-
-
- PROC readnumber()
- DEF numvalue,oldnumvalue,ch
- numvalue:=0
- oldnumvalue:=0
- ch:=getchar()
- IF (ch="x")
- line++
- RETURN x_value
- ENDIF
- WHILE (ch>="0") AND (ch<="9")
- numvalue:=Mul(10,numvalue)+ch-"0"
- line++
- ch:=getchar()
- IF Div(numvalue,10)<>oldnumvalue
- error(OVER_FLOW)
- RETURN 0
- ELSE
- oldnumvalue:=numvalue
- ENDIF
- ENDWHILE
- ENDPROC numvalue
-
- PROC try_functions()
- DEF oldline:PTR TO CHAR
- DEF ch1,ch2,ch3
- DEF answer
- oldline:=line
- ch1:=getchar()
- line++
- ch2:=getchar()
- line++
- ch3:=getchar()
- line++
- IF (ch1="a") AND (ch2="b") AND (ch3="s")
- answer:=readexpression();
- RETURN Abs(answer)
- ENDIF
- IF (ch1="a") AND (ch2="n") AND (ch3="s")
- RETURN result
- ENDIF
- error(UNKOWN_FUNCTION)
- ENDPROC
-
- PROC get_x()
- DEF ch
- DEF oldline:PTR TO CHAR
- oldline:=line
- line++
- ch:=getchar()
- IF ch<>"="
- line:=oldline
- RETURN FALSE
- ELSE
- line++
- ch:=getchar()
- x_value:=readexpression()
- err:=TRUE
- ENDIF
- ENDPROC TRUE
-