Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.


Topics - Support

Pages: 1 [2] 3 4 ... 12
16
What's New / dbgcon - Script BASIC remote debugger
« on: May 05, 2015, 07:47:55 PM »
A few years ago I made some bug fixes to Peter's Verhas's experimental sdbg remote Script BASIC debugger. I wrote my own console client in SB which works great. I plan on using some of Dave Zimmer's enhancements to his VB/COM IDE/Debugger preprocessor project to view array contents and trace the call stack. The remote socket based Script BASIC debugger works with both local desktop scripts and remote sbhttpd proxy server web applications.

dbgcon.sb
Code: Script BASIC
  1. ' ScriptBasic Remote Console Debugger
  2.  
  3. cmdln = TRIM(COMMAND())
  4. IF cmdln = "" THEN
  5.   PRINT "Usage: dbgcon [prog2debug]\n"
  6.   END
  7. END IF
  8. exitcode = EXECUTE("/usr/bin/scriba -i sdbg " & cmdln,-1,PID)
  9. OPEN "127.0.0.1:6647" FOR SOCKET AS #1
  10. WHILE NOT EOF(1)
  11.   LINE INPUT #1, dbgs
  12.   IF dbgs = ".\n" THEN
  13.     PRINT "-> "
  14.     LINE INPUT dbgc
  15.     IF LCASE(CHOMP(dbgc)) = "h" THEN
  16. PRINT """h help
  17. s step one line
  18. S step one line, do not step into functions or subs
  19. o step until getting out of the current function
  20.  (if you stepped into but changed your mind)
  21. ? var  print the value of a variable
  22. u step one level up in the stack
  23. d step one level down in the stack (for variable printing)
  24. D step down in the stack to current execution depth
  25. G list all global variables
  26. L list all local variables
  27. l [n-m] list the source lines
  28. r [n] run to line n
  29. R [n] run to line n but do not stop in recursive function call
  30. b [n] set breakpoint on the line n or the current line
  31. B [n-m] remove breakpoints from lines
  32. q quit the program
  33. """
  34.     END IF
  35.     PRINT #1, dbgc
  36.     IF CHOMP(dbgc) = "q" THEN GOTO Done
  37.   ELSE
  38.     dbgcmd = CHOMP(dbgs)
  39. ' l - List Source  
  40.    IF INSTR(dbgcmd,"Break-Point: ")<>undef THEN
  41.       p = INSTR(dbgcmd,"Break-Point: ")
  42.       IF MID(dbgcmd,p+13,1) = "0" THEN
  43.         PRINT " "
  44.       ELSE
  45.         PRINT "*"
  46.       END IF
  47.       GOTO IT
  48.     END IF
  49.     IF INSTR(dbgcmd,"Line-Number: ")<>undef THEN
  50.       p = INSTR(dbgcmd,"Line-Number: ")
  51.       PRINT FORMAT("%~[0000] ~",VAL(MID(dbgcmd,p+13)))
  52.       online = TRUE
  53.       GOTO IT
  54.     END IF
  55.     IF INSTR(dbgcmd,"Line: ")<>undef THEN
  56.       p = INSTR(dbgcmd,"Line: ")
  57.       IF online THEN
  58.         PRINT MID(dbgcmd,p+6),"\n"
  59.       ELSE
  60.         PRINT MID(dbgcmd,p),"\n"
  61.       END IF        
  62.       online = FALSE
  63.       GOTO IT
  64.     END IF
  65.     IF INSTR(dbgcmd,"Global-Variable")<>undef THEN
  66.       p = INSTR(dbgcmd,"Global-Variable")
  67.       PRINT "G-Var" & MID(dbgcmd,p+15) & "\n"
  68.       GOTO IT
  69.     END IF
  70. ' Unprocessed out
  71.   PRINT dbgs
  72.   END IF
  73. IT:
  74. WEND
  75.  
  76. Done:
  77. PRINT #1,"q"
  78. CLOSE(1)
  79. PRINT "Debug session closed.\n"
  80. END
  81.  

testarray.sb
Code: Script BASIC
  1. ' Long / Double / String
  2. i = 1
  3. d = .99
  4. s = "JRS"
  5. ' Indices array
  6. a[0,0] = 0
  7. a[0,1] = 123
  8. a[0,2] = 1.23
  9. a[0,3] = "One,Two,Three"
  10. a[1,10] = "Zero"
  11. a[1,11] = 321
  12. a[1,12] = 32.1
  13. a[1,13] = "Three,Two,One"
  14. ' Asscociative array
  15. b{"One"} = 1
  16. b{"Two"} = .2
  17. b{"Three"} = "*3*"
  18. ' Mix asscociative & indices array
  19. c{"JRS"}[1] = 1
  20. c{"JRS"}[2] = .2
  21. c{"JRS"}[3] = "*3*"
  22. PRINT "Done\n"
  23.  

Output

jrs@laptop:~/sb/sb22/sbt$ scriba dbgcon.sb testarray.sb
Application: ScriptBasic Remote Debugger - Linux
Version: 1.0
Source-File-Count: 1
Source-File: testarray.sb
Line: 2
-> b15
Message: done
Line: 2
-> l1-
 [0001] ' Long / Double / String
 [0002] i = 1
 [0003] d = .99
 [0004] s = "JRS"
 [0005] ' Indices array
 [0006] a[0,0] = 0
 [0007] a[0,1] = 123
 [0008] a[0,2] = 1.23
 [0009] a[0,3] = "One,Two,Three"
 [0010] a[1,10] = "Zero"
 [0011] a[1,11] = 321
 [0012] a[1,12] = 32.1
 [0013] a[1,13] = "Three,Two,One"
 [0014] ' Asscociative array
*[0015] b{"One"} = 1
 [0016] b{"Two"} = .2
 [0017] b{"Three"} = "*3*"
 [0018] ' Mix asscociative & indices array
 [0019] c{"JRS"}[1] = 1
 [0020] c{"JRS"}[2] = .2
 [0021] c{"JRS"}[3] = "*3*"
 [0022] PRINT "Done\n"
Line: 2
-> r
Line: 15
-> r22
Line: 22
-> G
G-Var-Name: VT=0 @ 0x014BBD18 VN=main::i
G-Var-Value: 1
G-Var-Name: VT=1 @ 0x014C9258 VN=main::d
G-Var-Value: 0.990000
G-Var-Name: VT=2 @ 0x014C92B8 VN=main::s
G-Var-Value: "JRS"
G-Var-Name: VT=3 @ 0x014C9378 LB=0 : UB=1 VN=main::a
G-Var-Value: 
LB=0 : UB=3 VN=[0]
[0] VT=3 @ 0x014C9468 
[0] VT=0 @ 0x014C9558 0
[1] VT=0 @ 0x014C96D8 123
[2] VT=1 @ 0x014C9898 1.230000
[3] VT=2 @ 0x014BC0A8 "One,Two,Three"
LB=10 : UB=13 VN=[1]
[1] VT=3 @ 0x014BC1C8 
[10] VT=2 @ 0x014BC228 "Zero"
[11] VT=0 @ 0x014BC3A8 321
[12] VT=1 @ 0x014BC568 32.100000
[13] VT=2 @ 0x014BC6D8 "Three,Two,One"
G-Var-Name: VT=3 @ 0x014BC798 LB=0 : UB=5 VN=main::b
G-Var-Value: 
[0] VT=2 @ 0x014BC7F8 "One"
[1] VT=0 @ 0x014BC8B8 1
[2] VT=2 @ 0x014BC968 "Two"
[3] VT=1 @ 0x014BCA28 0.200000
[4] VT=2 @ 0x014BCAE8 "Three"
[5] VT=2 @ 0x014BCB48 "*3*"
G-Var-Name: VT=3 @ 0x014BCBA8 LB=0 : UB=1 VN=main::c
G-Var-Value: 
[0] VT=2 @ 0x014BCC08 "JRS"
LB=1 : UB=3 VN=[1]
[1] VT=3 @ 0x014BCCC8 
[1] VT=0 @ 0x014BCD88 1
[2] VT=1 @ 0x014BCEA8 0.200000
[3] VT=2 @ 0x014BD5C8 "*3*"
Line: 22
-> ?s
Value: "JRS"
Line: 22
-> ?b
Value: 
[0] VT=2 @ 0x014BC7F8 "One"
[1] VT=0 @ 0x014BC8B8 1
[2] VT=2 @ 0x014BC968 "Two"
[3] VT=1 @ 0x014BCA28 0.200000
[4] VT=2 @ 0x014BCAE8 "Three"
[5] VT=2 @ 0x014BCB48 "*3*"
Line: 22
-> r
Done
Debug session closed.
jrs@laptop:~/sb/sb22/sbt$


17
What's New / 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$


18
Business BASIC Migrations / Business BASIC Helper Library
« on: May 04, 2015, 01:30:51 AM »
Here are a few ProvideX Business Basic like functions that can be used to help with your conversion to Script BASIC.

