FreeBASIC Programming (or any programming)?

General FreeBASIC programming questions.
Post Reply
GeorgeStevens
Posts: 2
Joined: Apr 13, 2021 4:02

FreeBASIC Programming (or any programming)?

Post by GeorgeStevens »

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???
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: FreeBASIC Programming (or any programming)?

Post by BasicCoder2 »

You appear to want an expression evaluator routine?
dafhi
Posts: 1641
Joined: Jun 04, 2005 9:51

Re: FreeBASIC Programming (or any programming)?

Post by dafhi »

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.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: FreeBASIC Programming (or any programming)?

Post by dodicat »

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.
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: FreeBASIC Programming (or any programming)?

Post by MrSwiss »

GeorgeStevens wrote: I would just like a program that I can just put 5+5 into and have it say 10.
Well, that sounds to me like a BASIC-interpreter and not a BASIC-compiler ...
Maybe something like SmallBASIC? (on SourceForge)
Muttonhead
Posts: 139
Joined: May 28, 2009 20:07

Re: FreeBASIC Programming (or any programming)?

Post by Muttonhead »

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
q quit program
c clear memory
return calculate
p ^2
s square root
n negative value

worst ever :)
Mutton
Post Reply