Author Topic: SBT - Script BASIC Tutorial API extension module  (Read 6258 times)

support

  • Administrator
  • *****
  • Posts: 851
    • Script BASIC Open Source Project
SBT - Script BASIC Tutorial API extension module
« on: May 05, 2015, 06:14:26 PM »
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
  1. /*  SBT (Script BASIC Tutorial) - Extension Module */
  2.  
  3. #include <stdio.h>
  4. #include <stdlib.h>
  5. #include <string.h>
  6. #include <ctype.h>
  7. #include <math.h>
  8. #include <time.h>
  9. #include <unistd.h>
  10. #include "../../basext.h"
  11. #include "../../scriba.h"
  12. #include "cbasic.h"
  13.  
  14.  
  15. /****************************
  16.  Extension Module Functions
  17. ****************************/
  18.  
  19. besVERSION_NEGOTIATE
  20.   RETURN_FUNCTION((int)INTERFACE_VERSION);
  21. besEND
  22.  
  23. besSUB_START
  24.   DIM AS long PTR p;
  25.   besMODULEPOINTER = besALLOC(sizeof(long));
  26.   IF (besMODULEPOINTER EQ NULL) THEN_DO RETURN_FUNCTION(0);
  27.   p = (long PTR)besMODULEPOINTER;
  28.   RETURN_FUNCTION(0);
  29. besEND
  30.  
  31. besSUB_FINISH
  32.   DIM AS long PTR p;
  33.   p = (long PTR)besMODULEPOINTER;
  34.   IF (p EQ NULL) THEN_DO RETURN_FUNCTION(0);
  35.   RETURN_FUNCTION(0);
  36. besEND
  37.  
  38.  
  39. /**********************
  40.  Script BASIC Instance
  41. **********************/
  42.  
  43. /******************
  44.  Support Routines
  45. ******************/
  46.  
  47. struct _RunServiceProgram {
  48.   char *pszProgramFileName;
  49.   char *pszCmdLineArgs;
  50.   char *pszConfigFileName;
  51.   pSbProgram pTProgram;
  52.   int iRestart;
  53.   };
  54.  
  55. static void ExecuteProgramThread(void *p){
  56.   pSbProgram pProgram;
  57.   char szInputFile[1024];
  58.   int iErrorCode;
  59.   struct _RunServiceProgram *pRSP;
  60.   pRSP = p;
  61.   strcpy(szInputFile,pRSP->pszProgramFileName);
  62.   pProgram = scriba_new(malloc,free);
  63.   pRSP->pTProgram = pProgram;
  64.   if( pProgram == NULL )return;
  65.   scriba_SetFileName(pProgram,szInputFile);
  66.   if (pRSP->pszConfigFileName != NULL){
  67.         strcpy(szInputFile,pRSP->pszConfigFileName);
  68.         scriba_LoadConfiguration(pProgram, pRSP->pszConfigFileName);
  69.   }else{
  70.         scriba_SetProcessSbObject(pProgram,pProgram);
  71.   }    
  72.   scriba_LoadSourceProgram(pProgram);
  73.   if (pRSP->pszCmdLineArgs != NULL){
  74.         strcpy(szInputFile,pRSP->pszCmdLineArgs);
  75.     iErrorCode = scriba_Run(pProgram,pRSP->pszCmdLineArgs);
  76.   }else{
  77.     iErrorCode = scriba_Run(pProgram,NULL);
  78.   }    
  79. //  scriba_destroy(pProgram);
  80.   return;
  81. }
  82.  
  83. besFUNCTION(SB_New)
  84.   DIM AS pSbProgram sbobj;
  85.   sbobj = scriba_new(malloc,free);
  86.   besRETURN_LONG(sbobj);
  87. besEND
  88.  
  89. besFUNCTION(SB_Configure)
  90.   DIM AS unsigned long sbobj;
  91.   DIM AS char PTR cfgfilename;
  92.   DIM AS int rtnval = -1;
  93.   besARGUMENTS("iz")
  94.     AT sbobj, AT cfgfilename
  95.   besARGEND
  96.   rtnval = scriba_LoadConfiguration(sbobj, cfgfilename);
  97.   besRETURN_LONG(rtnval);
  98. besEND
  99.  
  100. besFUNCTION(SB_Load)
  101.   DIM AS unsigned long sbobj;
  102.   DIM AS char PTR sbfilename;
  103.   DIM AS int rtnval = -1;
  104.   besARGUMENTS("iz")
  105.     AT sbobj, AT sbfilename
  106.   besARGEND
  107.   rtnval = scriba_SetFileName(sbobj, sbfilename);
  108.   scriba_LoadSourceProgram(sbobj);
  109.   besRETURN_LONG(rtnval);
  110. besEND
  111.  
  112. besFUNCTION(SB_LoadStr)
  113.   DIM AS unsigned long sbobj;
  114.   DIM AS char PTR sbpgm;
  115.   DIM AS int rtnval = -1;
  116.   besARGUMENTS("iz")
  117.     AT sbobj, AT sbpgm
  118.   besARGEND
  119.   scriba_SetFileName(sbobj, "fake");
  120.   rtnval = scriba_LoadProgramString(sbobj, sbpgm, strlen(sbpgm));
  121.   besRETURN_LONG(rtnval);
  122. besEND
  123.  
  124. besFUNCTION(SB_Run)
  125.   DIM AS unsigned long sbobj;
  126.   DIM AS int rtnval;
  127.   DIM AS char PTR sbcmdline;
  128.   besARGUMENTS("iz")
  129.     AT sbobj, AT sbcmdline
  130.   besARGEND
  131.   IF (besARGNR < 2) THEN_DO sbcmdline = "";
  132.   rtnval = scriba_Run(sbobj, sbcmdline);
  133.   besRETURN_LONG(rtnval);
  134. besEND
  135.  
  136. besFUNCTION(SB_NoRun)
  137.   DIM AS unsigned long sbobj;
  138.   DIM AS int rtnval;
  139.   besARGUMENTS("i")
  140.     AT sbobj
  141.   besARGEND
  142.   rtnval = scriba_NoRun(sbobj);
  143.   besRETURN_LONG(rtnval);
  144. besEND
  145.  
  146. besFUNCTION(SB_ThreadStart)
  147.   DIM AS struct _RunServiceProgram PTR pRSP;
  148.   DIM AS THREADHANDLE T;
  149.   DIM AS char PTR pszProgramFileName;
  150.   DIM AS char PTR pszCmdLineArgs;
  151.   DIM AS char PTR pszConfigFileName;
  152.   DIM AS unsigned long rtnval;
  153.   besARGUMENTS("z[z][z]")
  154.     AT pszProgramFileName, AT pszCmdLineArgs, AT pszConfigFileName
  155.   besARGEND
  156.   pRSP = (struct _RunServiceProgram PTR)malloc( sizeof(struct _RunServiceProgram) );
  157.   pRSP->pszProgramFileName = (char PTR)malloc(strlen(pszProgramFileName) + 1);  
  158.   strcpy(pRSP->pszProgramFileName,pszProgramFileName);
  159.   IF (pszCmdLineArgs NE NULL) THEN
  160.     pRSP->pszCmdLineArgs = (char PTR)malloc(strlen(pszCmdLineArgs) + 1);  
  161.     strcpy(pRSP->pszCmdLineArgs,pszCmdLineArgs);
  162.   ELSE
  163.         pRSP->pszCmdLineArgs = NULL;
  164.   END_IF
  165.   IF (pszConfigFileName NE NULL) THEN
  166.     pRSP->pszConfigFileName = (char PTR)malloc(strlen(pszConfigFileName) + 1);  
  167.     strcpy(pRSP->pszConfigFileName,pszConfigFileName);
  168.   ELSE
  169.         pRSP->pszConfigFileName = NULL;
  170.   END_IF
  171.   pRSP->iRestart = 0;
  172.   thread_CreateThread(AT T,ExecuteProgramThread,pRSP);
  173.   usleep(500);
  174.   rtnval = pRSP->pTProgram;
  175.   besRETURN_LONG(rtnval);
  176. besEND
  177.  
  178. besFUNCTION(SB_ThreadEnd)
  179.   thread_ExitThread();
  180.   besRETURNVALUE = NULL;
  181. besEND
  182.  
  183. besFUNCTION(SB_Destroy)
  184.   DIM AS unsigned long sbobj;
  185.   besARGUMENTS("i")
  186.     AT sbobj
  187.   besARGEND
  188.   scriba_destroy(sbobj);
  189.   RETURN_FUNCTION(0);
  190. besEND
  191.  
  192. besFUNCTION(SB_CallSub)
  193.   DIM AS unsigned long sbobj;
  194.   DIM AS int funcsernum;
  195.   DIM AS char PTR funcname;
  196.   besARGUMENTS("iz")
  197.     AT sbobj, AT funcname
  198.   besARGEND
  199.   funcsernum = scriba_LookupFunctionByName(sbobj, funcname);
  200.   besRETURN_LONG(scriba_Call(sbobj, funcsernum));
  201. besEND
  202.  
  203. besFUNCTION(SB_CallSubArgs)
  204.   DIM AS VARIABLE Argument;
  205.   DIM AS SbData ArgData[8];
  206.   DIM AS SbData FunctionResult;
  207.   DIM AS unsigned long sbobj;
  208.   DIM AS char PTR funcname;
  209.   DIM AS int i, sbtype, fnsn;
  210.  
  211.   Argument = besARGUMENT(1);
  212.   besDEREFERENCE(Argument);
  213.   sbobj = LONGVALUE(Argument);
  214.  
  215.   Argument = besARGUMENT(2);
  216.   besDEREFERENCE(Argument);
  217.   funcname = STRINGVALUE(Argument);
  218.  
  219.   DEF_FOR (i = 3 TO i <= besARGNR STEP INCR i)
  220.   BEGIN_FOR
  221.     Argument = besARGUMENT(i);
  222.     besDEREFERENCE(Argument);
  223.     SELECT_CASE (sbtype = TYPE(Argument))
  224.     BEGIN_SELECT
  225.       CASE VTYPE_LONG:
  226.         ArgData[i-3] = PTR scriba_NewSbLong(sbobj, LONGVALUE(Argument));
  227.         END_CASE
  228.       CASE VTYPE_DOUBLE:
  229.         ArgData[i-3] = PTR scriba_NewSbDouble(sbobj, DOUBLEVALUE(Argument));
  230.         END_CASE
  231.       CASE VTYPE_STRING:
  232.         ArgData[i-3] = PTR scriba_NewSbString(sbobj, STRINGVALUE(Argument));
  233.         END_CASE
  234.       CASE_ELSE
  235.         ArgData[i-3] = PTR scriba_NewSbUndef(sbobj);
  236.         END_CASE
  237.     END_SELECT
  238.   NEXT
  239.  
  240.   fnsn = scriba_LookupFunctionByName(sbobj, funcname);
  241.   scriba_CallArgEx(sbobj, fnsn, AT FunctionResult, besARGNR - 2, AT ArgData);
  242.  
  243.   SELECT_CASE (FunctionResult.type)
  244.   BEGIN_SELECT
  245.     CASE SBT_LONG:
  246.       besRETURN_LONG(FunctionResult.v.l);
  247.       END_CASE
  248.     CASE SBT_DOUBLE:
  249.       besRETURN_DOUBLE(FunctionResult.v.d);
  250.       END_CASE
  251.     CASE SBT_STRING:
  252.       besRETURN_STRING(FunctionResult.v.s);
  253.       END_CASE
  254.     CASE SBT_UNDEF:
  255.       besRETURNVALUE = NULL;
  256.       END_CASE
  257.   END_SELECT
  258. besEND
  259.  
  260. besFUNCTION(SB_GetVar)
  261.   DIM AS pSbData varobj;
  262.   DIM AS unsigned long sbobj;
  263.   DIM AS int vsn;
  264.   DIM AS char PTR varname;
  265.   besARGUMENTS("iz")
  266.     AT sbobj, AT varname
  267.   besARGEND
  268.   vsn = scriba_LookupVariableByName(sbobj, varname);
  269.   scriba_GetVariable(sbobj, vsn, AT varobj);
  270.   SELECT_CASE (scriba_GetVariableType(sbobj, vsn))
  271.   BEGIN_SELECT
  272.     CASE SBT_LONG   :
  273.       besRETURN_LONG(varobj[0].v.l);
  274.       END_CASE
  275.     CASE SBT_DOUBLE :
  276.       besRETURN_DOUBLE(varobj[0].v.d);
  277.       END_CASE
  278.     CASE SBT_STRING :
  279.       besRETURN_STRING(varobj[0].v.s);
  280.       END_CASE
  281.     CASE SBT_UNDEF  :
  282.       besRETURNVALUE = NULL;;
  283.       END_CASE
  284.   END_SELECT
  285. besEND
  286.  
  287. besFUNCTION(SB_SetUndef)
  288.   DIM AS pSbData varobj;
  289.   DIM AS unsigned long sbobj;
  290.   DIM AS int vsn;
  291.   DIM AS char PTR varname;
  292.   besARGUMENTS("iz")
  293.     AT sbobj, AT varname
  294.   besARGEND
  295.   vsn = scriba_LookupVariableByName(sbobj, varname);
  296.   besRETURN_LONG(scriba_SetVariable(sbobj, vsn, SBT_UNDEF, NULL, 0, "", 0));
  297. besEND
  298.  
  299. besFUNCTION(SB_SetInt)
  300.   DIM AS VARIABLE Argument;
  301.   DIM AS pSbData varobj;
  302.   DIM AS unsigned long sbobj;
  303.   DIM AS int vsn, usrval, i;
  304.   DIM AS char PTR varname;
  305.   IF (besARGNR < 3) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS);
  306.   DEF_FOR (i = 1 TO i <= 3 STEP INCR i)
  307.   BEGIN_FOR
  308.     Argument = besARGUMENT(i);
  309.     besDEREFERENCE(Argument);
  310.     IF (i EQ 1) THEN_DO sbobj = LONGVALUE(Argument);
  311.     IF (i EQ 2) THEN_DO varname = STRINGVALUE(Argument);
  312.     IF (i EQ 3) THEN_DO usrval = LONGVALUE(Argument);
  313.   NEXT
  314.   vsn = scriba_LookupVariableByName(sbobj, varname);
  315.   besRETURN_LONG(scriba_SetVariable(sbobj, vsn, SBT_LONG, usrval, 0, "", 0));
  316. besEND
  317.  
  318. besFUNCTION(SB_SetDbl)
  319.   DIM AS VARIABLE Argument;
  320.   DIM AS pSbData varobj;
  321.   DIM AS unsigned long sbobj;
  322.   DIM AS int vsn, i;
  323.   DIM AS char PTR varname;
  324.   DIM AS double usrval;
  325.   IF (besARGNR < 3) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS);
  326.   DEF_FOR (i = 1 TO i <= 3 STEP INCR i)
  327.   BEGIN_FOR
  328.     Argument = besARGUMENT(i);
  329.     besDEREFERENCE(Argument);
  330.     IF (i EQ 1) THEN_DO sbobj = LONGVALUE(Argument);
  331.     IF (i EQ 2) THEN_DO varname = STRINGVALUE(Argument);
  332.     IF (i EQ 3) THEN_DO usrval = DOUBLEVALUE(Argument);
  333.   NEXT
  334.   vsn = scriba_LookupVariableByName(sbobj, varname);
  335.   besRETURN_LONG(scriba_SetVariable(sbobj, vsn,  SBT_DOUBLE, 0, usrval, "", 0));
  336. besEND
  337.  
  338. besFUNCTION(SB_SetStr)
  339.   DIM AS VARIABLE Argument;
  340.   DIM AS pSbData varobj;
  341.   DIM AS unsigned long sbobj;
  342.   DIM AS int vsn, i;
  343.   DIM AS char PTR varname;
  344.   DIM AS char PTR usrval;
  345.   IF (besARGNR < 3) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS);
  346.   DEF_FOR (i = 1 TO i <= 3 STEP INCR i)
  347.   BEGIN_FOR
  348.     Argument = besARGUMENT(i);
  349.     besDEREFERENCE(Argument);
  350.     IF (i EQ 1) THEN_DO sbobj = LONGVALUE(Argument);
  351.     IF (i EQ 2) THEN_DO varname = STRINGVALUE(Argument);
  352.     IF (i EQ 3) THEN_DO usrval = STRINGVALUE(Argument);
  353.   NEXT
  354.   vsn = scriba_LookupVariableByName(sbobj, varname);
  355.   besRETURN_LONG(scriba_SetVariable(sbobj, vsn,  SBT_STRING, 0, 0, usrval, strlen(usrval)));
  356. besEND
  357.  
  358. besFUNCTION(SB_ResetVars)
  359.   DIM AS unsigned long sbobj;
  360.   besARGUMENTS("i")
  361.     AT sbobj
  362.   besARGEND
  363.   scriba_ResetVariables(sbobj);
  364.   besRETURNVALUE = NULL;
  365. besEND
  366.  

