chastdin for FreeBASIC

I have rewritten my chastdin program (the stack based calculator that reads keyboard input from standard input) into the FreeBASIC programming language. I did it as an exercise to prepare myself for a future book on the BASIC programming language which was my first programming language. FreeBASIC is compatible with QBASIC which is what I first started on. Luckily, BASIC is not so different from C but I had to spend a lot of time on the documentation to refresh my memory in how I used to do things with it.

Eventually I would like to make a GUI version of this command line calculator. I am trying to take baby steps in working my way into programs that the average person would use. However, command line utilities are still the easiest to build and that is an acceptable place to start.

main.bas

#include "chastelib.bi"
#include "chastdin.bi"

dim shared as integer chastack(256)
dim shared as integer csi=0 'Chastity's Stack Index

radix=10

dim as integer a,b
dim shared as string s

sub help()
?  "chastdin is a stack based interactive calculator"
?  "Numbers are pushed on the stack and commands can do math."
?  "It is a fork of chastack that reads from stdin instead of arguments."
?  "Each line can contain multiple numbers or commands."
?
?  "Math commands are add,sub,mul,div,rem"
?  "And use the top two stack numbers for their operations"
?
?  "The setradix command uses the top of stack as the new radix"
?  "The exit command ends the program"
?  "The ? command prints the entire stack"
?
end sub

sub stack_check()
 if csi>0 then
  chastack(csi+1)=0 /'erase old top of stack because command was successful'/
 else
  print "Error: two numbers required for command: ";s
  csi+=1 /'increment the pointer to what it was before the failed command'/
 end if
end sub

help():

while s<>"exit"

s=""

 s=getstr() 'read and ignore empty strings

'print entire stack
if s="?" or s="print" then
 b=csi
 while csi>0
  print intstr(chastack(csi))
  csi-=1
 wend
 csi=b

elseif s="exit" then
exit while

elseif s="help" then
help()

elseif s="setradix" then
 if csi>0 then
 radix=chastack(csi)
 chastack(csi)=0
 csi-=1
 else
  print "Error: need one number on stack for command: ";s
 end if

elseif s="add" then
b=chastack(csi)
csi-=1
a=chastack(csi)
a+=b
chastack(csi)=a
stack_check()

elseif s="sub" then
b=chastack(csi)
csi-=1
a=chastack(csi)
a-=b
chastack(csi)=a
stack_check()

elseif s="mul" then
b=chastack(csi)
csi-=1
a=chastack(csi)
a*=b
chastack(csi)=a
stack_check()

elseif s="div" then
b=chastack(csi)
csi-=1
a=chastack(csi)
a\=b
chastack(csi)=a
stack_check()

elseif s="rem" then
b=chastack(csi)
csi-=1
a=chastack(csi)
a=a mod b
chastack(csi)=a
stack_check()

else

'try to interpret string as a number if not empty
 a=strint(s)
 if strint_errors<>0 or len(s)=0 then
 'print s;" cannot be added to the stack because it is not a valid number"
 else
 csi+=1
 chastack(csi)=a
 print intstr(a);" was added to the stack"
 end if

end if

wend

/'
 This is a FreeBASIC program.

 compile and run as:

 fbc main.bas && ./main
'/

chastelib.bi

/'
 global variables to define radix and formatting
 for the intstr function
'/
dim shared as integer radix=2
dim shared as integer int_width=1

/'
 translation of intstr function for FreeBASIC
 by original C programmer Chastity White Rose
'/
function intstr(i as uinteger) as string
 dim as string s=""
 dim as integer w=0
 dim as byte c

 while i<>0 or w<int_width 

  c=i mod radix                  
  i\=radix                     

  if c<10 then 
  c+=48
  else
  c+=55
  end if

  s=chr(c)+s

  w+=1                     
 wend

return s
end function

/'
 global variable for error detection in strint function
 this variable will be zero if last string was a number
'/
dim shared as integer strint_errors=0

/'
 translation of strint function for FreeBASIC
 by original C programmer Chastity White Rose
'/
function strint(s as string) as uinteger
dim as uinteger i=0
dim as integer x=0,y=len(s)
dim as byte c

strint_errors = 0 /' clear errors '/

while x<y

 /' read digit from string '/
 c=s[x]

 /' 0 to 9 '/
 if c >= 48 and c <= 57 then
 c-=48
 /' A to Z '/
 elseif c >= 65 and c <= 90 then
 c-=65
 c+=10
 /' a to z '/
 elseif c >= 97 and c <= 122 then
 c-=97
 c+=10
 /' whitespace '/
 elseif c >= 0 and c <= 32 then
  exit while /' exit correctly at string end '/
 else
  strint_errors+=1
  print "Error: ";chr(s[x]);" is not an alphanumeric character!"
  exit while /' exit at invalid character '/
 end if

 if c>=radix then
  strint_errors+=1
  print "Error: ";chr(s[x]);" is not a valid character for radix ";radix
  exit while /' exit at digit wrong for radix '/
 end if

 /'multiply by radix then add digit'/
 i*=radix
 i+=c

x+=1
wend

return i
end function

chastdin.bi

dim shared as string stdin_buf
dim shared as integer stdin_buf_index
dim shared as integer stdin_buf_length=0

function getstr() as string
dim as string s=""         'create empty string
dim as byte c              'temporary byte/char variable

/'
this section gets a line of text
if the length of the string/buffer is 0
'/

if stdin_buf_length=0 then      'check if there are characters in the buf
input "-> ",stdin_buf           'if not, read a line of text
stdin_buf_index=0               'set index to zero
stdin_buf_length=len(stdin_buf) 'set the length
end if

/'
regardless of whether input was added above
or if it still had bytes from the last input
we then extract characters one at a time into the
substring s to be returned from the function
'/

while stdin_buf_index<stdin_buf_length
c=stdin_buf[stdin_buf_index]
stdin_buf_index+=1
if(c>=33) and (c<=126) then
s=s+chr(c)
else
exit while
endif
wend

/'
if the index matches the length of buffer
set length to zero so that more will be read
next time this function is called
'/

if stdin_buf_index=stdin_buf_length then
stdin_buf_length=0
end if

return s
end function

/'
the getline function always gets an entire line of text
I don't really need it but it is here as a reminder of
how to use the input statement in FreeBASIC
'/

function getline() as string
dim as string s=""
input "-> ",stdin_buf
s=stdin_buf
return s
end function

Comments

Leave a comment