Code: Script BASIC
  1. ' BB Function Helper Library
  2.  
  3.  
  4. ' BB_ATH - Business BASIC ATH() function
  5. '
  6. ' Converts a text string of hex character pairs to ASCII values.
  7. '
  8. FUNCTION BB_ATH(HexStr)
  9.  
  10.   LOCAL LenHex, AsciiStr, HexTable, ScanPos, HiByte, LowByte
  11.   LenHex = LEN(HexStr)
  12.   IF LenHex % 2 = 0 THEN
  13.     HexTable = "0123456789ABCDEF"
  14.     FOR ScanPos = 1 TO LenHex STEP 2
  15.       HiByte = INSTR(HexTable,UCASE(MID(HexStr, ScanPos, 1))) - 1
  16.       LowByte = INSTR(HexTable,UCASE(MID(HexStr, ScanPos + 1, 1))) - 1
  17.       IF ISINTEGER(HiByte) AND ISINTEGER(LowByte) THEN
  18.         AsciiStr &= CHR(HiByte * 16 + LowByte)
  19.       ELSE
  20.         AsciiStr = ""
  21.         GOTO Exit_For        
  22.       END IF
  23.     NEXT ScanPos
  24.     Exit_For:
  25.   ELSE
  26.     AsciiStr = ""
  27.   END IF
  28.   BB_ATH = AsciiStr
  29.  
  30. END FUNCTION
  31.  
  32.  
  33. ' BB_CVS - Business Basic CVS() function
  34. '
  35. ' Action:
  36. '  1   = Remove Leading characters
  37. '  2   = Remove Trailing characters
  38. '  4   = Convert String to Upper Case
  39. '  8   = Convert String to Lower Case
  40. '  16  = Replace characters < 32 with the control character
  41. '  32  = Replace multiple occurrence of the character with one
  42. '  64  = * Replace $ with defined Windows currency symbol
  43. '  128 = * Replace defined Windows currency, comma and thousand symbol
  44. '  256 = * Ucase first char of each word, rest to lower
  45. '    * = Not implemented yet.
  46. '
  47. FUNCTION BB_CVS(StrExpr, Action, CtrlChar)
  48.  
  49.   LOCAL Char, ExprLen, TempStr, ScanPos
  50.   IF CtrlChar = undef THEN CtrlChar = " "
  51.   Char = ASC(CtrlChar)
  52.  
  53.   ' Remove Leading characters
  54.  IF (Action AND 1) THEN  
  55.     ExprLen = LEN(StrExpr)
  56.     IF CtrlChar = " " THEN
  57.       StrExpr = LTRIM(StrExpr)
  58.     ELSE
  59.       TempStr = ""
  60.       FOR ScanPos = 1 TO ExprLen
  61.         IF MID(StrExpr, ScanPos, 1) <> CtrlChar THEN TempStr &= MID(StrExpr, ScanPos, 1)
  62.       NEXT ScanPos
  63.       StrExpr = TempStr
  64.     END IF
  65.   END IF
  66.  
  67.   ' Remove Trailing characters
  68.  IF (Action AND 2) THEN  
  69.     ExprLen = LEN(StrExpr)
  70.     IF CtrlChar = " " THEN
  71.       StrExpr = RTRIM(StrExpr)
  72.     ELSE
  73.       TempStr = ""
  74.       FOR ScanPos = ExprLen TO 1 STEP - 1
  75.         IF MID(StrExpr, ScanPos, 1) = CtrlChar THEN TempStr = LEFT(StrExpr, ScanPos - 1)
  76.       NEXT ScanPos
  77.       IF LEN(TempStr) THEN StrExpr = TempStr
  78.     END IF
  79.   END IF
  80.  
  81.   ' Convert String to Upper Case
  82.  IF (Action AND 4) THEN  
  83.     StrExpr = UCASE(StrExpr)
  84.   END IF
  85.  
  86.   ' Convert String to Lower Case
  87.  IF (Action AND 8) THEN  
  88.     StrExpr = LCASE(StrExpr)
  89.   END IF
  90.  
  91.   ' Replace characters < 32 with the control character
  92.  IF (Action AND 16) THEN  
  93.     FOR ScanPos = 1 TO LEN(StrExpr)
  94.          IF ASC(MID(StrExpr, ScanPos, 1)) < 32 THEN StrExpr = LEFT(StrExpr, ScanPos -1) & CtrlChar & MID(StrExpr, ScanPos + 1)
  95.     NEXT ScanPos
  96.   END IF
  97.  
  98.   ' Replace multiple occurence of the character with one
  99.  IF (Action AND 32) THEN  
  100.     HitCnt = 0
  101.     StartPos = 1
  102.     NextPos:
  103.     ScanPos = INSTR(StrExpr,CtrlChar,StartPos)
  104.     IF ISINTEGER(ScanPos) THEN
  105.       IF HitCnt THEN  
  106.         IF ASC(MID(StrExpr, ScanPos,1)) = CtrlChar THEN TeStrExpr = LEFT(StrExpr, ScanPos -1) & MID(StrExpr, ScanPos + 1)
  107.       ELSE
  108.         HitCnt += 1
  109.       END IF
  110.       StartPos += 1
  111.       GOTO NextPos
  112.     END IF
  113.   END IF        
  114.   BB_CVS = StrExpr
  115.  
  116. END FUNCTION
  117.  
  118.  
  119. ' BB_DEC - Business BASIC DEC() function
  120. '
  121. ' Returns a two's complement binary equivalent of the string.
  122. '
  123. FUNCTION BB_DEC(BinStr)                                  
  124.  
  125.   LOCAL i, d                                      
  126.   FOR i = LEN(BinStr) TO 1 STEP -1                        
  127.     d += ASC(MID(BinStr,i,1)) * 256 ^ ABS(i - LEN(BinStr))
  128.   NEXT i                                                    
  129.   BB_DEC = d                                                
  130.  
  131. END FUNCTION                                              
  132.  
  133.  
  134. ' BB_HTA - Business BASIC HTA() function
  135. '
  136. ' Returns the hexadecimal text string of the pasted argument string.
  137. '
  138. FUNCTION BB_HTA(AsciiStr)
  139.   LOCAL AsciiLen,ScanPos,HexStr
  140.   AsciiLen = LEN(AsciiStr)
  141.   IF AsciiLen THEN
  142.     FOR ScanPos = 1 TO AsciiLen
  143.       HexStr &= RIGHT("0" & HEX(ASC(MID(AsciiStr, ScanPos, 1))),2)
  144.     NEXT ScanPos
  145.   ELSE
  146.     HexStr = ""
  147.   END IF
  148.   BB_HTA = HexStr
  149. END FUNCTION
  150.  
  151.  
  152. ' BB_JUL - Business BASIC JUL() function
  153. '
  154. ' Converts a date from year, month, day to a Julian date.
  155. '
  156. FUNCTION BB_JUL(Y,M,D)
  157.  
  158.   IF Y = undef AND M = undef AND D = undef THEN
  159.     BB_JUL = NOW
  160.   ELSE
  161.     BB_JUL = TIMEVALUE(Y,M,D)
  162.   END IF
  163.  
  164. END FUNCTION
  165.  
  166.  
  167. ' BB_LRC - Business Basic LRC() function.
  168. '
  169. ' Returns a one byte string containing the longitudinal redundancy checksum of a character string.
  170. '
  171. FUNCTION BB_LRC(ArgStr)
  172.  
  173.   LOCAL ArgStrLen, ScanPos, LRCVal
  174.   LRCVal = 0
  175.   ArgStrLen = LEN(ArgStr)
  176.   IF ArgStrLen THEN
  177.     FOR ScanPos = 1 TO ArgStrLen
  178.       LRCVal += LRCVal XOR ASC(MID(ArgStr, ScanPos, 1))
  179.     NEXT ScanPos
  180.     BB_LRC = CHR(LRCVal)
  181.   ELSE
  182.     BB_LRC = CHR(&H00)
  183.   END IF
  184.  
  185. END FUNCTION
  186.  
  187.  
  188. ' BB_PAD - Business BASIC PAD() funtion
  189. '
  190. ' Returns a character string of the length specified (NumExpr)
  191. '
  192. ' NOTE: StrExpr    = String to be processed
  193. '       NewLen     = Desired length of string
  194. '       HowToPad   = This parameter defines how to pad the string
  195. '                     0 - Pad on left  (right justify)
  196. '                     1 - Pad on right (left justify)
  197. '                     2 - Center in string
  198. '       StrPad     = First character of this string used to pad StrExpr
  199. '
  200. FUNCTION BB_PAD(StrExpr,NewLen,HowToPad,StrPad)
  201.  
  202.   LOCAL StrExpr,NewLen,HowToPad,StrPad,PadVal,StrExprLen,ResultStr,RLPLen
  203.   IF HowToPad = undef THEN
  204.     PadVal = 1
  205.   ELSE IF HowToPad = 0 OR UCASE(HowToPad) = "L" THEN
  206.     PadVal = 0
  207.   ELSE IF HowToPad = 1 OR UCASE(HowToPad) = "R" THEN  
  208.     PadVal = 1
  209.   ELSE IF HowToPad = 2 OR UCASE(HowToPad) = "C" THEN      
  210.     PadVal = 2
  211.   ELSE
  212.     BB_ERR = 41
  213.     BB_PAD = ""
  214.     EXIT FUNCTION
  215.   END IF
  216.  
  217.   IF StrPad = undef THEN StrPad = " "
  218.   StrExprLen = LEN(StrExpr)
  219.  
  220.   IF PadVal = 0 THEN
  221.     IF NewLen < StrExprLen THEN
  222.       ResultStr = RIGHT(StrExpr, NewLen)
  223.     ELSE
  224.       ResultStr = STRING(NewLen - StrExprLen, StrPad) & StrExpr
  225.     END IF
  226.   END IF
  227.  
  228.   IF PadVal = 1 THEN
  229.     IF NewLen < StrExprLen THEN
  230.       ResultStr = LEFT(StrExpr, NewLen)
  231.     ELSE
  232.       ResultStr = StrExpr & STRING(NewLen - StrExprLen, StrPad)
  233.     END IF
  234.   END IF
  235.  
  236.   IF PadVal = 2 THEN
  237.     IF NewLen < StrExprLen THEN
  238.       ResultStr = LEFT(StrExpr, NewLen)
  239.     ELSE
  240.       RLPLen = (NewLen - StrExprLen) / 2
  241.       IF RLPLen % 2 THEN
  242.         ResultStr = STRING(FIX(RLPLen),StrPad) & StrExpr & STRING(FIX(RLPLen) + 1,StrPad)
  243.       ELSE
  244.         ResultStr = STRING(RLPLen,StrPad) & StrExpr & STRING(RLPLen,StrPad)
  245.       END IF
  246.     ENDIF
  247.   END IF
  248.  
  249.   BB_PAD = ResultStr
  250.  
  251. END FUNCTION
  252.  
  253.  
  254. ' BB_POS - Business Basic POS() function
  255. '
  256. ' BB_POS follows these logic steps:
  257. '
  258. ' 1. If stringA or StringB is null, return 0
  259. ' 2. Start with first byte in stringB if intA is positive, or the Nth byte
  260. '    from the end of stringB if intA is negatine (-N).
  261. ' 3. If past either the begining or end of stringB then return 0
  262. '    (or occurrence count if intB is 0)
  263. ' 4. Compare stringA with the substring at the current position in stringB.
  264. '    The length of substring will be either the length of stringA or the
  265. '    remainder of stringB, whichever is shorter.
  266. ' 5. If a given releationship is true and if this was the Nth successful
  267. '    try (specified by intB=N) then return the current scan position.
  268. ' 6. If the relation was not satisfied then bump the scan position
  269. '    (possibly backwards if intA is negative) and go to step 3 and try again.
  270. '
  271. ' Relationship Operators:
  272. '
  273. ' "="   -   Equal To
  274. ' "<"   -   Less Than
  275. ' ">"   -   Greater Than
  276. ' "<="  -   Less Than Or Equal To
  277. ' ">="  -   Greater Than Or Equal To
  278. ' "<>"  -   Not Equal To
  279. ' ":"   -   Equal to Any
  280. ' "^"   -   Not Equal To Any
  281. '
  282. FUNCTION BB_POS(MatchStr,ScanStr,Relate,IncVal,OccurVal)
  283.  
  284.   LOCAL LenMatchStr,LenScanStr,ScanPos,OccurCnt,Item,StartVal,EndVal
  285.   IF Relate = undef THEN Relate = "="
  286.   IF IncVal = undef  THEN IncVal = 1
  287.   IF OccurVal = undef  THEN OccurVal = 1
  288.   LenMatchStr = LEN(MatchStr)
  289.   IF INSTR(":^", Relate) THEN LenMatchStr = 1
  290.   LenScanStr = LEN(ScanStr)
  291.   IF LenMatchStr = 0 OR LenScanStr = 0 OR OccurVal < 0 THEN
  292.     BB_POS = 0
  293.     EXIT FUNCTION
  294.   END IF
  295.   IF IncVal > 0 THEN
  296.     StartVal = 1
  297.     EndVal = LenScanStr
  298.   ELSE
  299.     StartVal = LenScanStr
  300.     EndVal = 1
  301.   END IF
  302.   FOR ScanPos = StartVal TO EndVal STEP IncVal
  303.     Item = MID(ScanStr, ScanPos, LenMatchStr)
  304.     IF Relate = "=" THEN
  305.       IF MatchStr = Item THEN OccurCnt += 1
  306.     ELSE IF Relate = "<" THEN
  307.       IF MatchStr < Item THEN OccurCnt += 1
  308.     ELSE IF Relate = ">" THEN
  309.       IF MatchStr > Item THEN OccurCnt += 1
  310.     ELSE IF Relate = "<=" OR Relate = "=<" THEN
  311.       IF MatchStr <= Item THEN OccurCnt += 1
  312.     ELSE IF Relate = ">=" OR Relate = "=>" THEN
  313.       IF MatchStr >= Item THEN OccurCnt += 1
  314.     ELSE IF Relate = "<>" OR Relate = "><" THEN
  315.       IF MatchStr <> Item THEN OccurCnt += 1
  316.     ELSE IF Relate = ":" THEN
  317.       IF INSTR(MatchStr, Item) THEN OccurCnt += 1
  318.     ELSE IF Relate = "^" THEN
  319.       IF NOT ISNUMERIC(INSTR(MatchStr, Item)) THEN OccurCnt += 1
  320.     ELSE
  321.       BB_POS = 0
  322.       EXIT FUNCTION
  323.     END IF
  324.     IF OccurVal > 0 THEN
  325.       IF OccurCnt = OccurVal THEN GOTO Done
  326.     END IF
  327.   NEXT ScanPos
  328.  
  329.   Done:
  330.  
  331.   IF OccurVal = 0 THEN
  332.     BB_POS = OccurCnt
  333.   ELSE IF OccurCnt THEN
  334.     BB_POS = ScanPos
  335.   ELSE
  336.     BB_POS = 0  
  337.   END IF
  338.  
  339. END FUNCTION
  340.  

