Raspberry BASIC

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.


Messages - John Spikowski

Pages: 1 ... 8 9 [10] 11 12 ... 16
136
Nim / Re: Nim SB
« on: December 13, 2019, 07:49:45 AM »
I still have a few functions that need to be broken apart or reworked,

SB_CallSubArgs
SB_GetVar
SB_SetDbl
SB_SetStr

sbobj.c
Code: C
  1. // ScriptBasic Shared Object
  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 "/home/ubuntu/sb-dev-master/basext.h"
  11. #include "/home/ubuntu/sb-dev-master/scriba.h"
  12. #include "cbasic.h"
  13.  
  14.  
  15. /***********************
  16.  Statc Support Routines
  17. ***********************/
  18.  
  19. struct _RunServiceProgram {
  20.   char *pszProgramFileName;
  21.   char *pszCmdLineArgs;
  22.   char *pszConfigFileName;
  23.   pSbProgram pTProgram;
  24.   int iRestart;
  25.   };
  26.  
  27. static void ExecuteProgramThread(void *p){
  28.   pSbProgram pProgram;
  29.   char szInputFile[1024];
  30.   int iErrorCode;
  31.   struct _RunServiceProgram *pRSP;
  32.   pRSP = p;
  33.   strcpy(szInputFile,pRSP->pszProgramFileName);
  34.   pProgram = scriba_new(malloc,free);
  35.   pRSP->pTProgram = pProgram;
  36.   if( pProgram == NULL )return;
  37.   scriba_SetFileName(pProgram,szInputFile);
  38.   if (pRSP->pszConfigFileName != NULL){
  39.         strcpy(szInputFile,pRSP->pszConfigFileName);
  40.         scriba_LoadConfiguration(pProgram, pRSP->pszConfigFileName);
  41.   }else{
  42.         scriba_SetProcessSbObject(pProgram,pProgram);
  43.   }
  44.   scriba_LoadSourceProgram(pProgram);
  45.   if (pRSP->pszCmdLineArgs != NULL){
  46.         strcpy(szInputFile,pRSP->pszCmdLineArgs);
  47.     iErrorCode = scriba_Run(pProgram,pRSP->pszCmdLineArgs);
  48.   }else{
  49.     iErrorCode = scriba_Run(pProgram,NULL);
  50.   }
  51. //  scriba_destroy(pProgram);
  52.   return;
  53. }
  54.  
  55.  
  56. /*****************************
  57.  ScriptBasic Object Functions
  58. *****************************/
  59.  
  60. FUNCTION long SB_New()
  61. BEGIN_FUNCTION
  62.   DIM AS pSbProgram sbobj;
  63.   sbobj = scriba_new(malloc,free);
  64.   RETURN_FUNCTION(sbobj);
  65. END_FUNCTION
  66.  
  67. FUNCTION int SB_Configure(unsigned long sbobj, char PTR cfgfilename)
  68. BEGIN_FUNCTION
  69.   DIM AS int rtnval = -1;
  70.   rtnval = scriba_LoadConfiguration(sbobj, cfgfilename);
  71.   RETURN_FUNCTION(rtnval);
  72. END_FUNCTION
  73.  
  74. FUNCTION int SB_Load(unsigned long sbobj, char PTR sbfilename)
  75. BEGIN_FUNCTION
  76.   DIM AS int rtnval = -1;
  77.   rtnval = scriba_SetFileName(sbobj, sbfilename);
  78.   scriba_LoadSourceProgram(sbobj);
  79.   RETURN_FUNCTION(rtnval);
  80. END_FUNCTION
  81.  
  82. FUNCTION int SB_LoadStr(unsigned long sbobj, char PTR sbpgm)
  83. BEGIN_FUNCTION
  84.   DIM AS int rtnval = -1;
  85.   scriba_SetFileName(sbobj, "fake");
  86.   rtnval = scriba_LoadProgramString(sbobj, sbpgm, strlen(sbpgm));
  87.   RETURN_FUNCTION(rtnval);
  88. END_FUNCTION
  89.  
  90. FUNCTION int SB_Run(unsigned long sbobj, char PTR sbcmdline)
  91. BEGIN_FUNCTION
  92.   DIM AS int rtnval;
  93.   IF (besARGNR < 2) THEN_DO sbcmdline = "";
  94.   rtnval = scriba_Run(sbobj, sbcmdline);
  95.   RETURN_FUNCTION(rtnval);
  96. END_FUNCTION
  97.  
  98. FUNCTION int SB_NoRun(unsigned long sbobj)
  99. BEGIN_FUNCTION
  100.   DIM AS int rtnval;
  101.   rtnval = scriba_NoRun(sbobj);
  102.   RETURN_FUNCTION(rtnval);
  103. END_FUNCTION
  104.  
  105. FUNCTION int SB_ThreadStart(char PTR pszProgramFileName, char PTR pszCmdLineArgs, char PTR pszConfigFileName)
  106. BEGIN_FUNCTION
  107.   DIM AS struct _RunServiceProgram PTR pRSP;
  108.   DIM AS THREADHANDLE T;
  109.   DIM AS unsigned long rtnval;
  110.   pRSP = (struct _RunServiceProgram PTR)malloc( sizeof(struct _RunServiceProgram) );
  111.   pRSP->pszProgramFileName = (char PTR)malloc(strlen(pszProgramFileName) + 1);
  112.   strcpy(pRSP->pszProgramFileName,pszProgramFileName);
  113.   IF (pszCmdLineArgs NE NULL) THEN
  114.     pRSP->pszCmdLineArgs = (char PTR)malloc(strlen(pszCmdLineArgs) + 1);
  115.     strcpy(pRSP->pszCmdLineArgs,pszCmdLineArgs);
  116.   ELSE
  117.         pRSP->pszCmdLineArgs = NULL;
  118.   END_IF
  119.   IF (pszConfigFileName NE NULL) THEN
  120.     pRSP->pszConfigFileName = (char PTR)malloc(strlen(pszConfigFileName) + 1);
  121.     strcpy(pRSP->pszConfigFileName,pszConfigFileName);
  122.   ELSE
  123.         pRSP->pszConfigFileName = NULL;
  124.   END_IF
  125.   pRSP->iRestart = 0;
  126.   thread_CreateThread(AT T,ExecuteProgramThread,pRSP);
  127.   usleep(500);
  128.   rtnval = pRSP->pTProgram;
  129.   RETURN_FUNCTION(rtnval);
  130. END_FUNCTION
  131.  
  132. SUB SB_ThreadEnd()
  133. BEGIN_SUB
  134.   thread_ExitThread();
  135. END_SUB
  136.  
  137. SUB SB_Destroy(unsigned long sbobj)
  138.   scriba_destroy(sbobj);
  139. END_SUB
  140.  
  141. FUNCTION int SB_CallSub(unsigned long sbobj, char PTR funcname)
  142.   DIM AS int funcsernum;
  143.   funcsernum = scriba_LookupFunctionByName(sbobj, funcname);
  144.   RETURN_FUNCTION(scriba_Call(sbobj, funcsernum));
  145. END_FUNCTION
  146.  
  147. besFUNCTION(SB_CallSubArgs)
  148.   DIM AS VARIABLE Argument;
  149.   DIM AS SbData ArgData[8];
  150.   DIM AS SbData FunctionResult;
  151.   DIM AS unsigned long sbobj;
  152.   DIM AS char PTR funcname;
  153.   DIM AS int i, sbtype, fnsn;
  154.  
  155.   Argument = besARGUMENT(1);
  156.   besDEREFERENCE(Argument);
  157.   sbobj = LONGVALUE(Argument);
  158.  
  159.   Argument = besARGUMENT(2);
  160.   besDEREFERENCE(Argument);
  161.   funcname = STRINGVALUE(Argument);
  162.  
  163.   DEF_FOR (i = 3 TO i <= besARGNR STEP INCR i)
  164.   BEGIN_FOR
  165.     Argument = besARGUMENT(i);
  166.     besDEREFERENCE(Argument);
  167.     SELECT_CASE (sbtype = TYPE(Argument))
  168.     BEGIN_SELECT
  169.       CASE VTYPE_LONG:
  170.         ArgData[i-3] = PTR scriba_NewSbLong(sbobj, LONGVALUE(Argument));
  171.         END_CASE
  172.       CASE VTYPE_DOUBLE:
  173.         ArgData[i-3] = PTR scriba_NewSbDouble(sbobj, DOUBLEVALUE(Argument));
  174.         END_CASE
  175.       CASE VTYPE_STRING:
  176.         ArgData[i-3] = PTR scriba_NewSbString(sbobj, STRINGVALUE(Argument));
  177.         END_CASE
  178.       CASE_ELSE
  179.         ArgData[i-3] = PTR scriba_NewSbUndef(sbobj);
  180.         END_CASE
  181.     END_SELECT
  182.   NEXT
  183.  
  184.   fnsn = scriba_LookupFunctionByName(sbobj, funcname);
  185.   scriba_CallArgEx(sbobj, fnsn, AT FunctionResult, besARGNR - 2, AT ArgData);
  186.  
  187.   SELECT_CASE (FunctionResult.type)
  188.   BEGIN_SELECT
  189.     CASE SBT_LONG:
  190.       besRETURN_LONG(FunctionResult.v.l);
  191.       END_CASE
  192.     CASE SBT_DOUBLE:
  193.       besRETURN_DOUBLE(FunctionResult.v.d);
  194.       END_CASE
  195.     CASE SBT_STRING:
  196.       besRETURN_STRING(FunctionResult.v.s);
  197.       END_CASE
  198.     CASE SBT_UNDEF:
  199.       besRETURNVALUE = NULL;
  200.       END_CASE
  201.   END_SELECT
  202. besEND
  203.  
  204. besFUNCTION(SB_GetVar)
  205.   DIM AS pSbData varobj;
  206.   DIM AS unsigned long sbobj;
  207.   DIM AS int vsn;
  208.   DIM AS char PTR varname;
  209.   besARGUMENTS("iz")
  210.     AT sbobj, AT varname
  211.   besARGEND
  212.   vsn = scriba_LookupVariableByName(sbobj, varname);
  213.   scriba_GetVariable(sbobj, vsn, AT varobj);
  214.   SELECT_CASE (scriba_GetVariableType(sbobj, vsn))
  215.   BEGIN_SELECT
  216.     CASE SBT_LONG   :
  217.       besRETURN_LONG(varobj[0].v.l);
  218.       END_CASE
  219.     CASE SBT_DOUBLE :
  220.       besRETURN_DOUBLE(varobj[0].v.d);
  221.       END_CASE
  222.     CASE SBT_STRING :
  223.       besRETURN_STRING(varobj[0].v.s);
  224.       END_CASE
  225.     CASE SBT_UNDEF  :
  226.       besRETURNVALUE = NULL;
  227.       END_CASE
  228.   END_SELECT
  229. besEND
  230.  
  231. FUNCTION int SB_SetUndef(unsigned long sbobj, char PTR varname)
  232. BEGIN_FUNCTION
  233.   DIM AS pSbData varobj;
  234.   DIM AS int vsn;
  235.   vsn = scriba_LookupVariableByName(sbobj, varname);
  236.   RETURN_FUNCTION(scriba_SetVariable(sbobj, vsn, SBT_UNDEF, NULL, 0, "", 0));
  237. END_FUNCTION
  238.  
  239. FUNCTION int SB_SetInt()
  240. BEGIN_FUNCTION
  241.   DIM AS VARIABLE Argument;
  242.   DIM AS pSbData varobj;
  243.   DIM AS unsigned long sbobj;
  244.   DIM AS int vsn, usrval, i;
  245.   DIM AS char PTR varname;
  246.   IF (besARGNR < 3) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS);
  247.   DEF_FOR (i = 1 TO i <= 3 STEP INCR i)
  248.   BEGIN_FOR
  249.     Argument = besARGUMENT(i);
  250.     besDEREFERENCE(Argument);
  251.     IF (i EQ 1) THEN_DO sbobj = LONGVALUE(Argument);
  252.     IF (i EQ 2) THEN_DO varname = STRINGVALUE(Argument);
  253.     IF (i EQ 3) THEN_DO usrval = LONGVALUE(Argument);
  254.   NEXT
  255.   vsn = scriba_LookupVariableByName(sbobj, varname);
  256.   besRETURN_LONG(scriba_SetVariable(sbobj, vsn, SBT_LONG, usrval, 0, "", 0));
  257. besEND
  258.  
  259. besFUNCTION(SB_SetDbl)
  260.   DIM AS VARIABLE Argument;
  261.   DIM AS pSbData varobj;
  262.   DIM AS unsigned long sbobj;
  263.   DIM AS int vsn, i;
  264.   DIM AS char PTR varname;
  265.   DIM AS double usrval;
  266.   IF (besARGNR < 3) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS);
  267.   DEF_FOR (i = 1 TO i <= 3 STEP INCR i)
  268.   BEGIN_FOR
  269.     Argument = besARGUMENT(i);
  270.     besDEREFERENCE(Argument);
  271.     IF (i EQ 1) THEN_DO sbobj = LONGVALUE(Argument);
  272.     IF (i EQ 2) THEN_DO varname = STRINGVALUE(Argument);
  273.     IF (i EQ 3) THEN_DO usrval = DOUBLEVALUE(Argument);
  274.   NEXT
  275.   vsn = scriba_LookupVariableByName(sbobj, varname);
  276.   besRETURN_LONG(scriba_SetVariable(sbobj, vsn,  SBT_DOUBLE, 0, usrval, "", 0));
  277. besEND
  278.  
  279. besFUNCTION(SB_SetStr)
  280.   DIM AS VARIABLE Argument;
  281.   DIM AS pSbData varobj;
  282.   DIM AS unsigned long sbobj;
  283.   DIM AS int vsn, i;
  284.   DIM AS char PTR varname;
  285.   DIM AS char PTR usrval;
  286.   IF (besARGNR < 3) THEN_DO RETURN_FUNCTION(EX_ERROR_TOO_FEW_ARGUMENTS);
  287.   DEF_FOR (i = 1 TO i <= 3 STEP INCR i)
  288.   BEGIN_FOR
  289.     Argument = besARGUMENT(i);
  290.     besDEREFERENCE(Argument);
  291.     IF (i EQ 1) THEN_DO sbobj = LONGVALUE(Argument);
  292.     IF (i EQ 2) THEN_DO varname = STRINGVALUE(Argument);
  293.     IF (i EQ 3) THEN_DO usrval = STRINGVALUE(Argument);
  294.   NEXT
  295.   vsn = scriba_LookupVariableByName(sbobj, varname);
  296.   besRETURN_LONG(scriba_SetVariable(sbobj, vsn,  SBT_STRING, 0, 0, usrval, strlen(usrval)));
  297. besEND
  298.  
  299. SUB SB_ResetVars(unsigned long sbobj)
  300. BEGIN_SUB
  301.   scriba_ResetVariables(sbobj);
  302. END_SUB
  303.  
  304. SUB SB_msSleep(long t)
  305. BEGIN_SUB
  306.   usleep(t);
  307. END_SUB
  308.  

