Open Forum > What's New

SBT - Script BASIC Tutorial API extension module

(1/2) > >>

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