bbtest.sb
Code: Script BASIC
  1. ' bb.inc test script
  2.  
  3. IMPORT bb.inc
  4.  
  5.  
  6. PRINT "HTA()\n"
  7. hta = BB_HTA("Script BASIC")
  8. PRINT hta,"\n\n"
  9. PRINT "ATH()\n"
  10. PRINT BB_ATH(hta),"\n\n"
  11. PRINT "PAD()\n"
  12. s = BB_PAD("BASIC",10,2," ")
  13. PRINT "|" & s & "|\n\n"
  14. PRINT "POS()\n"
  15. s = "The quick brown fox"
  16. ' yields 5
  17. PRINT BB_POS("q",s,"="),"\n"
  18. ' yields 0
  19. PRINT BB_POS("z",s,"="),"\n"
  20. ' yields 13
  21. PRINT BB_POS("o",s,"=") ,"\n"
  22. ' yields 18 - Scan from end (fox)
  23. PRINT BB_POS("o",s,"=",-1),"\n"
  24. ' yields 18 - Second occurrence (fox)
  25. PRINT BB_POS("o",s,"=",1,2),"\n"
  26. ' yields 13 - Checks every 2nd position
  27. PRINT BB_POS("o",s,"=",2),"\n"
  28. ' yields 6 - "u" is first char. > "r"
  29. PRINT BB_POS("r",s,"<"),"\n"
  30. PRINT "CVS()\n"
  31. s = "  sb  "
  32. PRINT "|" & BB_CVS(s,3," "),"|\n"
  33. PRINT "|" & BB_CVS(s,4,""),"|\n\n"
  34.  

Output

jrs@laptop:~/sb/sb22/PHB$ time scriba bbtest.sb
HTA()
536372697074204241534943

ATH()
Script BASIC

PAD()
|  BASIC  |

POS()
5
0
13
18
18
13
6
CVS()
|sb|
|  SB  |


real   0m0.026s
user   0m0.022s
sys   0m0.004s
jrs@laptop:~/sb/sb22/PHB$


19
MY-BASIC / MY-BASIC Extension Module
« on: April 24, 2015, 09:35:40 PM »
Here is an example of the new MY-BASIC extension module for Script BASIC. Attached is the Windows 32 bit and Linux (Ubuntu) 64 bit shared objects. (dll/so)

interface.c
Code: C
  1. // MY-BASIC - Script BASIC extension module
  2.  
  3. #include <stdio.h>
  4. #include <stdlib.h>
  5. #include <string.h>
  6. #include <stdarg.h>
  7. #include <ctype.h>
  8. #include <math.h>
  9. #include <time.h>
  10. #include "../../basext.h"
  11. #include "cbasic.h"
  12.  
  13. #include "my_basic.h"
  14.  
  15.  
  16. /****************************
  17.  Extension Module Functions
  18. ****************************/
  19.  
  20. besVERSION_NEGOTIATE
  21.   RETURN_FUNCTION((int)INTERFACE_VERSION);
  22. besEND
  23.  
  24. besSUB_START
  25.   DIM AS long PTR p;
  26.   besMODULEPOINTER = besALLOC(sizeof(long));
  27.   IF (besMODULEPOINTER EQ NULL) THEN_DO RETURN_FUNCTION(0);
  28.   p = (long PTR)besMODULEPOINTER;
  29.   RETURN_FUNCTION(0);
  30. besEND
  31.  
  32. besSUB_FINISH
  33.   DIM AS long PTR p;
  34.   p = (long PTR)besMODULEPOINTER;
  35.   IF (p EQ NULL) THEN_DO RETURN_FUNCTION(0);
  36.   RETURN_FUNCTION(0);
  37. besEND
  38.  
  39.  
  40. /********************
  41.  MY-BASIC Functions
  42. ********************/
  43.  
  44. static struct mb_interpreter_t* bas = 0;
  45.  
  46. static int watch(struct mb_interpreter_t* s, void** l) {
  47.   int result = MB_FUNC_OK;
  48.   int_t arg = 0;
  49.   mb_assert(s && l);
  50.   mb_check(mb_attempt_open_bracket(s, l));
  51.   mb_check(mb_pop_int(s, l, &arg)); // That's it!
  52.   mb_check(mb_attempt_close_bracket(s, l));
  53.   // arg is what you want.
  54.   return result;
  55. }
  56.  
  57. besFUNCTION(mbas_init)
  58.   besRETURN_LONG(mb_init());
  59. besEND
  60.  
  61. besFUNCTION(mbas_dispose)
  62.   besRETURN_LONG(mb_dispose());
  63. besEND
  64.  
  65. besFUNCTION(mbas_open)
  66.   besRETURN_LONG(mb_open(AT bas));
  67. besEND
  68.  
  69. besFUNCTION(mbas_close)
  70.   besRETURN_LONG(mb_close(AT bas));
  71. besEND
  72.  
  73. besFUNCTION(mbas_load_str)
  74.   DIM AS const char PTR pgm;
  75.   besARGUMENTS("z")
  76.     AT pgm
  77.   besARGEND
  78.   besRETURN_LONG(mb_load_string(bas, pgm));
  79. besEND
  80.  
  81. besFUNCTION(mbas_load_file)
  82.   DIM AS const char PTR pgm;
  83.   besARGUMENTS("z")
  84.     AT pgm
  85.   besARGEND
  86.   besRETURN_LONG(mb_load_file(bas, pgm));
  87. besEND
  88.  
  89. besFUNCTION(mbas_run)
  90.   besRETURN_LONG(mb_run(bas));
  91. besEND
  92.  
  93. besFUNCTION(mbas_reset)
  94.   besRETURN_LONG(mb_reset(bas, false));
  95. besEND
  96.  
  97. besFUNCTION(mbas_getint)
  98.   DIM AS mb_value_t mbval;
  99.   DIM AS const char PTR varname;
  100.   besARGUMENTS("z")
  101.     AT varname
  102.   besARGEND
  103.   mbval.type = MB_DT_INT;
  104.   mb_debug_get(bas, varname, &mbval);
  105.   besRETURN_LONG(mbval.value.integer);
  106. besEND
  107.  
  108. besFUNCTION(mbas_getdbl)
  109.   DIM AS mb_value_t mbval;
  110.   DIM AS const char PTR varname;
  111.   besARGUMENTS("z")
  112.     AT varname
  113.   besARGEND
  114.   mbval.type = MB_DT_REAL;
  115.   mb_debug_get(bas, varname, &mbval);
  116.   besRETURN_DOUBLE(mbval.value.float_point);
  117. besEND
  118.  
  119. besFUNCTION(mbas_getstr)
  120.   DIM AS mb_value_t mbval;
  121.   DIM AS const char PTR varname;
  122.   besARGUMENTS("z")
  123.     AT varname
  124.   besARGEND
  125.   mbval.type = MB_DT_STRING;
  126.   mb_debug_get(bas, varname, &mbval);
  127.   besRETURN_STRING(mbval.value.string);
  128. besEND
  129.  
  130. besFUNCTION(mbas_setint)
  131.   DIM AS VARIABLE Argument;
  132.   DIM AS mb_value_t mbval;
  133.   DIM AS int usrval, i, rtnval;
  134.   DIM AS const char PTR varname;
  135.   IF (besARGNR < 2) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS);
  136.   DEF_FOR (i = 1 TO i <= 2 STEP INCR i)
  137.   BEGIN_FOR
  138.     Argument = besARGUMENT(i);
  139.     besDEREFERENCE(Argument);
  140.     IF (i EQ 1) THEN_DO varname = STRINGVALUE(Argument);
  141.     IF (i EQ 2) THEN_DO usrval = LONGVALUE(Argument);
  142.   NEXT
  143.   mbval.type = MB_DT_INT;
  144.   mbval.value.integer = usrval;
  145.   rtnval = mb_debug_set(bas, varname, mbval);
  146.   besRETURN_LONG(rtnval);
  147. besEND
  148.  
  149. besFUNCTION(mbas_setdbl)
  150.   DIM AS VARIABLE Argument;
  151.   DIM AS mb_value_t mbval;
  152.   DIM AS int i, rtnval;
  153.   DIM AS double usrval;
  154.   DIM AS const char PTR varname;
  155.   IF (besARGNR < 2) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS);
  156.   DEF_FOR (i = 1 TO i <= 2 STEP INCR i)
  157.   BEGIN_FOR
  158.     Argument = besARGUMENT(i);
  159.     besDEREFERENCE(Argument);
  160.     IF (i EQ 1) THEN_DO varname = STRINGVALUE(Argument);
  161.     IF (i EQ 2) THEN_DO usrval = DOUBLEVALUE(Argument);
  162.   NEXT
  163.   mbval.type = MB_DT_REAL;
  164.   mbval.value.float_point = usrval;
  165.   rtnval = mb_debug_set(bas, varname, mbval);
  166.   besRETURN_LONG(rtnval);
  167. besEND
  168.  
  169. besFUNCTION(mbas_setstr)
  170.   DIM AS VARIABLE Argument;
  171.   DIM AS mb_value_t mbval;
  172.   DIM AS int i, rtnval;
  173.   DIM AS const char PTR varname;
  174.   DIM AS const char PTR usrval;
  175.   IF (besARGNR < 2) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS);
  176.   DEF_FOR (i = 1 TO i <= 2 STEP INCR i)
  177.   BEGIN_FOR
  178.     Argument = besARGUMENT(i);
  179.     besDEREFERENCE(Argument);
  180.     IF (i EQ 1) THEN_DO varname = STRINGVALUE(Argument);
  181.     IF (i EQ 2) THEN_DO usrval = STRINGVALUE(Argument);
  182.   NEXT
  183.   mbval.type = MB_DT_STRING;
  184.   usrval = mb_memdup(usrval, strlen(usrval) + 1);
  185.   mbval.value.string = usrval;
  186.   besRETURN_LONG(mb_debug_set(bas, varname, mbval));
  187. besEND
  188.  