sbt.inc
Code: Script BASIC
  1. DECLARE SUB SB_New ALIAS "SB_New" LIB "sbt"
  2. DECLARE SUB SB_Configure ALIAS "SB_Configure" LIB "sbt"
  3. DECLARE SUB SB_Load ALIAS "SB_Load" LIB "sbt"
  4. DECLARE SUB SB_LoadStr ALIAS "SB_LoadStr" LIB "sbt"
  5. DECLARE SUB SB_Run ALIAS "SB_Run" LIB "sbt"
  6. DECLARE SUB SB_NoRun ALIAS "SB_NoRun" LIB "sbt"
  7. DECLARE SUB SB_ThreadStart ALIAS "SB_ThreadStart" LIB "sbt"
  8. DECLARE SUB SB_ThreadEnd ALIAS "SB_ThreadEnd" LIB "sbt"
  9. DECLARE SUB SB_GetVar ALIAS "SB_GetVar" LIB "sbt"
  10. DECLARE SUB SB_SetUndef ALIAS "SB_SetUndef" LIB "sbt"
  11. DECLARE SUB SB_SetInt ALIAS "SB_SetInt" LIB "sbt"
  12. DECLARE SUB SB_SetDbl ALIAS "SB_SetDbl" LIB "sbt"
  13. DECLARE SUB SB_SetStr ALIAS "SB_SetStr" LIB "sbt"
  14. DECLARE SUB SB_ResetVars ALIAS "SB_ResetVars" LIB "sbt"
  15. DECLARE SUB SB_CallSub ALIAS "SB_CallSub" LIB "sbt"
  16. DECLARE SUB SB_CallSubArgs ALIAS "SB_CallSubArgs" LIB "sbt"
  17. DECLARE SUB SB_Destroy ALIAS "SB_Destroy" LIB "sbt"
  18.  

