sync on sync rate 0 cls hide mouse set display mode 1024,768,32 cls type var_type name as string value as string endtype dim variable(0) as var_type dim instances(0) dim lastopen(0) dim part$(0) dim operator$(0) dim history$(0) global line0=0 global no_par=0 global function_amount=22 dim function$(function_amount) rem here are all the built-in functions: function$(0)="ASIN" function$(1)="ACOS" function$(2)="ATAN" function$(3)="HSIN" function$(4)="HCOS" function$(5)="HTAN" function$(6)="SIN" function$(7)="COS" function$(8)="TAN" function$(9)="CSC" function$(10)="SEC" function$(11)="COT" function$(12)="SQRT" function$(13)="ABS" function$(14)="INT" function$(15)="EXP" function$(16)="RND" function$(17)="TIMER" function$(18)="FLOOR" function$(19)="CEIL" function$(20)="WRAPVALUE" function$(21)="LOG" function$(22)="LN" type user_function_type expr as string parameter as string name as string endtype dim user_function(0) as user_function_type _print("Calculator") assign("left","-10") assign("right","10") assign("top","8") assign("bottom","-8") assign("start","0") assign("end","100") global function_replaced=0 `inc line0 history_index=0 do inpt$="" invalid=1 while invalid=1 e$=entry$() clear entry buffer if keystate(14)=1 e$="" if len(inpt$)>0 and timer()>last_back+65 inpt$=left$(inpt$,len(inpt$)-1) last_back=timer() endif endif if returnkey()=1 e$="" if len(inpt$)>0 then invalid=0 endif if upkey()=1 inc history_index if history_index>array count(history$(0)) history_index=array count(history$(0)) endif inpt$=history$(history_index) _print(":"+inpt$) dec line0 timer0=timer() while (upkey()=1 or downkey()=1) and timer()<timer0+100 endwhile endif if downkey()=1 dec history_index if history_index<0 history_index=0 endif inpt$=history$(history_index) _print(":"+inpt$) dec line0 timer0=timer() while (upkey()=1 or downkey()=1) and timer()<timer0+100 endwhile endif inpt$=inpt$+e$ _print(":"+inpt$) dec line0 ` ink rgb(255,255,255),0 ` text 0,line0*text height("X"),":"+inpt$ sync ` timer0=timer() ` while (upkey()=1 or downkey()=1) and timer()<timer0+100 ` endwhile endwhile history$(0)=inpt$ line0=line0+1 array insert at top history$(0) handle_input(inpt$) sync loop function handle_input(inpt$) inpt$=removeextraspaces(inpt$) inpt$=upper$(inpt$) inpt$=replace(inpt$,"[","(") inpt$=replace(inpt$,"]",")") if left$(inpt$,5)="PLOT(" inpt$=right$(inpt$,len(inpt$)-5) if right$(inpt$,1)=")" then inpt$=left$(inpt$,len(inpt$)-1) function$=removeextraspaces(before_first(inpt$,",")) variable$=removeextraspaces(after_first(inpt$,",")) Plot(function$,variable$) sync wait key exitfunction endif if left$(inpt$,15)="PARAMETRICPLOT(" inpt$=right$(inpt$,len(inpt$)-15) if right$(inpt$,1)=")" then inpt$=left$(inpt$,len(inpt$)-1) function1$=removeextraspaces(before_first(inpt$,",")) inpt$=removeextraspaces(after_first(inpt$,",")) function2$=removeextraspaces(before_first(inpt$,",")) variable$=removeextraspaces(after_first(inpt$,",")) ParametricPlot(function1$,function2$,variable$) sync wait key exitfunction endif ` if contains(inpt$,"=") if upper$(left$(inpt$,7))="DEFINE " name$=before_first(right$(inpt$,len(inpt$)-7),"(") rest$=after_first(inpt$,"(") parameter$=before_first(rest$,")") expr$=after_first(rest$,"=") define_function(name$,parameter$,expr$) else if contains(inpt$,"=") if upper$(left$(inpt$,4))="LET " assign(before_first(right$(inpt$,len(inpt$)-4),"="),after_first(right$(inpt$,len(inpt$)-4),"=")) else if contains(inpt$,"==") if equal(before_first(inpt$,"=="),"==",after_first(inpt$,"==")) _print("true") else _print("false") endif else if contains(inpt$,">=") if equal(before_first(inpt$,">="),">=",after_first(inpt$,">=")) _print("true") else _print("false") endif else if contains(inpt$,"<=") if equal(before_first(inpt$,"<="),"<=",after_first(inpt$,"<=")) _print("true") else _print("false") endif else if equal(before_first(inpt$,"="),"=",after_first(inpt$,"=")) _print("true") else _print("false") endif endif endif endif endif else if contains(inpt$,">") if equal(before_first(inpt$,">"),">",after_first(inpt$,">")) _print("true") else _print("false") endif else if contains(inpt$,"<") if equal(before_first(inpt$,"<"),"<",after_first(inpt$,"<")) _print("true") else _print("false") endif else _print(str$(evaluate(inpt$))) endif endif endif endif endfunction function Plot(function$,variable$) y1#=evaluate("bottom") y2#=evaluate("top") x1#=evaluate("left") x2#=evaluate("right") cls box (0-x1#)*screen width()/(x2#-x1#),0,(0-x1#)*screen width()/(x2#-x1#)+1,screen height() box 0,screen height()-(0.0-y1#)/(y2#-y1#)*screen height(),screen width(),screen height()-(0.0-y1#)/(y2#-y1#)*screen height()+1 first=1 for value#=x1# to x2# step (x2#-x1#)*0.002 assign(variable$,str$(value#)) y#=screen height()-(evaluate(function$)-y1#)/(y2#-y1#)*screen height() x#=(value#-x1#)*screen width()/(x2#-x1#) if first=0 line x#,y#,oldx#,oldy# sync endif first=0 oldy#=y# oldx#=x# next value# sync endfunction function ParametricPlot(function1$,function2$,variable$) y1#=evaluate("bottom") y2#=evaluate("top") x1#=evaluate("left") x2#=evaluate("right") t1#=evaluate("start") t2#=evaluate("end") cls box (0-x1#)*screen width()/(x2#-x1#),0,(0-x1#)*screen width()/(x2#-x1#)+1,screen height() box 0,screen height()-(0.0-y1#)/(y2#-y1#)*screen height(),screen width(),screen height()-(0.0-y1#)/(y2#-y1#)*screen height()+1 first=1 for value#=t1# to t2# step (t2#-t1#)*0.0006 assign(variable$,str$(value#)) x#=(evaluate(function1$)-x1#)/(x2#-x1#)*screen width() y#=screen height()-(evaluate(function2$)-y1#)/(y2#-y1#)*screen height() if first=0 line x#,y#,oldx#,oldy# sync endif first=0 oldy#=y# oldx#=x# next value# sync endfunction function assign(var$,val$) var$=upper$(var$) if val(var$)>0 or var$="0" _print("You are crazy!") else for n=0 to array count(variable(0)) if variable(n).name=var$ variable(n).value=val$ exitfunction endif next n array insert at bottom variable(0) variable(array count(variable(0))).name=var$ variable(array count(variable(0))).value=val$ endif endfunction function define_function(name$,para$,expr$) name$=upper$(name$) para$=upper$(para$) expr$=upper$(expr$) for n=0 to function_amount if function$(n)=name$ _print("Error: A built-in function already uses this name!") exitfunction endif next n if val(name$)>0 or name$="0" or val(para$)>0 or para$="0" _print("You are crazy!") else for n=0 to array count(user_function(0)) if user_function(n).name=name$ user_function(n).parameter=para$ user_function(n).expr=expr$ exitfunction endif next n array insert at bottom user_function(0) user_function(array count(user_function(0))).name=name$ user_function(array count(user_function(0))).parameter=para$ user_function(array count(user_function(0))).expr=expr$ endif endfunction function equal(expr1$,symbol$,expr2$) if symbol$="=" or symbol$="==" if abs(evaluate(expr1$)-evaluate(expr2$))<0.0000001 exitfunction 1 endif endif if symbol$=">" and evaluate(expr1$)>evaluate(expr2$) exitfunction 1 endif if symbol$=">=" and evaluate(expr1$)>=evaluate(expr2$) exitfunction 1 endif if symbol$="<" and evaluate(expr1$)<evaluate(expr2$) exitfunction 1 endif if symbol$="<=" and evaluate(expr1$)<=evaluate(expr2$) exitfunction 1 endif endfunction 0 function evaluate(expr$) rem spaces are bad expr$=replace(expr$," ","") expr$=replace(expr$,"[","(") expr$=replace(expr$,"]",")") rem put everything in parenthesis so it works. expr$="("+expr$+")" empty array lastopen(0) no_par=0 result$=evaluate2(expr$) if left$(result$,2)="N." result$="-"+right$(result$,len(result$)-2) endif result#=val(result$) endfunction result# function evaluate2(expr$) ` _print("ENTER evaluate2 with: ["+expr$+"]") `wait key if left$(expr$,1)="-" expr$="0"+expr$ endif rem now take care fo variables. ` for p= base_part to array count(part$(0)) ` next p ` _print(expr$) ` sync ` wait key repeat_replace_check: if no_par=1 rem to avoid confusion between sin, asin, and hsin etc, we rename them to unique function numbers internally. for v=0 to array count(variable(0)) if len(variable(v).name)>0 expr$=equation_replace(expr$,variable(v).name,"("+variable(v).value+")") endif next v for f=0 to array count(user_function(0)) if len(user_function(f).name)>0 expr$=function_replace(expr$,f) endif next f no_par=1 for c=0 to len(expr$) if mid$(expr$,c)="(" no_par=0 endif next c if no_par=1 for n=0 to function_amount expr$=replace(expr$,function$(n),"FUNCTION"+str$(n)+"|") expr$=proper_function(expr$,"FUNCTION"+str$(n)+"|") next n no_par=0 endif ` _print(expr$) endif if function_replaced=1 function_replaced=0 ` no_par=0 goto repeat_replace_check endif ` _print("yo!2") `wait key `_print(expr$) `sync `wait key `_print(str$(no_par)) `_print("Open:") `for n=0 to array count(lastopen(0)) `_print(str$(lastopen(n))) `next n `_print("----") `sync `wait key lastopen1=0 rem lastopen1 is last open bracket for c=0 to len(expr$) if mid$(expr$,c)="(" array insert at top lastopen(0) lastopen(0)=c rem found new bracket, add it to the stack endif if mid$(expr$,c)=")" rem if we cannot find the last open bracket, the user had too many close brackets, so die. if array count(lastopen(0))<0 _print("Error: Too few open brackets.") sync sync wait key end endif rem remove the last open bracket from the stack lastopen1=lastopen(0) array delete element lastopen(0),0 oldexpr$=expr$ expr$=left$(oldexpr$,lastopen1-1) rem now expr$ contains all characters before the open bracket. if nonoperator(right$(expr$,1))=1 and len(expr$)>0 and expr$<>"" expr$=expr$+"*" endif tempc=len(expr$) no_par=1 rght$=right$(oldexpr$,len(oldexpr$)-c) rem rght$ contains all chracters after the close bracket. rem evaluate the stuff inside the brackets. ` _print("I have ["+oldexpr$+"], so I'm calling evaluate2 with ["+substring(oldexpr$,lastopen1,c-lastopen1-1)+"]") expr$=expr$+evaluate2(substring(oldexpr$,lastopen1,c-lastopen1-1)) if nonoperator(left$(rght$,1))=1 and len(rght$)>0 rght$="*"+rght$ endif expr$=expr$+rght$ ` _print("I used to have ["+oldexpr$+"], but now I have ["+expr$+"]") c=tempc-1 endif next c rem pi is a constant, so it is replaced here by an approximation of its value expr$=equation_replace(expr$,"PI","3.1415926") expr$=equation_replace(expr$,"E","2.71828183") rem this prepares the functions for calculation rem Though it may look like it is replacing it with itself, equation_replace is different from a simple replace(). for n=0 to function_amount expr$=replace(expr$,function$(n),"FUNCTION"+str$(n)+"|") expr$=proper_function(expr$,"FUNCTION"+str$(n)+"|") next n for n=0 to function_amount expr$=equation_replace(expr$,"FUNCTION"+str$(n)+"|","FUNCTION"+str$(n)+"|") next n start=0 base_part=0 base_operator=0 empty array part$(0) empty array operator$(0) `_print("1") `wait key for c=0 to len(expr$) op$="" if mid$(expr$,c)="^" then op$="^" if mid$(expr$,c)="*" then op$="*" if mid$(expr$,c)="/" then op$="/" if mid$(expr$,c)="+" then op$="+" if mid$(expr$,c)="-" then op$="-" if mid$(expr$,c)="e" then op$="e" rem since sec has already been replaced with something unique, this will not annoy any sec functions. if substring(expr$,c,2)="**" then op$="^" rem ** is exponent as well if len(op$)>0 array insert at bottom part$(0) part$(array count(part$(0)))=substring(expr$,start,(c-start)-1) array insert at bottom operator$(0) operator$(array count(operator$(0)))=op$ if len(op$)=1 rem i don't know why, but I needed this little if statement to fix the end start=c+len(op$)-1 else start=c+len(op$) endif endif next c array insert at bottom part$(0) part$(array count(part$(0)))=substring(expr$,start,len(expr$)-start) ` _print("2") ` wait key for p=0 to array count(part$(0)) if left$(part$(p),2)="N." part$(p)="-"+right$(part$(p),len(part$(p))-2) endif next p rem take care of negative numbers for o=array count(operator$(0)) to 0 step -1 if operator$(o)="-" and part$(o)="" part$(o+1)=str$(val("-"+part$(o+1))) array delete element part$(0),o array delete element operator$(0),o dec o endif next o ` _print("3") ` wait key rem take care of factorials rem note: factorials and variables don't mix. for p= base_part to array count(part$(0)) if right$(part$(p),1)="!" part$(p)=str$(factorial(val(left$(part$(p),len(part$(p))-1)))) endif next p rem take care of exponent stuff for o=0 to array count(operator$(0)) found=0 if operator$(o)="^" part$(o+1)=str$(val(part$(o))^val(part$(o+1))) found=1 endif if operator$(o)="e" part$(o+1)=str$(val(part$(o))*10^val(part$(o+1))) found=1 endif if found=1 array delete element part$(0),o array delete element operator$(0),o dec o endif next o ` _print("4") ` wait key rem take care of multiplication, division, and all the functions. for go_again=1 to 0 step -1 for o=0 to array count(operator$(0)) `if spacekey()=1 then end found=0 if operator$(o)="*" func=0 if part$(o)="FUNCTION0|":part$(o+1)=str$(asin(val(part$(o+1)))):func=1:endif if part$(o)="FUNCTION1|":part$(o+1)=str$(acos(val(part$(o+1)))):func=1:endif if part$(o)="FUNCTION2|":part$(o+1)=str$(atan(val(part$(o+1)))):func=1:endif if part$(o)="FUNCTION3|":part$(o+1)=str$(hsin(val(part$(o+1)))):func=1:endif if part$(o)="FUNCTION4|":part$(o+1)=str$(hcos(val(part$(o+1)))):func=1:endif if part$(o)="FUNCTION5|":part$(o+1)=str$(htan(val(part$(o+1)))):func=1:endif if part$(o)="FUNCTION6|":part$(o+1)=str$(sin(val(part$(o+1)))):func=1:endif if part$(o)="FUNCTION7|":part$(o+1)=str$(cos(val(part$(o+1)))):func=1:endif if part$(o)="FUNCTION8|":part$(o+1)=str$(tan(val(part$(o+1)))):func=1:endif if part$(o)="FUNCTION9|":part$(o+1)=str$(1.0/sin(val(part$(o+1)))):func=1:endif if part$(o)="FUNCTION10|":part$(o+1)=str$(1.0/cos(val(part$(o+1)))):func=1:endif if part$(o)="FUNCTION11|":part$(o+1)=str$(1.0/tan(val(part$(o+1)))):func=1:endif if part$(o)="FUNCTION12|" if val(part$(o+1))<0 _print("Error: Cannot take the square root of a negative number") sync sync wait key end endif part$(o+1)=str$(sqrt(val(part$(o+1)))):func=1 endif if part$(o)="FUNCTION13|":part$(o+1)=str$(abs(val(part$(o+1)))):func=1:endif if part$(o)="FUNCTION14|":part$(o+1)=str$(int(val(part$(o+1)))):func=1:endif if part$(o)="FUNCTION15|":part$(o+1)=str$(exp(val(part$(o+1)))):func=1:endif if part$(o)="FUNCTION16|":part$(o+1)=str$(rnd(val(part$(o+1)))):func=1:endif if part$(o)="FUNCTION17|":part$(o+1)=str$(timer()):func=1:endif if part$(o)="FUNCTION18|":part$(o+1)=str$(floor(val(part$(o+1)))):func=1:endif if part$(o)="FUNCTION19|":part$(o+1)=str$(ceil(val(part$(o+1)))):func=1:endif if part$(o)="FUNCTION20|":part$(o+1)=str$(wrapvalue(val(part$(o+1)))):func=1:endif if part$(o)="FUNCTION21|":part$(o+1)=str$(log(val(part$(o+1)),10.0,6)):func=1:endif if part$(o)="FUNCTION22|":part$(o+1)=str$(log(val(part$(o+1)),2.71828183,6)):func=1:endif if func=0 if notfunction(part$(o+1)) part$(o+1)=str$(val(part$(o))*val(part$(o+1))) else go_again=3 endif else go_again=12 endif found=1 endif if operator$(o)="/" and found=0 if val(part$(o+1))=0 _print("Error: Divide by zero!") sync sync wait key end else if notfunction(part$(o+1)) part$(o+1)=str$(val(part$(o))/val(part$(o+1))) else go_again=2 endif endif found=1 endif if found=1 and go_again<3 or go_again>10 array delete element part$(0),o array delete element operator$(0),o dec o go_again=2 endif next o next go_again ` _print("5") ` wait key rem addition and subtraction: for o=0 to array count(operator$(0)) if operator$(o)="+" part$(o+1)=str$(val(part$(o))+val(part$(o+1))) array delete element part$(0),o array delete element operator$(0),o dec o else if operator$(o)="-" part$(o+1)=str$(val(part$(o))-val(part$(o+1))) array delete element part$(0),o array delete element operator$(0),o dec o endif endif next o expr$=part$(0) if left$(part$(0),1)="-" expr$="N."+right$(part$(0),len(part$(0))-1) endif array delete element part$(0),0 array delete element part$(0),0 array delete element operator$(0),0 variable(0).name="ANS" variable(0).value=expr$ endfunction expr$ function contains(strg$,find$) for c=0 to len(strg$)-len(find$) if substring(strg$,c,len(find$))=find$ exitfunction 1 endif next c endfunction 0 function substring(strg$,start,length) rem these checks prevent the function from complaining about negative values. if start<0 then start=0 if length<0 then length=0 strg$=left$(right$(strg$,len(strg$)-start),length) endfunction strg$ function before_first(strg$,find$) for c=0 to len(strg$)-len(find$) if substring(strg$,c,len(find$))=find$ exitfunction left$(strg$,c) endif next c endfunction strg$ function after_first(strg$,find$) for c=0 to len(strg$)-len(find$) if substring(strg$,c,len(find$))=find$ exitfunction right$(strg$,len(strg$)-(c+len(find$))) endif next c endfunction "" function nonoperator(c$) if c$<>"^" and c$<>"e" and c$<>"*" and c$<>"/" and c$<>"+" and c$<>"-" and c$<>"(" and c$<>")" exitfunction 1 endif endfunction 0 function operator(c$) if c$="^" or c$="e" or c$="*" or c$="/" or c$="+" or c$="-" or c$="(" or c$=")" exitfunction 1 endif endfunction 0 function replace(strg$,find$,rplc$) for c=0 to len(strg$)-len(find$) if substring(strg$,c,len(find$))=find$ strg$=before_first(strg$,find$)+rplc$+after_first(strg$,find$) endif next c endfunction strg$ function equation_replace(strg$,find$,rplc$) strg$=upper$(strg$) find$=upper$(find$) rplc$=upper$(rplc$) for c=0 to len(strg$)-len(find$) if upper$(substring(strg$,c,len(find$)))=find$ newstrg$=before_first(strg$,find$) if nonoperator(right$(newstrg$,1)) and len(newstrg$)>0 newstrg$=newstrg$+"*" endif newstrg$=newstrg$+rplc$ if nonoperator(left$(after_first(strg$,find$),1)) and len(after_first(strg$,find$))>0 newstrg$=newstrg$+"*" endif newstrg$=newstrg$+after_first(strg$,find$) strg$=newstrg$ endif next c endfunction strg$ function function_replace(strg$,func) name$=upper$(user_function(func).name) para$=upper$(user_function(func).parameter) expr$=upper$(user_function(func).expr) ` _print("string:"+strg$) for c=0 to len(strg$)-len(name$) if upper$(substring(strg$,c,len(name$)+1))=name$+"*" newstrg$=before_first(strg$,name$) if nonoperator(right$(newstrg$,1)) and len(newstrg$)>0 newstrg$=newstrg$+"*" endif count=0 startc=c+len(name$)+2 endc=len(strg$)+1 for c2=startc to len(strg$) ` if mid$(strg$,c2)="(" then inc count ` if mid$(strg$,c2)=")" then dec count `_print("stringc:"+mid$(strg$,c2)) if operator(mid$(strg$,c2)) endc=c2 c2=10000 endif next c2 actual_parameter$=substring(strg$,startc-1,endc-startc) `_print("passed parameter:"+actual_parameter$) expr1$=expr$ `_print("startc:"+mid$(strg$,startc)+" endc:"+mid$(strg$,endc)) `_print("normal expr:"+expr1$) `array insert at top lastopen(0) `lastopen(0)=len(newstrg$) expr1$="("+equation_replace(expr1$,para$,actual_parameter$)+")" `_print("new expr:"+expr1$) `wait key no_par=0 function_replaced=1 newstrg$=newstrg$+expr1$ if nonoperator(mid$(strg$,endc)) and endc<len(strg$) newstrg$=newstrg$+"*" endif newstrg$=newstrg$+right$(strg$,len(strg$)-endc+1) strg$=newstrg$ endif next c ` _print("string:"+strg$) endfunction strg$ function proper_function(strg$,find$) for c=0 to len(strg$)-len(find$) if substring(strg$,c,len(find$))=find$ newstrg$=left$(strg$,c)+"("+find$ in=0 if mid$(strg$,c+len(find$)+1)<>"*" if mid$(strg$,c+len(find$)+1)<>"(" in=1 newstrg$=newstrg$+"(" endif par=0 for c2=c+len(find$) to len(strg$) if mid$(strg$,c2)<>"(" then inc par if mid$(strg$,c2)<>")" then dec par if (operator(mid$(strg$,c2)) or c2=len(strg$)) and par<=0 and (c2>c+len(find$)+1 or mid$(strg$,c+len(find$)+1)<>"-") if c2=len(strg$) then c2=c2+1 newstrg$=newstrg$+substring(strg$,c+len(find$),c2-(c+len(find$))-1)+")" if in=1 newstrg$=newstrg$+")" endif newstrg$=newstrg$+right$(strg$,len(strg$)-c2+1) c2=1000 endif next c2 strg$=newstrg$ inc c,2 endif endif next c endfunction strg$ function factorial(num) rem factorial defined as a recursive function if num>1 exitfunction num*factorial(num-1) endif endfunction 1 function _print(strg$) if line0*text height("X")>screen height() cls line0=0 endif ink 0,0 box 0,line0*text height("X"),screen width()-1,(line0+1)*text height("X") ink rgb(255,255,255),0 text 0,line0*text height("X"),strg$ inc line0 sync endfunction function notfunction(strg$) for n=0 to function_amount if upper$(strg$)=upper$("FUNCTION"+str$(n)+"|") exitfunction 0 endif next n endfunction 1 function removeextraspaces(strg$) while left$(strg$,1)=" " strg$=right$(strg$,len(strg$)-1) endwhile while right$(strg$,1)=" " strg$=left$(strg$,len(strg$)-1) endwhile endfunction strg$ function log(nr#, base#,acc) result# = 0.00 for c = 0 to acc repeat inc result#, base#^(c*-1) until base#^result# >= nr# if base#^result# = nr# exitfunction result# else dec result#, base#^(c*-1) endif next c endfunction result#