mbvars.sb
Code: Script BASIC
  1. DECLARE SUB mb_init ALIAS "mbas_init" LIB "mb"
  2. DECLARE SUB mb_dispose ALIAS "mbas_dispose" LIB "mb"
  3. DECLARE SUB mb_open ALIAS "mbas_open" LIB "mb"
  4. DECLARE SUB mb_close ALIAS "mbas_close" LIB "mb"
  5. DECLARE SUB mb_load_str ALIAS "mbas_load_str" LIB "mb"
  6. DECLARE SUB mb_load_file ALIAS "mbas_load_file" LIB "mb"
  7. DECLARE SUB mb_run ALIAS "mbas_run" LIB "mb"
  8. DECLARE SUB mb_getint ALIAS "mbas_getint" LIB "mb"
  9. DECLARE SUB mb_getdbl ALIAS "mbas_getdbl" LIB "mb"
  10. DECLARE SUB mb_getstr ALIAS "mbas_getstr" LIB "mb"
  11. DECLARE SUB mb_setint ALIAS "mbas_setint" LIB "mb"
  12. DECLARE SUB mb_setdbl ALIAS "mbas_setdbl" LIB "mb"
  13. DECLARE SUB mb_setstr ALIAS "mbas_setstr" LIB "mb"
  14. DECLARE SUB mb_reset ALIAS "mbas_reset" LIB "mb"
  15.  
  16. mb_init
  17. mb_open
  18. mb_load_file "setvars.bas"
  19. mb_run
  20. mb_setint "A", 123
  21. mb_setdbl "B", 1.23
  22. mb_setstr "C$", "One,Two,Three"
  23. PRINT mb_getint("A"),"\n"
  24. PRINT FORMAT("%g\n", mb_getdbl("B"))
  25. PRINT mb_getstr("C$"),"\n"
  26. mb_close
  27. mb_dispose
  28.  

setvars.bas
Code: [Select]
a = 0
b = 0.0
c$ = ""

Output - Linux 64 bit

jrs@laptop:~/sb/sb22/mybasic$ time scriba mbvars.sb
123
1.23
One,Two,Three

real   0m0.006s
user   0m0.005s
sys   0m0.005s
jrs@laptop:~/sb/sb22/mybasic$


Output - Windows 32 bit

C:\sb22\mybasic>scriba mbvars.sb
123
1.23
One,Two,Three

C:\sb22\mybasic>


20
What's New / Perl Extension Module
« on: April 08, 2015, 09:07:07 AM »
I'm done with the Perl extension module in its current form. I see no purpose going through all the work of calling Perl functions from C directly and having to do all the crazy low level stack stuff. The Perl Eval function does everything I need at the moment and works like the TinyScheme extension module.

Code: Script BASIC
  1. DECLARE SUB pl_Init ALIAS "pl_Init" LIB "sbperl"
  2. DECLARE SUB pl_Eval ALIAS "pl_Eval" LIB "sbperl"
  3. DECLARE SUB pl_GetInt ALIAS "pl_GetInt" LIB "sbperl"
  4. DECLARE SUB pl_GetDbl ALIAS "pl_GetDbl" LIB "sbperl"
  5. DECLARE SUB pl_GetStr ALIAS "pl_GetStr" LIB "sbperl"
  6. DECLARE SUB pl_Destroy ALIAS "pl_Destroy" LIB "sbperl"
  7.  
  8. pl_Init
  9.  
  10. pl_code = """
  11. sub Average{
  12.   # get total number of arguments passed.
  13.   $n = scalar(@_);
  14.   $sum = 0;
  15.  
  16.   foreach $item (@_){
  17.      $sum += $item;
  18.   }
  19.   $average = $sum / $n;
  20.  
  21.   return $average;
  22. }
  23. """
  24. pl_Eval pl_code
  25. pl_Eval "$num = Average(10, 20, 30);"
  26. PRINT pl_GetInt("num"),"\n"
  27.  
  28. pl_Destroy
  29.  


jrs@laptop:~/sb/sb22/test$ scriba perlfunc.sb
20
jrs@laptop:~/sb/sb22/test$


21
What's New / Array Sort
« on: March 29, 2015, 09:59:07 PM »
One feature I have always wanted to add to Script BASIC was an array sort function. My first thought was to add the function to the existing T (Tools) extension module. This extension module already contains a wealth of string / array functions written in C. I took a peek at the C qsort function and the source to the GNU sort command line utility.

I decided on prototyping the array sort routine in Script BASIC first before committing to a direction. As it turns out my merge sort effort satisfies my immediate requirements for an array sort function and I added it to the T include.

Note: Duplicates are returned in the result array as one instance.

(T)ools Include File
Code: Script BASIC
  1. MODULE T                                                                        
  2.                                                                                  
  3. DECLARE SUB     ::md5              ALIAS "md5fun"         LIB "t"                
  4. DECLARE COMMAND ::ArrayToString    ALIAS "serialize"      LIB "t"                
  5. DECLARE COMMAND ::ArrayToXML       ALIAS "xmlserialize"   LIB "t"                
  6. DECLARE SUB     ::StringToArray    ALIAS "unserialize"    LIB "t"                
  7. DECLARE COMMAND ::Array2String     ALIAS "serialize"      LIB "t"                
  8. DECLARE COMMAND ::Array2XML        ALIAS "xmlserialize"   LIB "t"                
  9. DECLARE SUB     ::String2Array     ALIAS "unserialize"    LIB "t"                
  10. DECLARE COMMAND ::ArrayToStringMD5 ALIAS "md5serialize"   LIB "t"                
  11. DECLARE SUB     ::StringToArrayMD5 ALIAS "md5unserialize" LIB "t"                
  12. DECLARE COMMAND ::Array2StringMD5  ALIAS "md5serialize"   LIB "t"                
  13. DECLARE SUB     ::String2ArrayMD5  ALIAS "md5unserialize" LIB "t"                
  14. DECLARE SUB     ::SaveString       ALIAS "savestring"     LIB "t"                
  15. DECLARE SUB     ::LoadString       ALIAS "loadstring"     LIB "t"                
  16. DECLARE SUB     ::Exit             ALIAS "toolExit"       LIB "t"                
  17.                                                                                  
  18. SUB merge(left_side, right_side, result)                                        
  19.   LOCAL left_size, left_ptr, right_size, right_ptr, result_ptr                  
  20.   left_size = UBOUND(left_side)                                                  
  21.   left_ptr = 0                                                                  
  22.   right_size = UBOUND(right_side)                                                
  23.   right_ptr = 0                                                                  
  24.   result_ptr = 0                                                                
  25.   WHILE left_ptr <= left_size AND right_ptr <= right_size                        
  26.     IF left_side[left_ptr] <= right_side[right_ptr] THEN                        
  27.       result[result_ptr] = left_side[left_ptr]                                  
  28.       left_ptr += 1                                                              
  29.       result_ptr += 1                                                            
  30.     ELSE                                                                        
  31.       result[result_ptr] = right_side[right_ptr]                                
  32.       right_ptr += 1                                                            
  33.       result_ptr += 1                                                            
  34.     END IF                                                                      
  35.   WEND                                                                          
  36.   WHILE left_ptr <= left_size                                                    
  37.     result[result_ptr] = left_side[left_ptr]                                    
  38.     left_ptr += 1                                                                
  39.     result_ptr += 1                                                              
  40.   WEND                                                                          
  41.   WHILE right_ptr <= right_size                                                  
  42.     result[result_ptr] = right_side[right_ptr]                                  
  43.     right_ptr += 1                                                              
  44.     result_ptr += 1                                                              
  45.   WEND                                                                          
  46. END SUB                                                                          
  47.                                                                                  
  48. SUB sort(unsorted)                                                              
  49.   LOCAL left_side, right_side, the_middle, array_size, result, x, y, z          
  50.   array_size = UBOUND(unsorted)                                                  
  51.   IF array_size = 0 THEN                                                        
  52.     EXIT SUB                                                                
  53.   END IF                                                                        
  54.   the_middle = FIX((array_size + 1) / 2)                                        
  55.   y = 0                                                                          
  56.   FOR x = 0 TO the_middle - 1                                                    
  57.     left_side[y] = unsorted[x]                                                  
  58.     y += 1                                                                      
  59.   NEXT                                                                          
  60.   z = 0                                                                          
  61.   FOR x = the_middle TO array_size                                              
  62.     right_side[z] = unsorted[x]                                                  
  63.     z += 1                                                                      
  64.   NEXT                                                                          
  65.   sort(left_side)                                                                
  66.   sort(right_side)                                                              
  67.   merge(left_side, right_side, result)                                          
  68.   unsorted = result                                                              
  69. END SUB                                                                          
  70.                                                                                  
  71. END MODULE                                                                      
  72.  

Example Use
Code: Script BASIC
  1. ' Script BASIC Array Sort
  2.  
  3. IMPORT t.bas
  4.  
  5. s = "pear,cranberry,orange,apple,carrot,banana,grape"
  6. SPLITA s BY "," TO a
  7.  
  8. t::sort(a)
  9.  
  10. FOR x = 0 TO UBOUND(a)
  11.   PRINT a[x],"\n"
  12. NEXT
  13.  

Output

jrs@laptop:~/sb/sb22/test$ time scriba sort.sb
apple
banana
carrot
cranberry
grape
orange
pear