sbtdemo.sb
Code: Script BASIC
  1. ' SBT (Script BASIC Tutorial) - Example Script
  2.  
  3. IMPORT sbt.inc
  4.  
  5. sb_code = """
  6. FUNCTION prtvars(a, b, c)
  7.  PRINT a,"\\n"
  8.  PRINT FORMAT("%g\\n", b)
  9.  PRINT c,"\\n"
  10.  prtvars = "Function Return"
  11. END FUNCTION
  12.  
  13. a = 0
  14. b = 0
  15. c = ""
  16. """
  17.  
  18. sb = SB_New()
  19. SB_Configure sb, "/etc/scriba/basic.conf"
  20. SB_LoadStr sb, sb_code
  21. SB_NoRun sb
  22. funcrtn = SB_CallSubArgs(sb,"main::prtvars", 123, 1.23, "One, Two, Three")
  23. PRINT funcrtn,"\n"
  24. SB_Run sb, ""
  25. SB_SetInt sb, "main::a", 321
  26. SB_SetDbl sb, "main::b", 32.1
  27. SB_SetStr sb, "main::c", "Three,Two,One"
  28. SB_CallSubArgs sb, "main::prtvars", _
  29.           SB_GetVar(sb, "main::a"), _
  30.           SB_GetVar(sb, "main::b"), _
  31.           SB_GetVar(sb, "main::c")      
  32. SB_Destroy sb
  33.  

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$

« Last Edit: May 17, 2015, 10:25:15 PM by support »
Script BASIC Project Manager

support

  • Administrator
  • *****
  • Posts: 851
    • Script BASIC Open Source Project
Re: SBT - Script BASIC Tutorial API extension module - Thread Support
« Reply #1 on: May 14, 2015, 06:50:20 PM »
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
  1. IMPORT mt.bas
  2. IMPORT sbt.inc
  3.  
  4. SB_ThreadStart("tt1.sb", "JRS","/etc/scriba/basic.conf")
  5. PRINT "SB Host\n"
  6. LINE INPUT wait
  7. PRINT mt::GetVariable("thread_status"),"\n"
  8.  