137
Nim / Re: Nim SB
« on: December 12, 2019, 08:01:53 PM »
Silver lining is once I have the generic call conversion completed, the ScriptBasic shared object can be embedded in any language supporting a FFI interface. (compiled and interpretative)

138
Nim / Re: Nim SB
« on: December 12, 2019, 12:32:28 AM »
I thought I would get the Nim SB project kicked off by showing what already exists and needing a Nim extension interface. SBT is everything needed to make the interface with Nim work. It happens to be using ScriptBasic as its host language. The advantage is that it can also use the MT extension module to communicate with threads.

interface.c

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

sbt.inc - interpreter extension module include
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 (ScriptBasic Threads) - 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, "C:/Windows/SCRIBA.INI"
  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

123
1.23
One, Two, Three
Function Return
321
32.1
Three,Two,One



The goal is to create a Nim interface with the same function calls as in the ScriptBasic SBT include file. The first step is to convert the SBT shared object interface into a generic call format.

139
Programming Challenges / Re: SALC Rasbian 32
« on: December 11, 2019, 06:49:05 PM »
Current String / Array language challenge results.

140
Programming Challenges / Re: SALC Rasbian 32
« on: December 11, 2019, 06:29:50 PM »
8th Update (Jalih submission)

Code: Text
  1. 1000000 constant LIMIT
  2.  
  3. a:new 0 a:push var, a
  4. 0 b:new true b:writable var, s
  5. 0 b:new true b:writable var, t
  6.  
  7.  
  8. : iterate
  9.   s @ "" 2 pick n:1- 26 n:mod 65 n:+ s:+ b:append
  10.   b:len 26 n:< not if
  11.     t @ swap b:append drop
  12.     0 b:new true b:writable s !
  13.   else
  14.     drop
  15.   then
  16.   a:push ;
  17.  
  18. : app:main
  19.   a @ ' iterate 1 LIMIT loop
  20.   t @ b:rev >s s:len "r LEN: %d\n" s:strfmt .
  21.   dup 26 s:lsub "Front: %s\n" s:strfmt .
  22.   26 s:rsub "Back:  %s\n" s:strfmt .
  23.   LIMIT a:@ nip "UBVal: %d\n" s:strfmt .
  24.   bye ;
  25.  


