I want to make a calculator. a simple 4 function (+-/x) using ANY type of free software writing program. Though I would prefer to use FreeBASIC because I would love it if I could install this program onto my ti 84 using the mirageOS.
Now what I want this calculator to be able to do is very simple. I wish so that when you type in an equation, it solves it. you don't have to select any settings or be prompted for variables. I would just like a program that I can just put 5+5 into and have it say 10. I don't want anything like what I currently have... (which is where it asks what operation to perform and then individually prompts you for each number. why is this so difficult???
FreeBASIC Programming (or any programming)?
-
- Posts: 2
- Joined: Apr 13, 2021 4:02
-
- Posts: 3906
- Joined: Jan 01, 2009 7:03
- Location: Australia
Re: FreeBASIC Programming (or any programming)?
You appear to want an expression evaluator routine?
Re: FreeBASIC Programming (or any programming)?
something like ..
Code: Select all
function answer(mystr as string) as single
#define a val( left( mystr, i+1))
#define b val( right( mystr, len(mystr)-1 - i))
for i as integer = 0 to len(mystr)
var c = chr(mystr[i])
select case c
case "+": return a+b
case "-": return a-b
case "/": return a/b
case "*": return a*b
end select
next
#undef a
#undef b
return 0
End Function
print answer( "4.5/ 5")
Last edited by dafhi on Apr 13, 2021 23:08, edited 2 times in total.
Re: FreeBASIC Programming (or any programming)?
A windows one.
Code: Select all
#include "windows.bi"
#include "crt.bi"
'========= start =========='
declare Function eval(Byref sp As String ) As Double
declare Function inputbox(message As String) As string
Var n1=inputbox("Enter your equation: ")
sleep
Dim Shared e_input As String
Dim Shared e_tok As String
Dim Shared e_spelling As String
Dim Shared e_error As Integer
Function Set_Font (Font As String,Size As Integer,Bold As Integer,Italic As Integer,Underline As Integer,StrikeThru As Integer) As HFONT
Dim As HDC hDC=GetDC(HWND_DESKTOP)
Dim As Integer CyPixels=GetDeviceCaps(hDC,LOGPIXELSY)
ReleaseDC(HWND_DESKTOP,hDC)
Return CreateFont(0-(Size*CyPixels)/72,0,0,0,Bold,Italic,Underline,StrikeThru,ANSI_CHARSET _
,OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,FF_DONTCARE,Font)
End Function
Function inputbox(message As String) As string
Dim As HFONT ThisFont=Set_Font("Times new roman",12,0,0,0,0)
Dim As Double result
Dim As HWND Main_Win,OKwin,edit,cancel,answer
Main_Win=CreateWindowEx(0,"#32770",message,WS_OVERLAPPEDWINDOW Or WS_VISIBLE,200,200,400,200,0,0,0,0)
OKwin=CreateWindowEx(0,"button","OK", WS_VISIBLE Or WS_CHILD,0,0,60,30,Main_win,0,0,0)
edit=CreateWindowEx(0,"edit","", WS_VISIBLE Or WS_CHILD Or WS_Border,5,80,290,30,Main_win,0,0,0)
answer=CreateWindowEx(0,"static","", WS_VISIBLE Or WS_CHILD Or WS_Border,5,130,290,30,Main_win,0,0,0)
cancel=CreateWindowEx(0,"button","END", WS_VISIBLE Or WS_CHILD,0,40,60,30,Main_win,0,0,0)
SendMessage(edit,WM_SETFONT,Cast(WPARAM,ThisFont),0)
SendMessage(OKWin,WM_SETFONT,Cast(WPARAM,ThisFont),0)
SendMessage(cancel,WM_SETFONT,Cast(WPARAM,ThisFont),0)
SetFocus( edit )
Dim As msg msg
While GetMessage( @msg,Main_Win,0,0)
TranslateMessage(@msg)
DispatchMessage(@msg)
Select Case msg.hwnd
Case Main_Win
Select Case msg.message
Case 273
DeleteObject(Cast(HGDIOBJ,ThisFont))
End
End Select
Case OKwin
Select Case msg.message
Case WM_LBUTTONDOWN
cls
Dim As zstring * 500 s
GetWindowText(edit,s,100)
result=eval(s)
setwindowtext(answer,str(result))
End Select
Case cancel
Select Case msg.message
Case WM_LBUTTONDOWN
destroywindow(Main_Win)
Exit While
End Select
End Select
Wend
DeleteObject(Cast(HGDIOBJ,ThisFont))
Return ""
End Function
'============== PARSER START ==================================
Function SEC(Byval x As Double) As Double
SEC = 1 / Cos(x)
End Function
Function COSEC(Byval x As Double) As Double
COSEC = 1 / Sin(x)
End Function
Function COT(Byval x As Double) As Double
COT = 1 / Tan(x)
End Function
Function ARCSEC(Byval x As Double) As Double ''''''
ARCSEC = Atn(x / Sqr(x * x - 1)) + Sgn((x) -1) * (2 * Atn(1))
End Function
Function ARCCOSEC(Byval x As Double) As Double
ARCCOSEC = Atn(x / Sqr(x * x - 1)) + (Sgn(x) - 1) * (2 * Atn(1))
End Function
Function ARCCOT(Byval x As Double) As Double
ARCCOT = Atn(x) + 2 * Atn(1)
End Function
Function sech(Byval x As Double) As Double
sech = 2 / (Exp(x) + Exp(-x))
End Function
Function cosech(Byval x As Double) As Double
cosech = 2 / (Exp(x) - Exp(-x))
End Function
Function coth(Byval x As Double) As Double
coth = (Exp(x) + Exp(-x)) / (Exp(x) - Exp(-x))
End Function
Function arcsinh(Byval x As Double) As Double
arcsinh = Log(x + Sqr(x * x + 1))
End Function
Function arccosh(Byval x As Double) As Double
arccosh = Log(x + Sqr(x * x - 1))
End Function
Function arctanh(Byval x As Double) As Double
arctanh = Log((1 + x) / (1 - x)) / 2
End Function
Function arcsech(Byval x As Double) As Double
arcsech = Log((Sqr(-x * x + 1) + 1) / x)
End Function
Function arccosech(Byval x As Double) As Double
arccosech = Log((Sgn(x) * Sqr(x * x + 1) +1) / x)
End Function
Function arccoth(Byval x As Double) As Double
arccoth = Log((x + 1) / (x - 1)) / 2
End Function
Function HAVERSINE(Byval x As Double) As Double
HAVERSINE = (Sin(x/2))^2
End Function
function pies(byval x as double=1) as double
return (4*atn(1))*x
end function
Function e_function(Byref fun As String,Byval arg As Double) As Double
Dim n As Double
Select Case Lcase(fun)
Case "abs": n = Abs(arg)
Case "atn": n = Atn(arg)
Case "cos": n = Cos(arg)
Case "exp": n = Exp(arg)
Case "ezp": n = Exp(arg)
Case "fix": n = Fix(arg)
Case "int": n = Int(arg)
Case "log": n = Log(arg)
Case "rnd": n = Rnd(arg)
Case "sgn": n = Sgn(arg)
Case "sin": n = Sin(arg)
Case "sqr": n = Sqr(arg)
Case "tan": n = Tan(arg)
Case "haversine":n=haversine(arg)
Case "cosec":n=cosec(arg)
Case "sec":n=sec(arg)
Case "cot": n=cot(arg)
Case "asin":n=Asin(arg)
Case "acos":n=Acos(arg)
Case "atn":n=Atn(arg)
Case "arcsec":n=arcsec(arg)
Case "arccosec":n=arccosec(arg)
Case "arccot":n=arccot(arg)
Case "sinh":n=sinh(arg)
Case "cosh":n=cosh(arg)
Case "tanh":n=tanh(arg)
Case "sech":n=sech(arg)
Case "cosech":n=cosech(arg)
Case "coth":n=coth(arg)
Case "arcsinh":n=arcsinh(arg)
Case "arccoth":n=arccoth(arg)
Case "arctanh":n=arctanh(arg)
Case "arcsech":n=arcsech(arg)
Case "arccosech":n=arccosech(arg)
Case "pi" :n=pies(arg)
Case Else
If Not e_error Then
Locate 1,1
Print "UNDEFINED FUNCTION " + fun
Print
e_error = -1
End If
End Select
e_function = n
End Function
Sub e_nxt()
Dim is_keyword As Integer
Dim c As String
e_tok = ""
e_spelling = ""
Do
c = Left(e_input, 1)
e_input = Mid(e_input, 2)
Loop While c = " " Or c = Chr(9) Or c = Chr(13) Or c = Chr(10)
Select Case Lcase(c)
Case "0" To "9", "."
e_tok = "num"
Do
e_spelling = e_spelling + c
c = Left(e_input, 1)
e_input = Mid(e_input, 2)
Loop While (c >= "0" And c <= "9") Or c = "."
e_input = c + e_input
Case "a" To "z", "_"
Dim As Integer is_id
e_tok = "id"
Do
e_spelling = e_spelling + c
c = Lcase(Left(e_input, 1))
e_input = Mid(e_input, 2)
is_id = (c >= "a" And c <= "z")
is_id = is_id Or c = "_" Or (c >= "0" And c <= "9")
Loop While is_id
e_input = c + e_input
is_keyword = -1
Select Case Lcase(e_spelling)
Case "and"
Case "eqv"
Case "imp"
Case "mod"
Case "not"
Case "or"
Case "xor"
Case Else: is_keyword = 0
End Select
If is_keyword Then
e_tok = Lcase(e_spelling)
End If
Case "<", ">"
e_tok = c
c = Left(e_input, 1)
If c = "=" Or c = ">" Then
e_tok = e_tok + c
e_input = Mid(e_input, 2)
End If
Case Else
e_tok = c
End Select
If e_spelling = "" Then
e_spelling = e_tok
End If
End Sub
Sub e_match (Byref token As String)
If Not e_error And e_tok <> token Then
Locate 1,1
Print "EXPECTED " + token + ", got '" + e_spelling + "'"
e_error = -1':end
End If
e_nxt()
End Sub
Function e_prs (Byval p As Integer) As Double
Dim n As Double
Dim fun As String
If e_tok = "num" Then
n = Val(e_spelling)
e_nxt()
Elseif e_tok = "-" Then
e_nxt()
n = -e_prs(12) '' 11 before
Elseif e_tok = "not" Then
e_nxt()
n = Not e_prs(6)
Elseif e_tok = "(" Then
e_nxt()
n = e_prs(1)
e_match(")")
Elseif e_tok = "id" Then
fun = e_spelling
e_nxt()
e_match("(")
n = e_prs(1)
e_match(")")
n = e_function(fun, n)
Else
If Not e_error Then
Locate 1,1
Print "syntax error, at '" + e_spelling + "'"
e_error = -1':end
End If
End If
Do While Not e_error
If p <= 11 And e_tok = "^" Then
e_nxt(): n = n ^ e_prs(12)
Elseif p <= 10 And e_tok = "*" Then
e_nxt(): n = n * e_prs(11)
Elseif p <= 10 And e_tok = "/" Then
e_nxt(): n = n / e_prs(11)
Elseif p <= 9 And e_tok = "\" Then
e_nxt(): n = n \ e_prs(10)
Elseif p <= 8 And e_tok = "mod" Then
e_nxt(): n = n Mod e_prs(9)
Elseif p <= 7 And e_tok = "+" Then
e_nxt(): n = n + e_prs(8)
Elseif p <= 7 And e_tok = "-" Then
e_nxt(): n = n - e_prs(8)
Elseif p <= 6 And e_tok = "=" Then
e_nxt(): n = n = e_prs(7)
Elseif p <= 6 And e_tok = "<" Then
e_nxt(): n = n < e_prs(7)
Elseif p <= 6 And e_tok = ">" Then
e_nxt(): n = n > e_prs(7)
Elseif p <= 6 And e_tok = "<>" Then
e_nxt(): n = n <> e_prs(7)
Elseif p <= 6 And e_tok = "<=" Then
e_nxt(): n = n <= e_prs(7)
Elseif p <= 6 And e_tok = ">=" Then
e_nxt(): n = n >= e_prs(7)
Elseif p <= 5 And e_tok = "and" Then
e_nxt(): n = n And e_prs(6)
Elseif p <= 4 And e_tok = "or" Then
e_nxt(): n = n Or e_prs(5)
Elseif p <= 3 And e_tok = "xor" Then
e_nxt(): n = n Xor e_prs(4)
Elseif p <= 2 And e_tok = "eqv" Then
e_nxt(): n = n Eqv e_prs(3)
Elseif p <= 1 And e_tok = "imp" Then
e_nxt(): n = n Imp e_prs(2)
Else
Exit Do
End If
Loop
e_prs = n
End Function
Function eval(Byref sp As String ) As Double
Dim As Double value
e_error = 0
e_input = sp
e_nxt()
value = e_prs(1)
If Not e_error Then Return value else e_error=0
End Function
Last edited by dodicat on Apr 13, 2021 13:48, edited 1 time in total.
Re: FreeBASIC Programming (or any programming)?
Well, that sounds to me like a BASIC-interpreter and not a BASIC-compiler ...GeorgeStevens wrote: I would just like a program that I can just put 5+5 into and have it say 10.
Maybe something like SmallBASIC? (on SourceForge)
-
- Posts: 139
- Joined: May 28, 2009 20:07
Re: FreeBASIC Programming (or any programming)?
Code: Select all
type calculator
buffer as string
op as string
valueA as double
valueB as double
display as string
errorlock as integer
rewritebuffer as integer
declare constructor
declare sub initvalues
declare sub AddDigitToBuffer(digit as string)
declare function FindDotPos as integer
declare sub show
declare sub oplogic(newop as string)
declare sub flogic(func as string)
declare function Float2string(value as double) as string
end type
constructor calculator
end constructor
sub calculator.initvalues
op=""
valueA=0
valueB=0
buffer=float2String(valueA)
display=buffer
errorlock=0
rewritebuffer=0
show
end sub
sub calculator.AddDigitToBuffer(digit as string)
if errorlock then exit sub
if rewritebuffer then
buffer="0"
rewritebuffer=0
end if
if buffer="0" then buffer=""
if len(buffer)<10 then
if digit="." then
if FindDotPos=0 then buffer +=digit
else
if FindDotPos<=2 then buffer +=digit
end if
end if
display=buffer
show
end sub
function calculator.FindDotPos as integer
function=0
dim as integer i
if len(buffer)>0 then
for i=len(buffer) to 1 step -1
if mid(buffer,i,1)="." then function=len(buffer)-i+1
next i
end if
end function
sub calculator.show
locate (1,1)
print op & space(3) & display & space(20)
end sub
sub calculator.oplogic (newop as string)
if errorlock then exit sub
if buffer<>"" then
if op="" then
valueA=val(buffer)
display=float2String(valueA)
else
valueB=val(buffer)
select case op
case "+"
valueA=valueA + valueB
display=float2String(valueA)
case "-"
valueA=valueA - valueB
display=float2String(valueA)
case "*"
valueA=valueA * valueB
display=float2String(valueA)
case "/"
if valueB=0 then
errorlock=1
display="Error"
else
valueA=valueA / valueB
display=float2String(valueA)
end if
end select
end if
if abs(valueA)>9999999999 then
errorlock=1
display="Overflow"
end if
buffer=""
rewritebuffer=0
end if
op=newop
show
end sub
sub calculator.flogic (func as string)
if errorlock then exit sub
dim tempvalue as double
if buffer<>"" then
tempvalue=val(buffer)
else
tempvalue=valueA
end if
select case func
case "neg"
tempvalue=tempvalue*-1
display=float2String(tempvalue)
case "sqr"
if sgn(tempvalue)=-1 then
errorlock=1
tempvalue=0
display="Error"
else
tempvalue=sqr(tempvalue)
display=float2String(tempvalue)
end if
case "x^2"
tempvalue=tempvalue^2
if tempvalue>9999999999 then
errorlock=1
display="Overflow"
else
display=float2String(tempvalue)
end if
end select
if buffer<>"" then
buffer=float2String(tempvalue)
rewritebuffer=1
else
valueA=tempvalue
end if
show
end sub
function calculator.Float2String(value as double) as string
function="0"
dim as integer l
dim as string vstring,newstring
vstring = str(int(100! * abs(value) + .5))
l=len(vstring)
if l=1 then newstring ="0.0" & vstring
if l=2 then newstring ="0." & vstring
if l>2 then newstring =left(vstring,l-2) & "." & right(vstring,2)
if right(newstring,3)=".00" then newstring=left(newstring,len(newstring)-3)
if sgn(value)=-1 then newstring ="-" & newstring
function=newstring
end function
dim calc as calculator ptr
calc=new calculator
dim as string key
if calc then
calc->initvalues
calc->show
do
sleep
key=inkey
select case key
case "0","1","2","3","4","5","6","7","8","9","."
calc->AddDigitToBuffer(key)
case "+","-","*","/"
calc->oplogic(key)
case chr(13)
calc->oplogic("")
case "c"
calc->initvalues
case "n"
calc->flogic("neg")
case "s"
calc->flogic("sqr")
case "p"
calc->flogic("x^2")
end select
calc->show
loop until key="q"
delete calc
end if
c clear memory
return calculate
p ^2
s square root
n negative value
worst ever :)
Mutton