tt1.sb
Code: Script BASIC
  1. ' Test Thread
  2.  
  3. IMPORT mt.bas
  4. IMPORT sbt.inc
  5.  
  6. cmd = COMMAND()
  7. PRINT cmd,"\n"
  8.  
  9. FOR x = 1 TO 10
  10.   PRINT "Thread 1: ",x,"\n"
  11. NEXT
  12.  
  13. mt::SetVariable "thread_status","Completed"
  14.  
  15. SB_ThreadEnd
  16.  

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$
« Last Edit: May 14, 2015, 06:57:33 PM by support »
Script BASIC Project Manager

support

  • Administrator
  • *****
  • Posts: 851
    • Script BASIC Open Source Project
Re: SBT - Thread Enhancements
« Reply #2 on: May 17, 2015, 07:52:50 PM »
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
  1. IMPORT sbt.inc
  2.  
  3. sb = SB_ThreadStart("tcall.sb",undef,"/etc/scriba/basic.conf")
  4. SB_SetInt sb, "main::a", 123
  5. SB_SetDbl sb, "main::b", 1.23
  6. SB_SetStr sb, "main::c", "One, Two, Three"
  7. funcrtn = SB_CallSubArgs(sb, "main::prtvars", _
  8.           SB_GetVar(sb, "main::a"), _
  9.           SB_GetVar(sb, "main::b"), _
  10.           SB_GetVar(sb, "main::c"))      
  11. PRINT funcrtn,"\n"
  12. SB_Destroy sb
  13.  

tcall.sb
Code: Script BASIC
  1. FUNCTION prtvars(a, b, c)    
  2.   PRINT a,"\n"              
  3.   PRINT FORMAT("%g\n", b)  
  4.   PRINT c,"\n"              
  5.   prtvars = "Function Return"
  6. END FUNCTION                
  7.                              
  8. a = 0                        
  9. b = 0                        
  10. c = ""                      
  11.  


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
  1. IMPORT sbt.inc
  2.  
  3. sb = SB_ThreadStart("tprint.sb")
  4. SB_Run(sb,"")
  5. SB_Destroy(sb)
  6.  

Code: Script BASIC
  1. PRINT 123,"\n"
  2. PRINT FORMAT("%g\n",1.23)
  3. PRINT "One,Two,Three\n"
  4.  


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$

Script BASIC Project Manager

support

  • Administrator
  • *****
  • Posts: 851
    • Script BASIC Open Source Project
IUP Threaded - Windows 32 bit - DLLC
« Reply #3 on: May 17, 2015, 10:30:46 PM »
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
  1. ' Thread #1 Script
  2.  
  3. INCLUDE "dllcinc.sb"
  4.  
  5. iup = dllfile("iup.dll")
  6.  
  7. IupOpen          = dllproc(iup,"IupOpen          cdecl i = (i argc, i argv)")
  8. IupCreate        = dllproc(iup,"IupCreate        cdecl i = (c *classname)")
  9. IupSetAttributes = dllproc(iup,"IupSetAttributes cdecl i = (i ih, c *attr_str)")
  10. IupAppend        = dllproc(iup,"IupAppend        cdecl i = (i ih, cdecl i new_child)")
  11. IupSetCallback   = dllproc(iup,"IupSetCallback   cdecl i = (i ih, c*cb_name, i funcaddr)")
  12. IupShow          = dllproc(iup,"IupShow          cdecl i = (i ih)")
  13. IupMainLoop      = dllproc(iup,"IupMainLoop      cdecl i = ()")
  14. IupClose         = dllproc(iup,"IupClose         cdecl     ()")
  15.  
  16. GLOBAL CONST IUP_DEFAULT = -2
  17.  
  18. FUNCTION Btn1_T1(ih, mbut, pstat)
  19.   PRINT "B1 - T1 ", CHR(mbut), " - ", pstat, "\n"
  20.   Btn1_clicked = IUP_DEFAULT
  21. END FUNCTION
  22.  
  23. FUNCTION Btn2_T1(ih)
  24.   dllprnt"B2 - T1\n"
  25.   Btn2_clicked = IUP_DEFAULT
  26. END FUNCTION
  27.  
  28. FUNCTION Btn3_T1(ih)
  29.   dllprnt"B3 - T1\n"
  30.   Btn3_clicked = IUP_DEFAULT
  31. END FUNCTION
  32.  
  33. FUNCTION main(pProg,idat)
  34.   dllcall(IupOpen, 0, 0)
  35.   win = dllcall(IupCreate, "dialog")
  36.   dllcall(IupSetAttributes, win, "TITLE=\"Thread #1\", SIZE=300x")
  37.   horzbox = dllcall(IupCreate, "hbox")
  38.   dllcall(IupSetAttributes, horzbox, "GAP=5")
  39.   btn1 = dllcall(IupCreate, "button")
  40.   dllcall(IupSetAttributes, btn1, "TITLE=Button1, EXPAND=HORIZONTAL")
  41.   btn2 = dllcall(IupCreate, "button")
  42.   dllcall(IupSetAttributes, btn2, "TITLE=Button2, EXPAND=HORIZONTAL")
  43.   btn3 = dllcall(IupCreate, "button")
  44.   dllcall(IupSetAttributes, btn3, "TITLE=Button3, EXPAND=HORIZONTAL")
  45.   dllcall(IupAppend, horzbox, btn1)
  46.   dllcall(IupAppend, horzbox, btn2)
  47.   dllcall(IupAppend, horzbox, btn3)
  48.   dllcall(IupAppend, win, horzbox)
  49.   dllcall(IupSetCallback, btn1, "BUTTON_CB", dllclbk(1, pProg, "MAIN::Btn1_T1", 3,IUP_DEFAULT,idat))
  50.   dllcall(IupSetCallback, btn2, "ACTION", dllclbk(2, pProg, "MAIN::Btn2_T1", 1,IUP_DEFAULT,idat))
  51.   dllcall(IupSetCallback, btn3, "ACTION", dllclbk(3, pProg, "MAIN::Btn3_T1", 1,IUP_DEFAULT,idat))
  52.   dllcall(IupShow, win)
  53.   Main=IupMainLoop
  54. END FUNCTION
  55.  

