Author Topic: ScriptBasic Windows 32  (Read 1020 times)

Offline John

  • Forum Support / SB Dev
  • Posts: 2987
    • ScriptBasic Open Source Project
ScriptBasic Windows 32
« on: May 06, 2020, 10:24:07 AM »
I'm in the process of building a new ScriptBasic Windows 32 release using TDM-GCC-32 9.20 and an enhanced makefile AIR initially created. I have eliminated scriba.exe and created sbc.exe (console) and sbw.exe (Windows) which both support Windows styles if running IUP forms or VB6 OCX forms.

I'm working on porting GMP3, MXML and the new JSON extension modules to Windows. DLLC will also be included. I will be using the Inno installer for the release. I will be setting up a new project in the sandbox for sbwin-dev.

I hope to include a set of examples showing how to use each of the extension modules.

I had the opportunity to work with Postgres SQL with a project I'm working on with a client. I really like the DB Server and would like to update the existing PSQL extension module to work with the current release. I'm not planning on including it in this next release but will offer it as an addon when updated and tested.
« Last Edit: May 06, 2020, 10:43:10 AM by John »

Offline John

  • Forum Support / SB Dev
  • Posts: 2987
    • ScriptBasic Open Source Project
Re: ScriptBasic Windows 32
« Reply #1 on: May 06, 2020, 01:52:36 PM »
GMP
ŤArithmetic without limitationsť


I was able to get the gmp3 (large number library) working on Windows 10.

GMP3 Include
Code: Script BASIC
  1. module gmp3
  2.  
  3. declare sub     ::init     alias "init"     lib "gmp3"
  4. declare sub     ::init_set alias "init_set" lib "gmp3"
  5. declare sub     ::mul      alias "mul"      lib "gmp3"
  6. declare sub     ::mul_si   alias "mul_si"   lib "gmp3"
  7. declare sub     ::add      alias "add"      lib "gmp3"
  8. declare sub     ::sub      alias "sub"      lib "gmp3"
  9. declare sub     ::divide   alias "divide"   lib "gmp3"
  10.  
  11. end module
  12.  


Code: Script BASIC
  1. DECLARE SUB BI_ADD  ALIAS  "add"     LIB "gmp3"
  2. DECLARE SUB BI_SUB  ALIAS  "sub"     LIB "gmp3"
  3. DECLARE SUB BI_MUL  ALIAS  "mul"     LIB "gmp3"
  4. DECLARE SUB BI_DIV  ALIAS  "divide"  LIB "gmp3"
  5.  
  6. a = "10000000000"
  7. b = "9999999999"
  8.  
  9. PRINT "ADD: ", BI_ADD(a,b),"\n"
  10. PRINT "SUB: ", BI_SUB(a,b),"\n"
  11. PRINT "MUL: ", BI_MUL(a,b),"\n"
  12. PRINT "DIV: ", BI_DIV(a,2),"\n"
  13.  


C:\ScriptBASIC\examples>sbc gmp3test.sb
ADD: 19999999999
SUB: 1
MUL: 99999999990000000000
DIV: 5000000000

C:\ScriptBASIC\examples>


ScriptBasic supports large strings as well native.

Code: Script BASIC
  1. a = STRING(1234567890,CHR(0))
  2.            
  3. PRINT LEN(a),"\n"
  4.  


C:\ScriptBASIC\examples>sbc bigstr.sb
1234567890

C:\ScriptBASIC\examples>

« Last Edit: May 15, 2020, 10:12:37 PM by John »

Offline John

  • Forum Support / SB Dev
  • Posts: 2987
    • ScriptBasic Open Source Project
Re: ScriptBasic Windows 32
« Reply #2 on: May 06, 2020, 07:17:55 PM »
I was able to get the json extension module AIR created for Linux working on Windows 10.

JSON Include
Code: Script BASIC
  1. module json
  2.  
  3. ' FUNCTION DECLARATIONS
  4. declare sub     ::loadfile alias "loadfile" lib "json"
  5. declare sub     ::loadstr  alias "loadstr"  lib "json"
  6. declare sub     ::save     alias "save"     lib "json"
  7. declare sub     ::count    alias "count"    lib "json"
  8. declare sub     ::object   alias "object"   lib "json"
  9. declare sub     ::get      alias "get"      lib "json"
  10. declare sub     ::new      alias "new"      lib "json"
  11. declare sub     ::settext  alias "settext"  lib "json"
  12. declare sub     ::setnum   alias "setnum"   lib "json"
  13.  
  14. end module
  15.  


Code: Script BASIC
  1. ' SB JSON Create Entries
  2.  
  3. import json.sbi
  4.  
  5. root = json::New()
  6. json::SetText(root,"client1.name","Joe Blow")
  7. json::SetNum(root,"client1.age", 56)
  8. json::SetText(root,"client1.address.city","Tarrytown")
  9. json::SetText(root,"client1.address.state","NY")
  10. json::SetText(root,"client1.address.zip","10891")
  11.  
  12. json::SetText(root,"client2.name","John Smith")
  13. json::SetNum(root,"client2.age",86)
  14. json::SetText(root,"client2.address.city","Cupertino")
  15. json::SetText(root,"client2.address.state","CA")
  16. json::SetText(root,"client2.address.zip","N/A")
  17. json::Save("root.json")
  18.  

Output
Code: Text
  1. {
  2.     "client1": {
  3.         "name": "Joe Blow",
  4.         "age": 56,
  5.         "address": {
  6.             "city": "Tarrytown",
  7.             "state": "NY",
  8.             "zip": "10891"
  9.         }
  10.     },
  11.     "client2": {
  12.         "name": "John Smith",
  13.         "age": 86,
  14.         "address": {
  15.             "city": "Cupertino",
  16.             "state": "CA",
  17.             "zip": "N\/A"
  18.         }
  19.     }
  20. }
  21.  

Parse the above generated root.json file.

Code: Script BASIC
  1. ' SB READ IN CREATED JSON
  2.  
  3. import json.sbi
  4.  
  5. jObject = json::loadfile("root.json")
  6. for i = 0 to json::count(jObject)-1
  7.     obj = json::object(jObject,i)
  8.     print string(40,"-"),"\n"
  9.     print json::Get(obj,"name"),"\n"
  10.     print json::Get(obj,"age"),"\n"
  11.     print json::Get(obj,"address.city"),"\n"
  12.     print json::Get(obj,"address.state"),"\n"
  13.     print json::Get(obj,"address.zip"),"\n"
  14. next
  15. print string(40,"-"),"\n"
  16.  

Output

C:\ScriptBASIC\examples>sbc parse.sb
----------------------------------------
Joe Blow
56
Tarrytown
NY
10891
----------------------------------------
John Smith
86
Cupertino
CA
N/A
----------------------------------------

C:\ScriptBASIC\examples>

« Last Edit: May 15, 2020, 09:21:23 PM by John »

Offline John

  • Forum Support / SB Dev
  • Posts: 2987
    • ScriptBasic Open Source Project
Re: ScriptBasic Windows 32
« Reply #3 on: May 07, 2020, 04:59:42 PM »


This is the Mini XML (mxml) library static linked to the extension  module. AIR's latest version.

MXML Include
Code: Script BASIC
  1. module mxml
  2.  
  3. declare sub     ::LoadDoc       alias "LoadDoc"       lib "mxml"
  4. declare sub     ::GetNext       alias "GetNext"       lib "mxml"
  5. declare sub     ::GetChild      alias "GetChild"      lib "mxml"
  6. declare sub     ::GetNodeValue  alias "GetNodeValue"  lib "mxml"
  7. declare sub     ::GetNode       alias "GetNode"       lib "mxml"
  8. declare sub     ::SaveDoc       alias "SaveDoc"       lib "mxml"
  9. declare sub     ::NewDoc        alias "NewDoc"        lib "mxml"
  10. declare sub     ::GetProperty   alias "GetProperty"   lib "mxml"
  11. declare sub     ::FreeDoc       alias "FreeDoc"       lib "mxml"
  12.  
  13. end module
  14.  


Code: Script BASIC
  1. include mxml.sbi
  2.  
  3. filename = "mxml_demo.xml"
  4.  
  5. doc = mxml::LoadDoc(filename)
  6.  
  7. node =  mxml::GetNode(doc,"/stufflist/stuff_test")
  8. if node then print "Test1: ", mxml::GetNodeValue(node),"\n"
  9.  
  10. node =  mxml::GetNode(doc,"/stufflist/stuff_test2")
  11. if (node) then print "Test2: ", mxml::GetNodeValue(node),"\n\n"
  12.  
  13.  
  14. node = mxml::GetNode(doc,"/stufflist/stuff_test3/painting/img")
  15. if node then
  16.         print "Image: ", mxml::GetProperty(node,"src"), "\n"
  17.         print "Alt Image: ", mxml::GetProperty(node,"alt"), "\n\n"
  18. endif
  19.  
  20.  
  21. node = mxml::GetNode(doc,"/stufflist/books")
  22. child = mxml::GetChild(node)
  23.  
  24. while child
  25.         node = mxml::GetNode(child,"id")
  26.         if node then print "ID = ", mxml::GetNodeValue(node),"\n"
  27.         node = mxml::GetNode(child,"name")
  28.         if node then print "Name = ", mxml::GetNodeValue(node),"\n"
  29.  
  30.         child = mxml::GetNext(child)
  31. wend
  32.  
  33.  
  34. if doc then mxml::FreeDoc(doc)
  35.  

mxml_demo.xml
Code: XML
  1. <?xml version="1.0" encoding="UTF-8" ?>
  2.  
  3.  
  4. <stufflist>
  5.         <stuff_test>This is a test!</stuff_test>
  6.         <stuff_test2>And this is another test!</stuff_test2>
  7.         <stuff_test3>
  8.                 <painting>
  9.                         <img src="madonna.jpg" alt='Foligno Madonna, by Raphael'/>
  10.                         <caption>This is Raphael's "Foligno" Madonna, painted in
  11.                                 <date>1511</date>.
  12.                         </caption>
  13.                 </painting>
  14.         </stuff_test3>
  15.         <books>
  16.     <book>
  17.         <id>1</id>
  18.         <name>Hello, world!</name>
  19.     </book>
  20.     <book>
  21.         <id>2</id>
  22.         <name>Hello, China!</name>
  23.     </book>
  24.         </books>
  25. </stufflist>
  26.  

Output

C:\ScriptBASIC\examples>sbc mxml_demo.sb
Test1: This is a test!
Test2: And this is another test!

Image: madonna.jpg
Alt Image: Foligno Madonna, by Raphael

ID = 1
Name = Hello, world!
ID = 2
Name = Hello, China!

C:\ScriptBASIC\examples>

« Last Edit: May 15, 2020, 09:57:39 PM by John »

Offline John

  • Forum Support / SB Dev
  • Posts: 2987
    • ScriptBasic Open Source Project
Re: ScriptBasic Windows 32
« Reply #4 on: May 07, 2020, 10:58:01 PM »
DLLC is an extension module created by Charles Pegge in Oxygen Basic which he is the author of. Oxygen Basic is a JIT BASIC (like) compiler that generates ASM source. O2 is written in itself.

The DLLC extension module provides the following features.

  • Dynamic FF! definition and calling of DLL libraries.
  • Access and define C structures.
  • Access, create and translate OLE strings (BSTR) and wide strings (unicode)
  • Dynamically create virtual (DLL) functions from ScriptBasic with O2 JIT compiler.
  • Low level COM / GUID  functions.

I plan to demonstrate a few of DLLC's features in upcoming posts to this thread.

dllc.sbi
Code: Script BASIC
  1. '  supported types:
  2. '  b bool
  3. '  c char
  4. '  d double precision float
  5. '  f float
  6. '  h handle
  7. '  i integer (32bit)
  8. '  p pointer
  9. '  q quad (64bit) integer
  10. '  s short (16bit) integer
  11. '  z null terminated string
  12.  
  13. '  supported calling conventions
  14. '  cdecl
  15. '  stdcall
  16.  
  17. '  '*' signifies pass variable by reference, otherwise by value
  18.  
  19.  
  20.   'DIAGNOSTICS  
  21.  declare sub dllhook alias "dllhook" lib "DLLC"
  22.   declare sub dllshow alias "dllshow" lib "DLLC"
  23.   declare sub dllreco alias "dllreco" lib "DLLC"
  24.   declare sub dllsecs alias "dllsecs" lib "DLLC"
  25.   declare sub dllerrc alias "dllerrc" lib "DLLC"
  26.   declare sub dllerrs alias "dllerrs" lib "DLLC"
  27.  
  28.  'CONSOLE
  29.  declare sub dllcnsl alias "dllcnsl" lib "DLLC"
  30.   declare sub dlllnpt alias "dlllnpt" lib "DLLC"
  31.   declare sub dllprnt alias "dllprnt" lib "DLLC"
  32.   declare sub dllcmnd alias "dllcmnd" lib "DLLC"
  33.   'DLL LINKAGE
  34.  declare sub dllfile alias "dllfile" lib "DLLC"
  35.   declare sub dllproc alias "dllproc" lib "DLLC"
  36.   'DLL CALLS
  37.  declare sub dllmeth alias "dllmeth" lib "DLLC"
  38.   declare sub dllcall alias "dllcall" lib "DLLC"
  39.   declare sub dllcald alias "dllcald" lib "DLLC"
  40.   declare sub dllcalt alias "dllcalt" lib "DLLC"
  41.   declare sub dllcobj alias "dllcobj" lib "DLLC"
  42.   declare sub dllcobt alias "dllcobt" lib "DLLC"
  43.   declare sub dllclbk alias "dllclbk" lib "DLLC"
  44.   'SBCALLS
  45.  declare sub dllprog alias "dllprog" lib "dllc"
  46.   declare sub dllendp alias "dllendp" lib "dllc"
  47.   declare sub dlltran alias "dlltran" lib "DLLC"
  48.   'CHANNELS AND THREADS
  49.  declare sub dllidat alias "dllidat" lib "DLLC"
  50.   declare sub dllodat alias "dllodat" lib "DLLC"
  51.   declare sub dllclos alias "dllclos" lib "DLLC"
  52.   declare sub dllwait alias "dllwait" lib "DLLC"
  53.   'DATA
  54.  declare sub dllsptr alias "dllsptr" lib "DLLC"
  55.   declare sub dlltype alias "dlltype" lib "DLLC"
  56.   declare sub dlldimv alias "dlldimv" lib "DLLC"
  57.   declare sub dllfill alias "dllfill" lib "DLLC"
  58.   declare sub dllgetm alias "dllgetm" lib "DLLC"
  59.   declare sub dllputm alias "dllputm" lib "DLLC"
  60.   declare sub dllptrm alias "dllptrm" lib "DLLC"
  61.   declare sub dllfrem alias "dllfrem" lib "DLLC"
  62.   'STRINGS / GUIDS
  63.  declare sub dlldelo alias "dlldelo" lib "DLLC"
  64.   declare sub dllostr alias "dllostr" lib "DLLC"
  65.   declare sub dllzstr alias "dllzstr" lib "DLLC"
  66.   declare sub dllastr alias "dllastr" lib "DLLC"
  67.   declare sub dllwstr alias "dllwstr" lib "DLLC"
  68.   declare sub dllcast alias "dllcast" lib "DLLC"
  69.   declare sub dllguid alias "dllguid" lib "DLLC"
  70.  
  71. '  current limits:
  72. '  ===============
  73.  
  74. '  32   parameters per procedure
  75. '  2048 entities (total of libs+procs+types+vars)
  76.  