pi@RPi4B:~/8th-dev/examples $ timex ./1mil3-2
r LEN: 999986
Front: ZYXWVUTSRQPONMLKJIHGFEDCBA
Back:  ZYXWVUTSRQPONMLKJIHGFEDCBA
UBVal: 1000000
2.09user 0.16system 0:02.28elapsed 99%CPU (0avgtext+0avgdata 53140maxresident)k
0inputs+0outputs (0major+12124minor)pagefaults 0swaps
pi@RPi4B:~/8th-dev/examples $


I thought Rust executables were huge. 8th takes the lead in this category.

-rwxr-xr-x 1 pi pi 7344807 Dec  9 21:02 1mil3-2

141
Nim / Nim SB
« on: December 11, 2019, 05:38:36 PM »
I'm working on embedding ScriptBasic into Nim. Basically it's a port of the SBT extension module as Nim extension. This will allow the full functionality of SB and its extensions to be available to Nim dynamically at runtime.

@AIR - I may need some help creating the Nim interface if you have time.

142
Nim / Re: Nim Introduction
« on: December 11, 2019, 06:59:30 AM »
Yep. On the regret list. I should have listened to you years ago.

I hope to become as proficient with Nim as I am with SB.

My next example with Nim will be embedding ScriptBasic. It will be like a high level EVAL function. You pass it some SB code as text and it returns what you want from it. I don't want to leave my old friend behind. Actually this is what ScriptBasic was designed for, not a standalone BASIC interpreter