Thread #2 script
Code: Script BASIC
  1. ' Thread #2 Script
  2.  
  3. INCLUDE "dllcinc.sb"
  4.  
  5. iup = dllfile("iup.dll")
  6.  
  7. IupOpen          = dllproc(iup,"IupOpen          cdecl i = (i argc, i argv)")
  8. IupCreate        = dllproc(iup,"IupCreate        cdecl i = (c *classname)")
  9. IupSetAttributes = dllproc(iup,"IupSetAttributes cdecl i = (i ih, c *attr_str)")
  10. IupAppend        = dllproc(iup,"IupAppend        cdecl i = (i ih, cdecl i new_child)")
  11. IupSetCallback   = dllproc(iup,"IupSetCallback   cdecl i = (i ih, c*cb_name, i funcaddr)")
  12. IupShow          = dllproc(iup,"IupShow          cdecl i = (i ih)")
  13. IupMainLoop      = dllproc(iup,"IupMainLoop      cdecl i = ()")
  14. IupClose         = dllproc(iup,"IupClose         cdecl     ()")
  15.  
  16. GLOBAL CONST IUP_DEFAULT = -2
  17.  
  18. FUNCTION Btn1_T2(ih)
  19.   dllprnt"B1 - T2\n"
  20.   Btn1_clicked = IUP_DEFAULT
  21. END FUNCTION
  22.  
  23. FUNCTION Btn2_T2(ih)
  24.   dllprnt"B2 - T2\n"
  25.   Btn2_clicked = IUP_DEFAULT
  26. END FUNCTION
  27.  
  28. FUNCTION Btn3_T2(ih)
  29.   dllprnt"B3 - T2\n"
  30.   Btn3_clicked = IUP_DEFAULT
  31. END FUNCTION
  32.  
  33. FUNCTION main(pProg,idat)
  34.   dllcall(IupOpen, 0, 0)
  35.   win = dllcall(IupCreate, "dialog")
  36.   dllcall(IupSetAttributes, win, "TITLE=\"Thread #2\", SIZE=300x")
  37.   horzbox = dllcall(IupCreate, "hbox")
  38.   dllcall(IupSetAttributes, horzbox, "GAP=5")
  39.   btn1 = dllcall(IupCreate, "button")
  40.   dllcall(IupSetAttributes, btn1, "TITLE=Button1, EXPAND=HORIZONTAL")
  41.   btn2 = dllcall(IupCreate, "button")
  42.   dllcall(IupSetAttributes, btn2, "TITLE=Button2, EXPAND=HORIZONTAL")
  43.   btn3 = dllcall(IupCreate, "button")
  44.   dllcall(IupSetAttributes, btn3, "TITLE=Button3, EXPAND=HORIZONTAL")
  45.   dllcall(IupAppend, horzbox, btn1)
  46.   dllcall(IupAppend, horzbox, btn2)
  47.   dllcall(IupAppend, horzbox, btn3)
  48.   dllcall(IupAppend, win, horzbox)
  49.   dllcall(IupSetCallback, btn1, "ACTION", dllclbk(4, pProg, "MAIN::Btn1_T2", 1,IUP_DEFAULT,idat))
  50.   dllcall(IupSetCallback, btn2, "ACTION", dllclbk(5, pProg, "MAIN::Btn2_T2", 1,IUP_DEFAULT,idat))
  51.   dllcall(IupSetCallback, btn3, "ACTION", dllclbk(6, pProg, "MAIN::Btn3_T2", 1,IUP_DEFAULT,idat))
  52.   dllcall(IupShow, win)
  53.   Main=IupMainLoop
  54. END FUNCTION
  55.  

Start script
Code: Script BASIC
  1. ' Boot (Main / Launcher)
  2.  
  3. INCLUDE "dllcinc.sb"
  4. bdat=string(8192,chr(0))
  5. idat=dllsptr(bdat)
  6.  
  7. thrM1 = dlltran("T1.sb","main::main",1,idat)
  8. thrM2 = dlltran("T2.sb","main::main",2,idat)
  9.  
  10. LINE INPUT wait
  11.  
  12. dllclos thrM1,thrM2
  13. dllfile
  14.  
Script BASIC Project Manager

support

  • Administrator
  • *****
  • Posts: 851
    • Script BASIC Open Source Project
IUP Threaded - Linux 64 bit - SBT
« Reply #4 on: May 23, 2015, 07:26:41 PM »
Done!

I finally got this worked out and didn't have to inform Gtk or IUP that they're being threaded8)

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
  1. FUNCTION MainLoop
  2. LOCAL hex_event
  3.   LoopStep()
  4.   this_event = GetEvent()
  5.   hex_event = BB_HTA(this_event)
  6.   IF hex_event = event{hex_event}[0] THEN
  7.     IF event{hex_event}[2] = 1 THEN
  8.       SB_CallSub(main::sb1, event{hex_event}[1])
  9.     ELSEIF event{hex_event}[2] = 2 THEN
  10.       SB_CallSub(main::sb2, event{hex_event}[1])
  11.     END IF
  12.     MainLoop = GetActionName()
  13.   END IF  
  14. END FUNCTION
  15.  
  16. FUNCTION SetThreadCallback(ih, aname, fname, tnum)
  17.   t_event = mt::GetVariable("Callback_Map")
  18.   IF t_event = undef THEN t_event = ""
  19.   t_event = t_event & BB_HTA(ih) & "|" & fname & "|" & tnum & "\n"
  20.   mt::SetVariable("Callback_Map", t_event)
  21.   SetThreadCallback = __SetCallback(ih, aname)
  22. END FUNCTION
  23.  
  24. SUB GetThreadCallback
  25.   LOCAL t_event, e_list, e_array, x
  26.   t_event = mt::GetVariable("Callback_Map")
  27.   SPLITA t_event BY "\n" TO e_list
  28.   FOR x = 0 TO UBOUND(e_list)
  29.     SPLITA e_list[x] BY "|" TO e_array
  30.     event{e_array[0]}[0] = e_array[0]
  31.     event{e_array[0]}[1] = e_array[1]
  32.     event{e_array[0]}[2] = e_array[2]
  33.   NEXT
  34. END SUB
  35.  
  36. FUNCTION BB_HTA(AsciiStr)
  37.   LOCAL AsciiLen,ScanPos,HexStr
  38.   AsciiLen = LEN(AsciiStr)
  39.   HexStr = ""
  40.   IF AsciiLen THEN
  41.     FOR ScanPos = 1 TO AsciiLen
  42.       HexStr &= RIGHT("0" & HEX(ASC(MID(AsciiStr, ScanPos, 1))),2)
  43.     NEXT ScanPos
  44.   ELSE
  45.     HexStr = ""
  46.   END IF
  47.   BB_HTA = HexStr
  48. END FUNCTION
  49.  

iupmain.sb - host SB script (puppet master)
Code: Script BASIC
  1. IMPORT mt.bas
  2. IMPORT sbt.inc
  3. IMPORT iup.bas
  4.  
  5. Iup::Open()
  6.  
  7. SUB SB_Wait(mtvar)
  8.   WHILE mt::GetVariable(mtvar) <> "OK"
  9.     SB_msSleep(5000)
  10.   WEND
  11. END SUB
  12.  
  13. sb1 = SB_ThreadStart("rqdemo1.sb",undef,"/etc/scriba/basic.conf")
  14. SB_Wait("sb1_loaded")
  15. sb1_rtn = SB_CallSubArgs(sb1, "main::main", sb1)
  16.  
  17. sb2 = SB_ThreadStart("rqdemo2.sb",undef,"/etc/scriba/basic.conf")
  18. SB_Wait("sb2_loaded")
  19. sb2_rtn = SB_CallSubArgs(sb2, "main::main", sb2)
  20.  
  21. threads = 2
  22.  
  23. Iup::GetThreadCallback()
  24.  
  25. WHILE threads
  26.   event_class = Iup::MainLoop()
  27.   IF event_class = "CLOSE_CB" THEN
  28.     threads -= 1
  29.     IF Iup::event{Iup::BB_HTA(Iup::this_event)}[2] = 1 THEN
  30.       SB_CallSub(sb1, "iup::exitloop")
  31.     ELSEIF Iup::event{Iup::BB_HTA(Iup::this_event)}[2] = 2 THEN
  32.       SB_CallSub(sb2, "iup::exitloop")
  33.     END IF
  34.   END IF  
  35.   SB_msSleep(250)
  36. WEND
  37.  
  38. Iup::Close()
  39. SB_Destroy(sb2)
  40. SB_Destroy(sb1)
  41.  