« Last Edit: May 07, 2020, 11:00:44 PM by John »

Offline John

  • Forum Support / SB Dev
  • Posts: 2987
    • ScriptBasic Open Source Project
Re: ScriptBasic Windows 32
« Reply #5 on: May 08, 2020, 06:28:32 PM »
This is an example of a dynamic virtual DLL function using DLLC. This example also shows the dynamic FFI definition and call feature.

FYI: ScriptBasic can also run a a DLL resource. Your application could embed ScriptBasic which gives you a JIT BASIC compiler as well.  8)

Code: Script BASIC
  1. ' Virtual DLL Functions
  2.  
  3. include dllc.sbi
  4.  
  5. oxy=dllfile("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.  
  17. src="""
  18. extern
  19.  
  20. function funA(char* s) as char*
  21.  static char c[256]
  22.  c="Hello "+s
  23.  return c
  24. end function
  25.  
  26. function funB(char*s) as char*
  27.  static char c[256]
  28.  c="Goodbye "+s
  29.  return c
  30. end function
  31.  
  32. function reverse(char*s)
  33.  byte b at (strptr s)
  34.  sys i,d,e,j,t
  35.  e=len s
  36.  d=e>>1
  37.  for i=1 to d
  38.    j=e-i+1
  39.    t=b[i] : b[i]=b[j] : b[j]=t
  40.  next
  41. end function
  42.  
  43. sub finish()
  44.  terminate
  45. end sub
  46.  
  47. function link(sys n) as sys
  48.  select n
  49.    case 0 : return @finish
  50.    case 1 : return @funA
  51.    case 2 : return @funB
  52.    case 3 : return @reverse
  53.  end select
  54. end function
  55.  
  56. end extern
  57.  
  58. addr link
  59. """
  60.  
  61.  
  62. function oxygen(src)
  63.   dllcall o2_basic,src
  64.   if (dllcall(o2_errno)<>0) then
  65.     dllprnt dllcall(o2_error)
  66.     a=0
  67.   else
  68.     a=dllcall(o2_exec,0)
  69.   end if
  70.   oxygen=a
  71. end function
  72.  
  73. a=oxygen(src)
  74.  
  75. if (a<>0) then
  76.   Hello   = dllproc(a,"Hello   c*=(c*value) ", dllcald(a,1) )
  77.   Goodbye = dllproc(a,"Goodbye c*=(c*value) ", dllcald(a,2) )
  78.   Reverse = dllproc(a,"Reverse    (c*value) ", dllcald(a,3) )
  79.   Finish  = dllproc(a,"Finish     ()        ", dllcald(a,0) )
  80.  
  81.   print dllcall(hello,"John") & "\n"
  82.   print dllcall(Goodbye,"John") & "\n"
  83.   s="abcdef"
  84.   print "Reversed " & s & " = "
  85.   dllcall(Reverse,s)
  86.   print s & "\n"
  87.   dllcall(Finish)
  88. end if
  89.  
  90. dllfile
  91.  


C:\ScriptBASIC\examples>sbc dllco2_e.sb
Hello John
Goodbye John
Reversed abcdef = fedcba

C:\ScriptBASIC\examples>

« Last Edit: May 08, 2020, 10:41:30 PM by John »

Offline John

  • Forum Support / SB Dev
  • Posts: 2987
    • ScriptBasic Open Source Project
Re: ScriptBasic Windows 32
« Reply #6 on: May 09, 2020, 05:31:26 PM »
This is an example of using DLLC to call ASM based functions and methods.

Code: Script BASIC
  1.  
  2. include dllc.sbi
  3.  
  4.   oxy=dllfile("oxygen.dll")
  5.  
  6.   o2_basic = dllproc( oxy, "o2_basic i =(c*source) " )
  7.   o2_exec  = dllproc( oxy, "o2_exec  i =(i call)   " )
  8.   o2_error = dllproc( oxy, "o2_error c*=()         " )
  9.   o2_errno = dllproc( oxy, "o2_errno i =()         " )
  10.   o2_len   = dllproc( oxy, "o2_len   i =()         " )
  11.   o2_mode  = dllproc( oxy, "o2_mode     (i mode)   " )
  12.  
  13.   dllcall o2_mode,1
  14.  
  15.   function oxygen(src)
  16.   dllcall o2_basic,src
  17.   if (dllcall(o2_errno)<>0) then
  18.     dllprnt dllcall(o2_error)
  19.     a=0
  20.     line input q
  21.   else
  22.     a=dllcall(o2_exec,0)
  23.   end if
  24.   oxygen=a
  25.   end function
  26.  
  27.  
  28. ' ==============================
  29.  src="""
  30.  extern
  31.  
  32.  function reverse(char*s)
  33.  ========================
  34.  addr ecx,s
  35.  mov edx,0
  36. .rlen
  37.  mov al,[ecx]
  38.  cmp al,0
  39.  jz xlen
  40.  inc edx
  41.  inc ecx
  42.  jmp rlen
  43. .xlen
  44.  ;
  45.  addr ecx,s
  46.  add  edx,ecx
  47.  dec ecx
  48.  ;
  49. .rswap
  50.  inc ecx
  51.  dec edx
  52.  cmp edx,ecx
  53.  jle xswap
  54.  mov al,[ecx]
  55.  mov ah,[edx]
  56.  mov [ecx],ah
  57.  mov [edx],al
  58.  jmp rswap
  59. .xswap
  60.  end function
  61.  
  62.  function getword(char*ss,sys*b) as char*
  63.  '=======================================
  64.  sys a
  65.  if not @ss then return ""
  66.  if b=0 then b=1
  67.  byte s at @ss
  68.  byte c,d
  69.  sys bb,bc
  70.  static char z[128]
  71.  a=0
  72.  bb=b
  73.  '
  74.  'SKIP LEADING SPACES
  75.  do
  76.    c=s[b]
  77.    select c
  78.    case 33 to 255,0 : exit do 'SKIP SPACE
  79.    end select
  80.    b++
  81.  end do
  82.  bc=b
  83.  '
  84.  'QUOTES
  85.  select c
  86.  case 34,39
  87.   do
  88.      b+=1
  89.      d=s[b]
  90.      if d=0 or d=c then b+=1 : jmp fwd done
  91.   end do
  92.  end select
  93.  'WORDS AND SYMBOLS
  94.  do
  95.    c=s[b]
  96.    select c
  97.    case 0 to 32     : exit do
  98.    case 35          : jmp fwd more
  99.    case 33  to 47   : 'symbols
  100.    case 48  to 57   : jmp fwd more 'numbers
  101.    case 58  to 64   : 'symbols
  102.    case 65  to 90   : jmp fwd more 'capitals
  103.    case 95          : jmp fwd more 'underscore
  104.    case 91  to 96   : 'symbols
  105.    case 97  to 122  : jmp fwd more 'lower case
  106.    case 123 to 127  : 'symbols
  107.    case 128 to 255  : jmp fwd more 'higher ascii
  108.    end select
  109.    '
  110.    if b=bc then b++
  111.    exit do
  112.    '
  113.    more:
  114.    b++
  115.  end do
  116.  '
  117.  done:
  118.  '
  119.  if b>bb then
  120.    z=mid ss,bc,b-bc
  121.  else
  122.    z=""
  123.  end if
  124.  return z
  125.  
  126.  end function
  127.  
  128.  
  129. =================
  130. Class AlignedText
  131. =================
  132.  
  133. indexbase 1
  134.  
  135. string  buf, bufo, pr, cr, tab, jus, dlm
  136. sys     Cols, Rows, ColWidth[0x100], TotWidth, ColPad, ld
  137.  
  138. method SetText(char*s)
  139. ======================
  140. if not len cr then cr=chr(13,10)
  141. tab=chr(9)
  142. if not len jus then jus=string 200,"L"
  143. buf=s
  144. measure
  145. end method
  146.  
  147.  
  148. method measure()
  149. ================
  150. sys a, b, wa, wb, cm, c, cw, i
  151. a=1 : b=1
  152. Cols=0 : Rows=0 : ColPad=3
  153. ld=len dlm
  154. if not ld then dlm="," : ld=1 'default to comma
  155. do
  156.  wb=b
  157.  a=instr b,buf,cr
  158.  if a=0 then exit do
  159.  cm=0
  160.  c++
  161.  do
  162.    wa=instr wb,buf,dlm
  163.    if wa=0 or wa>a then exit do
  164.    cm++
  165.    if cm>cols then cols=cm
  166.    cw=wa-wb
  167.    if cw > ColWidth[cm] then ColWidth[cm]=cw
  168.    wb=wa+ld
  169.  end do
  170.  b=a+len cr
  171. end do
  172. rows=c
  173. '
  174. c=0
  175. for i=1 to cols
  176.  ColWidth[ i ]+=ColPad
  177.  c+=ColWidth[ i ]
  178. next
  179. TotWidth=c+len cr
  180. 'print ShowMetrics
  181. end method
  182.  
  183.  
  184. method ShowMetrics() as char*
  185. =============================
  186. sys i
  187. pr="METRICS:" cr cr
  188. pr+=rows tab cols tab totwidth cr cr
  189. pr+="column" tab "spacing" cr
  190. for i=1 to cols
  191.  pr+=i tab ColWidth[ i ] cr
  192. next
  193. return pr
  194. end method
  195.  
  196.  
  197. method justify(char*j)
  198. ======================
  199. jus=j
  200. end method
  201.  
  202. method delimiter(char*j)
  203. ========================
  204. dlm=j
  205. end method
  206.  
  207. method endofline(char*j)
  208. ========================
  209. cr=j
  210. end method
  211.  
  212.  
  213. method layout() as char*
  214. ========================
  215. sys a, b, wa, wb, wl, cm, lpos, cpos, p
  216. bufo=space Rows*TotWidth
  217. a=1 : b=1
  218. do
  219.  wb=b
  220.  a=instr(b,buf,cr)
  221.  if a=0 then exit do
  222.  cm=0
  223.  cpos=1
  224.  do
  225.    wa=instr(wb,buf,dlm)
  226.    if wa=0 or wa>a then exit do
  227.    '
  228.    cm++
  229.    '
  230.    'JUSTIFICATION
  231.    '
  232.    wl=wa-wb
  233.    p=lpos+cpos 'default "L" LEFT ALIGN
  234.    '
  235.    select case asc(jus,cm)
  236.      case "R" : p=lpos+cpos+ColWidth[cm]-wl-Colpad
  237.      case "C" : p=lpos+cpos+( ColWidth[cm]-wl-Colpad )*.5
  238.    end select
  239.    '
  240.    mid bufo,p, mid buf,wb,wl
  241.    cpos+=colwidth[cm]
  242.    wb=wa+ld
  243.  end do
  244.  b=a+len cr
  245.  lpos+=TotWidth
  246.  if lpos<len(bufo) then mid bufo,lpos-1,cr
  247. end do
  248. return bufo
  249. end method
  250. '
  251. end class
  252.  
  253. '#recordof AlignedText
  254.  
  255.  AlignedText atxt
  256.  
  257.  function AlignText(char *in,*ju,*dl,*cr) as char*
  258.  =================================================
  259.  atxt.justify         ju
  260.  atxt.delimiter       dl
  261.  atxt.endofline       cr
  262.  atxt.SetText         in
  263.  return               atxt.layout
  264.  end function
  265.  
  266.  
  267.  sub finish()
  268.  ============
  269.  terminate
  270.  end sub
  271.  
  272.  
  273.  
  274.  function link(sys n) as sys
  275.  ===========================
  276.  select n
  277.  case 0 : return @finish
  278.  case 1 : return @reverse
  279.  case 2 : return @getword
  280.  case 3 : return @aligntext
  281.  end select
  282.  end function
  283.  
  284.  end extern
  285.  
  286.  
  287.  addr link
  288.  """
  289. ' ==============================
  290.  
  291.   '
  292.  a=oxygen(src)
  293.   '
  294.  if (a<>0) then
  295.   '
  296. ' ==============================
  297.  '
  298.  Finish    = dllproc(a,"Finish     ()        ", dllcald(a,0) )
  299.   Reverse   = dllproc(a,"Reverse    (c*value) ", dllcald(a,1) )
  300.   GetWord   = dllproc(a,"GetWord c*=(c*value,i*index) ", dllcald(a,2) )
  301.   AlignText = dllproc(a,"AlignText c*=(c*in,c*jus,c*dlm,c*cr) ", dllcald(a,3) )
  302.   '
  303. ' ==============================
  304.  '
  305.  s="abcdef1234567"
  306.   print "Reversed " & s & " = "
  307.   dllcall(Reverse,s)
  308.   print s & "\n"
  309.   '
  310.  '
  311.  s="one two three"
  312.   i=1
  313.   dllcall(GetWord,s,i)
  314.   print dllcall(GetWord,s,i) & "\n"
  315.   dllcall(GetWord,s,i)
  316.  
  317.  
  318. s="""
  319. Given;;a;;text;;file;;of;;many;;lines,;;where;;fields;;within;;a;;line;;
  320. are;;delineated;;by;;a;;single;;'dollar';;character,;;write;;a;;program
  321. that;;aligns;;each;;column;;of;;fields;;by;;ensuring;;that;;words;;in;;each;;
  322. column;;are;;separated;;by;;at;;least;;one;;space.
  323. Further,;;allow;;for;;each;;word;;in;;a;;column;;to;;be;;either;;left;;
  324. justified,;;right;;justified,;;or;;center;;justified;;within;;its;;column.
  325. """
  326.  
  327.   lf="\n" & chr(0)
  328.   dl=";;"
  329.   fm="LLLLCCCRRRRR"
  330.   ' t=dllcall(AlignText,s,fm,dl,lf )
  331.  t=dllcall(AlignText,s,"LLLLCCCRRRRR",";;","\n" & chr(0) )
  332.   print t & "\n"
  333.  
  334.   dllcall(Finish)
  335.   '
  336.  end if
  337.   dllfile
  338.  

Output

C:\ScriptBASIC\examples>sbc dllco2asm.sb
Reversed abcdef1234567 = 7654321fedcba
two

 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\examples>


Offline John

  • Forum Support / SB Dev
  • Posts: 2987
    • ScriptBasic Open Source Project
Re: ScriptBasic Windows 32
« Reply #7 on: May 09, 2020, 09:48:51 PM »
This will be my last DLLC post. This example shows other features of DLLC like COM, BSTR, wide string, structures and more.

Code: Script BASIC
  1. ' PROPOSED ALTERNATIVE TO DYC
  2. ' supporting variables passed by reference
  3. ' supporting compound types
  4. ' supporting compound variables stored in SB strings
  5.  
  6. ' supported types:
  7. ' b bool
  8. ' c char
  9. ' d double precision float
  10. ' f float
  11. ' h handle
  12. ' i integer (32bit)
  13. ' p pointer
  14. ' s short (16bit) integer
  15. ' z null terminated string
  16.  
  17. ' supported calling conventions
  18. ' cdecl
  19. ' stdcall
  20.  
  21. ' * signifies pass variable by reference, otherwise by value
  22.  
  23. ' SB INTERFACE
  24.  
  25.   declare sub dllerrc alias "dllerrc" lib "DLLC"
  26.   declare sub dllerrs alias "dllerrs" lib "DLLC"
  27.   declare sub dllreco alias "dllreco" lib "DLLC"
  28.   declare sub dllfile alias "dllfile" lib "DLLC"
  29.   declare sub dllproc alias "dllproc" lib "DLLC"
  30.   declare sub dllprog alias "dllprog" lib "dllc"
  31.   declare sub dllendp alias "dllendp" lib "dllc"
  32.   declare sub dllmeth alias "dllmeth" lib "DLLC"
  33.   declare sub dllcall alias "dllcall" lib "DLLC"
  34.   declare sub dllcalt alias "dllcalt" lib "DLLC"
  35.   declare sub dllcobj alias "dllcobj" lib "DLLC"
  36.   declare sub dllcobt alias "dllcobt" lib "DLLC"
  37.   declare sub dllclbk alias "dllclbk" lib "DLLC"
  38.   declare sub dlltype alias "dlltype" lib "DLLC"
  39.   declare sub dlldimv alias "dlldimv" lib "DLLC"
  40.   declare sub dllfill alias "dllfill" lib "DLLC"
  41.   declare sub dllgetm alias "dllgetm" lib "DLLC"
  42.   declare sub dllputm alias "dllputm" lib "DLLC"
  43.   declare sub dlldelo alias "dlldelo" lib "DLLC"
  44.   declare sub dllostr alias "dllostr" lib "DLLC"
  45.   declare sub dllzstr alias "dllzstr" lib "DLLC"
  46.   declare sub dllastr alias "dllastr" lib "DLLC"
  47.   declare sub dllwstr alias "dllwstr" lib "DLLC"
  48.   declare sub dllcast alias "dllcast" lib "DLLC"
  49.   declare sub dllguid alias "dllguid" lib "DLLC"
  50.   declare sub dllsecs alias "dllsecs" lib "DLLC"
  51.   declare sub dlltran alias "dlltran" lib "DLLC"
  52.   declare sub dllclos alias "dllclos" lib "DLLC"
  53.  
  54.  
  55. 'TYPES
  56.  
  57. ' B boolean
  58. ' C character
  59. ' D double precision float
  60. ' F single precision float
  61. ' H handle
  62. ' I integer
  63. ' L long (4 byte) integer
  64. ' O bstring (as handle)
  65. ' Q quad integer (yet to be resolved)
  66. ' P pointer
  67. ' S short (2 byte) integer
  68. ' T user defined type
  69. ' Z sb zstring / SB string
  70.  
  71. ' add '*' for ptr/ passing byref
  72.  
  73. 'TITLE
  74.  
  75. print "DLLC SPEC / DEMO / TESTS:\n\n"
  76.  
  77. s=space(&h100)
  78.  
  79.  
  80. 'LOADING LIBRARIES
  81.  
  82.   mylib=dllfile("DLLCtestDLL.dll")
  83.   ole32=dllfile("ole32.dll")
  84. 'print mylib & "\n"
  85.  
  86. 'MEASURING TIME FRACTIONAL SECONDS
  87.  
  88. t1=dllsecs()
  89.  
  90. 'DECLARING PROCEDURES
  91.  
  92. stringbuf        = dllproc(mylib,"stringbuf stdcall i=(c*buf, i bufsize) " )
  93. doublebyref      = dllproc(mylib,"doublebyref (d*num)"           )
  94. longbyref        = dllproc(mylib,"longbyref (l*num)"             )
  95. returnbstring    = dllproc(mylib,"returnbstring o=()"            )
  96. rectanglearea    = dllproc(mylib,"rectanglearea i=(t*rectangle)" )
  97. showguid         = dllproc(mylib,"showguid z=(t*guidinput,t*guidinput)"      )
  98.  
  99. 'TRAP ERRORS
  100.  
  101. if dllerrc() then
  102.   print "DLLC logged errors: " & dllerrc() & "\n" & dllerrs()
  103.   goto ending
  104. end if
  105.  
  106. 'DECLARE MORE PROCEDURES FOR COM
  107.  
  108. CoInitialize     = dllproc(ole32,"CoInitialize (i)")
  109. CoUninitialize   = dllproc(ole32,"CoUninitialize (i)")
  110. CoCreateInstance = dllproc(ole32,"CoCreateInstance i=(t*ObjGuid ,i pUnkOuter,i context, t*IspGuid, i*Iface)" )
  111.  
  112. 'TRAP ERRORS
  113.  
  114. if dllerrc() then
  115.   print "DLLC logged errors: " & dllerrc() & "\n" & dllerrs()
  116.   goto ending
  117. end if
  118.  
  119.  
  120. 'COM SPEECH
  121.  
  122. VoiceObjGuid = dllguid("96749377-3391-11D2-9EE3-00C04F797396")
  123. ISpVoiceGuid = dllguid("6C44DF74-72B9-4992-A1EC-EF996E0422D4")
  124. Context      = 7
  125. pUnkOuter    = 0
  126. Voice        = 0
  127. Release      = dllmeth( 2,"Release i=()")
  128. Speak        = dllmeth(20,"Speak i=(z*pwcs,i flags,i pulstreamno)")
  129. WaitUntilDone= dllmeth(32,"WaitUntilDone i=(i)")
  130. print dllreco(speak)
  131. Text         = dllwstr("Hello Everyone!\0")
  132. hr=0
  133. dllcall(CoInitialize,0)
  134. hr=dllcall(CoCreateInstance, VoiceObjGuid, pUnkouter, Context, ISpVoiceGuid, Voice)
  135. if (hr=0) then
  136.   print "connected to voice\n\n"
  137.   print dllastr(Text) & "\n\n"
  138.   dllcobj(Voice,Speak,Text,0,0)
  139.   dllcobj(Voice,WaitUntilDone,0xFFFFFFFF)
  140.   dllcobj(Voice,Release)
  141. else
  142.   print "SAPI Error " & format("%x",hr) & "\n\n"
  143. end if
  144. dllcall(CoUninitialize)
  145.  
  146. 'TIMER
  147.  
  148. t2=dllsecs()
  149. print "Lapsed time Secs: " & t2-t1 & "\n\n"
  150.  
  151.  
  152. 'SHOW DLLC RECORDS
  153.  
  154. print dllreco(mylib) & "\n"
  155. print dllreco(stringbuf) & "\n"
  156.  
  157.  
  158. 'CREATING A COMPOUND TYPE
  159.  
  160. rectangle=dlltype("rectangle (i left,i top, i right, i bottom)")
  161. print dllreco(rectangle) & "\n"
  162.  
  163. 'CREATING A COMPOUND VARIABLE (ARRAY OF 2 UNITS)
  164.  
  165. rect=dlldimv(rectangle,2)
  166.  
  167. print "Length of rect variables record: (4+16*2) " & len(rect) & "\n"
  168.  
  169. 'ASSIGNING VALUES
  170.  
  171. dllfill(rect,10,20,30,40)
  172.  
  173. 'READING A MEMBER VALUE
  174.  
  175. w=dllgetm(rect,3)
  176. print "rect right (30) " & w & "\n"
  177.  
  178. 'WRITING A MEMBER VALUE
  179.  
  180. dllputm (rect,3,42)
  181. w=dllgetm(rect,3)
  182. print "rect right (42) " & w & "\n\n"
  183.  
  184. 'CALLING SUBS
  185.  
  186. z="Hello!" & space(100)
  187. dllcall(stringbuf,z,100)
  188. print z & "\n"
  189.  
  190. a=42
  191. dllcall(longbyref,a)
  192. print a & "\n"
  193. a=1.25
  194. dllcall(doublebyref,a)
  195. print a & "\n"
  196.  
  197.  
  198. 'CALLING FUNCTIONS
  199.  
  200. print "Rectangle Area: " & dllcall(rectanglearea,rect) & "\n"
  201. bs=dllcall(returnbstring)
  202. print "bstring handle: " & bs & "\n"
  203.  
  204. 'SB STRING / OLE STRING CONVERSIONS
  205.  
  206. z=dllzstr(bs)
  207. print z & "\n"
  208. bt=dllostr(z)
  209. print "bstring handle " & bt & "\n"
  210. y=dllzstr(bt)
  211. print y & "  (original bstring is auromatically freed) \n\n"
  212.  
  213. 'EXPLICIT DISPOSAL OF BSTRING
  214.  
  215. bs=dllostr("ABCDEF")
  216. print "new bstring: handle=" & bs & "\n"
  217. dlldelo(bs)
  218. print "dispose bstring: handle=" & bs & "\n\n"
  219.  
  220.  
  221. 'ASCII / WIDE CONVERSIONS
  222.  
  223. az="abcdef"
  224. wz=dllwstr(az)
  225. print "Wide string (6 to 12) " & len(wz) & "\n"
  226. az=dllastr(wz)
  227. print "ascii string (12 to 6) " & len(az) & "\n"
  228. print az & "\n\n"
  229.  
  230. 'GUID TEXT TO BINARY CONVERSION
  231.  
  232. gu1=dllguid("{96749377-3391-11D2-9EE3-00C04F797396}")
  233. gu2=dllguid("{6C44DF74-72B9-4992-A1EC-EF996E0422D4}")
  234.  
  235. print "GUID: " & dllcall(showguid,gu1,gu2) & "\n"
  236.  
  237. 'PAUSE TO DISPLAY RESULTS
  238. '
  239. ending:
  240.  
  241. 'FREE ALL DLLS USED BY DLLC
  242.  
  243. dllfile
  244.  

Output

C:\ScriptBASIC\examples>sbc dllcfeatures.sb
DLLC SPEC / DEMO / TESTS:

raw: Speak i=(z*pwcs,i flags,i pulstreamno)
name          Speak
metatype      4
handle        80
library       0
par count     3
par bytes     12
stack release 0

Params/Members
1  0    z
2  4    I
3  8    I
Return: I
connected to voice

Hello Everyone!

Lapsed time Secs: 2.183793

raw:
name          DLLCtestDLL.dll
metatype      1
handle        7405568
library       0
par count     0
par bytes     0
stack release 0

Params/Members
Return:

raw: stringbuf stdcall i=(c*buf, i bufsize)
name          stringbuf
metatype      2
handle        7422288
library       1
par count     2
par bytes     8
stack release 0

Params/Members
1  0    c
2  4    I
Return: I

raw: rectangle (i left,i top, i right, i bottom)
name          rectangle
metatype      3
handle        0
library       0
par count     4
par bytes     16
stack release 0

Params/Members
1  0    I
2  4    I
3  8    I
4  12   I
Return:

Length of rect variables record: (4+16*2) 48
rect right (30) 30
rect right (42) 42

greeting from stringbffuf procedure / DLLtestDLL

84
2.500000
Rectangle Area: 660
bstring handle: 9578972
This was an OLE/Bstring
bstring handle 9578972
This was an OLE/Bstring  (original bstring is auromatically freed)

new bstring: handle=9578972
dispose bstring: handle=0

Wide string (6 to 12) 12
ascii string (12 to 6) 6
abcdef

GUID: {96749377-3391-11D2-9EE3-00C04F797396}
{6C44DF74-72B9-4992-A1EC-EF996E0422D4}


C:\ScriptBASIC\examples>

Offline John

  • Forum Support / SB Dev
  • Posts: 2987
    • ScriptBasic Open Source Project
Re: ScriptBasic Windows 32
« Reply #8 on: May 10, 2020, 08:39:46 PM »
The SBT extension module adds thread support to ScriptBasic. Actually SBT is a ScriptBasic embedding DLL using ScriptBasic as the host. It is similar to the sbhttpd application server that uses C as the host and handles the web protocol and running as a Windows service.

SBT Include
Code: Script BASIC
  1. ' SBT (ScriptBasic Thread Extenstion) - Include File
  2.  
  3. DECLARE SUB SB_New ALIAS "SB_New" LIB "sbt"
  4. DECLARE SUB SB_Configure ALIAS "SB_Configure" LIB "sbt"
  5. DECLARE SUB SB_Load ALIAS "SB_Load" LIB "sbt"
  6. DECLARE SUB SB_LoadStr ALIAS "SB_LoadStr" LIB "sbt"
  7. DECLARE SUB SB_Run ALIAS "SB_Run" LIB "sbt"
  8. DECLARE SUB SB_NoRun ALIAS "SB_NoRun" LIB "sbt"
  9. DECLARE SUB SB_ThreadStart ALIAS "SB_ThreadStart" LIB "sbt"
  10. DECLARE SUB SB_ThreadEnd ALIAS "SB_ThreadEnd" LIB "sbt"
  11. DECLARE SUB SB_GetVar ALIAS "SB_GetVar" LIB "sbt"
  12. DECLARE SUB SB_SetUndef ALIAS "SB_SetUndef" LIB "sbt"
  13. DECLARE SUB SB_SetInt ALIAS "SB_SetInt" LIB "sbt"
  14. DECLARE SUB SB_SetDbl ALIAS "SB_SetDbl" LIB "sbt"
  15. DECLARE SUB SB_SetStr ALIAS "SB_SetStr" LIB "sbt"
  16. DECLARE SUB SB_ResetVars ALIAS "SB_ResetVars" LIB "sbt"
  17. DECLARE SUB SB_msSleep ALIAS "SB_msSleep" LIB "sbt"
  18. DECLARE SUB SB_CallSub ALIAS "SB_CallSub" LIB "sbt"
  19. DECLARE SUB SB_CallSubArgs ALIAS "SB_CallSubArgs" LIB "sbt"
  20. DECLARE SUB SB_Destroy ALIAS "SB_Destroy" LIB "sbt"
  21.  
 
This example shows starting a ScriptBasic (asynchronous) thread, calling it's function and get/set variables. 

Code: Script BASIC
  1. ' SBT Demo
  2.  
  3. IMPORT sbt.sbi
  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. ' Call function before running script
  23. funcrtn = SB_CallSubArgs(sb,"main::prtvars", 123, 1.23, "One, Two, Three")
  24. PRINT funcrtn,"\n"
  25. ' Run script initializing globals
  26. SB_Run sb, ""
  27. ' Assign variables values
  28. SB_SetInt sb, "main::a", 321
  29. SB_SetDbl sb, "main::b", 32.1
  30. SB_SetStr sb, "main::c", "Three,Two,One" & CHR(0)
  31. ' Call function again with variables assigned in the previous step
  32. SB_CallSubArgs sb, "main::prtvars", _
  33.           SB_GetVar(sb, "main::a"), _
  34.           SB_GetVar(sb, "main::b"), _
  35.           SB_GetVar(sb, "main::c")
  36. SB_Destroy sb
  37.  


C:\ScriptBASIC\examples>sbc sbt_demo.sb
123
1.23
One, Two, Three
Function Return
321
32.1
Three,Two,One

C:\ScriptBASIC\examples>


This is an independent synchronous thread example running a FOR/NEXT loop in main and a thread.

sbt_main
Code: Script BASIC
  1. ' SBT Main
  2.  
  3. IMPORT sbt.sbi
  4.  
  5. SB_ThreadStart("sbt_thread.sb", "","C:/Windows/SCRIBA.INI")
  6.  
  7. FOR x = 1 TO 10
  8.   PRINT "M:",x,"\n"
  9.   sb_msSleep(20)
  10. NEXT
  11.  

Thread
Code: Script BASIC
  1. ' SBT Thread
  2.  
  3. IMPORT sbt.sbi
  4.  
  5. FOR x = 1 TO 10
  6.   PRINT "T:",x,"\n"
  7.   SB_msSleep(20)
  8. NEXT
  9.  
  10. SB_ThreadEnd
  11.  

Output

C:\ScriptBASIC\examples>sbc sbt_main.sb
T:1
M:1
T:2
M:2
T:3
M:3
T:4
M:4
T:5
M:5
T:6
M:6
T:7
M:7
T:8
M:8
T:9
M:9
T:10
M:10

C:\ScriptBASIC\examples>


« Last Edit: May 10, 2020, 08:41:39 PM by John »

Offline John

  • Forum Support / SB Dev
  • Posts: 2987
    • ScriptBasic Open Source Project
Re: ScriptBasic Windows 32
« Reply #9 on: May 11, 2020, 03:55:20 PM »


IUP is a cross platform GUI library that is easy to use and well supported. The librrary includes form, canvas and image control features.

IUP Home Page

IUP Include
Code: Script BASIC
  1. MODULE Iup
  2.  
  3. ' System
  4. DECLARE SUB ::Open ALIAS "PuiOpen" LIB "pui"
  5. DECLARE SUB ::Close ALIAS "PuiClose" LIB "pui"
  6. DECLARE SUB ::Version ALIAS "PuiVersion" LIB "pui"
  7. DECLARE SUB ::Load ALIAS "PuiLoad" LIB "pui"
  8. DECLARE SUB ::Loadbuffer ALIAS "PuiLoadbuffer" LIB "pui"
  9. DECLARE SUB ::SetLanguage ALIAS "PuiSetLanguage" LIB "pui"
  10. DECLARE SUB ::GetLanguage ALIAS "PuiGetLanguage" LIB "pui"
  11. ' Attribute
  12. DECLARE SUB ::StoreAttribute ALIAS "PuiStoreAttribute" LIB "pui"
  13. DECLARE SUB ::StoreAttributeId ALIAS "PuiStoreAttributeId" LIB "pui"
  14. DECLARE SUB ::SetAttribute ALIAS "PuiSetAttribute" LIB "pui"
  15. DECLARE SUB ::SetAttributeId ALIAS "PuiSetAttributeId" LIB "pui"
  16. DECLARE SUB ::SetfAttribute ALIAS "PuiSetfAttribute" LIB "pui"
  17. DECLARE SUB ::SetfAttributeId ALIAS "PuiSetfAttributeId" LIB "pui"
  18. DECLARE SUB ::SetfAttributeId2 ALIAS "PuiSetfAttributeId2" LIB "pui"
  19. DECLARE SUB ::SetAttributes ALIAS "PuiSetAttributes" LIB "pui"
  20. DECLARE SUB ::ResetAttribute ALIAS "PuiResetAttribute" LIB "pui"
  21. DECLARE SUB ::SetAtt ALIAS "PuiSetAtt" LIB "pui"
  22. DECLARE SUB ::SetAttributeHandle ALIAS "PuiSetAttributeHandle" LIB "pui"
  23. DECLARE SUB ::GetAttributeHandle ALIAS "PuiGetAttributeHandle" LIB "pui"
  24. DECLARE SUB ::GetAttribute ALIAS "PuiGetAttribute" LIB "pui"
  25. DECLARE SUB ::GetAttributeId ALIAS "PuiGetAttributeId" LIB "pui"
  26. DECLARE SUB ::GetAllAttributes ALIAS "PuiGetAllAttributes" LIB "pui"
  27. DECLARE SUB ::GetAttributes ALIAS "PuiGetAttributes" LIB "pui"
  28. DECLARE SUB ::GetFloat ALIAS "PuiGetFloat" LIB "pui"
  29. DECLARE SUB ::GetFloatId ALIAS "PuiGetFloatId" LIB "pui"
  30. DECLARE SUB ::GetFloatId2 ALIAS "PuiGetFloatId2" LIB "pui"
  31. DECLARE SUB ::GetInt ALIAS "PuiGetInt" LIB "pui"
  32. DECLARE SUB ::GetInt2 ALIAS "PuiGetInt2" LIB "pui"
  33. DECLARE SUB ::GetIntInt ALIAS "PuiGetIntInt" LIB "pui"
  34. DECLARE SUB ::GetIntId ALIAS "PuiGetIntId" LIB "pui"
  35. DECLARE SUB ::GetIntId2 ALIAS "PuiGetIntId2" LIB "pui"
  36. DECLARE SUB ::StoreGlobal ALIAS "PuiStoreGlobal" LIB "pui"
  37. DECLARE SUB ::SetGlobal ALIAS "PuiSetGlobal" LIB "pui"
  38. DECLARE SUB ::GetGlobal ALIAS "PuiGetGlobal" LIB "pui"
  39. ' Events
  40. DECLARE SUB __GetEvent ALIAS "GetEvent" LIB "pui"
  41. DECLARE SUB __MainLoop ALIAS "PuiMainLoop" LIB "pui"
  42. DECLARE SUB ::MainLoopLevel ALIAS "PuiMainLoopLevel" LIB "pui"
  43. DECLARE SUB __LoopStep ALIAS "PuiLoopStep" LIB "pui"
  44. DECLARE SUB __LoopStepWait ALIAS "PuiLoopStepWait" LIB "pui"
  45. DECLARE SUB __ExitLoop ALIAS "PuiExitLoop" LIB "pui"
  46. DECLARE SUB ::Flush ALIAS "PuiFlush" LIB "pui"
  47. DECLARE SUB ::GetCallback ALIAS "PuiGetCallback" LIB "pui"
  48. DECLARE SUB __SetCallback ALIAS "PuiSetCallback" LIB "pui"
  49. DECLARE SUB ::SetCallbacks ALIAS "PuiSetCallbacks" LIB "pui"
  50. DECLARE SUB ::GetActionName ALIAS "PuiGetActionName" LIB "pui"
  51. DECLARE SUB ::SetFunction ALIAS "PuiSetFunction" LIB "pui"
  52. DECLARE SUB ::RecordInput ALIAS "PuiRecordInput" LIB "pui"
  53. DECLARE SUB ::PlayInput ALIAS "PuiPlayInput" LIB "pui"
  54. ' Layout
  55. DECLARE SUB ::Create ALIAS "PuiCreate" LIB "pui"
  56. DECLARE SUB ::Destroy ALIAS "PuiDestroy" LIB "pui"
  57. DECLARE SUB ::Map ALIAS "PuiMap" LIB "pui"
  58. DECLARE SUB ::Unmap ALIAS "PuiUnmap" LIB "pui"
  59. DECLARE SUB ::GetAllClasses ALIAS "PuiGetAllClasses" LIB "pui"
  60. DECLARE SUB ::GetClassName ALIAS "PuiGetClassName" LIB "pui"
  61. DECLARE SUB ::GetClassType ALIAS "PuiGetClassType" LIB "pui"
  62. DECLARE SUB ::ClassMatch ALIAS "PuiClassMatch" LIB "pui"
  63. DECLARE SUB ::GetClassAttributes ALIAS "PuiGetClassAttributes" LIB "pui"
  64. DECLARE SUB ::GetClassCallbacks ALIAS "PuiGetClassCallbacks" LIB "pui"
  65. DECLARE SUB ::SaveClassAttributes ALIAS "PuiSaveClassAttributes" LIB "pui"
  66. DECLARE SUB ::CopyClassAttributes ALIAS "PuiCopyClassAttributes" LIB "pui"
  67. DECLARE SUB ::SetClassDefaultAttribute ALIAS "PuiSetClassDefaultAttribute" LIB "pui"
  68. DECLARE SUB ::Fill ALIAS "PuiFill" LIB "pui"
  69. DECLARE SUB ::Hbox ALIAS "PuiHbox" LIB "pui"
  70. DECLARE SUB ::Vbox ALIAS "PuiVbox" LIB "pui"
  71. DECLARE SUB ::Zbox ALIAS "PuiZbox" LIB "pui"
  72. DECLARE SUB ::Radio ALIAS "PuiRadio" LIB "pui"
  73. DECLARE SUB ::Normalizer ALIAS "PuiNormalizer" LIB "pui"
  74. DECLARE SUB ::Cbox ALIAS "PuiCbox" LIB "pui"
  75. DECLARE SUB ::Sbox ALIAS "PuiSbox" LIB "pui"
  76. DECLARE SUB ::Split ALIAS "PuiSplit" LIB "pui"
  77. DECLARE SUB ::Append ALIAS "PuiAppend" LIB "pui"
  78. DECLARE SUB ::Detach ALIAS "PuiDetach" LIB "pui"
  79. DECLARE SUB ::Insert ALIAS "PuiInsert" LIB "pui"
  80. DECLARE SUB ::Reparent ALIAS "PuiReparent" LIB "pui"
  81. DECLARE SUB ::GetParent ALIAS "PuiGetParent" LIB "pui"
  82. DECLARE SUB ::GetChild ALIAS "PuiGetChild" LIB "pui"
  83. DECLARE SUB ::GetChildPos ALIAS "PuiGetChildPos" LIB "pui"
  84. DECLARE SUB ::GetChildCount ALIAS "PuiGetChildCount" LIB "pui"
  85. DECLARE SUB ::GetNextChild ALIAS "PuiGetNextChild" LIB "pui"
  86. DECLARE SUB ::GetBrother ALIAS "PuiGetBrother" LIB "pui"
  87. DECLARE SUB ::GetDialog ALIAS "PuiGetDialog" LIB "pui"
  88. DECLARE SUB ::GetDialogChild ALIAS "PuiGetDialogChild" LIB "pui"
  89. DECLARE SUB ::Refresh ALIAS "PuiRefresh" LIB "pui"
  90. DECLARE SUB ::RefreshChildren ALIAS "PuiRefreshChildren" LIB "pui"
  91. DECLARE SUB ::Update ALIAS "PuiUpdate" LIB "pui"
  92. DECLARE SUB ::UpdateChildren ALIAS "PuiUpdateChildren" LIB "pui"
  93. DECLARE SUB ::Redraw ALIAS "PuiRedraw" LIB "pui"
  94. DECLARE SUB ::ConvertXYToPos ALIAS "PuiConvertXYToPos" LIB "pui"
  95. ' Dialog
  96. DECLARE SUB ::Dialog ALIAS "PuiDialog" LIB "pui"
  97. DECLARE SUB ::Popup ALIAS "PuiPopup" LIB "pui"
  98. DECLARE SUB ::Show ALIAS "PuiShow" LIB "pui"
  99. DECLARE SUB ::ShowXY ALIAS "PuiShowXY" LIB "pui"
  100. DECLARE SUB ::Hide ALIAS "PuiHide" LIB "pui"
  101. DECLARE SUB ::FileDlg ALIAS "PuiFileDlg" LIB "pui"
  102. DECLARE SUB ::MessageDlg ALIAS "PuiMessageDlg" LIB "pui"
  103. DECLARE SUB ::ColorDlg ALIAS "PuiColorDlg" LIB "pui"
  104. DECLARE SUB ::FontDlg ALIAS "PuiFontDlg" LIB "pui"
  105. DECLARE SUB ::Alarm ALIAS "PuiAlarm" LIB "pui"
  106. DECLARE SUB ::GetFile ALIAS "PuiGetFile" LIB "pui"
  107. DECLARE SUB ::GetColor ALIAS "PuiGetColor" LIB "pui"
  108. DECLARE SUB ::GetParam ALIAS "PuiGetParam" LIB "pui"
  109. DECLARE SUB ::GetText ALIAS "PuiGetText" LIB "pui"
  110. DECLARE SUB ::ListDialog ALIAS "PuiListDialog" LIB "pui"
  111. DECLARE SUB ::Message ALIAS "PuiMessage" LIB "pui"
  112. DECLARE SUB ::LayoutDialog ALIAS "PuiLayoutDialog" LIB "pui"
  113. DECLARE SUB ::ElementPropertiesDialog ALIAS "PuiElementPropertiesDialog" LIB "pui"
  114. ' Controls
  115. DECLARE SUB ::Button ALIAS "PuiButton" LIB "pui"
  116. DECLARE SUB ::Canvas ALIAS "PuiCanvas" LIB "pui"
  117. DECLARE SUB ::Frame ALIAS "PuiFrame" LIB "pui"
  118. DECLARE SUB ::Label ALIAS "PuiLabel" LIB "pui"
  119. DECLARE SUB ::List ALIAS "PuiList" LIB "pui"
  120. DECLARE SUB ::MultiLine ALIAS "PuiMultiLine" LIB "pui"
  121. DECLARE SUB ::ProgressBar ALIAS "PuiProgressBar" LIB "pui"
  122. DECLARE SUB ::Spin ALIAS "PuiSpin" LIB "pui"
  123. DECLARE SUB ::Tabs ALIAS "PuiTabs" LIB "pui"
  124. DECLARE SUB ::Tabsv ALIAS "PuiTabsv" LIB "pui"
  125. DECLARE SUB ::Text ALIAS "PuiText" LIB "pui"
  126. DECLARE SUB ::Toggle ALIAS "PuiToggle" LIB "pui"
  127. DECLARE SUB ::Tree ALIAS "PuiTree" LIB "pui"
  128. DECLARE SUB ::Val ALIAS "PuiVal" LIB "pui"
  129. DECLARE SUB ::Cells ALIAS "PuiCells" LIB "pui"
  130. DECLARE SUB ::Colorbar ALIAS "PuiColorbar" LIB "pui"
  131. DECLARE SUB ::ColorBrowser ALIAS "PuiColorBrowser" LIB "pui"
  132. DECLARE SUB ::Dial ALIAS "PuiDial" LIB "pui"
  133. DECLARE SUB ::Matrix ALIAS "PuiMatrix" LIB "pui"
  134. DECLARE SUB ::GLCanvas ALIAS "PuiGLCanvas" LIB "pui"
  135. DECLARE SUB ::PPlot ALIAS "PuiPPlot" LIB "pui"
  136. DECLARE SUB ::WebBrowser ALIAS "PuiWebBrowser" LIB "pui"
  137. ' Resources
  138. DECLARE SUB ::Image ALIAS "PuiImage" LIB "pui"
  139. DECLARE SUB ::ImageRGB ALIAS "PuiImageRGB" LIB "pui"
  140. DECLARE SUB ::ImageRGBA ALIAS "PuiImageRGBA" LIB "pui"
  141. DECLARE SUB ::ImageLibOpen ALIAS "PuiImageLibOpen" LIB "pui"
  142. DECLARE SUB ::LoadImage ALIAS "PuiLoadImage" LIB "pui"
  143. DECLARE SUB ::SaveImage ALIAS "PuiSaveImage" LIB "pui"
  144. DECLARE SUB ::NextField ALIAS "PuiNextField" LIB "pui"
  145. DECLARE SUB ::PreviousField ALIAS "PuiPreviousField" LIB "pui"
  146. DECLARE SUB ::GetFocus ALIAS "PuiGetFocus" LIB "pui"
  147. DECLARE SUB ::SetFocus ALIAS "PuiSetFocus" LIB "pui"
  148. DECLARE SUB ::Item ALIAS "PuiItem" LIB "pui"
  149. DECLARE SUB ::Menu ALIAS "PuiMenu" LIB "pui"
  150. DECLARE SUB ::Menuv ALIAS "PuiMenuv" LIB "pui"
  151. DECLARE SUB ::Separator ALIAS "PuiSeparator" LIB "pui"
  152. DECLARE SUB ::Submenu ALIAS "PuiSubmenu" LIB "pui"
  153. DECLARE SUB ::SetHandle ALIAS "PuiSetHandle" LIB "pui"
  154. DECLARE SUB ::GetHandle ALIAS "PuiGetHandle" LIB "pui"
  155. DECLARE SUB ::GetName ALIAS "PuiGetName" LIB "pui"
  156. DECLARE SUB ::GetAllNames ALIAS "PuiGetAllNames" LIB "pui"
  157. DECLARE SUB ::GetAllDialogs ALIAS "PuiGetAllDialogs" LIB "pui"
  158. DECLARE SUB ::Clipboard ALIAS "PuiClipboard" LIB "pui"
  159. DECLARE SUB ::Timer ALIAS "PuiTimer" LIB "pui"
  160. DECLARE SUB ::User ALIAS "PuiUser" LIB "pui"
  161. DECLARE SUB ::Help ALIAS "PuiHelp" LIB "pui"
  162. ' DECLARE SUB ::GetListText ALIAS "PuiGetListText" LIB "pui"
  163. ' DECLARE SUB ::ClearList ALIAS "PuiClearList" LIB "pui"
  164.  
  165. ' Helper Functions
  166. DECLARE SUB ::GetListText ALIAS "PuiGetListText" LIB "pui"
  167. DECLARE SUB ::GetBtnPressed ALIAS "PuiGetBtnPressed" LIB "pui"
  168. DECLARE SUB ::GetBtnState ALIAS "PuiGetBtnState" LIB "pui"
  169. DECLARE SUB ::ClearList ALIAS "PuiClearList" LIB "pui"
  170. DECLARE SUB ::Info ALIAS "PuiInfo" LIB "pui"
  171.  
  172.  
  173. SUB MainLoop
  174. ExitLoop = 0
  175. REPEAT
  176.   __LoopStepWait()
  177.   this_event = __GetEvent()
  178.   IF this_event <> undef THEN
  179.     IF this_event = event{this_event}[0] THEN
  180.       ICALL(event{this_event}[1])
  181.     END IF
  182.   END IF
  183. UNTIL ExitLoop
  184. END SUB
  185.  
  186.  
  187. FUNCTION SetCallback(ih, aname, faddr)
  188.   event{ih}[0] = ih
  189.   event{ih}[1] = faddr
  190.   event{ih}[2] = aname
  191.   SetCallback = __SetCallback(ih, aname)
  192. END FUNCTION
  193.  
  194. END MODULE
  195.  


The following example is an online dictionary using IUP for the GUI and ScriptBasic to provided the data from the online dictionary API site.

Code: Script BASIC
  1. ' IUP Online Dictionary
  2.  
  3. IMPORT iup.sbi
  4.  
  5. servers[0]="dict.org"
  6. servers[1]="dict1.us.dict.org"
  7. servers[2]="all.dict.org"
  8.  
  9. about="IUP ScriptBasic Binding"
  10.  
  11. ' Initialize IUP
  12. Iup::Open()
  13.  
  14. ' Create main window
  15.  
  16. win = Iup::Create("dialog")
  17.   Iup::SetAttributes(win, "TITLE=\"ScriptBasic IUP Online Dictionary\", SIZE=500x300")
  18.   Iup::SetCallback(win,"CLOSE_CB",ADDRESS(Win_exit()))
  19.  
  20. ' Create container to house ALL GUI objects
  21.  
  22. vbox = Iup::Create("vbox")
  23.   Iup::SetAttributes(vbox, "MARGIN=10x10")
  24.  
  25. ' Create server panel
  26.  
  27. topBox = Iup::Create("hbox")
  28.   Iup::SetAttributes(topBox, "GAP=10")
  29.   Iup::Append(vbox, topBox)
  30. serverFrame = Iup::Create("frame")
  31.   Iup::SetAttributes(serverFrame, "TITLE=Servers, EXPAND=YES")
  32.   Iup::Append(topBox, serverFrame)
  33. serverBox = Iup::Create("hbox")
  34.   Iup::SetAttributes(serverBox, "GAP=5")
  35.   Iup::Append(serverFrame, serverBox)
  36. serverCombo = Iup::Create("list")
  37.   Iup::SetAttributes(serverCombo, "DROPDOWN=YES, SIZE=120x, EXPAND=HORIZONTAL, VALUE=1")
  38.   Iup::Append(serverBox, serverCombo)
  39.   Iup::SetCallback(serverCombo, "ACTION", ADDRESS(serverCombo_selected()))
  40. btnFetch = Iup::Create("button")
  41.   Iup::SetAttributes(btnFetch, "TITLE=Fetch, SIZE = 50x")
  42.   Iup::Append(serverBox, btnFetch)
  43.   Iup::SetCallback(btnFetch, "ACTION", ADDRESS(btnFetch_clicked()))
  44.  
  45. ' Create control panel
  46.  
  47. controlFrame = Iup::Create("frame")
  48.   Iup::SetAttributes(controlFrame, "TITLE=Controls")
  49.   Iup::Append(topBox, controlFrame)
  50. controlBox = Iup::Create("hbox")
  51.   Iup::SetAttributes(controlBox, "GAP=5")
  52.   Iup::Append(controlFrame, controlBox)
  53. btnAbout = Iup::Create("button")
  54.   Iup::SetAttributes(btnAbout, "TITLE=About, SIZE = 50x")
  55.   Iup::Append(controlBox, btnAbout)
  56.   Iup::SetCallback(btnAbout, "ACTION", ADDRESS(btnAbout_clicked()))
  57. btnClear = Iup::Create("button")
  58.   Iup::SetAttributes(btnClear, "TITLE=Clear, SIZE = 50x")
  59.   Iup::Append(controlBox, btnClear)
  60.   Iup::SetCallback(btnClear, "ACTION", ADDRESS(btnClear_clicked()))
  61. btnExit = Iup::Create("button")
  62.   Iup::SetAttributes(btnExit, "TITLE=Exit, SIZE = 50x")
  63.   Iup::Append(controlBox, btnExit)
  64.   Iup::SetCallback(btnExit,"ACTION",ADDRESS(Win_exit()))
  65.  
  66. ' Create dictionary panel
  67.  
  68. dictFrame = Iup::Create("frame")
  69.   Iup::SetAttributes(dictFrame, "TITLE=Dictionaries")
  70.   Iup::Append(vbox, dictFrame)
  71. serverList = Iup::Create("list")
  72.   Iup::SetAttributes(serverList, "EXPAND=YES, VISIBLELINES=1")
  73.   Iup::Append(dictFrame, serverList)
  74.   Iup::SetCallback(serverList, "ACTION", ADDRESS(serverList_selected()))
  75.  
  76. ' Create text part
  77.  
  78. transFrame = IUP::Create("frame")
  79.   Iup::SetAttributes(transFrame, "TITLE=Translation")
  80.   Iup::Append(vbox, transFrame)
  81. text = Iup::Create("text")
  82.   Iup::SetAttributes(text, "MULTILINE=YES, EXPAND=YES")
  83.   Iup::Append(transFrame, text)
  84.  
  85. ' Create entry and search button
  86.  
  87. bottomBox = Iup::Create("hbox")
  88.   Iup::SetAttributes(bottomBox, "GAP=10")
  89.   Iup::Append(vbox, bottomBox)
  90. label = Iup::Create("label")
  91.   Iup::SetAttributes(label, "TITLE=\"Enter Word to Search For:\", SIZE=x12")
  92.   Iup::Append(bottomBox, label)
  93. entry = Iup::Create("text")
  94.   Iup::SetAttributes(entry, "EXPAND=HORIZONTAL")
  95.   Iup::Append(bottomBox, entry)
  96. btnSearch = Iup::Create("button")
  97.   Iup::SetAttributes(btnSearch,"TITLE=Search, SIZE=50x")
  98.   Iup::Append(bottomBox, btnSearch)
  99.   Iup::SetCallback(btnSearch, "ACTION", ADDRESS(btnSearch_clicked()))
  100. chkAll = Iup::Create("toggle")
  101.   Iup::SetAttributes(chkAll, "TITLE=ALL, SIZE=x12")
  102.   Iup::Append(bottomBox, chkAll)
  103. chkUTF = Iup::Create("toggle")
  104.   Iup::SetAttributes(chkUTF, "TITLE=UTF-8, SIZE=x12")
  105.   Iup::Append(bottomBox, chkUTF)
  106.  
  107. ' Add the main GUI container to the Window
  108.  
  109. Iup::Append(win, vbox)
  110.  
  111. ' Setup dialog defaults
  112.  
  113. Iup::Show(win)
  114. Iup::SetFocus(btnFetch)
  115. FOR i = 0 TO UBOUND(servers)
  116.   Iup::SetAttribute(serverCombo, "APPENDITEM", servers[i])
  117. NEXT
  118. Iup::SetAttribute(serverCombo, "VALUE", "1")
  119. Iup::Update(serverCombo)
  120. server_selection = servers[0]
  121.  
  122. ' Main processing loop
  123.  
  124. Iup::MainLoop()
  125. Iup::Close()
  126. END
  127.  
  128. ' Callback routines
  129.  
  130. SUB Win_exit
  131.   Iup::ExitLoop = TRUE
  132. END SUB
  133.  
  134. SUB btnAbout_clicked
  135.   Iup::Message("ABOUT", about)
  136. END SUB
  137.  
  138. SUB serverCombo_selected
  139.   server_selection = Iup::GetListText()
  140. END SUB
  141.  
  142. SUB serverList_selected
  143.   whichDictionary = Iup::GetListText()
  144. END SUB
  145.  
  146. SUB btnFetch_clicked
  147.   LOCAL dat, total, count
  148.   ON ERROR GOTO G_NetError
  149.   OPEN server_selection & ":2628" FOR SOCKET AS #1
  150.   PRINT#1,"SHOW DB\n"
  151.   LINE INPUT#1, dat
  152.   LINE INPUT#1, dat
  153.   count = 0
  154.   WHILE LEFT(dat, 1) <> "."
  155.     LINE INPUT#1, dat
  156.     IF LEFT(dat, 1) <> "." THEN total[count] = TRIM(dat)
  157.     count+=1
  158.   WEND
  159.   PRINT#1,"QUIT\n"
  160.   CLOSE(#1)
  161.   FOR cnt = 0 TO count - 2
  162.     Iup::SetAttribute(serverList, "APPENDITEM", total[cnt])
  163.   NEXT
  164.   Iup::SetAttribute(serverList, "VALUE", "1")
  165.   Iup::Update(serverCombo)
  166.   whichDictionary = total[0]
  167.   EXIT SUB
  168.  
  169.   G_NetError:
  170.   PRINT "Server ",server_selection," not available. (",ERROR,")\n"
  171. END SUB
  172.  
  173. SUB btnClear_clicked
  174.   Iup::ClearList(serverList)
  175.   Iup::SetAttribute(text, "VALUE", "")
  176.   Iup::SetAttribute(entry, "VALUE", "")
  177. END SUB
  178.  
  179. SUB btnSearch_clicked
  180.   LOCAL dict, dat, total, info
  181.   IUP::SetAttribute(text, "VALUE","Fetching....")
  182.   ON ERROR GOTO L_NetError
  183.   dict = LEFT(whichDictionary, INSTR(whichDictionary, " "))
  184.   OPEN server_selection & ":2628" FOR SOCKET AS 1
  185.   IF Iup::GetAttribute(chkAll, "VALUE") THEN
  186.     PRINT#1,"DEFINE * " & Iup::GetAttribute(entry,"VALUE") & "\n"
  187.   ELSE
  188.     PRINT#1,"DEFINE " & dict & " " & Iup::GetAttribute(entry,"VALUE") & "\n"
  189.   END IF
  190.   REPEAT
  191.     LINE INPUT#1, dat
  192.     IF LEFT(dat, 3) = "151" THEN
  193.       total$ &= "------------------------------\r\n"
  194.       total$ &= RIGHT(dat, LEN(dat) - LEN(Iup::GetAttribute(entry, "VALUE")) - LEN(dict))
  195.       total$ &= "------------------------------\r\n"
  196.       REPEAT
  197.         LINE INPUT#1, info
  198.         info = REPLACE(info, CHR(34), CHR(92) & CHR(34))
  199.         IF LEFT(info, 1) <> "." THEN total &= TRIM(info) & "\n"
  200.       UNTIL LEFT(info, 1) = "."
  201.       total &= "\n"
  202.     END IF
  203.   UNTIL LEFT(dat, 3) = "250" OR VAL(LEFT(dat, 3)) > 499
  204.   PRINT#1,"QUIT\n"
  205.   CLOSE(#1)
  206.   IF LEFT(dat, 3) = "552" THEN
  207.     total = "No match found."
  208.   ELSE IF LEFT(dat, 3) = "501" THEN
  209.     total = "Select a dictionary first!"
  210.   ELSE IF LEFT(dat, 3) = "550" THEN
  211.     total = "Invalid database!"
  212.   END IF
  213.   Iup::SetAttribute(text, "VALUE", total)
  214. EXIT SUB
  215.  
  216. L_NetError:
  217.   dat[0] = "Could not lookup word! (" & ERROR & ")"
  218.   Iup::SetAttribute(text, "VALUE", dat)
  219. END SUB
  220.  

« Last Edit: May 15, 2020, 09:54:42 PM by John »

Offline John

  • Forum Support / SB Dev
  • Posts: 2987
    • ScriptBasic Open Source Project
Re: ScriptBasic Windows 32
« Reply #10 on: May 12, 2020, 04:03:10 AM »


The cURL extension module provides support for various internet protocols.

libcurl home page

ScriptBasic libcurl documentation

cURL Include
Code: Script BASIC
  1. module curl
  2.  
  3. declare sub ::Init       alias "sb_curl_init"     lib "curl"
  4. declare sub ::Option     alias "sb_curl_option"   lib "curl"
  5. declare sub ::Perform    alias "sb_curl_perform"  lib "curl"
  6. declare sub ::Finish     alias "sb_curl_finish"   lib "curl"
  7. declare sub ::Error      alias "sb_curl_error"    lib "curl"
  8. declare sub ::Info       alias "sb_curl_info"     lib "curl"
  9. declare sub ::Escape     alias "sb_curl_escape"   lib "curl"
  10. declare sub ::Unescape   alias "sb_curl_unescape" lib "curl"
  11. declare sub ::Getdate    alias "sb_curl_getdate"  lib "curl"
  12. declare sub ::Version    alias "sb_curl_version"  lib "curl"
  13.  
  14. end module
  15.  


This example downloads the war-and-peace.txt file from the AllBASIC.info site.

Code: Script BASIC
  1. IMPORT curl.sbi
  2.  
  3. ch = curl::init()
  4. PRINT "Downloading war-and-peace.txt ...\n"
  5. curl::option(ch, "URL", "https://allbasic.info/war-and-peace.txt")
  6. curl::option(ch, "FILE", "war-and-peace.txt")
  7. curl::option(ch,"NOPROGRESS",0)
  8. curl::perform(ch)
  9. PRINT curl::info(ch, "EFFECTIVE_URL"),"\n"
  10. PRINT FORMAT("Data downloaded: %0.0f bytes.\n", curl::info(ch, "SIZE_DOWNLOAD"))
  11. PRINT FORMAT("Total download time: %0.3f sec.\n", curl::info(ch, "TOTAL_TIME"))
  12. PRINT FORMAT("Average download speed: %0.3f kbyte/sec.\n", curl::info(ch, "SPEED_DOWNLOAD") / 1024)
  13. curl::finish(ch)
  14.  

Output

C:\ScriptBASIC\examples>sbc curl_wget.sb
Downloading war-and-peace.txt ...
  % Total    % Received % Xferd  Average Speed   Time    Time     Time  Current
                                 Dload  Upload   Total   Spent    Left  Speed
100 3214k  100 3214k    0     0  1672k      0  0:00:01  0:00:01 --:--:-- 1672k
https://allbasic.info/war-and-peace.txt
Data downloaded: 3291641 bytes.
Total download time: 1.922 sec.
Average download speed: 1672.473 kbyte/sec.

C:\ScriptBASIC\examples>


« Last Edit: May 15, 2020, 09:43:39 PM by John »

Offline John

  • Forum Support / SB Dev
  • Posts: 2987
    • ScriptBasic Open Source Project
Re: ScriptBasic Windows 32
« Reply #11 on: May 12, 2020, 05:59:22 PM »
The ScriptBasic COM extension module offers a CallByName COM/OLE automation interface. It is also tightly coupled with VB classic integration. The ScriptBasic IDE/Debugger is a good example of this integration.

COM Include
Code: Script BASIC
  1. GLOBAL CONST :GET    = 2
  2. GLOBAL CONST :LET    = 4
  3. GLOBAL CONST :CALL   = 1
  4. GLOBAL CONST :SET    = 8
  5.  
  6. MODULE COM
  7.  
  8. DECLARE SUB ::CREATE  ALIAS "CreateObject"      LIB "com"
  9. DECLARE SUB ::CBN     ALIAS "CallByName"        LIB "com"
  10. DECLARE SUB ::RELEASE ALIAS "ReleaseObject"     LIB "com"
  11. DECLARE SUB ::GHO     ALIAS "GetHostObject"     LIB "com"
  12. DECLARE SUB ::GHS     ALIAS "GetHostString"     LIB "com"
  13. DECLARE SUB ::TN      ALIAS "TypeName"          LIB "com"
  14. DECLARE SUB ::DI      ALIAS "DescribeInterface" LIB "com"
  15.  
  16. END MODULE
  17.  

This is an example of a VB6 OCX form I created to illustrate the concept. I converted the IUP online dictionary GUI form into an OCX, assigned methods and properties to it. When events occur the OCX form calls a ScriptBasic function / sub to process the event.

Code: Script BASIC
  1. IMPORT COM.sbi
  2. IMPORT NT.sbi
  3.  
  4. servers[0]="dict.org"
  5. servers[1]="dict1.us.dict.org"
  6. servers[2]="all.dict.org"
  7.  
  8. FUNCTION btnFetch_Clicked
  9.   LOCAL dat, total, count
  10.   ON ERROR GOTO G_NetError
  11.   server_selection = COM::CBN(obj, "CurrentServer")
  12.   OPEN server_selection & ":2628" FOR SOCKET AS #1
  13.   PRINT#1,"SHOW DB\n"
  14.   LINE INPUT#1, dat
  15.   LINE INPUT#1, dat
  16.   count = 0
  17.   WHILE LEFT(dat, 1) <> "."
  18.     LINE INPUT#1, dat
  19.     IF LEFT(dat, 1) <> "." THEN total[count] = TRIM(dat)
  20.     count+=1
  21.   WEND
  22.   PRINT#1,"QUIT\n"
  23.   CLOSE(#1)
  24.   FOR cnt = 0 TO count - 2
  25.     COM::CBN obj, "AddDictionaries", :CALL, total[cnt]
  26.   NEXT
  27.   COM::CBN obj, "DefaultDictionary"
  28.   btnFetch_Clicked = TRUE
  29.   EXIT FUNCTION
  30.  
  31.   G_NetError:
  32.   NT::MsgBox "Server " & server_selection & " not available. (" & ERROR & ")", "OLD Error", "OK","Info", 1
  33. END FUNCTION
  34.  
  35. FUNCTION btnSearch_clicked
  36.   LOCAL dict, dat, total, info
  37.   ON ERROR GOTO L_NetError
  38.   whichDictionary = COM::CBN(obj, "CurrentDictionary")
  39.   searchword = COM::CBN(obj, "SearchWord", :GET)
  40.   dict = LEFT(whichDictionary, INSTR(whichDictionary, " "))
  41.   OPEN COM::CBN(obj, "CurrentServer") & ":2628" FOR SOCKET AS 1
  42.   IF COM::CBN(obj, "AllDict", :GET) THEN
  43.     PRINT#1,"DEFINE * " & searchword & "\n"
  44.   ELSE
  45.     PRINT#1,"DEFINE " & dict & " " & searchword & "\n"
  46.   END IF
  47.   REPEAT
  48.     LINE INPUT#1, dat
  49.     IF LEFT(dat, 3) = "151" THEN
  50.       total$ &= "------------------------------\r\n"
  51.       total$ &= RIGHT(dat, LEN(dat) - LEN(searchword) - LEN(dict))
  52.       total$ &= "------------------------------\r\n"
  53.       REPEAT
  54.         LINE INPUT#1, info
  55.         info = REPLACE(info, CHR(34), CHR(92) & CHR(34))
  56.         IF LEFT(info, 1) <> "." THEN total &= TRIM(info) & "\r\n"
  57.       UNTIL LEFT(info, 1) = "."
  58.       total &= "\r\n"
  59.     END IF
  60.   UNTIL LEFT(dat, 3) = "250" OR VAL(LEFT(dat, 3)) > 499
  61.   PRINT#1,"QUIT\n"
  62.   CLOSE(#1)
  63.   IF LEFT(dat, 3) = "552" THEN
  64.     total = "No match found."
  65.   ELSE IF LEFT(dat, 3) = "501" THEN
  66.     total = "Select a dictionary first!"
  67.   ELSE IF LEFT(dat, 3) = "550" THEN
  68.     total = "Invalid database!"
  69.   END IF
  70.   COM::CBN(obj, "SetTranslation", :CALL, total)
  71.   btnSearch_Clicked = TRUE
  72. EXIT FUNCTION
  73.  
  74. L_NetError:
  75.   dat[0] = "Could not lookup word! (" & ERROR & ")"
  76.   COM::CBN(obj, "SetTranslation", :CALL, dat)
  77. END FUNCTION
  78.  
  79. ' MAIN
  80.  
  81. obj = COM::CREATE(:SET, "OLD.OLDict")
  82. oCollection = COM::CBN(obj, "CallBackHandlers", :GET)
  83. COM::CBN oCollection, "Add", :CALL, ADDRESS(btnFetch_Clicked()), "win.btnFetch_Click"
  84. COM::CBN oCollection, "Add", :CALL, ADDRESS(btnSearch_Clicked()), "win.btnSearch_Click"
  85. FOR idx = 0 TO UBOUND(servers)
  86.   COM::CBN obj, "AddServer", :CALL, servers[idx]
  87. NEXT  
  88. COM::CBN obj, "DefaultServer"
  89. COM::CBN obj, "ShowOLD"
  90. COM::RELEASE obj
  91.  




« Last Edit: May 12, 2020, 06:03:48 PM by John »

Offline John

  • Forum Support / SB Dev
  • Posts: 2987
    • ScriptBasic Open Source Project
Re: ScriptBasic Windows 32
« Reply #12 on: May 13, 2020, 01:55:24 PM »


The SDL_gfx extension module provides the following features.

The SDL_gfx library evolved out of the SDL_gfxPrimitives code which provided basic drawing routines such as lines, circles or polygons for SDL Surfaces and adding a couple other useful functions for zooming images for example and doing basic image processing on byte arrays.

Note that SDL_gfx is compatible with SDL version 1.2 (not SDL2).

The current components of the SDL_gfx library are:
  • Graphic Primitives
  • Rotozoomer
  • Framerate control
  • MMX image filters
  • Custom Blit functions
  • Build-in 8x8 Font

ScriptBasic GFX Include
Code: Script BASIC
  1. MODULE GFX
  2.  
  3. DECLARE SUB    ::Window                    ALIAS     "gfx_Window"                    LIB  "gfx"
  4. DECLARE SUB    ::Close                     ALIAS     "gfx_Close"                     LIB  "gfx"
  5. DECLARE SUB    ::Update                    ALIAS     "gfx_Update"                    LIB  "gfx"
  6. DECLARE SUB    ::ClearScreen               ALIAS     "gfx_ClearScreen"               LIB  "gfx"
  7. DECLARE SUB    ::SDL_SetClipRect           ALIAS     "gfx_SDL_SetClipRect"           LIB  "gfx"
  8. DECLARE SUB    ::Time                      ALIAS     "gfx_Time"                      LIB  "gfx"
  9. DECLARE SUB    ::Shift                     ALIAS     "gfx_Shift"                     LIB  "gfx"
  10. DECLARE SUB    ::Rotate                    ALIAS     "gfx_Rotate"                    LIB  "gfx"
  11. DECLARE SUB    ::GetKey                    ALIAS     "gfx_GetKey"                    LIB  "gfx"
  12. DECLARE SUB    ::WaitKey                   ALIAS     "gfx_WaitKey"                   LIB  "gfx"
  13. DECLARE SUB    ::KeyName                   ALIAS     "gfx_KeyName"                   LIB  "gfx"
  14. DECLARE SUB    ::Mouse                     ALIAS     "gfx_Mouse"                     LIB  "gfx"
  15. DECLARE SUB    ::pixelColor                ALIAS     "gfx_pixelColor"                LIB  "gfx"
  16. DECLARE SUB    ::pixelRGBA                 ALIAS     "gfx_pixelRGBA"                 LIB  "gfx"
  17. DECLARE SUB    ::hlineColor                ALIAS     "gfx_hlineColor"                LIB  "gfx"
  18. DECLARE SUB    ::hlineRGBA                 ALIAS     "gfx_hlineRGBA"                 LIB  "gfx"
  19. DECLARE SUB    ::vlineColor                ALIAS     "gfx_vlineColor"                LIB  "gfx"
  20. DECLARE SUB    ::vlineRGBA                 ALIAS     "gfx_vlineRGBA"                 LIB  "gfx"
  21. DECLARE SUB    ::rectangleColor            ALIAS     "gfx_rectangleColor"            LIB  "gfx"
  22. DECLARE SUB    ::rectangleRGBA             ALIAS     "gfx_rectangleRGBA"             LIB  "gfx"
  23. DECLARE SUB    ::roundedRectangleColor     ALIAS     "gfx_roundedRectangleColor"     LIB  "gfx"
  24. DECLARE SUB    ::roundedRectangleRGBA      ALIAS     "gfx_roundedRectangleRGBA"      LIB  "gfx"
  25. DECLARE SUB    ::boxColor                  ALIAS     "gfx_boxColor"                  LIB  "gfx"
  26. DECLARE SUB    ::boxRGBA                   ALIAS     "gfx_boxRGBA"                   LIB  "gfx"
  27. DECLARE SUB    ::roundedBoxColor           ALIAS     "gfx_roundedBoxColor"           LIB  "gfx"
  28. DECLARE SUB    ::roundedBoxRGBA            ALIAS     "gfx_roundedBoxRGBA"            LIB  "gfx"
  29. DECLARE SUB    ::lineColor                 ALIAS     "gfx_lineColor"                 LIB  "gfx"
  30. DECLARE SUB    ::lineRGBA                  ALIAS     "gfx_lineRGBA"                  LIB  "gfx"
  31. DECLARE SUB    ::aalineColor               ALIAS     "gfx_aalineColor"               LIB  "gfx"
  32. DECLARE SUB    ::aalineRGBA                ALIAS     "gfx_aalineRGBA"                LIB  "gfx"
  33. DECLARE SUB    ::thickLineColor            ALIAS     "gfx_thickLineColor"            LIB  "gfx"
  34. DECLARE SUB    ::thickLineRGBA             ALIAS     "gfx_thickLineRGBA"             LIB  "gfx"
  35. DECLARE SUB    ::circleColor               ALIAS     "gfx_circleColor"               LIB  "gfx"
  36. DECLARE SUB    ::circleRGBA                ALIAS     "gfx_circleRGBA"                LIB  "gfx"
  37. DECLARE SUB    ::arcColor                  ALIAS     "gfx_arcColor"                  LIB  "gfx"
  38. DECLARE SUB    ::arcRGBA                   ALIAS     "gfx_arcRGBA"                   LIB  "gfx"
  39. DECLARE SUB    ::aacircleColor             ALIAS     "gfx_aacircleColor"             LIB  "gfx"
  40. DECLARE SUB    ::aacircleRGBA              ALIAS     "gfx_aacircleRGBA"              LIB  "gfx"
  41. DECLARE SUB    ::filledCircleColor         ALIAS     "gfx_filledCircleColor"         LIB  "gfx"
  42. DECLARE SUB    ::filledCircleRGBA          ALIAS     "gfx_filledCircleRGBA"          LIB  "gfx"
  43. DECLARE SUB    ::ellipseColor              ALIAS     "gfx_ellipseColor"              LIB  "gfx"
  44. DECLARE SUB    ::ellipseRGBA               ALIAS     "gfx_ellipseRGBA"               LIB  "gfx"
  45. DECLARE SUB    ::aaellipseColor            ALIAS     "gfx_aaellipseColor"            LIB  "gfx"
  46. DECLARE SUB    ::aaellipseRGBA             ALIAS     "gfx_aaellipseRGBA"             LIB  "gfx"
  47. DECLARE SUB    ::filledEllipseColor        ALIAS     "gfx_filledEllipseColor"        LIB  "gfx"
  48. DECLARE SUB    ::filledEllipseRGBA         ALIAS     "gfx_filledEllipseRGBA"         LIB  "gfx"
  49. DECLARE SUB    ::pieColor                  ALIAS     "gfx_pieColor"                  LIB  "gfx"
  50. DECLARE SUB    ::pieRGBA                   ALIAS     "gfx_pieRGBA"                   LIB  "gfx"
  51. DECLARE SUB    ::filledPieColor            ALIAS     "gfx_filledPieColor"            LIB  "gfx"
  52. DECLARE SUB    ::filledPieRGBA             ALIAS     "gfx_filledPieRGBA"             LIB  "gfx"
  53. DECLARE SUB    ::trigonColor               ALIAS     "gfx_trigonColor"               LIB  "gfx"
  54. DECLARE SUB    ::trigonRGBA                ALIAS     "gfx_trigonRGBA"                LIB  "gfx"
  55. DECLARE SUB    ::aatrigonColor             ALIAS     "gfx_aatrigonColor"             LIB  "gfx"
  56. DECLARE SUB    ::aatrigonRGBA              ALIAS     "gfx_aatrigonRGBA"              LIB  "gfx"
  57. DECLARE SUB    ::filledTrigonColor         ALIAS     "gfx_filledTrigonColor"         LIB  "gfx"
  58. DECLARE SUB    ::filledTrigonRGBA          ALIAS     "gfx_filledTrigonRGBA"          LIB  "gfx"
  59. DECLARE SUB    ::polygonColor              ALIAS     "gfx_polygonColor"              LIB  "gfx"
  60. DECLARE SUB    ::polygonRGBA               ALIAS     "gfx_polygonRGBA"               LIB  "gfx"
  61. DECLARE SUB    ::aapolygonColor            ALIAS     "gfx_aapolygonColor"            LIB  "gfx"
  62. DECLARE SUB    ::aapolygonRGBA             ALIAS     "gfx_aapolygonRGBA"             LIB  "gfx"
  63. DECLARE SUB    ::filledPolygonColor        ALIAS     "gfx_filledPolygonColor"        LIB  "gfx"
  64. DECLARE SUB    ::filledPolygonRGBA         ALIAS     "gfx_filledPolygonRGBA"         LIB  "gfx"
  65. DECLARE SUB    ::texturedPolygon           ALIAS     "gfx_texturedPolygon"           LIB  "gfx"
  66. DECLARE SUB    ::bezierColor               ALIAS     "gfx_bezierColor"               LIB  "gfx"
  67. DECLARE SUB    ::bezierRGBA                ALIAS     "gfx_bezierRGBA"                LIB  "gfx"
  68. DECLARE SUB    ::SetFont                   ALIAS     "gfx_SetFont"                   LIB  "gfx"
  69. DECLARE SUB    ::FontRotation              ALIAS     "gfx_FontRotation"              LIB  "gfx"
  70. DECLARE SUB    ::characterColor            ALIAS     "gfx_characterColor"            LIB  "gfx"
  71. DECLARE SUB    ::characterRGBA             ALIAS     "gfx_characterRGBA"             LIB  "gfx"
  72. DECLARE SUB    ::stringColor               ALIAS     "gfx_stringColor"               LIB  "gfx"
  73. DECLARE SUB    ::stringRGBA                ALIAS     "gfx_stringRGBA"                LIB  "gfx"
  74. DECLARE SUB    ::SDL_initFramerate         ALIAS     "gfx_SDL_initFramerate"         LIB  "gfx"
  75. DECLARE SUB    ::SDL_getFramerate          ALIAS     "gfx_SDL_getFramerate"          LIB  "gfx"
  76. DECLARE SUB    ::SDL_setFramerate          ALIAS     "gfx_SDL_setFramerate"          LIB  "gfx"
  77. DECLARE SUB    ::SDL_framerateDelay        ALIAS     "gfx_SDL_framerateDelay"        LIB  "gfx"
  78. DECLARE SUB    ::CreateSurface             ALIAS     "gfx_CreateSurface"             LIB  "gfx"
  79. DECLARE SUB    ::FreeSurface               ALIAS     "gfx_FreeSurface"               LIB  "gfx"
  80. DECLARE SUB    ::BlitSurface               ALIAS     "gfx_BlitSurface"               LIB  "gfx"
  81. DECLARE SUB    ::LoadBMP                   ALIAS     "gfx_LoadBMP"                   LIB  "gfx"
  82. DECLARE SUB    ::GetPixel                  ALIAS     "gfx_GetPixel"                  LIB  "gfx"
  83. DECLARE SUB    ::GetPixelRGBA              ALIAS     "gfx_GetPixelRGBA"              LIB  "gfx"
  84. DECLARE SUB    ::Mandelbrot                ALIAS     "gfx_Mandelbrot"                LIB  "gfx"
  85.  
  86. END MODULE
  87.  

SDL_gfx Demo - Basic Primitives



Code: Script BASIC
  1. ' SDL_gfx Demo
  2.  
  3. IMPORT gfx.sbi
  4.  
  5. win = gfx::Window(700, 600, "ScriptBasic SDL_gfx Demo")
  6. gfx::pixelRGBA(win, 10, 15, 255, 255, 255, 255)
  7. gfx::lineRGBA(win, 20, 10, 70, 90, 255, 0, 0, 255)
  8. gfx::trigonRGBA(win, 500, 50, 550, 200, 600, 150, 0, 255, 255, 255)
  9. gfx::filledTrigonRGBA(win, 200, 200, 300, 50, 400, 200, 0, 0, 255, 255)
  10. gfx::rectangleRGBA(win, 10, 300, 100, 380, 0, 255, 0, 255)
  11. gfx::boxRGBA(win, 210, 76, 325, 300, 255, 0, 0, 150)
  12. gfx::ellipseRGBA(win, 600, 400, 50, 90, 255, 255, 0, 200)
  13. gfx::filledEllipseRGBA(win, 600, 400, 25, 150, 0, 255, 0, 255)
  14. SPLIT "350,275,300,325,350,400,325,325,390,390,375" BY "," TO _
  15.       x[0],x[1],x[2],x[3],x[4],x[5],y[0],y[1],y[2],y[3],y[4]
  16. gfx::polygonRGBA(win, x, y, 6, 255, 255, 255, 155)
  17. SPLIT "400,450,450,425,300,400,410,450,425,500" BY "," TO _
  18.       s[0],s[1],s[2],s[3],s[4],t[0],t[1],t[2],t[3],t[4]
  19. gfx::filledPolygonRGBA(win, s, t, 5, 255, 0, 255, 155)
  20. gfx::stringColor win, 250, 550, "Press ESC key to QUIT" & CHR(0), 0xffffffff
  21. gfx::Update
  22. WHILE gfx::KeyName(1) <> "+escape"
  23. WEND
  24. gfx::Close
  25.  

Alpha Circles



Code: Script BASIC
  1. ' ScriptBasic GFX - Alpha Circles
  2.  
  3. IMPORT gfx.sbi
  4.  
  5. scrn = gfx::Window(640, 480, "ScriptBasic GFX - Alpha Circles")
  6. ' Random Value Arrays
  7. RANDOMIZE(gfx::Time())
  8. FOR i = 0 TO 512
  9.   rx[i] = RND() % 640
  10.   ry[i] = 60 + RND() % 480 - 80
  11.   rz[i] = RND() % 64
  12.   rr[i] = RND() AND  255
  13.   rg[i] = RND() AND  255
  14.   rb[i] = RND() AND  255
  15.   af = rx[i] / 640
  16.   ra[i] = INT(255 * af)
  17. NEXT
  18.  
  19. ts = gfx::Time()
  20. FOR i = 0 TO 512
  21.   gfx::filledCircleRGBA scrn, rx[i], ry[i], rz[i], rr[i], rg[i], rb[i], ra[i]
  22. NEXT
  23. te = gfx::Time()
  24. gfx::stringColor scrn, 20, 15, "Time: " & FORMAT("%.4f",(te-ts)/1000) & " Seconds." & CHR(0), 0xffffffff
  25. gfx::Update
  26. WHILE gfx::KeyName(1) <> "+escape"
  27. WEND
  28. gfx::Close
  29.  

Mandelbrot Fractal



Code: Script BASIC
  1. ' ScriptBasic GFX - Mandelbrot
  2.  
  3. IMPORT gfx.sbi
  4.  
  5. s = gfx::Window(640,480,"ScriptBasic SDL_gfx Mandelbrot")
  6. ts = gfx::Time()
  7. FOR y = 0 TO 479
  8.   FOR x = 0 TO 639
  9.     cx = (x - 320) / 120
  10.     cy = (y - 240) / 120
  11.     rit = gfx::Mandelbrot(cx, cy, 510)
  12.     gfx::PixelRGBA s, x, y, rit * 32, rit * 16, rit * 8, 255
  13.   NEXT
  14. NEXT
  15. te = gfx::Time()
  16. gfx::stringColor s, 20, 15, "Time: " & FORMAT("%.4f",(te-ts)/1000) & " Seconds." & CHR(0), 0x000000ff
  17. gfx::Update
  18. WHILE gfx::KeyName(1) <> "+escape"
  19. WEND
  20. gfx::Close
  21.  

« Last Edit: May 16, 2020, 10:14:57 PM by John »

Offline John

  • Forum Support / SB Dev
  • Posts: 2987
    • ScriptBasic Open Source Project
Re: ScriptBasic Windows 32
« Reply #13 on: May 14, 2020, 01:06:58 PM »


The SQLite extension module provides core SQL CRUD functions in a lightweight DB library.

SQLite Home Page


SQLite Include
Code: Script BASIC
  1. module sqlite
  2.  
  3. SQLITE3_OK          =   0
  4. SQLITE3_ERROR       =   1
  5. SQLITE3_INTERNAL    =   2
  6. SQLITE3_PERM        =   3
  7. SQLITE3_ABORT       =   4
  8. SQLITE3_BUSY        =   5
  9. SQLITE3_LOCKED      =   6
  10. SQLITE3_NOMEM       =   7
  11. SQLITE3_READONLY    =   8
  12. SQLITE3_INTERRUPT   =   9
  13. SQLITE3_IOERR       =  10
  14. SQLITE3_CORRUPT     =  11
  15. SQLITE3_NOTFOUND    =  12  
  16. SQLITE3_FULL        =  13
  17. SQLITE3_CANTOPEN    =  14  
  18. SQLITE3_PROTOCOL    =  15  
  19. SQLITE3_EMPTY       =  16  
  20. SQLITE3_SCHEMA      =  17
  21. SQLITE3_TOOBIG      =  18
  22. SQLITE3_CONStraint  =  19
  23. SQLITE3_MISMATCH    =  20
  24. SQLITE3_MISUSE      =  21
  25. SQLITE3_NOLFS       =  22
  26. SQLITE3_AUTH        =  23
  27. SQLITE3_ROW         = 100
  28. SQLITE3_DONE        = 101
  29.  
  30. SQLITE3_STATIC      =   0
  31. SQLITE_TRANSIENT    =  -1
  32.  
  33. SQLITE_INTEGER      =   1
  34. SQLITE_FLOAT        =   2
  35. SQLITE_TEXT         =   3
  36. SQLITE_BLOB         =   4
  37. SQLITE_NULL         =   5
  38.      
  39. ' FUNCTION DECLARATIONS
  40. declare sub     ::OPEN         alias "sql3_open"         lib "sqlite"
  41. declare sub     ::CLOSE        alias "sql3_close"        lib "sqlite"
  42. declare sub     ::EXECUTE      alias "sql3_execute"      lib "sqlite"
  43. declare sub     ::QUERY        alias "sql3_query"        lib "sqlite"
  44. declare sub     ::ROW          alias "sql3_row"          lib "sqlite"
  45. declare sub     ::ROW_VALUE    alias "sql3_row_value"    lib "sqlite"
  46. declare sub     ::COLUMN_COUNT alias "sql3_column_count" lib "sqlite"
  47. declare sub     ::COLUMN_NAME  alias "sql3_column_name"  lib "sqlite"
  48. declare sub     ::FINALIZE     alias "sql3_finalize"     lib "sqlite"
  49. declare sub     ::VERSION      alias "sql3_version"      lib "sqlite"
  50. declare sub     ::ErrorCode    alias "sql3_errorcode"    lib "sqlite"
  51. declare sub     ::ErrorMsg     alias "sql3_errormsg"     lib "sqlite"
  52. declare sub     ::FETCHHASH    alias "sql3_fetchhash"    lib "sqlite"
  53. declare sub     ::FETCHARRAY   alias "sql3_fetcharray"   lib "sqlite"
  54.  
  55. end module
  56.  

SQLite Demo
Code: Script BASIC
  1. ' SQLite CREATE / INSERT / SELECT
  2.  
  3. IMPORT sqlite.sbi
  4.  
  5. db = sqlite::open("sqlite_demo.db")
  6.  
  7. sqlite::execute(db,"create table demo (someval integer, sometxt text);")
  8. sqlite::execute(db,"insert into demo values (123,'hello');")
  9. sqlite::execute(db, "INSERT INTO demo VALUES (234, 'cruel');")
  10. sqlite::execute(db, "INSERT INTO demo VALUES (345, 'world');")
  11.  
  12.  
  13. stmt = sqlite::query(db,"SELECT * FROM demo")
  14.  
  15. WHILE sqlite::row(stmt) = sqlite::SQLITE3_ROW
  16.   IF sqlite::fetchhash(stmt, column) THEN
  17.     PRINT column{"someval"},"\t-\t",column{"sometxt"},"\n"
  18.   END IF
  19. WEND
  20.  
  21. sqlite::close(db)
  22.  

Output

C:\ScriptBASIC\examples>sbc sqlite_demo.sb
123     -       hello
234     -       cruel
345     -       world

C:\ScriptBASIC\examples>



Offline John

  • Forum Support / SB Dev
  • Posts: 2987
    • ScriptBasic Open Source Project
Re: ScriptBasic Windows 32
« Reply #14 on: May 15, 2020, 04:55:22 PM »


The MySQL extension module is a C client interface to the MySQL Server Database.

MySQL Include
Code: Script BASIC
  1. module mysql
  2.  
  3. declare sub ::RealConnect alias "mys_real_connect" lib "mysql"
  4. declare sub ::Connect alias "mys_config_connect" lib "mysql"
  5. declare sub ::Close alias "mys_close" lib "mysql"
  6. declare sub ::Query alias "mys_query" lib "mysql"
  7. declare sub ::FetchArray alias "mys_fetcharray" lib "mysql"
  8. declare sub ::FetchHash alias "mys_fetchhash" lib "mysql"
  9. declare sub ::AffectedRows alias "mys_affected_rows" lib "mysql"
  10. declare sub ::ChangeUser alias "mys_change_user" lib "mysql"
  11. declare sub ::CharacterSetName alias "mys_character_set_name" lib "mysql"
  12. declare sub ::DataSeek alias "mys_data_seek" lib "mysql"
  13. declare sub ::ErrorMessage alias "mys_error" lib "mysql"
  14. declare sub ::GetClientInfo alias "mys_get_client_info" lib "mysql"
  15. declare sub ::GetHostInfo alias "mys_get_host_info" lib "mysql"
  16. declare sub ::GetProtoInfo alias "mys_get_proto_info" lib "mysql"
  17. declare sub ::GetServerInfo alias "mys_get_server_info" lib "mysql"
  18. declare sub ::Info alias "mys_info" lib "mysql"
  19. declare sub ::InsertId alias "mys_insert_id" lib "mysql"
  20. declare sub ::Kill alias "mys_kill" lib "mysql"
  21. declare sub ::Ping alias "mys_ping" lib "mysql"
  22. declare sub ::EscapeString alias "mys_real_escape_string" lib "mysql"
  23. declare sub ::SelectDatabase alias "mys_select_db" lib "mysql"
  24. declare sub ::Shutdown alias "mys_shutdown" lib "mysql"
  25. declare sub ::Stat alias "mys_stat" lib "mysql"
  26. declare sub ::ThreadId alias "mys_thread_id" lib "mysql"
  27.  
  28. end module
  29.  

This MySQL demo shows getting cars from a model DB.
Code: SQL
  1. CREATE TABLE IF NOT EXISTS `products` (
  2.   `productCode` VARCHAR(15) NOT NULL,
  3.   `productName` VARCHAR(70) NOT NULL,
  4.   `productLine` VARCHAR(50) NOT NULL,
  5.   `productScale` VARCHAR(10) NOT NULL,
  6.   `productVendor` VARCHAR(50) NOT NULL,
  7.   `productDescription` text NOT NULL,
  8.   `quantityInStock` SMALLINT(6) NOT NULL,
  9.   `buyPrice` DOUBLE NOT NULL,
  10.   `MSRP` DOUBLE NOT NULL,
  11.   PRIMARY KEY (`productCode`)
  12. ) ENGINE=MyISAM DEFAULT CHARSET=latin1;
  13.  

mysql_demo.sb
Code: Script BASIC
  1. ' MySQL Demo Program
  2.  
  3. INCLUDE mysql.sbi
  4.  
  5. dbh = mysql::RealConnect("localhost","user","password","classicmodels")
  6. PRINT "Got Here\n"
  7. mysql::query(dbh,"SELECT * FROM products WHERE productLine = 'Classic Cars'")
  8.  
  9. WHILE mysql::FetchHash(dbh,column)
  10.   PRINT column{"productCode"}," - ",column{"productName"}," - ",FORMAT("%~$###.00~",column{"MSRP"}),"\n"
  11. WEND
  12.  
  13. PRINTNL
  14. PRINT "The database handle is: ",dbh,"\n"
  15. PRINT "Affected rows by SELECT: ",mysql::AffectedRows(dbh),"\n"
  16. PRINT "Character set name is: ",mysql::CharacterSetName(dbh),"\n"
  17. PRINT "Last error is: ",mysql::ErrorMessage(dbh),"\n"
  18. PRINT "Client info is: ",mysql::GetClientInfo(),"\n"
  19. PRINT "Host info is: ",mysql::GetHostInfo(dbh),"\n"
  20. PRINT "Proto info is: ",mysql::GetProtoInfo(dbh),"\n"
  21. PRINT "Server info is: ",mysql::GetServerInfo(dbh),"\n"
  22. PRINT "PING result: ",mysql::Ping(dbh),"\n"
  23. PRINT "Thread ID: ",mysql::ThreadId(dbh),"\n"
  24. PRINT "Status is: ",mysql::Stat(dbh),"\n"
  25.  
  26. mysql::Close(dbh)
  27.  

Output

C:\ScriptBASIC\examples>sbc mysql_demo.sb
S10_1949 - 1952 Alpine Renault 1300 - $214.30
S10_4757 - 1972 Alfa Romeo GTA - $136.00
S10_4962 - 1962 LanciaA Delta 16V - $147.74
S12_1099 - 1968 Ford Mustang - $194.57
S12_1108 - 2001 Ferrari Enzo - $207.80
S12_3148 - 1969 Corvair Monza - $151.08
S12_3380 - 1968 Dodge Charger - $117.44
S12_3891 - 1969 Ford Falcon - $173.02
S12_3990 - 1970 Plymouth Hemi Cuda - $ 79.80
S12_4675 - 1969 Dodge Charger - $115.16
S18_1129 - 1993 Mazda RX-7 - $141.54
S18_1589 - 1965 Aston Martin DB5 - $124.44
S18_1889 - 1948 Porsche 356-A Roadster - $ 77.00
S18_1984 - 1995 Honda Civic - $142.25
S18_2238 - 1998 Chrysler Plymouth Prowler - $163.73
S18_2870 - 1999 Indy 500 Monte Carlo SS - $132.00
S18_3232 - 1992 Ferrari 360 Spider red - $169.34
S18_3233 - 1985 Toyota Supra - $107.57
S18_3278 - 1969 Dodge Super Bee - $ 80.41
S18_3482 - 1976 Ford Gran Torino - $146.99
S18_3685 - 1948 Porsche Type 356 Roadster - $141.28
S18_4027 - 1970 Triumph Spitfire - $143.62
S18_4721 - 1957 Corvette Convertible - $148.80
S18_4933 - 1957 Ford Thunderbird - $ 71.27
S24_1046 - 1970 Chevy Chevelle SS 454 - $ 73.49
S24_1444 - 1970 Dodge Coronet - $ 57.80
S24_1628 - 1966 Shelby Cobra 427 S/C - $ 50.31
S24_2766 - 1949 Jaguar XK 120 - $ 90.87
S24_2840 - 1958 Chevy Corvette Limited Edition - $ 35.36
S24_2887 - 1952 Citroen-15CV - $117.44
S24_2972 - 1982 Lamborghini Diablo - $ 37.76
S24_3191 - 1969 Chevrolet Camaro Z28 - $ 85.61
S24_3371 - 1971 Alpine Renault 1600s - $ 61.23
S24_3432 - 2002 Chevy Corvette - $107.08
S24_3856 - 1956 Porsche 356A Coupe - $140.43
S24_4048 - 1992 Porsche Cayenne Turbo Silver - $118.28
S24_4620 - 1961 Chevrolet Impala - $ 80.84
S700_2824 - 1982 Camaro Z28 - $101.15

The database handle is: 1
Affected rows by SELECT: 38
Character set name is: latin1
Last error is:
Client info is: 6.0.0
Host info is: localhost via TCP/IP
Proto info is: 10
Server info is: 8.0.20
PING result: -1
Thread ID: 0
Status is: Uptime: 7690  Threads: 6  Questions: 10766  Slow queries: 0  Opens: 726  Flush tables: 3  Open tables: 633  Queries per second avg: 1.400

C:\ScriptBASIC\examples>