real   0m0.008s
user   0m0.007s
sys   0m0.000s
jrs@laptop:~/sb/sb22/test$


As a stress test, I thought I would sort each line in a text version of the Bible. (30383 lines / 4,047,392 bytes)

Code: Script BASIC
  1. ' Script BASIC Array Sort
  2.  
  3. IMPORT t.bas
  4.  
  5. OPEN "bible.txt" FOR INPUT AS #1
  6. s = INPUT(LOF(1),1)
  7. SPLITA s BY "\n" TO a
  8.  
  9. t::sort(a)
  10.  
  11. FOR x = UBOUND(a) - 10 TO UBOUND(a)
  12.   PRINT a[x],"\n"
  13. NEXT
  14.  

Output
Code: [Select]
jrs@laptop:~/sb/sb22/test$ time scriba sort.sb
Zebulun and Naphtali were a people that jeoparded their lives unto the death in the high places of the field.
Zebulun shall dwell at the haven of the sea; and he shall be for an haven of ships; and his border shall be unto Zidon.
Zedekiah was one and twenty years old when he began to reign, and he reigned eleven years in Jerusalem. And his mother's name was Hamutal the daughter of Jeremiah of Libnah.
Zedekiah was one and twenty years old when he began to reign, and reigned eleven years in Jerusalem.
Zelek the Ammonite, Naharai the Berothite, the armourbearer of Joab the son of Zeruiah,
Zelek the Ammonite, Nahari the Beerothite, armourbearer to Joab the son of Zeruiah,
Zenan, and Hadashah, and Migdalgad,
Zion heard, and was glad; and the daughters of Judah rejoiced because of thy judgments, O LORD.
Zion shall be redeemed with judgment, and her converts with righteousness.
Zion spreadeth forth her hands, and there is none to comfort her: the LORD hath commanded concerning Jacob, that his adversaries should be round about him: Jerusalem is as a menstruous woman among them.
Ziph, and Telem, and Bealoth,

real 0m13.069s
user 0m12.173s
sys 0m0.810s
jrs@laptop:~/sb/sb22/test$

The array sort routine also works with associative arrays and isn't restricted to a single indies array.

Code: Script BASIC
  1. ' Script BASIC Array Sort
  2.  
  3. IMPORT t.bas
  4.  
  5. s = "pear,apple,cranberry,orange,carrot,banana,grape"
  6. SPLITA s BY "," TO a{"food"}
  7.  
  8. t::sort(a{"food"})
  9.  
  10. FOR x = 0 TO UBOUND(a{"food"})
  11.   PRINT a{"food"}[x],"\n"
  12. NEXT  
  13.  


jrs@laptop:~/sb/sb22/test$ scriba arraysort.sb
apple
banana
carrot
cranberry
grape
orange
pear
jrs@laptop:~/sb/sb22/test$


22
Documentation / MININT
« on: November 27, 2014, 05:56:08 PM »
The documentation I recently posted for Script BASIC flushed out a command I was unaware of.

Quote
MININT

This built-in constant is implemented as an argument less function. Returns the minimal ("maximal negative") number that can be stored as an integer value.

Code: Script BASIC
  1. PRINT MININT,"\n"
  2.  

Output from my Ubuntu 14.04 LTS 64 bit laptop.

jrs@laptop:~/sb/sb22/test$ scriba minint.sb
-9223372036854775808
jrs@laptop:~/sb/sb22/test$


23
Documentation / Script BASIC Commands & Functions Reference
« on: November 27, 2014, 03:54:05 PM »
Script BASIC Commands & Functions Reference


24
What's New / CSV Line Formatting Function
« on: November 10, 2014, 12:27:42 PM »
This Script BASIC function makes it easy to quickly format raw CSV (comma-separated values) files that has been a standard way of normalizing data for export / import. While searching for sample CSV data to play with I came across a site that posted the Sacramento crime log for January 1st, 2006 (24 hour period)

FYI: You can use either of the numeric formatting masks Script BASIC offers (BASIC or C style) and if you leave out the format info for a column, it will be ignored. This function will be added to the T.bas (Tools) extension module include file for the 2.2 release.



Code: Script BASIC
  1. ' result = FormatLine(in_str, fmt_str, quo_char, num_spc) Note: num_spc = -1 uses TAB
  2.  
  3. FUNCTION FormatLine(ln,fmtstr,qc,nsp)
  4.   SPLITAQ ln BY "," QUOTE qc TO col
  5.   SPLITA fmtstr BY "|" TO fmtcmd
  6.   rs = ""
  7.   FOR x = 0 to UBOUND(col)
  8.     SPLITA fmtcmd[x] BY ":" TO fmt
  9.     IF fmt[0] = "L" THEN
  10.       tmp = LEFT(col[x] & STRING(fmt[1]," "),fmt[1])
  11.       GOSUB Margin
  12.     ELSE IF fmt[0] = "R" THEN
  13.       IF fmt[2] <> undef THEN
  14.         tmp = FORMAT(fmt[2],col[x])
  15.       ELSE
  16.         tmp = col[x]
  17.       END IF
  18.       tmp = RIGHT(STRING(fmt[1]," ") & tmp, fmt[1])
  19.       GOSUB Margin
  20.     ELSE IF fmt[0] = "C" THEN
  21.       pad = fmt[1] - LEN(col[x])
  22.       pboth = pad \ 2
  23.       prt = pad % 2
  24.       tmp = STRING(pboth," ") & col[x] & STRING(pboth," ") & STRING(prt," ")
  25.       GOSUB Margin
  26.     END IF
  27.   NEXT
  28.   GOTO Done
  29.  
  30.   Margin:
  31.   IF nsp = -1 THEN
  32.     tmp &= "\t"
  33.   ELSE
  34.     tmp &= STRING(nsp," ")
  35.   END IF
  36.   rs &= tmp  
  37.   RETURN
  38.  
  39.   Done:
  40.   FormatLine = rs
  41. END FUNCTION
  42.  
  43. OPEN "SacramentocrimeJanuary2006.csv" FOR INPUT AS #1
  44. OPEN "sac.fmt" FOR OUTPUT AS #2
  45. fmtstr = "L:15|L:30|R:4|L:4|R:6|L:35|L:6|R:10:%~-##0.0000~|R:10:%~-##0.0000~"
  46. LINE INPUT #1, hdr
  47. WHILE NOT EOF(1)
  48.   LINE INPUT #1, csvln
  49.   csvln = CHOMP(csvln)
  50.   PRINT #2, FormatLine(csvln,fmtstr,"",2),"\n"
  51. WEND  
  52.  
  53. CLOSE(1)
  54. CLOSE(2)
  55.  

Output (7584 rows)

jrs@laptop:~/sb/sb22/test$ time scriba fmtline.sb

real   0m0.454s
user   0m0.415s
sys    0m0.036s
jrs@laptop:~/sb/sb22/test$

Code: [Select]
1/1/06 0:00      3108 OCCIDENTAL DR                 3  3C      1115  10851(A)VC TAKE VEH W/O OWNER        2404       38.5504   -121.3914 
1/1/06 0:00      2082 EXPEDITION WAY                5  5A      1512  459 PC  BURGLARY RESIDENCE           2204       38.4735   -121.4902 
1/1/06 0:00      4 PALEN CT                         2  2A       212  10851(A)VC TAKE VEH W/O OWNER        2404       38.6578   -121.4621 
1/1/06 0:00      22 BECKFORD CT                     6  6C      1443  476 PC PASS FICTICIOUS CHECK         2501       38.5068   -121.4270 
1/1/06 0:00      3421 AUBURN BLVD                   2  2A       508  459 PC  BURGLARY-UNSPECIFIED         2299       38.6374   -121.3846 

25
DLLC / Script BASIC Virtual DLL
« on: November 03, 2014, 08:00:23 PM »
Viirtual DLL is what I call the DLLC OxygenBasic JIT function(s). Below is an example of calling an ASM string reverse function, a word parsing function and a column align function in O2 BASIC from Script BASIC as an extension module IMPORT.

testo2.sb
Code: Script BASIC
  1. IMPORT O2.inc
  2.  
  3. FOR x = 65 TO 90
  4.   alpha &= CHR(x)
  5. NEXT
  6. PRINT alpha,"\n"
  7. PRINT O2::RevStr(alpha),"\n"
  8. p = 1
  9. Next_Word:
  10.   wd = O2::GetWords("abc(d[xx]+7/6,\"qwerty\")", p)
  11.   IF wd <> "" THEN
  12.     PRINT wd,"\n"
  13.     GOTO Next_Word
  14.   END IF
  15. q = """
  16. Given;;a;;text;;file;;of;;many;;lines,;;where;;fields;;within;;a;;line;;
  17. are;;delineated;;by;;a;;single;;'dollar';;character,;;write;;a;;program
  18. that;;aligns;;each;;column;;of;;fields;;by;;ensuring;;that;;words;;in;;each;;
  19. column;;are;;separated;;by;;at;;least;;one;;space.
  20. Further,;;allow;;for;;each;;word;;in;;a;;column;;to;;be;;either;;left;;
  21. justified,;;right;;justified,;;or;;center;;justified;;within;;its;;column.
  22. """
  23. PRINT O2::ColumnAlign(q, "LLLLCCCRRRRR", ";;", "\n")
  24.  
  25. O2::Done()
  26.  

O2.inc
Code: Script BASIC
  1. MODULE O2
  2.  
  3. include "dllcinc.sb"
  4.  
  5. oxy=dllfile("/scriptbasic/Debugger/modules/oxygen.dll")
  6.  
  7. o2_basic = dllproc( oxy, "o2_basic i =(c*source) " )
  8. o2_exec  = dllproc( oxy, "o2_exec  i =(i call)   " )
  9. o2_error = dllproc( oxy, "o2_error c*=()         " )
  10. o2_errno = dllproc( oxy, "o2_errno i =()         " )
  11. o2_len   = dllproc( oxy, "o2_len   i =()         " )
  12. o2_mode  = dllproc( oxy, "o2_mode     (i mode)   " )
  13.  
  14. dllcall o2_mode,1
  15.  
  16. OPEN "/scriptbasic/Debugger/include/O2.src" FOR INPUT AS #1
  17. src = INPUT(LOF(1), 1)
  18. CLOSE(1)
  19.  
  20. a = oxygen(src)
  21. Finish  = dllproc(a,"Finish ()", dllcald(a,0))
  22. Reverse = dllproc(a,"Reverse (c*value)", dllcald(a,1))
  23. Words   = dllproc(a,"getword c* = (c* strraw, i* start)", dllcald(a,2))
  24. ColAlign   = dllproc(a,"AlignText c* = (c* in, c* ju, C* dl, c* cr)", dllcald(a,3))
  25.  
  26. FUNCTION oxygen(src)
  27.   dllcall o2_basic,src
  28.   IF (dllcall(o2_errno)<> 0) THEN
  29.     dllprnt dllcall(o2_error)
  30.     a = 0
  31.   ELSE
  32.     a = dllcall(o2_exec,0)
  33.   END IF
  34.   oxygen = a
  35. END FUNCTION
  36.  
  37. FUNCTION Done
  38.   rtnval = dllcall(Finish)
  39.   dllfile
  40.   Done = rtnval
  41. END FUNCTION
  42.  
  43. ' SB wrapper functions
  44.  
  45. FUNCTION RevStr(strarg)
  46.   dllcall(Reverse, strarg)
  47.   RevStr = strarg
  48. END FUNCTION
  49.  
  50. FUNCTION GetWords(strarg, longarg)
  51.   GetWords = dllcall(Words, strarg, longarg)
  52. END FUNCTION
  53.  
  54. FUNCTION ColumnAlign(in_str, just_str, dlm_str, eol_str)
  55.   ColumnAlign = dllcall(ColAlign, in_str, just_str, dlm_str, eol_str)
  56. END FUNCTION
  57.  
  58. END MODULE
  59.  

