'#file "SBembed1.exe"
include "scriba.inc"
indexbase 0
dim as long pProgram,iError,cArgs
dim as long f1,f2,v
dim as long n,m
dim as SbData ReturnData,ArgData(3)
dim as sbdata byref pdat
dim as long qdat
'
cr=chr(13)+chr(10)
'
pr="Embedded ScriptBasic Tests" cr cr
function newmem CDECL (ByVal le As Long) As BSTR Export
return nuls le
end function
sub freemem CDECL (ByVal p As bstr) Export
frees p
end sub
'SetConsoleTitle "FreeBasic ScriptBasic Embedding Test"
'
'LOADING AND RUNNING A PROGRAM
'-----------------------------
'
pProgram=scriba_new (& newmem, & freemem)
'scriba_LoadConfiguration(pProgram,"c:\scriptbasic\bin\scriba.conf")
'
finit 'reinitialise FPU
'
scriba_SetFileName(pProgram,"SBProg1.bas")
iError=scriba_LoadSourceProgram(pProgram)
if iError then goto ending
iError=scriba_Run(pProgram,"Hello")
if iError then goto ending
'
'ACCESSING GLOBAL DATA
'---------------------
'
v=scriba_LookupVariableByName(pProgram,"main::a")
scriba_GetVariable(pProgram,v,& pdat)
'
pr+="read A: "str(pdat.lng) cr
'
m=pdat.lng+100
pr+="add 100 to A" cr
'
scriba_SetVariable(pProgram,v,2,m,0,"",0)
scriba_GetVariable(pProgram,v, & pdat)
'
pr+="read A: "str(pdat.lng) cr
'
'CALLING SIMPLE SUBROUTINE
'-------------------------
'
f1=scriba_LookupFunctionByName(pProgram,"main::dprint")
if f1=0 then print "Unable to locat Dprint" : goto ending
iError=scriba_Call(pProgram,f1)
if iError then goto ending
'
'
'
'CALLING FUNCTION, RETURNING DATA AND GETTING ALTERED PARAMS
'-----------------------------------------------------------
f2=scriba_LookupFunctionByName(pProgram,"main::eprint")
if f2=0 then print "Unable to locate Eprint" : goto ending
'SETUP ARGUMENTS
'---------------
'these can be used for both input and output
ArgData(0).typ=SBT_DOUBLE
ArgData(1).typ=SBT_DOUBLE
ArgData(2).typ=SBT_DOUBLE
ArgData(3).typ=SBT_DOUBLE
ArgData(0).siz=0
ArgData(1).siz=0
ArgData(2).siz=0
ArgData(3).siz=0
ArgData(0).dbl=11
ArgData(1).dbl=12
ArgData(2).dbl=13
ArgData(3).dbl=14
cArgs=4
'
pr+="call F2:" cr
'
iError=scriba_CallArgEx(pProgram, f2, ReturnData, cArgs, ArgData)
if iError then goto ending
sys c=ReturnData.typ
'
'READ RETURNED VALUE
'-------------------
'
select case c
case SBT_UNDEF : pr+= "Undefined "
case SBT_DOUBLE : pr+="double " ReturnData.dbl
case SBT_LONG : pr+="long " ReturnData.lng
case SBT_STRING : pr+="zstring " ReturnData.str
case SBT_ZCHAR : pr+="zchar " ReturnData.str
end select
'
pr+=cr
'
print pr
'------
ending:
'======
scriba_destroy(pProgram)
if iError then print "ERROR: " + hex(iError) ' + " " + hex(pProgram)