rqdemo1.sb - rqdemo2.sb is identical other than the references to it been the second thread.
Code: Script BASIC
  1. ' Script BASIC Rapid-Q form conversion
  2.  
  3. IMPORT mt.bas
  4. IMPORT iup.bas
  5.  
  6. ' CALLBACKS FUNCTIONS
  7.  
  8. SUB button_quit
  9.   PRINT "Thread 1 Quit Button Pressed\n"
  10. END SUB  
  11.  
  12. SUB win_exit
  13.   ' Good-Bye  
  14. END SUB
  15.  
  16. SUB main
  17.  
  18.   ' SBIUP-Q INIT
  19.  
  20.   Iup::Open()
  21.   Iup::SetGlobal("DEFAULTFONT", "Sans, 7.5")
  22.  
  23.   ' CREATE FORM
  24.  
  25.   Form = Iup::Create("dialog")
  26.          Iup::SetAttributes(Form, "RASTERSIZE=320x240, TITLE=\"Thread 1\"")
  27.  
  28.        Label1  = Iup::Create("label")
  29.                  Iup::SetAttributes(Label1, "TITLE=\"Customer\", RASTERSIZE=55x13, FLOATING=YES, POSITION=\"19,19\"")
  30.  
  31.        Edit1   = Iup::Create("text")
  32.                  Iup::SetAttributes(Edit1, "RASTERSIZE=121x21, FLOATING=YES, POSITION=\"72,16\"")
  33.  
  34.        Button1 = Iup::Create("button")
  35.                  Iup::SetAttributes(Button1, "TITLE=\"&Quit\", RASTERSIZE=75x25, FLOATING=YES, POSITION=\"107,164\"")
  36.  
  37.   vbx = Iup::Vbox(Label1, Edit1, Button1)
  38.   Iup::Append(Form, vbx)
  39.                  
  40.   ' SET CALLBACKS
  41.  
  42.   Iup::SetThreadCallback(Form, "CLOSE_CB", "main::win_exit", 1)
  43.   Iup::SetThreadCallback(Button1, "ACTION", "main::button_quit", 1)
  44.   Iup::Show(Form)
  45. END SUB
  46. mt::SetVariable("sb1_loaded","OK")
  47.  
« Last Edit: May 25, 2015, 01:20:01 AM by support »
Script BASIC Project Manager

support

  • Administrator
  • *****
  • Posts: 851
    • Script BASIC Open Source Project
IUP Threaded - Linux 64 bit - SBT 3*3
« Reply #5 on: May 25, 2015, 07:20:52 PM »
The solution to my unstable IUP start-up issues were resolved with creating an IUP dialog in the parent script before creating threaded children dialogs.  I moved the Iup::MainLoop and Iup::GetThreadCallback routines into the main script from the IUP extension module. At this point everything is working as expected and I couldn't be happier.

Moral: How can you have well behaved children if you don't have a mature parent in charge?  ::)

SBx_Main
Code: Script BASIC
  1. ' SBT IUP Theaded Example
  2.  
  3. IMPORT mt.bas
  4. IMPORT sbt.inc
  5. IMPORT iup.bas
  6. IMPORT "SBx"
  7.  
  8. Iup::Open()
  9.  
  10. SUB SB_Wait(mtvar)
  11.   WHILE mt::GetVariable(mtvar) <> "OK"
  12.     SB_msSleep(5000)
  13.   WEND
  14. END SUB
  15.  
  16. SUB btn1_clicked
  17.   PRINT "Main 0 Button 1 Pressed\n"
  18.   PRINT "Which Mouse Button: ",CHR(Iup::GetBtnPressed()),"\n"
  19.   PRINT "Button Up/Dn State: ",Iup::GetBtnState(),"\n"
  20. END SUB
  21.  
  22. SUB btn2_clicked
  23.   PRINT "Main 0 Button 2 Pressed\n"
  24. END SUB
  25.  
  26. SUB btn3_clicked
  27.   PRINT "Main 0 Button 3 Pressed\n"
  28. END SUB
  29.  
  30. SUB win_exit
  31.   ' Good-Bye
  32. END SUB
  33.  
  34. win = DIALOG()
  35. SETPROPERTIES win, "TITLE=\"SBx Main 0\", SIZE=300x"
  36. horzbox = HBOX()
  37. SETPROPERTIES horzbox, "GAP=5"
  38. btn1 = BUTTON()
  39. SETPROPERTIES btn1, "TITLE=\"Button 1\", EXPAND=HORIZONTAL"
  40. btn2 = BUTTON()
  41. SETPROPERTIES btn2, "TITLE=\"Button 2\", EXPAND=HORIZONTAL"
  42. btn3 = BUTTON()
  43. SETPROPERTIES btn3, "TITLE=\"Button 3\", EXPAND=HORIZONTAL"
  44. APPEND horzbox, btn1
  45. APPEND horzbox, btn2
  46. APPEND horzbox, btn3
  47. APPEND win, horzbox
  48. Iup::SetThreadCallback(win, "CLOSE_CB", ADDRESS(win_exit()), 0)
  49. Iup::SetThreadCallback(btn1, "BUTTON_CB", ADDRESS(btn1_clicked()), 0)
  50. Iup::SetThreadCallback(btn2, "ACTION", ADDRESS(btn2_clicked()), 0)
  51. Iup::SetThreadCallback(btn3, "ACTION", ADDRESS(btn3_clicked()), 0)
  52. SHOW win
  53.  
  54. ' Puppet Show
  55.  
  56. sb1 = SB_ThreadStart("SBx_T1",undef,"/etc/scriba/basic.conf")
  57. SB_Wait("sb1_loaded")
  58. sb1_rtn = SB_CallSubArgs(sb1, "main::main", sb1)
  59.  
  60. sb2 = SB_ThreadStart("SBx_T2",undef,"/etc/scriba/basic.conf")
  61. SB_Wait("sb2_loaded")
  62. sb2_rtn = SB_CallSubArgs(sb2, "main::main", sb2)
  63.  
  64. threads = 3
  65.  
  66. t_event = mt::GetVariable("Callback_Map")
  67. SPLITA t_event BY "\n" TO e_list
  68. FOR x = 0 TO UBOUND(e_list)
  69.   SPLITA e_list[x] BY "|" TO e_array
  70.   event{e_array[0]}[0] = e_array[0]
  71.   event{e_array[0]}[1] = e_array[1]
  72.   event{e_array[0]}[2] = e_array[2]
  73. NEXT
  74.  
  75. WHILE threads
  76.   Iup::LoopStep()
  77.   this_event = Iup::GetEvent()
  78.   hex_event = Iup::BB_HTA(this_event)
  79.   IF hex_event = event{hex_event}[0] THEN
  80.     IF event{hex_event}[2] = 0 THEN
  81.       ICALL event{hex_event}[1]
  82.     ELSE IF event{hex_event}[2] = 1 THEN
  83.       SB_CallSub(main::sb1, event{hex_event}[1])
  84.     ELSE IF event{hex_event}[2] = 2 THEN
  85.       SB_CallSub(main::sb2, event{hex_event}[1])
  86.     END IF
  87.     IF Iup::GetActionName() = "CLOSE_CB" THEN threads -= 1
  88.   END IF  
  89.   SB_msSleep(250)
  90. WEND
  91.  
  92. Iup::Close()
  93. SB_Destroy(sb2)
  94. SB_Destroy(sb1)
  95.  