O2.src
Code: OxygenBasic
  1. ' O2 source
  2.  
  3. extern
  4.  
  5. function reverse(char*s)
  6. '=======================
  7.  addr ecx,s
  8.   mov edx,0
  9.  .rlen
  10.   mov al,[ecx]
  11.   cmp al,0
  12.   jz xlen
  13.   inc edx
  14.   inc ecx
  15.   jmp rlen
  16.  .xlen
  17.   ;
  18.   addr ecx,s
  19.   add  edx,ecx
  20.   dec ecx
  21.   ;
  22.  .rswap
  23.   inc ecx
  24.   dec edx
  25.   cmp edx,ecx
  26.   jle xswap
  27.   mov al,[ecx]
  28.   mov ah,[edx]
  29.   mov [ecx],ah
  30.   mov [edx],al
  31.   jmp rswap
  32.  .xswap
  33.   end function
  34.  
  35. function getword(char*ss,sys*b) as char*
  36. '=======================================
  37. if b=0 then b=1
  38. byte s at @ss
  39. byte c,d
  40. sys bb,bc
  41. static char z[128]
  42. a=0
  43. bb=b
  44.  
  45. 'SKIP LEADING SPACES
  46. do
  47.   c=s[b]
  48.   select c
  49.    case 33 to 255,0 : exit do 'SKIP SPACE
  50.  end select
  51.   b++
  52. end do
  53. bc=b
  54.  '
  55. 'QUOTES
  56. select c
  57.  case 34,39
  58.    do
  59.      b+=1
  60.      d=s[b]
  61.      if d=0 or d=c then b+=1 : jmp fwd done
  62.    end do
  63. end select
  64. 'WORDS AND SYMBOLS
  65. do
  66.   c=s[b]
  67.   select c
  68.   case 0 to 32    : exit do
  69.   case 35         : jmp fwd more
  70.   case 33 to 47   : 'symbols
  71.  case 48 to 57   : jmp fwd more 'numbers
  72.  case 58 to 64   : 'symbols
  73.  case 65 to 90   : jmp fwd more 'capitals
  74.  case 95         : jmp fwd more 'underscore
  75.  case 91 to 96   : 'symbols
  76.  case 97 to 122  : jmp fwd more 'lower case
  77.  case 123 to 127 : 'symbols
  78.  case 128 to 255 : jmp fwd more 'higher ascii
  79. end select
  80.  
  81. if b=bc then b++
  82.   exit do
  83.  
  84.   more:
  85.   b++
  86. end do
  87.  
  88. done:
  89.  
  90. if b > bb then
  91.   z=mid ss,bc,b-bc
  92. else
  93.   z = ""
  94. end if
  95. return z
  96.  
  97. end function
  98.  
  99. =================
  100. Class AlignedText
  101. =================
  102.  
  103. indexbase 1
  104.  
  105. string  buf, bufo, pr, cr, tab, jus, dlm
  106. sys     Cols, Rows, ColWidth[0x100], TotWidth, ColPad, ld
  107.  
  108. method SetText(char*s)
  109. ======================
  110. if not len cr then cr=chr(13,10)
  111. tab=chr(9)
  112. if not len jus then jus=string 200,"L"
  113. buf=s
  114. measure
  115. end method
  116.  
  117.  
  118. method measure()
  119. ================
  120. sys a, b, wa, wb, cm, c, cw
  121. a=1 : b=1
  122. Cols=0 : Rows=0 : ColPad=3
  123. ld=len dlm
  124. if not ld then dlm="," : ld=1 'default to comma
  125. do
  126.   wb=b
  127.   a=instr b,buf,cr
  128.   if a=0 then exit do
  129.   cm=0
  130.   c++
  131.   do
  132.     wa=instr wb,buf,dlm
  133.     if wa=0 or wa>a then exit do
  134.     cm++
  135.     if cm>cols then cols=cm
  136.     cw=wa-wb
  137.     if cw > ColWidth[cm] then ColWidth[cm]=cw
  138.     wb=wa+ld
  139.   end do
  140.   b=a+len cr
  141. end do
  142. rows=c
  143. '
  144. c=0
  145. for i=1 to cols
  146.   ColWidth[ i ]+=ColPad
  147.   c+=ColWidth[ i ]
  148. next
  149. TotWidth=c+len cr
  150. 'print ShowMetrics
  151. end method
  152.  
  153.  
  154. method ShowMetrics() as char*
  155. =============================
  156. pr="METRICS:" cr cr
  157. pr+=rows tab cols tab totwidth cr cr
  158. pr+="column" tab "spacing" cr
  159. for i=1 to cols
  160.   pr+=i tab ColWidth[ i ] cr
  161. next
  162. return pr
  163. end method
  164.  
  165.  
  166. method justify(char*j)
  167. ======================
  168. jus=j
  169. end method
  170.  
  171. method delimiter(char*j)
  172. ========================
  173. dlm=j
  174. end method
  175.  
  176. method endofline(char*j)
  177. ========================
  178. cr=j
  179. end method
  180.  
  181.  
  182. method layout() as char*
  183. ========================
  184. sys a, b, wa, wb, wl, cm, lpos, cpos
  185. bufo=space Rows*TotWidth
  186. a=1 : b=1
  187. do
  188.   wb=b
  189.   a=instr(b,buf,cr)
  190.   if a=0 then exit do
  191.   cm=0
  192.   cpos=1
  193.   do
  194.     wa=instr(wb,buf,dlm)
  195.     if wa=0 or wa>a then exit do
  196.     '
  197.    cm++
  198.     '
  199.    'JUSTIFICATION
  200.    '
  201.    wl=wa-wb
  202.     p=lpos+cpos 'default "L" LEFT ALIGN
  203.    '
  204.    select case asc(jus,cm)
  205.       case "R" : p=lpos+cpos+ColWidth[cm]-wl-Colpad
  206.       case "C" : p=lpos+cpos+( ColWidth[cm]-wl-Colpad )*.5
  207.     end select
  208.     '
  209.    mid bufo,p, mid buf,wb,wl
  210.     cpos+=colwidth[cm]
  211.     wb=wa+ld
  212.   end do
  213.   b=a+len cr
  214.   lpos+=TotWidth
  215.   if lpos<len(bufo) then mid bufo,lpos-1,cr
  216. end do
  217. return bufo
  218. end method
  219.  
  220. end class
  221.  
  222. '#recordof AlignedText
  223.  
  224. AlignedText atxt
  225.  
  226. function AlignText(char *in,*ju,*dl,*cr) as char*
  227. =================================================
  228. atxt.justify         ju
  229. atxt.delimiter       dl
  230. atxt.endofline       cr
  231. atxt.SetText         in
  232. return               atxt.layout
  233. end function
  234.  
  235. sub finish()
  236. '===========
  237.  terminate
  238. end sub
  239.  
  240. function link(sys n) as sys
  241. '==========================
  242.  select n
  243.   case 0 : return @finish
  244.   case 1 : return @reverse
  245.   case 2 : return @getword
  246.   case 3 : return @AlignText
  247.   end select
  248. end function
  249.  
  250. end extern
  251.  
  252. addr link
  253.  

Output

C:\scriptbasic\o2dev>scriba testo2.sb
ABCDEFGHIJKLMNOPQRSTUVWXYZ
ZYXWVUTSRQPONMLKJIHGFEDCBA
abc
(
d
[
xx
]
+
7
/
6
,
"qwerty"
)

  Given        a            text         file       of       many        lines,        where   fields   within        a   line
  are          delineated   by           a        single    'dollar'   character,      write        a
  that         aligns       each         column     of       fields        by       ensuring     that    words       in   each
  column       are          separated    by         at       least        one
  Further,     allow        for          each      word        in          a          column       to       be   either   left
  justified,   right        justified,   or       center   justified     within          its

C:\scriptbasic\o2dev>


26
General Discussions / VB2IUP
« on: October 12, 2014, 11:08:21 PM »
A member of the BaCon forum created a utility to convert Pencil .ep files to BaCon HUG assisted forms. I carried on with the idea but using VB6 IDE as the GUI builder and translating the .frm files to IUP for a cross platform GUI. Jose Roca from the PowerBASIC forum created this very helpful list of VB6 components.

I hope to have something to show soon.


There are three broad categories of controls in Visual Basic:

a) Intrinsic controls, such as the command button and frame controls. These controls are contained inside the Visual Basic .exe file.

b) ActiveX controls, which exist as separate files with a .ocx file name extension. These include controls that are available in all editions of Visual Basic (DataCombo, DataList controls, and so on) and those that are available only in the Professional and Enterprise editions (such as Listview, Toolbar, Animation, and Tabbed Dialog). Many third-party ActiveX controls are also available.

c) Insertable Objects, such as a Microsoft Excel Worksheet object containing a list of all your company's employees, or a Microsoft Project Calendar object containing the scheduling information for a project.

Intrinsic Controls

The following table summarizes the intrinsic controls found in the Visual Basic toolbox.

CheckBox Displays a True/False or Yes/No option. You can check any number of check boxes on a form at one time.

ComboBox Combines a text box with a list box. Allows a user to type in a selection or select an item from a drop-down list.

Command button CommandButton Carries out a command or action when a user chooses it.

Data Enables you to connect to an existing database and display information from it on your forms.

DirListBox Displays and allows a user to select directories and paths.

DriveListBox Displays and allows a user to select valid disk drives.

FileListBox Displays and allows a user to select from a list of files.

Frame Provides a visual and functional container for controls.

HScrollBar and VScrollBar Allow a user to add scroll bars to controls that do not automatically provide them. (These are not the same as the built-in scroll bars found with many controls.)

Image Displays bitmaps, icons, or Windows metafiles, JPEG, or GIF files; acts like a command button when clicked.

