FUNCTION InstrP(source As STRING, search As STRING,start as INT) As INT
'this sub searches for the LAST string search in the string source,
'reverse of the function instr(). The sub returns 0 if the search could not be found.
'Also this function neglects content between brackets () in source
INT n, bopen,bclose
STRING sign
start=255
n=start
IF n > LEN(source) THEN n = LEN(source) - LEN(search)+1
bopen=0 'number of bracket open
bclose=0 'number of bracket close
DO
sign = MID(source, n, LEN(search))
IF sign=search AND bopen=bclose THEN RETURN n 'exit the sub, return n
IF LEFT(sign,1)=chr(28) THEN bopen++
IF LEFT(sign,1)=chr(29) THEN bclose++
n=n-1
IF n <= 0 THEN EXIT DO
END DO
RETURN 0 'if the string search is not found, then return 0
END FUNCTION/*
Simple Expression Evaluator
Supports expressions with operators + - * / ^ E and parentheses ( )
Original by: JOS de JONG -> Joske
*/
indexbase 0
#lookahead ' for procedures
INT TRUE = 1
INT FALSE = 0
STRING out,msg
'test
'---------------------------------
String in$
'in$ = "(2+3)-1"
'in$ = "2+(3-2)"
'in$ = "(2+3)*3"
in$ = "12/(3-1)"
out = Eval_line(in$)
print out
'----------------------------------
FUNCTION Eval_line(expression As STRING) As STRING
'this sub evaluates the expression and returns a string that
'can contain the answer or an (error) message.
'the expression can have values, operators + - * / ^ E and parentheses ( )
FLOAT ans
msg=""
ans = Eval(expression) 'evaluate the expression
'print "ANS: "+ str(ans)
IF msg<>"" THEN RETURN msg :'return (error) message if not empty
RETURN "Ans = " + str(ans) :'return the answer
END FUNCTION
'_______________________________________________________________
FUNCTION Eval(expression As STRING) As FLOAT
'evaluate expression
'The expression can contain operators, values, parentheses, spaces
'Input: a string containing an expression
'Output: a FLOAT, containing the answer of the expression.
STRING expr, op
INT n, i
FLOAT value1, value2, res
expr = Trim(expression) :'copy the expression to another to keep the original string intact
'check if expr is equal to a value. If so, return the value of expr
IF IsOK_value(Trim(expr))=TRUE THEN RETURN val(Trim(expr))
'check for the operator with the lowest precedence (outside parenthesis), and evalulate it
'order from low to high: + - * / ^ E
FOR i=1 TO 6
op = MID("+-*/^E", i, 1)
n = InstrP(expr, op,len op)
'print "N: " + str(n)
WHILE n > 0
IF IsOK_operator(expr,op,n) = TRUE
'this is indeed an operator. evaluate it
'IF n=1: ert("Error: Missing value before operator " + op): RETURN : END IF
'IF n=LEN(expr): ert("Error: Missing value after operator " + op):RETURN : END IF
'IF op="E" THEN
'IF MID(expr,n+1,1)="+" THEN Replace(expr,n+1,1," ") :'replace "2e+3" with "2e 3" (remove unary plus)
' END IF
value1 = Eval(LEFT(expr,n-1))
value2 = Eval(Right(expr,LEN(expr)-n))
IF op ="+" THEN res = value1 + value2
IF op ="-" THEN res = value1 - value2
IF op ="*" THEN res = value1 * value2
IF op ="/"
'IF value2=0: ert("Error: Divide by zero") :RETURN 0 :END IF
res = value1 / value2
END IF
IF op ="^" THEN res = value1 ^ value2
'IF op ="E" THEN res = value1 * 10^value2
'print "RES: "+ str(res)
RETURN res
END IF
IF n>0 THEN n = InstrP(UCASE(expr), op, n-1) :'search for previous operator
WEND
NEXT i
IF LEFT(expr,1)="(" AND RIGHT(expr,1)=")" THEN
'remove parentheses at start and end, for example "(2+3)" -> "2+3"
RETURN Eval(MID(expr,2,LEN(expr)-2))
END IF
'if still not evalved, then return an error
'ert("Error: Syntax error in part '" + expr + "'")
RETURN 0
END FUNCTION
'_______________________________________________________________
FUNCTION IsOK_operator(expr As STRING, op As string, n As int) As string
'this sub checks of the operator at postion n in expr is a legal operator
'for example the "+" in "2.3E+3" is no operator, and the "-" in "-2.5" is no operator but a unary minus
STRING sign2
IF op="+"
IF UCASE(MID(expr,n-1,1))="E"
IF n>2
IF INSTR("1234567890.", MID(expr,n-2,1))>0 THEN RETURN FALSE
END IF
END IF
ENDIF
IF op="-"
IF n=1
'this is an unary minus
RETURN FALSE
ELSE
'check for an unary minus (for example 2*-3 or 2.5E-6)
sign2 = LEFT(expr,n-1)
sign2 = RTRIM(sign2)
sign2 = Right(sign2,1)
IF INSTR("+-/*^", sign2)>0 THEN RETURN FALSE
'IF UCASE(MID(expr,n-1,1))="E"
'IF n>2
'IF INSTR("1234567890.", MID(expr,n-2,1))>0 THEN RETURN FALSE
' END IF
'END IF
END IF
END IF
RETURN TRUE
END FUNCTION
'_______________________________________________________________
FUNCTION IsOK_value(expr As STRING) As string
'this sub checks if expr is a legal value. if so, returns true. if not, returns false
INT i
STRING sign
FOR i=1 TO LEN(expr)
sign = UCASE(MID(expr,i,1))
IF INSTR("1234567890.-", sign)=0 THEN RETURN FALSE 'check for legal signs in the string
'IF sign="." THEN IF INSTR(expr,".",i+1)>0 THEN RETURN FALSE 'check if there is max. 1 point in the string
IF sign="-" THEN
IF i<>1 THEN RETURN FALSE
END IF 'check for correct use of minus: only at position 1
NEXT i
RETURN TRUE
END FUNCTION
'__________________________________________________________________
'__________________________________________________________________
FUNCTION Trim(mystr As STRING) As STRING
'remove spaces and tabs at start and end of the string
RETURN LTRIM(RTRIM(mystr))
END FUNCTION
'__________________________________________________________________
'__________________________________________________________________
FUNCTION InstrP(source As STRING, search As STRING,start as INT) As INT
'this sub searches for the LAST string search in the string source,
'reverse of the function instr(). The sub returns 0 if the search could not be found.
'Also this function neglects content between brackets () in source
INT n, bopen,bclose
STRING sign
start=255
n=start
IF n > LEN(source) THEN n = LEN(source) - LEN(search)+1
bopen=0 'number of bracket open
bclose=0 'number of bracket close
do
sign = MID(source, n, LEN(search))
IF (sign=search) AND (bopen=bclose) THEN Return n 'exit the sub, return n
IF LEFT(sign,1)="(" THEN bopen=bopen+1
IF LEFT(sign,1)=")" THEN bclose=bclose+1
n=n-1
if n<=0 then exit do
end do
RETURN 0 'if the string search is not found, then return 0
END FUNCTION
'_________________________________________________________________________
FUNCTION Right(getStr As String,rLen As Int) As String
String retStr
retStr = MID(getStr,-rLen)
Return retStr
END FUNCTION
'_________________________________________________________________________
FUNCTION Replace(t as string,w as string,r as string) As String
'=======================================
'
sys a,b,lw,lr
string s=t
'
lw=Len w
lr=Len r
a=1
'
DO
a=INSTR a,s,w
IF a=0 THEN EXIT DO
s=LEFT(s,a-1)+r+MID(s,a+lw)
a=a+lr
END DO
RETURN s
END FUNCTION
function eval (string s) as double
'=================================
'
sys a,c
string t,er
'
t="function f() as double {return "+s+"} : c=@f "
'
a=compile t
er=error
'
if er then
print "runtime error: " er : exit function
end if
'
c=call a
declare f()as double at c
function=f()
'
freememory a
'
end function
'=====
'TESTS
'=====
print eval "3*3*3"
print eval "sqr(64)"
print eval "pi()"
case "a" to "z"
vi=b : v=vv[vi] : dp=0
'vi=b : v=GetIntValue(string ) :dp=0
print
what is this?
spam?
Turkey is the focus on the day before Black Friday.'SIMPLE EVALUATOR
' supporting:
' +-*/
' floating ppoint values
' variables a..z
' brackets
' multiple statements and lines
indexbase 0
% maxvar 1024
string vn[maxvar] ' variable name
double vv[maxvar] ' variable store
double st[16] ' stack value
sys sp[16] ' stack operator
sys vnb=1 ' base of var lists
sys vne=1 ' end of var lists
function wordbound(byte*b) as sys
=================================
do
select b
case "0" to "9"
case "A" to "Z"
case "a" to "z"
case else : exit do
end select
@b++
end do
return @b
end function
function newvar(string wr,double v) as sys
==========================================
vn[vne]=wr 'new variable name
vv[vne]=0 'value
vne++
if vne>maxvar then vne=maxvar 'clamp
return vne-1
end function
function lookup(string wr) as sys
=================================
sys i=vnb,f=0
do
if i>=vne then exit do 'end of var list
if wr=vn[i] then f=i : exit do
i++
end do
return f
end function
function lookupv(sys p) as sys
==============================
byte b at (*p)
byte e at (wordbound b)
sys lw=@e-@b
if lw=0 then return 0 'empty word
*p=@e-1 'update source position
string wr=nuls lw
copy strptr(wr),@b,lw
sys f=lookup(wr)
if not f then f=newvar(wr,0)
return f
end function
function evalnm(sys *dp, double *v,sys b)
=========================================
b-=48
if dp=0
v=v*10+b
else
dp*=10
v=v+b/dp
end if
end function
function evalop(sys op, double *a,v)
====================================
select op
case 0 : a=v
case "+" : a+=v
case "-" : a-=v
case "*" : a*=v
case "/" : a/=v
case
end select
end function
function eval(string s) as double
=================================
byte b at (strptr s) 'source string
double a 'accum
double v 'value
sys op 'operator
sys ai 'accum index
sys si 'stack index
sys vi 'variable index
sys dp 'decimal point
do
select b
case 0 : evalop(op,a,v) : return a
case 10 to 13 : evalop(op,a,v) : vv[ai]=a : a=0 : v=0 : op=0 : dp=0
case ":" : evalop(op,a,v) : vv[ai]=a : a=0 : v=0 : op=0 : dp=0
case "0" to "9" : evalnm(dp,v,b)
case "A" to "Z" : vi=lookupv(@@b) : v=vv(vi) : dp=0
case "a" to "z" : vi=lookupv(@@b) : v=vv(vi) : dp=0
case "=" : ai=vi
case "." : dp=1
case 42 to 47 : evalop(op,a,v) : op=b : v=0 : dp=0
case "(" : st[si]=a : sp[si]=op : a=0 : v=0 : op=0 : dp=0 : si++
case ")" : evalop(op,a,v) : si-- : v=a : a=st[si] : op=sp[si] : dp=0
end select
@b++
end do
end function
print eval("av=32 : bv=16.25 : 2*(av+bv) ") '96.5
What is now 'TURKEY' ?
string wr=nuls lw
copy strptr(wr),@b,lw
print "WORD:" + wrso finally i get string (word)..i don't know nothing about copy command ???string wr=nuls lw
copy strptr(wr),@b,lw
print "WORD:" + wr
float f = GetIntValue(wr)
'print "F:" + f
return fcase "a" to "z"
v=lookupv(@@b) :dp=0and variable value is properly calculated...defINT n,start1,e,i,x,r
Set n=1,start1 = 2,e=3
wForm 100,0,400,400,#MMS,0,"New Window!"
Set r = start1*(3+5)
wtext 10,50,"Result is: "
wtext 140,50,r
That definition is determined by the number of credit cards in your wallet, what you think is a deal and how much you like crowded stores.
I suspect the Bitcoin market is vulnerable to price manipulation - for instance, indirect purchase of own bitcoins at a high price to inflate the perceived market value.
Sorry if this is an inappropriate post, but I'm at the end of my rope.
Just to say I'm a long term customer of PowerBASIC from using Turbo Basic in the Borland days, to PowerBASIC when it was Spectra publishing and then PowerBASIC 3.5 for DOS, PowerBASIC Console Compiler 3 and Classic PowerBASIC 8 Windows Compiler.
On the 8th November I ordered PowerBASIC Console Compiler 5, on the 13th November I had an Invoice which I duly paid, then nothing....
I tried emailing sales@powerbasic.com, and again nothing. After mailing again and hearing nothing I raised a dispute through PayPal, this at least seem to do something as I had a reply from PowerBASIC on the 25th November apologising for the delay and now nothing again.
My emails are still going unanswered. Now before I escalate the dispute further I'm hoping someone in PowerBASIC will see this post and try and resolve whatever the issue is. The order number is 388264.
Thanks
Rob
defINT n,s
Set n = 1,s=2
wForm 100,0,400,400,#MMS,0,"New Window!"
LoopTo n,1,120000,1
set s = n+1
wtext 100,100,s
Shift n
wtext 250,40,"Test TEXT"
Assigning an empty string to a variable
PA This is the usual way to clear a string variable.
Text$ = ""
What a waste! First of all, the string "" takes 6 bytes of RAM each time you use it. Consider the alternative:
Text$ = vbNullString
So what is this? vbNullString is a special VB constant that denotes a null string. The "" literal is an empty string. There's an important difference. An empty string is a real string. A null string is not. It is just a zero. If you know the C language, vbNullString is the equivalent of NULL.
SUB exec_SET
'STRING arg[20] 'after RETURN this LOCAL string array is NOT released
INT n=1
'count
'arg[n]=arg1[PC]
'If arg[n]=""
' Return
'Else
if n=1
ParseExpr(arg1[PC])
' true if is not empty
' because is true RETURN must work ?
End If
' do i must use EXIT SUB ? why is next line executed after RETURN?
If arg2[PC] = "" then Return Is EXIT SUB same as RETURN ?
Is EXIT SUB same as RETURN ?
Yes.
include "sw.inc"
window 320,240,1
Sub MyExitSub()
static sys count
iF count >=100
Cls RGB(Rnd(128,255),Rnd(128,255),Rnd(128,255))
Return
End iF
Text 50,50,"Wait.. " + count,0
count +=1
End Sub
while Key(27)=0
Cls sw_white
MyExitSub
Sync
SetFps (24)
wend
CloseWindow
string arg[100]
sub f()
sys n=2
arg[16]=space 1000
arg[n]=arg[16]
if arg[n]="" then return
return
end sub
function g(sys a)
for i=1 to a
f
next
end function
print "" 'check for mem in task manager
g 10000
print "" 'check for mem in task manager: max increase: ~16k (Vista PC)
FUNCTION Eval_Expr(string in) as FLOAT
STRING expr,op
frees expr
expr = in
Function VisibleToken(STRING s) as string
Select s
Case CR
' s = "newline"
Case LF
' s = "newline"
Case ""
' s = "nothing"
End Select
Return s
End Function
';Cleanup then end
Function Finish()
perr=1
Return 0
End Function
';Report an error
Function Error(string s)
print "Error: " + s + "."
End Function
';Report an error and abort
Function Abort(STRING s)
Error(s)
Finish()
End Function
';Report what was expected
Function Expected(STRING expect)
Abort("Expected: " + expect + ", got '" + VisibleToken(Look) + "'")
Return 0
End Function
';Read a character into Look
Goto GetChar_End
sub GetChar
'print "SUB->GETCHAR"
Look = Mid (Stream ,StreamPos,1)
'print "LOOK:" + Look
StreamPos = StreamPos + 1
Return
end sub
GetChar_End:
';Match a specific input character
Function Match(STRING s)
'print "MATCH<s>" + s
If Look <> s
'print "MATCH<Look>" + Look
Expected("'"+ s +"'")
Else
'print "MATCH<else>"
Gosub getchar
End If
End Function
';Get a number-----------------------------------------------------
Function GetNum() As Float
STRING Temp
If Asc(look) > 47 and Asc(look) < 58 ' read chars as numbers
'print "need number"
End if
While (Asc(Look) > 47 And Asc(Look) < 58) Or Asc(Look) = 46' dec.point
Temp = Temp + Look
Gosub getchar
Wend
Return Val(Temp)
End Function
';Get variable ----------------------------------------------------------
Function GetVar() as float
'print "SUB->GETVAR"
STRING Temp,func,expr
FLOAT tempv
'If Asc(look) < 96 and Asc(look) > 123 ' read chars as variable
' print ("need variable")
'end if
While (Asc(Look) > 64 And Asc(Look) < 95) OR (Asc(Look) > 96 And Asc(Look) < 123) OR (Asc(Look) > 47 And Asc(Look) < 58) '; Works
Temp = Temp + Look
Gosub getchar
'print "GetVar-TEMP:" + Temp
'IF
Wend
'test variable value .........GetIntValue (byref vName as string) As FLOAT
'print "LOOK:" + Look
IF Look <> "("
If instr(Temp,"[") = 0
tempv = GetIntValue(Temp) 'not Array
Else ' is array
' print "TEMP:is array:" + Temp
tempv = GetArrayValue(Temp)
End if
'Return tempv
END IF
'expected function..................
IF Look = "("
'temp = sin(90)
'print "fTemp:" + temp ' sin
Gosub getchar 'skip bracket ( Look +1
While Look <> "" ' ->...)
expr = expr + Look
Gosub getchar
Wend
'print "F->TEMP:" + expr ' 90
tempv=GetFunc(temp,expr)
'Return tempv
Gosub getchar
END IF
'...................................
Return tempv
End Function
Declare function Expression() as float
'==============================================================
Function Factor() as float
'print "SUB->FACTOR"
FLOAT Value
'get number ----------------------------
If Asc(Look) > 47 And Asc(Look) < 58
Return GetNum()
End if
'get variable --------------------------
If Asc(look) > 96 and asc(look) < 123 OR (Asc(Look) > 64 And Asc(Look) < 91)
return GetVar()
End if
'get parens ---------------------------
If look <> ""
Match("(")
Value = Expression()
Match(")")
End If
Return Value
End Function
'==============================================================
Function Term() as float
FLOAT Value
Value = Factor()
While (Look = "*" Or Look = "/")
If Look = "*"
Gosub getchar
Value = Value * Factor()
Else
Gosub getchar
Value = Value / Factor()
End If
Wend
Return Value
End Function
Function Expression() as float
FLOAT Value
If (Look = "-")
Gosub getchar
Value = -(Term())
Else
Value = Term()
End If
While (Look = "+") Or (Look = "-")
If Look = "+"
Gosub getchar
Value = Value + Term()
Else
Gosub getchar
Value = Value - Term()
End If
Wend
Return Value
End Function
Function EvaLLine(byval s as string) as float
Stream = Replace(s, " ", "")
StreamPos = 1
Gosub getchar
'string out
Float Tempv
Tempv = Expression()
'If StreamPos < Len(Stream) '; Error check, you
'Expected("nothing") '; can remove them if you don't
'EndIf
'out=str(Temp) '; need the check
Return Tempv
End Function