SBx_T1 - T2 is the same
Code: Script BASIC
  1. ' SBx_buttons Example (Thread 1)
  2.  
  3. IMPORT mt.bas
  4. IMPORT iup.bas
  5. IMPORT "SBx"
  6.  
  7. SUB btn1_clicked
  8.   PRINT "Thread 1 Button 1 Pressed\n"
  9.   PRINT "Which Mouse Button: ",CHR(Iup::GetBtnPressed()),"\n"
  10.   PRINT "Button Up/Dn State: ",Iup::GetBtnState(),"\n"
  11. END SUB
  12.  
  13. SUB btn2_clicked
  14.   PRINT "Thread 1 Button 2 Pressed\n"
  15. END SUB
  16.  
  17. SUB btn3_clicked
  18.   PRINT "Thread 1 Button 3 Pressed\n"
  19. END SUB
  20.  
  21. SUB win_exit
  22.   ' Good-Bye
  23. END SUB
  24.  
  25. SUB main
  26.   win = DIALOG()
  27.   SETPROPERTIES win, "TITLE=\"SBx Thread 1\", SIZE=300x"
  28.   horzbox = HBOX()
  29.   SETPROPERTIES horzbox, "GAP=5"
  30.   btn1 = BUTTON()
  31.   SETPROPERTIES btn1, "TITLE=\"Button 1\", EXPAND=HORIZONTAL"
  32.   btn2 = BUTTON()
  33.   SETPROPERTIES btn2, "TITLE=\"Button 2\", EXPAND=HORIZONTAL"
  34.   btn3 = BUTTON()
  35.   SETPROPERTIES btn3, "TITLE=\"Button 3\", EXPAND=HORIZONTAL"
  36.   APPEND horzbox, btn1
  37.   APPEND horzbox, btn2
  38.   APPEND horzbox, btn3
  39.   APPEND win, horzbox
  40.   Iup::SetThreadCallback(win, "CLOSE_CB", "main::win_exit", 1)
  41.   Iup::SetThreadCallback(btn1, "BUTTON_CB", "main::btn1_clicked", 1)
  42.    Iup::SetThreadCallback(btn2, "ACTION", "main::btn2_clicked", 1)
  43.   Iup::SetThreadCallback(btn3, "ACTION", "main::btn3_clicked", 1)
  44.   SHOW win
  45. END SUB
  46. mt::SetVariable("sb1_loaded","OK")
  47.  

SBx (Experimental IUP Wrapper)
Code: Script BASIC
  1. ' ScriptBasic IUP Interface
  2.  
  3. FUNCTION DIALOG
  4.   DIALOG = Iup::Create("dialog")
  5. END FUNCTION
  6.  
  7. SUB SETPROPERTIES(ih, propstr)
  8.   Iup::SetAttributes(ih, propstr)
  9. END SUB
  10.  
  11. SUB SETPROPERTY(ih, typ, value)
  12.   Iup::SetAttribute(ih, typ, value)
  13. END SUB
  14.  
  15. FUNCTION GETPROPERTY(ih, typ)
  16.   GETPROPERTY = Iup::GetAttribute(ih, typ)
  17. END FUNCTION
  18.  
  19. FUNCTION VBOX
  20.   VBOX = Iup::Create("vbox")
  21. END FUNCTION
  22.  
  23. FUNCTION HBOX
  24.   HBOX = Iup::Create("hbox")
  25. END FUNCTION
  26.  
  27. FUNCTION FRAME
  28.   FRAME = Iup::Create("frame")
  29. END FUNCTION
  30.  
  31. FUNCTION BUTTON
  32.   BUTTON = Iup::Create("button")
  33. END FUNCTION
  34.  
  35. FUNCTION LIST
  36.   LIST = Iup::Create("list")
  37. END FUNCTION
  38.  
  39. FUNCTION TEXT
  40.   TEXT = Iup::Create("text")
  41. END FUNCTION
  42.  
  43. FUNCTION LABEL
  44.   LABEL = Iup::Create("label")
  45. END FUNCTION
  46.  
  47. FUNCTION TOGGLE
  48.   TOGGLE = Iup::Create("toggle")
  49. END FUNCTION
  50.  
  51. SUB MESSAGE(title, body)
  52.   Iup::Message(title, body)
  53. END SUB
  54.  
  55. FUNCTION GETITEM
  56.   GETITEM = Iup::GetListText()
  57. END FUNCTION
  58.  
  59. SUB APPEND(ih_to, ih_from)
  60.   Iup::Append(ih_to, ih_from)
  61. END SUB
  62.  
  63. FUNCTION FOCUS(ih)
  64.   FOCUS = Iup::SetFocus(ih)
  65. END FUNCTION
  66.  
  67. FUNCTION UPDATE(ih)
  68.   UPDATE = Iup::Update(ih)
  69. END FUNCTION
  70.  
  71. SUB CLEAR(ih)
  72.   Iup::ClearList(ih)
  73. END SUB
  74.  
  75. ' SUB SETEVENT(ih, class, funcaddr)
  76. '   Iup::SetCallback(ih, class,  funcaddr)
  77. ' END SUB
  78.  
  79. SUB SHOW(ih)
  80.   Iup::Show(ih)
  81. END SUB  
  82.  
  83. ' SUB GETEVENT
  84. '   Iup::MainLoop
  85. '   Iup::Close
  86. ' END SUB
  87.  
« Last Edit: May 25, 2015, 07:23:27 PM by support »
Script BASIC Project Manager

support

  • Administrator
  • *****
  • Posts: 851
    • Script BASIC Open Source Project
SBx 3 Forms
« Reply #6 on: May 27, 2015, 11:19:46 PM »
As it turns out, you really don't need threading to achieve multiple window support. As I see it threading of a IUP dialog would be a special use case. It's good to know it can be done.