Label Displays text a user cannot interact with or modify.

Line Adds a straight-line segment to a form.

ListBox Displays a list of items that a user can choose from.

OLE container Embeds data into a Visual Basic application.

OptionButton The Option Button control, as part of an option group with other option buttons, displays multiple choices, from which a user can choose only one.

PictureBox Displays bitmaps, icons, or Windows metafiles, JPEG, or GIF files. It also displays text or acts as a visual container for other controls.

Shape Adds a rectangle, square, ellipse, or circle to a form, frame, or picture box.

TextBox Provides an area to enter or display text.

Timer Executes timer events at specified time intervals.

As they are contained inside the Visual Basic .exe file, and not in an OCX, they can only be used with VB6.


Standard ActiveX Controls

The Learning edition of Visual Basic contains a number of ActiveX controls (referred to as standard ActiveX controls) that allow you to add advanced features to your applications. ActiveX controls have the file name extension .ocx and can be used in your project by manually adding them to the toolbox.

The following table summarizes the standard ActiveX controls available in the Learning edition of Visual Basic.

ADO Data Control ADODC Creates a connection to a database using ADO. Assignable to the DataSource property of other controls such as the DataGrid.

Common dialog CommonDialog Provides a standard set of dialog boxes for operations such as opening and saving files, setting print options, and selecting colors and fonts.

DataCombo DataCombo Provides most of the features of the standard combo box control, plus increased data access capabilities.

DataGrid DataGrid A grid control that allows can be data-bound to a data source such as the ADO Data Control. Reading and editing the recordset is possible.

DataList DataList Provides most of the features of the standard list box control, plus increased data access capabilities.

Microsoft Hierarchical FlexGrid MSHFlexGrid A read-only grid control that can be bound the Data Environment designer to show hierarchical recordsets.

These can be used with PB, but except the Common Dialogs, require the use of a OLE Container to host them.


ActiveX Controls

ADO Data Control
The ADO Data Control is similar to the intrinsic Data control and the Remote Data Control (RDC). The ADO Data Control allows you to quickly create a connection to a database using Microsoft ActiveX Data Objects (ADO).

Animation Control
The Animation control allows you to create buttons which display animations, such as .avi files, when clicked. The control can play only AVI files that have no sound. In addition, the Animation control can display only uncompressed .avi files or .avi files that have been compressed using Run-Length Encoding (RLE).

CommonDialog Control
The CommonDialog control provides a standard set of dialog boxes for operations such as opening and saving files, setting print options, and selecting colors and fonts. The control also has the ability to display help by running the Windows Help engine.

CoolBar Control
A CoolBar control contains a collection of Band objects used to create a configurable toolbar that is associated with a form.

DataCombo Control
The DataCombo control is a data-bound combo box that is automatically populated from a field in an attached data source, and optionally updates a field in a related table of another data source.

DataGrid Control
Displays and enables data manipulation of a series of rows and columns representing records and fields from a Recordset object.

DataList Control
The DataList control is a data-bound list box that is automatically populated from a field in an attached data source, and optionally updates a field in a related table of another data source.

DataRepeater Control
The DataRepeater control functions as a scrollable container of data-bound user controls. Each control appears in its own row as a "repeated" control, allowing the user to view several data-bound user controls at once.

DateTimePicker Control
The DateTimePicker control enables you to provide a formatted date field that allows easy date selection. In addition, users can select a date from a dropdown calendar interface similar to the MonthView control.

DBCombo Control
The DBCombo control is a data bound combo box with a drop-down list box which is automatically populated from a field in an attached Data control, and optionally updates a field in a related table of another Data control. The text box portion of DBCombo can be used to edit the selected field.

DBList Control
he DBList control is a data bound list box which is automatically populated from a field in an attached Data control, and optionally updates a field in a related table of another Data control.

FlatScrollBar Control
The FlatScrollBar control is a mouse-sensitive version of the standard Windows scroll bar that offers two-dimensional formatting options. It can also replace the standard Windows three-dimensional scroll bar. The FlatScrollBar provides increased interactivity when using the scroll arrows and the scroll box.

ImageCombo Control
The ImageCombo control is a picture-enabled version of the standard Windows combo box. Each item in the list portion of the control can have a picture assigned to it.

ImageList Control
An ImageList control contains a collection of ListImage objects, each of which can be referred to by its index or key. The ImageList control is not meant to be used alone, but as a central repository to conveniently supply other controls with images.

ListView Control
The ListView control displays items using one of four different views. You can arrange items into columns with or without column headings as well as display accompanying icons and text.

MAPIMessages Control
The messaging application program interface (MAPI) controls allow you to create mail-enabled Visual Basic MAPI applications.

MAPISession Control
The messaging application program interface (MAPI) controls allow you to create mail-enabled Visual Basic MAPI applications.

Masked Edit Control
The Masked Edit control provides restricted data input as well as formatted data output. This control supplies visual cues about the type of data being entered or displayed.

Microsoft Internet Transfer Control
The Internet Transfer control provides implementation of two of the most widely used protocols on the Internet, HyperText Transfer Protocol (HTTP) and File Transfer Protocol (FTP).

MonthView Control
The MonthView control enables you to create applications that let users view and set date information via a calendar-like interface.

MSChart Control
A chart that graphically displays data.

MSComm Control
The MSComm control provides serial communications for your application by allowing the transmission and reception of data through a serial port.

MSFlexGrid Control
The Microsoft FlexGrid (MSFlexGrid) control displays and operates on tabular data. It allows complete flexibility to sort, merge, and format tables containing strings and pictures. When bound to a Data control, MSFlexGrid displays read-only data.

MSHFlexGrid Control
The Microsoft Hierarchical FlexGrid (MSHFlexGrid) control displays and operates on tabular data. It allows complete flexibility to sort, merge, and format tables containing strings and pictures. When bound to a data control, MSHFlexGrid displays read-only data.

Multimedia MCI Control
The Multimedia MCI control manages the recording and playback of multimedia files on Media Control Interface (MCI) devices. Conceptually, this control is a set of push buttons that issues MCI commands to devices such as audio boards, MIDI sequencers, CD-ROM drives, audio CD players, videodisc players, and videotape recorders and players. The MCI control also supports the playback of Video for Windows (*.avi) files.

PictureClip Control
The PictureClip control allows you to select an area of a source bitmap and then display the image of that area in a form or picture box. PictureClip controls are invisible at run time.

ProgressBar Control
The ProgressBar control shows the progress of a lengthy operation by filling a rectangle with chunks from left to right.

RemoteData Control
Provides access to data stored in a remote ODBC data source through bound controls. The RemoteData control enables you to move from row to row in a result set and to display and manipulate data from the rows in bound controls.

RichTextBox Control
The RichTextBox control allows the user to enter and edit text while also providing more advanced formatting features than the conventional TextBox control.

Slider Control
A Slider control is a window containing a slider and optional tick marks. You can move the slider by dragging it, clicking the mouse to either side of the slider, or using the keyboard.

SSTab Control
The SSTab control provides a group of tabs, each of which acts as a container for other controls. Only one tab is active in the control at a time, displaying the controls it contains to the user while hiding the controls in the other tabs.

StatusBar Control
A StatusBar control provides a window, usually at the bottom of a parent form, through which an application can display various kinds of status data. The StatusBar can be divided up into a maximum of sixteen Panel objects that are contained in a Panels collection.

SysInfo Control
The SysInfo control allows you to respond to certain system messages sent to all applications by the operating system. Your application can then adapt to changes in the operating system if necessary.

TabStrip Control
A TabStrip control is like the dividers in a notebook or the labels on a group of file folders. By using a TabStrip control, you can define multiple pages for the same area of a window or dialog box in your application.

Toolbar Control
A Toolbar control contains a collection of Button objects used to create a toolbar that is associated with an application.

TreeView Control
A TreeView control displays a hierarchical list of Node objects, each of which consists of a label and an optional bitmap. A TreeView is typically used to display the headings in a document, the entries in an index, the files and directories on a disk, or any other kind of information that might usefully be displayed as a hierarchy.

UpDown Control
An UpDown control has a pair of arrow buttons which the user can click to increment or decrement a value, such as a scroll position or a value in an associated control, known as a buddy control.

Winsock Control
The Winsock control, invisible to the user, provides easy access to TCP and UDP network services. It can be used by Microsoft Access, Visual Basic, Visual C++, or Visual FoxPro developers. To write client or server applications you do not need to understand the details of TCP or to call low level Winsock APIs. By setting properties and invoking methods of the control, you can easily connect to a remote machine and exchange data in both directions.


27
COM / SBVB
« on: October 09, 2014, 11:38:35 AM »
This thread will demonstrate using the Script BASIC COM interface with Visual BASIC and .NET forms as COM ActiveX controls.

      



   



Code: Script BASIC
  1. import com.inc
  2.  
  3. obj = CreateObject("VB6.Sample")
  4.  
  5. 'Sample function prototypes
  6. '       longTest(v As Long)
  7. '       intTest(v As Integer)
  8. '       ByteTest(v As Byte)
  9. '       GetString(prompt As String, title, def) As String
  10. '       ShowUI() As Long
  11.  
  12. if obj = 0 then
  13.         print "CreateObject failed!\n"
  14. else
  15.  
  16.     print "TypeName obj = ", TypeName(obj), "\n"
  17.  
  18.     CallByName(obj, "longTest", VbMethod, 20000)
  19.     CallByName(obj, "intTest", VbMethod, 1000)
  20.     CallByName(obj, "byteTest", VbMethod, 255)
  21.    
  22.     'this one fails silently because its invalid value for byte type..
  23.    CallByName(obj, "byteTest", VbMethod, 256)
  24.  
  25.     retVal = CallByName(obj, "GetString", VbMethod, "Enter some Text:", "my title", "default value!")
  26.     print "GetString returned: ", retVal, "\n"
  27.    
  28.     'do NOT release objects you dont own..
  29.    objForm = CallByName(obj, "LaunchUI")
  30.     print "objForm = ", objForm, "\n"
  31.    
  32.     for i=0 to 10
  33.         CallByName(objForm, "AddItem", VbMethod, "Hello from script basic! " & i)
  34.     next
  35.    
  36.     print "Waiting until user closes form to proceede..\n"
  37.     CallByName(obj, "BlockUntilFormCloses")
  38.    
  39.     sDate = CallByName(obj, "SelectDate")
  40.     if len(sDate) = 0 then
  41.         print "User pressed cancel for date selection\n"
  42.     else
  43.         print "Date: ", sDate, "\n"
  44.     end if
  45.    
  46.     ReleaseObject(obj)
  47.     print "anndddd were done!\n"
  48.    
  49. end if
  50.  

Console Output