143
Swift / Re: Swift RPi
« on: December 11, 2019, 01:56:07 AM »
I tried the latest submission for Swift on my laptop Ubuntu 19.10 64 bit. It looks to me that  the problem is specific to ARM. I typically see a 4-5 X speed difference between my Lenovo laptop and the RPi 4B 4GB.


ubuntu@ubuntu:~/swift-dev/examples$ /usr/bin/time ./main
t LEN:  999986
Front: ZYXWVUTSRQPONMLKJIHGFEDCBA
Back:  ZYXWVUTSRQPONMLKJIHGFEDCBA
UBVal:  100000
0.19user 0.01system 0:00.23elapsed 91%CPU (0avgtext+0avgdata 16868maxresident)k
10264inputs+24outputs (31major+2804minor)pagefaults 0swaps
ubuntu@ubuntu:~/swift-dev/examples$ time ./main
t LEN:  999986
Front: ZYXWVUTSRQPONMLKJIHGFEDCBA
Back:  ZYXWVUTSRQPONMLKJIHGFEDCBA
UBVal:  100000

real   0m0.227s
user   0m0.210s
sys   0m0.016s
ubuntu@ubuntu:~/swift-dev/examples$


144
General Discussion / Re: RPI Forum
« on: December 10, 2019, 11:32:01 PM »
The Swift ARM maintainer agrees there is a problem with the Swift string engine. I hope he follows up with it. I've done all I can.

