Open Forum > What's New
SBT - Script BASIC Tutorial API extension module
Support:
I have embedded Script BASIC into itself as an easy to use example of the embedding and extension API's. I used the C BASIC C preprocessor defines to extend Script BASIC's extensive macro and define definitions in the interface.c design for readability.
Current SBT Download Attached
SBT interface.c
--- Code: C ---/* SBT (Script BASIC Tutorial) - Extension Module */ #include <stdio.h>#include <stdlib.h>#include <string.h>#include <ctype.h>#include <math.h>#include <time.h>#include <unistd.h>#include "../../basext.h"#include "../../scriba.h"#include "cbasic.h" /**************************** Extension Module Functions****************************/ besVERSION_NEGOTIATE RETURN_FUNCTION((int)INTERFACE_VERSION);besEND besSUB_START DIM AS long PTR p; besMODULEPOINTER = besALLOC(sizeof(long)); IF (besMODULEPOINTER EQ NULL) THEN_DO RETURN_FUNCTION(0); p = (long PTR)besMODULEPOINTER; RETURN_FUNCTION(0);besEND besSUB_FINISH DIM AS long PTR p; p = (long PTR)besMODULEPOINTER; IF (p EQ NULL) THEN_DO RETURN_FUNCTION(0); RETURN_FUNCTION(0);besEND /********************** Script BASIC Instance**********************/ /****************** Support Routines******************/ struct _RunServiceProgram { char *pszProgramFileName; char *pszCmdLineArgs; char *pszConfigFileName; pSbProgram pTProgram; int iRestart; }; static void ExecuteProgramThread(void *p){ pSbProgram pProgram; char szInputFile[1024]; int iErrorCode; struct _RunServiceProgram *pRSP; pRSP = p; strcpy(szInputFile,pRSP->pszProgramFileName); pProgram = scriba_new(malloc,free); pRSP->pTProgram = pProgram; if( pProgram == NULL )return; scriba_SetFileName(pProgram,szInputFile); if (pRSP->pszConfigFileName != NULL){ strcpy(szInputFile,pRSP->pszConfigFileName); scriba_LoadConfiguration(pProgram, pRSP->pszConfigFileName); }else{ scriba_SetProcessSbObject(pProgram,pProgram); } scriba_LoadSourceProgram(pProgram); if (pRSP->pszCmdLineArgs != NULL){ strcpy(szInputFile,pRSP->pszCmdLineArgs); iErrorCode = scriba_Run(pProgram,pRSP->pszCmdLineArgs); }else{ iErrorCode = scriba_Run(pProgram,NULL); } // scriba_destroy(pProgram); return;} besFUNCTION(SB_New) DIM AS pSbProgram sbobj; sbobj = scriba_new(malloc,free); besRETURN_LONG(sbobj);besEND besFUNCTION(SB_Configure) DIM AS unsigned long sbobj; DIM AS char PTR cfgfilename; DIM AS int rtnval = -1; besARGUMENTS("iz") AT sbobj, AT cfgfilename besARGEND rtnval = scriba_LoadConfiguration(sbobj, cfgfilename); besRETURN_LONG(rtnval);besEND besFUNCTION(SB_Load) DIM AS unsigned long sbobj; DIM AS char PTR sbfilename; DIM AS int rtnval = -1; besARGUMENTS("iz") AT sbobj, AT sbfilename besARGEND rtnval = scriba_SetFileName(sbobj, sbfilename); scriba_LoadSourceProgram(sbobj); besRETURN_LONG(rtnval);besEND besFUNCTION(SB_LoadStr) DIM AS unsigned long sbobj; DIM AS char PTR sbpgm; DIM AS int rtnval = -1; besARGUMENTS("iz") AT sbobj, AT sbpgm besARGEND scriba_SetFileName(sbobj, "fake"); rtnval = scriba_LoadProgramString(sbobj, sbpgm, strlen(sbpgm)); besRETURN_LONG(rtnval);besEND besFUNCTION(SB_Run) DIM AS unsigned long sbobj; DIM AS int rtnval; DIM AS char PTR sbcmdline; besARGUMENTS("iz") AT sbobj, AT sbcmdline besARGEND IF (besARGNR < 2) THEN_DO sbcmdline = ""; rtnval = scriba_Run(sbobj, sbcmdline); besRETURN_LONG(rtnval);besEND besFUNCTION(SB_NoRun) DIM AS unsigned long sbobj; DIM AS int rtnval; besARGUMENTS("i") AT sbobj besARGEND rtnval = scriba_NoRun(sbobj); besRETURN_LONG(rtnval);besEND besFUNCTION(SB_ThreadStart) DIM AS struct _RunServiceProgram PTR pRSP; DIM AS THREADHANDLE T; DIM AS char PTR pszProgramFileName; DIM AS char PTR pszCmdLineArgs; DIM AS char PTR pszConfigFileName; DIM AS unsigned long rtnval; besARGUMENTS("z[z][z]") AT pszProgramFileName, AT pszCmdLineArgs, AT pszConfigFileName besARGEND pRSP = (struct _RunServiceProgram PTR)malloc( sizeof(struct _RunServiceProgram) ); pRSP->pszProgramFileName = (char PTR)malloc(strlen(pszProgramFileName) + 1); strcpy(pRSP->pszProgramFileName,pszProgramFileName); IF (pszCmdLineArgs NE NULL) THEN pRSP->pszCmdLineArgs = (char PTR)malloc(strlen(pszCmdLineArgs) + 1); strcpy(pRSP->pszCmdLineArgs,pszCmdLineArgs); ELSE pRSP->pszCmdLineArgs = NULL; END_IF IF (pszConfigFileName NE NULL) THEN pRSP->pszConfigFileName = (char PTR)malloc(strlen(pszConfigFileName) + 1); strcpy(pRSP->pszConfigFileName,pszConfigFileName); ELSE pRSP->pszConfigFileName = NULL; END_IF pRSP->iRestart = 0; thread_CreateThread(AT T,ExecuteProgramThread,pRSP); usleep(500); rtnval = pRSP->pTProgram; besRETURN_LONG(rtnval);besEND besFUNCTION(SB_ThreadEnd) thread_ExitThread(); besRETURNVALUE = NULL;besEND besFUNCTION(SB_Destroy) DIM AS unsigned long sbobj; besARGUMENTS("i") AT sbobj besARGEND scriba_destroy(sbobj); RETURN_FUNCTION(0);besEND besFUNCTION(SB_CallSub) DIM AS unsigned long sbobj; DIM AS int funcsernum; DIM AS char PTR funcname; besARGUMENTS("iz") AT sbobj, AT funcname besARGEND funcsernum = scriba_LookupFunctionByName(sbobj, funcname); besRETURN_LONG(scriba_Call(sbobj, funcsernum));besEND besFUNCTION(SB_CallSubArgs) DIM AS VARIABLE Argument; DIM AS SbData ArgData[8]; DIM AS SbData FunctionResult; DIM AS unsigned long sbobj; DIM AS char PTR funcname; DIM AS int i, sbtype, fnsn; Argument = besARGUMENT(1); besDEREFERENCE(Argument); sbobj = LONGVALUE(Argument); Argument = besARGUMENT(2); besDEREFERENCE(Argument); funcname = STRINGVALUE(Argument); DEF_FOR (i = 3 TO i <= besARGNR STEP INCR i) BEGIN_FOR Argument = besARGUMENT(i); besDEREFERENCE(Argument); SELECT_CASE (sbtype = TYPE(Argument)) BEGIN_SELECT CASE VTYPE_LONG: ArgData[i-3] = PTR scriba_NewSbLong(sbobj, LONGVALUE(Argument)); END_CASE CASE VTYPE_DOUBLE: ArgData[i-3] = PTR scriba_NewSbDouble(sbobj, DOUBLEVALUE(Argument)); END_CASE CASE VTYPE_STRING: ArgData[i-3] = PTR scriba_NewSbString(sbobj, STRINGVALUE(Argument)); END_CASE CASE_ELSE ArgData[i-3] = PTR scriba_NewSbUndef(sbobj); END_CASE END_SELECT NEXT fnsn = scriba_LookupFunctionByName(sbobj, funcname); scriba_CallArgEx(sbobj, fnsn, AT FunctionResult, besARGNR - 2, AT ArgData); SELECT_CASE (FunctionResult.type) BEGIN_SELECT CASE SBT_LONG: besRETURN_LONG(FunctionResult.v.l); END_CASE CASE SBT_DOUBLE: besRETURN_DOUBLE(FunctionResult.v.d); END_CASE CASE SBT_STRING: besRETURN_STRING(FunctionResult.v.s); END_CASE CASE SBT_UNDEF: besRETURNVALUE = NULL; END_CASE END_SELECTbesEND besFUNCTION(SB_GetVar) DIM AS pSbData varobj; DIM AS unsigned long sbobj; DIM AS int vsn; DIM AS char PTR varname; besARGUMENTS("iz") AT sbobj, AT varname besARGEND vsn = scriba_LookupVariableByName(sbobj, varname); scriba_GetVariable(sbobj, vsn, AT varobj); SELECT_CASE (scriba_GetVariableType(sbobj, vsn)) BEGIN_SELECT CASE SBT_LONG : besRETURN_LONG(varobj[0].v.l); END_CASE CASE SBT_DOUBLE : besRETURN_DOUBLE(varobj[0].v.d); END_CASE CASE SBT_STRING : besRETURN_STRING(varobj[0].v.s); END_CASE CASE SBT_UNDEF : besRETURNVALUE = NULL;; END_CASE END_SELECTbesEND besFUNCTION(SB_SetUndef) DIM AS pSbData varobj; DIM AS unsigned long sbobj; DIM AS int vsn; DIM AS char PTR varname; besARGUMENTS("iz") AT sbobj, AT varname besARGEND vsn = scriba_LookupVariableByName(sbobj, varname); besRETURN_LONG(scriba_SetVariable(sbobj, vsn, SBT_UNDEF, NULL, 0, "", 0));besEND besFUNCTION(SB_SetInt) DIM AS VARIABLE Argument; DIM AS pSbData varobj; DIM AS unsigned long sbobj; DIM AS int vsn, usrval, i; DIM AS char PTR varname; IF (besARGNR < 3) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS); DEF_FOR (i = 1 TO i <= 3 STEP INCR i) BEGIN_FOR Argument = besARGUMENT(i); besDEREFERENCE(Argument); IF (i EQ 1) THEN_DO sbobj = LONGVALUE(Argument); IF (i EQ 2) THEN_DO varname = STRINGVALUE(Argument); IF (i EQ 3) THEN_DO usrval = LONGVALUE(Argument); NEXT vsn = scriba_LookupVariableByName(sbobj, varname); besRETURN_LONG(scriba_SetVariable(sbobj, vsn, SBT_LONG, usrval, 0, "", 0));besEND besFUNCTION(SB_SetDbl) DIM AS VARIABLE Argument; DIM AS pSbData varobj; DIM AS unsigned long sbobj; DIM AS int vsn, i; DIM AS char PTR varname; DIM AS double usrval; IF (besARGNR < 3) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS); DEF_FOR (i = 1 TO i <= 3 STEP INCR i) BEGIN_FOR Argument = besARGUMENT(i); besDEREFERENCE(Argument); IF (i EQ 1) THEN_DO sbobj = LONGVALUE(Argument); IF (i EQ 2) THEN_DO varname = STRINGVALUE(Argument); IF (i EQ 3) THEN_DO usrval = DOUBLEVALUE(Argument); NEXT vsn = scriba_LookupVariableByName(sbobj, varname); besRETURN_LONG(scriba_SetVariable(sbobj, vsn, SBT_DOUBLE, 0, usrval, "", 0));besEND besFUNCTION(SB_SetStr) DIM AS VARIABLE Argument; DIM AS pSbData varobj; DIM AS unsigned long sbobj; DIM AS int vsn, i; DIM AS char PTR varname; DIM AS char PTR usrval; IF (besARGNR < 3) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS); DEF_FOR (i = 1 TO i <= 3 STEP INCR i) BEGIN_FOR Argument = besARGUMENT(i); besDEREFERENCE(Argument); IF (i EQ 1) THEN_DO sbobj = LONGVALUE(Argument); IF (i EQ 2) THEN_DO varname = STRINGVALUE(Argument); IF (i EQ 3) THEN_DO usrval = STRINGVALUE(Argument); NEXT vsn = scriba_LookupVariableByName(sbobj, varname); besRETURN_LONG(scriba_SetVariable(sbobj, vsn, SBT_STRING, 0, 0, usrval, strlen(usrval)));besEND besFUNCTION(SB_ResetVars) DIM AS unsigned long sbobj; besARGUMENTS("i") AT sbobj besARGEND scriba_ResetVariables(sbobj); besRETURNVALUE = NULL;besEND
sbt.inc
--- Code: Script BASIC ---DECLARE SUB SB_New ALIAS "SB_New" LIB "sbt"DECLARE SUB SB_Configure ALIAS "SB_Configure" LIB "sbt"DECLARE SUB SB_Load ALIAS "SB_Load" LIB "sbt"DECLARE SUB SB_LoadStr ALIAS "SB_LoadStr" LIB "sbt"DECLARE SUB SB_Run ALIAS "SB_Run" LIB "sbt"DECLARE SUB SB_NoRun ALIAS "SB_NoRun" LIB "sbt"DECLARE SUB SB_ThreadStart ALIAS "SB_ThreadStart" LIB "sbt"DECLARE SUB SB_ThreadEnd ALIAS "SB_ThreadEnd" LIB "sbt"DECLARE SUB SB_GetVar ALIAS "SB_GetVar" LIB "sbt"DECLARE SUB SB_SetUndef ALIAS "SB_SetUndef" LIB "sbt"DECLARE SUB SB_SetInt ALIAS "SB_SetInt" LIB "sbt"DECLARE SUB SB_SetDbl ALIAS "SB_SetDbl" LIB "sbt"DECLARE SUB SB_SetStr ALIAS "SB_SetStr" LIB "sbt"DECLARE SUB SB_ResetVars ALIAS "SB_ResetVars" LIB "sbt"DECLARE SUB SB_CallSub ALIAS "SB_CallSub" LIB "sbt"DECLARE SUB SB_CallSubArgs ALIAS "SB_CallSubArgs" LIB "sbt"DECLARE SUB SB_Destroy ALIAS "SB_Destroy" LIB "sbt"
sbtdemo.sb
--- Code: Script BASIC ---' SBT (Script BASIC Tutorial) - Example Script IMPORT sbt.inc sb_code = """FUNCTION prtvars(a, b, c) PRINT a,"\\n" PRINT FORMAT("%g\\n", b) PRINT c,"\\n" prtvars = "Function Return"END FUNCTION a = 0b = 0c = """"" sb = SB_New()SB_Configure sb, "/etc/scriba/basic.conf"SB_LoadStr sb, sb_codeSB_NoRun sbfuncrtn = SB_CallSubArgs(sb,"main::prtvars", 123, 1.23, "One, Two, Three")PRINT funcrtn,"\n"SB_Run sb, ""SB_SetInt sb, "main::a", 321SB_SetDbl sb, "main::b", 32.1SB_SetStr sb, "main::c", "Three,Two,One"SB_CallSubArgs sb, "main::prtvars", _ SB_GetVar(sb, "main::a"), _ SB_GetVar(sb, "main::b"), _ SB_GetVar(sb, "main::c") SB_Destroy sb
Output
jrs@laptop:~/sb/sb22/sbt$ time scriba sbtdemo.sb
123
1.23
One, Two, Three
Function Return
321
32.1
Three,Two,One
real 0m0.007s
user 0m0.007s
sys 0m0.000s
jrs@laptop:~/sb/sb22/sbt$
Support:
I have added thread support to the SBT extension module. It also supports the MT multi-threaded shared (lockable R/W) variable and session manager.
Here is an example of using the MT extension module to communicate between threads and the host script. The command line and configuration file are optional arguments. If not passed, The threaded version of the script uses the internal defaults. This method doesn't provide the paths to the modules & include directory that the configuration file provides. As long as you IMPORT your extension modules in the host script, a simple DECLARE of the function is all that is needed.
ttmain.sb
--- Code: Script BASIC ---IMPORT mt.basIMPORT sbt.inc SB_ThreadStart("tt1.sb", "JRS","/etc/scriba/basic.conf")PRINT "SB Host\n"LINE INPUT waitPRINT mt::GetVariable("thread_status"),"\n"
tt1.sb
--- Code: Script BASIC ---' Test Thread IMPORT mt.basIMPORT sbt.inc cmd = COMMAND()PRINT cmd,"\n" FOR x = 1 TO 10 PRINT "Thread 1: ",x,"\n"NEXT mt::SetVariable "thread_status","Completed" SB_ThreadEnd
Output
jrs@laptop:~/sb/sb22/sbt$ scriba ttmain.sb
SB Host
JRS
Thread 1: 1
Thread 1: 2
Thread 1: 3
Thread 1: 4
Thread 1: 5
Thread 1: 6
Thread 1: 7
Thread 1: 8
Thread 1: 9
Thread 1: 10
Completed
jrs@laptop:~/sb/sb22/sbt$
Support:
I made a few improvement to the SBT extension module to allow threads to act more like the embedded API I started off with. A thread will not terminate at the end of its run. The script can be rerun in the thread if you like. You can access thread script variables, call FUNCTIONs and SUBs and use the MT extension module for thread status for the host or other threads.
tcallmain
--- Code: Script BASIC ---IMPORT sbt.inc sb = SB_ThreadStart("tcall.sb",undef,"/etc/scriba/basic.conf")SB_SetInt sb, "main::a", 123SB_SetDbl sb, "main::b", 1.23SB_SetStr sb, "main::c", "One, Two, Three"funcrtn = SB_CallSubArgs(sb, "main::prtvars", _ SB_GetVar(sb, "main::a"), _ SB_GetVar(sb, "main::b"), _ SB_GetVar(sb, "main::c")) PRINT funcrtn,"\n"SB_Destroy sb
tcall.sb
--- Code: Script BASIC ---FUNCTION prtvars(a, b, c) PRINT a,"\n" PRINT FORMAT("%g\n", b) PRINT c,"\n" prtvars = "Function Return"END FUNCTION a = 0 b = 0 c = ""
jrs@laptop:~/sb/sb22/sbt$ scriba tcallmain.sb
123
1.23
One, Two, Three
Function Return
jrs@laptop:~/sb/sb22/sbt$
Here is an example of rerunning a script in an existing thread.
--- Code: Script BASIC ---IMPORT sbt.inc sb = SB_ThreadStart("tprint.sb")SB_Run(sb,"")SB_Destroy(sb)
--- Code: Script BASIC ---PRINT 123,"\n"PRINT FORMAT("%g\n",1.23)PRINT "One,Two,Three\n"
jrs@laptop:~/sb/sb22/sbt$ scriba tpmain.sb
123
1.23
One,Two,Three
123
1.23
One,Two,Three
jrs@laptop:~/sb/sb22/sbt$
Support:
Here is an example of IUP running in a threaded mode with the DLLC extension module for Windows 32 bit.
The DLLC Windows 32 bit extension module can be found in the current OxygenBasic build and maintained by Charles Pegge.
Thread #1 script
--- Code: Script BASIC ---' Thread #1 Script INCLUDE "dllcinc.sb" iup = dllfile("iup.dll") IupOpen = dllproc(iup,"IupOpen cdecl i = (i argc, i argv)")IupCreate = dllproc(iup,"IupCreate cdecl i = (c *classname)")IupSetAttributes = dllproc(iup,"IupSetAttributes cdecl i = (i ih, c *attr_str)")IupAppend = dllproc(iup,"IupAppend cdecl i = (i ih, cdecl i new_child)")IupSetCallback = dllproc(iup,"IupSetCallback cdecl i = (i ih, c*cb_name, i funcaddr)")IupShow = dllproc(iup,"IupShow cdecl i = (i ih)")IupMainLoop = dllproc(iup,"IupMainLoop cdecl i = ()")IupClose = dllproc(iup,"IupClose cdecl ()") GLOBAL CONST IUP_DEFAULT = -2 FUNCTION Btn1_T1(ih, mbut, pstat) PRINT "B1 - T1 ", CHR(mbut), " - ", pstat, "\n" Btn1_clicked = IUP_DEFAULTEND FUNCTION FUNCTION Btn2_T1(ih) dllprnt"B2 - T1\n" Btn2_clicked = IUP_DEFAULTEND FUNCTION FUNCTION Btn3_T1(ih) dllprnt"B3 - T1\n" Btn3_clicked = IUP_DEFAULTEND FUNCTION FUNCTION main(pProg,idat) dllcall(IupOpen, 0, 0) win = dllcall(IupCreate, "dialog") dllcall(IupSetAttributes, win, "TITLE=\"Thread #1\", SIZE=300x") horzbox = dllcall(IupCreate, "hbox") dllcall(IupSetAttributes, horzbox, "GAP=5") btn1 = dllcall(IupCreate, "button") dllcall(IupSetAttributes, btn1, "TITLE=Button1, EXPAND=HORIZONTAL") btn2 = dllcall(IupCreate, "button") dllcall(IupSetAttributes, btn2, "TITLE=Button2, EXPAND=HORIZONTAL") btn3 = dllcall(IupCreate, "button") dllcall(IupSetAttributes, btn3, "TITLE=Button3, EXPAND=HORIZONTAL") dllcall(IupAppend, horzbox, btn1) dllcall(IupAppend, horzbox, btn2) dllcall(IupAppend, horzbox, btn3) dllcall(IupAppend, win, horzbox) dllcall(IupSetCallback, btn1, "BUTTON_CB", dllclbk(1, pProg, "MAIN::Btn1_T1", 3,IUP_DEFAULT,idat)) dllcall(IupSetCallback, btn2, "ACTION", dllclbk(2, pProg, "MAIN::Btn2_T1", 1,IUP_DEFAULT,idat)) dllcall(IupSetCallback, btn3, "ACTION", dllclbk(3, pProg, "MAIN::Btn3_T1", 1,IUP_DEFAULT,idat)) dllcall(IupShow, win) Main=IupMainLoopEND FUNCTION
Thread #2 script
--- Code: Script BASIC ---' Thread #2 Script INCLUDE "dllcinc.sb" iup = dllfile("iup.dll") IupOpen = dllproc(iup,"IupOpen cdecl i = (i argc, i argv)")IupCreate = dllproc(iup,"IupCreate cdecl i = (c *classname)")IupSetAttributes = dllproc(iup,"IupSetAttributes cdecl i = (i ih, c *attr_str)")IupAppend = dllproc(iup,"IupAppend cdecl i = (i ih, cdecl i new_child)")IupSetCallback = dllproc(iup,"IupSetCallback cdecl i = (i ih, c*cb_name, i funcaddr)")IupShow = dllproc(iup,"IupShow cdecl i = (i ih)")IupMainLoop = dllproc(iup,"IupMainLoop cdecl i = ()")IupClose = dllproc(iup,"IupClose cdecl ()") GLOBAL CONST IUP_DEFAULT = -2 FUNCTION Btn1_T2(ih) dllprnt"B1 - T2\n" Btn1_clicked = IUP_DEFAULTEND FUNCTION FUNCTION Btn2_T2(ih) dllprnt"B2 - T2\n" Btn2_clicked = IUP_DEFAULTEND FUNCTION FUNCTION Btn3_T2(ih) dllprnt"B3 - T2\n" Btn3_clicked = IUP_DEFAULTEND FUNCTION FUNCTION main(pProg,idat) dllcall(IupOpen, 0, 0) win = dllcall(IupCreate, "dialog") dllcall(IupSetAttributes, win, "TITLE=\"Thread #2\", SIZE=300x") horzbox = dllcall(IupCreate, "hbox") dllcall(IupSetAttributes, horzbox, "GAP=5") btn1 = dllcall(IupCreate, "button") dllcall(IupSetAttributes, btn1, "TITLE=Button1, EXPAND=HORIZONTAL") btn2 = dllcall(IupCreate, "button") dllcall(IupSetAttributes, btn2, "TITLE=Button2, EXPAND=HORIZONTAL") btn3 = dllcall(IupCreate, "button") dllcall(IupSetAttributes, btn3, "TITLE=Button3, EXPAND=HORIZONTAL") dllcall(IupAppend, horzbox, btn1) dllcall(IupAppend, horzbox, btn2) dllcall(IupAppend, horzbox, btn3) dllcall(IupAppend, win, horzbox) dllcall(IupSetCallback, btn1, "ACTION", dllclbk(4, pProg, "MAIN::Btn1_T2", 1,IUP_DEFAULT,idat)) dllcall(IupSetCallback, btn2, "ACTION", dllclbk(5, pProg, "MAIN::Btn2_T2", 1,IUP_DEFAULT,idat)) dllcall(IupSetCallback, btn3, "ACTION", dllclbk(6, pProg, "MAIN::Btn3_T2", 1,IUP_DEFAULT,idat)) dllcall(IupShow, win) Main=IupMainLoopEND FUNCTION
Start script
--- Code: Script BASIC ---' Boot (Main / Launcher) INCLUDE "dllcinc.sb"bdat=string(8192,chr(0))idat=dllsptr(bdat) thrM1 = dlltran("T1.sb","main::main",1,idat)thrM2 = dlltran("T2.sb","main::main",2,idat) LINE INPUT wait dllclos thrM1,thrM2dllfile
Support:
Done!
I finally got this worked out and didn't have to inform Gtk or IUP that they're being threaded. 8)
I can click on either thread window's button as fast as I can and it responds with the being pressed message. The only minor issue I still have is the second thread window will open in max size and sometimes without a max/restore window button. At this point I'm happy.
iup.bas - callback handling functions
--- Code: Script BASIC ---FUNCTION MainLoopLOCAL hex_event LoopStep() this_event = GetEvent() hex_event = BB_HTA(this_event) IF hex_event = event{hex_event}[0] THEN IF event{hex_event}[2] = 1 THEN SB_CallSub(main::sb1, event{hex_event}[1]) ELSEIF event{hex_event}[2] = 2 THEN SB_CallSub(main::sb2, event{hex_event}[1]) END IF MainLoop = GetActionName() END IF END FUNCTION FUNCTION SetThreadCallback(ih, aname, fname, tnum) t_event = mt::GetVariable("Callback_Map") IF t_event = undef THEN t_event = "" t_event = t_event & BB_HTA(ih) & "|" & fname & "|" & tnum & "\n" mt::SetVariable("Callback_Map", t_event) SetThreadCallback = __SetCallback(ih, aname)END FUNCTION SUB GetThreadCallback LOCAL t_event, e_list, e_array, x t_event = mt::GetVariable("Callback_Map") SPLITA t_event BY "\n" TO e_list FOR x = 0 TO UBOUND(e_list) SPLITA e_list[x] BY "|" TO e_array event{e_array[0]}[0] = e_array[0] event{e_array[0]}[1] = e_array[1] event{e_array[0]}[2] = e_array[2] NEXTEND SUB FUNCTION BB_HTA(AsciiStr) LOCAL AsciiLen,ScanPos,HexStr AsciiLen = LEN(AsciiStr) HexStr = "" IF AsciiLen THEN FOR ScanPos = 1 TO AsciiLen HexStr &= RIGHT("0" & HEX(ASC(MID(AsciiStr, ScanPos, 1))),2) NEXT ScanPos ELSE HexStr = "" END IF BB_HTA = HexStrEND FUNCTION
iupmain.sb - host SB script (puppet master)
--- Code: Script BASIC ---IMPORT mt.basIMPORT sbt.incIMPORT iup.bas Iup::Open() SUB SB_Wait(mtvar) WHILE mt::GetVariable(mtvar) <> "OK" SB_msSleep(5000) WENDEND SUB sb1 = SB_ThreadStart("rqdemo1.sb",undef,"/etc/scriba/basic.conf")SB_Wait("sb1_loaded")sb1_rtn = SB_CallSubArgs(sb1, "main::main", sb1) sb2 = SB_ThreadStart("rqdemo2.sb",undef,"/etc/scriba/basic.conf")SB_Wait("sb2_loaded")sb2_rtn = SB_CallSubArgs(sb2, "main::main", sb2) threads = 2 Iup::GetThreadCallback() WHILE threads event_class = Iup::MainLoop() IF event_class = "CLOSE_CB" THEN threads -= 1 IF Iup::event{Iup::BB_HTA(Iup::this_event)}[2] = 1 THEN SB_CallSub(sb1, "iup::exitloop") ELSEIF Iup::event{Iup::BB_HTA(Iup::this_event)}[2] = 2 THEN SB_CallSub(sb2, "iup::exitloop") END IF END IF SB_msSleep(250)WEND Iup::Close()SB_Destroy(sb2)SB_Destroy(sb1)
rqdemo1.sb - rqdemo2.sb is identical other than the references to it been the second thread.
--- Code: Script BASIC ---' Script BASIC Rapid-Q form conversion IMPORT mt.basIMPORT iup.bas ' CALLBACKS FUNCTIONS SUB button_quit PRINT "Thread 1 Quit Button Pressed\n"END SUB SUB win_exit ' Good-Bye END SUB SUB main ' SBIUP-Q INIT Iup::Open() Iup::SetGlobal("DEFAULTFONT", "Sans, 7.5") ' CREATE FORM Form = Iup::Create("dialog") Iup::SetAttributes(Form, "RASTERSIZE=320x240, TITLE=\"Thread 1\"") Label1 = Iup::Create("label") Iup::SetAttributes(Label1, "TITLE=\"Customer\", RASTERSIZE=55x13, FLOATING=YES, POSITION=\"19,19\"") Edit1 = Iup::Create("text") Iup::SetAttributes(Edit1, "RASTERSIZE=121x21, FLOATING=YES, POSITION=\"72,16\"") Button1 = Iup::Create("button") Iup::SetAttributes(Button1, "TITLE=\"&Quit\", RASTERSIZE=75x25, FLOATING=YES, POSITION=\"107,164\"") vbx = Iup::Vbox(Label1, Edit1, Button1) Iup::Append(Form, vbx) ' SET CALLBACKS Iup::SetThreadCallback(Form, "CLOSE_CB", "main::win_exit", 1) Iup::SetThreadCallback(Button1, "ACTION", "main::button_quit", 1) Iup::Show(Form)END SUBmt::SetVariable("sb1_loaded","OK")
Navigation
[0] Message Index
[#] Next page
Go to full version