Code: Script BASIC
  1. ' SBx_buttons Example (3 Form Version)
  2.  
  3. IMPORT iup.bas
  4. IMPORT sbt.inc
  5. IMPORT "SBx"
  6.  
  7. ' Form 1 Callback Routines
  8. SUB frm1_btn1_clicked
  9.   PRINT "Form 1 Button 1 Pressed\n"
  10.   PRINT "Which Mouse Button: ",CHR(Iup::GetBtnPressed()),"\n"
  11.   PRINT "Button Up/Dn State: ",Iup::GetBtnState(),"\n"
  12. END SUB
  13.  
  14. SUB frm1_btn2_clicked
  15.   PRINT "Form 1 Button 2 Pressed\n"
  16. END SUB
  17.  
  18. SUB frm1_btn3_clicked
  19.   PRINT "Form 1 Button 3 Pressed\n"
  20. END SUB
  21.  
  22. ' Form 2  Callback Routines
  23. SUB frm2_btn1_clicked
  24.   PRINT "Form 2 Button 1 Pressed\n"
  25.   PRINT "Which Mouse Button: ",CHR(Iup::GetBtnPressed()),"\n"
  26.   PRINT "Button Up/Dn State: ",Iup::GetBtnState(),"\n"
  27. END SUB
  28.  
  29. SUB frm2_btn2_clicked
  30.   PRINT "Form 2 Button 2 Pressed\n"
  31. END SUB
  32.  
  33. SUB frm2_btn3_clicked
  34.   PRINT "Form 2 Button 3 Pressed\n"
  35. END SUB
  36.  
  37. ' Form 3 Callback Routines
  38. SUB frm3_btn1_clicked
  39.   PRINT "Form 3 Button 1 Pressed\n"
  40.   PRINT "Which Mouse Button: ",CHR(Iup::GetBtnPressed()),"\n"
  41.   PRINT "Button Up/Dn State: ",Iup::GetBtnState(),"\n"
  42. END SUB
  43.  
  44. SUB frm3_btn2_clicked
  45.   PRINT "Form 3 Button 2 Pressed\n"
  46. END SUB
  47.  
  48. SUB frm3_btn3_clicked
  49.   PRINT "Form 3 Button 3 Pressed\n"
  50. END SUB
  51.  
  52. SUB win_exit
  53.   ' Good-Bye
  54. END SUB
  55.  
  56. Iup::Open()
  57.  
  58. ' Form 1 Dialog
  59. win1 = DIALOG()
  60. SETPROPERTIES(win1, "TITLE=\"SBx Form 1\", SIZE=300x")
  61. horzbox1 = HBOX()
  62. SETPROPERTIES horzbox1, "GAP=5"
  63. btn1_1 = BUTTON()
  64. SETPROPERTIES btn1_1, "TITLE=\"Button 1\", EXPAND=HORIZONTAL"
  65. btn1_2 = BUTTON()
  66. SETPROPERTIES btn1_2, "TITLE=\"Button 2\", EXPAND=HORIZONTAL"
  67. btn1_3 = BUTTON()
  68. SETPROPERTIES btn1_3, "TITLE=\"Button 3\", EXPAND=HORIZONTAL"
  69. APPEND horzbox1, btn1_1
  70. APPEND horzbox1, btn1_2
  71. APPEND horzbox1, btn1_3
  72. APPEND win1, horzbox1
  73. Iup::SetCallback win1, "CLOSE_CB", ADDRESS(win_exit())
  74. Iup::SetCallback btn1_1, "BUTTON_CB", ADDRESS(frm1_btn1_clicked())
  75. Iup::SetCallback btn1_2, "ACTION", ADDRESS(frm1_btn2_clicked())
  76. Iup::SetCallback btn1_3, "ACTION", ADDRESS(frm1_btn3_clicked())
  77. Iup::ShowXY(win1,500,200)
  78.  
  79.  
  80.  
  81. ' Form 2 Dialog
  82. win2 = DIALOG()
  83. SETPROPERTIES win2, "TITLE=\"SBx Form 2\", SIZE=300x"
  84. horzbox2 = HBOX()
  85. SETPROPERTIES horzbox2, "GAP=5"
  86. btn2_1 = BUTTON()
  87. SETPROPERTIES btn2_1, "TITLE=\"Button 1\", EXPAND=HORIZONTAL"
  88. btn2_2 = BUTTON()
  89. SETPROPERTIES btn2_2, "TITLE=\"Button 2\", EXPAND=HORIZONTAL"
  90. btn2_3 = BUTTON()
  91. SETPROPERTIES btn2_3, "TITLE=\"Button 3\", EXPAND=HORIZONTAL"
  92. APPEND horzbox2, btn2_1
  93. APPEND horzbox2, btn2_2
  94. APPEND horzbox2, btn2_3
  95. APPEND win2, horzbox2
  96. Iup::SetCallback win2, "CLOSE_CB", ADDRESS(win_exit())
  97. Iup::SetCallback btn2_1, "BUTTON_CB", ADDRESS(frm2_btn1_clicked())
  98. Iup::SetCallback btn2_2, "ACTION", ADDRESS(frm2_btn2_clicked())
  99. Iup::SetCallback btn2_3, "ACTION", ADDRESS(frm2_btn3_clicked())
  100. Iup::ShowXY(win2,500,400)
  101.  
  102. ' Form 3 Dialog
  103. win3 = DIALOG()
  104. SETPROPERTIES win3, "TITLE=\"SBx Form 3\", SIZE=300x"
  105. horzbox3 = HBOX()
  106. SETPROPERTIES horzbox3, "GAP=5"
  107. btn3_1 = BUTTON()
  108. SETPROPERTIES btn3_1, "TITLE=\"Button 1\", EXPAND=HORIZONTAL"
  109. btn3_2 = BUTTON()
  110. SETPROPERTIES btn3_2, "TITLE=\"Button 2\", EXPAND=HORIZONTAL"
  111. btn3_3 = BUTTON()
  112. SETPROPERTIES btn3_3, "TITLE=\"Button 3\", EXPAND=HORIZONTAL"
  113. APPEND horzbox3, btn3_1
  114. APPEND horzbox3, btn3_2
  115. APPEND horzbox3, btn3_3
  116. APPEND win3, horzbox3
  117. Iup::SetCallback win3, "CLOSE_CB", ADDRESS(win_exit())
  118. Iup::SetCallback btn3_1, "BUTTON_CB", ADDRESS(frm3_btn1_clicked())
  119. Iup::SetCallback btn3_2, "ACTION", ADDRESS(frm3_btn2_clicked())
  120. Iup::SetCallback btn3_3, "ACTION", ADDRESS(frm3_btn3_clicked())
  121. Iup::ShowXY(win3,500,600)
  122.  
  123.  
  124.  
  125. ' Event Loop
  126. windows = 3
  127.  
  128. WHILE windows
  129.   Iup::LoopStep()
  130.   this_event = Iup::GetEvent()
  131.   this_event = Iup::BB_HTA(this_event)
  132.   IF this_event = event{this_event}[0] THEN
  133.     ICALL event{this_event}[1]
  134.     IF Iup::GetActionName() = "CLOSE_CB" THEN windows -= 1
  135.   END IF  
  136.   SB_msSleep(250)
  137. WEND
  138.  
  139. Iup::Close
  140.  

iup.bas - I changed the Iup::SetCallback() to create the event array in the main namespace.
Code: Script BASIC
  1. FUNCTION SetCallback(ih, aname, fname)
  2.   main::event{BB_HTA(ih)}[0] = BB_HTA(ih)
  3.   main::event{BB_HTA(ih)}[1] = fname
  4.   SetCallback = __SetCallback(ih, aname)
  5. END FUNCTION
  6.  
« Last Edit: May 27, 2015, 11:23:00 PM by support »
Script BASIC Project Manager