145
Programming Challenges / Re: SALC Rasbian 32
« on: December 10, 2019, 06:49:19 AM »
Free Pascal (AIR submission)

Code: Pascal
  1. // Free Pascal -1mil3 - AIR
  2.  
  3. program mil;
  4.  
  5. Uses StrUtils;
  6.  
  7. var
  8.     s:AnsiString;
  9.     t:AnsiString;
  10.     c:AnsiChar;
  11.     a:array[0..1000001] of int32;
  12.     x:int32;
  13. begin
  14.     s := '';
  15.     t := '';
  16.     for x := 0 to 1000001 do
  17.     begin
  18.         c :=  chr( (x mod 26)+65 );
  19.         a[x] := x;
  20.         s += c;
  21.         if Length(s) = 26 then
  22.         begin
  23.             t += ReverseString(s);
  24.             s := '';
  25.         end;
  26.     end;
  27.  
  28.     writeln( 'r len: ', Length(t) );
  29.     writeln( 'Front: ', LeftStr(t,26) );
  30.     writeln( 'Back:  ', RightStr(t,26) );
  31.     writeln( 'UBVal: ', a[1000000]);
  32. end.
  33.  


pi@RPi4B:~/freepascal-dev/examples $ ls -l
total 80
-rwxr-xr-x 1 pi pi 78352 Dec  9 20:31 1mil3
pi@RPi4B:~/freepascal-dev/examples $ timex ./1mil3
r len: 999986
Front: ZYXWVUTSRQPONMLKJIHGFEDCBA
Back:  ZYXWVUTSRQPONMLKJIHGFEDCBA
UBVal: 1000000
0.20user 0.02system 0:00.23elapsed 99%CPU (0avgtext+0avgdata 5604maxresident)k
8inputs+0outputs (0major+1431minor)pagefaults 0swaps
pi@RPi4B:~/freepascal-dev/examples $


146
Programming Challenges / Re: SALC Rasbian 32
« on: December 10, 2019, 06:38:31 AM »
Swift Update (AIR submission)

Code: Text
  1. // Swift 5.1.2 - 1mil3-3.swift
  2.  
  3. var s = ""
  4. var t = ""
  5. var a = [Int](repeating: 0, count: 1000001)
  6.  
  7. for x in 1...1000000 {
  8.   let c = (x - 1) % 26
  9.   s.append(String(UnicodeScalar(UInt8(c + 65))))
  10.   a[x] = x
  11.   if c == 25 {
  12.     t.append(String(s.reversed()))
  13.     s = ""
  14.   }
  15. }
  16.  
  17. print("t LEN: ", t.count)
  18. print("Front: \(t.prefix(26))")
  19. print("Back:  \(t.suffix(26))")
  20. print("UBVal: ", a[100000])
  21.  


pi@RPi4B:~/swift-dev/examples $ swiftc -O 1mil3-3.swift
pi@RPi4B:~/swift-dev/examples $ ls -l main
-rwxr-xr-x 1 pi pi 29316 Dec  9 22:37 main
pi@RPi4B:~/swift-dev/examples $ timex ./main
t LEN:  999986
Front: ZYXWVUTSRQPONMLKJIHGFEDCBA
Back:  ZYXWVUTSRQPONMLKJIHGFEDCBA
UBVal:  100000
23.26user 0.03system 0:23.31elapsed 99%CPU (0avgtext+0avgdata 12012maxresident)k
0inputs+0outputs (0major+1890minor)pagefaults 0swaps
pi@RPi4B:~/swift-dev/examples $


147
Programming Challenges / Re: SALC Rasbian 32
« on: December 10, 2019, 02:18:47 AM »
Rust (AIR submission)