C:\ScriptBasic_Control-master\engine\COM_Extension_DLL>scriba COM_VB6_Example.sb
TypeName obj = _Sample
GetString returned: Script BASIC talks to VB6.
objForm = 1417320
Waiting until user closes form to proceede..
Date: 9/10/2014
anndddd were done!

C:\ScriptBasic_Control-master\engine\COM_Extension_DLL>





28
COM / Script BASIC IDE/Debugger
« on: September 07, 2014, 09:38:19 PM »
David Zimmer (our COM/VB pro) embedded Script BASIC into VB6 to create an interactive IDE/Debugger for the project. (Windows 7 screenshot attached)




This project aims to create a VB6 usable ScriptBasic Engine.
along with a an integrated IDE + debugger.

Features include:

 VB6 access class to ScriptBasic Engine
   - AddObject
   - AddCode
   ? Eval

 IDE as VB6 ActiveX control
   - intellisense
   - syntax highlighting
   - integrated debugger
      - breakpoints
      - single step
      - step over
      - step out
      - variable inspection
      - call stack
      - variable modification
      - run to line
 
Status:
   - standalone debugger and vb usable script engine is complete.
      switching over to dll/ocx control will be completed next time I
      need this functionality embedded in another app. (hard part done)

Notes:

  - auto complete/intellisense has several scopes. hit ctrl+space to trigger.
    if there is a partial identifer already typed, with only one match, the
    string will be auto completed. If there are multiple matches, then the
    filtered results will be show in intellisense list. If no matches are found
    then entire list will be shown.

    The following scopes are supported:

      - import statements - lists *.bas in specified /include directory
      - external module functions - parses the *.bas headers to build func list.
      - built in script basic functions
      - is not currently aware of script variable names
 
   - for module functions (ex curl::) to show up, the matching import must exist
      (include file name, must match embedded module name)

   - debugger variable inspection / modification - When debugging a list view
     of variable names, scopes, and values is kept. You can edit values by right
     clicking its list entry. Array values can be viewed by double clicking on
     its variable name to bring up the array viewer form.

     You can also display a variable value, by hovering the mouse over it in
     the IDE window. A call tip will popup showing its value. Click on the call tip
     to being up the edit value form. Longs and string values are supported. You can
     also prefix a string with 0x for hex numbers.

   - parse errors will show up in their own listview. Each error will get its own entry.
     where possible line numbers, files, and error descriptions are provided. Clicking
     on the entry will jump to that line in the IDE (if one was given by SB engine)

   - changes to scripts are automatically saved each time they are executed.

   - special hot keys:

              ctrl-f - find/replace
              ctrl-g - goto line
              ctrl-z - undo
              ctrl-y - redo

              F2     - set breakpoint
              F5     - go
              F7     - single step
              F9     - step out
              F8     - step over
 

Github Project Repository

29
TinyScheme / TinyScheme Extension Module
« on: August 27, 2014, 11:38:58 PM »
I thought I would post an update to where things are with the Lisp in BASIC adventure. Mike has taken over with the QB converted Lisp in BASIC and is primarily developing it for FBSL and possibly OxygenBasic. My interest in the project was to see how compatible Script BASIC was with QB 4.5 and as a possible teaching aid. It seemed to be too much work to convert it to C when there are already more complete and faster implementations of Scheme. I'm using TinyScheme which is the scripting language for GIMP and easily embedded in SB. I have a C BASIC TinyScheme extension working on Ubuntu 64 and decided to use DLLC under Windows to take advantage of the multi-threading feature of the DLLC interface. The following example loads/calls a ASCII Mandelbrot Scheme script Rob wrote on the O2 forum and returns the results in a SB predefine buffer string.

Code: Scheme
  1. (newline)
  2. (newline)
  3. (display "Ascii Mandelbrot TinyScheme") (newline)
  4. (display "---------------------------") (newline)
  5.  
  6. (define sq
  7.    (lambda (x) (* x x)))
  8.  
  9. (define (1+ x) (+ x 1))
  10. (define (1- x) (- x 1))
  11.  
  12. (define level
  13.   (lambda (i x y rc ic it orb)
  14.    (if (or (= i it) (> orb 4)) i
  15.     (level (1+ i) (+ rc (- (sq x) (sq y))) (+ ic (* 2 x y)) rc ic it (+ (sq x) (sq y))))))
  16.  
  17. (define mlevel
  18.    (lambda (L)
  19.      (level 0 (cadr L) (car L) (cadr L) (car L) 11 0)))
  20.  
  21. (define (main)
  22.    (let ((cnt 0) (lvl 0) (xo -1.7) (yo -2.3) (dz 0.1) )
  23.      (do ((i 0 (1+ i)))
  24.          ((= i 30))
  25.         (do ((j 0 (1+ j)))
  26.             ((= 30 j))
  27.               (set! lvl (mlevel (list (+ xo (* i dz)) (+ yo (* j dz)) )))
  28.               (if (< lvl 10)
  29.                    (begin (display lvl) (display " "))
  30.                    (display lvl))
  31.               (set! cnt (1+ cnt))
  32.               (when (= 30 cnt)
  33.                  (set! cnt 0)
  34.                  (newline))
  35. ))))
  36.  
  37. (main)
  38. (quit)
  39.  

Code: Script BASIC
  1. ' TinyScheme Script BASIC DLLC Example
  2.  
  3. DECLARE SUB dllfile ALIAS "dllfile" LIB "dllc"
  4. DECLARE SUB dllproc ALIAS "dllproc" LIB "dllc"
  5. DECLARE SUB dllcall ALIAS "dllcall" LIB "dllc"
  6. DECLARE SUB dllsptr ALIAS "dllsptr" LIB "dllc"
  7.  
  8. ts = dllfile("libtinyscheme.dll")
  9. InitNew = dllproc(ts, "scheme_init_new i = ()")
  10. RtnStr = dllproc(ts, "scheme_set_output_port_string (i sc, i startptr, i endptr)")
  11. Deinit = dllproc(ts, "scheme_deinit (i sc)")
  12. LoadStr = dllproc(ts, "scheme_load_string (i sc, c *cmd)")
  13.  
  14. sc = dllcall(InitNew)
  15. lispbuf = STRING(4096,CHR(0))
  16. lispstrptr = dllsptr(lispbuf)
  17. lispstrend = lispstrptr + 4096 - 1
  18. dllcall(RtnStr,sc, lispstrptr, lispstrend)
  19. dllcall(LoadStr, sc, "(load \"init.scm\")")
  20. dllcall(LoadStr, sc, "(load \"mbrot2.scm\")")
  21. strlen = INSTR(lispbuf, CHR(0))
  22. PRINT LEFT(lispbuf, strlen - 1),"\n"
  23. dllcall(Deinit, sc)
  24.  
  25. dllfile()
  26.  

Output

Code: [Select]
C:\SB22\TS>ptime scriba dllchellots.sb

ptime 1.0 for Win32, Freeware - http://www.pc-tools.net/
Copyright(C) 2002, Jem Berkes <jberkes@pc-tools.net>

=== scriba dllchellots.sb ===


Ascii Mandelbrot TinyScheme
---------------------------
1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 3 3 3 3 3 2 2 2 2 2 2 2 2 2
1 1 1 1 1 1 1 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2
1 1 1 1 1 1 1 2 2 2 3 3 3 3 3 3 3 3 4 4 4 115 4 4 3 3 2 2 2
1 1 1 1 1 1 2 2 2 3 3 3 3 3 3 3 3 4 4 4 5 7 9 114 4 3 3 2 2
1 1 1 1 1 1 2 3 3 3 3 3 3 3 3 4 4 4 4 5 6 9 118 5 4 4 3 3 3
1 1 1 1 1 2 3 3 3 3 3 3 3 3 4 4 4 4 5 6 8 1111116 5 5 4 3 3
1 1 1 1 1 2 3 3 3 3 3 3 3 4 4 4 5 7 8 8 101111119 6 6 5 4 3
1 1 1 1 2 3 3 3 3 3 3 3 4 4 5 5 6 11111111111111111111114 3
1 1 1 1 2 3 3 3 3 3 4 5 5 5 5 6 8 111111111111111111117 5 3
1 1 1 1 3 3 3 3 4 5 7 7 7 7 7 7 11111111111111111111119 5 4
1 1 1 1 3 4 4 4 5 5 7 111111119 1111111111111111111111116 4
1 1 1 1 4 4 4 5 5 6 8 11111111111111111111111111111111115 4
1 1 1 1 4 4 6 6 7 1111111111111111111111111111111111118 5 4
1 1 1 1111111111111111111111111111111111111111111111117 5 4
1 1 1 1 4 4 6 6 7 1111111111111111111111111111111111118 5 4
1 1 1 1 4 4 4 5 5 6 8 11111111111111111111111111111111115 4
1 1 1 1 3 4 4 4 5 5 7 111111119 1111111111111111111111116 4
1 1 1 1 3 3 3 3 4 5 7 7 7 7 7 7 11111111111111111111119 5 4
1 1 1 1 2 3 3 3 3 3 4 5 5 5 5 6 8 111111111111111111117 5 3
1 1 1 1 2 3 3 3 3 3 3 3 4 4 5 5 6 11111111111111111111114 3
1 1 1 1 1 2 3 3 3 3 3 3 3 4 4 4 5 7 8 8 101111119 6 6 5 4 3
1 1 1 1 1 2 3 3 3 3 3 3 3 3 4 4 4 4 5 6 8 1111116 5 5 4 3 3
1 1 1 1 1 1 2 3 3 3 3 3 3 3 3 4 4 4 4 5 6 9 118 5 4 4 3 3 3
1 1 1 1 1 1 2 2 2 3 3 3 3 3 3 3 3 4 4 4 5 7 9 114 4 3 3 2 2
1 1 1 1 1 1 1 2 2 2 3 3 3 3 3 3 3 3 4 4 4 115 4 4 3 3 2 2 2
1 1 1 1 1 1 1 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2


Execution time: 1.086 s

C:\SB22\TS>

30
General Discussions / SBLisp
« on: July 29, 2014, 05:52:18 PM »
In conjunction with Dave's VB/COM adventures I thought I would see how compatible Script BASIC is with Microsoft's Quick BASIC 4.5. I found a LISP in BASIC example and converted it to Script BASIC. (see attached)  I have a slight problem with it and could use another set of eyes.  If you solve the riddle and not a forum member, please send me an e-mail at support@scriptbasic.org and I will give you credit for the find.

Here is where I'm at.

Code: [Select]
jrs@laptop:~/sb/sb22/sblisp$ scriba lisp.sb
Initializing Memory...
Initializing Lisp Environment...
LISP in BASIC v1.3 by Arthur Nunes-Harwitt
 0](+ 2 2)
ERROR: UNBOUND VARIABLE
ERROR: UNBOUND VARIABLE
ERROR: UNKNOWN APPLICATION
( ())
 0]

Pages: 1 [2] 3 4 ... 12