Code: Text
  1. // Rust - 1mil3 - AIR
  2.  
  3. fn main() {
  4.     let mut s = "".to_string();
  5.     let mut t = "".to_string();
  6.     let mut a = [0;1000001];
  7.  
  8.     for x in 0..1000001 {
  9.         a[x] = x;
  10.         let b   = ( x%26 ) as u8;
  11.         let c = ( b+65 ) as char;
  12.         s.push( c );
  13.         if s.len() == 26 {
  14.             let reversed: String = s.chars().rev().collect();
  15.             t.push_str( &reversed );
  16.             s.clear();
  17.         }
  18.     }
  19.     println!( "r LEN: {}",  t.len() );
  20.     println!( "Front: {}",  &t[..26] );
  21.     println!( "Back:  {}",  &t[t.len()-26..]);
  22.     println!( "UBVal: {}",  a[1000000] );
  23.  
  24. }
  25.  

-rwxr-xr-x 1 pi pi 2582500 Dec  9 17:47 1mil3

pi@RPi4B:~/rust-dev/examples $ timex ./1mil3
r LEN: 999986
Front: ZYXWVUTSRQPONMLKJIHGFEDCBA
Back:  ZYXWVUTSRQPONMLKJIHGFEDCBA
UBVal: 1000000
0.10user 0.02system 0:00.12elapsed 96%CPU (0avgtext+0avgdata 6336maxresident)k
0inputs+0outputs (0major+1392minor)pagefaults 0swaps
pi@RPi4B:~/rust-dev/examples $



148
Programming Challenges / Re: SALC Rasbian 32
« on: December 09, 2019, 11:12:38 PM »
C Update (AIR submission)

Code: C
  1. #include <stdlib.h>
  2. #include <stdio.h>
  3. #include <glib.h>
  4. #include <glib/gprintf.h>
  5.  
  6. int main(int argc, char **argv) {
  7.         GString *s = g_string_new(NULL);
  8.         GString *t = g_string_new(NULL);
  9.         int a[1000001] = {0};
  10.  
  11.         for (int x = 0; x < 1000001; x++) {
  12.                 a[x] = x;
  13.                 g_string_append_c(s,(char)(x%26)+65);
  14.                 if (s->len == 26) {
  15.                         g_string_append(t,g_strreverse(s->str));
  16.                         g_string_assign(s,"");
  17.                 }
  18.         }
  19.  
  20.         g_printf("r LEN: %d\n",t->len);
  21.         g_printf("Front: %.*s\n", 26, t->str);
  22.         g_printf("Back:  %s\n", t->str + t->len - 26);
  23.         g_printf("UBVal: %d\n",a[1000000]);
  24.  
  25.         g_string_free (s,TRUE);
  26.         g_string_free (t,TRUE);
  27. }
  28.  


pi@RPi4B:~/c-dev/examples $ gcc -O3 1mil3-3.c  $(pkg-config --libs --cflags glib-2.0) -o 1mil3-3
pi@RPi4B:~/c-dev/examples $ ls -l 1mil3-3
-rwxr-xr-x 1 pi pi 8308 Dec  9 15:05 1mil3-3
pi@RPi4B:~/c-dev/examples $ timex ./1mil3-3
r LEN: 999986
Front: ZYXWVUTSRQPONMLKJIHGFEDCBA
Back:  ZYXWVUTSRQPONMLKJIHGFEDCBA
UBVal: 1000000
0.03user 0.02system 0:00.07elapsed 95%CPU (0avgtext+0avgdata 6384maxresident)k
0inputs+0outputs (0major+1336minor)pagefaults 0swaps
pi@RPi4B:~/c-dev/examples $


149
Programming Challenges / Re: SALC Rasbian 32
« on: December 09, 2019, 07:26:17 PM »
Ruby (AIR submission)

Code: Ruby
  1. # Ruby - 1mil3.rb - AIR
  2.  
  3. a = [10000001]
  4. s = ""
  5. t = ""
  6.  
  7.  
  8. (0..1000001).each do |x|
  9.         a << x+1
  10.         s << (x%26)+65
  11.         if s.length == 26
  12.                 t << s.reverse
  13.                 s.clear
  14.         end
  15. end
  16.  
  17. puts "t LEN: #{t.length}"
  18. puts "Front: #{t[0,26]}"
  19. puts "Back:  #{t[-26,26]}"
  20. puts "UBVal: #{a[1000000]}"
  21.  


pi@RPi4B:~/ruby-dev/examples $ timex ruby 1mil3.rb
t LEN: 999986
Front: ZYXWVUTSRQPONMLKJIHGFEDCBA
Back:  ZYXWVUTSRQPONMLKJIHGFEDCBA
UBVal: 1000000
0.98user 0.04system 0:01.18elapsed 86%CPU (0avgtext+0avgdata 12024maxresident)k
7168inputs+0outputs (16major+2164minor)pagefaults 0swaps
pi@RPi4B:~/ruby-dev/examples $


150
Nim / Re: Nim SDL Transformations
« on: December 09, 2019, 05:07:30 AM »
Code: Text
  1. # ex202_transformations.nim
  2. # =========================
  3. # VIDEO / Transforming textures
  4. # -----------------------------
  5.  
  6.  
  7. import sdl2/sdl, sdl2/sdl_image as img
  8.  
  9.  
  10. const
  11.   Title = "SDL2 App"
  12.   ScreenW = 640 # Window width
  13.   ScreenH = 480 # Window height
  14.   WindowFlags = 0
  15.   RendererFlags = sdl.RendererAccelerated or sdl.RendererPresentVsync
  16.  
  17.  
  18. type
  19.   App = ref AppObj
  20.   AppObj = object
  21.     window*: sdl.Window # Window pointer
  22.     renderer*: sdl.Renderer # Rendering state pointer
  23.  
  24.  
  25.   Image = ref ImageObj
  26.   ImageObj = object of RootObj
  27.     texture: sdl.Texture # Image texture
  28.     w, h: int # Image dimensions
  29.  
  30.  
  31. #########
  32. # IMAGE #
  33. #########
  34.  
  35. proc newImage(): Image = Image(texture: nil, w: 0, h: 0)
  36. proc free(obj: Image) = sdl.destroyTexture(obj.texture)
  37. proc w(obj: Image): int {.inline.} = return obj.w
  38. proc h(obj: Image): int {.inline.} = return obj.h
  39.  
  40.  
  41. # Load image from file
  42. # Return true on success or false, if image can't be loaded
  43. proc load(obj: Image, renderer: sdl.Renderer, file: string): bool =
  44.   result = true
  45.   # Load image to texture
  46.   obj.texture = renderer.loadTexture(file)
  47.   if obj.texture == nil:
  48.     sdl.logCritical(sdl.LogCategoryError,
  49.                     "Can't load image %s: %s",
  50.                     file, img.getError())
  51.     return false
  52.   # Get image dimensions
  53.   var w, h: cint
  54.   if obj.texture.queryTexture(nil, nil, addr(w), addr(h)) != 0:
  55.     sdl.logCritical(sdl.LogCategoryError,
  56.                     "Can't get texture attributes: %s",
  57.                     sdl.getError())
  58.     sdl.destroyTexture(obj.texture)
  59.     return false
  60.   obj.w = w
  61.   obj.h = h
  62.  
  63.  
  64. # Render texture to screen
  65. proc render(obj: Image, renderer: sdl.Renderer, x, y: int): bool =
  66.   var rect = sdl.Rect(x: x, y: y, w: obj.w, h: obj.h)
  67.   if renderer.renderCopy(obj.texture, nil, addr(rect)) == 0:
  68.     return true
  69.   else:
  70.     return false
  71.  
  72.  
  73. # Render transformed texture to screen
  74. proc renderEx(obj: Image, renderer: sdl.Renderer, x, y: int,
  75.               w = 0, h = 0, angle = 0.0, centerX = -1, centerY = -1,
  76.               flip = sdl.FlipNone): bool =
  77.   var
  78.     rect = sdl.Rect(x: x, y: y, w: obj.w, h: obj.h)
  79.     centerObj = sdl.Point(x: centerX, y: centerY)
  80.     center: ptr sdl.Point = nil
  81.   if w != 0: rect.w = w
  82.   if h != 0: rect.h = h
  83.   if not (centerX == -1 and centerY == -1): center = addr(centerObj)
  84.   if renderer.renderCopyEx(obj.texture, nil, addr(rect),
  85.                            angle, center, flip) == 0:
  86.     return true
  87.   else:
  88.     return false
  89.  
  90.  
  91. ##########
  92. # COMMON #
  93. ##########
  94.  
  95. # Initialization sequence
  96. proc init(app: App): bool =
  97.   # Init SDL
  98.   if sdl.init(sdl.InitVideo) != 0:
  99.     sdl.logCritical(sdl.LogCategoryError,
  100.                     "Can't initialize SDL: %s",
  101.                     sdl.getError())
  102.     return false
  103.  
  104.   # Init SDL_Image
  105.   if img.init(img.InitPng) == 0:
  106.     sdl.logCritical(sdl.LogCategoryError,
  107.                     "Can't initialize SDL_Image: %s",
  108.                     img.getError())
  109.  
  110.   # Create window
  111.   app.window = sdl.createWindow(
  112.     Title,
  113.     sdl.WindowPosUndefined,
  114.     sdl.WindowPosUndefined,
  115.     ScreenW,
  116.     ScreenH,
  117.     WindowFlags)
  118.   if app.window == nil:
  119.     sdl.logCritical(sdl.LogCategoryError,
  120.                     "Can't create window: %s",
  121.                     sdl.getError())
  122.     return false
  123.  
  124.   # Create renderer
  125.   app.renderer = sdl.createRenderer(app.window, -1, RendererFlags)
  126.   if app.renderer == nil:
  127.     sdl.logCritical(sdl.LogCategoryError,
  128.                     "Can't create renderer: %s",
  129.                     sdl.getError())
  130.     return false
  131.  
  132.   # Set draw color
  133.   if app.renderer.setRenderDrawColor(0x00, 0x00, 0x00, 0xFF) != 0:
  134.     sdl.logWarn(sdl.LogCategoryVideo,
  135.                 "Can't set draw color: %s",
  136.                 sdl.getError())
  137.     return false
  138.  
  139.   sdl.logInfo(sdl.LogCategoryApplication, "SDL initialized successfully")
  140.   return true
  141.  
  142.  
  143. # Shutdown sequence
  144. proc exit(app: App) =
  145.   app.renderer.destroyRenderer()
  146.   app.window.destroyWindow()
  147.   img.quit()
  148.   sdl.logInfo(sdl.LogCategoryApplication, "SDL shutdown completed")
  149.   sdl.quit()
  150.  
  151.  
  152. # Event handling
  153. # Return true on app shutdown request, otherwise return false
  154. proc events(pressed: var seq[sdl.Keycode]): bool =
  155.   result = false
  156.   var e: sdl.Event
  157.   if pressed.len > 0:
  158.     pressed = @[]
  159.  
  160.   while sdl.pollEvent(addr(e)) != 0:
  161.  
  162.     # Quit requested
  163.     if e.kind == sdl.Quit:
  164.       return true
  165.  
  166.     # Key pressed
  167.     elif e.kind == sdl.KeyDown:
  168.       # Add pressed key to sequence
  169.       pressed.add(e.key.keysym.sym)
  170.  
  171.       # Exit on Escape key press
  172.       if e.key.keysym.sym == sdl.K_Escape:
  173.         return true
  174.  
  175.  
  176. ########
  177. # MAIN #
  178. ########
  179.  
  180. var
  181.   app = App(window: nil, renderer: nil)
  182.   done = false # Main loop exit condition
  183.   pressed: seq[sdl.Keycode] = @[] # Pressed keys
  184.  
  185. if init(app):
  186.  
  187.   # Load assets
  188.   var
  189.     image1 = newImage()
  190.   if not image1.load(app.renderer, "img/img1.png"):
  191.     done = true
  192.  
  193.   echo "-----------------------"
  194.   echo "|      Controls:      |"
  195.   echo "|---------------------|"
  196.   echo "| Q/A: change width   |"
  197.   echo "| W/S: change height  |"
  198.   echo "| E/D: rotate         |"
  199.   echo "| R/F: flip           |"
  200.   echo "-----------------------"
  201.  
  202.   # Transformations
  203.   const
  204.     sizeStep = 10
  205.     angleStep = 10
  206.   var
  207.     w = image1.w
  208.     h = image1.h
  209.     angle = 0.0
  210.     flip = sdl.FlipNone
  211.  
  212.   # Main loop
  213.   while not done:
  214.     # Clear screen with draw color
  215.     if app.renderer.renderClear() != 0:
  216.       sdl.logWarn(sdl.LogCategoryVideo,
  217.                   "Can't clear screen: %s",
  218.                   sdl.getError())
  219.  
  220.     # Render textures
  221.     if not image1.renderEx(app.renderer,
  222.                            ScreenW div 2 - w div 2,
  223.                            ScreenH div 2 - h div 2,
  224.                            w, h, angle, flip = flip):
  225.       sdl.logWarn(sdl.LogCategoryVideo,
  226.                   "Can't render image1: %s",
  227.                   sdl.getError())
  228.  
  229.     # Event handling
  230.     done = events(pressed)
  231.  
  232.     # Process input
  233.     if K_q in pressed: w += sizeStep
  234.     if K_a in pressed: w -= sizeStep
  235.     if K_w in pressed: h += sizeStep
  236.     if K_s in pressed: h -= sizeStep
  237.     if K_e in pressed: angle += angleStep
  238.     if K_d in pressed: angle -= angleStep
  239.     if K_r in pressed:
  240.       if flip == sdl.FlipNone:
  241.         flip = sdl.FlipHorizontal
  242.       else:
  243.         flip = sdl.FlipNone
  244.     if K_f in pressed:
  245.       if flip == sdl.FlipNone:
  246.         flip = sdl.FlipVertical
  247.       else:
  248.         flip = sdl.FlipNone
  249.  
  250.     # Check bounds
  251.     if w <= 0: w = sizeStep
  252.     if h <= 0: h = sizeStep
  253.     if angle >= 360: angle -= 360
  254.     elif angle <= -360: angle += 360
  255.  
  256.     # Update renderer
  257.     app.renderer.renderPresent()
  258.  
  259.   # Free assets
  260.   free(image1)
  261.  
  262. # Shutdown
  263. exit(app)
  264.  


pi@RPi4B:~/nim-dev/examples $ ./trans
INFO: SDL initialized successfully
-----------------------
|      Controls:      |
|---------------------|
| Q/A: change width   |
| W/S: change height  |
| E/D: rotate         |
| R/F: flip           |
-----------------------

Pages: 1 ... 8 9 [10] 11 12 ... 16